From ae83749222c49c9857a41ef5e4acc93157d551c0 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Thu, 20 Feb 2025 03:44:03 +1100 Subject: [PATCH] punk::args and ansi fixes, another vfs --- .../modules/argparsingtest-0.1.0.tm | 568 + src/bootsupport/modules/commandstack-0.3.tm | 8 +- src/bootsupport/modules/funcl-0.1.tm | 2 +- .../modules/include_modules.config | 2 +- src/bootsupport/modules/overtype-1.6.5.tm | 45 +- src/bootsupport/modules/punk-0.1.tm | 31 +- .../modules/punk/aliascore-0.1.0.tm | 5 +- src/bootsupport/modules/punk/ansi-0.1.1.tm | 640 +- src/bootsupport/modules/punk/args-0.1.0.tm | 1730 +- src/bootsupport/modules/punk/char-0.1.0.tm | 36 +- src/bootsupport/modules/punk/console-0.1.1.tm | 940 +- src/bootsupport/modules/punk/lib-0.1.1.tm | 174 +- src/bootsupport/modules/punk/mix/cli-0.3.1.tm | 21 +- .../punk/mix/commandset/layout-0.1.0.tm | 42 +- .../punk/mix/commandset/loadedlib-0.1.0.tm | 13 +- .../punk/mix/commandset/module-0.1.0.tm | 29 +- .../punk/mix/commandset/project-0.1.0.tm | 84 +- src/bootsupport/modules/punk/nav/fs-0.1.0.tm | 3 +- src/bootsupport/modules/punk/ns-0.1.0.tm | 242 +- .../modules/punk/packagepreference-0.1.0.tm | 157 +- src/bootsupport/modules/punk/path-0.1.0.tm | 33 +- src/bootsupport/modules/punk/pipe-1.0.tm | 853 + .../modules/punk/repl/codethread-0.1.1.tm | 22 +- src/bootsupport/modules/punk/repo-0.1.1.tm | 24 +- src/bootsupport/modules/punk/zip-0.1.1.tm | 38 +- src/bootsupport/modules/punkcheck-0.1.0.tm | 113 +- .../modules/punkcheck/cli-0.1.0.tm | 2 + src/bootsupport/modules/shellfilter-0.1.9.tm | 17 +- src/bootsupport/modules/textblock-0.1.3.tm | 151 +- src/bootsupport/modules/tomlish-1.1.1.tm | 9 +- .../modules_tcl8/include_modules.config | 1 + .../modules_tcl8/win32_x86_64_tcl8-2.8.9.tm | Bin 0 -> 79939 bytes .../punk/modules/template_module-0.0.3.tm | 120 +- src/make.tcl | 149 +- src/modules/argparsingtest-999999.0a1.0.tm | 4 +- src/modules/funcl-0.1.tm | 2 +- src/modules/patternpunk-1.1.tm | 25 +- src/modules/punk-0.1.tm | 923 +- src/modules/punk/aliascore-999999.0a1.0.tm | 5 +- src/modules/punk/ansi-999999.0a1.0.tm | 640 +- src/modules/punk/args-999999.0a1.0.tm | 1730 +- src/modules/punk/args/tclcore-999999.0a1.0.tm | 832 +- src/modules/punk/basictelnet-999999.0a1.0.tm | 81 +- src/modules/punk/blockletter-999999.0a1.0.tm | 6 +- src/modules/punk/char-999999.0a1.0.tm | 36 +- src/modules/punk/console-999999.0a1.0.tm | 940 +- src/modules/punk/lib-999999.0a1.0.tm | 174 +- src/modules/punk/mix/cli-999999.0a1.0.tm | 21 +- .../mix/commandset/layout-999999.0a1.0.tm | 42 +- .../mix/commandset/loadedlib-999999.0a1.0.tm | 13 +- .../mix/commandset/module-999999.0a1.0.tm | 29 +- .../mix/commandset/project-999999.0a1.0.tm | 67 +- src/modules/punk/nav/fs-999999.0a1.0.tm | 3 +- src/modules/punk/ns-999999.0a1.0.tm | 242 +- .../punk/packagepreference-999999.0a1.0.tm | 157 +- src/modules/punk/path-999999.0a1.0.tm | 33 +- src/modules/punk/pcon-999999.0a1.0.tm | 279 + src/modules/punk/pcon-buildversion.txt | 3 + src/modules/punk/pipe-999999.0a1.0.tm | 853 + src/modules/punk/pipe-buildversion.txt | 3 + src/modules/punk/repl-0.1.tm | 583 +- .../punk/repl/codethread-999999.0a1.0.tm | 22 +- src/modules/punk/repo-999999.0a1.0.tm | 24 +- src/modules/punk/safe-999999.0a1.0.tm | 41 +- src/modules/punk/winrun-999999.0a1.0.tm | 6 +- src/modules/punk/winshell-999999.0a1.0.tm | 68 +- src/modules/punk/zip-999999.0a1.0.tm | 38 +- src/modules/punkcheck-0.1.0.tm | 113 +- src/modules/punkcheck/cli-999999.0a1.0.tm | 2 + src/modules/shellfilter-0.1.9.tm | 17 +- src/modules/shellthread-1.6.1.tm | 4 +- src/modules/textblock-999999.0a1.0.tm | 151 +- .../custom/_project/punk.basic/src/make.tcl | 149 +- .../modules/argparsingtest-0.1.0.tm | 568 + .../bootsupport/modules/commandstack-0.3.tm | 8 +- .../src/bootsupport/modules/funcl-0.1.tm | 2 +- .../modules/include_modules.config | 2 +- .../src/bootsupport/modules/overtype-1.6.5.tm | 45 +- .../src/bootsupport/modules/punk-0.1.tm | 31 +- .../modules/punk/aliascore-0.1.0.tm | 5 +- .../bootsupport/modules/punk/ansi-0.1.1.tm | 640 +- .../bootsupport/modules/punk/args-0.1.0.tm | 1730 +- .../bootsupport/modules/punk/char-0.1.0.tm | 36 +- .../bootsupport/modules/punk/console-0.1.1.tm | 940 +- .../src/bootsupport/modules/punk/lib-0.1.1.tm | 174 +- .../bootsupport/modules/punk/mix/cli-0.3.1.tm | 21 +- .../punk/mix/commandset/layout-0.1.0.tm | 42 +- .../punk/mix/commandset/loadedlib-0.1.0.tm | 13 +- .../punk/mix/commandset/module-0.1.0.tm | 29 +- .../punk/mix/commandset/project-0.1.0.tm | 84 +- .../bootsupport/modules/punk/nav/fs-0.1.0.tm | 3 +- .../src/bootsupport/modules/punk/ns-0.1.0.tm | 242 +- .../modules/punk/packagepreference-0.1.0.tm | 157 +- .../bootsupport/modules/punk/path-0.1.0.tm | 33 +- .../src/bootsupport/modules/punk/pipe-1.0.tm | 853 + .../modules/punk/repl/codethread-0.1.1.tm | 22 +- .../bootsupport/modules/punk/repo-0.1.1.tm | 24 +- .../src/bootsupport/modules/punk/zip-0.1.1.tm | 38 +- .../bootsupport/modules/punkcheck-0.1.0.tm | 113 +- .../modules/punkcheck/cli-0.1.0.tm | 2 + .../bootsupport/modules/shellfilter-0.1.9.tm | 17 +- .../bootsupport/modules/textblock-0.1.3.tm | 151 +- .../src/bootsupport/modules/tomlish-1.1.1.tm | 9 +- .../_project/punk.project-0.1/src/make.tcl | 149 +- .../modules/argparsingtest-0.1.0.tm | 568 + .../bootsupport/modules/commandstack-0.3.tm | 8 +- .../src/bootsupport/modules/funcl-0.1.tm | 2 +- .../modules/include_modules.config | 2 +- .../src/bootsupport/modules/overtype-1.6.5.tm | 45 +- .../src/bootsupport/modules/punk-0.1.tm | 31 +- .../modules/punk/aliascore-0.1.0.tm | 5 +- .../bootsupport/modules/punk/ansi-0.1.1.tm | 640 +- .../bootsupport/modules/punk/args-0.1.0.tm | 1730 +- .../bootsupport/modules/punk/char-0.1.0.tm | 36 +- .../bootsupport/modules/punk/console-0.1.1.tm | 940 +- .../src/bootsupport/modules/punk/lib-0.1.1.tm | 174 +- .../bootsupport/modules/punk/mix/cli-0.3.1.tm | 21 +- .../punk/mix/commandset/layout-0.1.0.tm | 42 +- .../punk/mix/commandset/loadedlib-0.1.0.tm | 13 +- .../punk/mix/commandset/module-0.1.0.tm | 29 +- .../punk/mix/commandset/project-0.1.0.tm | 84 +- .../bootsupport/modules/punk/nav/fs-0.1.0.tm | 3 +- .../src/bootsupport/modules/punk/ns-0.1.0.tm | 242 +- .../modules/punk/packagepreference-0.1.0.tm | 157 +- .../bootsupport/modules/punk/path-0.1.0.tm | 33 +- .../src/bootsupport/modules/punk/pipe-1.0.tm | 853 + .../modules/punk/repl/codethread-0.1.1.tm | 22 +- .../bootsupport/modules/punk/repo-0.1.1.tm | 24 +- .../src/bootsupport/modules/punk/zip-0.1.1.tm | 38 +- .../bootsupport/modules/punkcheck-0.1.0.tm | 113 +- .../modules/punkcheck/cli-0.1.0.tm | 2 + .../bootsupport/modules/shellfilter-0.1.9.tm | 17 +- .../bootsupport/modules/textblock-0.1.3.tm | 151 +- .../src/bootsupport/modules/tomlish-1.1.1.tm | 9 +- .../_project/punk.shell-0.1/src/make.tcl | 149 +- .../modules/argparsingtest-0.1.0.tm | 4 +- .../modules/commandstack-0.3.tm | 8 +- src/vfs/_vfscommon.vfs/modules/funcl-0.1.tm | 2 +- .../_vfscommon.vfs/modules/overtype-1.6.5.tm | 45 +- .../_vfscommon.vfs/modules/patternpunk-1.1.tm | 25 +- src/vfs/_vfscommon.vfs/modules/pipe-1.0.tm | 305 + src/vfs/_vfscommon.vfs/modules/punk-0.1.tm | 923 +- .../modules/punk/aliascore-0.1.0.tm | 5 +- .../_vfscommon.vfs/modules/punk/ansi-0.1.1.tm | 640 +- .../_vfscommon.vfs/modules/punk/args-0.1.0.tm | 1730 +- .../modules/punk/args/tclcore-0.1.0.tm | 832 +- .../modules/punk/basictelnet-0.1.0.tm | 81 +- .../modules/punk/blockletter-0.1.0.tm | 6 +- .../_vfscommon.vfs/modules/punk/char-0.1.0.tm | 36 +- .../modules/punk/console-0.1.1.tm | 940 +- .../_vfscommon.vfs/modules/punk/lib-0.1.1.tm | 174 +- .../modules/punk/mix/cli-0.3.1.tm | 21 +- .../punk/mix/commandset/layout-0.1.0.tm | 42 +- .../punk/mix/commandset/loadedlib-0.1.0.tm | 13 +- .../punk/mix/commandset/module-0.1.0.tm | 29 +- .../punk/mix/commandset/project-0.1.0.tm | 67 +- .../modules/punk/nav/fs-0.1.0.tm | 3 +- .../_vfscommon.vfs/modules/punk/ns-0.1.0.tm | 242 +- .../modules/punk/packagepreference-0.1.0.tm | 157 +- .../_vfscommon.vfs/modules/punk/path-0.1.0.tm | 33 +- .../_vfscommon.vfs/modules/punk/pcon-1.0.tm | 279 + .../_vfscommon.vfs/modules/punk/pipe-1.0.tm | 853 + .../_vfscommon.vfs/modules/punk/repl-0.1.tm | 583 +- .../modules/punk/repl/codethread-0.1.1.tm | 22 +- .../_vfscommon.vfs/modules/punk/repo-0.1.1.tm | 24 +- .../_vfscommon.vfs/modules/punk/safe-0.1.0.tm | 41 +- .../modules/punk/winrun-0.1.0.tm | 6 +- .../modules/punk/winshell-0.1.0.tm | 68 +- .../_vfscommon.vfs/modules/punk/zip-0.1.1.tm | 38 +- .../_vfscommon.vfs/modules/punkcheck-0.1.0.tm | 113 +- .../modules/punkcheck/cli-0.1.0.tm | 2 + .../modules/shellfilter-0.1.9.tm | 17 +- .../modules/shellthread-1.6.1.tm | 4 +- .../_vfscommon.vfs/modules/textblock-0.1.3.tm | 151 +- .../_vfscommon.vfs/modules/tomlish-1.1.1.tm | 9 +- .../mkzipfix.vfs/modules/commandstack-0.3.tm | 3 +- src/vfs/punk9magicsplat.vfs/bin/concrt140.dll | Bin 0 -> 322672 bytes .../punk9magicsplat.vfs/bin/libtommath.dll | Bin 0 -> 81408 bytes src/vfs/punk9magicsplat.vfs/bin/msvcp140.dll | Bin 0 -> 573008 bytes .../punk9magicsplat.vfs/bin/msvcp140_1.dll | Bin 0 -> 35920 bytes .../punk9magicsplat.vfs/bin/msvcp140_2.dll | Bin 0 -> 268392 bytes .../bin/msvcp140_atomic_wait.dll | Bin 0 -> 50280 bytes .../bin/msvcp140_codecvt_ids.dll | Bin 0 -> 31856 bytes src/vfs/punk9magicsplat.vfs/bin/tcl90.dll | Bin 0 -> 2179584 bytes src/vfs/punk9magicsplat.vfs/bin/tcl9tk90.dll | Bin 0 -> 1893888 bytes .../punk9magicsplat.vfs/bin/vccorlib140.dll | Bin 0 -> 348784 bytes .../punk9magicsplat.vfs/bin/vcruntime140.dll | Bin 0 -> 119376 bytes .../bin/vcruntime140_1.dll | Bin 0 -> 49744 bytes .../bin/vcruntime140_threads.dll | Bin 0 -> 38512 bytes src/vfs/punk9magicsplat.vfs/bin/zlib1.dll | Bin 0 -> 102912 bytes .../lib/bwidget1.10.0/BWman/ArrowButton.html | 276 + .../lib/bwidget1.10.0/BWman/BWidget.html | 228 + .../lib/bwidget1.10.0/BWman/Button.html | 307 + .../lib/bwidget1.10.0/BWman/ButtonBox.html | 266 + .../lib/bwidget1.10.0/BWman/ComboBox.html | 410 + .../lib/bwidget1.10.0/BWman/Dialog.html | 328 + .../lib/bwidget1.10.0/BWman/DragSite.html | 141 + .../lib/bwidget1.10.0/BWman/DropSite.html | 266 + .../lib/bwidget1.10.0/BWman/DynamicHelp.html | 251 + .../lib/bwidget1.10.0/BWman/Entry.html | 366 + .../lib/bwidget1.10.0/BWman/Label.html | 362 + .../lib/bwidget1.10.0/BWman/LabelEntry.html | 194 + .../lib/bwidget1.10.0/BWman/LabelFrame.html | 144 + .../lib/bwidget1.10.0/BWman/ListBox.html | 675 + .../lib/bwidget1.10.0/BWman/MainFrame.html | 323 + .../lib/bwidget1.10.0/BWman/MessageDlg.html | 221 + .../lib/bwidget1.10.0/BWman/NoteBook.html | 483 + .../lib/bwidget1.10.0/BWman/PagesManager.html | 180 + .../lib/bwidget1.10.0/BWman/PanedWindow.html | 158 + .../lib/bwidget1.10.0/BWman/PanelFrame.html | 153 + .../lib/bwidget1.10.0/BWman/PasswdDlg.html | 214 + .../lib/bwidget1.10.0/BWman/ProgressBar.html | 152 + .../lib/bwidget1.10.0/BWman/ProgressDlg.html | 145 + .../lib/bwidget1.10.0/BWman/ScrollView.html | 130 + .../bwidget1.10.0/BWman/ScrollableFrame.html | 194 + .../bwidget1.10.0/BWman/ScrolledWindow.html | 160 + .../lib/bwidget1.10.0/BWman/SelectColor.html | 212 + .../lib/bwidget1.10.0/BWman/SelectFont.html | 152 + .../lib/bwidget1.10.0/BWman/Separator.html | 77 + .../lib/bwidget1.10.0/BWman/SpinBox.html | 250 + .../lib/bwidget1.10.0/BWman/StatusBar.html | 147 + .../lib/bwidget1.10.0/BWman/TitleFrame.html | 107 + .../lib/bwidget1.10.0/BWman/Tree.html | 942 + .../lib/bwidget1.10.0/BWman/Widget.html | 505 + .../lib/bwidget1.10.0/BWman/contents.html | 95 + .../lib/bwidget1.10.0/BWman/index.html | 7 + .../lib/bwidget1.10.0/BWman/navtree.html | 41 + .../lib/bwidget1.10.0/BWman/options.htm | 458 + .../lib/bwidget1.10.0/CHANGES.txt | 266 + .../lib/bwidget1.10.0/ChangeLog | 2513 + .../lib/bwidget1.10.0/LICENSE.txt | 41 + .../lib/bwidget1.10.0/README.txt | 127 + .../lib/bwidget1.10.0/arrow.tcl | 551 + .../lib/bwidget1.10.0/bitmap.tcl | 94 + .../lib/bwidget1.10.0/button.tcl | 399 + .../lib/bwidget1.10.0/buttonbox.tcl | 419 + .../lib/bwidget1.10.0/color.tcl | 941 + .../lib/bwidget1.10.0/combobox.tcl | 955 + .../lib/bwidget1.10.0/demo/basic.tcl | 200 + .../lib/bwidget1.10.0/demo/bwidget.xbm | 46 + .../lib/bwidget1.10.0/demo/demo.tcl | 273 + .../lib/bwidget1.10.0/demo/dnd.tcl | 42 + .../lib/bwidget1.10.0/demo/manager.tcl | 141 + .../lib/bwidget1.10.0/demo/select.tcl | 59 + .../lib/bwidget1.10.0/demo/tmpldlg.tcl | 215 + .../lib/bwidget1.10.0/demo/tree.tcl | 260 + .../lib/bwidget1.10.0/demo/x1.xbm | 2258 + .../lib/bwidget1.10.0/dialog.tcl | 361 + .../lib/bwidget1.10.0/dragsite.tcl | 197 + .../lib/bwidget1.10.0/dropsite.tcl | 461 + .../lib/bwidget1.10.0/dynhelp.tcl | 798 + .../lib/bwidget1.10.0/entry.tcl | 529 + .../lib/bwidget1.10.0/font.tcl | 574 + .../lib/bwidget1.10.0/images/bold.gif | Bin 0 -> 118 bytes .../lib/bwidget1.10.0/images/copy.gif | Bin 0 -> 145 bytes .../lib/bwidget1.10.0/images/cut.gif | Bin 0 -> 130 bytes .../lib/bwidget1.10.0/images/dragfile.gif | Bin 0 -> 949 bytes .../lib/bwidget1.10.0/images/dragicon.gif | Bin 0 -> 1012 bytes .../lib/bwidget1.10.0/images/error.gif | Bin 0 -> 259 bytes .../lib/bwidget1.10.0/images/file.gif | Bin 0 -> 860 bytes .../lib/bwidget1.10.0/images/folder.gif | Bin 0 -> 139 bytes .../lib/bwidget1.10.0/images/hourglass.gif | Bin 0 -> 211 bytes .../lib/bwidget1.10.0/images/info.gif | Bin 0 -> 256 bytes .../lib/bwidget1.10.0/images/italic.gif | Bin 0 -> 111 bytes .../lib/bwidget1.10.0/images/minus.xbm | 5 + .../lib/bwidget1.10.0/images/new.gif | Bin 0 -> 131 bytes .../lib/bwidget1.10.0/images/opcopy.xbm | 5 + .../lib/bwidget1.10.0/images/open.gif | Bin 0 -> 139 bytes .../lib/bwidget1.10.0/images/openfold.gif | Bin 0 -> 146 bytes .../lib/bwidget1.10.0/images/oplink.xbm | 5 + .../lib/bwidget1.10.0/images/opmove.xbm | 5 + .../lib/bwidget1.10.0/images/overstrike.gif | Bin 0 -> 119 bytes .../lib/bwidget1.10.0/images/palette.gif | Bin 0 -> 151 bytes .../lib/bwidget1.10.0/images/passwd.gif | Bin 0 -> 481 bytes .../lib/bwidget1.10.0/images/paste.gif | Bin 0 -> 159 bytes .../lib/bwidget1.10.0/images/plus.xbm | 5 + .../lib/bwidget1.10.0/images/print.gif | Bin 0 -> 140 bytes .../lib/bwidget1.10.0/images/question.gif | Bin 0 -> 265 bytes .../lib/bwidget1.10.0/images/redo.gif | Bin 0 -> 70 bytes .../lib/bwidget1.10.0/images/save.gif | Bin 0 -> 138 bytes .../lib/bwidget1.10.0/images/target.xbm | 9 + .../lib/bwidget1.10.0/images/underline.gif | Bin 0 -> 119 bytes .../lib/bwidget1.10.0/images/undo.gif | Bin 0 -> 115 bytes .../lib/bwidget1.10.0/images/warning.gif | Bin 0 -> 254 bytes .../lib/bwidget1.10.0/init.tcl | 55 + .../lib/bwidget1.10.0/label.tcl | 327 + .../lib/bwidget1.10.0/labelentry.tcl | 105 + .../lib/bwidget1.10.0/labelframe.tcl | 168 + .../lib/bwidget1.10.0/lang/da.rc | 67 + .../lib/bwidget1.10.0/lang/de.rc | 67 + .../lib/bwidget1.10.0/lang/en.rc | 67 + .../lib/bwidget1.10.0/lang/es.rc | 69 + .../lib/bwidget1.10.0/lang/fr.rc | 69 + .../lib/bwidget1.10.0/lang/hu.rc | 67 + .../lib/bwidget1.10.0/lang/nl.rc | 67 + .../lib/bwidget1.10.0/lang/no.rc | 67 + .../lib/bwidget1.10.0/lang/pl.rc | 67 + .../lib/bwidget1.10.0/listbox.tcl | 1785 + .../lib/bwidget1.10.0/mainframe.tcl | 857 + .../lib/bwidget1.10.0/messagedlg.tcl | 128 + .../lib/bwidget1.10.0/notebook.tcl | 1306 + .../lib/bwidget1.10.0/pagesmgr.tcl | 298 + .../lib/bwidget1.10.0/panedw.tcl | 385 + .../lib/bwidget1.10.0/panelframe.tcl | 246 + .../lib/bwidget1.10.0/passwddlg.tcl | 182 + .../lib/bwidget1.10.0/pkgIndex.tcl | 48 + .../lib/bwidget1.10.0/progressbar.tcl | 208 + .../lib/bwidget1.10.0/progressdlg.tcl | 87 + .../lib/bwidget1.10.0/scrollframe.tcl | 272 + .../lib/bwidget1.10.0/scrollview.tcl | 254 + .../lib/bwidget1.10.0/scrollw.tcl | 296 + .../lib/bwidget1.10.0/separator.tcl | 75 + .../lib/bwidget1.10.0/spinbox.tcl | 346 + .../lib/bwidget1.10.0/statusbar.tcl | 422 + .../lib/bwidget1.10.0/tests/entry.test | 173 + .../lib/bwidget1.10.0/titleframe.tcl | 170 + .../lib/bwidget1.10.0/tree.tcl | 2256 + .../lib/bwidget1.10.0/utils.tcl | 713 + .../lib/bwidget1.10.0/widget.tcl | 1715 + .../lib/bwidget1.10.0/wizard.tcl | 1028 + .../lib/bwidget1.10.0/xpm2image.tcl | 177 + .../cawt2.9.6/Applications/AbbrExample.docx | Bin 0 -> 14410 bytes .../cawt2.9.6/Applications/DocumentInfo.tcl | 145 + .../cawt2.9.6/Applications/EnumExplorer.tcl | 278 + .../cawt2.9.6/Applications/FindTypeLibs.tcl | 24 + .../cawt2.9.6/Applications/MailAttachment.tcl | 167 + .../cawt2.9.6/Applications/OneNoteInfo.tcl | 256 + .../Applications/OneNoteMailList.txt | 2 + .../lib/cawt2.9.6/Applications/Word2Pdf.tcl | 93 + .../cawt2.9.6/Applications/WordAbbrCheck.tcl | 246 + .../lib/cawt2.9.6/CAWT-License.txt | 24 + .../lib/cawt2.9.6/CawtCore/cawtBasic.tcl | 675 + .../lib/cawt2.9.6/CawtCore/cawtClipboard.tcl | 50 + .../lib/cawt2.9.6/CawtCore/cawtColorUtil.tcl | 928 + .../lib/cawt2.9.6/CawtCore/cawtDateUtil.tcl | 208 + .../lib/cawt2.9.6/CawtCore/cawtEmbed.tcl | 139 + .../lib/cawt2.9.6/CawtCore/cawtFileUtil.tcl | 154 + .../lib/cawt2.9.6/CawtCore/cawtImgUtil.tcl | 142 + .../cawt2.9.6/CawtCore/cawtInterpolate.tcl | 493 + .../lib/cawt2.9.6/CawtCore/cawtStringUtil.tcl | 119 + .../lib/cawt2.9.6/CawtCore/cawtTestUtil.tcl | 256 + .../lib/cawt2.9.6/CawtCore/pkgInit.tcl | 17 + .../lib/cawt2.9.6/CawtEarth/earthBasic.tcl | 123 + .../lib/cawt2.9.6/CawtEarth/pkgInit.tcl | 8 + .../lib/cawt2.9.6/CawtExcel/excelBasic.tcl | 3822 + .../lib/cawt2.9.6/CawtExcel/excelChart.tcl | 720 + .../lib/cawt2.9.6/CawtExcel/excelConst.tcl | 6719 ++ .../lib/cawt2.9.6/CawtExcel/excelCsv.tcl | 254 + .../lib/cawt2.9.6/CawtExcel/excelHtml.tcl | 396 + .../lib/cawt2.9.6/CawtExcel/excelImgRaw.tcl | 376 + .../cawt2.9.6/CawtExcel/excelMatlabFile.tcl | 261 + .../cawt2.9.6/CawtExcel/excelMediaWiki.tcl | 315 + .../cawt2.9.6/CawtExcel/excelTablelist.tcl | 246 + .../lib/cawt2.9.6/CawtExcel/excelUtil.tcl | 447 + .../lib/cawt2.9.6/CawtExcel/excelWikit.tcl | 275 + .../lib/cawt2.9.6/CawtExcel/excelWord.tcl | 73 + .../lib/cawt2.9.6/CawtExcel/pkgInit.tcl | 19 + .../cawt2.9.6/CawtExplorer/explorerBasic.tcl | 175 + .../lib/cawt2.9.6/CawtExplorer/pkgInit.tcl | 8 + .../lib/cawt2.9.6/CawtMatlab/matlabBasic.tcl | 93 + .../lib/cawt2.9.6/CawtMatlab/pkgInit.tcl | 8 + .../lib/cawt2.9.6/CawtOcr/ocrBasic.tcl | 161 + .../lib/cawt2.9.6/CawtOcr/pkgInit.tcl | 8 + .../lib/cawt2.9.6/CawtOffice/officeBasic.tcl | 734 + .../lib/cawt2.9.6/CawtOffice/officeConst.tcl | 7502 ++ .../lib/cawt2.9.6/CawtOffice/pkgInit.tcl | 9 + .../cawt2.9.6/CawtOneNote/oneNoteBasic.tcl | 468 + .../cawt2.9.6/CawtOneNote/oneNoteConst.tcl | 346 + .../lib/cawt2.9.6/CawtOneNote/pkgInit.tcl | 9 + .../cawt2.9.6/CawtOutlook/outlookBasic.tcl | 201 + .../cawt2.9.6/CawtOutlook/outlookCalendar.tcl | 519 + .../cawt2.9.6/CawtOutlook/outlookCategory.tcl | 187 + .../cawt2.9.6/CawtOutlook/outlookColor.tcl | 129 + .../cawt2.9.6/CawtOutlook/outlookConst.tcl | 2798 + .../cawt2.9.6/CawtOutlook/outlookContact.tcl | 700 + .../lib/cawt2.9.6/CawtOutlook/outlookMail.tcl | 122 + .../lib/cawt2.9.6/CawtOutlook/pkgInit.tcl | 14 + .../lib/cawt2.9.6/CawtPpt/pkgInit.tcl | 11 + .../lib/cawt2.9.6/CawtPpt/pptBasic.tcl | 1673 + .../lib/cawt2.9.6/CawtPpt/pptConst.tcl | 4050 + .../lib/cawt2.9.6/CawtPpt/pptShapes.tcl | 401 + .../lib/cawt2.9.6/CawtPpt/pptUtil.tcl | 226 + .../lib/cawt2.9.6/CawtReader/pkgInit.tcl | 8 + .../lib/cawt2.9.6/CawtReader/readerBasic.tcl | 196 + .../lib/cawt2.9.6/CawtSapi/pkgInit.tcl | 9 + .../lib/cawt2.9.6/CawtSapi/sapiBasic.tcl | 178 + .../lib/cawt2.9.6/CawtSapi/sapiConst.tcl | 2480 + .../lib/cawt2.9.6/CawtWord/pkgInit.tcl | 10 + .../lib/cawt2.9.6/CawtWord/wordBasic.tcl | 3621 + .../lib/cawt2.9.6/CawtWord/wordConst.tcl | 10320 ++ .../lib/cawt2.9.6/CawtWord/wordUtil.tcl | 686 + .../lib/cawt2.9.6/Readme.txt | 717 + .../cawt2.9.6/TestPrograms/Cawt-01_Basic.tcl | 76 + .../cawt2.9.6/TestPrograms/Cawt-02_Color.tcl | 79 + .../cawt2.9.6/TestPrograms/Cawt-03_Date.tcl | 37 + .../cawt2.9.6/TestPrograms/Cawt-04_String.tcl | 48 + .../cawt2.9.6/TestPrograms/Cawt-05_File.tcl | 53 + .../cawt2.9.6/TestPrograms/Cawt-06_Img.tcl | 53 + .../cawt2.9.6/TestPrograms/Cawt-07_ComObj.tcl | 32 + .../TestPrograms/Cawt-08_TestUtil.tcl | 37 + .../cawt2.9.6/TestPrograms/Cawt-09_Embed.tcl | 61 + .../TestPrograms/Cawt-10_Interpolate.tcl | 215 + .../cawt2.9.6/TestPrograms/Cawt-11_Url.tcl | 53 + .../cawt2.9.6/TestPrograms/Earth-01_Basic.tcl | 28 + .../TestPrograms/Earth-02_MunichTour.tcl | 145 + .../cawt2.9.6/TestPrograms/Excel-01_Basic.tcl | 115 + .../cawt2.9.6/TestPrograms/Excel-02_Misc.tcl | 168 + .../cawt2.9.6/TestPrograms/Excel-03_Add.tcl | 121 + .../TestPrograms/Excel-04_Insert.tcl | 165 + .../TestPrograms/Excel-05_Ranges.tcl | 55 + .../cawt2.9.6/TestPrograms/Excel-06_Chart.tcl | 323 + .../cawt2.9.6/TestPrograms/Excel-07_Csv.tcl | 137 + .../TestPrograms/Excel-07_CsvUniCode.tcl | 42 + .../TestPrograms/Excel-08_Tablelist.tcl | 168 + .../Excel-08_TablelistSelection.tcl | 75 + .../TestPrograms/Excel-09_WordTable.tcl | 119 + .../TestPrograms/Excel-10_Matrix.tcl | 62 + .../TestPrograms/Excel-11_RawImage-16bit.tcl | 105 + .../TestPrograms/Excel-11_RawImage.tcl | 105 + .../TestPrograms/Excel-12_MatlabFile.tcl | 79 + .../TestPrograms/Excel-13_MediaWiki.tcl | 78 + .../cawt2.9.6/TestPrograms/Excel-14_Wikit.tcl | 78 + .../TestPrograms/Excel-14_WikitWithLinks.tcl | 87 + .../TestPrograms/Excel-15_Clipboard.tcl | 65 + .../TestPrograms/Excel-16_SetGet.tcl | 112 + .../cawt2.9.6/TestPrograms/Excel-17_Diff.tcl | 64 + .../TestPrograms/Excel-17_DiffEqual.tcl | 57 + .../TestPrograms/Excel-18_SparseMatrix.tcl | 110 + .../TestPrograms/Excel-19_MarkLink.tcl | 91 + .../TestPrograms/Excel-20_ImgUtil.tcl | 68 + .../TestPrograms/Excel-21_ImgCell.tcl | 108 + .../cawt2.9.6/TestPrograms/Excel-22_Html.tcl | 42 + .../TestPrograms/Excel-23_Font-Attributes.tcl | 113 + .../cawt2.9.6/TestPrograms/Excel-23_Font.tcl | 140 + .../TestPrograms/Excel-24_Format.tcl | 119 + .../TestPrograms/Excel-25_Properties.tcl | 71 + .../TestPrograms/Excel-26_PageSetup.tcl | 100 + .../TestPrograms/Excel-27_RowColumn.tcl | 111 + .../TestPrograms/Excel-28_NamedRange.tcl | 66 + .../TestPrograms/Excel-29_EmptySheet.tcl | 49 + .../TestPrograms/Excel-30_SelectRange.tcl | 57 + .../TestPrograms/Excel-31_Import.tcl | 86 + .../cawt2.9.6/TestPrograms/Excel-32_Quit.tcl | 40 + .../TestPrograms/Excel-33_AddAndRunMacro.tcl | 80 + .../Excel-33_ImportAndRunMacro.tcl | 76 + .../TestPrograms/Excel-33_RunMacro.tcl | 64 + .../TestPrograms/Excel-34_Events.tcl | 66 + .../TestPrograms/Excel-35_Styles.tcl | 87 + .../cawt2.9.6/TestPrograms/Excel-36_Embed.tcl | 78 + .../TestPrograms/Excel-37_WorksheetName.tcl | 69 + .../TestPrograms/Excel-38_Interpolate.tcl | 114 + .../TestPrograms/Explorer-01_Basic.tcl | 46 + .../TestPrograms/Explorer-02_Misc.tcl | 34 + .../TestPrograms/Explorer-03_Events.tcl | 64 + .../TestPrograms/Matlab-01_Basic.tcl | 39 + .../TestPrograms/Matlab-02_MFile.tcl | 37 + .../cawt2.9.6/TestPrograms/Ocr-01_Basic.tcl | 22 + .../cawt2.9.6/TestPrograms/Ocr-02_Misc.tcl | 91 + .../TestPrograms/OneNote-01_Basic.tcl | 55 + .../TestPrograms/Outlook-01_Basic.tcl | 87 + .../TestPrograms/Outlook-02_Mail.tcl | 43 + .../TestPrograms/Outlook-03_Holiday.tcl | 91 + .../TestPrograms/Outlook-04_Appointment.tcl | 81 + .../TestPrograms/Outlook-05_MailFolders.tcl | 40 + .../Outlook-06_ContactFolders.tcl | 235 + .../cawt2.9.6/TestPrograms/Ppt-01_Basic.tcl | 73 + .../cawt2.9.6/TestPrograms/Ppt-02_Misc.tcl | 61 + .../lib/cawt2.9.6/TestPrograms/Ppt-03_Add.tcl | 65 + .../cawt2.9.6/TestPrograms/Ppt-04_Present.tcl | 50 + .../cawt2.9.6/TestPrograms/Ppt-05_Export.tcl | 28 + .../TestPrograms/Ppt-06_CustomLayout.tcl | 62 + .../TestPrograms/Ppt-07_Properties.tcl | 70 + .../TestPrograms/Ppt-08_Comments.tcl | 47 + .../cawt2.9.6/TestPrograms/Ppt-09_Shapes.tcl | 74 + .../TestPrograms/Ppt-10_AllShapes.tcl | 86 + .../TestPrograms/Ppt-11_AllConnectors.tcl | 57 + .../cawt2.9.6/TestPrograms/Ppt-12_Quit.tcl | 32 + .../cawt2.9.6/TestPrograms/Ppt-13_Media.tcl | 108 + .../TestPrograms/Ppt-14_CreateVideo.tcl | 149 + .../TestPrograms/Ppt-15_ButtonEvent.tcl | 114 + .../cawt2.9.6/TestPrograms/Ppt-16_Embed.tcl | 71 + .../TestPrograms/Reader-01_Basic.tcl | 27 + .../TestPrograms/Reader-02_Embed.tcl | 59 + .../lib/cawt2.9.6/TestPrograms/RunTest.tcl | 179 + .../lib/cawt2.9.6/TestPrograms/RunTests.bat | 1 + .../lib/cawt2.9.6/TestPrograms/RunTests.log | 3 + .../cawt2.9.6/TestPrograms/Sapi-01_Basic.tcl | 37 + .../cawt2.9.6/TestPrograms/Sapi-02_Speak.tcl | 26 + .../TestPrograms/Sapi-03_SpeakOptions.tcl | 41 + .../TestPrograms/Sapi-04_SpeakFlags.tcl | 33 + .../cawt2.9.6/TestPrograms/SetTestPathes.tcl | 17 + .../cawt2.9.6/TestPrograms/Word-01_Basic.tcl | 71 + .../cawt2.9.6/TestPrograms/Word-02_Table.tcl | 199 + .../TestPrograms/Word-02_TableWidth.tcl | 64 + .../cawt2.9.6/TestPrograms/Word-03_Text.tcl | 183 + .../cawt2.9.6/TestPrograms/Word-04_Find.tcl | 86 + .../TestPrograms/Word-04_FindGeneric.tcl | 72 + .../cawt2.9.6/TestPrograms/Word-05_Report.tcl | 158 + .../cawt2.9.6/TestPrograms/Word-06_Diff.tcl | 58 + .../cawt2.9.6/TestPrograms/Word-07_Link.tcl | 234 + .../TestPrograms/Word-08_ImgUtil.tcl | 197 + .../TestPrograms/Word-09_Controls.tcl | 60 + .../TestPrograms/Word-10_Properties.tcl | 154 + .../cawt2.9.6/TestPrograms/Word-11_Tables.tcl | 49 + .../TestPrograms/Word-12_LargeTable.tcl | 161 + .../TestPrograms/Word-13_MultiTables.tcl | 195 + .../cawt2.9.6/TestPrograms/Word-14_Quit.tcl | 33 + .../TestPrograms/Word-15_MergeCells.tcl | 65 + .../TestPrograms/Word-16_ReplaceImages.tcl | 63 + .../TestPrograms/Word-17_Subdocuments.tcl | 66 + .../TestPrograms/Word-18_PageSetup.tcl | 74 + .../TestPrograms/Word-19_Heading.tcl | 76 + .../TestPrograms/Word-19_HeadingDict.tcl | 99 + .../cawt2.9.6/TestPrograms/Word-20_Font.tcl | 90 + .../TestPrograms/Word-21_RunMacro.tcl | 95 + .../cawt2.9.6/TestPrograms/Word-22_Events.tcl | 66 + .../cawt2.9.6/TestPrograms/Word-23_Embed.tcl | 74 + .../TestPrograms/testIn/Cawt-001.png | Bin 0 -> 10499 bytes .../TestPrograms/testIn/Cawt-002.png | Bin 0 -> 10471 bytes .../TestPrograms/testIn/Cawt-003.png | Bin 0 -> 10076 bytes .../TestPrograms/testIn/Cawt-004.png | Bin 0 -> 10286 bytes .../TestPrograms/testIn/Cawt-005.png | Bin 0 -> 10161 bytes .../TestPrograms/testIn/Cawt-006.png | Bin 0 -> 10146 bytes .../TestPrograms/testIn/Cawt-007.png | Bin 0 -> 9969 bytes .../TestPrograms/testIn/Cawt-008.png | Bin 0 -> 9489 bytes .../TestPrograms/testIn/Cawt-009.png | Bin 0 -> 9449 bytes .../TestPrograms/testIn/Cawt-010.png | Bin 0 -> 8930 bytes .../TestPrograms/testIn/CawtManual1.pdf | Bin 0 -> 352706 bytes .../TestPrograms/testIn/CawtManual2.pdf | Bin 0 -> 349292 bytes .../TestPrograms/testIn/CawtVideo.mp4 | Bin 0 -> 394840 bytes .../TestPrograms/testIn/CawtVideo.mpg | Bin 0 -> 100428 bytes .../TestPrograms/testIn/CustomLayout.potx | Bin 0 -> 41088 bytes .../TestPrograms/testIn/Expression.m | 1 + .../TestPrograms/testIn/Holidays.hol | 5 + .../TestPrograms/testIn/HolidaysUnicode.hol | Bin 0 -> 216 bytes .../TestPrograms/testIn/InsertMe.html | 20 + .../TestPrograms/testIn/Landscape.gif | Bin 0 -> 1758 bytes .../TestPrograms/testIn/MediaWikiTable.txt | 17 + .../TestPrograms/testIn/MultiLine.xls | Bin 0 -> 26112 bytes .../TestPrograms/testIn/Portrait.gif | Bin 0 -> 1527 bytes .../testIn/ReplaceImageTemplate.docx | Bin 0 -> 13691 bytes .../TestPrograms/testIn/ReportTemplate.doc | Bin 0 -> 54784 bytes .../TestPrograms/testIn/ReportTemplate.docx | Bin 0 -> 26863 bytes .../TestPrograms/testIn/SampleMacro.docm | Bin 0 -> 19621 bytes .../TestPrograms/testIn/SampleMacro.xls | Bin 0 -> 36352 bytes .../TestPrograms/testIn/SampleMacro.xlsm | Bin 0 -> 13768 bytes .../TestPrograms/testIn/SampleNamedRange.xls | Bin 0 -> 26112 bytes .../TestPrograms/testIn/SamplePpt.pptx | Bin 0 -> 33106 bytes .../TestPrograms/testIn/SampleTable.xls | Bin 0 -> 33792 bytes .../TestPrograms/testIn/SampleUnicode.xlsx | Bin 0 -> 9551 bytes .../TestPrograms/testIn/SampleWikitTable.xlsx | Bin 0 -> 13032 bytes .../cawt2.9.6/TestPrograms/testIn/Square.gif | Bin 0 -> 1727 bytes .../testIn/Subdocuments/Master.docx | Bin 0 -> 30007 bytes .../testIn/Subdocuments/Sub1.docx | Bin 0 -> 24370 bytes .../testIn/Subdocuments/Sub2.docx | Bin 0 -> 25852 bytes .../testIn/Subdocuments/Sub3.docx | Bin 0 -> 25871 bytes .../TestPrograms/testIn/TemplateTable.docx | Bin 0 -> 15671 bytes .../TestPrograms/testIn/TestMacro.bas | 22 + .../TestPrograms/testIn/WikitTable.txt | 6 + .../TestPrograms/testIn/WordTables.doc | Bin 0 -> 28672 bytes .../TestPrograms/testIn/gradient-16bit.raw | Bin 0 -> 131212 bytes .../TestPrograms/testIn/gradient.mat | Bin 0 -> 524359 bytes .../TestPrograms/testIn/gradient.raw | Bin 0 -> 262284 bytes .../TestPrograms/testIn/intensity.dat | 18 + .../lib/cawt2.9.6/TestPrograms/testIn/ocr.bmp | Bin 0 -> 355314 bytes .../TestPrograms/testIn/temperatures.dat | 100 + .../cawt2.9.6/TestPrograms/testIn/wish.gif | Bin 0 -> 1048 bytes .../lib/cawt2.9.6/pkgIndex.tcl | 35 + .../punk9magicsplat.vfs/lib/libtcl9.0.0.zip | Bin 0 -> 1135573 bytes .../punk9magicsplat.vfs/lib/nmake/nmakehlp.c | 820 + .../punk9magicsplat.vfs/lib/nmake/rules.vc | 1912 + .../punk9magicsplat.vfs/lib/nmake/targets.vc | 98 + .../punk9magicsplat.vfs/lib/nmake/tcl.nmake | 3 + .../lib/nmake/x86_64-w64-mingw32-nmakehlp.exe | Bin 0 -> 25088 bytes .../lib/projectInfo/pkgIndex.tcl | 1 + .../lib/projectInfo/projectInfo.tcl | 342 + .../lib/remotedebug/docs/initdebug.n | 148 + .../lib/remotedebug/docs/initdebug.pdf | Bin 0 -> 8204 bytes .../lib/remotedebug/initdebug.tcl | 112 + .../lib/remotedebug/pkgIndex.tcl | 1 + .../punk9magicsplat.vfs/lib/ruff2.4.2/LICENSE | 25 + .../lib/ruff2.4.2/README.md | 120 + .../lib/ruff2.4.2/assets/ruff-index-min.js | 1 + .../lib/ruff2.4.2/assets/ruff-logo.png | Bin 0 -> 1778 bytes .../lib/ruff2.4.2/assets/ruff-md.css | 171 + .../lib/ruff2.4.2/assets/ruff-min.css | 1 + .../lib/ruff2.4.2/assets/ruff-min.js | 1 + .../lib/ruff2.4.2/diagram.tcl | 141 + .../lib/ruff2.4.2/formatter.tcl | 1407 + .../lib/ruff2.4.2/formatter_html.tcl | 685 + .../lib/ruff2.4.2/formatter_markdown.tcl | 530 + .../lib/ruff2.4.2/formatter_nroff.tcl | 695 + .../lib/ruff2.4.2/msgs/de.msg | 10 + .../lib/ruff2.4.2/pkgIndex.tcl | 2 + .../lib/ruff2.4.2/ruff-ruff-sample.html | 715 + .../lib/ruff2.4.2/ruff-ruff.html | 669 + .../lib/ruff2.4.2/ruff.html | 61 + .../lib/ruff2.4.2/ruff.tcl | 2935 + .../lib/ruff2.4.2/sample.tcl | 410 + src/vfs/punk9magicsplat.vfs/lib/tcl90.lib | Bin 0 -> 166624 bytes src/vfs/punk9magicsplat.vfs/lib/tcl9tk90.lib | Bin 0 -> 131582 bytes .../lib/tcldebugger/appLaunch.tcl | 87 + .../lib/tcldebugger/bindings.tcl | 594 + .../lib/tcldebugger/blend.pdx | 62 + .../lib/tcldebugger/block.tcl | 376 + .../lib/tcldebugger/break.tcl | 299 + .../lib/tcldebugger/breakWin.tcl | 668 + .../lib/tcldebugger/codeWin.tcl | 844 + .../lib/tcldebugger/coverage.tcl | 700 + .../lib/tcldebugger/dbg.tcl | 1771 + .../lib/tcldebugger/debugger.tcl | 415 + .../lib/tcldebugger/evalWin.tcl | 324 + .../lib/tcldebugger/file.tcl | 204 + .../lib/tcldebugger/find.tcl | 758 + .../lib/tcldebugger/font.tcl | 149 + .../lib/tcldebugger/gui.tcl | 2655 + .../lib/tcldebugger/guiUtil.tcl | 1029 + .../lib/tcldebugger/icon.tcl | 646 + .../lib/tcldebugger/image.tcl | 96 + .../lib/tcldebugger/images/about.gif | Bin 0 -> 9209 bytes .../lib/tcldebugger/images/break_d.gif | Bin 0 -> 81 bytes .../lib/tcldebugger/images/break_e.gif | Bin 0 -> 68 bytes .../lib/tcldebugger/images/break_m.gif | Bin 0 -> 81 bytes .../lib/tcldebugger/images/combo_arrow.gif | Bin 0 -> 61 bytes .../lib/tcldebugger/images/current.gif | Bin 0 -> 79 bytes .../lib/tcldebugger/images/current_d.gif | Bin 0 -> 105 bytes .../lib/tcldebugger/images/current_e.gif | Bin 0 -> 89 bytes .../lib/tcldebugger/images/current_m.gif | Bin 0 -> 105 bytes .../lib/tcldebugger/images/current_v.gif | Bin 0 -> 91 bytes .../lib/tcldebugger/images/debugUnixIcon.gif | Bin 0 -> 2564 bytes .../lib/tcldebugger/images/go.gif | Bin 0 -> 87 bytes .../lib/tcldebugger/images/go_d.gif | Bin 0 -> 85 bytes .../lib/tcldebugger/images/history.gif | Bin 0 -> 84 bytes .../tcldebugger/images/history_disable.gif | Bin 0 -> 93 bytes .../lib/tcldebugger/images/history_enable.gif | Bin 0 -> 95 bytes .../lib/tcldebugger/images/history_mixed.gif | Bin 0 -> 107 bytes .../lib/tcldebugger/images/kill.gif | Bin 0 -> 81 bytes .../lib/tcldebugger/images/kill_d.gif | Bin 0 -> 96 bytes .../lib/tcldebugger/images/logo.gif | Bin 0 -> 1762 bytes .../lib/tcldebugger/images/refresh.gif | Bin 0 -> 909 bytes .../lib/tcldebugger/images/refresh_d.gif | Bin 0 -> 914 bytes .../lib/tcldebugger/images/restart.gif | Bin 0 -> 90 bytes .../lib/tcldebugger/images/restart_d.gif | Bin 0 -> 98 bytes .../lib/tcldebugger/images/stepin.gif | Bin 0 -> 100 bytes .../lib/tcldebugger/images/stepin_d.gif | Bin 0 -> 110 bytes .../lib/tcldebugger/images/stepout.gif | Bin 0 -> 106 bytes .../lib/tcldebugger/images/stepout_d.gif | Bin 0 -> 112 bytes .../lib/tcldebugger/images/stepover.gif | Bin 0 -> 103 bytes .../lib/tcldebugger/images/stepover_d.gif | Bin 0 -> 110 bytes .../lib/tcldebugger/images/stepresult.gif | Bin 0 -> 93 bytes .../lib/tcldebugger/images/stepresult_d.gif | Bin 0 -> 100 bytes .../lib/tcldebugger/images/stepto.gif | Bin 0 -> 94 bytes .../lib/tcldebugger/images/stepto_d.gif | Bin 0 -> 103 bytes .../lib/tcldebugger/images/stop.gif | Bin 0 -> 111 bytes .../lib/tcldebugger/images/stop_d.gif | Bin 0 -> 111 bytes .../lib/tcldebugger/images/var_d.gif | Bin 0 -> 83 bytes .../lib/tcldebugger/images/var_e.gif | Bin 0 -> 72 bytes .../lib/tcldebugger/images/win_break.gif | Bin 0 -> 202 bytes .../lib/tcldebugger/images/win_cover.gif | Bin 0 -> 975 bytes .../lib/tcldebugger/images/win_eval.gif | Bin 0 -> 186 bytes .../lib/tcldebugger/images/win_proc.gif | Bin 0 -> 192 bytes .../lib/tcldebugger/images/win_watch.gif | Bin 0 -> 215 bytes .../lib/tcldebugger/initdebug.tcl | 158 + .../lib/tcldebugger/inspectorWin.tcl | 406 + .../lib/tcldebugger/instrument.tcl | 2372 + .../lib/tcldebugger/location.tcl | 128 + .../lib/tcldebugger/menu.tcl | 1062 + .../lib/tcldebugger/nub.tcl | 3440 + .../lib/tcldebugger/oratcl.pdx | 17 + .../lib/tcldebugger/pkgIndex.tcl | 1 + .../lib/tcldebugger/portWin.tcl | 221 + .../lib/tcldebugger/pref.tcl | 709 + .../lib/tcldebugger/prefWin.tcl | 590 + .../lib/tcldebugger/procWin.tcl | 581 + .../lib/tcldebugger/proj.tcl | 1452 + .../lib/tcldebugger/projWin.tcl | 1278 + .../lib/tcldebugger/result.tcl | 81 + .../lib/tcldebugger/selection.tcl | 1081 + .../lib/tcldebugger/stackWin.tcl | 464 + .../lib/tcldebugger/sybtcl.pdx | 20 + .../lib/tcldebugger/system.tcl | 1182 + .../lib/tcldebugger/tabnotebook.tcl | 617 + .../lib/tcldebugger/tclCom.pdx | 20 + .../lib/tcldebugger/tcltest.pdx | 23 + .../lib/tcldebugger/tests/all.tcl | 45 + .../lib/tcldebugger/tests/block.test | 236 + .../lib/tcldebugger/tests/dbgLaunch.tcl | 240 + .../lib/tcldebugger/tests/guiLaunch.tcl | 220 + .../lib/tcldebugger/tests/initProject.tcl | 338 + .../lib/tcldebugger/tests/initdebug.test | 241 + .../lib/tcldebugger/tests/instrument.test | 2810 + .../lib/tcldebugger/tests/pkgIndex.tcl | 11 + .../lib/tcldebugger/tests/pref.test | 684 + .../lib/tcldebugger/tests/protest.tcl | 887 + .../lib/tcldebugger/tests/startup.tcl | 140 + .../lib/tcldebugger/tests/system.test | 103 + .../lib/tcldebugger/tkcon.tcl | 880 + .../lib/tcldebugger/toolbar.tcl | 294 + .../lib/tcldebugger/uplevel.pdx | 51 + .../lib/tcldebugger/util.tcl | 89 + .../lib/tcldebugger/varWin.tcl | 244 + .../lib/tcldebugger/watchWin.tcl | 1816 + .../lib/tcldebugger/widget.tcl | 812 + .../lib/tcldebugger/xmlGen.pdx | 20 + src/vfs/punk9magicsplat.vfs/lib/tclstub.lib | Bin 0 -> 20670 bytes .../punk9magicsplat.vfs/lib/tk9.0/bgerror.tcl | 282 + .../punk9magicsplat.vfs/lib/tk9.0/button.tcl | 782 + .../lib/tk9.0/choosedir.tcl | 310 + .../punk9magicsplat.vfs/lib/tk9.0/clrpick.tcl | 696 + .../punk9magicsplat.vfs/lib/tk9.0/comdlg.tcl | 322 + .../punk9magicsplat.vfs/lib/tk9.0/console.tcl | 1143 + .../lib/tk9.0/demos/README | 44 + .../lib/tk9.0/demos/anilabel.tcl | 168 + .../lib/tk9.0/demos/aniwave.tcl | 107 + .../lib/tk9.0/demos/arrow.tcl | 260 + .../lib/tk9.0/demos/bind.tcl | 78 + .../lib/tk9.0/demos/bitmap.tcl | 52 + .../lib/tk9.0/demos/browse | 66 + .../lib/tk9.0/demos/button.tcl | 47 + .../lib/tk9.0/demos/check.tcl | 71 + .../lib/tk9.0/demos/clrpick.tcl | 54 + .../lib/tk9.0/demos/colors.tcl | 99 + .../lib/tk9.0/demos/combo.tcl | 62 + .../lib/tk9.0/demos/cscroll.tcl | 134 + .../lib/tk9.0/demos/ctext.tcl | 172 + .../lib/tk9.0/demos/dialog1.tcl | 25 + .../lib/tk9.0/demos/dialog2.tcl | 18 + .../lib/tk9.0/demos/en.msg | 103 + .../lib/tk9.0/demos/entry1.tcl | 34 + .../lib/tk9.0/demos/entry2.tcl | 47 + .../lib/tk9.0/demos/entry3.tcl | 185 + .../lib/tk9.0/demos/filebox.tcl | 82 + .../lib/tk9.0/demos/floor.tcl | 1379 + .../lib/tk9.0/demos/fontchoose.tcl | 67 + .../lib/tk9.0/demos/form.tcl | 38 + .../lib/tk9.0/demos/goldberg.tcl | 1970 + .../punk9magicsplat.vfs/lib/tk9.0/demos/hello | 22 + .../lib/tk9.0/demos/hscale.tcl | 49 + .../lib/tk9.0/demos/icon.tcl | 51 + .../lib/tk9.0/demos/image1.tcl | 44 + .../lib/tk9.0/demos/image2.tcl | 114 + .../lib/tk9.0/demos/images/Tcl.svg | 75 + .../lib/tk9.0/demos/images/Tk_feather.png | Bin 0 -> 11700 bytes .../lib/tk9.0/demos/images/earth.gif | Bin 0 -> 51559 bytes .../lib/tk9.0/demos/images/earthmenu.png | Bin 0 -> 8157 bytes .../lib/tk9.0/demos/images/earthris.gif | Bin 0 -> 6343 bytes .../lib/tk9.0/demos/images/flagdown.xbm | 27 + .../lib/tk9.0/demos/images/flagup.xbm | 27 + .../lib/tk9.0/demos/images/gray25.xbm | 6 + .../lib/tk9.0/demos/images/letters.xbm | 27 + .../lib/tk9.0/demos/images/noletter.xbm | 27 + .../lib/tk9.0/demos/images/ouster.png | Bin 0 -> 54257 bytes .../lib/tk9.0/demos/images/pattern.xbm | 6 + .../lib/tk9.0/demos/images/plowed_field.png | Bin 0 -> 68476 bytes .../lib/tk9.0/demos/images/starry_night.png | Bin 0 -> 82214 bytes .../lib/tk9.0/demos/images/tcllogo.gif | Bin 0 -> 2341 bytes .../lib/tk9.0/demos/images/teapot.ppm | 31 + .../lib/tk9.0/demos/items.tcl | 307 + .../punk9magicsplat.vfs/lib/tk9.0/demos/ixset | 328 + .../lib/tk9.0/demos/knightstour.tcl | 274 + .../lib/tk9.0/demos/label.tcl | 47 + .../lib/tk9.0/demos/labelframe.tcl | 76 + .../lib/tk9.0/demos/license.terms | 40 + .../lib/tk9.0/demos/mac_styles.tcl | 266 + .../lib/tk9.0/demos/mac_tabs.tcl | 76 + .../lib/tk9.0/demos/mac_wm.tcl | 227 + .../lib/tk9.0/demos/mclist.tcl | 170 + .../lib/tk9.0/demos/menu.tcl | 184 + .../lib/tk9.0/demos/menubu.tcl | 90 + .../lib/tk9.0/demos/msgbox.tcl | 62 + .../lib/tk9.0/demos/nl.msg | 132 + .../lib/tk9.0/demos/paned1.tcl | 32 + .../lib/tk9.0/demos/paned2.tcl | 74 + .../lib/tk9.0/demos/pendulum.tcl | 206 + .../lib/tk9.0/demos/plot.tcl | 97 + .../lib/tk9.0/demos/print.tcl | 90 + .../lib/tk9.0/demos/puzzle.tcl | 82 + .../lib/tk9.0/demos/radio.tcl | 66 + .../punk9magicsplat.vfs/lib/tk9.0/demos/rmt | 210 + .../lib/tk9.0/demos/rolodex | 204 + .../lib/tk9.0/demos/ruler.tcl | 175 + .../lib/tk9.0/demos/sayings.tcl | 44 + .../lib/tk9.0/demos/search.tcl | 139 + .../lib/tk9.0/demos/spin.tcl | 45 + .../lib/tk9.0/demos/square | 60 + .../lib/tk9.0/demos/states.tcl | 54 + .../lib/tk9.0/demos/style.tcl | 155 + .../lib/tk9.0/demos/systray.tcl | 89 + .../lib/tk9.0/demos/tclIndex | 70 + .../lib/tk9.0/demos/tcolor | 358 + .../lib/tk9.0/demos/text.tcl | 113 + .../lib/tk9.0/demos/textpeer.tcl | 62 + .../punk9magicsplat.vfs/lib/tk9.0/demos/timer | 47 + .../lib/tk9.0/demos/toolbar.tcl | 92 + .../lib/tk9.0/demos/tree.tcl | 89 + .../lib/tk9.0/demos/ttkbut.tcl | 84 + .../lib/tk9.0/demos/ttkmenu.tcl | 53 + .../lib/tk9.0/demos/ttknote.tcl | 57 + .../lib/tk9.0/demos/ttkpane.tcl | 112 + .../lib/tk9.0/demos/ttkprogress.tcl | 46 + .../lib/tk9.0/demos/ttkscale.tcl | 39 + .../lib/tk9.0/demos/ttkspin.tcl | 49 + .../lib/tk9.0/demos/twind.tcl | 358 + .../lib/tk9.0/demos/unicodeout.tcl | 126 + .../lib/tk9.0/demos/vscale.tcl | 50 + .../lib/tk9.0/demos/widget | 713 + .../lib/tk9.0/demos/windowicons.tcl | 108 + .../punk9magicsplat.vfs/lib/tk9.0/dialog.tcl | 175 + .../punk9magicsplat.vfs/lib/tk9.0/entry.tcl | 720 + .../punk9magicsplat.vfs/lib/tk9.0/focus.tcl | 178 + .../lib/tk9.0/fontchooser.tcl | 512 + .../lib/tk9.0/iconbadges.tcl | 253 + .../lib/tk9.0/iconlist.tcl | 705 + .../punk9magicsplat.vfs/lib/tk9.0/icons.tcl | 54 + .../lib/tk9.0/images/README | 7 + .../lib/tk9.0/images/logo.eps | 2091 + .../lib/tk9.0/images/logo100.gif | Bin 0 -> 2341 bytes .../lib/tk9.0/images/logo64.gif | Bin 0 -> 1670 bytes .../lib/tk9.0/images/logoLarge.gif | Bin 0 -> 11000 bytes .../lib/tk9.0/images/logoMed.gif | Bin 0 -> 3889 bytes .../lib/tk9.0/images/pwrdLogo.eps | 1897 + .../lib/tk9.0/images/pwrdLogo100.gif | Bin 0 -> 1615 bytes .../lib/tk9.0/images/pwrdLogo150.gif | Bin 0 -> 2489 bytes .../lib/tk9.0/images/pwrdLogo175.gif | Bin 0 -> 2981 bytes .../lib/tk9.0/images/pwrdLogo200.gif | Bin 0 -> 3491 bytes .../lib/tk9.0/images/pwrdLogo75.gif | Bin 0 -> 1171 bytes .../lib/tk9.0/images/tai-ku.gif | Bin 0 -> 5473 bytes .../lib/tk9.0/license.terms | 40 + .../punk9magicsplat.vfs/lib/tk9.0/listbox.tcl | 523 + .../lib/tk9.0/megawidget.tcl | 297 + .../punk9magicsplat.vfs/lib/tk9.0/menu.tcl | 1372 + .../punk9magicsplat.vfs/lib/tk9.0/mkpsenc.tcl | 1488 + .../punk9magicsplat.vfs/lib/tk9.0/msgbox.tcl | 454 + .../punk9magicsplat.vfs/lib/tk9.0/msgs/cs.msg | 95 + .../punk9magicsplat.vfs/lib/tk9.0/msgs/da.msg | 96 + .../punk9magicsplat.vfs/lib/tk9.0/msgs/de.msg | 109 + .../punk9magicsplat.vfs/lib/tk9.0/msgs/el.msg | 104 + .../punk9magicsplat.vfs/lib/tk9.0/msgs/en.msg | 110 + .../lib/tk9.0/msgs/en_gb.msg | 3 + .../punk9magicsplat.vfs/lib/tk9.0/msgs/eo.msg | 93 + .../punk9magicsplat.vfs/lib/tk9.0/msgs/es.msg | 94 + .../punk9magicsplat.vfs/lib/tk9.0/msgs/fi.msg | 114 + .../punk9magicsplat.vfs/lib/tk9.0/msgs/fr.msg | 90 + .../punk9magicsplat.vfs/lib/tk9.0/msgs/hu.msg | 96 + .../punk9magicsplat.vfs/lib/tk9.0/msgs/it.msg | 91 + .../punk9magicsplat.vfs/lib/tk9.0/msgs/nl.msg | 109 + .../punk9magicsplat.vfs/lib/tk9.0/msgs/pl.msg | 109 + .../punk9magicsplat.vfs/lib/tk9.0/msgs/pt.msg | 92 + .../punk9magicsplat.vfs/lib/tk9.0/msgs/ru.msg | 112 + .../punk9magicsplat.vfs/lib/tk9.0/msgs/sv.msg | 94 + .../lib/tk9.0/msgs/zh_cn.msg | 110 + .../punk9magicsplat.vfs/lib/tk9.0/optMenu.tcl | 43 + .../punk9magicsplat.vfs/lib/tk9.0/palette.tcl | 283 + .../lib/tk9.0/panedwindow.tcl | 194 + .../lib/tk9.0/pkgIndex.tcl | 16 + .../punk9magicsplat.vfs/lib/tk9.0/print.tcl | 1343 + .../punk9magicsplat.vfs/lib/tk9.0/safetk.tcl | 262 + .../punk9magicsplat.vfs/lib/tk9.0/scale.tcl | 299 + .../punk9magicsplat.vfs/lib/tk9.0/scaling.tcl | 232 + .../punk9magicsplat.vfs/lib/tk9.0/scrlbar.tcl | 500 + .../punk9magicsplat.vfs/lib/tk9.0/spinbox.tcl | 580 + .../punk9magicsplat.vfs/lib/tk9.0/systray.tcl | 483 + .../punk9magicsplat.vfs/lib/tk9.0/tclIndex | 252 + .../punk9magicsplat.vfs/lib/tk9.0/tearoff.tcl | 155 + .../punk9magicsplat.vfs/lib/tk9.0/text.tcl | 1295 + src/vfs/punk9magicsplat.vfs/lib/tk9.0/tk.tcl | 851 + .../punk9magicsplat.vfs/lib/tk9.0/tkfbox.tcl | 1251 + .../lib/tk9.0/ttk/altTheme.tcl | 153 + .../lib/tk9.0/ttk/aquaTheme.tcl | 178 + .../lib/tk9.0/ttk/button.tcl | 83 + .../lib/tk9.0/ttk/clamTheme.tcl | 190 + .../lib/tk9.0/ttk/classicTheme.tcl | 145 + .../lib/tk9.0/ttk/combobox.tcl | 555 + .../lib/tk9.0/ttk/cursors.tcl | 205 + .../lib/tk9.0/ttk/defaults.tcl | 231 + .../lib/tk9.0/ttk/entry.tcl | 678 + .../lib/tk9.0/ttk/fonts.tcl | 152 + .../lib/tk9.0/ttk/menubutton.tcl | 237 + .../lib/tk9.0/ttk/notebook.tcl | 255 + .../lib/tk9.0/ttk/panedwindow.tcl | 89 + .../lib/tk9.0/ttk/progress.tcl | 55 + .../lib/tk9.0/ttk/scale.tcl | 94 + .../lib/tk9.0/ttk/scrollbar.tcl | 119 + .../lib/tk9.0/ttk/sizegrip.tcl | 102 + .../lib/tk9.0/ttk/spinbox.tcl | 204 + .../lib/tk9.0/ttk/treeview.tcl | 464 + .../punk9magicsplat.vfs/lib/tk9.0/ttk/ttk.tcl | 223 + .../lib/tk9.0/ttk/utils.tcl | 318 + .../lib/tk9.0/ttk/vistaTheme.tcl | 259 + .../lib/tk9.0/ttk/winTheme.tcl | 119 + .../lib/tk9.0/ttk/xpTheme.tcl | 95 + .../punk9magicsplat.vfs/lib/tk9.0/xmfbox.tcl | 982 + .../lib/tklib0.8/autoscroll/autoscroll.tcl | 238 + .../lib/tklib0.8/autoscroll/pkgIndex.tcl | 13 + .../lib/tklib0.8/canvas/canvas_drag.tcl | 278 + .../lib/tklib0.8/canvas/canvas_ecircle.tcl | 383 + .../lib/tklib0.8/canvas/canvas_epoints.tcl | 453 + .../lib/tklib0.8/canvas/canvas_epolyline.tcl | 660 + .../lib/tklib0.8/canvas/canvas_equad.tcl | 414 + .../lib/tklib0.8/canvas/canvas_erectangle.tcl | 452 + .../lib/tklib0.8/canvas/canvas_gradient.tcl | 278 + .../lib/tklib0.8/canvas/canvas_highlight.tcl | 106 + .../lib/tklib0.8/canvas/canvas_mvg.tcl | 392 + .../lib/tklib0.8/canvas/canvas_pdf.tcl | 51 + .../lib/tklib0.8/canvas/canvas_snap.tcl | 111 + .../lib/tklib0.8/canvas/canvas_sqmap.tcl | 667 + .../lib/tklib0.8/canvas/canvas_tags.tcl | 70 + .../lib/tklib0.8/canvas/canvas_trlines.tcl | 95 + .../lib/tklib0.8/canvas/canvas_zoom.tcl | 181 + .../lib/tklib0.8/canvas/pkgIndex.tcl | 17 + .../lib/tklib0.8/chatwidget/chatwidget.tcl | 777 + .../lib/tklib0.8/chatwidget/pkgIndex.tcl | 1 + .../lib/tklib0.8/controlwidget/bindDown.tcl | 45 + .../tklib0.8/controlwidget/controlwidget.tcl | 17 + .../lib/tklib0.8/controlwidget/led.tcl | 127 + .../lib/tklib0.8/controlwidget/pkgIndex.tcl | 23 + .../tklib0.8/controlwidget/radioMatrix.tcl | 253 + .../lib/tklib0.8/controlwidget/rdial.tcl | 455 + .../lib/tklib0.8/controlwidget/tachometer.tcl | 389 + .../tklib0.8/controlwidget/vertical_meter.tcl | 1458 + .../lib/tklib0.8/controlwidget/voltmeter.tcl | 347 + .../lib/tklib0.8/crosshair/crosshair.tcl | 598 + .../lib/tklib0.8/crosshair/pkgIndex.tcl | 4 + .../lib/tklib0.8/ctext/ctext.tcl | 1113 + .../lib/tklib0.8/ctext/pkgIndex.tcl | 1 + .../lib/tklib0.8/cursor/cursor.tcl | 137 + .../lib/tklib0.8/cursor/pkgIndex.tcl | 1 + .../lib/tklib0.8/datefield/datefield.tcl | 456 + .../lib/tklib0.8/datefield/pkgIndex.tcl | 1 + .../lib/tklib0.8/diagrams/application.tcl | 476 + .../lib/tklib0.8/diagrams/attributes.tcl | 383 + .../lib/tklib0.8/diagrams/basic.tcl | 1279 + .../lib/tklib0.8/diagrams/core.tcl | 1120 + .../lib/tklib0.8/diagrams/diagram.tcl | 62 + .../lib/tklib0.8/diagrams/direction.tcl | 254 + .../lib/tklib0.8/diagrams/element.tcl | 298 + .../lib/tklib0.8/diagrams/navigation.tcl | 138 + .../lib/tklib0.8/diagrams/pkgIndex.tcl | 15 + .../lib/tklib0.8/diagrams/point.tcl | 184 + .../lib/tklib0.8/getstring/pkgIndex.tcl | 13 + .../lib/tklib0.8/getstring/tk_getString.tcl | 124 + .../lib/tklib0.8/history/history.tcl | 119 + .../lib/tklib0.8/history/pkgIndex.tcl | 3 + .../lib/tklib0.8/ico/ico.tcl | 1454 + .../lib/tklib0.8/ico/ico0.tcl | 1183 + .../lib/tklib0.8/ico/pkgIndex.tcl | 7 + .../lib/tklib0.8/ipentry/ipentry.tcl | 977 + .../lib/tklib0.8/ipentry/pkgIndex.tcl | 3 + .../lib/tklib0.8/khim/ROOT.msg | 74 + .../lib/tklib0.8/khim/cs.msg | 108 + .../lib/tklib0.8/khim/da.msg | 104 + .../lib/tklib0.8/khim/de.msg | 123 + .../lib/tklib0.8/khim/en.msg | 114 + .../lib/tklib0.8/khim/es.msg | 108 + .../lib/tklib0.8/khim/khim.tcl | 2025 + .../lib/tklib0.8/khim/pkgIndex.tcl | 1 + .../lib/tklib0.8/khim/pl.msg | 113 + .../lib/tklib0.8/khim/ru.msg | 124 + .../lib/tklib0.8/khim/uk.msg | 117 + .../lib/tklib0.8/map/area-display.tcl | 229 + .../lib/tklib0.8/map/area-file.tcl | 140 + .../lib/tklib0.8/map/area-map-display.tcl | 392 + .../lib/tklib0.8/map/area-store-fs.tcl | 157 + .../lib/tklib0.8/map/area-store-mem.tcl | 184 + .../lib/tklib0.8/map/area-table-display.tcl | 264 + .../lib/tklib0.8/map/box-display.tcl | 120 + .../lib/tklib0.8/map/box-entry.tcl | 242 + .../lib/tklib0.8/map/box-file.tcl | 131 + .../lib/tklib0.8/map/box-map-display.tcl | 390 + .../lib/tklib0.8/map/box-store-fs.tcl | 170 + .../lib/tklib0.8/map/box-store-mem.tcl | 167 + .../lib/tklib0.8/map/box-table-display.tcl | 261 + .../lib/tklib0.8/map/display.tcl | 665 + .../lib/tklib0.8/map/mark.tcl | 140 + .../lib/tklib0.8/map/pkgIndex.tcl | 36 + .../lib/tklib0.8/map/point-file.tcl | 182 + .../lib/tklib0.8/map/point-map-display.tcl | 498 + .../lib/tklib0.8/map/point-store-fs.tcl | 165 + .../lib/tklib0.8/map/point-store-mem.tcl | 284 + .../lib/tklib0.8/map/point-table-display.tcl | 254 + .../lib/tklib0.8/map/provider-osm.tcl | 142 + .../lib/tklib0.8/map/track-display.tcl | 217 + .../lib/tklib0.8/map/track-entry.tcl | 273 + .../lib/tklib0.8/map/track-file.tcl | 140 + .../lib/tklib0.8/map/track-map-display.tcl | 391 + .../lib/tklib0.8/map/track-store-fs.tcl | 157 + .../lib/tklib0.8/map/track-store-mem.tcl | 182 + .../lib/tklib0.8/map/track-table-display.tcl | 264 + .../lib/tklib0.8/mentry/mentry.tcl | 14 + .../lib/tklib0.8/mentry/mentryCommon.tcl | 101 + .../lib/tklib0.8/mentry/mentry_tile.tcl | 24 + .../lib/tklib0.8/mentry/pkgIndex.tcl | 27 + .../mentry/scripts/mentryDateTime.tcl | 912 + .../mentry/scripts/mentryFixedPoint.tcl | 142 + .../tklib0.8/mentry/scripts/mentryIPAddr.tcl | 262 + .../mentry/scripts/mentryIPv6Addr.tcl | 300 + .../tklib0.8/mentry/scripts/mentryThemes.tcl | 784 + .../tklib0.8/mentry/scripts/mentryWidget.tcl | 2411 + .../tklib0.8/mentry/scripts/mwutil/mwutil.tcl | 742 + .../mentry/scripts/mwutil/pkgIndex.tcl | 7 + .../lib/tklib0.8/mentry/scripts/tclIndex | 118 + .../lib/tklib0.8/menubar/debug.tcl | 226 + .../lib/tklib0.8/menubar/menubar.tcl | 1920 + .../lib/tklib0.8/menubar/node.tcl | 161 + .../lib/tklib0.8/menubar/pkgIndex.tcl | 4 + .../lib/tklib0.8/menubar/tree.tcl | 1101 + .../tklib0.8/notifywindow/notifywindow.tcl | 96 + .../lib/tklib0.8/notifywindow/pkgIndex.tcl | 1 + .../lib/tklib0.8/ntext/ntext.tcl | 3694 + .../lib/tklib0.8/ntext/pkgIndex.tcl | 2 + .../persistentSelection.tcl | 907 + .../tklib0.8/persistentSelection/pkgIndex.tcl | 2 + .../lib/tklib0.8/pkgIndex.tcl | 48 + .../lib/tklib0.8/plotchart/pkgIndex.tcl | 7 + .../lib/tklib0.8/plotchart/plot3d.tcl | 431 + .../lib/tklib0.8/plotchart/plotanim.tcl | 607 + .../lib/tklib0.8/plotchart/plotannot.tcl | 450 + .../lib/tklib0.8/plotchart/plotaxis.tcl | 2211 + .../lib/tklib0.8/plotchart/plotbind.tcl | 263 + .../lib/tklib0.8/plotchart/plotbusiness.tcl | 386 + .../lib/tklib0.8/plotchart/plotchart.tcl | 3482 + .../lib/tklib0.8/plotchart/plotcombined.tcl | 189 + .../lib/tklib0.8/plotchart/plotconfig.tcl | 443 + .../lib/tklib0.8/plotchart/plotcontour.tcl | 1861 + .../lib/tklib0.8/plotchart/plotdendrogram.tcl | 255 + .../lib/tklib0.8/plotchart/plotgantt.tcl | 345 + .../lib/tklib0.8/plotchart/plotobject.tcl | 274 + .../lib/tklib0.8/plotchart/plotpack.tcl | 377 + .../lib/tklib0.8/plotchart/plotpriv.tcl | 4750 + .../lib/tklib0.8/plotchart/plotscada.tcl | 274 + .../lib/tklib0.8/plotchart/plotspecial.tcl | 624 + .../tklib0.8/plotchart/plotstatustimeline.tcl | 228 + .../lib/tklib0.8/plotchart/plottable.tcl | 327 + .../lib/tklib0.8/plotchart/scaling.tcl | 200 + .../lib/tklib0.8/plotchart/xyplot.tcl | 579 + .../lib/tklib0.8/scrollutil/pkgIndex.tcl | 27 + .../tklib0.8/scrollutil/scripts/attrib.tcl | 78 + .../scrollutil/scripts/notebookImages.tcl | 652 + .../tklib0.8/scrollutil/scripts/pagesman.tcl | 844 + .../scrollutil/scripts/plainnotebook.tcl | 1905 + .../scrollutil/scripts/scrollableframe.tcl | 1216 + .../scrollutil/scripts/scrollarea.tcl | 1238 + .../scrollutil/scripts/scrollednotebook.tcl | 1996 + .../scrollutil/scripts/scrollsync.tcl | 620 + .../lib/tklib0.8/scrollutil/scripts/tclIndex | 211 + .../utils/indicatorImgs/gifIndicatorImgs.tcl | 1641 + .../utils/indicatorImgs/svgIndicatorImgs.tcl | 373 + .../scripts/utils/indicatorImgs/tclIndex | 20 + .../scrollutil/scripts/utils/mwutil.tcl | 742 + .../scrollutil/scripts/utils/pkgIndex.tcl | 9 + .../scrollutil/scripts/utils/scaleutil.tcl | 834 + .../scrollutil/scripts/utils/themepatch.tcl | 392 + .../scrollutil/scripts/wheelEvent.tcl | 995 + .../lib/tklib0.8/scrollutil/scrollutil.tcl | 19 + .../tklib0.8/scrollutil/scrollutilCommon.tcl | 99 + .../tklib0.8/scrollutil/scrollutil_tile.tcl | 36 + .../lib/tklib0.8/shtmlview/pkgIndex.tcl | 3 + .../tklib0.8/shtmlview/shtmlview-doctools.tcl | 46 + .../tklib0.8/shtmlview/shtmlview-mkdoc.tcl | 47 + .../lib/tklib0.8/shtmlview/shtmlview.tcl | 3560 + .../lib/tklib0.8/style/as.tcl | 514 + .../lib/tklib0.8/style/lobster.tcl | 90 + .../lib/tklib0.8/style/pkgIndex.tcl | 13 + .../lib/tklib0.8/style/style.tcl | 33 + .../lib/tklib0.8/swaplist/pkgIndex.tcl | 13 + .../lib/tklib0.8/swaplist/swaplist.tcl | 386 + .../lib/tklib0.8/tablelist/pkgIndex.tcl | 27 + .../lib/tklib0.8/tablelist/scripts/pencil.cur | Bin 0 -> 4286 bytes .../tablelist/scripts/tablelistBind.tcl | 4739 + .../tablelist/scripts/tablelistConfig.tcl | 4315 + .../tablelist/scripts/tablelistEdit.tcl | 3336 + .../tablelist/scripts/tablelistImages.tcl | 3975 + .../tablelist/scripts/tablelistMove.tcl | 586 + .../tablelist/scripts/tablelistSort.tcl | 764 + .../tablelist/scripts/tablelistThemes.tcl | 2233 + .../tablelist/scripts/tablelistUtil.tcl | 7002 ++ .../tablelist/scripts/tablelistWidget.tcl | 9437 ++ .../lib/tklib0.8/tablelist/scripts/tclIndex | 691 + .../utils/indicatorImgs/gifIndicatorImgs.tcl | 1641 + .../utils/indicatorImgs/svgIndicatorImgs.tcl | 373 + .../scripts/utils/indicatorImgs/tclIndex | 20 + .../tablelist/scripts/utils/mwutil.tcl | 742 + .../tablelist/scripts/utils/pkgIndex.tcl | 11 + .../tablelist/scripts/utils/scaleutil.tcl | 834 + .../tablelist/scripts/utils/scaleutilMisc.tcl | 670 + .../tablelist/scripts/utils/themepatch.tcl | 392 + .../lib/tklib0.8/tablelist/tablelist.tcl | 14 + .../tklib0.8/tablelist/tablelistCommon.tcl | 108 + .../lib/tklib0.8/tablelist/tablelist_tile.tcl | 24 + .../lib/tklib0.8/text/pkgIndex.tcl | 1 + .../lib/tklib0.8/text/txmixins.tcl | 1382 + .../lib/tklib0.8/tkpiechart/boxlabel.tcl | 141 + .../lib/tklib0.8/tkpiechart/canlabel.tcl | 206 + .../lib/tklib0.8/tkpiechart/labarray.tcl | 103 + .../lib/tklib0.8/tkpiechart/objselec.tcl | 37 + .../lib/tklib0.8/tkpiechart/perilabel.tcl | 222 + .../lib/tklib0.8/tkpiechart/pie.tcl | 391 + .../lib/tklib0.8/tkpiechart/pielabel.tcl | 41 + .../lib/tklib0.8/tkpiechart/pkgIndex.tcl | 3 + .../lib/tklib0.8/tkpiechart/relirect.tcl | 112 + .../lib/tklib0.8/tkpiechart/selector.tcl | 166 + .../lib/tklib0.8/tkpiechart/slice.tcl | 312 + .../lib/tklib0.8/tkpiechart/tkpiechart.tcl | 15 + .../lib/tklib0.8/tooltip/pkgIndex.tcl | 4 + .../lib/tklib0.8/tooltip/tipstack.tcl | 166 + .../lib/tklib0.8/tooltip/tooltip.tcl | 778 + .../lib/tklib0.8/treeview/pkgIndex.tcl | 1 + .../lib/tklib0.8/treeview/tvmixins.tcl | 1411 + .../lib/tklib0.8/wcb/pkgIndex.tcl | 15 + .../lib/tklib0.8/wcb/scripts/tclIndex | 47 + .../lib/tklib0.8/wcb/scripts/wcbCommon.tcl | 492 + .../lib/tklib0.8/wcb/scripts/wcbEntry.tcl | 333 + .../lib/tklib0.8/wcb/scripts/wcbListbox.tcl | 70 + .../lib/tklib0.8/wcb/scripts/wcbTablelist.tcl | 104 + .../lib/tklib0.8/wcb/scripts/wcbText.tcl | 207 + .../lib/tklib0.8/wcb/scripts/wcbTreeview.tcl | 131 + .../lib/tklib0.8/wcb/wcb.tcl | 58 + .../lib/tklib0.8/widget/arrowb.tcl | 126 + .../lib/tklib0.8/widget/calendar.tcl | 700 + .../lib/tklib0.8/widget/dateentry.tcl | 382 + .../lib/tklib0.8/widget/dialog.tcl | 471 + .../lib/tklib0.8/widget/mentry.tcl | 297 + .../lib/tklib0.8/widget/panelframe.tcl | 244 + .../lib/tklib0.8/widget/pkgIndex.tcl | 15 + .../lib/tklib0.8/widget/ruler.tcl | 645 + .../lib/tklib0.8/widget/scrollw.tcl | 258 + .../lib/tklib0.8/widget/statusbar.tcl | 287 + .../lib/tklib0.8/widget/stext.tcl | 77 + .../lib/tklib0.8/widget/superframe.tcl | 140 + .../lib/tklib0.8/widget/toolbar.tcl | 296 + .../lib/tklib0.8/widget/widget.tcl | 162 + .../lib/tklib0.8/widgetPlus/pkgIndex.tcl | 2 + .../lib/tklib0.8/widgetPlus/widgetPlus.tcl | 1677 + .../lib/tklib0.8/widgetl/icons/add.png | Bin 0 -> 733 bytes .../lib/tklib0.8/widgetl/icons/arrow_down.png | Bin 0 -> 379 bytes .../lib/tklib0.8/widgetl/icons/arrow_up.png | Bin 0 -> 372 bytes .../lib/tklib0.8/widgetl/icons/delete.png | Bin 0 -> 715 bytes .../tklib0.8/widgetl/icons/folder_explore.png | Bin 0 -> 679 bytes .../lib/tklib0.8/widgetl/listentry.tcl | 1192 + .../lib/tklib0.8/widgetl/listsimple.tcl | 676 + .../lib/tklib0.8/widgetl/msgs/de.msg | 20 + .../lib/tklib0.8/widgetl/msgs/en.msg | 20 + .../lib/tklib0.8/widgetl/msgs/root.msg | 20 + .../lib/tklib0.8/widgetl/pkgIndex.tcl | 3 + .../lib/tklib0.8/widgetv/pkgIndex.tcl | 2 + .../lib/tklib0.8/widgetv/validator.tcl | 422 + src/vfs/punk9magicsplat.vfs/lib/tkstub.lib | Bin 0 -> 8220 bytes src/vfs/punk9magicsplat.vfs/lib/tommath.lib | Bin 0 -> 29386 bytes src/vfs/punk9magicsplat.vfs/lib/zdll.lib | Bin 0 -> 17370 bytes .../lib_tcl9/Img2.0.0/jpegtclstub.lib | Bin 0 -> 1776 bytes .../lib_tcl9/Img2.0.0/pkgIndex.tcl | 76 + .../lib_tcl9/Img2.0.0/pngtclstub.lib | Bin 0 -> 1758 bytes .../lib_tcl9/Img2.0.0/tcl9jpegtcl960.dll | Bin 0 -> 291840 bytes .../lib_tcl9/Img2.0.0/tcl9pngtcl1644.dll | Bin 0 -> 189440 bytes .../lib_tcl9/Img2.0.0/tcl9tifftcl470.dll | Bin 0 -> 418816 bytes .../lib_tcl9/Img2.0.0/tcl9tkimg200.dll | Bin 0 -> 48128 bytes .../lib_tcl9/Img2.0.0/tcl9tkimgbmp200.dll | Bin 0 -> 24576 bytes .../lib_tcl9/Img2.0.0/tcl9tkimgdted200.dll | Bin 0 -> 20480 bytes .../lib_tcl9/Img2.0.0/tcl9tkimgflir200.dll | Bin 0 -> 20480 bytes .../lib_tcl9/Img2.0.0/tcl9tkimggif200.dll | Bin 0 -> 24064 bytes .../lib_tcl9/Img2.0.0/tcl9tkimgico200.dll | Bin 0 -> 25088 bytes .../lib_tcl9/Img2.0.0/tcl9tkimgjpeg200.dll | Bin 0 -> 23040 bytes .../lib_tcl9/Img2.0.0/tcl9tkimgpcx200.dll | Bin 0 -> 24064 bytes .../lib_tcl9/Img2.0.0/tcl9tkimgpixmap200.dll | Bin 0 -> 23552 bytes .../lib_tcl9/Img2.0.0/tcl9tkimgpng200.dll | Bin 0 -> 24064 bytes .../lib_tcl9/Img2.0.0/tcl9tkimgppm200.dll | Bin 0 -> 25088 bytes .../lib_tcl9/Img2.0.0/tcl9tkimgps200.dll | Bin 0 -> 20992 bytes .../lib_tcl9/Img2.0.0/tcl9tkimgraw200.dll | Bin 0 -> 28160 bytes .../lib_tcl9/Img2.0.0/tcl9tkimgsgi200.dll | Bin 0 -> 28160 bytes .../lib_tcl9/Img2.0.0/tcl9tkimgsun200.dll | Bin 0 -> 23552 bytes .../lib_tcl9/Img2.0.0/tcl9tkimgtga200.dll | Bin 0 -> 22528 bytes .../lib_tcl9/Img2.0.0/tcl9tkimgtiff200.dll | Bin 0 -> 64512 bytes .../lib_tcl9/Img2.0.0/tcl9tkimgwindow200.dll | Bin 0 -> 14848 bytes .../lib_tcl9/Img2.0.0/tcl9tkimgxbm200.dll | Bin 0 -> 18944 bytes .../lib_tcl9/Img2.0.0/tcl9tkimgxpm200.dll | Bin 0 -> 23040 bytes .../lib_tcl9/Img2.0.0/tcl9zlibtcl131.dll | Bin 0 -> 83456 bytes .../lib_tcl9/Img2.0.0/tifftclstub.lib | Bin 0 -> 1774 bytes .../lib_tcl9/Img2.0.0/tkimgstub.lib | Bin 0 -> 1736 bytes .../lib_tcl9/Img2.0.0/zlibtclstub.lib | Bin 0 -> 1768 bytes .../lib_tcl9/cffi2.0b1/LICENSE | 25 + .../lib_tcl9/cffi2.0b1/pkgIndex.tcl | 32 + .../cffi2.0b1/win32-x86_64/tcl9cffi20b1.dll | Bin 0 -> 194048 bytes .../lib_tcl9/dde1.4/pkgIndex.tcl | 12 + .../lib_tcl9/dde1.4/tcl9dde14.dll | Bin 0 -> 25600 bytes .../lib_tcl9/iocp2.0b1/LICENSE | 25 + .../lib_tcl9/iocp2.0b1/bt.tcl | 690 + .../lib_tcl9/iocp2.0b1/btnames.tcl | 383 + .../lib_tcl9/iocp2.0b1/btsdr.tcl | 962 + .../lib_tcl9/iocp2.0b1/pkgIndex.tcl | 36 + .../iocp2.0b1/win32-x86_64/tcl9iocp20b1.dll | Bin 0 -> 67072 bytes .../lib_tcl9/itcl4.3.1/itcl.tcl | 151 + .../lib_tcl9/itcl4.3.1/itclHullCmds.tcl | 562 + .../lib_tcl9/itcl4.3.1/itclWidget.tcl | 447 + .../lib_tcl9/itcl4.3.1/itclstub.lib | Bin 0 -> 3670 bytes .../lib_tcl9/itcl4.3.1/pkgIndex.tcl | 14 + .../lib_tcl9/itcl4.3.1/tcl9itcl431.dll | Bin 0 -> 290304 bytes .../itcl4.3.1/test_Itcl_CreateObject.tcl | 26 + .../lib_tcl9/registry1.3/pkgIndex.tcl | 9 + .../lib_tcl9/registry1.3/tcl9registry13.dll | Bin 0 -> 22016 bytes .../lib_tcl9/sqlite3.45.3/pkgIndex.tcl | 5 + .../lib_tcl9/sqlite3.45.3/sqlite3.n | 15 + .../lib_tcl9/sqlite3.45.3/tcl9sqlite3453.dll | Bin 0 -> 1571840 bytes .../lib_tcl9/tclcsv2.4.3/LICENSE | 29 + .../lib_tcl9/tclcsv2.4.3/README.md | 20 + .../lib_tcl9/tclcsv2.4.3/csv.tcl | 366 + .../lib_tcl9/tclcsv2.4.3/pkgIndex.tcl | 32 + .../lib_tcl9/tclcsv2.4.3/widgets.tcl | 890 + .../win32-x86_64/tcl9tclcsv243.dll | Bin 0 -> 33280 bytes .../tcllib2.0/0compatibility/pkgIndex.tcl | 8 + .../lib_tcl9/tcllib2.0/aes/aes.tcl | 625 + .../lib_tcl9/tcllib2.0/aes/pkgIndex.tcl | 5 + .../lib_tcl9/tcllib2.0/amazon-s3/S3.tcl | 1960 + .../lib_tcl9/tcllib2.0/amazon-s3/pkgIndex.tcl | 9 + .../lib_tcl9/tcllib2.0/amazon-s3/xsxp.tcl | 254 + .../lib_tcl9/tcllib2.0/asn/asn.tcl | 1580 + .../lib_tcl9/tcllib2.0/asn/pkgIndex.tcl | 4 + .../lib_tcl9/tcllib2.0/base32/base32.tcl | 180 + .../lib_tcl9/tcllib2.0/base32/base32_c.tcl | 254 + .../lib_tcl9/tcllib2.0/base32/base32_tcl.tcl | 73 + .../lib_tcl9/tcllib2.0/base32/base32core.tcl | 134 + .../lib_tcl9/tcllib2.0/base32/base32hex.tcl | 182 + .../lib_tcl9/tcllib2.0/base32/base32hex_c.tcl | 254 + .../tcllib2.0/base32/base32hex_tcl.tcl | 79 + .../lib_tcl9/tcllib2.0/base32/pkgIndex.tcl | 4 + .../lib_tcl9/tcllib2.0/base64/ascii85.tcl | 270 + .../lib_tcl9/tcllib2.0/base64/base64.tcl | 411 + .../lib_tcl9/tcllib2.0/base64/base64c.tcl | 19 + .../lib_tcl9/tcllib2.0/base64/pkgIndex.tcl | 5 + .../lib_tcl9/tcllib2.0/base64/uuencode.tcl | 337 + .../lib_tcl9/tcllib2.0/base64/yencode.tcl | 309 + .../lib_tcl9/tcllib2.0/bee/bee.tcl | 999 + .../lib_tcl9/tcllib2.0/bee/pkgIndex.tcl | 4 + .../lib_tcl9/tcllib2.0/bench/bench.tcl | 556 + .../lib_tcl9/tcllib2.0/bench/bench_read.tcl | 162 + .../lib_tcl9/tcllib2.0/bench/bench_wcsv.tcl | 101 + .../lib_tcl9/tcllib2.0/bench/bench_wtext.tcl | 165 + .../lib_tcl9/tcllib2.0/bench/libbench.tcl | 561 + .../lib_tcl9/tcllib2.0/bench/pkgIndex.tcl | 7 + .../lib_tcl9/tcllib2.0/bibtex/bibtex.tcl | 501 + .../lib_tcl9/tcllib2.0/bibtex/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/blowfish/blowfish.tcl | 755 + .../lib_tcl9/tcllib2.0/blowfish/pkgIndex.tcl | 5 + .../lib_tcl9/tcllib2.0/cache/async.tcl | 185 + .../lib_tcl9/tcllib2.0/cache/pkgIndex.tcl | 3 + .../lib_tcl9/tcllib2.0/clay/clay.tcl | 2227 + .../lib_tcl9/tcllib2.0/clay/pkgIndex.tcl | 3 + .../lib_tcl9/tcllib2.0/clock/iso8601.tcl | 280 + .../lib_tcl9/tcllib2.0/clock/pkgIndex.tcl | 3 + .../lib_tcl9/tcllib2.0/clock/rfc2822.tcl | 214 + .../lib_tcl9/tcllib2.0/cmdline/cmdline.tcl | 933 + .../lib_tcl9/tcllib2.0/cmdline/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/comm/comm.tcl | 1806 + .../lib_tcl9/tcllib2.0/comm/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/control/ascaller.tcl | 72 + .../lib_tcl9/tcllib2.0/control/assert.tcl | 91 + .../lib_tcl9/tcllib2.0/control/control.tcl | 24 + .../lib_tcl9/tcllib2.0/control/do.tcl | 81 + .../lib_tcl9/tcllib2.0/control/no-op.tcl | 14 + .../lib_tcl9/tcllib2.0/control/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/control/tclIndex | 18 + .../tcllib2.0/coroutine/coro_auto.tcl | 403 + .../tcllib2.0/coroutine/coroutine.tcl | 495 + .../lib_tcl9/tcllib2.0/coroutine/pkgIndex.tcl | 5 + .../lib_tcl9/tcllib2.0/counter/counter.tcl | 1263 + .../lib_tcl9/tcllib2.0/counter/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/crc/cksum.tcl | 200 + .../lib_tcl9/tcllib2.0/crc/crc16.tcl | 606 + .../lib_tcl9/tcllib2.0/crc/crc32.tcl | 336 + .../lib_tcl9/tcllib2.0/crc/crc32c.tcl | 87 + .../lib_tcl9/tcllib2.0/crc/pkgIndex.tcl | 5 + .../lib_tcl9/tcllib2.0/crc/sum.tcl | 223 + .../lib_tcl9/tcllib2.0/crc/sumc.tcl | 84 + .../lib_tcl9/tcllib2.0/cron/cron.tcl | 620 + .../lib_tcl9/tcllib2.0/cron/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/csv/csv.tcl | 787 + .../lib_tcl9/tcllib2.0/csv/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/debug/caller.tcl | 97 + .../lib_tcl9/tcllib2.0/debug/debug.tcl | 306 + .../lib_tcl9/tcllib2.0/debug/heartbeat.tcl | 68 + .../lib_tcl9/tcllib2.0/debug/pkgIndex.tcl | 5 + .../lib_tcl9/tcllib2.0/debug/timestamp.tcl | 47 + .../lib_tcl9/tcllib2.0/defer/defer.tcl | 120 + .../lib_tcl9/tcllib2.0/defer/pkgIndex.tcl | 5 + .../lib_tcl9/tcllib2.0/des/des.tcl | 272 + .../lib_tcl9/tcllib2.0/des/pkgIndex.tcl | 7 + .../lib_tcl9/tcllib2.0/des/tcldes.tcl | 1089 + .../lib_tcl9/tcllib2.0/des/tcldesjr.tcl | 1055 + .../lib_tcl9/tcllib2.0/dicttool/dicttool.tcl | 155 + .../lib_tcl9/tcllib2.0/dicttool/pkgIndex.tcl | 1 + .../lib_tcl9/tcllib2.0/dns/dns.tcl | 1526 + .../lib_tcl9/tcllib2.0/dns/ip.tcl | 558 + .../lib_tcl9/tcllib2.0/dns/ipMore.tcl | 1279 + .../lib_tcl9/tcllib2.0/dns/ipMoreC.tcl | 243 + .../lib_tcl9/tcllib2.0/dns/msgs/en.msg | 8 + .../lib_tcl9/tcllib2.0/dns/pkgIndex.tcl | 7 + .../lib_tcl9/tcllib2.0/dns/resolv.tcl | 249 + .../lib_tcl9/tcllib2.0/dns/spf.tcl | 528 + .../lib_tcl9/tcllib2.0/docstrip/docstrip.tcl | 163 + .../tcllib2.0/docstrip/docstrip_util.tcl | 653 + .../lib_tcl9/tcllib2.0/docstrip/pkgIndex.tcl | 21 + .../lib_tcl9/tcllib2.0/doctools/api.tcl | 31 + .../lib_tcl9/tcllib2.0/doctools/api_idx.tcl | 26 + .../lib_tcl9/tcllib2.0/doctools/api_toc.tcl | 26 + .../lib_tcl9/tcllib2.0/doctools/changelog.tcl | 278 + .../lib_tcl9/tcllib2.0/doctools/checker.tcl | 734 + .../tcllib2.0/doctools/checker_idx.tcl | 207 + .../tcllib2.0/doctools/checker_toc.tcl | 214 + .../lib_tcl9/tcllib2.0/doctools/cvs.tcl | 134 + .../lib_tcl9/tcllib2.0/doctools/docidx.tcl | 961 + .../lib_tcl9/tcllib2.0/doctools/doctoc.tcl | 967 + .../lib_tcl9/tcllib2.0/doctools/doctools.tcl | 1362 + .../tcllib2.0/doctools/mpformats/_common.tcl | 316 + .../tcllib2.0/doctools/mpformats/_html.tcl | 199 + .../doctools/mpformats/_idx_common.tcl | 31 + .../doctools/mpformats/_markdown.tcl | 216 + .../tcllib2.0/doctools/mpformats/_nroff.tcl | 182 + .../tcllib2.0/doctools/mpformats/_text.tcl | 184 + .../doctools/mpformats/_text_bullets.tcl | 30 + .../doctools/mpformats/_text_ccore.tcl | 141 + .../doctools/mpformats/_text_cstack.tcl | 31 + .../doctools/mpformats/_text_dlist.tcl | 278 + .../doctools/mpformats/_text_margin.tcl | 21 + .../doctools/mpformats/_text_para.tcl | 65 + .../doctools/mpformats/_text_state.tcl | 22 + .../doctools/mpformats/_text_utils.tcl | 60 + .../doctools/mpformats/_toc_common.tcl | 31 + .../tcllib2.0/doctools/mpformats/_xml.tcl | 233 + .../tcllib2.0/doctools/mpformats/_xref.tcl | 129 + .../tcllib2.0/doctools/mpformats/c.msg | 58 + .../tcllib2.0/doctools/mpformats/de.msg | 54 + .../tcllib2.0/doctools/mpformats/en.msg | 54 + .../tcllib2.0/doctools/mpformats/fmt.desc | 49 + .../tcllib2.0/doctools/mpformats/fmt.html | 644 + .../tcllib2.0/doctools/mpformats/fmt.latex | 427 + .../tcllib2.0/doctools/mpformats/fmt.list | 52 + .../tcllib2.0/doctools/mpformats/fmt.markdown | 529 + .../tcllib2.0/doctools/mpformats/fmt.nroff | 308 + .../tcllib2.0/doctools/mpformats/fmt.null | 30 + .../tcllib2.0/doctools/mpformats/fmt.text | 565 + .../tcllib2.0/doctools/mpformats/fmt.tmml | 309 + .../tcllib2.0/doctools/mpformats/fmt.wiki | 305 + .../tcllib2.0/doctools/mpformats/fr.msg | 34 + .../tcllib2.0/doctools/mpformats/idx.html | 333 + .../tcllib2.0/doctools/mpformats/idx.markdown | 219 + .../tcllib2.0/doctools/mpformats/idx.nroff | 101 + .../tcllib2.0/doctools/mpformats/idx.null | 23 + .../tcllib2.0/doctools/mpformats/idx.text | 77 + .../tcllib2.0/doctools/mpformats/idx.wiki | 63 + .../tcllib2.0/doctools/mpformats/man.macros | 267 + .../tcllib2.0/doctools/mpformats/toc.html | 198 + .../tcllib2.0/doctools/mpformats/toc.markdown | 75 + .../tcllib2.0/doctools/mpformats/toc.nroff | 70 + .../tcllib2.0/doctools/mpformats/toc.null | 23 + .../tcllib2.0/doctools/mpformats/toc.text | 106 + .../tcllib2.0/doctools/mpformats/toc.tmml | 34 + .../tcllib2.0/doctools/mpformats/toc.wiki | 63 + .../lib_tcl9/tcllib2.0/doctools/pkgIndex.tcl | 6 + .../lib_tcl9/tcllib2.0/doctools2base/html.tcl | 209 + .../doctools2base/html_cssdefaults.tcl | 158 + .../tcllib2.0/doctools2base/msgcat.tcl | 59 + .../doctools2base/nroff_manmacros.tcl | 261 + .../tcllib2.0/doctools2base/pkgIndex.tcl | 17 + .../tcllib2.0/doctools2base/tcl_parse.tcl | 800 + .../lib_tcl9/tcllib2.0/doctools2base/text.tcl | 216 + .../tcllib2.0/doctools2idx/container.tcl | 405 + .../tcllib2.0/doctools2idx/export.tcl | 123 + .../tcllib2.0/doctools2idx/export_docidx.tcl | 210 + .../tcllib2.0/doctools2idx/export_html.tcl | 421 + .../tcllib2.0/doctools2idx/export_json.tcl | 214 + .../tcllib2.0/doctools2idx/export_nroff.tcl | 213 + .../tcllib2.0/doctools2idx/export_text.tcl | 136 + .../tcllib2.0/doctools2idx/export_wiki.tcl | 163 + .../tcllib2.0/doctools2idx/import.tcl | 189 + .../tcllib2.0/doctools2idx/import_docidx.tcl | 91 + .../tcllib2.0/doctools2idx/import_json.tcl | 78 + .../tcllib2.0/doctools2idx/msgcat_c.tcl | 26 + .../tcllib2.0/doctools2idx/msgcat_de.tcl | 26 + .../tcllib2.0/doctools2idx/msgcat_en.tcl | 26 + .../tcllib2.0/doctools2idx/msgcat_fr.tcl | 29 + .../lib_tcl9/tcllib2.0/doctools2idx/parse.tcl | 1043 + .../tcllib2.0/doctools2idx/pkgIndex.tcl | 33 + .../tcllib2.0/doctools2idx/structure.tcl | 288 + .../tcllib2.0/doctools2toc/container.tcl | 545 + .../tcllib2.0/doctools2toc/export.tcl | 123 + .../tcllib2.0/doctools2toc/export_doctoc.tcl | 217 + .../tcllib2.0/doctools2toc/export_html.tcl | 323 + .../tcllib2.0/doctools2toc/export_json.tcl | 223 + .../tcllib2.0/doctools2toc/export_nroff.tcl | 218 + .../tcllib2.0/doctools2toc/export_text.tcl | 142 + .../tcllib2.0/doctools2toc/export_wiki.tcl | 144 + .../tcllib2.0/doctools2toc/import.tcl | 189 + .../tcllib2.0/doctools2toc/import_doctoc.tcl | 91 + .../tcllib2.0/doctools2toc/import_json.tcl | 77 + .../tcllib2.0/doctools2toc/msgcat_c.tcl | 28 + .../tcllib2.0/doctools2toc/msgcat_de.tcl | 28 + .../tcllib2.0/doctools2toc/msgcat_en.tcl | 28 + .../tcllib2.0/doctools2toc/msgcat_fr.tcl | 31 + .../lib_tcl9/tcllib2.0/doctools2toc/parse.tcl | 1058 + .../tcllib2.0/doctools2toc/pkgIndex.tcl | 33 + .../tcllib2.0/doctools2toc/structure.tcl | 388 + .../lib_tcl9/tcllib2.0/dtplite/dtplite.tcl | 1785 + .../lib_tcl9/tcllib2.0/dtplite/pkgIndex.tcl | 5 + .../lib_tcl9/tcllib2.0/fileutil/decode.tcl | 203 + .../lib_tcl9/tcllib2.0/fileutil/fileutil.tcl | 2125 + .../lib_tcl9/tcllib2.0/fileutil/multi.tcl | 28 + .../lib_tcl9/tcllib2.0/fileutil/multiop.tcl | 646 + .../lib_tcl9/tcllib2.0/fileutil/paths.tcl | 74 + .../lib_tcl9/tcllib2.0/fileutil/pkgIndex.tcl | 7 + .../lib_tcl9/tcllib2.0/fileutil/traverse.tcl | 393 + .../lib_tcl9/tcllib2.0/ftp/ftp.tcl | 3159 + .../lib_tcl9/tcllib2.0/ftp/ftp_geturl.tcl | 135 + .../lib_tcl9/tcllib2.0/ftp/pkgIndex.tcl | 3 + .../lib_tcl9/tcllib2.0/ftpd/ftpd.tcl | 2064 + .../lib_tcl9/tcllib2.0/ftpd/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/fumagic/cfront.tcl | 932 + .../lib_tcl9/tcllib2.0/fumagic/cgen.tcl | 705 + .../lib_tcl9/tcllib2.0/fumagic/filetypes.tcl | 85040 ++++++++++++++++ .../lib_tcl9/tcllib2.0/fumagic/pkgIndex.tcl | 14 + .../lib_tcl9/tcllib2.0/fumagic/rtcore.tcl | 1019 + .../tcllib2.0/generator/generator.tcl | 381 + .../lib_tcl9/tcllib2.0/generator/pkgIndex.tcl | 3 + .../lib_tcl9/tcllib2.0/gpx/gpx.tcl | 294 + .../lib_tcl9/tcllib2.0/gpx/pkgIndex.tcl | 2 + .../tcllib2.0/grammar_aycock/aycock-build.tcl | 735 + .../tcllib2.0/grammar_aycock/aycock-debug.tcl | 189 + .../grammar_aycock/aycock-runtime.tcl | 425 + .../tcllib2.0/grammar_aycock/pkgIndex.tcl | 8 + .../tcllib2.0/grammar_fa/dacceptor.tcl | 166 + .../lib_tcl9/tcllib2.0/grammar_fa/dexec.tcl | 188 + .../lib_tcl9/tcllib2.0/grammar_fa/fa.tcl | 1242 + .../lib_tcl9/tcllib2.0/grammar_fa/faop.tcl | 1618 + .../tcllib2.0/grammar_fa/pkgIndex.tcl | 6 + .../lib_tcl9/tcllib2.0/grammar_me/gasm.tcl | 207 + .../lib_tcl9/tcllib2.0/grammar_me/me_cpu.tcl | 103 + .../tcllib2.0/grammar_me/me_cpucore.tcl | 1162 + .../lib_tcl9/tcllib2.0/grammar_me/me_tcl.tcl | 521 + .../lib_tcl9/tcllib2.0/grammar_me/me_util.tcl | 191 + .../tcllib2.0/grammar_me/pkgIndex.tcl | 7 + .../lib_tcl9/tcllib2.0/grammar_peg/peg.tcl | 541 + .../tcllib2.0/grammar_peg/peg_interp.tcl | 350 + .../tcllib2.0/grammar_peg/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/hook/hook.tcl | 358 + .../lib_tcl9/tcllib2.0/hook/pkgIndex.tcl | 5 + .../lib_tcl9/tcllib2.0/html/html.tcl | 1581 + .../lib_tcl9/tcllib2.0/html/pkgIndex.tcl | 2 + .../tcllib2.0/htmlparse/htmlparse.tcl | 1444 + .../lib_tcl9/tcllib2.0/htmlparse/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/http/autoproxy.tcl | 588 + .../lib_tcl9/tcllib2.0/http/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/httpd/httpd.tcl | 2016 + .../lib_tcl9/tcllib2.0/httpd/pkgIndex.tcl | 4 + .../lib_tcl9/tcllib2.0/httpwget/pkgIndex.tcl | 1 + .../lib_tcl9/tcllib2.0/httpwget/wget.tcl | 62 + .../lib_tcl9/tcllib2.0/ident/ident.tcl | 89 + .../lib_tcl9/tcllib2.0/ident/pkgIndex.tcl | 3 + .../lib_tcl9/tcllib2.0/imap4/imap4.tcl | 1385 + .../lib_tcl9/tcllib2.0/imap4/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/inifile/ini.tcl | 422 + .../lib_tcl9/tcllib2.0/inifile/pkgIndex.tcl | 2 + .../tcllib2.0/interp/deleg_method.tcl | 64 + .../lib_tcl9/tcllib2.0/interp/deleg_proc.tcl | 68 + .../lib_tcl9/tcllib2.0/interp/interp.tcl | 87 + .../lib_tcl9/tcllib2.0/interp/pkgIndex.tcl | 4 + .../lib_tcl9/tcllib2.0/irc/irc.tcl | 531 + .../lib_tcl9/tcllib2.0/irc/picoirc.tcl | 450 + .../lib_tcl9/tcllib2.0/irc/pkgIndex.tcl | 7 + .../tcllib2.0/javascript/javascript.tcl | 453 + .../tcllib2.0/javascript/pkgIndex.tcl | 4 + .../lib_tcl9/tcllib2.0/jpeg/jpeg.tcl | 1118 + .../lib_tcl9/tcllib2.0/jpeg/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/json/json.tcl | 285 + .../lib_tcl9/tcllib2.0/json/json_tcl.tcl | 291 + .../lib_tcl9/tcllib2.0/json/json_write.tcl | 212 + .../lib_tcl9/tcllib2.0/json/jsonc.tcl | 171 + .../lib_tcl9/tcllib2.0/json/pkgIndex.tcl | 5 + .../lib_tcl9/tcllib2.0/lambda/lambda.tcl | 43 + .../lib_tcl9/tcllib2.0/lambda/pkgIndex.tcl | 8 + .../lib_tcl9/tcllib2.0/lazyset/lazyset.tcl | 88 + .../lib_tcl9/tcllib2.0/lazyset/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/ldap/ldap.tcl | 2327 + .../lib_tcl9/tcllib2.0/ldap/ldapx.tcl | 1804 + .../lib_tcl9/tcllib2.0/ldap/pkgIndex.tcl | 7 + .../lib_tcl9/tcllib2.0/log/log.tcl | 897 + .../lib_tcl9/tcllib2.0/log/logger.tcl | 1297 + .../lib_tcl9/tcllib2.0/log/loggerAppender.tcl | 444 + .../lib_tcl9/tcllib2.0/log/loggerUtils.tcl | 538 + .../lib_tcl9/tcllib2.0/log/msgs/en.msg | 7 + .../lib_tcl9/tcllib2.0/log/pkgIndex.tcl | 5 + .../tcllib2.0/map/map_geocode_nominatim.tcl | 91 + .../lib_tcl9/tcllib2.0/map/map_slippy.tcl | 285 + .../lib_tcl9/tcllib2.0/map/map_slippy_c.tcl | 837 + .../tcllib2.0/map/map_slippy_cache.tcl | 143 + .../tcllib2.0/map/map_slippy_fetcher.tcl | 170 + .../lib_tcl9/tcllib2.0/map/map_slippy_tcl.tcl | 852 + .../lib_tcl9/tcllib2.0/map/pkgIndex.tcl | 6 + .../lib_tcl9/tcllib2.0/mapproj/mapproj.tcl | 1817 + .../lib_tcl9/tcllib2.0/mapproj/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/markdown/markdown.tcl | 813 + .../lib_tcl9/tcllib2.0/markdown/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/math/bessel.tcl | 200 + .../lib_tcl9/tcllib2.0/math/bigfloat2.tcl | 2217 + .../lib_tcl9/tcllib2.0/math/bignum.tcl | 900 + .../lib_tcl9/tcllib2.0/math/calculus.tcl | 1652 + .../lib_tcl9/tcllib2.0/math/changepoint.tcl | 311 + .../tcllib2.0/math/classic_polyns.tcl | 207 + .../lib_tcl9/tcllib2.0/math/combinatorics.tcl | 447 + .../tcllib2.0/math/combinatoricsExt.tcl | 825 + .../lib_tcl9/tcllib2.0/math/constants.tcl | 211 + .../lib_tcl9/tcllib2.0/math/decimal.tcl | 1742 + .../lib_tcl9/tcllib2.0/math/elliptic.tcl | 246 + .../lib_tcl9/tcllib2.0/math/exact.tcl | 4060 + .../lib_tcl9/tcllib2.0/math/exponential.tcl | 449 + .../lib_tcl9/tcllib2.0/math/figurate.tcl | 294 + .../lib_tcl9/tcllib2.0/math/filtergen.tcl | 251 + .../lib_tcl9/tcllib2.0/math/fourier.tcl | 376 + .../lib_tcl9/tcllib2.0/math/fuzzy.tcl | 173 + .../lib_tcl9/tcllib2.0/math/geometry.tcl | 1569 + .../tcllib2.0/math/geometry_circle.tcl | 382 + .../lib_tcl9/tcllib2.0/math/geometry_ext.tcl | 1023 + .../lib_tcl9/tcllib2.0/math/interpolate.tcl | 667 + .../lib_tcl9/tcllib2.0/math/kruskal.tcl | 154 + .../lib_tcl9/tcllib2.0/math/linalg.tcl | 2299 + .../lib_tcl9/tcllib2.0/math/liststat.tcl | 95 + .../tcllib2.0/math/machineparameters.tcl | 378 + .../lib_tcl9/tcllib2.0/math/math.tcl | 44 + .../lib_tcl9/tcllib2.0/math/misc.tcl | 385 + .../lib_tcl9/tcllib2.0/math/mvlinreg.tcl | 265 + .../lib_tcl9/tcllib2.0/math/numtheory.tcl | 82 + .../lib_tcl9/tcllib2.0/math/optimize.tcl | 1323 + .../lib_tcl9/tcllib2.0/math/pca.tcl | 403 + .../lib_tcl9/tcllib2.0/math/pdf_stat.tcl | 2676 + .../lib_tcl9/tcllib2.0/math/pkgIndex.tcl | 35 + .../lib_tcl9/tcllib2.0/math/plotstat.tcl | 312 + .../lib_tcl9/tcllib2.0/math/polynomials.tcl | 564 + .../lib_tcl9/tcllib2.0/math/primes.tcl | 569 + .../lib_tcl9/tcllib2.0/math/probopt.tcl | 19 + .../tcllib2.0/math/probopt_diffev.tcl | 275 + .../lib_tcl9/tcllib2.0/math/probopt_lipo.tcl | 241 + .../lib_tcl9/tcllib2.0/math/probopt_pso.tcl | 427 + .../lib_tcl9/tcllib2.0/math/probopt_sce.tcl | 378 + .../lib_tcl9/tcllib2.0/math/qcomplex.tcl | 178 + .../lib_tcl9/tcllib2.0/math/quasirandom.tcl | 522 + .../tcllib2.0/math/rational_funcs.tcl | 367 + .../lib_tcl9/tcllib2.0/math/romannumerals.tcl | 164 + .../lib_tcl9/tcllib2.0/math/rootfind.tcl | 343 + .../lib_tcl9/tcllib2.0/math/special.tcl | 463 + .../lib_tcl9/tcllib2.0/math/stat_kernel.tcl | 217 + .../lib_tcl9/tcllib2.0/math/stat_logit.tcl | 120 + .../tcllib2.0/math/stat_wasserstein.tcl | 214 + .../lib_tcl9/tcllib2.0/math/statistics.tcl | 2039 + .../lib_tcl9/tcllib2.0/math/symdiff.tcl | 1229 + .../lib_tcl9/tcllib2.0/math/tclIndex | 26 + .../lib_tcl9/tcllib2.0/math/trig.tcl | 290 + .../lib_tcl9/tcllib2.0/math/wilcoxon.tcl | 338 + .../lib_tcl9/tcllib2.0/md4/md4.tcl | 569 + .../lib_tcl9/tcllib2.0/md4/md4c.tcl | 121 + .../lib_tcl9/tcllib2.0/md4/pkgIndex.tcl | 3 + .../lib_tcl9/tcllib2.0/md5/md5.tcl | 463 + .../lib_tcl9/tcllib2.0/md5/md5c.tcl | 149 + .../lib_tcl9/tcllib2.0/md5/md5x.tcl | 738 + .../lib_tcl9/tcllib2.0/md5/pkgIndex.tcl | 3 + .../lib_tcl9/tcllib2.0/md5c/critcl-rt.tcl | 381 + .../lib_tcl9/tcllib2.0/md5c/license.terms | 1 + .../lib_tcl9/tcllib2.0/md5c/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/md5c/teapot.txt | 7 + .../tcllib2.0/md5c/win32-x86_64/md5c.dll | Bin 0 -> 22528 bytes .../lib_tcl9/tcllib2.0/md5crypt/md5crypt.tcl | 155 + .../lib_tcl9/tcllib2.0/md5crypt/md5cryptc.tcl | 182 + .../lib_tcl9/tcllib2.0/md5crypt/pkgIndex.tcl | 3 + .../lib_tcl9/tcllib2.0/mime/mime.tcl | 3930 + .../lib_tcl9/tcllib2.0/mime/pkgIndex.tcl | 3 + .../lib_tcl9/tcllib2.0/mime/smtp.tcl | 1508 + .../lib_tcl9/tcllib2.0/mkdoc/mkdoc.tcl | 701 + .../lib_tcl9/tcllib2.0/mkdoc/pkgIndex.tcl | 2 + .../tcllib2.0/multiplexer/multiplexer.tcl | 291 + .../tcllib2.0/multiplexer/pkgIndex.tcl | 12 + .../tcllib2.0/namespacex/namespacex.tcl | 335 + .../tcllib2.0/namespacex/pkgIndex.tcl | 5 + .../lib_tcl9/tcllib2.0/ncgi/ncgi.tcl | 1121 + .../lib_tcl9/tcllib2.0/ncgi/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/nettool/nettool.tcl | 1814 + .../lib_tcl9/tcllib2.0/nettool/pkgIndex.tcl | 6 + .../lib_tcl9/tcllib2.0/nmea/nmea.tcl | 199 + .../lib_tcl9/tcllib2.0/nmea/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/nns/common.tcl | 38 + .../lib_tcl9/tcllib2.0/nns/nns.tcl | 432 + .../lib_tcl9/tcllib2.0/nns/nns_auto.tcl | 443 + .../lib_tcl9/tcllib2.0/nns/pkgIndex.tcl | 5 + .../lib_tcl9/tcllib2.0/nns/server.tcl | 385 + .../lib_tcl9/tcllib2.0/nntp/nntp.tcl | 979 + .../lib_tcl9/tcllib2.0/nntp/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/ntp/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/ntp/time.tcl | 382 + .../lib_tcl9/tcllib2.0/oauth/oauth.tcl | 304 + .../lib_tcl9/tcllib2.0/oauth/pkgIndex.tcl | 2 + .../tcllib2.0/oodialect/oodialect.tcl | 265 + .../lib_tcl9/tcllib2.0/oodialect/pkgIndex.tcl | 1 + .../lib_tcl9/tcllib2.0/oometa/oometa.tcl | 503 + .../lib_tcl9/tcllib2.0/oometa/oooption.tcl | 169 + .../lib_tcl9/tcllib2.0/oometa/pkgIndex.tcl | 8 + .../lib_tcl9/tcllib2.0/ooutil/ooutil.tcl | 189 + .../lib_tcl9/tcllib2.0/ooutil/pkgIndex.tcl | 7 + .../lib_tcl9/tcllib2.0/otp/otp.tcl | 430 + .../lib_tcl9/tcllib2.0/otp/pkgIndex.tcl | 3 + .../tcllib2.0/page/analysis_peg_emodes.tcl | 458 + .../tcllib2.0/page/analysis_peg_minimize.tcl | 51 + .../tcllib2.0/page/analysis_peg_reachable.tcl | 150 + .../page/analysis_peg_realizable.tcl | 257 + .../tcllib2.0/page/compiler_peg_mecpu.tcl | 1642 + .../lib_tcl9/tcllib2.0/page/gen_peg_canon.tcl | 481 + .../lib_tcl9/tcllib2.0/page/gen_peg_cpkg.tcl | 171 + .../lib_tcl9/tcllib2.0/page/gen_peg_hb.tcl | 79 + .../lib_tcl9/tcllib2.0/page/gen_peg_me.tcl | 888 + .../tcllib2.0/page/gen_peg_me.template | 61 + .../lib_tcl9/tcllib2.0/page/gen_peg_mecpu.tcl | 289 + .../tcllib2.0/page/gen_peg_mecpu.template | 48 + .../lib_tcl9/tcllib2.0/page/gen_peg_ser.tcl | 63 + .../lib_tcl9/tcllib2.0/page/gen_tree_text.tcl | 94 + .../lib_tcl9/tcllib2.0/page/parse_lemon.tcl | 7420 ++ .../lib_tcl9/tcllib2.0/page/parse_peg.tcl | 4415 + .../lib_tcl9/tcllib2.0/page/parse_peghb.tcl | 118 + .../lib_tcl9/tcllib2.0/page/parse_pegser.tcl | 99 + .../lib_tcl9/tcllib2.0/page/peg_grammar.tcl | 117 + .../lib_tcl9/tcllib2.0/page/pkgIndex.tcl | 80 + .../lib_tcl9/tcllib2.0/page/pluginmgr.tcl | 581 + .../tcllib2.0/page/plugins/config_peg.tcl | 14 + .../tcllib2.0/page/plugins/pkgIndex.tcl | 34 + .../tcllib2.0/page/plugins/reader_hb.tcl | 114 + .../tcllib2.0/page/plugins/reader_lemon.tcl | 170 + .../tcllib2.0/page/plugins/reader_peg.tcl | 169 + .../tcllib2.0/page/plugins/reader_ser.tcl | 114 + .../tcllib2.0/page/plugins/reader_treeser.tcl | 116 + .../page/plugins/transform_mecpu.tcl | 107 + .../page/plugins/transform_reachable.tcl | 107 + .../page/plugins/transform_realizable.tcl | 106 + .../tcllib2.0/page/plugins/writer_hb.tcl | 106 + .../page/plugins/writer_identity.tcl | 98 + .../tcllib2.0/page/plugins/writer_me.tcl | 115 + .../tcllib2.0/page/plugins/writer_mecpu.tcl | 116 + .../tcllib2.0/page/plugins/writer_null.tcl | 97 + .../tcllib2.0/page/plugins/writer_peg.tcl | 106 + .../tcllib2.0/page/plugins/writer_ser.tcl | 104 + .../tcllib2.0/page/plugins/writer_tpc.tcl | 105 + .../tcllib2.0/page/plugins/writer_tree.tcl | 105 + .../lib_tcl9/tcllib2.0/page/util_flow.tcl | 90 + .../tcllib2.0/page/util_norm_lemon.tcl | 427 + .../lib_tcl9/tcllib2.0/page/util_norm_peg.tcl | 415 + .../lib_tcl9/tcllib2.0/page/util_peg.tcl | 209 + .../lib_tcl9/tcllib2.0/page/util_quote.tcl | 173 + .../lib_tcl9/tcllib2.0/pkgIndex.tcl | 40 + .../lib_tcl9/tcllib2.0/pki/pkgIndex.tcl | 3 + .../lib_tcl9/tcllib2.0/pki/pki.tcl | 3321 + .../lib_tcl9/tcllib2.0/pluginmgr/pkgIndex.tcl | 2 + .../tcllib2.0/pluginmgr/pluginmgr.tcl | 418 + .../lib_tcl9/tcllib2.0/png/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/png/png.tcl | 306 + .../lib_tcl9/tcllib2.0/pop3/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/pop3/pop3.tcl | 832 + .../lib_tcl9/tcllib2.0/pop3d/pkgIndex.tcl | 14 + .../lib_tcl9/tcllib2.0/pop3d/pop3d.tcl | 1147 + .../lib_tcl9/tcllib2.0/pop3d/pop3d_dbox.tcl | 485 + .../lib_tcl9/tcllib2.0/pop3d/pop3d_udb.tcl | 300 + .../lib_tcl9/tcllib2.0/practcl/pkgIndex.tcl | 4 + .../lib_tcl9/tcllib2.0/practcl/practcl.tcl | 8463 ++ .../tcllib2.0/processman/pkgIndex.tcl | 3 + .../tcllib2.0/processman/processman.tcl | 348 + .../lib_tcl9/tcllib2.0/profiler/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/profiler/profiler.tcl | 667 + .../lib_tcl9/tcllib2.0/pt/char.tcl | 289 + .../lib_tcl9/tcllib2.0/pt/pkgIndex.tcl | 71 + .../lib_tcl9/tcllib2.0/pt/pt_astree.tcl | 239 + .../tcllib2.0/pt/pt_cparam_config_critcl.tcl | 509 + .../tcllib2.0/pt/pt_cparam_config_tea.tcl | 477 + .../lib_tcl9/tcllib2.0/pt/pt_parse_peg.tcl | 180 + .../lib_tcl9/tcllib2.0/pt/pt_parse_peg_c.tcl | 4978 + .../tcllib2.0/pt/pt_parse_peg_tcl.tcl | 2431 + .../tcllib2.0/pt/pt_peg_container.tcl | 530 + .../tcllib2.0/pt/pt_peg_container_peg.tcl | 146 + .../lib_tcl9/tcllib2.0/pt/pt_peg_export.tcl | 117 + .../tcllib2.0/pt/pt_peg_export_container.tcl | 51 + .../tcllib2.0/pt/pt_peg_export_json.tcl | 50 + .../tcllib2.0/pt/pt_peg_export_peg.tcl | 51 + .../tcllib2.0/pt/pt_peg_from_json.tcl | 48 + .../lib_tcl9/tcllib2.0/pt/pt_peg_from_peg.tcl | 394 + .../lib_tcl9/tcllib2.0/pt/pt_peg_import.tcl | 188 + .../tcllib2.0/pt/pt_peg_import_json.tcl | 40 + .../tcllib2.0/pt/pt_peg_import_peg.tcl | 41 + .../lib_tcl9/tcllib2.0/pt/pt_peg_interp.tcl | 385 + .../lib_tcl9/tcllib2.0/pt/pt_peg_op.tcl | 375 + .../tcllib2.0/pt/pt_peg_to_container.tcl | 345 + .../tcllib2.0/pt/pt_peg_to_cparam.tcl | 1662 + .../lib_tcl9/tcllib2.0/pt/pt_peg_to_json.tcl | 149 + .../lib_tcl9/tcllib2.0/pt/pt_peg_to_param.tcl | 1029 + .../lib_tcl9/tcllib2.0/pt/pt_peg_to_peg.tcl | 413 + .../tcllib2.0/pt/pt_peg_to_tclparam.tcl | 1274 + .../lib_tcl9/tcllib2.0/pt/pt_pegrammar.tcl | 380 + .../lib_tcl9/tcllib2.0/pt/pt_pexpr_op.tcl | 331 + .../lib_tcl9/tcllib2.0/pt/pt_pexpression.tcl | 321 + .../lib_tcl9/tcllib2.0/pt/pt_pgen.tcl | 278 + .../lib_tcl9/tcllib2.0/pt/pt_rdengine.tcl | 206 + .../lib_tcl9/tcllib2.0/pt/pt_rdengine_c.tcl | 168 + .../lib_tcl9/tcllib2.0/pt/pt_rdengine_nx.tcl | 148 + .../lib_tcl9/tcllib2.0/pt/pt_rdengine_oo.tcl | 2170 + .../lib_tcl9/tcllib2.0/pt/pt_rdengine_tcl.tcl | 2283 + .../tcllib2.0/pt/pt_tclparam_config_nx.tcl | 113 + .../tcllib2.0/pt/pt_tclparam_config_snit.tcl | 141 + .../tcllib2.0/pt/pt_tclparam_config_tcloo.tcl | 121 + .../lib_tcl9/tcllib2.0/pt/pt_util.tcl | 160 + .../lib_tcl9/tcllib2.0/pt/rde_critcl/m.c | 2735 + .../lib_tcl9/tcllib2.0/pt/rde_critcl/m.h | 150 + .../lib_tcl9/tcllib2.0/pt/rde_critcl/ms.c | 317 + .../lib_tcl9/tcllib2.0/pt/rde_critcl/ms.h | 20 + .../lib_tcl9/tcllib2.0/pt/rde_critcl/ot.c | 230 + .../lib_tcl9/tcllib2.0/pt/rde_critcl/ot.h | 24 + .../lib_tcl9/tcllib2.0/pt/rde_critcl/p.c | 183 + .../lib_tcl9/tcllib2.0/pt/rde_critcl/p.h | 24 + .../lib_tcl9/tcllib2.0/pt/rde_critcl/pInt.h | 50 + .../lib_tcl9/tcllib2.0/pt/rde_critcl/param.c | 1789 + .../lib_tcl9/tcllib2.0/pt/rde_critcl/param.h | 183 + .../lib_tcl9/tcllib2.0/pt/rde_critcl/stack.c | 160 + .../lib_tcl9/tcllib2.0/pt/rde_critcl/stack.h | 63 + .../lib_tcl9/tcllib2.0/pt/rde_critcl/tc.c | 187 + .../lib_tcl9/tcllib2.0/pt/rde_critcl/tc.h | 31 + .../lib_tcl9/tcllib2.0/pt/rde_critcl/util.c | 145 + .../lib_tcl9/tcllib2.0/pt/rde_critcl/util.h | 79 + .../lib_tcl9/tcllib2.0/pt/text_write.tcl | 249 + .../lib_tcl9/tcllib2.0/rc4/pkgIndex.tcl | 5 + .../lib_tcl9/tcllib2.0/rc4/rc4.tcl | 422 + .../lib_tcl9/tcllib2.0/rc4/rc4c.tcl | 169 + .../lib_tcl9/tcllib2.0/rcs/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/rcs/rcs.tcl | 281 + .../lib_tcl9/tcllib2.0/report/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/report/report.tcl | 1394 + .../lib_tcl9/tcllib2.0/rest/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/rest/rest.tcl | 857 + .../lib_tcl9/tcllib2.0/ripemd/pkgIndex.tcl | 3 + .../lib_tcl9/tcllib2.0/ripemd/ripemd128.tcl | 731 + .../lib_tcl9/tcllib2.0/ripemd/ripemd160.tcl | 874 + .../lib_tcl9/tcllib2.0/sasl/gtoken.tcl | 92 + .../lib_tcl9/tcllib2.0/sasl/ntlm.tcl | 376 + .../lib_tcl9/tcllib2.0/sasl/pkgIndex.tcl | 11 + .../lib_tcl9/tcllib2.0/sasl/sasl.tcl | 682 + .../lib_tcl9/tcllib2.0/sasl/scram.tcl | 503 + .../lib_tcl9/tcllib2.0/sha1/pkgIndex.tcl | 5 + .../lib_tcl9/tcllib2.0/sha1/sha1.c | 268 + .../lib_tcl9/tcllib2.0/sha1/sha1.h | 28 + .../lib_tcl9/tcllib2.0/sha1/sha1.tcl | 814 + .../lib_tcl9/tcllib2.0/sha1/sha1c.tcl | 126 + .../lib_tcl9/tcllib2.0/sha1/sha1v1.tcl | 710 + .../lib_tcl9/tcllib2.0/sha1/sha256.c | 524 + .../lib_tcl9/tcllib2.0/sha1/sha256.h | 88 + .../lib_tcl9/tcllib2.0/sha1/sha256.tcl | 833 + .../lib_tcl9/tcllib2.0/sha1/sha256c.tcl | 191 + .../tcllib2.0/simulation/annealing.tcl | 564 + .../tcllib2.0/simulation/montecarlo.tcl | 486 + .../tcllib2.0/simulation/pkgIndex.tcl | 3 + .../lib_tcl9/tcllib2.0/simulation/random.tcl | 645 + .../lib_tcl9/tcllib2.0/smtpd/pkgIndex.tcl | 12 + .../lib_tcl9/tcllib2.0/smtpd/smtpd.tcl | 924 + .../lib_tcl9/tcllib2.0/snit/main1.tcl | 3987 + .../lib_tcl9/tcllib2.0/snit/main2.tcl | 3888 + .../lib_tcl9/tcllib2.0/snit/pkgIndex.tcl | 6 + .../lib_tcl9/tcllib2.0/snit/snit.tcl | 32 + .../lib_tcl9/tcllib2.0/snit/snit2.tcl | 32 + .../lib_tcl9/tcllib2.0/snit/validate.tcl | 720 + .../lib_tcl9/tcllib2.0/soundex/pkgIndex.tcl | 12 + .../lib_tcl9/tcllib2.0/soundex/soundex.tcl | 96 + .../lib_tcl9/tcllib2.0/stooop/mkpkgidx.tcl | 112 + .../lib_tcl9/tcllib2.0/stooop/pkgIndex.tcl | 22 + .../lib_tcl9/tcllib2.0/stooop/stooop.tcl | 937 + .../lib_tcl9/tcllib2.0/stooop/switched.tcl | 133 + .../lib_tcl9/tcllib2.0/stooop/xifo.tcl | 142 + .../lib_tcl9/tcllib2.0/string/pkgIndex.tcl | 6 + .../lib_tcl9/tcllib2.0/string/token.tcl | 94 + .../lib_tcl9/tcllib2.0/string/token_shell.tcl | 172 + .../tcllib2.0/stringprep/pkgIndex.tcl | 5 + .../tcllib2.0/stringprep/stringprep.tcl | 303 + .../tcllib2.0/stringprep/stringprep_data.tcl | 1033 + .../lib_tcl9/tcllib2.0/stringprep/unicode.tcl | 289 + .../tcllib2.0/stringprep/unicode_data.tcl | 1549 + .../lib_tcl9/tcllib2.0/struct/disjointset.tcl | 385 + .../lib_tcl9/tcllib2.0/struct/graph.tcl | 177 + .../lib_tcl9/tcllib2.0/struct/graph1.tcl | 2154 + .../lib_tcl9/tcllib2.0/struct/graph_c.tcl | 158 + .../lib_tcl9/tcllib2.0/struct/graph_tcl.tcl | 3280 + .../lib_tcl9/tcllib2.0/struct/graphops.tcl | 3787 + .../lib_tcl9/tcllib2.0/struct/list.tcl | 1860 + .../lib_tcl9/tcllib2.0/struct/list.test.tcl | 1288 + .../lib_tcl9/tcllib2.0/struct/map.tcl | 104 + .../lib_tcl9/tcllib2.0/struct/matrix.tcl | 2808 + .../lib_tcl9/tcllib2.0/struct/pkgIndex.tcl | 25 + .../lib_tcl9/tcllib2.0/struct/pool.tcl | 715 + .../lib_tcl9/tcllib2.0/struct/prioqueue.tcl | 536 + .../lib_tcl9/tcllib2.0/struct/queue.tcl | 183 + .../lib_tcl9/tcllib2.0/struct/queue_c.tcl | 151 + .../lib_tcl9/tcllib2.0/struct/queue_oo.tcl | 228 + .../lib_tcl9/tcllib2.0/struct/queue_tcl.tcl | 383 + .../lib_tcl9/tcllib2.0/struct/record.tcl | 830 + .../lib_tcl9/tcllib2.0/struct/sets.tcl | 185 + .../lib_tcl9/tcllib2.0/struct/sets_c.tcl | 91 + .../lib_tcl9/tcllib2.0/struct/sets_tcl.tcl | 430 + .../lib_tcl9/tcllib2.0/struct/skiplist.tcl | 437 + .../lib_tcl9/tcllib2.0/struct/stack.tcl | 183 + .../lib_tcl9/tcllib2.0/struct/stack_c.tcl | 156 + .../lib_tcl9/tcllib2.0/struct/stack_oo.tcl | 298 + .../lib_tcl9/tcllib2.0/struct/stack_tcl.tcl | 507 + .../lib_tcl9/tcllib2.0/struct/struct.tcl | 18 + .../lib_tcl9/tcllib2.0/struct/struct1.tcl | 17 + .../lib_tcl9/tcllib2.0/struct/tree.tcl | 182 + .../lib_tcl9/tcllib2.0/struct/tree1.tcl | 1487 + .../lib_tcl9/tcllib2.0/struct/tree_c.tcl | 206 + .../lib_tcl9/tcllib2.0/struct/tree_tcl.tcl | 2443 + .../lib_tcl9/tcllib2.0/tar/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/tar/tar.tcl | 674 + .../lib_tcl9/tcllib2.0/tcllibc/critcl-rt.tcl | 381 + .../lib_tcl9/tcllib2.0/tcllibc/license.terms | 1 + .../lib_tcl9/tcllib2.0/tcllibc/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/tcllibc/teapot.txt | 22 + .../tcllibc/win32-x86_64/tcllibc.dll | Bin 0 -> 351744 bytes .../lib_tcl9/tcllib2.0/tepam/pkgIndex.tcl | 3 + .../lib_tcl9/tcllib2.0/tepam/tepam.tcl | 2783 + .../tcllib2.0/tepam/tepam_doc_gen.tcl | 748 + .../lib_tcl9/tcllib2.0/term/ansi/code.tcl | 56 + .../tcllib2.0/term/ansi/code/attr.tcl | 108 + .../tcllib2.0/term/ansi/code/ctrl.tcl | 272 + .../tcllib2.0/term/ansi/code/macros.tcl | 93 + .../lib_tcl9/tcllib2.0/term/ansi/ctrlunix.tcl | 91 + .../lib_tcl9/tcllib2.0/term/ansi/send.tcl | 92 + .../lib_tcl9/tcllib2.0/term/bind.tcl | 132 + .../lib_tcl9/tcllib2.0/term/imenu.tcl | 202 + .../lib_tcl9/tcllib2.0/term/ipager.tcl | 206 + .../lib_tcl9/tcllib2.0/term/pkgIndex.tcl | 13 + .../lib_tcl9/tcllib2.0/term/receive.tcl | 60 + .../lib_tcl9/tcllib2.0/term/send.tcl | 34 + .../lib_tcl9/tcllib2.0/term/term.tcl | 19 + .../lib_tcl9/tcllib2.0/textutil/adjust.tcl | 763 + .../lib_tcl9/tcllib2.0/textutil/dehypht.tex | 902 + .../lib_tcl9/tcllib2.0/textutil/eshyph_vo.tex | 1104 + .../lib_tcl9/tcllib2.0/textutil/expander.tcl | 1122 + .../lib_tcl9/tcllib2.0/textutil/ithyph.tex | 223 + .../lib_tcl9/tcllib2.0/textutil/patch.tcl | 180 + .../lib_tcl9/tcllib2.0/textutil/pkgIndex.tcl | 14 + .../lib_tcl9/tcllib2.0/textutil/repeat.tcl | 91 + .../lib_tcl9/tcllib2.0/textutil/split.tcl | 144 + .../lib_tcl9/tcllib2.0/textutil/string.tcl | 144 + .../lib_tcl9/tcllib2.0/textutil/tabify.tcl | 289 + .../lib_tcl9/tcllib2.0/textutil/textutil.tcl | 80 + .../lib_tcl9/tcllib2.0/textutil/trim.tcl | 112 + .../lib_tcl9/tcllib2.0/textutil/wcswidth.tcl | 2252 + .../lib_tcl9/tcllib2.0/tie/pkgIndex.tcl | 9 + .../lib_tcl9/tcllib2.0/tie/tie.tcl | 510 + .../lib_tcl9/tcllib2.0/tie/tie_array.tcl | 123 + .../lib_tcl9/tcllib2.0/tie/tie_dsource.tcl | 53 + .../lib_tcl9/tcllib2.0/tie/tie_file.tcl | 272 + .../lib_tcl9/tcllib2.0/tie/tie_growfile.tcl | 146 + .../lib_tcl9/tcllib2.0/tie/tie_log.tcl | 94 + .../lib_tcl9/tcllib2.0/tie/tie_rarray.tcl | 117 + .../lib_tcl9/tcllib2.0/tiff/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/tiff/tiff.tcl | 781 + .../lib_tcl9/tcllib2.0/tool/pkgIndex.tcl | 13 + .../lib_tcl9/tcllib2.0/tool/tool.tcl | 1849 + .../lib_tcl9/tcllib2.0/transfer/connect.tcl | 97 + .../lib_tcl9/tcllib2.0/transfer/copyops.tcl | 389 + .../lib_tcl9/tcllib2.0/transfer/ddest.tcl | 169 + .../lib_tcl9/tcllib2.0/transfer/dsource.tcl | 183 + .../lib_tcl9/tcllib2.0/transfer/pkgIndex.tcl | 8 + .../lib_tcl9/tcllib2.0/transfer/receiver.tcl | 188 + .../lib_tcl9/tcllib2.0/transfer/tqueue.tcl | 223 + .../tcllib2.0/transfer/transmitter.tcl | 176 + .../lib_tcl9/tcllib2.0/treeql/pkgIndex.tcl | 5 + .../lib_tcl9/tcllib2.0/treeql/treeql.tcl | 24 + .../lib_tcl9/tcllib2.0/treeql/treeql84.tcl | 734 + .../lib_tcl9/tcllib2.0/treeql/treeql85.tcl | 737 + .../lib_tcl9/tcllib2.0/try/fhome.tcl | 63 + .../lib_tcl9/tcllib2.0/try/pkgIndex.tcl | 21 + .../lib_tcl9/tcllib2.0/try/throw.tcl | 18 + .../lib_tcl9/tcllib2.0/try/try.tcl | 206 + .../tcllib2.0/udpcluster/pkgIndex.tcl | 4 + .../tcllib2.0/udpcluster/udpcluster.tcl | 661 + .../lib_tcl9/tcllib2.0/uev/pkgIndex.tcl | 3 + .../lib_tcl9/tcllib2.0/uev/uevent.tcl | 468 + .../lib_tcl9/tcllib2.0/uev/uevent_onidle.tcl | 51 + .../lib_tcl9/tcllib2.0/units/pkgIndex.tcl | 4 + .../lib_tcl9/tcllib2.0/units/units.tcl | 703 + .../lib_tcl9/tcllib2.0/uri/pkgIndex.tcl | 6 + .../lib_tcl9/tcllib2.0/uri/uri.tcl | 1444 + .../lib_tcl9/tcllib2.0/uri/urn-scheme.tcl | 143 + .../lib_tcl9/tcllib2.0/uuid/pkgIndex.tcl | 2 + .../lib_tcl9/tcllib2.0/uuid/uuid.tcl | 245 + .../lib_tcl9/tcllib2.0/valtype/cc_amex.tcl | 68 + .../tcllib2.0/valtype/cc_discover.tcl | 70 + .../tcllib2.0/valtype/cc_mastercard.tcl | 68 + .../lib_tcl9/tcllib2.0/valtype/cc_visa.tcl | 69 + .../lib_tcl9/tcllib2.0/valtype/ean13.tcl | 99 + .../lib_tcl9/tcllib2.0/valtype/iban.tcl | 92 + .../lib_tcl9/tcllib2.0/valtype/imei.tcl | 66 + .../lib_tcl9/tcllib2.0/valtype/isbn.tcl | 176 + .../lib_tcl9/tcllib2.0/valtype/luhn.tcl | 128 + .../lib_tcl9/tcllib2.0/valtype/luhn5.tcl | 140 + .../lib_tcl9/tcllib2.0/valtype/pkgIndex.tcl | 13 + .../lib_tcl9/tcllib2.0/valtype/usnpi.tcl | 65 + .../lib_tcl9/tcllib2.0/valtype/valtype.tcl | 77 + .../lib_tcl9/tcllib2.0/valtype/verhoeff.tcl | 128 + .../tcllib2.0/virtchannel_base/cat.tcl | 139 + .../tcllib2.0/virtchannel_base/facade.tcl | 238 + .../tcllib2.0/virtchannel_base/fifo.tcl | 142 + .../tcllib2.0/virtchannel_base/fifo2.tcl | 117 + .../tcllib2.0/virtchannel_base/halfpipe.tcl | 198 + .../tcllib2.0/virtchannel_base/memchan.tcl | 173 + .../tcllib2.0/virtchannel_base/null.tcl | 58 + .../tcllib2.0/virtchannel_base/nullzero.tcl | 66 + .../tcllib2.0/virtchannel_base/pkgIndex.tcl | 17 + .../tcllib2.0/virtchannel_base/random.tcl | 84 + .../tcllib2.0/virtchannel_base/randseed.tcl | 58 + .../tcllib2.0/virtchannel_base/std.tcl | 101 + .../tcllib2.0/virtchannel_base/string.tcl | 128 + .../tcllib2.0/virtchannel_base/textwindow.tcl | 78 + .../tcllib2.0/virtchannel_base/variable.tcl | 185 + .../tcllib2.0/virtchannel_base/zero.tcl | 58 + .../tcllib2.0/virtchannel_core/core.tcl | 77 + .../tcllib2.0/virtchannel_core/events.tcl | 158 + .../tcllib2.0/virtchannel_core/pkgIndex.tcl | 8 + .../virtchannel_core/transformcore.tcl | 71 + .../virtchannel_transform/adler32.tcl | 103 + .../virtchannel_transform/base64.tcl | 111 + .../virtchannel_transform/counter.tcl | 94 + .../tcllib2.0/virtchannel_transform/crc32.tcl | 103 + .../tcllib2.0/virtchannel_transform/hex.tcl | 58 + .../virtchannel_transform/identity.tcl | 59 + .../virtchannel_transform/limitsize.tcl | 88 + .../virtchannel_transform/observe.tcl | 80 + .../tcllib2.0/virtchannel_transform/otp.tcl | 98 + .../virtchannel_transform/pkgIndex.tcl | 14 + .../tcllib2.0/virtchannel_transform/rot.tcl | 95 + .../virtchannel_transform/spacer.tcl | 151 + .../tcllib2.0/virtchannel_transform/zlib.tcl | 100 + .../lib_tcl9/tcllib2.0/websocket/pkgIndex.tcl | 2 + .../tcllib2.0/websocket/websocket.tcl | 1801 + .../lib_tcl9/tcllib2.0/wip/pkgIndex.tcl | 3 + .../lib_tcl9/tcllib2.0/wip/wip.tcl | 463 + .../lib_tcl9/tcllib2.0/wip/wip2.tcl | 464 + .../lib_tcl9/tcllib2.0/yaml/huddle.tcl | 646 + .../lib_tcl9/tcllib2.0/yaml/huddle_types.tcl | 296 + .../lib_tcl9/tcllib2.0/yaml/json2huddle.tcl | 389 + .../lib_tcl9/tcllib2.0/yaml/pkgIndex.tcl | 6 + .../lib_tcl9/tcllib2.0/yaml/yaml.tcl | 1297 + .../lib_tcl9/tcllib2.0/zip/decode.tcl | 749 + .../lib_tcl9/tcllib2.0/zip/encode.tcl | 374 + .../lib_tcl9/tcllib2.0/zip/mkzip.tcl | 295 + .../lib_tcl9/tcllib2.0/zip/pkgIndex.tcl | 8 + .../lib_tcl9/tclparser1.9/parse.html | 214 + .../lib_tcl9/tclparser1.9/pkgIndex.tcl | 5 + .../lib_tcl9/tclparser1.9/tcl9tclparser19.dll | Bin 0 -> 16896 bytes .../lib_tcl9/tdbc1.1.9/pkgIndex.tcl | 26 + .../lib_tcl9/tdbc1.1.9/tcl9tdbc119.dll | Bin 0 -> 17408 bytes .../lib_tcl9/tdbc1.1.9/tdbc.n | 86 + .../lib_tcl9/tdbc1.1.9/tdbc.tcl | 922 + .../lib_tcl9/tdbc1.1.9/tdbcConfig.sh | 81 + .../lib_tcl9/tdbc1.1.9/tdbc_connection.n | 376 + .../lib_tcl9/tdbc1.1.9/tdbc_mapSqlState.n | 93 + .../lib_tcl9/tdbc1.1.9/tdbc_resultset.n | 191 + .../lib_tcl9/tdbc1.1.9/tdbc_statement.n | 236 + .../lib_tcl9/tdbc1.1.9/tdbc_tokenize.n | 101 + .../lib_tcl9/tdbc1.1.9/tdbcstub.lib | Bin 0 -> 4232 bytes .../lib_tcl9/tdbcmysql1.1.9/pkgIndex.tcl | 14 + .../tdbcmysql1.1.9/tcl9tdbcmysql119.dll | Bin 0 -> 41984 bytes .../lib_tcl9/tdbcmysql1.1.9/tdbc_mysql.n | 175 + .../lib_tcl9/tdbcmysql1.1.9/tdbcmysql.tcl | 193 + .../lib_tcl9/tdbcodbc1.1.9/pkgIndex.tcl | 14 + .../tdbcodbc1.1.9/tcl9tdbcodbc119.dll | Bin 0 -> 54784 bytes .../lib_tcl9/tdbcodbc1.1.9/tdbc_odbc.n | 235 + .../lib_tcl9/tdbcodbc1.1.9/tdbcodbc.tcl | 554 + .../lib_tcl9/tdbcpostgres1.1.9/pkgIndex.tcl | 14 + .../tdbcpostgres1.1.9/tcl9tdbcpostgres119.dll | Bin 0 -> 38912 bytes .../tdbcpostgres1.1.9/tdbc_postgres.n | 157 + .../tdbcpostgres1.1.9/tdbcpostgres.tcl | 135 + .../lib_tcl9/tdbcsqlite31.1.9/tdbc_sqlite3.n | 124 + .../lib_tcl9/tdom0.9.5/category-index.html | 19 + .../lib_tcl9/tdom0.9.5/dom.html | 820 + .../lib_tcl9/tdom0.9.5/domDoc.html | 786 + .../lib_tcl9/tdom0.9.5/domNode.html | 795 + .../lib_tcl9/tdom0.9.5/expat.html | 934 + .../lib_tcl9/tdom0.9.5/expatapi.html | 209 + .../lib_tcl9/tdom0.9.5/index.html | 20 + .../lib_tcl9/tdom0.9.5/keyword-index.html | 91 + .../lib_tcl9/tdom0.9.5/manpage.css | 204 + .../lib_tcl9/tdom0.9.5/pkgIndex.tcl | 1 + .../lib_tcl9/tdom0.9.5/pullparser.html | 187 + .../lib_tcl9/tdom0.9.5/schema.html | 1686 + .../lib_tcl9/tdom0.9.5/tcl9tdom095.dll | Bin 0 -> 1230848 bytes .../lib_tcl9/tdom0.9.5/tdom.tcl | 1101 + .../lib_tcl9/tdom0.9.5/tdomcmd.html | 90 + .../lib_tcl9/tdom0.9.5/tdomstub.lib | Bin 0 -> 5558 bytes .../lib_tcl9/tdom0.9.5/tnc.html | 140 + .../lib_tcl9/tdomhtml0.1.0/pkgIndex.tcl | 1 + .../lib_tcl9/tdomhtml0.1.0/tdomhtml.tcl | 367 + .../lib_tcl9/thread3.0.0/pkgIndex.tcl | 54 + .../lib_tcl9/thread3.0.0/tcl9thread300.dll | Bin 0 -> 96256 bytes .../lib_tcl9/thread3.0.0/thread.html | 599 + .../lib_tcl9/thread3.0.0/tpool.html | 316 + .../lib_tcl9/thread3.0.0/tsv.html | 409 + .../lib_tcl9/thread3.0.0/ttrace.html | 312 + .../lib_tcl9/thread3.0.0/ttrace.tcl | 943 + .../lib_tcl9/tjson1.0.25/LICENSE | 21 + .../lib_tcl9/tjson1.0.25/pkgIndex.tcl | 1 + .../lib_tcl9/tjson1.0.25/readme.md | 159 + .../lib_tcl9/tjson1.0.25/tcl9tjson1025.dll | Bin 0 -> 84992 bytes .../lib_tcl9/tnc0.3.0/pkgIndex.tcl | 5 + .../lib_tcl9/tnc0.3.0/tcl9tnc030.dll | Bin 0 -> 36864 bytes .../What-is-New-in-TkTreeCtrl.html | 3648 + .../lib_tcl9/treectrl2.5/demos/biglist.tcl | 468 + .../lib_tcl9/treectrl2.5/demos/bitmaps.tcl | 84 + .../treectrl2.5/demos/column-lock.tcl | 334 + .../lib_tcl9/treectrl2.5/demos/demo.tcl | 2211 + .../lib_tcl9/treectrl2.5/demos/explorer.tcl | 1378 + .../lib_tcl9/treectrl2.5/demos/firefox.tcl | 479 + .../lib_tcl9/treectrl2.5/demos/gradients.tcl | 352 + .../lib_tcl9/treectrl2.5/demos/gradients2.tcl | 116 + .../lib_tcl9/treectrl2.5/demos/gradients3.tcl | 286 + .../lib_tcl9/treectrl2.5/demos/headers.tcl | 578 + .../lib_tcl9/treectrl2.5/demos/help.tcl | 363 + .../lib_tcl9/treectrl2.5/demos/imovie.tcl | 171 + .../lib_tcl9/treectrl2.5/demos/inspector.tcl | 286 + .../lib_tcl9/treectrl2.5/demos/layout.tcl | 166 + .../lib_tcl9/treectrl2.5/demos/mailwasher.tcl | 205 + .../lib_tcl9/treectrl2.5/demos/mycomputer.tcl | 127 + .../treectrl2.5/demos/outlook-folders.tcl | 248 + .../treectrl2.5/demos/outlook-newgroup.tcl | 494 + .../treectrl2.5/demos/pics/big-dll.gif | Bin 0 -> 437 bytes .../treectrl2.5/demos/pics/big-exe.gif | Bin 0 -> 368 bytes .../treectrl2.5/demos/pics/big-file.gif | Bin 0 -> 466 bytes .../treectrl2.5/demos/pics/big-folder.gif | Bin 0 -> 459 bytes .../treectrl2.5/demos/pics/big-txt.gif | Bin 0 -> 392 bytes .../treectrl2.5/demos/pics/checked.gif | Bin 0 -> 78 bytes .../treectrl2.5/demos/pics/feather.gif | Bin 0 -> 10898 bytes .../lib_tcl9/treectrl2.5/demos/pics/file.gif | Bin 0 -> 279 bytes .../treectrl2.5/demos/pics/folder-closed.gif | Bin 0 -> 111 bytes .../treectrl2.5/demos/pics/folder-open.gif | Bin 0 -> 120 bytes .../demos/pics/help-book-closed.gif | Bin 0 -> 115 bytes .../treectrl2.5/demos/pics/help-book-open.gif | Bin 0 -> 128 bytes .../treectrl2.5/demos/pics/help-page.gif | Bin 0 -> 132 bytes .../treectrl2.5/demos/pics/imovie-01.gif | Bin 0 -> 5406 bytes .../treectrl2.5/demos/pics/imovie-02.gif | Bin 0 -> 5912 bytes .../treectrl2.5/demos/pics/imovie-03.gif | Bin 0 -> 4696 bytes .../treectrl2.5/demos/pics/imovie-04.gif | Bin 0 -> 5783 bytes .../treectrl2.5/demos/pics/imovie-05.gif | Bin 0 -> 3238 bytes .../treectrl2.5/demos/pics/imovie-06.gif | Bin 0 -> 3509 bytes .../treectrl2.5/demos/pics/imovie-07.gif | Bin 0 -> 2091 bytes .../demos/pics/internet-check-off.gif | Bin 0 -> 70 bytes .../demos/pics/internet-check-on.gif | Bin 0 -> 76 bytes .../treectrl2.5/demos/pics/internet-print.gif | Bin 0 -> 124 bytes .../demos/pics/internet-radio-off.gif | Bin 0 -> 68 bytes .../demos/pics/internet-radio-on.gif | Bin 0 -> 71 bytes .../demos/pics/internet-search.gif | Bin 0 -> 114 bytes .../demos/pics/internet-security.gif | Bin 0 -> 108 bytes .../treectrl2.5/demos/pics/mac-collapse.gif | Bin 0 -> 275 bytes .../treectrl2.5/demos/pics/mac-expand.gif | Bin 0 -> 277 bytes .../treectrl2.5/demos/pics/outlook-arrow.gif | Bin 0 -> 113 bytes .../treectrl2.5/demos/pics/outlook-clip.gif | Bin 0 -> 113 bytes .../demos/pics/outlook-deleted.gif | Bin 0 -> 138 bytes .../treectrl2.5/demos/pics/outlook-draft.gif | Bin 0 -> 134 bytes .../treectrl2.5/demos/pics/outlook-folder.gif | Bin 0 -> 133 bytes .../treectrl2.5/demos/pics/outlook-group.gif | Bin 0 -> 144 bytes .../treectrl2.5/demos/pics/outlook-inbox.gif | Bin 0 -> 133 bytes .../treectrl2.5/demos/pics/outlook-local.gif | Bin 0 -> 146 bytes .../treectrl2.5/demos/pics/outlook-main.gif | Bin 0 -> 174 bytes .../treectrl2.5/demos/pics/outlook-outbox.gif | Bin 0 -> 136 bytes .../treectrl2.5/demos/pics/outlook-read-2.gif | Bin 0 -> 343 bytes .../treectrl2.5/demos/pics/outlook-read.gif | Bin 0 -> 304 bytes .../treectrl2.5/demos/pics/outlook-sent.gif | Bin 0 -> 132 bytes .../treectrl2.5/demos/pics/outlook-server.gif | Bin 0 -> 163 bytes .../treectrl2.5/demos/pics/outlook-unread.gif | Bin 0 -> 303 bytes .../treectrl2.5/demos/pics/outlook-watch.gif | Bin 0 -> 139 bytes .../lib_tcl9/treectrl2.5/demos/pics/sky.gif | Bin 0 -> 6454 bytes .../treectrl2.5/demos/pics/small-dll.gif | Bin 0 -> 311 bytes .../treectrl2.5/demos/pics/small-exe.gif | Bin 0 -> 115 bytes .../treectrl2.5/demos/pics/small-file.gif | Bin 0 -> 338 bytes .../treectrl2.5/demos/pics/small-folder.gif | Bin 0 -> 307 bytes .../treectrl2.5/demos/pics/small-txt.gif | Bin 0 -> 302 bytes .../treectrl2.5/demos/pics/unchecked.gif | Bin 0 -> 72 bytes .../lib_tcl9/treectrl2.5/demos/random.tcl | 410 + .../lib_tcl9/treectrl2.5/demos/span.tcl | 128 + .../treectrl2.5/demos/style-editor.tcl | 976 + .../lib_tcl9/treectrl2.5/demos/table.tcl | 460 + .../treectrl2.5/demos/textvariable.tcl | 84 + .../treectrl2.5/demos/www-options.tcl | 295 + .../treectrl2.5/filelist-bindings.tcl | 1293 + .../lib_tcl9/treectrl2.5/pkgIndex.tcl | 8 + .../lib_tcl9/treectrl2.5/tcl9treectrl25.dll | Bin 0 -> 509952 bytes .../lib_tcl9/treectrl2.5/treectrl.html | 4417 + .../lib_tcl9/treectrl2.5/treectrl.tcl | 1978 + .../lib_tcl9/twapi5.0b1/LICENSE | 29 + .../lib_tcl9/twapi5.0b1/README.md | 73 + .../lib_tcl9/twapi5.0b1/account.tcl | 1160 + .../lib_tcl9/twapi5.0b1/adsi.tcl | 28 + .../lib_tcl9/twapi5.0b1/apputil.tcl | 114 + .../lib_tcl9/twapi5.0b1/base.tcl | 1876 + .../lib_tcl9/twapi5.0b1/clipboard.tcl | 254 + .../lib_tcl9/twapi5.0b1/com.tcl | 4238 + .../lib_tcl9/twapi5.0b1/console.tcl | 736 + .../lib_tcl9/twapi5.0b1/crypto.tcl | 3456 + .../lib_tcl9/twapi5.0b1/device.tcl | 624 + .../lib_tcl9/twapi5.0b1/etw.tcl | 1390 + .../lib_tcl9/twapi5.0b1/eventlog.tcl | 391 + .../lib_tcl9/twapi5.0b1/evt.tcl | 718 + .../lib_tcl9/twapi5.0b1/handle.tcl | 236 + .../lib_tcl9/twapi5.0b1/input.tcl | 623 + .../lib_tcl9/twapi5.0b1/msi.tcl | 432 + .../lib_tcl9/twapi5.0b1/mstask.tcl | 745 + .../lib_tcl9/twapi5.0b1/multimedia.tcl | 75 + .../lib_tcl9/twapi5.0b1/namedpipe.tcl | 103 + .../lib_tcl9/twapi5.0b1/network.tcl | 1124 + .../lib_tcl9/twapi5.0b1/nls.tcl | 467 + .../lib_tcl9/twapi5.0b1/os.tcl | 1213 + .../lib_tcl9/twapi5.0b1/pdh.tcl | 984 + .../lib_tcl9/twapi5.0b1/pkgIndex.tcl | 100 + .../lib_tcl9/twapi5.0b1/power.tcl | 136 + .../lib_tcl9/twapi5.0b1/printer.tcl | 58 + .../lib_tcl9/twapi5.0b1/process.tcl | 2028 + .../lib_tcl9/twapi5.0b1/rds.tcl | 191 + .../lib_tcl9/twapi5.0b1/registry.tcl | 490 + .../lib_tcl9/twapi5.0b1/resource.tcl | 458 + .../lib_tcl9/twapi5.0b1/security.tcl | 2392 + .../lib_tcl9/twapi5.0b1/service.tcl | 1187 + .../lib_tcl9/twapi5.0b1/share.tcl | 966 + .../lib_tcl9/twapi5.0b1/shell.tcl | 627 + .../lib_tcl9/twapi5.0b1/sspi.tcl | 801 + .../lib_tcl9/twapi5.0b1/storage.tcl | 616 + .../lib_tcl9/twapi5.0b1/synch.tcl | 94 + .../lib_tcl9/twapi5.0b1/tls.tcl | 1313 + .../lib_tcl9/twapi5.0b1/twapi.tcl | 855 + .../lib_tcl9/twapi5.0b1/ui.tcl | 1430 + .../lib_tcl9/twapi5.0b1/win.tcl | 131 + .../twapi5.0b1/win32-x86_64/tcl9twapi50b1.dll | Bin 0 -> 658432 bytes .../lib_tcl9/twapi5.0b1/winlog.tcl | 304 + .../lib_tcl9/twapi5.0b1/winsta.tcl | 113 + .../lib_tcl9/twapi5.0b1/wmi.tcl | 223 + .../lib_tcl9/twapi5.0b1/wts.tcl | 64 + ...main.tcl#@punk%3a%3aboot,merge_over#.fxlnk | 0 .../modules_tcl9/http-2.10.0.tm | 5514 + .../modules_tcl9/msgcat-1.7.1.tm | 1349 + .../modules_tcl9/platform-1.0.19.tm | 450 + .../modules_tcl9/platform/shell-1.1.4.tm | 241 + .../modules_tcl9/promise-1.2.0.tm | 1311 + .../modules_tcl9/tcltest-2.5.8.tm | 3588 + .../modules_tcl9/tdbc/sqlite3-1.1.9.tm | 751 + .../modules_tcl9/tdbc/sqlite3-1.1.9.uuid | 1 + 2147 files changed, 842643 insertions(+), 8297 deletions(-) create mode 100644 src/bootsupport/modules/argparsingtest-0.1.0.tm create mode 100644 src/bootsupport/modules/punk/pipe-1.0.tm create mode 100644 src/bootsupport/modules_tcl8/win32_x86_64_tcl8-2.8.9.tm create mode 100644 src/modules/punk/pcon-999999.0a1.0.tm create mode 100644 src/modules/punk/pcon-buildversion.txt create mode 100644 src/modules/punk/pipe-999999.0a1.0.tm create mode 100644 src/modules/punk/pipe-buildversion.txt create mode 100644 src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/argparsingtest-0.1.0.tm create mode 100644 src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/pipe-1.0.tm create mode 100644 src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/argparsingtest-0.1.0.tm create mode 100644 src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/pipe-1.0.tm create mode 100644 src/vfs/_vfscommon.vfs/modules/pipe-1.0.tm create mode 100644 src/vfs/_vfscommon.vfs/modules/punk/pcon-1.0.tm create mode 100644 src/vfs/_vfscommon.vfs/modules/punk/pipe-1.0.tm create mode 100644 src/vfs/punk9magicsplat.vfs/bin/concrt140.dll create mode 100644 src/vfs/punk9magicsplat.vfs/bin/libtommath.dll create mode 100644 src/vfs/punk9magicsplat.vfs/bin/msvcp140.dll create mode 100644 src/vfs/punk9magicsplat.vfs/bin/msvcp140_1.dll create mode 100644 src/vfs/punk9magicsplat.vfs/bin/msvcp140_2.dll create mode 100644 src/vfs/punk9magicsplat.vfs/bin/msvcp140_atomic_wait.dll create mode 100644 src/vfs/punk9magicsplat.vfs/bin/msvcp140_codecvt_ids.dll create mode 100644 src/vfs/punk9magicsplat.vfs/bin/tcl90.dll create mode 100644 src/vfs/punk9magicsplat.vfs/bin/tcl9tk90.dll create mode 100644 src/vfs/punk9magicsplat.vfs/bin/vccorlib140.dll create mode 100644 src/vfs/punk9magicsplat.vfs/bin/vcruntime140.dll create mode 100644 src/vfs/punk9magicsplat.vfs/bin/vcruntime140_1.dll create mode 100644 src/vfs/punk9magicsplat.vfs/bin/vcruntime140_threads.dll create mode 100644 src/vfs/punk9magicsplat.vfs/bin/zlib1.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/ArrowButton.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/BWidget.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/Button.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/ButtonBox.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/ComboBox.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/Dialog.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/DragSite.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/DropSite.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/DynamicHelp.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/Entry.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/Label.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/LabelEntry.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/LabelFrame.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/ListBox.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/MainFrame.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/MessageDlg.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/NoteBook.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/PagesManager.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/PanedWindow.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/PanelFrame.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/PasswdDlg.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/ProgressBar.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/ProgressDlg.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/ScrollView.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/ScrollableFrame.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/ScrolledWindow.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/SelectColor.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/SelectFont.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/Separator.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/SpinBox.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/StatusBar.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/TitleFrame.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/Tree.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/Widget.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/contents.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/index.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/navtree.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/BWman/options.htm create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/CHANGES.txt create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/ChangeLog create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/LICENSE.txt create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/README.txt create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/arrow.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/bitmap.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/button.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/buttonbox.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/color.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/combobox.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/demo/basic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/demo/bwidget.xbm create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/demo/demo.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/demo/dnd.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/demo/manager.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/demo/select.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/demo/tmpldlg.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/demo/tree.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/demo/x1.xbm create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/dialog.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/dragsite.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/dropsite.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/dynhelp.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/entry.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/font.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/bold.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/copy.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/cut.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/dragfile.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/dragicon.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/error.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/file.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/folder.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/hourglass.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/info.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/italic.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/minus.xbm create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/new.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/opcopy.xbm create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/open.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/openfold.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/oplink.xbm create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/opmove.xbm create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/overstrike.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/palette.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/passwd.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/paste.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/plus.xbm create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/print.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/question.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/redo.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/save.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/target.xbm create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/underline.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/undo.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/images/warning.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/init.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/label.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/labelentry.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/labelframe.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/lang/da.rc create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/lang/de.rc create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/lang/en.rc create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/lang/es.rc create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/lang/fr.rc create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/lang/hu.rc create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/lang/nl.rc create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/lang/no.rc create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/lang/pl.rc create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/listbox.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/mainframe.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/messagedlg.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/notebook.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/pagesmgr.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/panedw.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/panelframe.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/passwddlg.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/progressbar.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/progressdlg.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/scrollframe.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/scrollview.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/scrollw.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/separator.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/spinbox.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/statusbar.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/tests/entry.test create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/titleframe.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/tree.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/utils.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/widget.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/wizard.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/bwidget1.10.0/xpm2image.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/Applications/AbbrExample.docx create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/Applications/DocumentInfo.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/Applications/EnumExplorer.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/Applications/FindTypeLibs.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/Applications/MailAttachment.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/Applications/OneNoteInfo.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/Applications/OneNoteMailList.txt create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/Applications/Word2Pdf.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/Applications/WordAbbrCheck.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CAWT-License.txt create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtCore/cawtBasic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtCore/cawtClipboard.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtCore/cawtColorUtil.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtCore/cawtDateUtil.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtCore/cawtEmbed.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtCore/cawtFileUtil.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtCore/cawtImgUtil.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtCore/cawtInterpolate.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtCore/cawtStringUtil.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtCore/cawtTestUtil.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtCore/pkgInit.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtEarth/earthBasic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtEarth/pkgInit.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtExcel/excelBasic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtExcel/excelChart.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtExcel/excelConst.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtExcel/excelCsv.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtExcel/excelHtml.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtExcel/excelImgRaw.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtExcel/excelMatlabFile.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtExcel/excelMediaWiki.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtExcel/excelTablelist.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtExcel/excelUtil.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtExcel/excelWikit.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtExcel/excelWord.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtExcel/pkgInit.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtExplorer/explorerBasic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtExplorer/pkgInit.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtMatlab/matlabBasic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtMatlab/pkgInit.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtOcr/ocrBasic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtOcr/pkgInit.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtOffice/officeBasic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtOffice/officeConst.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtOffice/pkgInit.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtOneNote/oneNoteBasic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtOneNote/oneNoteConst.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtOneNote/pkgInit.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtOutlook/outlookBasic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtOutlook/outlookCalendar.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtOutlook/outlookCategory.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtOutlook/outlookColor.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtOutlook/outlookConst.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtOutlook/outlookContact.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtOutlook/outlookMail.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtOutlook/pkgInit.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtPpt/pkgInit.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtPpt/pptBasic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtPpt/pptConst.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtPpt/pptShapes.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtPpt/pptUtil.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtReader/pkgInit.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtReader/readerBasic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtSapi/pkgInit.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtSapi/sapiBasic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtSapi/sapiConst.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtWord/pkgInit.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtWord/wordBasic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtWord/wordConst.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/CawtWord/wordUtil.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/Readme.txt create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Cawt-01_Basic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Cawt-02_Color.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Cawt-03_Date.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Cawt-04_String.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Cawt-05_File.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Cawt-06_Img.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Cawt-07_ComObj.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Cawt-08_TestUtil.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Cawt-09_Embed.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Cawt-10_Interpolate.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Cawt-11_Url.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Earth-01_Basic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Earth-02_MunichTour.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-01_Basic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-02_Misc.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-03_Add.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-04_Insert.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-05_Ranges.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-06_Chart.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-07_Csv.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-07_CsvUniCode.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-08_Tablelist.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-08_TablelistSelection.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-09_WordTable.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-10_Matrix.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-11_RawImage-16bit.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-11_RawImage.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-12_MatlabFile.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-13_MediaWiki.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-14_Wikit.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-14_WikitWithLinks.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-15_Clipboard.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-16_SetGet.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-17_Diff.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-17_DiffEqual.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-18_SparseMatrix.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-19_MarkLink.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-20_ImgUtil.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-21_ImgCell.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-22_Html.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-23_Font-Attributes.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-23_Font.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-24_Format.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-25_Properties.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-26_PageSetup.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-27_RowColumn.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-28_NamedRange.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-29_EmptySheet.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-30_SelectRange.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-31_Import.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-32_Quit.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-33_AddAndRunMacro.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-33_ImportAndRunMacro.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-33_RunMacro.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-34_Events.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-35_Styles.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-36_Embed.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-37_WorksheetName.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Excel-38_Interpolate.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Explorer-01_Basic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Explorer-02_Misc.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Explorer-03_Events.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Matlab-01_Basic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Matlab-02_MFile.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Ocr-01_Basic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Ocr-02_Misc.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/OneNote-01_Basic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Outlook-01_Basic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Outlook-02_Mail.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Outlook-03_Holiday.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Outlook-04_Appointment.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Outlook-05_MailFolders.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Outlook-06_ContactFolders.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Ppt-01_Basic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Ppt-02_Misc.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Ppt-03_Add.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Ppt-04_Present.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Ppt-05_Export.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Ppt-06_CustomLayout.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Ppt-07_Properties.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Ppt-08_Comments.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Ppt-09_Shapes.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Ppt-10_AllShapes.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Ppt-11_AllConnectors.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Ppt-12_Quit.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Ppt-13_Media.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Ppt-14_CreateVideo.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Ppt-15_ButtonEvent.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Ppt-16_Embed.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Reader-01_Basic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Reader-02_Embed.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/RunTest.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/RunTests.bat create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/RunTests.log create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Sapi-01_Basic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Sapi-02_Speak.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Sapi-03_SpeakOptions.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Sapi-04_SpeakFlags.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/SetTestPathes.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Word-01_Basic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Word-02_Table.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Word-02_TableWidth.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Word-03_Text.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Word-04_Find.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Word-04_FindGeneric.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Word-05_Report.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Word-06_Diff.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Word-07_Link.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Word-08_ImgUtil.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Word-09_Controls.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Word-10_Properties.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Word-11_Tables.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Word-12_LargeTable.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Word-13_MultiTables.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Word-14_Quit.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Word-15_MergeCells.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Word-16_ReplaceImages.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Word-17_Subdocuments.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Word-18_PageSetup.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Word-19_Heading.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Word-19_HeadingDict.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Word-20_Font.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Word-21_RunMacro.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Word-22_Events.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/Word-23_Embed.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/Cawt-001.png create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/Cawt-002.png create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/Cawt-003.png create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/Cawt-004.png create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/Cawt-005.png create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/Cawt-006.png create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/Cawt-007.png create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/Cawt-008.png create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/Cawt-009.png create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/Cawt-010.png create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/CawtManual1.pdf create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/CawtManual2.pdf create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/CawtVideo.mp4 create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/CawtVideo.mpg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/CustomLayout.potx create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/Expression.m create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/Holidays.hol create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/HolidaysUnicode.hol create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/InsertMe.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/Landscape.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/MediaWikiTable.txt create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/MultiLine.xls create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/Portrait.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/ReplaceImageTemplate.docx create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/ReportTemplate.doc create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/ReportTemplate.docx create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/SampleMacro.docm create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/SampleMacro.xls create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/SampleMacro.xlsm create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/SampleNamedRange.xls create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/SamplePpt.pptx create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/SampleTable.xls create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/SampleUnicode.xlsx create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/SampleWikitTable.xlsx create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/Square.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/Subdocuments/Master.docx create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/Subdocuments/Sub1.docx create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/Subdocuments/Sub2.docx create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/Subdocuments/Sub3.docx create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/TemplateTable.docx create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/TestMacro.bas create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/WikitTable.txt create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/WordTables.doc create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/gradient-16bit.raw create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/gradient.mat create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/gradient.raw create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/intensity.dat create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/ocr.bmp create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/temperatures.dat create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/TestPrograms/testIn/wish.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/cawt2.9.6/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/libtcl9.0.0.zip create mode 100644 src/vfs/punk9magicsplat.vfs/lib/nmake/nmakehlp.c create mode 100644 src/vfs/punk9magicsplat.vfs/lib/nmake/rules.vc create mode 100644 src/vfs/punk9magicsplat.vfs/lib/nmake/targets.vc create mode 100644 src/vfs/punk9magicsplat.vfs/lib/nmake/tcl.nmake create mode 100644 src/vfs/punk9magicsplat.vfs/lib/nmake/x86_64-w64-mingw32-nmakehlp.exe create mode 100644 src/vfs/punk9magicsplat.vfs/lib/projectInfo/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/projectInfo/projectInfo.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/remotedebug/docs/initdebug.n create mode 100644 src/vfs/punk9magicsplat.vfs/lib/remotedebug/docs/initdebug.pdf create mode 100644 src/vfs/punk9magicsplat.vfs/lib/remotedebug/initdebug.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/remotedebug/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/ruff2.4.2/LICENSE create mode 100644 src/vfs/punk9magicsplat.vfs/lib/ruff2.4.2/README.md create mode 100644 src/vfs/punk9magicsplat.vfs/lib/ruff2.4.2/assets/ruff-index-min.js create mode 100644 src/vfs/punk9magicsplat.vfs/lib/ruff2.4.2/assets/ruff-logo.png create mode 100644 src/vfs/punk9magicsplat.vfs/lib/ruff2.4.2/assets/ruff-md.css create mode 100644 src/vfs/punk9magicsplat.vfs/lib/ruff2.4.2/assets/ruff-min.css create mode 100644 src/vfs/punk9magicsplat.vfs/lib/ruff2.4.2/assets/ruff-min.js create mode 100644 src/vfs/punk9magicsplat.vfs/lib/ruff2.4.2/diagram.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/ruff2.4.2/formatter.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/ruff2.4.2/formatter_html.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/ruff2.4.2/formatter_markdown.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/ruff2.4.2/formatter_nroff.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/ruff2.4.2/msgs/de.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/ruff2.4.2/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/ruff2.4.2/ruff-ruff-sample.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/ruff2.4.2/ruff-ruff.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/ruff2.4.2/ruff.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib/ruff2.4.2/ruff.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/ruff2.4.2/sample.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcl90.lib create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcl9tk90.lib create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/appLaunch.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/bindings.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/blend.pdx create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/block.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/break.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/breakWin.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/codeWin.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/coverage.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/dbg.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/debugger.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/evalWin.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/file.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/find.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/font.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/gui.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/guiUtil.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/icon.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/image.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/about.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/break_d.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/break_e.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/break_m.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/combo_arrow.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/current.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/current_d.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/current_e.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/current_m.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/current_v.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/debugUnixIcon.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/go.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/go_d.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/history.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/history_disable.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/history_enable.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/history_mixed.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/kill.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/kill_d.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/logo.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/refresh.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/refresh_d.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/restart.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/restart_d.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/stepin.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/stepin_d.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/stepout.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/stepout_d.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/stepover.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/stepover_d.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/stepresult.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/stepresult_d.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/stepto.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/stepto_d.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/stop.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/stop_d.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/var_d.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/var_e.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/win_break.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/win_cover.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/win_eval.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/win_proc.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/images/win_watch.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/initdebug.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/inspectorWin.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/instrument.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/location.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/menu.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/nub.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/oratcl.pdx create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/portWin.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/pref.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/prefWin.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/procWin.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/proj.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/projWin.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/result.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/selection.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/stackWin.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/sybtcl.pdx create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/system.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/tabnotebook.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/tclCom.pdx create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/tcltest.pdx create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/tests/all.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/tests/block.test create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/tests/dbgLaunch.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/tests/guiLaunch.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/tests/initProject.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/tests/initdebug.test create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/tests/instrument.test create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/tests/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/tests/pref.test create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/tests/protest.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/tests/startup.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/tests/system.test create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/tkcon.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/toolbar.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/uplevel.pdx create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/util.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/varWin.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/watchWin.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/widget.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tcldebugger/xmlGen.pdx create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tclstub.lib create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/bgerror.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/button.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/choosedir.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/clrpick.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/comdlg.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/console.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/README create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/anilabel.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/aniwave.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/arrow.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/bind.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/bitmap.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/browse create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/button.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/check.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/clrpick.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/colors.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/combo.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/cscroll.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/ctext.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/dialog1.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/dialog2.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/en.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/entry1.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/entry2.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/entry3.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/filebox.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/floor.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/fontchoose.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/form.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/goldberg.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/hello create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/hscale.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/icon.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/image1.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/image2.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/images/Tcl.svg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/images/Tk_feather.png create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/images/earth.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/images/earthmenu.png create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/images/earthris.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/images/flagdown.xbm create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/images/flagup.xbm create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/images/gray25.xbm create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/images/letters.xbm create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/images/noletter.xbm create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/images/ouster.png create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/images/pattern.xbm create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/images/plowed_field.png create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/images/starry_night.png create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/images/tcllogo.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/images/teapot.ppm create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/items.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/ixset create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/knightstour.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/label.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/labelframe.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/license.terms create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/mac_styles.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/mac_tabs.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/mac_wm.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/mclist.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/menu.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/menubu.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/msgbox.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/nl.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/paned1.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/paned2.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/pendulum.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/plot.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/print.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/puzzle.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/radio.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/rmt create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/rolodex create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/ruler.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/sayings.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/search.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/spin.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/square create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/states.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/style.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/systray.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/tclIndex create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/tcolor create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/text.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/textpeer.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/timer create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/toolbar.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/tree.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/ttkbut.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/ttkmenu.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/ttknote.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/ttkpane.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/ttkprogress.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/ttkscale.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/ttkspin.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/twind.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/unicodeout.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/vscale.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/widget create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/demos/windowicons.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/dialog.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/entry.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/focus.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/fontchooser.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/iconbadges.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/iconlist.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/icons.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/images/README create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/images/logo.eps create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/images/logo100.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/images/logo64.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/images/logoLarge.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/images/logoMed.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/images/pwrdLogo.eps create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/images/pwrdLogo100.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/images/pwrdLogo150.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/images/pwrdLogo175.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/images/pwrdLogo200.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/images/pwrdLogo75.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/images/tai-ku.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/license.terms create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/listbox.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/megawidget.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/menu.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/mkpsenc.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/msgbox.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/msgs/cs.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/msgs/da.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/msgs/de.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/msgs/el.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/msgs/en.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/msgs/en_gb.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/msgs/eo.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/msgs/es.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/msgs/fi.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/msgs/fr.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/msgs/hu.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/msgs/it.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/msgs/nl.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/msgs/pl.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/msgs/pt.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/msgs/ru.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/msgs/sv.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/msgs/zh_cn.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/optMenu.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/palette.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/panedwindow.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/print.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/safetk.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/scale.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/scaling.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/scrlbar.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/spinbox.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/systray.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/tclIndex create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/tearoff.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/text.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/tk.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/tkfbox.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/ttk/altTheme.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/ttk/aquaTheme.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/ttk/button.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/ttk/clamTheme.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/ttk/classicTheme.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/ttk/combobox.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/ttk/cursors.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/ttk/defaults.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/ttk/entry.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/ttk/fonts.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/ttk/menubutton.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/ttk/notebook.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/ttk/panedwindow.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/ttk/progress.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/ttk/scale.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/ttk/scrollbar.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/ttk/sizegrip.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/ttk/spinbox.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/ttk/treeview.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/ttk/ttk.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/ttk/utils.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/ttk/vistaTheme.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/ttk/winTheme.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/ttk/xpTheme.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tk9.0/xmfbox.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/autoscroll/autoscroll.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/autoscroll/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/canvas/canvas_drag.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/canvas/canvas_ecircle.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/canvas/canvas_epoints.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/canvas/canvas_epolyline.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/canvas/canvas_equad.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/canvas/canvas_erectangle.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/canvas/canvas_gradient.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/canvas/canvas_highlight.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/canvas/canvas_mvg.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/canvas/canvas_pdf.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/canvas/canvas_snap.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/canvas/canvas_sqmap.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/canvas/canvas_tags.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/canvas/canvas_trlines.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/canvas/canvas_zoom.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/canvas/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/chatwidget/chatwidget.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/chatwidget/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/controlwidget/bindDown.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/controlwidget/controlwidget.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/controlwidget/led.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/controlwidget/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/controlwidget/radioMatrix.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/controlwidget/rdial.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/controlwidget/tachometer.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/controlwidget/vertical_meter.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/controlwidget/voltmeter.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/crosshair/crosshair.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/crosshair/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/ctext/ctext.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/ctext/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/cursor/cursor.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/cursor/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/datefield/datefield.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/datefield/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/diagrams/application.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/diagrams/attributes.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/diagrams/basic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/diagrams/core.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/diagrams/diagram.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/diagrams/direction.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/diagrams/element.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/diagrams/navigation.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/diagrams/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/diagrams/point.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/getstring/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/getstring/tk_getString.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/history/history.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/history/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/ico/ico.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/ico/ico0.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/ico/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/ipentry/ipentry.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/ipentry/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/khim/ROOT.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/khim/cs.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/khim/da.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/khim/de.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/khim/en.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/khim/es.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/khim/khim.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/khim/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/khim/pl.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/khim/ru.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/khim/uk.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/area-display.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/area-file.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/area-map-display.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/area-store-fs.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/area-store-mem.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/area-table-display.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/box-display.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/box-entry.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/box-file.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/box-map-display.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/box-store-fs.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/box-store-mem.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/box-table-display.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/display.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/mark.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/point-file.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/point-map-display.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/point-store-fs.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/point-store-mem.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/point-table-display.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/provider-osm.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/track-display.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/track-entry.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/track-file.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/track-map-display.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/track-store-fs.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/track-store-mem.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/map/track-table-display.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/mentry/mentry.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/mentry/mentryCommon.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/mentry/mentry_tile.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/mentry/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/mentry/scripts/mentryDateTime.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/mentry/scripts/mentryFixedPoint.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/mentry/scripts/mentryIPAddr.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/mentry/scripts/mentryIPv6Addr.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/mentry/scripts/mentryThemes.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/mentry/scripts/mentryWidget.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/mentry/scripts/mwutil/mwutil.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/mentry/scripts/mwutil/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/mentry/scripts/tclIndex create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/menubar/debug.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/menubar/menubar.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/menubar/node.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/menubar/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/menubar/tree.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/notifywindow/notifywindow.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/notifywindow/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/ntext/ntext.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/ntext/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/persistentSelection/persistentSelection.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/persistentSelection/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/plotchart/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/plotchart/plot3d.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/plotchart/plotanim.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/plotchart/plotannot.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/plotchart/plotaxis.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/plotchart/plotbind.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/plotchart/plotbusiness.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/plotchart/plotchart.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/plotchart/plotcombined.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/plotchart/plotconfig.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/plotchart/plotcontour.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/plotchart/plotdendrogram.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/plotchart/plotgantt.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/plotchart/plotobject.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/plotchart/plotpack.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/plotchart/plotpriv.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/plotchart/plotscada.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/plotchart/plotspecial.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/plotchart/plotstatustimeline.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/plotchart/plottable.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/plotchart/scaling.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/plotchart/xyplot.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/scrollutil/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/scrollutil/scripts/attrib.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/scrollutil/scripts/notebookImages.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/scrollutil/scripts/pagesman.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/scrollutil/scripts/plainnotebook.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/scrollutil/scripts/scrollableframe.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/scrollutil/scripts/scrollarea.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/scrollutil/scripts/scrollednotebook.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/scrollutil/scripts/scrollsync.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/scrollutil/scripts/tclIndex create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/scrollutil/scripts/utils/indicatorImgs/gifIndicatorImgs.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/scrollutil/scripts/utils/indicatorImgs/svgIndicatorImgs.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/scrollutil/scripts/utils/indicatorImgs/tclIndex create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/scrollutil/scripts/utils/mwutil.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/scrollutil/scripts/utils/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/scrollutil/scripts/utils/scaleutil.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/scrollutil/scripts/utils/themepatch.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/scrollutil/scripts/wheelEvent.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/scrollutil/scrollutil.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/scrollutil/scrollutilCommon.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/scrollutil/scrollutil_tile.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/shtmlview/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/shtmlview/shtmlview-doctools.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/shtmlview/shtmlview-mkdoc.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/shtmlview/shtmlview.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/style/as.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/style/lobster.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/style/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/style/style.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/swaplist/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/swaplist/swaplist.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tablelist/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tablelist/scripts/pencil.cur create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tablelist/scripts/tablelistBind.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tablelist/scripts/tablelistConfig.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tablelist/scripts/tablelistEdit.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tablelist/scripts/tablelistImages.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tablelist/scripts/tablelistMove.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tablelist/scripts/tablelistSort.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tablelist/scripts/tablelistThemes.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tablelist/scripts/tablelistUtil.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tablelist/scripts/tablelistWidget.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tablelist/scripts/tclIndex create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tablelist/scripts/utils/indicatorImgs/gifIndicatorImgs.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tablelist/scripts/utils/indicatorImgs/svgIndicatorImgs.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tablelist/scripts/utils/indicatorImgs/tclIndex create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tablelist/scripts/utils/mwutil.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tablelist/scripts/utils/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tablelist/scripts/utils/scaleutil.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tablelist/scripts/utils/scaleutilMisc.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tablelist/scripts/utils/themepatch.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tablelist/tablelist.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tablelist/tablelistCommon.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tablelist/tablelist_tile.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/text/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/text/txmixins.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tkpiechart/boxlabel.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tkpiechart/canlabel.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tkpiechart/labarray.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tkpiechart/objselec.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tkpiechart/perilabel.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tkpiechart/pie.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tkpiechart/pielabel.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tkpiechart/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tkpiechart/relirect.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tkpiechart/selector.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tkpiechart/slice.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tkpiechart/tkpiechart.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tooltip/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tooltip/tipstack.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/tooltip/tooltip.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/treeview/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/treeview/tvmixins.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/wcb/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/wcb/scripts/tclIndex create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/wcb/scripts/wcbCommon.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/wcb/scripts/wcbEntry.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/wcb/scripts/wcbListbox.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/wcb/scripts/wcbTablelist.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/wcb/scripts/wcbText.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/wcb/scripts/wcbTreeview.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/wcb/wcb.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widget/arrowb.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widget/calendar.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widget/dateentry.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widget/dialog.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widget/mentry.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widget/panelframe.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widget/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widget/ruler.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widget/scrollw.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widget/statusbar.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widget/stext.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widget/superframe.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widget/toolbar.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widget/widget.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widgetPlus/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widgetPlus/widgetPlus.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widgetl/icons/add.png create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widgetl/icons/arrow_down.png create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widgetl/icons/arrow_up.png create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widgetl/icons/delete.png create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widgetl/icons/folder_explore.png create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widgetl/listentry.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widgetl/listsimple.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widgetl/msgs/de.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widgetl/msgs/en.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widgetl/msgs/root.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widgetl/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widgetv/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tklib0.8/widgetv/validator.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tkstub.lib create mode 100644 src/vfs/punk9magicsplat.vfs/lib/tommath.lib create mode 100644 src/vfs/punk9magicsplat.vfs/lib/zdll.lib create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/jpegtclstub.lib create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/pngtclstub.lib create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/tcl9jpegtcl960.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/tcl9pngtcl1644.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/tcl9tifftcl470.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/tcl9tkimg200.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/tcl9tkimgbmp200.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/tcl9tkimgdted200.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/tcl9tkimgflir200.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/tcl9tkimggif200.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/tcl9tkimgico200.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/tcl9tkimgjpeg200.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/tcl9tkimgpcx200.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/tcl9tkimgpixmap200.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/tcl9tkimgpng200.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/tcl9tkimgppm200.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/tcl9tkimgps200.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/tcl9tkimgraw200.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/tcl9tkimgsgi200.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/tcl9tkimgsun200.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/tcl9tkimgtga200.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/tcl9tkimgtiff200.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/tcl9tkimgwindow200.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/tcl9tkimgxbm200.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/tcl9tkimgxpm200.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/tcl9zlibtcl131.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/tifftclstub.lib create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/tkimgstub.lib create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/Img2.0.0/zlibtclstub.lib create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/cffi2.0b1/LICENSE create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/cffi2.0b1/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/cffi2.0b1/win32-x86_64/tcl9cffi20b1.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/dde1.4/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/dde1.4/tcl9dde14.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/iocp2.0b1/LICENSE create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/iocp2.0b1/bt.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/iocp2.0b1/btnames.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/iocp2.0b1/btsdr.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/iocp2.0b1/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/iocp2.0b1/win32-x86_64/tcl9iocp20b1.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/itcl4.3.1/itcl.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/itcl4.3.1/itclHullCmds.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/itcl4.3.1/itclWidget.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/itcl4.3.1/itclstub.lib create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/itcl4.3.1/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/itcl4.3.1/tcl9itcl431.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/itcl4.3.1/test_Itcl_CreateObject.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/registry1.3/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/registry1.3/tcl9registry13.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/sqlite3.45.3/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/sqlite3.45.3/sqlite3.n create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/sqlite3.45.3/tcl9sqlite3453.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tclcsv2.4.3/LICENSE create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tclcsv2.4.3/README.md create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tclcsv2.4.3/csv.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tclcsv2.4.3/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tclcsv2.4.3/widgets.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tclcsv2.4.3/win32-x86_64/tcl9tclcsv243.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/0compatibility/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/aes/aes.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/aes/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/amazon-s3/S3.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/amazon-s3/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/amazon-s3/xsxp.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/asn/asn.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/asn/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/base32/base32.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/base32/base32_c.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/base32/base32_tcl.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/base32/base32core.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/base32/base32hex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/base32/base32hex_c.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/base32/base32hex_tcl.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/base32/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/base64/ascii85.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/base64/base64.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/base64/base64c.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/base64/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/base64/uuencode.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/base64/yencode.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/bee/bee.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/bee/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/bench/bench.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/bench/bench_read.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/bench/bench_wcsv.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/bench/bench_wtext.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/bench/libbench.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/bench/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/bibtex/bibtex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/bibtex/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/blowfish/blowfish.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/blowfish/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/cache/async.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/cache/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/clay/clay.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/clay/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/clock/iso8601.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/clock/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/clock/rfc2822.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/cmdline/cmdline.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/cmdline/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/comm/comm.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/comm/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/control/ascaller.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/control/assert.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/control/control.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/control/do.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/control/no-op.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/control/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/control/tclIndex create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/coroutine/coro_auto.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/coroutine/coroutine.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/coroutine/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/counter/counter.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/counter/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/crc/cksum.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/crc/crc16.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/crc/crc32.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/crc/crc32c.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/crc/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/crc/sum.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/crc/sumc.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/cron/cron.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/cron/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/csv/csv.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/csv/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/debug/caller.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/debug/debug.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/debug/heartbeat.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/debug/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/debug/timestamp.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/defer/defer.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/defer/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/des/des.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/des/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/des/tcldes.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/des/tcldesjr.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/dicttool/dicttool.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/dicttool/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/dns/dns.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/dns/ip.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/dns/ipMore.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/dns/ipMoreC.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/dns/msgs/en.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/dns/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/dns/resolv.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/dns/spf.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/docstrip/docstrip.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/docstrip/docstrip_util.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/docstrip/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/api.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/api_idx.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/api_toc.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/changelog.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/checker.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/checker_idx.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/checker_toc.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/cvs.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/docidx.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/doctoc.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/doctools.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/_common.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/_html.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/_idx_common.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/_markdown.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/_nroff.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/_text.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/_text_bullets.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/_text_ccore.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/_text_cstack.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/_text_dlist.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/_text_margin.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/_text_para.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/_text_state.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/_text_utils.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/_toc_common.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/_xml.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/_xref.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/c.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/de.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/en.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/fmt.desc create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/fmt.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/fmt.latex create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/fmt.list create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/fmt.markdown create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/fmt.nroff create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/fmt.null create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/fmt.text create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/fmt.tmml create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/fmt.wiki create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/fr.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/idx.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/idx.markdown create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/idx.nroff create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/idx.null create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/idx.text create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/idx.wiki create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/man.macros create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/toc.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/toc.markdown create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/toc.nroff create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/toc.null create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/toc.text create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/toc.tmml create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/mpformats/toc.wiki create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2base/html.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2base/html_cssdefaults.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2base/msgcat.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2base/nroff_manmacros.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2base/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2base/tcl_parse.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2base/text.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2idx/container.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2idx/export.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2idx/export_docidx.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2idx/export_html.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2idx/export_json.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2idx/export_nroff.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2idx/export_text.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2idx/export_wiki.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2idx/import.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2idx/import_docidx.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2idx/import_json.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2idx/msgcat_c.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2idx/msgcat_de.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2idx/msgcat_en.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2idx/msgcat_fr.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2idx/parse.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2idx/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2idx/structure.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2toc/container.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2toc/export.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2toc/export_doctoc.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2toc/export_html.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2toc/export_json.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2toc/export_nroff.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2toc/export_text.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2toc/export_wiki.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2toc/import.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2toc/import_doctoc.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2toc/import_json.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2toc/msgcat_c.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2toc/msgcat_de.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2toc/msgcat_en.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2toc/msgcat_fr.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2toc/parse.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2toc/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/doctools2toc/structure.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/dtplite/dtplite.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/dtplite/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/fileutil/decode.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/fileutil/fileutil.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/fileutil/multi.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/fileutil/multiop.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/fileutil/paths.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/fileutil/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/fileutil/traverse.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/ftp/ftp.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/ftp/ftp_geturl.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/ftp/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/ftpd/ftpd.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/ftpd/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/fumagic/cfront.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/fumagic/cgen.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/fumagic/filetypes.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/fumagic/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/fumagic/rtcore.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/generator/generator.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/generator/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/gpx/gpx.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/gpx/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/grammar_aycock/aycock-build.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/grammar_aycock/aycock-debug.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/grammar_aycock/aycock-runtime.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/grammar_aycock/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/grammar_fa/dacceptor.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/grammar_fa/dexec.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/grammar_fa/fa.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/grammar_fa/faop.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/grammar_fa/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/grammar_me/gasm.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/grammar_me/me_cpu.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/grammar_me/me_cpucore.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/grammar_me/me_tcl.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/grammar_me/me_util.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/grammar_me/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/grammar_peg/peg.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/grammar_peg/peg_interp.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/grammar_peg/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/hook/hook.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/hook/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/html/html.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/html/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/htmlparse/htmlparse.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/htmlparse/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/http/autoproxy.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/http/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/httpd/httpd.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/httpd/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/httpwget/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/httpwget/wget.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/ident/ident.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/ident/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/imap4/imap4.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/imap4/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/inifile/ini.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/inifile/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/interp/deleg_method.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/interp/deleg_proc.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/interp/interp.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/interp/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/irc/irc.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/irc/picoirc.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/irc/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/javascript/javascript.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/javascript/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/jpeg/jpeg.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/jpeg/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/json/json.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/json/json_tcl.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/json/json_write.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/json/jsonc.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/json/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/lambda/lambda.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/lambda/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/lazyset/lazyset.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/lazyset/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/ldap/ldap.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/ldap/ldapx.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/ldap/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/log/log.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/log/logger.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/log/loggerAppender.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/log/loggerUtils.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/log/msgs/en.msg create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/log/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/map/map_geocode_nominatim.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/map/map_slippy.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/map/map_slippy_c.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/map/map_slippy_cache.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/map/map_slippy_fetcher.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/map/map_slippy_tcl.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/map/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/mapproj/mapproj.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/mapproj/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/markdown/markdown.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/markdown/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/bessel.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/bigfloat2.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/bignum.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/calculus.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/changepoint.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/classic_polyns.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/combinatorics.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/combinatoricsExt.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/constants.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/decimal.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/elliptic.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/exact.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/exponential.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/figurate.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/filtergen.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/fourier.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/fuzzy.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/geometry.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/geometry_circle.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/geometry_ext.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/interpolate.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/kruskal.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/linalg.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/liststat.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/machineparameters.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/math.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/misc.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/mvlinreg.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/numtheory.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/optimize.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/pca.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/pdf_stat.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/plotstat.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/polynomials.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/primes.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/probopt.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/probopt_diffev.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/probopt_lipo.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/probopt_pso.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/probopt_sce.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/qcomplex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/quasirandom.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/rational_funcs.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/romannumerals.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/rootfind.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/special.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/stat_kernel.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/stat_logit.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/stat_wasserstein.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/statistics.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/symdiff.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/tclIndex create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/trig.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/math/wilcoxon.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/md4/md4.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/md4/md4c.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/md4/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/md5/md5.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/md5/md5c.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/md5/md5x.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/md5/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/md5c/critcl-rt.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/md5c/license.terms create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/md5c/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/md5c/teapot.txt create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/md5c/win32-x86_64/md5c.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/md5crypt/md5crypt.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/md5crypt/md5cryptc.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/md5crypt/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/mime/mime.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/mime/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/mime/smtp.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/mkdoc/mkdoc.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/mkdoc/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/multiplexer/multiplexer.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/multiplexer/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/namespacex/namespacex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/namespacex/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/ncgi/ncgi.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/ncgi/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/nettool/nettool.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/nettool/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/nmea/nmea.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/nmea/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/nns/common.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/nns/nns.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/nns/nns_auto.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/nns/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/nns/server.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/nntp/nntp.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/nntp/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/ntp/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/ntp/time.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/oauth/oauth.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/oauth/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/oodialect/oodialect.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/oodialect/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/oometa/oometa.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/oometa/oooption.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/oometa/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/ooutil/ooutil.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/ooutil/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/otp/otp.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/otp/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/analysis_peg_emodes.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/analysis_peg_minimize.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/analysis_peg_reachable.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/analysis_peg_realizable.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/compiler_peg_mecpu.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/gen_peg_canon.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/gen_peg_cpkg.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/gen_peg_hb.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/gen_peg_me.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/gen_peg_me.template create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/gen_peg_mecpu.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/gen_peg_mecpu.template create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/gen_peg_ser.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/gen_tree_text.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/parse_lemon.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/parse_peg.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/parse_peghb.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/parse_pegser.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/peg_grammar.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/pluginmgr.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/plugins/config_peg.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/plugins/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/plugins/reader_hb.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/plugins/reader_lemon.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/plugins/reader_peg.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/plugins/reader_ser.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/plugins/reader_treeser.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/plugins/transform_mecpu.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/plugins/transform_reachable.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/plugins/transform_realizable.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/plugins/writer_hb.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/plugins/writer_identity.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/plugins/writer_me.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/plugins/writer_mecpu.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/plugins/writer_null.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/plugins/writer_peg.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/plugins/writer_ser.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/plugins/writer_tpc.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/plugins/writer_tree.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/util_flow.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/util_norm_lemon.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/util_norm_peg.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/util_peg.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/page/util_quote.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pki/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pki/pki.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pluginmgr/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pluginmgr/pluginmgr.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/png/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/png/png.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pop3/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pop3/pop3.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pop3d/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pop3d/pop3d.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pop3d/pop3d_dbox.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pop3d/pop3d_udb.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/practcl/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/practcl/practcl.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/processman/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/processman/processman.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/profiler/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/profiler/profiler.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/char.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_astree.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_cparam_config_critcl.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_cparam_config_tea.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_parse_peg.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_parse_peg_c.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_parse_peg_tcl.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_peg_container.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_peg_container_peg.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_peg_export.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_peg_export_container.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_peg_export_json.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_peg_export_peg.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_peg_from_json.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_peg_from_peg.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_peg_import.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_peg_import_json.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_peg_import_peg.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_peg_interp.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_peg_op.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_peg_to_container.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_peg_to_cparam.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_peg_to_json.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_peg_to_param.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_peg_to_peg.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_peg_to_tclparam.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_pegrammar.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_pexpr_op.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_pexpression.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_pgen.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_rdengine.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_rdengine_c.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_rdengine_nx.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_rdengine_oo.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_rdengine_tcl.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_tclparam_config_nx.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_tclparam_config_snit.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_tclparam_config_tcloo.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/pt_util.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/rde_critcl/m.c create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/rde_critcl/m.h create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/rde_critcl/ms.c create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/rde_critcl/ms.h create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/rde_critcl/ot.c create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/rde_critcl/ot.h create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/rde_critcl/p.c create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/rde_critcl/p.h create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/rde_critcl/pInt.h create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/rde_critcl/param.c create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/rde_critcl/param.h create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/rde_critcl/stack.c create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/rde_critcl/stack.h create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/rde_critcl/tc.c create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/rde_critcl/tc.h create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/rde_critcl/util.c create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/rde_critcl/util.h create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/pt/text_write.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/rc4/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/rc4/rc4.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/rc4/rc4c.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/rcs/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/rcs/rcs.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/report/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/report/report.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/rest/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/rest/rest.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/ripemd/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/ripemd/ripemd128.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/ripemd/ripemd160.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/sasl/gtoken.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/sasl/ntlm.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/sasl/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/sasl/sasl.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/sasl/scram.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/sha1/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/sha1/sha1.c create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/sha1/sha1.h create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/sha1/sha1.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/sha1/sha1c.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/sha1/sha1v1.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/sha1/sha256.c create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/sha1/sha256.h create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/sha1/sha256.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/sha1/sha256c.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/simulation/annealing.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/simulation/montecarlo.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/simulation/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/simulation/random.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/smtpd/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/smtpd/smtpd.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/snit/main1.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/snit/main2.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/snit/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/snit/snit.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/snit/snit2.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/snit/validate.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/soundex/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/soundex/soundex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/stooop/mkpkgidx.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/stooop/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/stooop/stooop.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/stooop/switched.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/stooop/xifo.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/string/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/string/token.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/string/token_shell.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/stringprep/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/stringprep/stringprep.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/stringprep/stringprep_data.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/stringprep/unicode.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/stringprep/unicode_data.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/disjointset.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/graph.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/graph1.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/graph_c.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/graph_tcl.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/graphops.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/list.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/list.test.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/map.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/matrix.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/pool.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/prioqueue.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/queue.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/queue_c.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/queue_oo.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/queue_tcl.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/record.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/sets.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/sets_c.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/sets_tcl.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/skiplist.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/stack.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/stack_c.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/stack_oo.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/stack_tcl.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/struct.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/struct1.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/tree.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/tree1.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/tree_c.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/struct/tree_tcl.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/tar/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/tar/tar.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/tcllibc/critcl-rt.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/tcllibc/license.terms create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/tcllibc/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/tcllibc/teapot.txt create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/tcllibc/win32-x86_64/tcllibc.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/tepam/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/tepam/tepam.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/tepam/tepam_doc_gen.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/term/ansi/code.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/term/ansi/code/attr.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/term/ansi/code/ctrl.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/term/ansi/code/macros.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/term/ansi/ctrlunix.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/term/ansi/send.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/term/bind.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/term/imenu.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/term/ipager.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/term/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/term/receive.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/term/send.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/term/term.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/textutil/adjust.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/textutil/dehypht.tex create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/textutil/eshyph_vo.tex create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/textutil/expander.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/textutil/ithyph.tex create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/textutil/patch.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/textutil/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/textutil/repeat.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/textutil/split.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/textutil/string.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/textutil/tabify.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/textutil/textutil.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/textutil/trim.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/textutil/wcswidth.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/tie/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/tie/tie.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/tie/tie_array.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/tie/tie_dsource.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/tie/tie_file.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/tie/tie_growfile.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/tie/tie_log.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/tie/tie_rarray.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/tiff/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/tiff/tiff.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/tool/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/tool/tool.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/transfer/connect.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/transfer/copyops.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/transfer/ddest.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/transfer/dsource.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/transfer/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/transfer/receiver.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/transfer/tqueue.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/transfer/transmitter.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/treeql/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/treeql/treeql.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/treeql/treeql84.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/treeql/treeql85.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/try/fhome.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/try/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/try/throw.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/try/try.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/udpcluster/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/udpcluster/udpcluster.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/uev/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/uev/uevent.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/uev/uevent_onidle.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/units/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/units/units.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/uri/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/uri/uri.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/uri/urn-scheme.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/uuid/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/uuid/uuid.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/valtype/cc_amex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/valtype/cc_discover.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/valtype/cc_mastercard.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/valtype/cc_visa.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/valtype/ean13.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/valtype/iban.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/valtype/imei.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/valtype/isbn.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/valtype/luhn.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/valtype/luhn5.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/valtype/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/valtype/usnpi.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/valtype/valtype.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/valtype/verhoeff.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_base/cat.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_base/facade.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_base/fifo.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_base/fifo2.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_base/halfpipe.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_base/memchan.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_base/null.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_base/nullzero.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_base/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_base/random.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_base/randseed.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_base/std.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_base/string.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_base/textwindow.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_base/variable.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_base/zero.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_core/core.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_core/events.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_core/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_core/transformcore.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_transform/adler32.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_transform/base64.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_transform/counter.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_transform/crc32.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_transform/hex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_transform/identity.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_transform/limitsize.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_transform/observe.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_transform/otp.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_transform/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_transform/rot.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_transform/spacer.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/virtchannel_transform/zlib.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/websocket/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/websocket/websocket.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/wip/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/wip/wip.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/wip/wip2.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/yaml/huddle.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/yaml/huddle_types.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/yaml/json2huddle.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/yaml/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/yaml/yaml.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/zip/decode.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/zip/encode.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/zip/mkzip.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tcllib2.0/zip/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tclparser1.9/parse.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tclparser1.9/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tclparser1.9/tcl9tclparser19.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdbc1.1.9/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdbc1.1.9/tcl9tdbc119.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdbc1.1.9/tdbc.n create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdbc1.1.9/tdbc.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdbc1.1.9/tdbcConfig.sh create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdbc1.1.9/tdbc_connection.n create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdbc1.1.9/tdbc_mapSqlState.n create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdbc1.1.9/tdbc_resultset.n create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdbc1.1.9/tdbc_statement.n create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdbc1.1.9/tdbc_tokenize.n create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdbc1.1.9/tdbcstub.lib create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdbcmysql1.1.9/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdbcmysql1.1.9/tcl9tdbcmysql119.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdbcmysql1.1.9/tdbc_mysql.n create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdbcmysql1.1.9/tdbcmysql.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdbcodbc1.1.9/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdbcodbc1.1.9/tcl9tdbcodbc119.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdbcodbc1.1.9/tdbc_odbc.n create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdbcodbc1.1.9/tdbcodbc.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdbcpostgres1.1.9/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdbcpostgres1.1.9/tcl9tdbcpostgres119.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdbcpostgres1.1.9/tdbc_postgres.n create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdbcpostgres1.1.9/tdbcpostgres.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdbcsqlite31.1.9/tdbc_sqlite3.n create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdom0.9.5/category-index.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdom0.9.5/dom.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdom0.9.5/domDoc.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdom0.9.5/domNode.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdom0.9.5/expat.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdom0.9.5/expatapi.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdom0.9.5/index.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdom0.9.5/keyword-index.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdom0.9.5/manpage.css create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdom0.9.5/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdom0.9.5/pullparser.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdom0.9.5/schema.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdom0.9.5/tcl9tdom095.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdom0.9.5/tdom.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdom0.9.5/tdomcmd.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdom0.9.5/tdomstub.lib create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdom0.9.5/tnc.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdomhtml0.1.0/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tdomhtml0.1.0/tdomhtml.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/thread3.0.0/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/thread3.0.0/tcl9thread300.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/thread3.0.0/thread.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/thread3.0.0/tpool.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/thread3.0.0/tsv.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/thread3.0.0/ttrace.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/thread3.0.0/ttrace.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tjson1.0.25/LICENSE create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tjson1.0.25/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tjson1.0.25/readme.md create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tjson1.0.25/tcl9tjson1025.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tnc0.3.0/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/tnc0.3.0/tcl9tnc030.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/What-is-New-in-TkTreeCtrl.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/biglist.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/bitmaps.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/column-lock.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/demo.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/explorer.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/firefox.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/gradients.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/gradients2.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/gradients3.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/headers.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/help.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/imovie.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/inspector.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/layout.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/mailwasher.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/mycomputer.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/outlook-folders.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/outlook-newgroup.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/big-dll.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/big-exe.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/big-file.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/big-folder.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/big-txt.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/checked.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/feather.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/file.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/folder-closed.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/folder-open.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/help-book-closed.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/help-book-open.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/help-page.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/imovie-01.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/imovie-02.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/imovie-03.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/imovie-04.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/imovie-05.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/imovie-06.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/imovie-07.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/internet-check-off.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/internet-check-on.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/internet-print.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/internet-radio-off.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/internet-radio-on.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/internet-search.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/internet-security.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/mac-collapse.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/mac-expand.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/outlook-arrow.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/outlook-clip.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/outlook-deleted.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/outlook-draft.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/outlook-folder.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/outlook-group.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/outlook-inbox.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/outlook-local.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/outlook-main.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/outlook-outbox.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/outlook-read-2.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/outlook-read.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/outlook-sent.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/outlook-server.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/outlook-unread.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/outlook-watch.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/sky.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/small-dll.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/small-exe.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/small-file.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/small-folder.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/small-txt.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/pics/unchecked.gif create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/random.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/span.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/style-editor.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/table.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/textvariable.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/demos/www-options.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/filelist-bindings.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/tcl9treectrl25.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/treectrl.html create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/treectrl2.5/treectrl.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/LICENSE create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/README.md create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/account.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/adsi.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/apputil.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/base.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/clipboard.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/com.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/console.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/crypto.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/device.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/etw.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/eventlog.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/evt.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/handle.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/input.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/msi.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/mstask.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/multimedia.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/namedpipe.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/network.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/nls.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/os.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/pdh.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/pkgIndex.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/power.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/printer.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/process.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/rds.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/registry.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/resource.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/security.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/service.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/share.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/shell.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/sspi.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/storage.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/synch.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/tls.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/twapi.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/ui.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/win.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/win32-x86_64/tcl9twapi50b1.dll create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/winlog.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/winsta.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/wmi.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/lib_tcl9/twapi5.0b1/wts.tcl create mode 100644 src/vfs/punk9magicsplat.vfs/main.tcl#..+_config+punk_main.tcl#@punk%3a%3aboot,merge_over#.fxlnk create mode 100644 src/vfs/punk9magicsplat.vfs/modules_tcl9/http-2.10.0.tm create mode 100644 src/vfs/punk9magicsplat.vfs/modules_tcl9/msgcat-1.7.1.tm create mode 100644 src/vfs/punk9magicsplat.vfs/modules_tcl9/platform-1.0.19.tm create mode 100644 src/vfs/punk9magicsplat.vfs/modules_tcl9/platform/shell-1.1.4.tm create mode 100644 src/vfs/punk9magicsplat.vfs/modules_tcl9/promise-1.2.0.tm create mode 100644 src/vfs/punk9magicsplat.vfs/modules_tcl9/tcltest-2.5.8.tm create mode 100644 src/vfs/punk9magicsplat.vfs/modules_tcl9/tdbc/sqlite3-1.1.9.tm create mode 100644 src/vfs/punk9magicsplat.vfs/modules_tcl9/tdbc/sqlite3-1.1.9.uuid diff --git a/src/bootsupport/modules/argparsingtest-0.1.0.tm b/src/bootsupport/modules/argparsingtest-0.1.0.tm new file mode 100644 index 00000000..1ede846b --- /dev/null +++ b/src/bootsupport/modules/argparsingtest-0.1.0.tm @@ -0,0 +1,568 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from -buildversion.txt +# module template: punkshell/src/decktemplates/vendor/punk/modules/template_module-0.0.2.tm +# +# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. +# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# (C) Julian Noble 2024 +# +# @@ Meta Begin +# Application argparsingtest 0.1.0 +# Meta platform tcl +# Meta license MIT +# @@ Meta End + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# doctools header +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[manpage_begin punkshell_module_argparsingtest 0 0.1.0] +#[copyright "2024"] +#[titledesc {Module API}] [comment {-- Name section and table of contents description --}] +#[moddesc {-}] [comment {-- Description at end of page heading --}] +#[require argparsingtest] +#[keywords module] +#[description] +#[para] - + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section Overview] +#[para] overview of argparsingtest +#[subsection Concepts] +#[para] - + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[subsection dependencies] +#[para] packages used by argparsingtest +#[list_begin itemized] + +package require Tcl 8.6- +package require punk::args +package require struct::set +#*** !doctools +#[item] [package {Tcl 8.6}] +#[item] [package {punk::args}] + +# #package require frobz +# #*** !doctools +# #[item] [package {frobz}] + +#*** !doctools +#[list_end] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section API] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# oo::class namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval argparsingtest::class { + #*** !doctools + #[subsection {Namespace argparsingtest::class}] + #[para] class definitions + if {[info commands [namespace current]::interface_sample1] eq ""} { + #*** !doctools + #[list_begin enumerated] + + # oo::class create interface_sample1 { + # #*** !doctools + # #[enum] CLASS [class interface_sample1] + # #[list_begin definitions] + + # method test {arg1} { + # #*** !doctools + # #[call class::interface_sample1 [method test] [arg arg1]] + # #[para] test method + # puts "test: $arg1" + # } + + # #*** !doctools + # #[list_end] [comment {-- end definitions interface_sample1}] + # } + + #*** !doctools + #[list_end] [comment {--- end class enumeration ---}] + } +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Base namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval argparsingtest { + namespace export {[a-z]*} ;# Convention: export all lowercase + #variable xyz + + #*** !doctools + #[subsection {Namespace argparsingtest}] + #[para] Core API functions for argparsingtest + #[list_begin definitions] + + proc test1_ni {args} { + set defaults [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_seps \uFFEF\ + -x ""\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + foreach {k v} $args { + if {$k ni [dict keys $defaults]} { + error "unrecognised option '$k'. Known options [dict keys $defaults]" + } + } + set opts [dict merge $defaults $args] + } + proc test1_switchmerge {args} { + set defaults [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_seps \uFFEF\ + -x ""\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + foreach {k v} $args { + switch -- $k { + -return - -show_edge - -show_seps - -frametype - -x - -y - -z - -1 - -2 - -3 {} + default { + error "unrecognised option '$k'. Known options [dict keys $defaults]" + } + } + } + set opts [dict merge $defaults $args] + } + #if we need to loop to test arg validity anyway - then dict set as we go is slightly faster than a dict merge at the end + proc test1_switch {args} { + set opts [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_seps \uFFEF\ + -x ""\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + foreach {k v} $args { + switch -- $k { + -return - -show_edge - -show_seps - -frametype - -x - -y - -z - -1 - -2 - -3 { + dict set opts $k $v + } + default { + error "unrecognised option '$k'. Known options [dict keys $opts]" + } + } + } + return $opts + } + variable switchopts + set switchopts [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_seps \uFFEF\ + -x ""\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + #slightly slower than just creating the dict within the proc + proc test1_switch_nsvar {args} { + variable switchopts + set opts $switchopts + foreach {k v} $args { + switch -- $k { + -return - -show_edge - -show_seps - -frametype - -x - -y - -z - -1 - -2 - -3 { + dict set opts $k $v + } + default { + error "unrecognised option '$k'. Known options [dict keys $opts]" + } + } + } + return $opts + } + proc test1_switch2 {args} { + set opts [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_seps \uFFEF\ + -x ""\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + set switches [lmap v [dict keys $opts] {list $v -}] + set switches [concat {*}$switches] + set switches [lrange $switches 0 end-1] + foreach {k v} $args { + switch -- $k\ + {*}$switches { + dict set opts $k $v + }\ + default { + error "unrecognised option '$k'. Known options [dict keys $opts]" + } + } + return $opts + } + proc test1_prefix {args} { + set opts [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_seps \uFFEF\ + -x ""\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + foreach {k v} $args { + dict set opts [tcl::prefix::match -message "test1_prefix option $k" {-return -frametype -show_edge -show_seps -x -y -z -1 -2 -3} $k] $v + } + return $opts + } + proc test1_prefix2 {args} { + set opts [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_seps \uFFEF\ + -x ""\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + if {[llength $args]} { + set knownflags [dict keys $opts] + } + foreach {k v} $args { + dict set opts [tcl::prefix::match -message "test1_prefix2 option $k" $knownflags $k] $v + } + return $opts + } + + #punk::args is slower than argp - but comparable, and argp doesn't support solo flags + proc test1_punkargs {args} { + set argd [punk::args::parse $args withdef { + @id -id ::argparsingtest::test1_punkargs + @cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" + @opts -anyopts 0 + -return -default string -type string + -frametype -default \uFFEF -type string + -show_edge -default \uFFEF -type string + -show_seps -default \uFFEF -type string + -join -type none -multiple 1 + -x -default "" -type string + -y -default b -type string + -z -default c -type string + -1 -default 1 -type boolean + -2 -default 2 -type integer + -3 -default 3 -type integer + @values + }] + return [tcl::dict::get $argd opts] + } + + punk::args::define { + @id -id ::test1_punkargs_by_id + @cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" + @opts -anyopts 0 + -return -default string -type string + -frametype -default \uFFEF -type string + -show_edge -default \uFFEF -type string + -show_seps -default \uFFEF -type string + -join -type none -multiple 1 + -x -default "" -type string + -y -default b -type string + -z -default c -type string + -1 -default 1 -type boolean + -2 -default 2 -type integer + -3 -default 3 -type integer + @values + } + proc test1_punkargs_by_id {args} { + set argd [punk::args::get_by_id ::test1_punkargs_by_id $args] + return [tcl::dict::get $argd opts] + } + + punk::args::define { + @id -id ::argparsingtest::test1_punkargs2 + @cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" + @opts -anyopts 0 + -return -default string -type string + -frametype -default \uFFEF -type string + -show_edge -default \uFFEF -type string + -show_seps -default \uFFEF -type string + -join -type none -multiple 1 + -x -default "" -type string + -y -default b -type string + -z -default c -type string + -1 -default 1 -type boolean + -2 -default 2 -type integer + -3 -default 3 -type integer + @values + } + proc test1_punkargs2 {args} { + set argd [punk::args::get_by_id ::argparsingtest::test1_punkargs2 $args] + return [tcl::dict::get $argd opts] + } + + + proc test1_punkargs_validate_ansistripped {args} { + set argd [punk::args::get_dict { + @id -id ::argparsingtest::test1_punkargs_validate_ansistripped + @cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" + @opts -anyopts 0 + -return -default string -type string -choices {string object} -help "return type" + -frametype -default \uFFEF -type string + -show_edge -default \uFFEF -type string + -show_seps -default \uFFEF -type string + -join -type none -multiple 1 + -x -default "" -type string + -y -default b -type string + -z -default c -type string + -1 -default 1 -type boolean -validate_ansistripped true + -2 -default 2 -type integer -validate_ansistripped true + -3 -default 3 -type integer -validate_ansistripped true + @values + } $args] + return [tcl::dict::get $argd opts] + } + + package require opt + variable optlist + tcl::OptProc test1_opt { + {-return string "return type"} + {-frametype \uFFEF "type of frame"} + {-show_edge \uFFEF "show table outer borders"} + {-show_seps \uFFEF "show separators"} + {-join "solo option"} + {-x "" "x val"} + {-y b "y val"} + {-z c "z val"} + {-1 1 "1val"} + {-2 -int 2 "2val"} + {-3 -int 3 "3val"} + } { + set opts [dict create] + foreach v [info locals] { + dict set opts $v [set $v] + } + return $opts + } + + package require cmdline + #cmdline::getoptions is much faster than typedGetoptions + proc test1_cmdline_untyped {args} { + set cmdlineopts_untyped { + {return.arg "string" "return val"} + {frametype.arg \uFFEF "frame type"} + {show_edge.arg \uFFEF "show table borders"} + {show_seps.arg \uFFEF "show table seps"} + {join "join the things"} + {x.arg "" "arg x"} + {y.arg b "arg y"} + {z.arg c "arg z"} + {1.arg 1 "arg 1"} + {2.arg 2 "arg 2"} + {3.arg 3 "arg 3"} + } + + set usage "usage etc" + return [::cmdline::getoptions args $cmdlineopts_untyped $usage] + } + proc test1_cmdline_typed {args} { + set cmdlineopts_typed { + {return.arg "string" "return val"} + {frametype.arg \uFFEF "frame type"} + {show_edge.arg \uFFEF "show table borders"} + {show_seps.arg \uFFEF "show table seps"} + {join "join the things"} + {x.arg "" "arg x"} + {y.arg b "arg y"} + {z.arg c "arg z"} + {1.boolean 1 "arg 1"} + {2.integer 2 "arg 2"} + {3.integer 3 "arg 3"} + } + + set usage "usage etc" + return [::cmdline::typedGetoptions args $cmdlineopts_typed $usage] + } + + catch { + package require argp + argp::registerArgs test1_argp { + { -return string "string" } + { -frametype string \uFFEF } + { -show_edge string \uFFEF } + { -show_seps string \uFFEF } + { -x string "" } + { -y string b } + { -z string c } + { -1 boolean 1 } + { -2 integer 2 } + { -3 integer 3 } + } + } + proc test1_argp {args} { + argp::parseArgs opts + return [array get opts] + } + + package require tepam + tepam::procedure {test1_tepam} { + -args { + {-return -type string -default string} + {-frametype -type string -default \uFFEF} + {-show_edge -type string -default \uFFEF} + {-show_seps -type string -default \uFFEF} + {-join -type none -multiple} + {-x -type string -default ""} + {-y -type string -default b} + {-z -type string -default c} + {-1 -type boolean -default 1} + {-2 -type integer -default 2} + {-3 -type integer -default 3} + } + } { + return [dict create return $return frametype $frametype show_edge $show_edge show_seps $show_seps x $x y $y z $z 1 $1 2 $2 3 $3 join $join] + } + + #multiline values use first line of each record to determine amount of indent to trim + proc test_multiline {args} { + set t3 [textblock::frame t3] + set argd [punk::args::get_dict [subst { + -template1 -default { + ****** + * t1 * + ****** + } + -template2 -default { ------ + ****** + * t2 * + ******} + -template3 -default {$t3} + #substituted or literal values with newlines - no autoindent applied - caller will have to pad appropriately + -template3b -default { + $t3 + ----------------- + $t3 + abc\ndef + } + -template4 -default "****** + * t4 * + ******" + -template5 -default " + + + " + -flag -default 0 -type boolean + }] $args] + return $argd + } + + #proc sample1 {p1 n args} { + # #*** !doctools + # #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] + # #[para]Description of sample1 + # #[para] Arguments: + # # [list_begin arguments] + # # [arg_def tring p1] A description of string argument p1. + # # [arg_def integer n] A description of integer argument n. + # # [list_end] + # return "ok" + #} + + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace argparsingtest ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Secondary API namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval argparsingtest::lib { + namespace export {[a-z]*} ;# Convention: export all lowercase + namespace path [namespace parent] + #*** !doctools + #[subsection {Namespace argparsingtest::lib}] + #[para] Secondary functions that are part of the API + #[list_begin definitions] + + #proc utility1 {p1 args} { + # #*** !doctools + # #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] + # #[para]Description of utility1 + # return 1 + #} + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace argparsingtest::lib ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[section Internal] +namespace eval argparsingtest::system { + #*** !doctools + #[subsection {Namespace argparsingtest::system}] + #[para] Internal functions that are not part of the API + + + +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide argparsingtest [namespace eval argparsingtest { + variable pkg argparsingtest + variable version + set version 0.1.0 +}] +return + +#*** !doctools +#[manpage_end] + diff --git a/src/bootsupport/modules/commandstack-0.3.tm b/src/bootsupport/modules/commandstack-0.3.tm index ee486569..a45eaeaf 100644 --- a/src/bootsupport/modules/commandstack-0.3.tm +++ b/src/bootsupport/modules/commandstack-0.3.tm @@ -211,7 +211,7 @@ namespace eval commandstack { set new_code [string trim $procbody] if {$current_code eq $new_code} { puts stderr "(commandstack::rename_command) WARNING - renamer '$renamer' has already renamed the '$command' command with same procbody - Aborting rename." - puts stderr [show_stack $command] + puts stderr [::commandstack::show_stack $command] } else { puts stderr "(commandstack::rename_command) WARNING - renamer '$renamer' has already renamed the '$command' command - but appears to be with new code - proceeding." puts stdout "----------" @@ -236,8 +236,7 @@ namespace eval commandstack { set next_target ::commandstack::renamed_commands::${mungedcommand}_${munged_next_implementor}-$mungedrenamer-$tokenid set do_rename 1 } elseif {$next_implementor in {unspecified undetermined}} { - #review - probably don't need a warning anyway - puts stderr "(commandstack::rename_command) WARNING - Something may have renamed the '$command' command. Attempting to cooperate.(untested)" + #could be a standard tcl proc, or from application or package set next_target ::commandstack::renamed_commands::${mungedcommand}_${munged_next_implementor}-$mungedrenamer-$tokenid set do_rename 1 } else { @@ -380,7 +379,8 @@ namespace eval commandstack { #if caller is attempting exact match - use the calling context to resolve in case they didn't supply namespace set commandname_glob [uplevel 1 [list namespace which $commandname_glob]] } - if {[package provide punk::lib] ne ""} { + if {[package provide punk::lib] ne "" && [package provide punk] ne ""} { + #punk pipeline also needed for patterns return [punk::lib::pdict -channel none all_stacks $commandname_glob/@*/@*.@*] } else { set result "" diff --git a/src/bootsupport/modules/funcl-0.1.tm b/src/bootsupport/modules/funcl-0.1.tm index 1d2fe64a..e8430fb0 100644 --- a/src/bootsupport/modules/funcl-0.1.tm +++ b/src/bootsupport/modules/funcl-0.1.tm @@ -9,7 +9,7 @@ package provide funcl [namespace eval funcl { namespace eval funcl { - #from punk + #from punk::pipe proc arg_is_script_shaped {arg} { if {[string first " " $arg] >= 0} { return 1 diff --git a/src/bootsupport/modules/include_modules.config b/src/bootsupport/modules/include_modules.config index 158166cf..816f3331 100644 --- a/src/bootsupport/modules/include_modules.config +++ b/src/bootsupport/modules/include_modules.config @@ -18,7 +18,6 @@ set bootsupport_modules [list\ src/vendormodules md5\ src/vendormodules metaface\ src/vendormodules modpod\ - src/vendormodules oolib\ src/vendormodules overtype\ src/vendormodules pattern\ src/vendormodules patterncmd\ @@ -40,6 +39,7 @@ set bootsupport_modules [list\ modules funcl\ modules natsort\ modules punk\ + modules punk::pipe\ modules punkapp\ modules punkcheck\ modules punkcheck::cli\ diff --git a/src/bootsupport/modules/overtype-1.6.5.tm b/src/bootsupport/modules/overtype-1.6.5.tm index fb044b3c..9363fb6d 100644 --- a/src/bootsupport/modules/overtype-1.6.5.tm +++ b/src/bootsupport/modules/overtype-1.6.5.tm @@ -216,7 +216,9 @@ tcl::namespace::eval overtype { } set optargs [lrange $args 0 end-2] if {[llength $optargs] % 2 == 0} { - lassign [lrange $args end-1 end] underblock overblock + set overblock [lindex $args end] + set underblock [lindex $args end-1] + #lassign [lrange $args end-1 end] underblock overblock set argsflags [lrange $args 0 end-2] } else { set optargs [lrange $args 0 end-1] @@ -1810,8 +1812,10 @@ tcl::namespace::eval overtype { if {[llength $args] < 2} { error {usage: ?-info 0|1? ?-startcolumn ? ?-cursor_column ? ?-cursor_row |""? ?-transparent [0|1|]? ?-expand_right [1|0]? undertext overtext} } - lassign [lrange $args end-1 end] under over - if {[string first \n $under] >= 0} { + set under [lindex $args end-1] + set over [lindex $args end] + #lassign [lrange $args end-1 end] under over + if {[string last \n $under] >= 0} { error "overtype::renderline not allowed to contain newlines in undertext" } #if {[string first \n $over] >=0 || [string first \n $under] >= 0} { @@ -2920,6 +2924,7 @@ tcl::namespace::eval overtype { set leadernorm [tcl::string::range [tcl::string::map [list\ \x1b\[< 1006\ \x1b\[ 7CSI\ + \x1bY 7MAP\ \x1bP 7DCS\ \x90 8DCS\ \x9b 8CSI\ @@ -2948,6 +2953,10 @@ tcl::namespace::eval overtype { #8-bit Device Control String set codenorm [tcl::string::cat $leadernorm [tcl::string::range $code 1 end]] } + 7MAP { + #map to another type of code to share implementation branch + set codenorm $leadernorm[tcl::string::range $code 1 end] + } 7ESC { #set codenorm [tcl::string::cat $leadernorm [tcl::string::range $code 1 end]] set codenorm $leadernorm[tcl::string::range $code 1 end] @@ -2964,6 +2973,30 @@ tcl::namespace::eval overtype { } } + switch -- $leadernorm { + 7MAP { + switch -- [lindex $codenorm 4] { + Y { + #vt52 movement. we expect 2 chars representing position (limited range) + set params [tcl::string::range $codenorm 5 end] + if {[tcl::string::length $params] != 2} { + #shouldn't really get here or need this branch if ansi splitting was done correctly + puts stderr "overtype::renderline ESC Y recognised as vt52 move, but incorrect parameters length ([string length $params] vs expected 2) [ansistring VIEW -lf 1 -vt 1 -nul 1 $code] not implemented codenorm:[ansistring VIEW -lf 1 -vt 1 -nul 1 $codenorm]" + } + set line [tcl::string::index $params 5] + set column [tcl::string::index $params 1] + set r [expr {[scan $line %c] -31}] + set c [expr {[scan $column %c] -31}] + + #MAP to: + #CSI n;m H - CUP - Cursor Position + set leadernorm 7CSI + set codenorm "$leadernorm${r}\;${c}H" + } + } + } + } + #we've mapped 7 and 8bit escapes to values we can handle as literals in switch statements to take advantange of jump tables. switch -- $leadernorm { 1006 { @@ -2982,7 +3015,8 @@ tcl::namespace::eval overtype { {7CSI} - {8CSI} { set param [tcl::string::range $codenorm 4 end-1] #puts stdout "--> CSI [tcl::string::index $leadernorm 0] bit param:$param" - set code_end [tcl::string::index $codenorm end] ;#used for e.g h|l set/unset mode + set code_end [tcl::string::index $codenorm end] ;#used for e.g h|l set/unset mode + switch -exact -- $code_end { A { #Row move - up @@ -3875,6 +3909,7 @@ tcl::namespace::eval overtype { 7ESC { # #re_other_single {\x1b(D|M|E)$} + #also vt52 Y.. #also PM \x1b^...(ST) switch -- [tcl::string::index $codenorm 4] { c { @@ -4586,6 +4621,8 @@ tcl::namespace::eval overtype::priv { set o [lreplace $o $i $i] set ustacks [lreplace $ustacks $i $i] set gxstacks [lreplace $gxstacks $i $i] + } elseif {$i == 0 || $i == $nxt} { + #nothing to do } else { puts stderr "render_delchar - attempt to delchar at index $i >= number of outcols $nxt - shouldn't happen" } diff --git a/src/bootsupport/modules/punk-0.1.tm b/src/bootsupport/modules/punk-0.1.tm index 738d89c5..68a14411 100644 --- a/src/bootsupport/modules/punk-0.1.tm +++ b/src/bootsupport/modules/punk-0.1.tm @@ -20,6 +20,21 @@ namespace eval punk { variable cmdexedir set cmdexedir "" + proc sync_package_paths_script {} { + #the tcl::tm namespace doesn't exist until one of the tcl::tm commands + #is run. (they are loaded via ::auto_index triggering load of tm.tcl) + #we call tcl::tm::list to trigger the initial set of tm paths before + #we can override it, otherwise our changes will be lost + #REVIEW - won't work on safebase interp where paths are mapped to {$p(:x:)} etc + return "\ + apply {{ap tmlist} { + set ::auto_path \$ap + tcl::tm::list + set ::tcl::tm::paths \$tmlist + }} {$::auto_path} {[tcl::tm::list]} + " + } + proc rehash {{refresh 0}} { global auto_execs if {!$refresh} { @@ -217,7 +232,7 @@ namespace eval punk { [file exists [set testapp [file join $::env(LOCALAPPDATA) "Microsoft" "WindowsApps" "winget.exe"]]])} { #should be unlikely to get here - unless LOCALAPPDATA missing set windowsappdir [file dirname [lindex [::punk::auto_execok_windows winget.exe] 0]] - puts stderr "(resolved winget by search)" + catch {puts stderr "(resolved winget by search)"} } else { set windowsappdir [file dirname $testapp] } @@ -359,7 +374,7 @@ if {![llength [info commands ::ansistring]]} { } #require aliascore after punk::lib & punk::ansi are loaded package require punk::aliascore ;#mostly punk::lib aliases -punk::aliascore::init +punk::aliascore::init -force 1 package require punk::repl::codethread package require punk::config @@ -383,8 +398,10 @@ namespace eval punk { package require punk::assertion if {[catch {namespace import ::punk::assertion::assert} errM]} { - puts stderr "punk error importing punk::assertion::assert\n$errM" - puts stderr "punk::a* commands:[info commands ::punk::a*]" + catch { + puts stderr "punk error importing punk::assertion::assert\n$errM" + puts stderr "punk::a* commands:[info commands ::punk::a*]" + } } punk::assertion::active on # -- --- --- @@ -393,7 +410,7 @@ namespace eval punk { if {[catch { package require pattern } errpkg]} { - puts stderr "Failed to load package pattern error: $errpkg" + catch {puts stderr "Failed to load package pattern error: $errpkg"} } package require shellfilter package require punkapp @@ -524,7 +541,7 @@ namespace eval punk { set loader [zzzload::pkg_wait twapi] } errM]} { if {$loader in [list failed loading]} { - puts stderr "Unexpected problem during thread-load of pkg twapi - zzload::pkg_wait returned $loader" + catch {puts stderr "Unexpected problem during thread-load of pkg twapi - zzload::pkg_wait returned $loader"} } } else { package require twapi @@ -1061,7 +1078,7 @@ namespace eval punk { proc destructure {selector data} { # replaced by proc generating destructure_func - - puts stderr "punk::destructure .d. selector:'$selector'" + catch {puts stderr "punk::destructure .d. selector:'$selector'"} set selector [string trim $selector /] upvar v_dict_idx v_dict_idx ;#positional tracker for /@@ - dict position diff --git a/src/bootsupport/modules/punk/aliascore-0.1.0.tm b/src/bootsupport/modules/punk/aliascore-0.1.0.tm index 296bb6df..3d1d87e9 100644 --- a/src/bootsupport/modules/punk/aliascore-0.1.0.tm +++ b/src/bootsupport/modules/punk/aliascore-0.1.0.tm @@ -105,6 +105,7 @@ tcl::namespace::eval punk::aliascore { #functions must be in export list of their source namespace set aliases [tcl::dict::create\ + val ::punk::pipe::val\ aliases ::punk::lib::aliases\ alias ::punk::lib::alias\ tstr ::punk::lib::tstr\ @@ -123,12 +124,12 @@ tcl::namespace::eval punk::aliascore { colour ::punk::console::colour\ ansi ::punk::console::ansi\ color ::punk::console::colour\ + a? ::punk::console::code_a?\ + A? {::punk::console::code_a? forcecolor}\ a+ ::punk::console::code_a+\ A+ {::punk::console::code_a+ forcecolour}\ a ::punk::console::code_a\ A {::punk::console::code_a forcecolour}\ - a? ::punk::console::code_a?\ - A? {::punk::console::code_a? forcecolor}\ smcup ::punk::console::enable_alt_screen\ rmcup ::punk::console::disable_alt_screen\ ] diff --git a/src/bootsupport/modules/punk/ansi-0.1.1.tm b/src/bootsupport/modules/punk/ansi-0.1.1.tm index 422c524e..b367be2a 100644 --- a/src/bootsupport/modules/punk/ansi-0.1.1.tm +++ b/src/bootsupport/modules/punk/ansi-0.1.1.tm @@ -137,7 +137,7 @@ tcl::namespace::eval punk::ansi::class { @id -id "::punk::ansi::class::class_ansi render_to_input_line" @cmd -name "punk::ansi::class::class_ansi render_to_input_line" -help\ "render string from line 0 to line - (experimental/debug)" + (experimental/debug)" -dimensions -type string -help\ "WxH where W is integer width >= 1 and H is integer heigth >= 1" -minus -type integer -help\ @@ -584,25 +584,38 @@ tcl::namespace::eval punk::ansi { set base $CWD } } + if {[info commands file] eq ""} { + #probably a safe interp + return "UNAVAILABLE" + } return [file join $base src/testansi] } - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + @dynamic @id -id ::punk::ansi::example @cmd -name punk::ansi::example -help "Display .ans image files in a grid that will fit in console " - -colwidth -default 82 -help "Width of each column - default of 82 will fit a standard 80wide ansi image (when framed) - You can specify a narrower width to truncate images on the right side" - -folder -default "${[punk::ansi::Get_ansifolder]}" -help "Base folder for files if relative paths are used. - Defaults to /src/testansi - where projectbase is determined from current directory. + -colwidth -default 82 -help\ + "Width of each column - default of 82 will fit a standard 80wide ansi image + (when framed) + You can specify a narrower width to truncate images on the right side" + -folder -default "${[punk::ansi::Get_ansifolder]}" -help\ + "Base folder for files if relative paths are used. + Defaults to /src/testansi - where projectbase is determined + from the current directory. " @values -min 0 -max -1 - files -default {belinda.ans bot.ans flower.ans fish.ans} -multiple true -help "List of filenames - leave empty to display 4 defaults" + files -default {belinda.ans bot.ans flower.ans fish.ans} -multiple true -help\ + "List of filenames - leave empty to display 4 defaults" } ""] proc example {args} { set argd [punk::args::get_by_id ::punk::ansi::example $args] set colwidth [dict get $argd opts -colwidth] + if {[info commands file] eq ""} { + error "file command unavailable - punk::ansi::example cannot be shown" + } set ansifolder [file normalize [dict get $argd opts -folder]] set fnames [dict get $argd values files] @@ -617,6 +630,16 @@ tcl::namespace::eval punk::ansi { puts stderr "Ensure ansi test files exist: $fnames" #error "punk::ansi::example Cannot find example files" } + set termsize [punk::console:::get_size] + set termcols [dict get $termsize columns] + set margin 4 ;#review + set freewidth [expr {$termcols-$margin}] + if {$freewidth < $colwidth} { + puts stderr "[a+ red bold]punk::ansi::example freewidth: $freewidth < colwidth: $colwidth TRUNCATING IMAGES[a]" + set colwidth $freewidth + } + set per_row [expr {$freewidth / $colwidth}] + set missingbase [a+ yellow][textblock::block [expr {$colwidth-2}] 23 ?][a] ;#assuming standard frame - subtract 2 for left/right borders set pics [list] foreach f $fnames { @@ -636,10 +659,6 @@ tcl::namespace::eval punk::ansi { } } - set termsize [punk::console:::get_size] - set margin 4 - set freewidth [expr {[tcl::dict::get $termsize columns]-$margin}] - set per_row [expr {$freewidth / $colwidth}] set rowlist [list] ;# { { } { } } set heightlist [list] ;# { { } { } } @@ -737,22 +756,23 @@ tcl::namespace::eval punk::ansi { #review - can terminals handle SGR codes within a PM? #Wezterm will hide PM,SOS,APC - but not any part following an SGR code - i.e it seems to terminate hiding before the ST (apparently at the ) proc controlstring_PM {text} { - return "\x1b^${text}\033\\" + #dquotes with trailing \\ in string will confuse silly editors + return \x1b^${text}\033\\ } proc controlstring_PM8 {text} { - return "\x9e${text}\x9c" + return \x9e${text}\x9c } proc controlstring_SOS {text} { - return "\x1bX${text}\033\\" + return \x1bX${text}\033\\ } proc controlstring_SOS8 {text} { - return "\x98${text}\x9c" + return \x98${text}\x9c } proc controlstring_APC {text} { - return "\x1b_${text}\033\\" + return \x1b_${text}\033\\ } proc controlstring_APC8 {text} { - return "\x9f${text}\x9c" + return \x9f${text}\x9c } #there is also the SGR hide code (8) which has intermittent terminal support #This doesn't change the output length - so support is tricky to detec. (terminal checksum report?) @@ -843,10 +863,79 @@ tcl::namespace::eval punk::ansi { return $out } + + #Wrap text in ansi codes to switch to DEC alternate graphics character set. + #todo vt52 versions proc g0 {text} { return \x1b(0$text\x1b(B } + variable altg_map [dict create\ + hl q\ + vl x\ + tlc l\ + trc k\ + blc m\ + ltj t\ + rtj u\ + ttj w\ + btj v\ + rtj u\ + fwj n\ + ] + proc altg_map {names} { + variable altg_map + set result [list] + foreach nm $names { + if {[dict exists $altg_map $nm]} { + lappend result [dict get $altg_map $nm] + } else { + lappend "" + } + } + return $result + } + + # -------------------------------- + # Taken from term::ansi::code::ctrl + # -------------------------------- + #Note that SYN (\016) seems to put terminals in a state + #where alternate graphics are not processed. + #an ETB (\017) needs to be sent to get alt graphics working again. + #It isn't known what software utilises SYN/ETB within altg sequences + # (presumably to alternate between the charsets within a graphics-on/graphics-off section) + #but as modern emulators seem to react to it, we should handle it. + #REVIEW - this mapping not fully understood + #used by groptim + variable grforw + variable grback + variable _ + + foreach _ { + ! \" # $ % & ' ( ) * + , - . / + 0 1 2 3 4 5 6 7 8 9 : ; < = > + ? @ A B C D E F G H I J K L M + N O P Q R S T U V W X Y Z [ ^ + \\ ] + } { + lappend grforw \016$_ $_\016 + lappend grback $_\017 \017$_ + } + unset _ + # ------------------------------ + #REVIEW - see forward/backward map in term::ansi::code::macros::cd::groptim - what are they for?? + proc groptim {string} { + variable grforw + variable grback + set offon \x1b(B\x1b(0 ;#)) ;#editor highlighting comment + set onoff \x1b(0\x1b(B ;#)) ;#editor highlighting comment + while {![string equal $string [set new [string map [list $offon {} $onoff {}] [string map $grback [string map $grforw $string]]]]]} { + set string $new + } + return $string + } + # -------------------------------- + proc ansistrip_gx {text} { #e.g "\033(0" - select VT100 graphics for character set G0 #e.g "\033(B" - reset @@ -854,10 +943,10 @@ tcl::namespace::eval punk::ansi { #e.g "\033)X" - where X is any char other than 0 to reset ?? #return [convert_g0 $text] - return [tcl::string::map [list "\x1b(0" "" \x1b(B" "" "\x1b)0" "" "\x1b)X" ""] $text] + return [tcl::string::map [list \x1b(0 "" \x1b(B "" \x1b)0 "" \x1b)X ""] $text] } proc stripansi_gx {text} { - return [tcl::string::map [list "\x1b(0" "" \x1b(B" "" "\x1b)0" "" "\x1b)X" ""] $text] + return [tcl::string::map [list \x1b(0 "" \x1b(B "" \x1b)0 "" \x1b)X ""] $text] } @@ -1459,7 +1548,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu tcl::dict::set opts $k $v } default { - error "colourmap1 unrecognised option $k. Known-options: [tcl::dict::keys $opts] + error "colourmap1 unrecognised option $k. Known-options: [tcl::dict::keys $opts]" } } } @@ -2358,11 +2447,11 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu lappend PUNKARGS [list { @id -id ::punk::ansi::sgr_cache @cmd -name punk::ansi::sgr_cache -help\ - "Convenience function to view and optionally clear the ansi character attribute cache (ansi SGR codes) - " + "Convenience function to view and optionally clear the ansi character attribute cache + (ansi SGR codes)" -action -default "" -choices "clear" -help\ "-action clear will unset the keys in the punk::ansi::sgr_cache dict - This is called automatically when setting 'colour false' in the console" + This is called automatically when setting 'colour false' in the console" -pretty -default 1 -type boolean -help\ "use 'pdict punk::ansi::sgr_cache */%str,%ansiview' output" @@ -2882,7 +2971,8 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set SGR_samples [dict create] foreach k [dict keys $SGR_map] { - dict set SGR_samples $k "[punk::ansi::a+ $k]sample\x1b\[m" + #indent of 1 space is important for clarity in i -return string a+ output + dict set SGR_samples $k " [punk::ansi::a+ $k]sample\x1b\[m" } lappend PUNKARGS [list { @id -id ::punk::ansi::a+ @@ -2895,23 +2985,23 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu code -type string -optional 1 -multiple 1 -choices {}\ -choicelabels {}\ -choicecolumns 5 -choiceprefix 0 -choicerestricted 0 -help\ - "SGR code from the list below, or an integer corresponding to the code e.g 31 = red. - A leading capital letter indicates a codename applies to the background colour. - Other accepted codes are: - term- Term- foreground/background where int is 0-255 terminal color - term- Term- foreground/background - rgb--- Rgb--- foreground/background where are the - 0-255 int values for red, green and blue. - rgb# Rgb# where is a 6 char hex colour e.g rgb#C71585 - web- Web- + "SGR code from the list below, or an integer corresponding to the code e.g 31 = red. + A leading capital letter indicates a codename applies to the background colour. + Other accepted codes are: + term- Term- foreground/background where int is 0-255 terminal color + term- Term- foreground/background + rgb--- Rgb--- foreground/background where are the + 0-255 int values for red, green and blue. + rgb# Rgb# where is a 6 char hex colour e.g rgb#C71585 + web- Web- - The acceptable values for and can be queried using - punk::ansi::a? term - and - punk::ansi::a? web + The acceptable values for and can be queried using + punk::ansi::a? term + and + punk::ansi::a? web - Example to set foreground red and background cyan followed by a reset: - set str \"[a+ red Cyan]sample text[a]\" + Example to set foreground red and background cyan followed by a reset: + set str \"[a+ red Cyan]sample text[a]\" " }]] @@ -3264,7 +3354,55 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu return $result } - proc ansiwrap {codes text} { + lappend PUNKARGS [list { + @id -id ::punk::ansi::ansiwrap + @cmd -name punk::ansi::ansiwrap -help\ + "Wrap a string with ANSI codes from + supplied codelist(s) followed by trailing + ANSI reset. + + Codes are numbers or strings as indicated + in the output of the colour information + function: punk::ansi::a? + + No leading reset is applied - so when + placing resultant text, any existing + SGR codes that aren't overridden may + still take effect. + + For finer control use the a+ and a + functions eg + set x \"[a+ red]text [a+ bold]etc[a]\" + " + @leaders -min 0 -max -1 + codelist -multiple 1 -default {} -type list -help\ + "ANSI names/ints as understood by 'a?' + (Not actual ANSI as output by a+) + These can be supplied individually or + as a list or lists" + @values -min 1 -max 1 + text -type string -help\ + "String to wrap with ANSI (SGR)" + }] + #proc ansiwrap {codes text} { + # return [a {*}$codes]$text[a] + #} + proc ansiwrap2 {args} { + set argd [punk::args::parse $args withid ::punk::ansi::ansiwrap] + set codelists [dict get $argd leaders codelist] + set text [dict get $argd values text] + set codes [concat {*}$codelists] ;#flatten + return [a {*}$codes]$text[a] + } + proc ansiwrap {args} { + if {[llength $args] < 1} { + #minimal args parsing - unhappy path only + punk::args::parse $args withid ::punk::ansi::ansiwrap + return + } + set text [lindex $args end] + set codelists [lrange $args 0 end-1] + set codes [concat {*}$codelists] ;#flatten return [a {*}$codes]$text[a] } @@ -3300,6 +3438,14 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[call [fun reset_soft]] return \x1b\[!p } + proc SYN {} { + #syn seems to disable alternate graphics mode temporarily on modern terminals + return \016 + } + proc ETB {} { + #This is a form of soft reset for the state where a SYN was sent - re-enabling altg processing + return \017 + } proc reset_colour {} { #*** !doctools #[call [fun reset_colour]] @@ -3341,6 +3487,12 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[call [fun cursor_off]] return "\033\[?25l" } + proc cursor_on_vt52 {} { + return \x1be + } + proc cursor_off_vt52 {} { + return \x1bf + } # REVIEW - osc8 replays etc for split lines? - textblock #Hyperlinks (a.k.a. HTML-like anchors) in terminal emulators https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda @@ -3387,6 +3539,24 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } # -- --- --- --- --- + lappend PUNKARGS [list { + @id -id ::punk::ansi::move + @cmd -name punk::ansi::move -help\ + {Return an ANSI sequence to move cursor to row,col + (aka: cursor home) + + Sequence is of the form: + \x1b[;H + (CSI row ; col H) + This sequence will not be understood by old vt52 + terminals. see also vt52_move. + } + @values -min 2 -max 2 + row -type integer -help\ + "row number - starting at 1" + col -type integer -help\ + "column number - starting at 1" + }] proc move {row col} { #*** !doctools #[call [fun move] [arg row] [arg col]] @@ -3394,6 +3564,44 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[para]aka cursor home return \033\[${row}\;${col}H } + #NOTE vt52 uses ESC Y line column + # where line and column are ascii codes whose values are +31 + # vt52 can be entered/exited via escapes + # This means we probably need to to wrap enter/exit vt52 and keep this state - as we don't have a standard way to query for terminal type + # (vt52 supports ESC Z - but vt100 sometimes? doesn't - and querying at each output would be slow anyway, even if there was a common query :/ ) + + lappend PUNKARGS [list { + @id -id ::punk::ansi::vt52move + @cmd -name punk::ansi::vt52move -help\ + {Return a VT52 sequence to move cursor to row,col + (aka: cursor home) + + Sequence is of the form: + ESCY + This sequence will generally not be understood by terminals + that are not in vt52 mode (e.g DECANM unset). + } + @values -min 2 -max 2 + row -type integer -help\ + "row number - starting at 1" + col -type integer -help\ + "column number - starting at 1" + }] + proc vt52move {row col} { + #test + set r [format %c [expr {$row + 31}]] + set c [format %c [expr {$col + 31}]] + return \x1bY${r}${c} + } + proc vt52color {int} { + if {[string is integer -strict $int]} { + if {$int < 0 || $int > 15} { + error "vt52color unsupported - only 0 to 15 available" + } + } + set char [format %c [expr {$int + 31}]] + return \x1bb${char} + } proc move_emit {row col data args} { #*** !doctools #[call [fun move_emit] [arg row] [arg col] [arg data] [opt {row col data...}]] @@ -3424,6 +3632,27 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } return $out } + proc vt52move_emit {row col data args} { + #Todo - G code? + set out "" + if {$row eq "this"} { + #append out \033\[\;${col}G$data + append out [vt52move_column $col]$data + } else { + #append out \033\[${row}\;${col}H$data + append out [vt52move $row $col]$data + } + foreach {row col data} $args { + if {$row eq "this"} { + append out [vt52move_column $col]$data + #append out \033\[\;${col}G$data + } else { + #append out \033\[${row}\;${col}H$data + append out [vt52move $row $col]$data + } + } + return $out + } proc move_emitblock {row col textblock} { #*** !doctools #[call [fun move_emitblock] [arg row] [arg col] [arg textblock]] @@ -3434,31 +3663,63 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } return $commands } + proc vt52move_emitblock {row col textblock} { + #*** !doctools + #[call [fun move_emitblock] [arg row] [arg col] [arg textblock]] + set commands "" + foreach ln [split $textblock \n] { + append commands [punk::ansi::vt52move_emit $row $col $ln] + incr row + } + return $commands + } proc move_forward {{n 1}} { #*** !doctools #[call [fun move_forward] [arg n]] return \033\[${n}C } + proc vt52move_forward {{n 1}} { + return [string repeat \x1bC $n] + } proc move_back {{n 1}} { #*** !doctools #[call [fun move_back] [arg n]] return \033\[${n}D } + proc vt52move_back {{n 1}} { + return [string repeat \x1bD $n] + } proc move_up {{n 1}} { #*** !doctools #[call [fun move_up] [arg n]] return \033\[${n}A } + proc vt52move_up {{n 1}} { + return [string repeat \x1bA $n] + } proc move_down {{n 1}} { #*** !doctools #[call [fun move_down] [arg n]] return \033\[${n}B } + proc vt52move_down {{n 1}} { + return [string repeat \x1bB $n] + } proc move_column {col} { #*** !doctools #[call [fun move_column] [arg col]] return \x1b\[${col}G } + proc vt52move_column {col} { + #This is a bit of a fudge - as there is no command to move to a specific column. + #without tracking state - we settle for moving back enough times to ensure we're at column 1 - and then move forward. + #inefficient - but will have to do I guess. + #review - max term width vt52? env var LINES and env var COLUMNS ? + # also ESC R CR - set window size + set back [string repeat \x1bD 132] + set fwd [string repeat \x1bC [expr {$col - 1}]] + return $back$fwd + } proc move_row {row} { #*** !doctools #[call [fun move_row] [arg row]] @@ -3496,6 +3757,13 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[para] DECRC return \x1b8 } + proc cursor_save_vt52 {} { + return \x1bj + } + proc cursor_restore_vt52 {} { + return \x1bk + } + # -- --- --- --- --- #CRM Show Control Character Mode proc enable_crm {} { @@ -3550,18 +3818,131 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu # \x1b\[?7\;1\$y # \x1b\[?7\;2\$y #where 1 = set, 2 = unset. (0 = mode not recognised, 3 = permanently set, 4 = permanently unset) + + #https://wiki.tau.garden/dec-modes/ + #(DEC,xterm,contour,mintty,kitty etc) + #https://invisible-island.net/xterm/ctlseqs/ctlseqs.html#h2-Mouse-Tracking + + #names for other alt_screen mechanismk: 1047,1048 vs 1049? + #variable decmode_names [dict create\ + # DECANM 2\ + # origin 6\ + # DECCOLM 3\ + # line_wrap 7\ + # LNM 20\ + # alt_screen 1049\ + # grapheme_clusters 2027\ + # bracketed_paste 2004\ + # mouse_sgr 1006\ + # mouse_urxvt 1015\ + # mouse_sgr_pixel 1016\ + #] + variable decmode_data { + 1 { + {origin DEC description "DECCKM - Cursor Keys Mode" names {DECCKM cursor_keys}} + } + 2 { + {origin DEC description "DECANM - ANSI/VT52 Mode" names {DECANM} note { +Disable to turn on VT52 emulation. +In VT52 mode - use \x1b< to exit. + } + } + } + 3 { + {origin DEC description "DECCOLM - Column" names {DECCOLM}} + } + 4 { + {origin DEC description "DECSCLM - Scrolling" names {DECSCLM}} + } + 5 { + {origin DEC description "DECSCNM - Screen Mode (light or dark screen)" names {DECSNM lightmode}} + } + 7 { + {origin DEC description "DECAWM - Auto Wrap Mode" names {DECAWM line_wrap}} + } + 9 { + {origin "xterm" description "X10 compatibility mouse" names {SET_X10_MOUSE mouse_tracking} note { +Escape sequence on button press only. +CSI M CbCxCy (6 chars) +Coords limited to 223 (=255 - 32) + } + } + {origin DEC description "DECINLM - Interlace Mode (obsolete?)" names {DECINLM}} + } + 20 { + {origin DEC description "LNM - Line Feed/New Line Mode" names {LNM} note { +For terminals that support LNM, the default is off +meaning a lone CR respresents the character emitted +when enter is pushed. Turning LNM on would mean that +CR LF is sent when hitting enter. This feature is +not commonly supported, and the default will normally +be as if this was off - ie lone CR. + } + } + } + 25 { + {origin DEC description "DECTCEM - Text Cursor Enable Mode" names {DECTCEM cursor_enable}} + } + 47 { + {origin xterm description "xterm alternate buffer" names {xterm_altbuf}} + {origin DEC description "DECGRPM - Graphics Rotated Print Mode (obsolete?)" names {DECGRPM}} + } + 66 { + {origin DEC description "DECNKM - Numeric Keypad Mode" names {DECNKM}} + } + 1000 { + {origin "xterm" description "VT200 compatibility mouse" names {SET_VT200_MOUSE} note { +Escape sequence on both button press and release. +CSI M CbCxCy + } + } + } + 1004 { + {origin "xterm" description "Send FocusIn/FocusOut events" names {mouse_focus_event}} + } + 1005 { + {origin "xterm" description "Enable UTF-8 Mouse Mode" names {mouse_utf8 mouse_utf8_extended}} + } + 1006 { + {origin "xterm" description "Enable SGR Mouse Mode" names {mouse_sgr mouse_sgr_extended} note{ +SET_SGR_EXT_MODE_MOUSE - extended compared to x10 mouse protocol which limits x y coords +to 223 (=255 - 32) + } + } + } + 1015 { + {origin "urxvt" description "Enable urxvt Mouse Mode" names {mouse_urxvt}} + } + 1016 { + {origin "xterm" description "Enable SGR Pixel Mouse Mode" names {mouse_sgr_pixel}} + } + 1047 { + {origin "xterm" description "Alternate Buffer" names {alt_buffer_only}} + } + 1049 { + {origin "xterm" description "Alternate Buffer with save cursor" names {alt_buffer alt_screen}} + } + 2004 { + {origin "xterm" description "Set bracketed paste mode" names {bracketed_paste}} + } + 2027 { + {origin Contour description "Grapheme Cluster Processing" names {grapheme_clusters}} + } + } + set decmode_names [dict create] + dict for {code items} $decmode_data { + foreach itm $items { + set names [dict get $itm names] + foreach nm $names { + dict set decmode_names $nm $code + } + } + } + + + + - #names for other alt_screen mechanisms: 1047,1048 vs 1049? - variable decmode_names [dict create\ - line_wrap 7\ - LNM 20\ - alt_screen 1049\ - grapheme_clusters 2027\ - bracketed_paste 2004\ - mouse_sgr_extended 1006\ - mouse_urxvt 1015\ - mouse_sgr 1016\ - ] proc query_mode {num_or_name} { if {[string is integer -strict $num_or_name]} { set m $num_or_name @@ -3674,11 +4055,17 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[para]Erase to start of line, leaving cursor position alone. return \033\[1K } + proc vt52erase_sol {} { + return \x1bo + } proc erase_eol {} { #*** !doctools #[call [fun erase_eol]] return \033\[K } + proc vt52erase_eol {} { + return \x1bK + } #see also clear_above clear_below # -- --- --- --- --- @@ -3732,6 +4119,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu proc cursor_pos_extended {} { #includes page e.g ^[[47;3;1R + #(but not on all terminals - some (freebsd?) will report as per 6n e.g ^[[74;3R) return \033\[?6n } @@ -3789,6 +4177,9 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[para]This may not work on terminals which have multiple panes/windows return "\033\]2;$windowtitle\033\\" ;#works for xterm and most derivatives } + proc vt52titleset {windowtitle} { + return \x1bS$windowtitle\r + } #titleget - https://invisible-island.net/xterm/xterm.faq.html#how2_title #no cross-platform ansi-only mechanism ? @@ -4672,8 +5063,14 @@ tcl::namespace::eval punk::ansi::ta { variable re_osc_open {(?:\x1b\]|\u009d).*} - variable standalone_code_map [list \x1bc "" \x1b7 "" \x1b8 "" \x1bM "" \x1bE "" \x1bD "" \x1bH "" \x1b= "" \x1b> "" \x1b#3 "" \x1b#4 "" \x1b#5 "" \x1b#6 "" \x1b#8 ""] - variable re_standalones {(?:\x1bc|\x1b7|\x1b8|\x1bM|\x1bE|\x1bD|\x1bD|\x1bH|\x1b=|\x1b>|\x1b#3|\x1b#4|\x1b#5|\x1b#6|\x1b#8)} + #variable standalone_code_map [list \x1bc "" \x1b7 "" \x1b8 "" \x1bM "" \x1bE "" \x1bD "" \x1bH "" \x1b= "" \x1b> "" \x1b#3 "" \x1b#4 "" \x1b#5 "" \x1b#6 "" \x1b#8 ""] + variable re_standalones {(?:\x1bc|\x1b7|\x1b8|\x1bM|\x1bD|\x1bE|\x1bH|\x1b=|\x1b>|\x1b#3|\x1b#4|\x1b#5|\x1b#6|\x1b#8)} + variable re_standalones_vt52 {(?:\x1bZ)} + + #ESC Y move, ESC b foreground colour + #ESC F - gr-on ESC G - gr-off + variable re_vt52_open {(?:\x1bY|\x1bb|\x1bF)} + #\x1bc vt52 bgcolour conflict ?? #if we don't split on altgraphics too and separate them out - it's easy to get into a horrible mess variable re_g0_group {(?:\x1b\(0)(?:(?!\x1b\(B).)*\x1b\(B} @@ -4686,7 +5083,7 @@ tcl::namespace::eval punk::ansi::ta { #regex to capture the start of string/privacy message/application command block including the contents and string terminator (ST) #non-greedy by exclusion of ST terminators in body - #we need to match \x1b\\ not just \x1b There could be colour codes nested in a privacy msg/string + #we need to match \x1b\\ not just \x1b There could be colour codes nested in a privacy msg/string (not widely supported?) #even if terminals generally don't support that - it's quite possible for an ansi code to get nested this way - and we'd prefer it not to break our splits #Just checking for \x1b will terminate the match too early #we also need to track the start of ST terminated code and not add it for replay (in the ansistring functions) @@ -4705,17 +5102,44 @@ tcl::namespace::eval punk::ansi::ta { #handrafted TRIE version of above. Somewhat difficult to construct and maintain. TODO - find a regexp TRIE generator that works with Tcl regexes #This does make things quicker - but it's too early to finalise the detect/split regexes (e.g missing \U0090 ) - will need to be redone. #variable re_ansi_detect {(?:\x1b(?:\((?:0|B)|\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|c|7|8|M|E|D|H|=|>|(?:#(?:3|4|5|6|8))))|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]|(?:\u009d)(?:[^\u009c]*)?\u009c} - variable re_ansi_detect {(?:\x1b(?:\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|\((?:0|B)|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|c|7|8|M|E|D|H|=|>|(?:#(?:3|4|5|6|8))))|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]|(?:\u009d)(?:[^\u009c]*)?\u009c} + + #NOTE - the literal # char can cause problems in expanded syntax - even though it's within a bracketed section. \# seems to work though. + #vt52 specific |<|A|B|C|I|J|K|L|M|Z|(?:Y(?:..))|(?:b(?:.)| + #https://freemint.github.io/tos.hyp/en/VT_52_terminal.html + #what to with ESC c vs vt52 ESC c (background colour) ??? + #we probably need to use a separate re_ansi_detect for vt52 + + #although it's stated later terminals are backwards compatible with vt52 - that doesn't seem to mean for example a vt100 will process vt52 codes at the same time as ansi codes + #ie - when DECANM is on - VT52 codes are *not* processed + + #todo - ansi mode and cursor key mode set ? + # arrow keys -> ESC O A, ESC O B, ESC O C, ESC O D + # plus more for auxiliary keypad codes in keypad application mode (and some in numeric mode) + + variable re_ansi_detect {(?x) + (?:\x1b(?:\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|c|7|8|M|D|E|H|=|>|<|A|B|C|I|J|K|L|M|Z|(?:Y(?:..))|(?:b(?:.))|\((?:0|B)|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|(?:\#(?:3|4|5|6|8)))) + |(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c) + |(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e] + |(?:\u009d)(?:[^\u009c]*)?\u009c + } + #--- + # -- --- --- --- #variable re_csi_code {(?:\x1b\[|\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]} - variable re_ansi_detect_open "${re_csi_open}|${re_osc_open}|${re_standalones}|${re_ST_open}|${re_g0_open}" + variable re_ansi_detect_open "${re_csi_open}|${re_osc_open}|${re_standalones}|${re_standalones_vt52}|${re_ST_open}|${re_g0_open}|${re_vt52_open}" #may be same as detect - kept in case detect needs to diverge #variable re_ansi_split "${re_csi_code}|${re_esc_osc1}|${re_esc_osc2}|${re_esc_osc3}|${re_standalones}|${re_ST}|${re_g0_open}|${re_g0_close}" set re_ansi_split $re_ansi_detect + variable re_ansi_split_multi + if {[string first (?x) $re_ansi_split] == 0} { + set re_ansi_split_multi "(?x)(?:[string range ${re_ansi_split} 4 end])+" + } else { + set re_ansi_split_multi "(?:${re_ansi_split})+" + } lappend PUNKARGS [list -dynamic 0 { @id -id ::punk::ansi::ta::detect @@ -4922,81 +5346,46 @@ tcl::namespace::eval punk::ansi::ta { # -- --- --- --- --- --- #Split $text to a list containing alternating ANSI colour codes and text. #ANSI colour codes are always on the second element, fourth, and so on. - #(ie plaintext on odd list-indices ansi on even indices) + #(ie plaintext on even list-indices ansi on odd indices) + #result of split on non-empty string always has an odd length - with indices 0 and end always being plaintext (possibly empty string) # Example: - #ta_split_codes "" # => "" - #ta_split_codes "a" # => "a" - #ta_split_codes "a\e[31m" # => {"a" "\e[31m"} - #ta_split_codes "\e[31ma" # => {"" "\e[31m" "a"} - #ta_split_codes "\e[31ma\e[0m" # => {"" "\e[31m" "a" "\e[0m"} - #ta_split_codes "\e[31ma\e[0mb" # => {"" "\e[31m" "a" "\e[0m", "b"} - #ta_split_codes "\e[31m\e[0mb" # => {"" "\e[31m\e[0m" "b"} + #split_codes "" # => "" + #split_codes "a" # => "a" + #split_codes "a\e[31m" # => {"a" "\e[31m" ""} + #split_codes "\e[31ma" # => {"" "\e[31m" "a"} + #split_codes "\e[31ma\e[0m" # => {"" "\e[31m" "a" "\e[0m" ""} + #split_codes "\e[31ma\e[0mb" # => {"" "\e[31m" "a" "\e[0m", "b"} + #split_codes "\e[31m\e[0mb" # => {"" "\e[31m\e[0m" "b"} # proc split_codes {text} { - variable re_ansi_split - set re "(?:${re_ansi_split})+" - return [_perlish_split $re $text] + variable re_ansi_split_multi + return [_perlish_split $re_ansi_split_multi $text] } #micro optimisations on split_codes to avoid function calls and make re var local tend to yield very little benefit (sub uS diff on calls that commonly take 10s/100s of uSeconds) - #like split_codes - but each ansi-escape is split out separately (with empty string of plaintext between codes so odd/even plain ansi still holds) + #like split_codes - but each ansi-escape is split out separately (with empty string of plaintext between codes so even/odd indices for plain ansi still holds) #- the slightly simpler regex than split_codes means that it will be slightly faster than keeping the codes grouped. - proc split_codes_single2 {text} { - variable re_ansi_split - return [_perlish_split $re_ansi_split $text] - } - proc split_codes_single3 {text} { - #copy from re_ansi_split - _perlish_split {(?:\x1b(?:\((?:0|B)|\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|c|7|8|M|E|D|H|=|>|(?:#(?:3|4|5|6|8))))|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]|(?:\u009d)(?:[^\u009c]*)?\u009c} $text - } - proc split_codes_single4 {text} { - if {$text eq ""} { - return {} - } - variable re_ansi_split - set re $re_ansi_split - #variable re_ansi_detect1 - #set re $re_ansi_detect1 - set list [list] - set start 0 - - #set re {(?:\x1b(?:\((?:0|B)|\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|c|7|8|M|E|D|H|=|>|(?:#(?:3|4|5|6|8))))|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]|(?:\u009d)(?:[^\u009c]*)?\u009c} - #We can get $matchEnd < $matchStart; we need to ensure there is an exit condition for non-greedy empty results REVIEW - #while {[regexp -start $start -indices -- {(?:\x1b(?:\((?:0|B)|\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|c|7|8|M|E|D|H|=|>|(?:#(?:3|4|5|6|8))))|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]|(?:\u009d)(?:[^\u009c]*)?\u009c} $text match]} {} - while {[regexp -start $start -indices -- $re $text match]} { - lassign $match matchStart matchEnd - #puts "->start $start ->match $matchStart $matchEnd" - lappend list [tcl::string::range $text $start $matchStart-1] - if {$matchEnd < $matchStart} { - set e $matchStart - incr start - } else { - set e $matchEnd - set start [expr {$matchEnd+1}] - } - lappend list [tcl::string::range $text $matchStart $e] - if {$start >= [tcl::string::length $text]} { - break - } - } - return [lappend list [tcl::string::range $text $start end]] - } proc split_codes_single {text} { if {$text eq ""} { return {} } variable re_ansi_split set next 0 - set b -1 + #set b -1 set list [list] set coderanges [regexp -indices -all -inline -- $re_ansi_split $text] foreach cr $coderanges { lappend list [tcl::string::range $text $next [lindex $cr 0]-1] [tcl::string::range $text [lindex $cr 0] [lindex $cr 1]] set next [expr {[lindex $cr 1]+1}] + #set next [lindex $cr 1]+1 ;#text index-expression for string range } lappend list [tcl::string::range $text $next end] return $list } + proc split_codes_single2 {text} { + variable re_ansi_split + return [_perlish_split $re_ansi_split $text] + } proc get_codes_single {text} { variable re_ansi_split regexp -all -inline -- $re_ansi_split $text @@ -5008,7 +5397,7 @@ tcl::namespace::eval punk::ansi::ta { return {} } set next 0 - set b -1 + #set b -1 set list [list] set coderanges [regexp -indices -all -inline -- $re $text] foreach cr $coderanges { @@ -5103,29 +5492,6 @@ tcl::namespace::eval punk::ansi::ta { #return [lappend list [tcl::string::range $text $start end]] yield [tcl::string::range $text $start end] } - proc _perlish_split2 {re text} { - if {[tcl::string::length $text] == 0} { - return {} - } - set list [list] - set start 0 - #We can get $matchEnd < $matchStart; we need to ensure there is an exit condition for non-greedy empty results REVIEW - while {[regexp -start $start -indices -- $re $text match]} { - lassign $match matchStart matchEnd - #puts "->start $start ->match $matchStart $matchEnd" - if {$matchEnd < $matchStart} { - lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::index $text $matchStart] - incr start - } else { - lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::range $text $matchStart $matchEnd] - set start [expr {$matchEnd+1}] - } - if {$start >= [tcl::string::length $text]} { - break - } - } - return [lappend list [tcl::string::range $text $start end]] - } proc _ws_split {text} { regexp -all -inline {(?:\S+)|(?:\s+)} $text } @@ -7429,12 +7795,10 @@ tcl::namespace::eval punk::ansi::internal { #todo - document interp alias {} ansistring {} ::punk::ansi::ansistring -if {![info exists ::punk::args::register::NAMESPACES]} { - namespace eval ::punk::args::register { - set NAMESPACES [list] - } +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::ansi ::punk::ansi::class ::punk::ansi::ta } -lappend ::punk::args::register::NAMESPACES ::punk::ansi ::punk::ansi::class ::punk::ansi::ta # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready diff --git a/src/bootsupport/modules/punk/args-0.1.0.tm b/src/bootsupport/modules/punk/args-0.1.0.tm index 37f8b712..e940dada 100644 --- a/src/bootsupport/modules/punk/args-0.1.0.tm +++ b/src/bootsupport/modules/punk/args-0.1.0.tm @@ -226,15 +226,26 @@ tcl::namespace::eval punk::args::register { #[para] The punk::args package will then test for a public list variable ::PUNKARGS containing argument definitions when it needs to. #[list_begin definitions] + #Although the actual punk::args::define calls are not too sluggish, there could be *many*. + #in a multi-interp environment, we want to be lazy about loading argdefs until they're actually required, + #especially since a fair proportion may be for documentation purposes rather than parsing args. + # -- --- --- --- --- --- --- --- - #cooperative with packages that define some punk args but may need to do so lazily - #These could be loaded prior to punk::args being loaded - variable NAMESPACES + #cooperative with packages that define some punk args but do so lazily + #These could be loaded prior to punk::args being loaded - so check existence of NAMESPACES var first + variable NAMESPACES ;#just declaring it with variable doesn't yet mean it 'exists' from 'info exists' perspective if {![info exists ::punk::args::register::NAMESPACES]} { - set NAMESPACES [list] + set ::punk::args::register::NAMESPACES [list] } # -- --- --- --- --- --- --- --- + variable loaded_packages [list] ;#fully loaded + variable loaded_info [dict create] ;#time + variable scanned_packages [list] ;#packages scanned for ids used to update namespace_docpackages + variable scanned_info [dict create] ;#time and idcount + #some packages, e.g punk::args::tclcore document other namespaces. + #when punk::args::update_definitions gets a query for a namespace - we need to load argdefs from registered sources + variable namespace_docpackages [dict create] #*** !doctools #[list_end] [comment {--- end definitions namespace punk::args::register ---}] @@ -250,14 +261,15 @@ tcl::namespace::eval punk::args { variable PUNKARGS ;#list of our own punk::args function argument definitions - loaded with punk::args::define at the end. tcl::namespace::export {[a-z]*} - variable argdata_cache - variable argdefcache_by_id - variable argdefcache_unresolved ;#key = original template list supplied to 'define', value = 2-element list: (tstr-parsed split of template) & (unresolved params) - variable id_counter - set argdata_cache [tcl::dict::create] - set argdefcache_by_id [tcl::dict::create] - set argdefcache_unresolved [tcl::dict::create] - set id_counter 0 + variable rawdef_cache [tcl::dict::create] ;#key on rawdef list - return dict of {-id -dynamic 0|1} + variable id_cache_rawdef [tcl::dict::create] + variable id_cache_spec [tcl::dict::create] + + variable argdefcache_unresolved [tcl::dict::create] ;#key = original template list supplied to 'define', value = 2-element list: (tstr-parsed split of template) & (unresolved params) + + variable argdata_cache [tcl::dict::create] + + variable id_counter 0 #*** !doctools #[subsection {Namespace punk::args}] @@ -321,22 +333,22 @@ tcl::namespace::eval punk::args { %B%@id%N% ?opt val...? options: -id %B%@cmd%N% ?opt val...? - options -name -help + options: -name -help %B%@leaders%N% ?opt val...? - options -min -max + options: -min -max (used for leading args that come before switches/opts) %B%@opts%N% ?opt val...? - options -any + options: -any %B%@values%N% ?opt val...? - options -min -max + options: -min -max (used for trailing args that come after switches/opts) %B%@argdisplay%N% ?opt val...? - options -header (text for header row of table) + options: -header (text for header row of table) -body (text to replace autogenerated arg info) %B%@doc%N% ?opt val...? - options -name -url + options: -name -url %B%@seealso%N% ?opt val...? - options -name -url (for footer - unimplemented) + options: -name -url (for footer - unimplemented) Some other options normally present on custom arguments are available to use with the @leaders @opts @values directives to set defaults @@ -418,6 +430,15 @@ tcl::namespace::eval punk::args { streaming and checksumming. The -choices list is equivalent to a -choicegroups dict entry where the key (groupname) is the empty string. + -choicemultiple (default {1 1}) + is a pair representing min and max number of choices + that can be present in the value. + If is a single integer it is equivalent to a + specified with the same integer for both min and max. + Max of -1 represents no upper limit. + If allows more than one choice the value is a list + consisting of items in the choices made available through + entries in -choices/-choicegrups. -minsize (type dependant) -maxsize (type dependant) -range (type dependant) @@ -425,27 +446,27 @@ tcl::namespace::eval punk::args { " -dynamic -type boolean -default 0 -help\ - "If -dynamic is true, tstr interpolations of the form \$\{\$var\} - are re-evaluated on each call. - If the definition is being used not just as documentation, but is also - used within the function to parse args, e.g using punk::args::get_by_id, - then it should be noted that there is a slight performance penalty for the - dynamic case. - It is often not significant, perhaps depending on what vars/commands are - used but -dynamic true might be less desirable if the command is used in - inner loops in more performance-sensitive code. + "If -dynamic is true, tstr interpolations of the form \$\{\$var\} + are re-evaluated on each call. + If the definition is being used not just as documentation, but is also + used within the function to parse args, e.g using punk::args::get_by_id, + then it should be noted that there is a slight performance penalty for the + dynamic case. + It is often not significant, perhaps depending on what vars/commands are + used but -dynamic true might be less desirable if the command is used in + inner loops in more performance-sensitive code. " @values -min 1 -max -1 text -type string -multiple 1 -help\ - "Block(s) of text representing the argument definition for a command. - At least one must be supplied. If multiple, they are joined together with \\n. - Using multiple text arguments may be useful to mix curly-braced and double-quoted - strings to have finer control over interpolation when defining arguments. - (this can also be handy for sections that pull resolved definition lines - from existing definitions (by id) for re-use of argument specifications and help text) - - e.g the following definition passes 2 blocks as text arguments - definition { + "Block(s) of text representing the argument definition for a command. + At least one must be supplied. If multiple, they are joined together with \\n. + Using multiple text arguments may be useful to mix curly-braced and double-quoted + strings to have finer control over interpolation when defining arguments. + (this can also be handy for sections that pull resolved definition lines + from existing definitions (by id) for re-use of argument specifications and help text) + + e.g the following definition passes 2 blocks as text arguments + definition { @id -id ::myns::myfunc @cmd -name myns::myfunc -help\\ \"Description of command\" @@ -454,13 +475,18 @@ tcl::namespace::eval punk::args { -option1 -default blah -type string #The following option defines a flag style option (solo) -flag1 -default 0 -type none -help\\ - \"Info about flag1\" + \"Info about flag1 + subsequent help lines auto-dedented by whitespace to left + of corresponding record start (in this case -flag1) + + first 4 spaces if they are all present. + This line has no extra indent relative to first line 'Info about flag1' + This line indented a further 6 chars\" @values -min 1 -max -1 #Items that don't begin with * or - are value definitions v1 -type integer -default 0 thinglist -type string -multiple 1 - } \"*doc -name Manpage: -url \[myfunc_manpage_geturl myns::myfunc]\" + } \"*doc -name Manpage: -url \[myfunc_manpage_geturl myns::myfunc]\" " }]] @@ -475,6 +501,7 @@ tcl::namespace::eval punk::args { -nocase 0\ -choiceprefix 1\ -choicerestricted 1\ + -choicemultiple {1 1}\ -multiple 0\ -regexprepass {}\ -validationtransform {}\ @@ -488,6 +515,7 @@ tcl::namespace::eval punk::args { -nocase 0\ -choiceprefix 1\ -choicerestricted 1\ + -choicemultiple {1 1}\ -multiple 0\ -regexprepass {}\ -validationtransform {}\ @@ -501,6 +529,7 @@ tcl::namespace::eval punk::args { -nocase 0\ -choiceprefix 1\ -choicerestricted 1\ + -choicemultiple {1 1}\ -multiple 0\ -regexprepass {}\ -validationtransform {}\ @@ -569,8 +598,23 @@ tcl::namespace::eval punk::args { #] } proc define {args} { + dict get [resolve {*}$args] id + } + proc resolve {args} { + variable rawdef_cache + variable id_cache_rawdef + if {[dict exists $rawdef_cache $args]} { + set id [dict get $rawdef_cache $args -id] + set is_dynamic [dict get $rawdef_cache $args -dynamic] + } else { + set id [rawdef_id $args] + set is_dynamic [rawdef_is_dynamic $args] + dict set rawdef_cache $args [dict create -id $id -dynamic $is_dynamic] + dict set id_cache_rawdef $id $args + } + + variable argdata_cache - variable argdefcache_by_id variable argdefcache_unresolved @@ -592,7 +636,6 @@ tcl::namespace::eval punk::args { punk::args::get_by_id ::punk::args::define {} return } - set is_dynamic 0 if {[lindex $args 0] eq "-dynamic"} { set is_dynamic [lindex $args 1] set textargs [lrange $args 2 end] @@ -699,14 +742,18 @@ tcl::namespace::eval punk::args { if {![tcl::info::complete $test_complete]} { #append linebuild [string trimleft $rawline] \n if {$in_record} { - if {[tcl::string::length $lastindent]} { - #trim only the whitespace corresponding to last indent - not all whitespace on left - if {[tcl::string::first $lastindent $rawline] == 0} { - set trimmedline [tcl::string::range $rawline [tcl::string::length $lastindent] end] - append linebuild $trimmedline \n - } else { - append linebuild $rawline \n - } + #trim only the whitespace corresponding to last record indent or lastindent + 4 spaces - not all whitespace on left + #this allows alignment of multiline help strings to left margin whilst maintaining a visual indent in source form. + #Aligning subsequent lines with the record, or aligning 4 spaces in are equivalent. + #ie to indent lines further - whitespace should be added 4+ columns in from the record-line start position. + #(this leaves an oddity if indenting is only 1 2 or 3 spaces mixed with longer indents as we don't check for it.. REVIEW) + #(note string first "" $str is fast and returns -1) + if {[tcl::string::first "$lastindent " $rawline] == 0} { + set trimmedline [tcl::string::range $rawline [tcl::string::length "$lastindent "] end] + append linebuild $trimmedline \n + } elseif {[tcl::string::first $lastindent $rawline] == 0} { + set trimmedline [tcl::string::range $rawline [tcl::string::length $lastindent] end] + append linebuild $trimmedline \n } else { append linebuild $rawline \n } @@ -719,14 +766,13 @@ tcl::namespace::eval punk::args { } } else { set in_record 0 - if {[tcl::string::length $lastindent]} { - #trim only the whitespace corresponding to last indent - not all whitespace on left - if {[tcl::string::first $lastindent $rawline] == 0} { - set trimmedline [tcl::string::range $rawline [tcl::string::length $lastindent] end] - append linebuild $trimmedline - } else { - append linebuild $rawline - } + #trim only the whitespace corresponding to last record indent or lastindent + 4 spaces - not all whitespace on left + if {[tcl::string::first "$lastindent " $rawline] == 0} { + set trimmedline [tcl::string::range $rawline [tcl::string::length "$lastindent "] end] + append linebuild $trimmedline + } elseif {[tcl::string::first $lastindent $rawline] == 0} { + set trimmedline [tcl::string::range $rawline [tcl::string::length $lastindent] end] + append linebuild $trimmedline } else { append linebuild $rawline } @@ -734,10 +780,13 @@ tcl::namespace::eval punk::args { set linebuild "" } } - set cmd_info {} - set id_info {} ;#e.g -children ?? - set doc_info {} + set cmd_info {} + set package_info {} + set id_info {} ;#e.g -children ?? + set doc_info {} set argdisplay_info {} ;#optional override of autogenerated 'Arg Type Default Multi Help' table + set seealso_info {} + set keywords_info {} ###set leader_min 0 ###set leader_max 0 ;#default 0 but if leader_min is set switches to -1 for no limit #set leader_max "" @@ -745,7 +794,7 @@ tcl::namespace::eval punk::args { set opt_any 0 set val_min 0 set val_max -1 ;#-1 for no limit - set DEF_definition_id "" + set DEF_definition_id $id #form_defs set F [dict create _default [New_command_form _default]] @@ -840,20 +889,26 @@ tcl::namespace::eval punk::args { set at_specs $record_values switch -- [tcl::string::range $directive_name 1 end] { + dynamic { + set is_dynamic 1 + } id { + #disallow duplicate @id line ? + #review - nothing to stop multiple @id lines - or redefining as auto (which is ignored?) + #id An id will be allocated if no id line present or the -id value is "auto" - if {$DEF_definition_id ne ""} { - #disallow duplicate @id line - error "punk::args::define - @id already set. Existing value $DEF_definition_id\n[join $args \n]" - } + if {[dict exists $at_specs -id]} { - set DEF_definition_id [dict get $at_specs -id] - } else { - set DEF_definition_id auto + set thisid [dict get $at_specs -id] + if {$thisid ni [list $id auto]} { + error "punk::args::define @id mismatch existing: $id vs $thisid" + } } set id_info $at_specs } ref { + #a reference within the definition + #e.g see punk::args::tclcore ::after #global reference dict - independent of forms #ignore refs without an -id #store all keys except -id @@ -867,10 +922,10 @@ tcl::namespace::eval punk::args { #(if we were to take from a definition - we would have to check and maybe change this def to -dynamic.. ?) #perhaps we could allow -dynamic as a flag here - but IFF this define is already -dynamic (?) #That is possibly too complicated and/or unnecessary? - #however.. as it stands we have define -dynamic 1 making *immediate* resolutions .. is that really desirable? + #however.. as it stands we have define @dynamic making *immediate* resolutions .. is that really desirable? if {[dict exists $at_specs -id]} { - set copyfrom [get_def [dict get $at_specs -id]] + set copyfrom [get_spec [dict get $at_specs -id]] #we don't copy the @id info from the source #for now we only copy across if nothing set.. #todo - bring across defaults for empty keys at targets? @@ -942,6 +997,9 @@ tcl::namespace::eval punk::args { } #new form keys already created if they were needed (done for all records that have -form ) } + package { + set package_info [dict merge $package_info $at_specs] + } cmd { #allow arbitrary - review set cmd_info [dict merge $cmd_info $at_specs] @@ -968,7 +1026,7 @@ tcl::namespace::eval punk::args { -anyopts { set opt_any $v } - -minsize - -maxsize - -range - -choices - -choicegroups - -choicecolumns - -choicelabels - -choiceinfo - -choiceprefix - -choiceprefixdenylist - -choicerestricted { + -minsize - -maxsize - -range - -choices - -choicegroups - -choicemultiple - -choicecolumns - -choicelabels - -choiceinfo - -choiceprefix - -choiceprefixdenylist - -choicerestricted { #review - only apply to certain types? tcl::dict::set tmp_optspec_defaults $k $v } @@ -1014,7 +1072,7 @@ tcl::namespace::eval punk::args { tcl::dict::set tmp_optspec_defaults $k $v } default { - set known { -any -anyopts -minsize -maxsize -range -choices -choicegroups -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted -nocase\ + set known { -any -anyopts -minsize -maxsize -range -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted -nocase\ -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ -regexprepass -regexprefail -regexprefailmsg -validationtransform\ @@ -1052,10 +1110,16 @@ tcl::namespace::eval punk::args { } dict set F $fid LEADER_MAX $v } - -minsize - -maxsize - -range - -choices - -choicegroups - -choicecolumns - -choicelabels - -choiceinfo - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -nocase { + -minsize - -maxsize - -range - -choices - -choicegroups - -choicemultiple - -choicecolumns - -choicelabels - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -nocase { #review - only apply to certain types? tcl::dict::set tmp_leaderspec_defaults $k $v } + -choiceinfo { + if {[llength $v] %2 != 0} { + error "punk::args::define - key '-choiceinfo' requires a dictionary value as an argument. got $v id:$DEF_definition_id" + } + tcl::dict::set tmp_leaderspec_defaults $k $v + } -nominsize - -nomaxsize - -norange - -nochoices - -nochoicelabels { #-choicegroups? if {$v} { @@ -1100,7 +1164,7 @@ tcl::namespace::eval punk::args { default { set known { -min -minvalues -max -maxvalues\ -minsize -maxsize -range\ - -choices -choicegroups -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted\ + -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted\ -nocase -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ -regexprepass -regexprefail -regexprefailmsg -validationtransform\ @@ -1138,12 +1202,18 @@ tcl::namespace::eval punk::args { } set val_max $v } - -minsize - -maxsize - -range - -choices - -choicegroups - -choicecolumns - -choicelabels - -choiceinfo - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -nocase { + -minsize - -maxsize - -range - -choices - -choicemultiple - -choicecolumns - -choicelabels - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -nocase { #review - only apply to certain types? tcl::dict::set tmp_valspec_defaults $k $v } + -choiceinfo - -choicegroups { + if {[llength $v] % 2 != 0} { + error "punk::args::define - key '$k' requires a dictionary value as an argument. got $v id:$DEF_definition_id" + } + tcl::dict::set tmp_valspec_defaults $k $v + } -nominsize - -nomaxsize - -norange - -nochoices - -nochoicelabels { - # -choicegoups ?? + # -choicegroups ?? if {$v} { set k2 -[string range $k 3 end] ;#strip 'no' tcl::dict::unset tmp_valspec_defaults $k2 @@ -1186,7 +1256,7 @@ tcl::namespace::eval punk::args { default { set known { -min -minvalues -max -maxvalues\ -minsize -maxsize -range\ - -choices -choicegroups -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted\ + -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted\ -nocase\ -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ @@ -1203,6 +1273,11 @@ tcl::namespace::eval punk::args { seealso { #todo! #like @doc, except displays in footer, multiple - sub-table? + set seealso_info [dict merge $seealso_info $at_specs] + } + keywords { + #review - put as option on @cmd instead? @cmd -name xxx -keywords {blah etc hmm} ?? + set keywords_info [dict merge $keywords_info $at_specs] } default { error "punk::args::define - unrecognised @ line in '$rec'. Expected @id @cmd @form... @leaders @opts @values @doc @argdisplay - use @@name if paramname needs to be @name @id:$DEF_definition_id" @@ -1331,7 +1406,7 @@ tcl::namespace::eval punk::args { } } -default - -solo - -range - - -choices - -choicegroups - -choicecolumns - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -choicelabels - -choiceinfo - + -choices - -choicegroups - -choicemultiple - -choicecolumns - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -choicelabels - -choiceinfo - -minsize - -maxsize - -nocase - -optional - -multiple - -validate_ansistripped - -allow_ansi - -strip_ansi - -help - -ARGTYPE - -regexprepass - -regexprefail - -regexprefailmsg @@ -1376,7 +1451,7 @@ tcl::namespace::eval punk::args { } } } else { - set known_argopts [list -form -default -type -range -minsize -maxsize -choices -choicegroups -choicecolumns -choiceprefix -choiceprefixdenylist -choicerestricted\ + set known_argopts [list -form -default -type -range -minsize -maxsize -choices -choicegroups -choicemultiple -choicecolumns -choiceprefix -choiceprefixdenylist -choicerestricted\ -nocase -optional -multiple -validate_ansistripped -allow_ansi -strip_ansi -help\ -regexprepass -regexprefail -regexprefailmsg -validationtransform\ ] @@ -1426,10 +1501,10 @@ tcl::namespace::eval punk::args { } ;# end foreach rec $records - if {$DEF_definition_id eq "" || [tcl::string::tolower $DEF_definition_id] eq "auto"} { - variable id_counter - set DEF_definition_id "autoid_[incr id_counter]" - } + #if {$DEF_definition_id eq "" || [tcl::string::tolower $DEF_definition_id] eq "auto"} { + # variable id_counter + # set DEF_definition_id "autoid_[incr id_counter]" + #} #check ALL forms not just form_ids_active (record_form_ids) @@ -1521,9 +1596,11 @@ tcl::namespace::eval punk::args { VAL_CHECKS_DEFAULTS [dict get $F $firstformid VAL_CHECKS_DEFAULTS]\ cmd_info $cmd_info\ doc_info $doc_info\ + package_info $package_info\ argdisplay_info $argdisplay_info\ + seealso_info $seealso_info\ id_info $id_info\ - temp_F $F\ + FORMS $F\ form_names [dict keys $F]\ FORM_INFO $form_info\ ] @@ -1533,42 +1610,75 @@ tcl::namespace::eval punk::args { #also cache resolved version tcl::dict::set argdata_cache $optionspecs $argdata_dict } - #tcl::dict::set argdefcache_by_id $DEF_definition_id $optionspecs - tcl::dict::set argdefcache_by_id $DEF_definition_id $args + + #tcl::dict::set id_cache_rawdef $DEF_definition_id $args #puts "xxx:$result" return $argdata_dict } #return raw definition list as created with 'define' - proc rawdef {id} { - variable argdefcache_by_id + # - possibly with unresolved dynamic parts + proc raw_def {id} { + variable id_cache_rawdef set realid [real_id $id] - #return the raw definition - possibly with unresolved dynamic parts - if {![dict exists $argdefcache_by_id $realid]} { + if {![dict exists $id_cache_rawdef $realid]} { return "" } - return [tcl::dict::get $argdefcache_by_id $realid] + return [tcl::dict::get $id_cache_rawdef $realid] } namespace eval argdoc { - variable resolved_def_TYPE_CHOICES {* @id @cmd @leaders @opts @values @doc} + variable resolved_def_TYPE_CHOICES {* @id @package @cmd @ref @doc @argdisplay @seealso @leaders @opts @values leaders opts values} + variable resolved_def_TYPE_CHOICEGROUPS { + directives {@id @package @cmd @ref @doc @argdisplay @seealso} + argumenttypes {leaders opts values} + remaining_defaults {@leaders @opts @values} + } - lappend PUNKARGS [list -dynamic 0 [string map [list %TYPECHOICES% $resolved_def_TYPE_CHOICES] { + lappend PUNKARGS [list [string map [list %TYPECHOICES% $resolved_def_TYPE_CHOICES %TYPECHOICEGROUPS% $resolved_def_TYPE_CHOICEGROUPS] { @id -id ::punk::args::resolved_def @cmd -name punk::args::resolved_def -help\ - "" + "Resolves or retrieves the previously resolved definition and + uses the 'spec' form to build a response in definition format. + + Pulling argument definition data from another function is a form + of tight coupling to the other function that should be done with + care. + + Note that the directives @leaders @opts @values may appear multiple + times in a source definition - applying defaults for arguments that + follow. When retrieving these - there is only a single result for + each that represents the defaults after all have been applied. + When retrieving -types * each of these will be positioned before + the arguments of that type - but this doesn't mean there was a single + leading directive for this argument type in the source definition. + Each argument has already had its complete specification recorded in + its own result. + + When manually specifying -types, the order @leaders then @opts then + @values must be maintained - but if they are placed before their + corresponding arguments, they will not affect the retrieved arguments + as these arguments are already fully spec'd. The defaults from the + source can be removed by adding @leaders, @opts @values to the + -antiglobs list, but again - this won't affect the existing arguments. + Each argument can have members of its spec overridden using the + -override dictionary. + " @leaders -min 0 -max 0 @opts -form -default 0 -help\ - "UNIMPLEMENTED - Ordinal index or name of command form" - -type -default * -choices {%TYPECHOICES%} -choiceprefix 0 -multiple 1 + "Ordinal index or name of command form" + + #no restriction on number of types/repetitions? + -types -default * -choices {%TYPECHOICES%} -choicegroups {%TYPECHOICEGROUPS%} -choiceprefix 0 -choicemultiple {0 -1} + -antiglobs -default {} -type list -help\ + "Glob patterns for directive or argument/flags to + be suppressed" -override -type dict -optional 1 -default "" -help\ "dict of dicts. Key in outer dict is the name of a directive or an argument. Inner dict is a map of overrides/additions (- ...) for that line. - (unimplemented). " @values -min 1 -max -1 id -type string -help\ @@ -1597,23 +1707,24 @@ tcl::namespace::eval punk::args { proc resolved_def {args} { set opts [dict create\ - -type {}\ + -types {}\ -form 0\ + -antiglobs {}\ -override {}\ ] if {[llength $args] < 1} { #must have at least id - punk::args::get_by_id ::punk::args::resolved_def $args + punk::args::parse $args withid ::punk::args::resolved_def return } set patterns [list] - #a definition id must not begin with "-" + #a definition id must not begin with "-" ??? review for {set i 0} {$i < [llength $args]} {incr i} { set a [lindex $args $i] - if {$a eq "-type"} { + if {$a in {-type -types}} { incr i - dict lappend opts -type [lindex $args $i] + dict set opts -types [lindex $args $i] } elseif {[string match -* $a]} { incr i dict set opts $a [lindex $args $i] @@ -1623,7 +1734,7 @@ tcl::namespace::eval punk::args { break } if {$i == [llength $args]-1} { - punk::args::get_by_id ::punk::args::resolved_def $args + punk::args::parse $args withid ::punk::args::resolved_def return } } @@ -1632,47 +1743,121 @@ tcl::namespace::eval punk::args { } dict for {k v} $opts { switch -- $k { - -form - -type - -override {} + -form - -types - -antiglobs - -override {} default { - punk::args::get_by_id ::punk::args::resolved_def $args + punk::args::parse $args withid ::punk::args::resolved_def return } } } - set typelist [dict get $opts -type] + set typelist [dict get $opts -types] if {[llength $typelist] == 0} { set typelist {*} } foreach type $typelist { if {$type ni $::punk::args::argdoc::resolved_def_TYPE_CHOICES} { - punk::args::get_by_id ::punk::args::resolved_def $args + punk::args::parse $args withid ::punk::args::resolved_def return } } - variable argdefcache_by_id + + variable id_cache_rawdef set realid [real_id $id] if {$realid ne ""} { - set deflist [tcl::dict::get $argdefcache_by_id $realid] + set deflist [tcl::dict::get $id_cache_rawdef $realid] set result "" - set specdict [uplevel 1 [list ::punk::args::define {*}$deflist]] - set arg_info [dict get $specdict ARG_INFO] - set argtypes [dict create @opts option @leaders leader @values value] + set specdict [uplevel 1 [list ::punk::args::resolve {*}$deflist]] + + set opt_form [dict get $opts -form] + if {[string is integer -strict $opt_form]} { + set formname [lindex [dict get $specdict form_names] $opt_form] + } else { + set formname $opt_form + } + set opt_override [dict get $opts -override] + + #set arg_info [dict get $specdict ARG_INFO] + set arg_info [dict get $specdict FORMS $formname ARG_INFO] + set argtypes [dict create leaders leader opts option values value] + + set opt_antiglobs [dict get $opts -antiglobs] + set directives [lsearch -all -inline -exact -not $::punk::args::argdoc::resolved_def_TYPE_CHOICES *] + set suppressed_directives [list] + set suppressed_args [list] + foreach ag $opt_antiglobs { + foreach d $directives { + if {[string match $ag $d]} { + lappend suppressed_directives $d + } + } + foreach argname [dict keys $arg_info] { + if {[string match $ag $argname]} { + lappend suppressed_args $argname + } + } + } + set suppressed_directives [lsort -unique $suppressed_directives] + set suppressed_args [lsort -unique $suppressed_args] + + set included_directives [punk::args::system::punklib_ldiff $directives $suppressed_directives] + + set globbed [list] + foreach pat $patterns { + set matches [dict keys $arg_info $pat] + lappend globbed {*}$matches + } + set globbed [lsort -unique $globbed] + set included_args [punk::args::system::punklib_ldiff $globbed $suppressed_args] + foreach type $typelist { switch -exact -- $type { * { - append result \n "@id -id [dict get $specdict id]" - append result \n "@cmd [dict get $specdict cmd_info]" - append result \n "@doc [dict get $specdict doc_info]" - foreach tp {leader option value} { - foreach pat $patterns { - set matches [dict keys $arg_info $pat] - foreach m $matches { - set def [dict get $arg_info $m] - if {[dict get $def -ARGTYPE] eq $tp} { - set def [dict remove $def -ARGTYPE] - append result \n "$m $def" + if {"@id" in $included_directives} { + if {[dict exists $opt_override @id]} { + append result \n "@id [dict merge [dict create -id [dict get $specdict id]] [dict get $opt_override @id]]" + } else { + append result \n "@id -id [dict get $specdict id]" + } + } + foreach directive {@package @cmd @doc @seealso @argdisplay} { + set dshort [string range $directive 1 end] + if {"$directive" in $included_directives} { + if {[dict exists $opt_override $directive]} { + append result \n "$directive [dict merge [dict get $specdict ${dshort}_info] [dict get $opt_override $directive]]" + } else { + append result \n "$directive [dict get $specdict ${dshort}_info]" + } + } + } + #output ordered by leader, option, value + foreach pseudodirective {leaders opts values} tp {leader option value} { + set directive "@$pseudodirective" + switch -- $directive { + @leaders {set defaults_key leaderspec_defaults} + @opts {set defaults_key optspec_defaults} + @values {set defaults_key valspec_defaults} + } + + if {"$directive" in $included_directives} { + if {[dict exists $opt_override "$directive"]} { + append result \n "$directive [dict merge [dict get $specdict $defaults_key] [dict get $opt_override $directive]]" + } else { + append result \n "$directive [dict get $specdict $defaults_key]" + } + } + + if {$pseudodirective in $included_directives} { + foreach m $included_args { + set argspec [dict get $arg_info $m] + if {[dict get $argspec -ARGTYPE] eq $tp} { + set argspec [dict remove $argspec -ARGTYPE] + if {[dict exists $opt_override $m]} { + append result \n "$m [dict merge $argspec [dict get $opt_override $m]]" + } else { + append result \n "$m $argspec" + } } } } @@ -1680,27 +1865,52 @@ tcl::namespace::eval punk::args { } @id { - #only a single id record can exist - append result \n "@id -id [dict get $specdict id]" - } - @cmd { - #only a single @cmd record can exist - #merged if multiple in original def (?) - append result \n "@cmd [dict get $specdict cmd_info]" + if {"@id" in $included_directives} { + #only a single id record can exist + if {[dict exists $opt_override @id]} { + append result \n "@id [dict merge [dict create -id [dict get $specdict id]] [dict get $opt_override @id]]" + } else { + append result \n "@id -id [dict get $specdict id]" + } + } } - @doc { - #only a single @doc record can exist - append result \n "@doc [dict get $specdict doc_info]" + @package - @cmd - @doc - @seealso - @argdisplay { + if {"$type" in $included_directives} { + set tp [string range $type 1 end] ;# @package -> package + if {[dict exists $opt_override $type]} { + append result \n "$type [dict merge [dict get $specdict ${tp}_info] [dict get $opt_override $type]]" + } else { + append result \n "$type [dict get $specdict ${tp}_info]" + } + } } @leaders - @opts - @values { - #option, - foreach pat $patterns { - set matches [dict keys $arg_info $pat] - foreach m $matches { - set def [dict get $arg_info $m] - if {[dict get $def -ARGTYPE] eq [dict get $argtypes $type]} { - set def [dict remove $def -ARGTYPE] - append result \n "$m $def" + #these are the active defaults for further arguments + if {"$type" in $included_directives} { + switch -- $type { + @leaders {set defaults_key leaderspec_defaults} + @opts {set defaults_key optspec_defaults} + @values {set defaults_key valspec_defaults} + } + if {[dict exists $opt_override $type]} { + append result \n "$type [dict merge [dict get $specdict leaderspec_defaults] [dict get $opt_override $type]]" + } else { + append result \n "$type [dict get $specdict leaderspec_defaults]" + } + } + } + leaders - opts - values { + #pseudo-directives + if {$type in $included_directives} { + foreach m $included_args { + set argspec [dict get $arg_info $m] + if {[dict get $argspec -ARGTYPE] eq [dict get $argtypes $type]} { + set argspec [dict remove $argspec -ARGTYPE] + if {[dict exists $opt_override $m]} { + append result \n "$m [dict merge $argspec [dict get $opt_override $m]]" + } else { + append result \n "$m $argspec" + } } } } @@ -1714,12 +1924,12 @@ tcl::namespace::eval punk::args { } } - proc get_spec_values {id {patternlist *}} { - variable argdefcache_by_id + proc resolved_def_values {id {patternlist *}} { + variable id_cache_rawdef set realid [real_id $id] if {$realid ne ""} { - set speclist [tcl::dict::get $argdefcache_by_id $realid] - set specdict [define {*}$speclist] + set speclist [tcl::dict::get $id_cache_rawdef $realid] + set specdict [resolve {*}$speclist] set arg_info [dict get $specdict ARG_INFO] set valnames [dict get $specdict VAL_NAMES] set result "" @@ -1744,18 +1954,69 @@ tcl::namespace::eval punk::args { } } } - #proc get_spec_leaders ?? - #proc get_spec_opts ?? + #proc resolved_def_leaders ?? + #proc resolved_def_opts ?? - proc get_def {id} { - return [define {*}[rawdef $id]] + proc get_spec {id} { + set rdef [raw_def $id] + if {$rdef eq ""} {return} + return [resolve {*}$rdef] #if {[id_exists $id]} { - # return [define {*}[rawdef $id]] + # return [resolve {*}[raw_def $id]] #} } proc is_dynamic {id} { - set deflist [rawdef $id] - return [expr {[lindex $deflist 0] eq "-dynamic" && [lindex $deflist 1]} ] + variable id_cache_rawdef + variable rawdef_cache + set deflist [raw_def $id] + if {[dict exists $rawdef_cache $deflist -dynamic]} { + return [dict get $rawdef_cache $deflist -dynamic] + } + return [rawdef_is_dynamic $deflist] + #@dynamic only has meaning as 1st element of a def in the deflist + } + + #@id must be within first 4 lines of a block - or assign auto + #review - @dynamic block where -id not explicitly set? - disallow? + proc rawdef_id {rawdef} { + set id "" + foreach d $rawdef { + foreach ln [lrange [split $d \n] 0 4] { + if {[regexp {\s*(\S+)(.*)} $ln _match firstword rest]} { + if {$firstword eq "@id"} { + if {[llength $rest] %2 == 0 && [dict exists $rest -id]} { + set id [dict get $rest -id] + break + } + } + } + } + if {$id ne ""} { + break + } + } + if {$id eq "" || [string tolower $id] eq "auto"} { + variable id_counter + set id "autoid_[incr id_counter]" + } + #puts "==>id: $id" + return $id + } + #test the rawdef for @dynamic directive + proc rawdef_is_dynamic {rawdef} { + #temporary - old way + set flagged_dynamic [expr {[lindex $rawdef 0] eq "-dynamic" && [lindex $rawdef 1]} ] + if {$flagged_dynamic} { + return true + } + foreach d $rawdef { + if {[regexp {\s*(\S+)} $d _match firstword]} { + if {$firstword eq "@dynamic"} { + return true + } + } + } + return false } variable aliases @@ -1770,19 +2031,19 @@ tcl::namespace::eval punk::args { "exact id or glob pattern for ids" }] proc get_ids {{match *}} { - variable argdefcache_by_id + variable id_cache_rawdef variable aliases - return [list {*}[tcl::dict::keys $aliases $match] {*}[tcl::dict::keys $argdefcache_by_id $match]] + return [list {*}[tcl::dict::keys $aliases $match] {*}[tcl::dict::keys $id_cache_rawdef $match]] } #we don't automatically test for (autodef)$id - only direct ids and aliases proc id_exists {id} { - variable argdefcache_by_id variable aliases if {[tcl::dict::exists $aliases $id]} { return 1 } - tcl::dict::exists $argdefcache_by_id $id + variable id_cache_rawdef + tcl::dict::exists $id_cache_rawdef $id } proc set_alias {alias id} { variable aliases @@ -1800,16 +2061,18 @@ tcl::namespace::eval punk::args { } proc real_id {id} { - variable argdefcache_by_id + variable id_cache_rawdef variable aliases if {[tcl::dict::exists $aliases $id]} { set id [tcl::dict::get $aliases $id] } - if {[tcl::dict::exists $argdefcache_by_id $id]} { + if {[tcl::dict::exists $id_cache_rawdef $id]} { return $id } else { - if {![llength [update_definitions]]} { - if {[tcl::dict::exists $argdefcache_by_id (autodef)$id]} { + set check_updates [list [namespace qualifiers $id]] + if {![llength [update_definitions $check_updates]]} { + #nothing new loaded + if {[tcl::dict::exists $id_cache_rawdef (autodef)$id]} { return (autodef)$id } return "" @@ -1817,10 +2080,10 @@ tcl::namespace::eval punk::args { if {[tcl::dict::exists $aliases $id]} { set id [tcl::dict::get $aliases $id] } - if {[tcl::dict::exists $argdefcache_by_id $id]} { + if {[tcl::dict::exists $id_cache_rawdef $id]} { return $id } - if {[tcl::dict::exists $argdefcache_by_id (autodef)$id]} { + if {[tcl::dict::exists $id_cache_rawdef (autodef)$id]} { return (autodef)$id } return "" @@ -1828,42 +2091,188 @@ tcl::namespace::eval punk::args { } } - variable loaded_packages - set loaded_packages [list] + proc status {} { + upvar ::punk::args::register::NAMESPACES registered + upvar ::punk::args::register::loaded_packages loaded_packages + upvar ::punk::args::register::loaded_info loaded_info + upvar ::punk::args::register::scanned_packages scanned_packages + upvar ::punk::args::register::scanned_info scanned_info + set result "" + # [format %-${w0}s $idtail] + set widest [tcl::mathfunc::max {*}[lmap v [list {*}$registered "Registered"] {string length $v}]] + append result "[format %-${widest}s Registered] Scanned_ids Scantime_us Loaded_defs Loadtime_us" \n + set width_c2 [string length "Scanned_ids"] + set width_c3 [string length "Scantime_us"] + set width_c4 [string length "Loaded_defs"] + set width_c5 [string length "Loadtime_us"] + set count_unloaded 0 + set count_loaded 0 + foreach ns $registered { + if {$ns in $scanned_packages} { + set ids [dict get $scanned_info $ns idcount] + set scan_us [dict get $scanned_info $ns time] + } else { + set ids "" + set scan_us "" + } + if {$ns in $loaded_packages} { + incr count_loaded + set ldefs [dict get $loaded_info $ns defcount] + set load_us [dict get $loaded_info $ns time] + } else { + incr count_unloaded + set ldefs "" + set load_us "" + } + append result "[format %-${widest}s $ns] [format %${width_c2}s $ids] [format %${width_c3}s $scan_us] [format %${width_c4}s $ldefs] [format %${width_c5}s $load_us]" \n + } + append result "\nPackages - Registered: [llength $registered] Loaded: $count_loaded Unloaded: $count_unloaded" + return $result + } + + #scanned_packages (list) + #namespace_docpackages (dict) + proc update_definitions {{nslist *}} { + if {[set gposn [lsearch $nslist {}]] >= 0} { + lset nslist $gposn :: + } + upvar ::punk::args::register::NAMESPACES registered ;#list + upvar ::punk::args::register::loaded_packages loaded_packages ;#list + upvar ::punk::args::register::loaded_info loaded_info ;#dict + upvar ::punk::args::register::scanned_packages scanned_packages ;#list + upvar ::punk::args::register::scanned_info scanned_info ;#dict + upvar ::punk::args::register::namespace_docpackages namespace_docpackages ;#dict - proc update_definitions {} { + + #puts stderr "-->update_definitions '$nslist'" #needs to run quickly - especially when no package namespaces to be scanned for argdefs - #e.g - get's called for each subcommand of an ensemble (could be many) + #e.g - gets called for each subcommand of an ensemble (could be many) # It needs to get called in each arginfo call as we don't know what namespace origins or aliases may be involved in resolving a command. #we could possibly get away with not calling it for nested calls (such as with ensemble subcommands) but the code to avoid calls is probably more complex/slow than any gain avoiding the fast-path below. # -- --- --- --- --- --- # common-case fast-path - variable loaded_packages - upvar ::punk::args::register::NAMESPACES pkgs - if {[llength $loaded_packages] == [llength $pkgs]} { + + if {[llength $loaded_packages] == [llength $registered]} { #the only valid mechanism to add to 'loaded_packages' is with this function - so if lengths are equal, nothing to do. + #assert - if all are registered - then all have been scanned ( return {} } # -- --- --- --- --- --- - set unloaded [punklib_ldiff $pkgs $loaded_packages] + set unscanned [punklib_ldiff $registered $scanned_packages] + if {[llength $unscanned]} { + foreach pkgns $unscanned { + set idcount 0 + set ts_start [clock microseconds] + if {[info exists ${pkgns}::PUNKARGS]} { + set seen_documentedns [list] ;#seen per pkgns + foreach definitionlist [set ${pkgns}::PUNKARGS] { + #namespace eval $evalns [list punk::args::define {*}$definitionlist] + set id [rawdef_id $definitionlist] + if {[string match autoid_* $id]} { + puts stderr "update_definitions - unexpected autoid during scan of $pkgns - skipping" + puts stderr "definition:\n" + foreach d $definitionlist { + set out "" + foreach ln [split $d \n] { + append out " " $ln \n + } + puts $out + } + continue + } + #todo - detect duplicate ids (last will silently win.. should be reported somewhere) + incr idcount + set documentedns [namespace qualifiers $id] + if {$documentedns eq ""} {set documentedns ::} + if {$documentedns ni $seen_documentedns} { + #don't add own ns as a key in namespace_docpackages + if {$documentedns ne $pkgns} { + dict lappend namespace_docpackages $documentedns $pkgns + } + lappend seen_documentedns $documentedns + } + } + } + set ts_end [clock microseconds] + set diff [expr {$ts_end - $ts_start}] + dict set scanned_info $pkgns [dict create time $diff idcount $idcount] + #we count it as scanned even if PUNKARGS didn't exist + #(registered the namespace, variable PUNKARGS may or may not be declared, but didn't set PUNKARGS) + lappend scanned_packages $pkgns + } + } + + + + if {"*" in $nslist} { + set needed [punklib_ldiff $registered $loaded_packages] + } else { + set needed [list] + foreach pkgns $nslist { + if {$pkgns in $registered && $pkgns ni $loaded_packages} { + lappend needed $pkgns + } + #argdoc sub namespace is a standard place to put defs that match the namespace below + #(generally the PUNKARGS in a namespace should apply to own ns) + set docns ${pkgns}::argdoc + if {[namespace exists $docns]} { + if {($pkgns in $registered || $docns in $registered) && $docns ni $needed && $docns ni $loaded_packages} { + lappend needed $docns + } + } + if {[dict exists $namespace_docpackages $pkgns]} { + #this namespace has other argdef sources + foreach docns [dict get $namespace_docpackages $pkgns] { + if {$docns ni $loaded_packages} { + lappend needed $docns + } + } + } + } + } + + + set newloaded [list] - foreach pkgns $unloaded { - #puts -nonewline stderr . ;#debugging - see actual loads + foreach pkgns $needed { + #puts stderr "update_definitions Loading: $pkgns" + set ts_start [clock microseconds] + set def_count 0 if {![catch { if {[info exists ${pkgns}::PUNKARGS]} { + set docns ${pkgns}::argdoc + if {[namespace exists $docns]} { + namespace eval ${pkgns}::argdoc { + set epath [namespace path] + set pkgns [namespace parent] + if {$pkgns ni $epath} { + namespace path [list {*}$epath $pkgns] ;#add to tail + } + + } + set evalns $docns + } else { + set evalns $pkgns + } foreach definitionlist [set ${pkgns}::PUNKARGS] { - namespace eval $pkgns [list punk::args::define {*}$definitionlist] + namespace eval $evalns [list punk::args::define {*}$definitionlist] + incr def_count } } + + #process list of 2-element lists if {[info exists ${pkgns}::PUNKARGS_aliases]} { foreach adef [set ${pkgns}::PUNKARGS_aliases] { punk::args::set_alias {*}$adef } } } errMsg]} { + set ts_end [clock microseconds] + set diff [expr {$ts_end - $ts_start}] lappend loaded_packages $pkgns lappend newloaded $pkgns + dict set loaded_info $pkgns [dict create time $diff defcount $def_count] } else { puts stderr "punk::args::update_definitions error - failed to load PUNKARGS definitions for $pkgns\nerr:$errMsg" } @@ -1875,7 +2284,8 @@ tcl::namespace::eval punk::args { #This mechanism gets less-than-useful results for oo methods #e.g {$obj} proc Get_caller {} { - set call_level -3 + #set call_level -3 ;#for get_dict call + set call_level -4 set cmdinfo [tcl::dict::get [tcl::info::frame $call_level] cmd] #puts "-->$cmdinfo" #puts "-->[tcl::info::frame -3]" @@ -1918,7 +2328,7 @@ tcl::namespace::eval punk::args { @values -min 0 -max 0 }] proc test_get_dict {args} { - punk::args::get_dict {*}[punk::args::rawdef ::punk::args::test1] $args + punk::args::get_dict {*}[punk::args::raw_def ::punk::args::test1] $args } proc test_get_by_id {args} { punk::args::get_by_id ::punk::args::test1 $args @@ -1960,22 +2370,22 @@ tcl::namespace::eval punk::args { " @leaders -min 2 -max 2 msg -type string -help\ - "error message to display immediately prior to usage table. - May be empty string to just display usage. + "Error message to display immediately prior to usage table. + May be empty string to just display usage. " spec_dict -type dict -help\ - "Dictionary of argument specifications. - This is the internal format parsed from - the textual definition. It contains the data - organised/optimised to allow the final arg - parser/validator to make decisions. + "Dictionary of argument specifications. + This is the internal format parsed from + the textual definition. It contains the data + organised/optimised to allow the final arg + parser/validator to make decisions. " @opts -badarg -type string -help\ "name of an argument to highlight" -aserror -type boolean -help\ - "If true, the usage table is raised as an error message, - otherwise it is returned as a value." + "If true, the usage table is raised as an error message, + otherwise it is returned as a value." -return -choices {string table tableobject} -choicelabels { string "no table layout" tableobject "table object cmd" @@ -2133,6 +2543,8 @@ tcl::namespace::eval punk::args { } + #set RST [a] + set RST "\x1b\[m" set t "" ;#possible oo table object - may be tested for objectiness at the end so needs to exist. #REVIEW - risk of accidental indefinite recursion if functions used here also use punk::args::get_dict and there is an argument error @@ -2158,7 +2570,7 @@ tcl::namespace::eval punk::args { append errmsg \n } else { if {($returntype in {table tableobject}) && !$has_textblock} { - append errmsg \n "$CLR(errormsg)(layout package textblock is missing)[a]" \n + append errmsg \n "$CLR(errormsg)(layout package textblock is missing)$RST" \n } else { append errmsg \n } @@ -2181,7 +2593,7 @@ tcl::namespace::eval punk::args { set blank_header_col [list] if {$cmdname ne ""} { lappend blank_header_col "" - set cmdname_display $CLR(cmdname)$cmdname[a] + set cmdname_display $CLR(cmdname)$cmdname$RST } else { set cmdname_display "" } @@ -2194,7 +2606,7 @@ tcl::namespace::eval punk::args { } if {$docurl ne ""} { lappend blank_header_col "" - set docurl_display [a+ white]$docurl[a] + set docurl_display [a+ white]$docurl$RST } else { set docurl_display "" } @@ -2216,7 +2628,7 @@ tcl::namespace::eval punk::args { lappend blank_header_col "" } if {$use_table} { - set t [textblock::class::table new $CLR(title)Usage[a]] + set t [textblock::class::table new "$CLR(title)Usage$RST"] $t add_column -headers $blank_header_col -minwidth 3 $t add_column -headers $blank_header_col @@ -2295,19 +2707,18 @@ tcl::namespace::eval punk::args { #potentially require coordination with header colspans? $t add_row [list "" $argdisplay_body] } else { - if {$argdisplay_header ne "" + if {$argdisplay_header ne ""} { lappend errlines $argdisplay_header } lappend errlines {*}$argdisplay_body } } else { - set RST [a] #set A_DEFAULT [a+ brightwhite Brightgreen] set A_DEFAULT "" set A_BADARG $CLR(badarg) - set greencheck $CLR(check)\u2713[a] ;#green tick - set soloflag $CLR(solo)\u2690[a] ;#flag - may be replacement char in old dos prompt (?) + set greencheck $CLR(check)\u2713$RST ;#green tick + set soloflag $CLR(solo)\u2690$RST ;#flag - may be replacement char in old dos prompt (?) set A_PREFIX $CLR(choiceprefix) ;#use a+ so colour off can apply if {$A_PREFIX eq "" || $A_PREFIX eq [a+ underline]} { #A_PREFIX can resolve to empty string if colour off @@ -2380,6 +2791,11 @@ tcl::namespace::eval punk::args { set allchoices_originalcase [list] set choices [Dict_getdef $arginfo -choices {}] set choicegroups [Dict_getdef $arginfo -choicegroups {}] + set choicemultiple [dict get $arginfo -choicemultiple] + if {[string is integer -strict $choicemultiple]} { + set choicemultiple [list $choicemultiple $choicemultiple] + } + lassign $choicemultiple choicemultiple_min choicemultiple_max set choicecolumns [Dict_getdef $arginfo -choicecolumns 4] set choiceprefixdenylist [Dict_getdef $arginfo -choiceprefixdenylist {}] if {[Dict_getdef $arginfo -multiple 0]} { @@ -2416,6 +2832,17 @@ tcl::namespace::eval punk::args { set choicelabeldict [Dict_getdef $arginfo -choicelabels {}] set formattedchoices [dict create] ;#use dict rather than array to preserve order append help " Choices$prefixmsg$casemsg" + if {$choicemultiple_max > 1 || $choicemultiple_max == -1} { + if {$choicemultiple_max == -1} { + append help \n " The value can be a list of $choicemultiple_min or more of these choices" + } else { + if {$choicemultiple_min eq $choicemultiple_max} { + append help \n " The value must be a list of $choicemultiple_min of these choices" + } else { + append help \n " The value can be a list of $choicemultiple_min to $choicemultiple_max of these choices" + } + } + } if {![dict get $arginfo -choiceprefix] || [catch {package require punk::trie}]} { #append help "\n " [join [dict get $arginfo -choices] "\n "] if {[dict size $choicelabeldict]} { @@ -2513,7 +2940,7 @@ tcl::namespace::eval punk::args { #append help \n[textblock::join -- " " [$choicetableobj print]] } else { if {$groupname ne ""} { - append help \n \n "$CLR(groupname)Group: $groupname[a]" + append help \n \n "$CLR(groupname)Group: $groupname$RST" } else { append help \n } @@ -2527,15 +2954,15 @@ tcl::namespace::eval punk::args { if {$usetable} { #these will be displayed after all table entries if {$groupname eq ""} { - dict set choicetable_footers "" " $CLR(errormsg)(no choices defined for main group)[a]" + dict set choicetable_footers "" " $CLR(errormsg)(no choices defined for main group)$RST" } else { - dict set choicetable_footers $groupname " $CLR(errormsg)(no choices defined for group $groupname)[a]" + dict set choicetable_footers $groupname " $CLR(errormsg)(no choices defined for group $groupname)$RST" } } else { if {$groupname eq ""} { - append help \n " " $CLR(errormsg)(no choices defined)[a] + append help \n " " $CLR(errormsg)(no choices defined)$RST } else { - append help \n " " $CLR(errormsg)(no choices defined for group $groupname)[a] + append help \n " " $CLR(errormsg)(no choices defined for group $groupname)$RST } } } @@ -2561,7 +2988,7 @@ tcl::namespace::eval punk::args { $obj destroy } if {[dict size $choicetable_footers]} { - foreach groupname [dict keys $formattedchoices { + foreach groupname [dict keys $formattedchoices] { if {[dict exists $choicetable_footers $groupname]} { append help \n [dict get $choicetable_footers $groupname] } @@ -2570,6 +2997,7 @@ tcl::namespace::eval punk::args { #review. use -type to restrict additional choices - may be different to values in the -choices if {![dict get $arginfo -choicerestricted]} { + #when -choicemultiple - the -type refers to each selection if {[dict get $arginfo -type] eq "string"} { append help "\n (values not in defined choices are allowed)" } else { @@ -2609,7 +3037,7 @@ tcl::namespace::eval punk::args { } } else { #review - formatting will be all over the shop due to newlines in typesshow, help - set arghelp "[a+ bold]$argshow[a] TYPE:$typeshow DEFAULT:$default MULTI:$multiple\n" + set arghelp "[a+ bold]$argshow$RST TYPE:$typeshow DEFAULT:$default MULTI:$multiple\n" foreach ln [split $help \n] { append arghelp " $ln" \n } @@ -2666,35 +3094,40 @@ tcl::namespace::eval punk::args { } - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + @dynamic @id -id ::punk::args::usage @cmd -name punk::args::usage -help\ - "Return usage information for a command. + "Return usage information for a command identified by an id. + This will only work for commands where a punk::args definition exists - for the command and an id has been defined for it. + for the command and an id has been defined for it. The id for custom + help for a command should match the fully qualified name of the command. + Many commands (such as ensembles and oo objects) may have argument - documentation generated dynamically and not have an id. + documentation generated dynamically and may not yet have an id. + IDs for autogenenerated help are prefixed e.g (autodef)::myensemble. + Generally punk::ns::arginfo (aliased as i in the punk shell) should be used in preference - as it will search for a documentation - mechanism and call this as necessary. + mechanism and call punk::args::usage as necessary. " -return -default table -choices {string table tableobject} - } {${[punk::args::resolved_def -type @opts ::punk::args::arg_error -scheme]}} { + } {${[punk::args::resolved_def -types opts ::punk::args::arg_error -scheme]}} { @values -min 0 -max 1 id -help\ - "exact id. - Will usually match the command name" + "Exact id. + Will usually match the command name" }] proc usage {args} { lassign [dict values [punk::args::get_by_id ::punk::args::usage $args]] leaders opts values received set id [dict get $values id] - set definitionlist [rawdef $id] - if {[llength $definitionlist] == 0} { + set real_id [real_id $id] + if {$real_id eq ""} { error "punk::args::usage - no such id: $id" } - #by placing scheme before the supplied args - it can be overridden - arg_error "" [uplevel 1 [list punk::args::define {*}$definitionlist]] -scheme punk_info {*}$opts -aserror 0 + arg_error "" [punk::args::get_spec $real_id] -scheme punk_info {*}$opts -aserror 0 } lappend PUNKARGS [list { @@ -2704,13 +3137,13 @@ tcl::namespace::eval punk::args { id arglist -type list -help\ "list containing arguments to be parsed as per the - argument specification identified by the supplied id." + argument specification identified by the supplied id." }] #deprecate? proc get_by_id {id arglist} { - set definitionlist [punk::args::rawdef $id] + set definitionlist [punk::args::raw_def $id] if {[llength $definitionlist] == 0} { error "punk::args::get_by_id - no such id: $id" } @@ -2734,62 +3167,86 @@ tcl::namespace::eval punk::args { @cmd -name punk::args::parse -help\ "parse and validate command arguments based on a definition. - In the 'withid' form the definition is a pre-existing - record that has been created with ::punk::args::define. - In the 'withdef' form - the definition is created on the - first call and cached thereafter. + In the 'withid' form the definition is a pre-existing record that has been + created with ::punk::args::define, or indirectly by adding a definition to + the PUNKARGS variable in a namespace which is then registered in + punk::args::register::NAMESPACES, or by a previous call to punk::parse + using 'withdef' and a definition block containing an @id -id directive. + + In the 'withdef' form - the definition is created on the first call and + cached thereafter, if the id didn't already exist. - form1: parse ?-flag val?... -- $arglist withid $id - form2: parse ?-flag val?... -- $arglist withdef $def ?$def? + form1: parse $arglist ?-flag val?... withid $id + form2: parse $arglist ?-flag val?... withdef $def ?$def? see punk::args::define" + @form -form {withid withdef} + @leaders -min 1 -max 1 + arglist -type list -optional 0 -help\ + "Arguments to parse - supplied as a single list" + @opts - -form -type list -default * -help\ + -form -type list -default * -help\ "Restrict parsing to the set of forms listed. - Forms are the orthogonal sets of arguments a - command can take - usually described in 'synopsis' - entries. - " + Forms are the orthogonal sets of arguments a + command can take - usually described in 'synopsis' + entries." #default to enhanced errorstyle despite slow 'catch' (unhappy path) performance #todo - configurable per interp/namespace - -errorstyle -type string -default enhanced -choices {enhanced standard minimal} - @values -min 3 - sep -optional 0 -choices "--" + -errorstyle -type string -default enhanced -choices {enhanced standard minimal} + @values -min 2 - @form -form withid -synopsis "parse ?-form {int|...}? ?-errorstyle ? -- withid $id" + @form -form withid -synopsis "parse arglist ?-form {int|...}? ?-errorstyle ? withid $id" withid -type literal -help\ "The literal value 'withid'" id -type string -help\ "id of punk::args definition for a command" - @form -form withdef -synopsis "parse ?-form {int|...}? ?-errorstyle ? -- withdef $def ?$def?" + @form -form withdef -synopsis "parse arglist ?-form {int|...}? ?-errorstyle ? withdef $def ?$def?" withdef -type literal -help\ "The literal value 'withdef'" + + #todo - make -dynamic obsolete - use @dynamic directive instead def -type string -multiple 1 -optional 0 -help\ "Each remaining argument is a block of text - defining argument definitions. - As a special case, -dynamic may be - specified as the 1st 2 arguments. These are - not treated as an indicator to punk::args - about how to process the definition." + defining argument definitions. + As a special case, -dynamic may be + specified as the 1st 2 arguments. These are + treated as an indicator to punk::args about + how to process the definition." }] proc parse {args} { set tailtype "" ;#withid|withdef - set split [lsearch -exact $args --] ;#first -- + if {[llength $args] < 3} { + error "punk::args::parse - invalid call. < 3 args" + } + set parseargs [lindex $args 0] + set tailargs [lrange $args 1 end] + + set split [lsearch -exact $tailargs withid] if {$split < 0} { - #punk::args::usage arg_error? - error "punk::args::parse - invalid call. End of opts marker -- is required even if no options are present." + set split [lsearch -exact $tailargs withdef] + if {$split < 0} { + #punk::args::usage arg_error? + error "punk::args::parse - invalid call. keyword withid|withdef required" + } else { + set tailtype withdef + } + } else { + set tailtype withid + } + + set opts [lrange $tailargs 0 $split-1] ;#repeated flags will override earlier. That's ok here. + if {[llength $opts] % 2} { + error "punk::args::parse Even number of -flag val pairs required after arglist" } - set opts [lrange $args 0 $split-1] ;#repeated flags will override earlier. That's ok here. - set arglist [lindex $args $split+1] - set tailtype [lindex $args $split+2] set defaultopts [dict create\ -form {*}\ -errorstyle enhanced\ ] - + set opts [dict merge $opts $defaultopts] dict for {k v} $opts { switch -- $k { -form - -errorstyle { @@ -2802,24 +3259,43 @@ tcl::namespace::eval punk::args { } switch -- $tailtype { withid { - if {[llength [lrange $args $split+3 end]] != 1} { + if {[llength [lrange $tailargs $split+1 end]] != 1} { error "punk::args::parse - invalid call. Expected exactly one argument after 'withid'" } - set id [lindex $args $split+3] - return "parse [llength $arglist] args withid $id, options:$opts" + set id [lindex $tailargs $split+1] + #puts stdout "punk::args::parse [llength $parseargs] args withid $id, options: $opts" + set deflist [raw_def $id] + if {[llength $deflist] == 0} { + error "punk::args::parse - no such id: $id" + } } withdef { - set deflist [lrange $args $split+3 end] + set deflist [lrange $tailargs $split+1 end] if {[llength $deflist] < 1} { error "punk::args::parse - invalid call. Expected at least one argument after 'withdef'" } - return "parse [llength $arglist] with [llength $deflist] definition blocks, options:$opts" + #puts stdout "punk::args::parse [llength $parseargs] args with [llength $deflist] definition blocks, options: $opts" } default { error "punk::args::parse - invalid call. Argument following arglist must be 'withid' or 'withdef'" } } - + try { + set result [punk::args::get_dict {*}$deflist $parseargs] + } trap {PUNKARGS} {msg opts} { + #trap punk::args argument validation/parsing errors and decide here + #whether to display basic error - or full usage if configured. + puts stderr "PUNKARGS: $msg\n$opts" + return + } trap {} {msg opts} { + #review + #puts stderr "$msg\n$opts" + #quote from DKF: The reason for using return -code error vs error or throw depends on where the error is. If the problem is in your code, use error or throw. + #If the problem is in your caller (e.g., because they gave you bad arguments) then use return -code error. Simple. + throw [dict get $opts -errorcode] [dict get $opts -errorinfo] + return + } + return $result } proc parseXXX {args} { #no solo flags allowed for parse function itself. (ok for arglist being parsed) @@ -2920,19 +3396,14 @@ tcl::namespace::eval punk::args { # @values -multiple 1 #} $args - set is_dynamic 0 - if {[lindex $args 0] eq "-dynamic"} { - set is_dynamic [lindex $args 1] - } set rawargs [lindex $args end] ;# args values to be parsed - #we take a definition list rather than argspecs - because the definition could be dynamic set definition_args [lrange $args 0 end-1] #if definition has been seen before, #define will either return a permanently cached argspecs (-dynamic 0) - or # use a cached pre-split definition with parameters to dynamically generate a new (or limitedly cached?) argspecs. - set argspecs [uplevel 1 [list ::punk::args::define {*}$definition_args]] + set argspecs [uplevel 1 [list ::punk::args::resolve {*}$definition_args]] # ----------------------------------------------- # Warning - be aware of all vars thrown into this space (from tail end of 'definition' proc) @@ -3397,22 +3868,22 @@ tcl::namespace::eval punk::args { #puts "---opts_and_values:$opts_and_values" #puts "---argstate:$argstate" tcl::dict::for {argname v} $opts_and_values { - set thisarg [tcl::dict::get $argstate $argname] - #set thisarg_keys [tcl::dict::keys $thisarg] - set thisarg_checks [tcl::dict::get $arg_checks $argname] - set is_multiple [tcl::dict::get $thisarg -multiple] - set is_allow_ansi [tcl::dict::get $thisarg -allow_ansi] - set is_validate_ansistripped [tcl::dict::get $thisarg -validate_ansistripped] - set is_strip_ansi [tcl::dict::get $thisarg -strip_ansi] - set has_default [tcl::dict::exists $thisarg -default] + set thisarg [tcl::dict::get $argstate $argname] + #set thisarg_keys [tcl::dict::keys $thisarg] + set thisarg_checks [tcl::dict::get $arg_checks $argname] + set is_multiple [tcl::dict::get $thisarg -multiple] + set is_allow_ansi [tcl::dict::get $thisarg -allow_ansi] + set is_validate_ansistripped [tcl::dict::get $thisarg -validate_ansistripped] + set is_strip_ansi [tcl::dict::get $thisarg -strip_ansi] + set has_default [tcl::dict::exists $thisarg -default] if {$has_default} { set defaultval [tcl::dict::get $thisarg -default] } - set type [tcl::dict::get $thisarg -type] - set has_choices [expr {[tcl::dict::exists $thisarg -choices] || [tcl::dict::exists $thisarg -choicegroups]}] - set regexprepass [tcl::dict::get $thisarg -regexprepass] - set regexprefail [Dict_getdef $thisarg -regexprefail ""] ;#aliased to dict getdef in tcl9 - set validationtransform [tcl::dict::get $thisarg -validationtransform] + set type [tcl::dict::get $thisarg -type] + set has_choices [expr {[tcl::dict::exists $thisarg -choices] || [tcl::dict::exists $thisarg -choicegroups]}] + set regexprepass [tcl::dict::get $thisarg -regexprepass] + set regexprefail [Dict_getdef $thisarg -regexprefail ""] ;#aliased to dict getdef in tcl9 + set validationtransform [tcl::dict::get $thisarg -validationtransform] if {$is_multiple} { @@ -3443,13 +3914,18 @@ tcl::namespace::eval punk::args { set choiceprefix [tcl::dict::get $thisarg -choiceprefix] set choiceprefixdenylist [Dict_getdef $thisarg -choiceprefixdenylist {}] set choicerestricted [tcl::dict::get $thisarg -choicerestricted] + set choicemultiple [tcl::dict::get $thisarg -choicemultiple] + if {[string is integer -strict $choicemultiple]} { + set choicemultiple [list $choicemultiple $choicemultiple] + } + lassign $choicemultiple choicemultiple_min choicemultiple_max set nocase [tcl::dict::get $thisarg -nocase] set choices [Dict_getdef $thisarg -choices {}] set choicegroups [Dict_getdef $thisarg -choicegroups {}] set allchoices $choices if {[dict size $choicegroups]} { - dict for {groupname clist} $choicegroups { - lappend allchoices {*}$clist + dict for {groupname groupmembers} $choicegroups { + lappend allchoices {*}$groupmembers } } #note we can legitimately have dups in allchoices - if a choice should be documented to display in multiple groups @@ -3468,115 +3944,159 @@ tcl::namespace::eval punk::args { } } set idx 0 ;# - #opts/values_dict $argname member has been populated with the actual entered choices - which might be prefixes + #leaders_dict/opts/values_dict $argname member has been populated with the actual entered choices - which might be prefixes #assert llength $vlist == llength [dict get $dname $argname] # (unless there was a default and the option wasn't specified) set vlist_validate [list] set vlist_check_validate [list] foreach e $vlist e_check $vlist_check { - if {$nocase} { - set casemsg " (case insensitive)" - set choices_test [tcl::string::tolower $allchoices] - #Don't lcase the denylist - even in nocase mode! - #set choiceprefixdenylist [tcl::string::tolower $choiceprefixdenylist] - set v_test [tcl::string::tolower $e_check] + set allchoices_in_list 0 + if {$choicemultiple_max > 1 || $choicemultiple_max == -1} { + #vlist and vlist_check can be list of lists if -multiple and -choicemultiple + #each e represents 0 or more choice selections + set c_list $e + set c_check_list $e_check + #todo? check if entire list matches default? } else { - set casemsg " (case sensitive)" - set v_test $e_check - set choices_test $allchoices + #only one choice at a time - ensure single entry in c_list c_check_list + set c_list [list $e] + set c_check_list [list $e_check] } - set choice_in_list 0 - set matches_default [expr {$has_default && $e eq $defaultval}] - if {!$matches_default} { - if {$choiceprefix} { - #can we handle empty string as a choice? It should just work - REVIEW/test - set choice_exact_match 0 - if {$e_check in $allchoices} { - #for case when there are case-differenced duplicates - allow exact match to avoid selecting earlier match of another casing - set chosen $e_check - set choice_in_list 1 - set choice_exact_match 1 - } elseif {$v_test in $choices_test} { - set chosen $v_test - set choice_in_list 1 - } else { - #PREFIX check required - any 'chosen' here is not an exact match or it would have matched above. - #assert - if empty string was a provided choice and empty string was a provided arg - we would have matched above. - #in this block we can treat empty result from prefix match as a non-match - if {$nocase} { - #nocase implies that our entered value doesn't have to match case of choices - - #but we would still like to select the best match if there are case-dups. - #e.g arg -choices {delete Delete} -nocase 1 -choiceprefixdenylist delete - # selecting Del will find Delete, del will match delete (and raise error) - # but DEL will also match delete rather than Delete - so again an error is raised. - #This is counterintuitive with -nocase - #This is probably such an edge case that best served with documentation as a feature-not-bug - #Rationale being that in a nocase situation it's arbitrary/counterintuitive to consider DEL, or DeL a better match for Delete than delete? - #The choice of the user to use -choiceprefixdenylist along with case-dups is the issue. - - set bestmatch [tcl::prefix::match -error "" [lsort -unique $allchoices] $e_check] - if {$bestmatch eq ""} { - set chosen [tcl::prefix::match -error "" [lsort -unique $choices_test] $v_test] - set choice_in_list [expr {$chosen ne ""}] - #we + + + #----------------------------------- + #fast fail on the wrong number of choices + if {[llength $c_list] < $choicemultiple_min} { + set msg "Option $argname for [Get_caller] requires at least $choicemultiple_min choices. Received [llength $c_list] choices." + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list choicecount [llength $c_list] minchoices $choicemultiple_min maxchoices $choicemultiple_max] -badarg $argname]] $msg + } + if {$choicemultiple_max != -1 && [llength $c_list] > $choicemultiple_max} { + set msg "Option $argname for [Get_caller] requires at most $choicemultiple_max choices. Received [llength $c_list] choices." + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list choicecount [llength $c_list] minchoices $choicemultiple_min maxchoices $choicemultiple_max] -badarg $argname]] $msg + } + #----------------------------------- + + set choice_idx 0 ;#we need to overwrite raw-choice (which may be prefix) with a value from the choice list + foreach c $c_list c_check $c_check_list { + if {$nocase} { + set casemsg " (case insensitive)" + set choices_test [tcl::string::tolower $allchoices] + #Don't lcase the denylist - even in nocase mode! + #set choiceprefixdenylist [tcl::string::tolower $choiceprefixdenylist] + set v_test [tcl::string::tolower $c_check] + } else { + set casemsg " (case sensitive)" + set v_test $c_check + set choices_test $allchoices + } + set choice_in_list 0 + set matches_default [expr {$has_default && $c eq $defaultval}] ;# defaultval when -choicemultiple could be a list? + if {!$matches_default} { + if {$choiceprefix} { + #can we handle empty string as a choice? It should just work - REVIEW/test + set choice_exact_match 0 + if {$c_check in $allchoices} { + #for case when there are case-differenced duplicates - allow exact match to avoid selecting earlier match of another casing + set chosen $c_check + set choice_in_list 1 + set choice_exact_match 1 + } elseif {$v_test in $choices_test} { + set chosen $v_test + set choice_in_list 1 + } else { + #PREFIX check required - any 'chosen' here is not an exact match or it would have matched above. + #assert - if empty string was a provided choice and empty string was a provided arg - we would have matched above. + #in this block we can treat empty result from prefix match as a non-match + if {$nocase} { + #nocase implies that our entered value doesn't have to match case of choices - + #but we would still like to select the best match if there are case-dups. + #e.g arg -choices {delete Delete} -nocase 1 -choiceprefixdenylist delete + # selecting Del will find Delete, del will match delete (and raise error) + # but DEL will also match delete rather than Delete - so again an error is raised. + #This is counterintuitive with -nocase + #This is probably such an edge case that best served with documentation as a feature-not-bug + #Rationale being that in a nocase situation it's arbitrary/counterintuitive to consider DEL, or DeL a better match for Delete than delete? + #The choice of the user to use -choiceprefixdenylist along with case-dups is the issue. + + set bestmatch [tcl::prefix::match -error "" [lsort -unique $allchoices] $c_check] + if {$bestmatch eq ""} { + set chosen [tcl::prefix::match -error "" [lsort -unique $choices_test] $v_test] + #now pick the earliest match in the actually defined list so that case of chosen always matches a defined entry with casing + set chosen [lsearch -inline -nocase $allchoices $chosen] + set choice_in_list [expr {$chosen ne ""}] + } else { + set chosen $bestmatch + set choice_in_list 1 + } } else { - set chosen $bestmatch - set choice_in_list 1 + set chosen [tcl::prefix::match -error "" [lsort -unique $allchoices] $c_check] + if {$chosen eq ""} { + set choice_in_list 0 + } else { + set choice_in_list 1 + } } - } else { - set chosen [tcl::prefix::match -error "" [lsort -unique $allchoices] $e_check] - if {$chosen eq ""} { + #override choice_in_list if in deny list + #don't allow prefixing for elements from -choiceprefixdenylist + #we still use all elements to calculate the prefixes though + #review - case difference edge cases in choiceprefixdenylist !todo + if {$chosen in $choiceprefixdenylist} { set choice_in_list 0 - } else { - set choice_in_list 1 + set chosen "" } } - #override choice_in_list if in deny list - #don't allow prefixing for elements from -choiceprefixdenylist - #we still use all elements to calculate the prefixes though - #review - case difference edge cases in choiceprefixdenylist !todo - if {$chosen in $choiceprefixdenylist} { - set choice_in_list 0 - set chosen "" - } - } - if {$choice_in_list && !$choice_exact_match} { - if {$is_multiple} { - set existing [tcl::dict::get [set $dname] $argname] - lset existing $idx $chosen - tcl::dict::set $dname $argname $existing - } else { - tcl::dict::set $dname $argname $chosen + if {$choice_in_list && !$choice_exact_match} { + if {$choicemultiple_max != -1 && $choicemultiple_max < 2} { + if {$is_multiple} { + set existing [tcl::dict::get [set $dname] $argname] + lset existing $idx $chosen + tcl::dict::set $dname $argname $existing + } else { + tcl::dict::set $dname $argname $chosen + } + } else { + if {$is_multiple} { + set existing_all [tcl::dict::get [set $dname] $argname] + lset existing_all $idx $choice_idx $chosen + tcl::dict::set $dname $argname $existing_all + } else { + set existing [tcl::dict::get [set $dname] $argname] + lset existing $choice_idx $chosen + tcl::dict::set $dname $argname $existing + } + } } + } else { + #value as stored in $dname is ok + set choice_in_list [expr {$v_test in $choices_test}] } - } else { - #value as stored in $dname is ok - set choice_in_list [expr {$v_test in $choices_test}] } - } - if {!$choice_in_list && !$matches_default} { - if {!$choicerestricted} { - #if {$is_multiple} { - # set existing [tcl::dict::get [set $dname] $argname] - # lset existing $idx $v_test - # tcl::dict::set $dname $argname $existing - #} else { - # tcl::dict::set $dname $argname $v_test - #} - lappend vlist_validate $e - lappend vlist_check_validate $e_check - } else { - #unhappy path - if {$choiceprefix} { - set prefixmsg " (or a unique prefix of a value)" + if {!$choice_in_list && !$matches_default} { + if {!$choicerestricted} { + #if {$is_multiple} { + # set existing [tcl::dict::get [set $dname] $argname] + # lset existing $idx $v_test + # tcl::dict::set $dname $argname $existing + #} else { + # tcl::dict::set $dname $argname $v_test + #} + lappend vlist_validate $c + lappend vlist_check_validate $c_check } else { - set prefixmsg "" + #unhappy path + if {$choiceprefix} { + set prefixmsg " (or a unique prefix of a value)" + } else { + set prefixmsg "" + } + arg_error "Option $argname for [Get_caller] must be one of the listed values:\n [join $allchoices "\n "]\n$casemsg$prefixmsg. Received: '$c'" $argspecs -badarg $argname } - arg_error "Option $argname for [Get_caller] must be one of the listed values:\n [join $allchoices "\n "]\n$casemsg$prefixmsg. Received: '$e'" $argspecs -badarg $argname } + incr choice_idx } + incr idx } #reduce our vlist and vlist_check lists by removing choice matches as they need to be passed through without validation @@ -3588,10 +4108,11 @@ tcl::namespace::eval punk::args { if {[llength $vlist] && $has_default} { set vlist_validate [list] set vlist_check_validate [list] - foreach e $vlist e_check $vlist_check { - if {$e_check ne $defaultval} { - lappend vlist_validate $e - lappend vlist_check_validate $e + foreach c $vlist c_check $vlist_check { + #for -choicemultiple with default that could be a list use 'ni' ?? review + if {$c_check ne $defaultval} { + lappend vlist_validate $c + lappend vlist_check_validate $c } } set vlist $vlist_validate @@ -3854,7 +4375,12 @@ tcl::namespace::eval punk::args { xdigit { foreach e $vlist e_check $vlist_check { if {![tcl::string::is $type $e_check]} { - arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e'" $argspecs -badarg $argname + set msg "Option $argname for [Get_caller] requires type '$type'. Received: '$e'" + #try trap? + #return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type]]] $result + #throw ? + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname]] $msg + arg_error $msg $argspecs -badarg $argname } } } @@ -4012,59 +4538,104 @@ tcl::namespace::eval punk::args::lib { lappend PUNKARGS [list { @id -id ::punk::args::lib::tstr @cmd -name punk::args::lib::tstr -help\ - "A rough equivalent of js template literals" + "A rough equivalent of js template literals + + Substitutions: + \$\{$varName\} + \$\{[myCommand]\} + (when -allowcommands flag is given)" -allowcommands -default 0 -type none -help\ - "if -allowcommands is present, placeholder can contain commands - e.g {\$\{plaintext0 [lindex $var 0] plaintext2\}}" - -return -default list -choices {dict list string args}\ + "If -allowcommands is present, placeholder can contain commands + e.g {\$\{plaintext0 [lindex $var 0] plaintext2\}}" + -undent -default 1 -type boolean -help\ + "undent/dedent the template lines. + The longest common prefix of whitespace is removed" + -indent -default "" -type string -help\ + "String with which to indent the template + prior to substitution. + If -undent is enabled, that is performed + first, then the indent is applied." + -paramindents -default line -choices {none line position} -choicelabels { + line\ + " Use leading whitespace in + the line in which the + placeholder occurs." + position\ + " Use the position in + the line in which the + placeholder occurs." + none\ + " No indents applied to + subsequent placeholder value + lines. This will usually + result in text awkwardly + ragged unless the source code + has also been aligned with the + left margin or the value has + been manually padded." + } -help\ + "How indenting is done for subsequent lines in a + multi-line placeholder substitution value. + The 1st line or a single line value is always + placed at the placeholder. + paramindents are performed after the main + template has been indented/undented. + (indenting by position does not calculate + unicode double-wide or grapheme cluster widths) + " + #choicelabels indented by 1 char is clearer for -return string - and reasonable in table + -return -default string -choices {dict list string args}\ -choicelabels { dict\ - "Return a dict with keys - 'template', 'params' and - 'errors'" - string\ - "Return a single result - being the string with - placeholders substituted." - list\ - "Return a 2 element list. - The first is itself a list - of plaintext portions of the - template, split at each point - at which placeholders were - present. The second element - of the outer list is a list - of placeholder values if -eval - is 1, or a list of the raw - placeholder strings if -eval - is 0." - args\ - "Return a list where the first - element is a list of template - plaintext sections as per the - 'list' return mechanism, but the - placeholder items are individual - items in the returned list. - This can be useful when passing - the expanded result of a tstr - command to another function - which expects the placeholders - as individual arguments" + " Return a dict with keys + 'template', 'params' and + 'errors'" + string\ + " Return a single result + being the string with + placeholders substituted." + list\ + " Return a 2 element list. + The first is itself a list + of plaintext portions of the + template, split at each point + at which placeholders were + present. The second element + of the outer list is a list + of placeholder values if -eval + is 1, or a list of the raw + placeholder strings if -eval + is 0." + args\ + " Return a list where the first + element is a list of template + plaintext sections as per the + 'list' return mechanism, but the + placeholder items are individual + items in the returned list. + This can be useful when passing + the expanded result of a tstr + command to another function + which expects the placeholders + as individual arguments" } -eval -default 1 -type boolean -help\ "Whether to evaluate the \$\{\} placeholders. - When -return is string, -eval should generally be set to 1. - For a string return, -eval 0 will result in the raw contents of \$\{\} being substituted. - contained variables in that case should be braced, or the variable name is likely to collide - with surrounding text. - e.g tstr -return string -eval 0 {plaintext\$\{\$\{var\}\}plaintext} -> plaintext\$\{var\}plaintext" + When -return is string, -eval should generally be set to 1. + For a string return, -eval 0 will result in the raw contents of \$\{\} being substituted. + contained variables in that case should be braced or whitespace separated, or the variable + name is likely to collide with surrounding text. + e.g tstr -return string -eval 0 {plaintext\$\{\$\{var\}\}plaintext} -> plaintext\$\{var\}plaintext" @values -min 0 -max 1 templatestring -help\ "This argument should be a braced string containing placeholders such as \$\{$var\} e.g {The value is \$\{$var\}.} - where $var will be substituted from the calling context - The placeholder itself can contain plaintext portions as well as variables. - It can contain commands in square brackets if -allowcommands is true - e.g tstr -return string -allowcommands {Tcl Version:\$\{[info patch]\} etc}" + where $var will be substituted from the calling context + The placeholder itself can contain plaintext portions as well as variables. + It can contain commands in square brackets if -allowcommands is true + e.g tstr -return string -allowcommands {Tcl Version:\$\{[info patch]\} etc} + + Escape sequences such as \\n and unicode escapes are processed within placeholders. + " }] proc tstr {args} { @@ -4080,8 +4651,11 @@ tcl::namespace::eval punk::args::lib { set arglist [lrange $args 0 end-1] set opts [dict create\ -allowcommands 0\ + -undent 1\ + -indent ""\ + -paramindents line\ -eval 1\ - -return list\ + -return string\ ] if {"-allowcommands" in $arglist} { set arglist [::punk::args::system::punklib_ldiff $arglist -allowcommands] @@ -4089,21 +4663,21 @@ tcl::namespace::eval punk::args::lib { } if {[llength $arglist] % 2 != 0} { if {[info commands ::punk::args::get_by_id] ne ""} { - punk::args::get_by_id ::punk::args::tstr $args + punk::args::get_by_id ::punk::args::lib::tstr $args return } else { error "punk::args::lib::tstr expected option/value pairs prior to last argument" } } dict for {k v} $arglist { - set fullk [tcl::prefix::match -error "" {-allowcommands -return -eval} $k] + set fullk [tcl::prefix::match -error "" {-allowcommands -indent -undent -paramindents -return -eval} $k] switch -- $fullk { - -return - -eval { + -indent - -undent - -paramindents - -return - -eval { dict set opts $fullk $v } default { if {[info commands ::punk::args::get_by_id] ne ""} { - punk::args::get_by_id ::punk::args::tstr $args + punk::args::get_by_id ::punk::args::lib::tstr $args return } else { error "punk::args::lib::tstr unknown option $k. Known options: [dict keys $opts]" @@ -4112,6 +4686,12 @@ tcl::namespace::eval punk::args::lib { } } set opt_allowcommands [dict get $opts -allowcommands] + set opt_paramindents [dict get $opts -paramindents] + set test_paramindents [tcl::prefix::match -error "" {none line position} $opt_paramindents] + if {$test_paramindents ni {none line position}} { + error "punk::args::lib::tstr option -paramindents invalid value '$opt_paramindents'. Must be one of none, line, position or an unambiguous abbreviation thereof." + } + set opt_paramindents $test_paramindents set opt_return [dict get $opts -return] set opt_return [tcl::prefix::match -error "" {args dict list string} $opt_return] if {$opt_return eq ""} { @@ -4124,6 +4704,15 @@ tcl::namespace::eval punk::args::lib { set nocommands "" } + set opt_undent [dict get $opts -undent] + if {$opt_undent} { + set templatestring [punk::args::lib::undent $templatestring] + } + set opt_indent [dict get $opts -indent] + if {$opt_indent ne ""} { + set templatestring [punk::args::lib::indent $templatestring $opt_indent] + } + #set parts [_tstr_split $templatestring] if {[string first \$\{ $templatestring] < 0} { set parts [list $templatestring] @@ -4135,6 +4724,14 @@ tcl::namespace::eval punk::args::lib { set params [list] set idx 0 set errors [dict create] + set lastline "" ;#todo - first line has placeholder? + set pt1 [lindex $parts 0] + set lastline_posn [string last \n $pt1] + if {$lastline_posn >= 0} { + set lastline [string range $pt1 $lastline_posn+1 end] + } else { + set lastline $pt1 + } foreach {pt expression} $parts { lappend textchunks $pt incr idx ;#pt incr @@ -4143,18 +4740,39 @@ tcl::namespace::eval punk::args::lib { if {$idx == [llength $parts]} { break } + set lastline_posn [string last \n $pt] + if {$lastline_posn >= 0} { + set lastline [string range $pt $lastline_posn+1 end] + } #lappend expressions $expression + #---------------------- + #REVIEW - JMN + #TODO - debug punk::args loading of @dynamic defs + #puts "-- $expression" + #---------------------- + #brk1 - literal newline not {\n} + set leader "" + if {[set brk1 [string first \n $expression]] >= 0} { + #undent left of paramstart only for lines of expression that arent on opening ${..} line + set tail [string range $expression $brk1+1 end] + set leader [string repeat " " [string length $lastline]] + set undentedtail [punk::args::lib::undentleader $tail $leader] + #set undentedtail [punk::lib::undent [string range $expression $brk1+1 end]] + set expression "[string range $expression 0 $brk1]$undentedtail" + } if {$opt_eval} { if {[catch [list uplevel 1 [list ::subst {*}$nocommands $expression]] result]} { lappend params [string cat \$\{ $expression \}] dict set errors [expr {[llength $params]-1}] $result } else { + set result [string map [list \n "\n$leader"] $result] lappend params $result } #lappend params [uplevel 1 [list ::subst {*}$nocommands $expression]] } else { - lappend params $expression + lappend params [subst -nocommands -novariables $expression] } + append lastline [lindex $params end] ;#for current expression's position calc incr idx ;#expression incr } @@ -4167,7 +4785,9 @@ tcl::namespace::eval punk::args::lib { dict for {i e} $errors { append einfo "parameter $i error: $e" \n } - puts stderr "tstr errors:\n$einfo\n]" + #REVIEW!!! + #TODO - fix + #puts stderr "tstr errors:\n$einfo\n" } switch -- $opt_return { @@ -4179,9 +4799,46 @@ tcl::namespace::eval punk::args::lib { return [list $textchunks {*}$params] } string { + #todo - flag to disable indent-matching behaviour for multiline param? set out "" + set pt1 [lindex $parts 0] + set lastline_posn [string last \n $pt1] + if {$lastline_posn >= 0} { + set lastline [string range $pt1 $lastline_posn+1 end] + } else { + set lastline $pt1 + } foreach pt $textchunks param $params { - append out $pt $param + if {$opt_paramindents eq "none"} { + append out $pt $param + } else { + set lastline_posn [string last \n $pt] + if {$lastline_posn >= 0} { + set lastline [string range $pt $lastline_posn+1 end] + } + if {$opt_paramindents eq "line"} { + regexp {(\s*).*} $lastline _all lastindent + } else { + #position + #TODO - detect if there are grapheme clusters + #This regsub doesn't properly space unicode double-wide chars or clusters + set lastindent "[regsub -all {\S} $lastline " "] " + } + if {$lastindent ne ""} { + set paramlines [split $param \n] + if {[llength $paramlines] == 1} { + append out $pt $param + } else { + append out $pt [lindex $paramlines 0] + foreach nextline [lrange $paramlines 1 end] { + append out \n $lastindent $nextline + } + } + } else { + append out $pt $param + } + append lastline $param + } } return $out } @@ -4239,7 +4896,7 @@ tcl::namespace::eval punk::args::lib { } } else { if {$in_placeholder == 2} { - #skip opening bracket + #skip opening bracket dollar sign set in_placeholder 1 } else { append echars $ch @@ -4294,11 +4951,248 @@ tcl::namespace::eval punk::args::lib { return [lappend list [tcl::string::range $text $start end]] } + #like textutil::adjust::indent - but doesn't strip trailing lines, and doesn't implement skip parameter. + proc indent {text {prefix " "}} { + set result [list] + foreach line [split $text \n] { + if {[string trim $line] eq ""} { + lappend result "" + } else { + lappend result $prefix[string trimright $line] + } + } + return [join $result \n] + } + #dedent? + proc undent {text} { + if {$text eq ""} { + return "" + } + set lines [split $text \n] + set nonblank [list] + foreach ln $lines { + if {[string trim $ln] eq ""} { + continue + } + lappend nonblank $ln + } + set lcp [longestCommonPrefix $nonblank] + if {$lcp eq ""} { + return $text + } + regexp {^([\t ]*)} $lcp _m lcp + if {$lcp eq ""} { + return $text + } + set len [string length $lcp] + set result [list] + foreach ln $lines { + if {[string trim $ln] eq ""} { + lappend result "" + } else { + lappend result [string range $ln $len end] + } + } + return [join $result \n] + } + + #hacky + proc undentleader {text leader} { + #leader usually whitespace - but doesn't have to be + if {$text eq ""} { + return "" + } + set lines [split $text \n] + set nonblank [list] + foreach ln $lines { + if {[string trim $ln] eq ""} { + continue + } + lappend nonblank $ln + } + lappend nonblank "${leader}!!" + set lcp [longestCommonPrefix $nonblank] + if {$lcp eq ""} { + return $text + } + #regexp {^([\t ]*)} $lcp _m lcp + #lcp can be shorter than leader + set lcp [string range $lcp 0 [string length $leader]-1] + + if {$lcp eq ""} { + return $text + } + set len [string length $lcp] + set result [list] + foreach ln $lines { + if {[string trim $ln] eq ""} { + lappend result "" + } else { + lappend result [string range $ln $len end] + } + } + return [join $result \n] + } + #A version of textutil::string::longestCommonPrefixList + proc longestCommonPrefix {items} { + if {[llength $items] <= 1} { + return [lindex $items 0] + } + set items [lsort $items[unset items]] + set min [lindex $items 0] + set max [lindex $items end] + #if first and last of sorted list share a prefix - then all do (first and last of sorted list are the most different in the list) + #(sort order nothing to do with length - e.g min may be longer than max) + if {[string length $min] > [string length $max]} { + set temp $min + set min $max + set max $temp + } + set n [string length $min] + set prefix "" + set i -1 + while {[incr i] < $n && ([set c [string index $min $i]] eq [string index $max $i])} { + append prefix $c + } + return $prefix + } + #*** !doctools #[list_end] [comment {--- end definitions namespace punk::args::lib ---}] } + +tcl::namespace::eval punk::args::argdocbase { + namespace export * + #use a? to test and create literal ansi here rather than relying on punk::ansi package presence + #e.g + #% a? bold + #- bold │SGR 1│sample│â›[1msample + #- ──────┼─────┼──────┼────────── + #- RESULT│ │sample│â›[1msample + proc B {} {return \x1b\[1m} ;#a+ bold + proc N {} {return \x1b\[22m} ;#a+ normal + proc I {} {return \x1b\[3m} ;#a+ italic + proc NI {} {return \x1b\[23m} ;#a+ noitalic + +} # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +tcl::namespace::eval punk::args::package { + variable PUNKARGS + lappend PUNKARGS [list { + @dynamic + @id -id "::punk::args::package::standard_about" + @cmd -name "%pkg%::about" -help\ + "About %pkg% + ... + " + -package_about_namespace -type string -optional 0 -help\ + "Namespace containing the package about procedures + Must contain " + -return\ + -type string\ + -default table\ + -choices {string table tableobject}\ + -choicelabels { + string\ + "A basic text layout" + table\ + "layout in table borders + (requires package: textblock)" + tableobject\ + "textblock::class::table object instance" + }\ + -help\ + "Choose the return type of the 'about' information" + topic -optional 1\ + -nocase 1\ + -default {*}\ + -choices {Description License Version Contact *}\ + -choicerestricted 0\ + -choicelabels { + + }\ + -multiple 1\ + -help\ + "Topic to display. Omit or specify as * to see all. + If * is included with explicit topics, * represents + the remaining unmentioned topics." + }] + proc standard_about {args} { + set argd [punk::args::parse $args withid ::punk::args::package::standard_about] + lassign [dict values $argd] leaders OPTS values received + + set pkgns [dict get $OPTS -package_about_namespace] + if {[info commands ${pkgns}::package_name] eq ""} { + error "punk::args::package::standard_about unable to find function ${pkgns}::package_name" + } + set pkgname [${pkgns}::package_name] + + set opt_return [dict get $OPTS -return] + set all_topics [${pkgns}::about_topics] + if {![dict exists $received topic]} { + set topics $all_topics + } else { + # * represents all remaining topics not explicitly mentioned. + set val_topics [dict get $values topic] ;#if -multiple is true, this is a list + set explicit_topics [lsearch -all -inline -exact -not $val_topics "*"] + set topics [list] + foreach t $val_topics { + if {$t eq "*"} { + foreach a $all_topics { + if {$a ni $explicit_topics} { + lappend topics $a + } + } + } else { + lappend topics $t + } + } + } + if {$opt_return ne "string"} { + package require textblock ;#table support + set is_table 1 + set title [string cat {[} $pkgname {]} ] + set t [textblock::class::table new -title $title] + $t configure -frametype double -minwidth [expr {[string length $title]+2}] + + } else { + set topiclens [lmap t $topics {string length $t}] + set widest_topic [tcl::mathfunc::max {*}$topiclens] + set is_table 0 + set about "$pkgname\n" + append about [string repeat - $widest_topic] \n + } + foreach topic $topics { + if {[llength [info commands ::${pkgns}::get_topic_$topic]] == 1} { + set topic_contents [::${pkgns}::get_topic_$topic] + } else { + set topic_contents "" + } + if {!$is_table} { + set content_lines [split $topic_contents \n] + append about [format %-${widest_topic}s $topic] " " [lindex $content_lines 0] \n + foreach ln [lrange $content_lines 1 end] { + append about [format %-${widest_topic}s ""] " " $ln \n + } + } else { + $t add_row [list $topic $topic_contents] + } + } + + if {!$is_table} { + return $about + } else { + if {$opt_return eq "tableobject"} { + return $t + } + set result [$t print] + $t destroy + return $result + } + } + +} #usually we would directly call arg definitions near the defining proc, # so that the proc could directly use the definition in its parsing. @@ -4314,7 +5208,7 @@ tcl::namespace::eval punk::args::lib { # set PUNKARGS "" #} -lappend ::punk::args::register::NAMESPACES ::punk::args::argdoc ::punk::args ::punk::args::lib +lappend ::punk::args::register::NAMESPACES ::punk::args::argdoc ::punk::args ::punk::args::lib ::punk::args::package # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools @@ -4326,8 +5220,6 @@ tcl::namespace::eval punk::args::system { #dict get value with default wrapper for tcl 8.6 if {[info commands ::tcl::dict::getdef] eq ""} { - #package require punk::lib - #interp alias "" ::punk::args::Dict_getdef "" ::punk::lib::dict_getdef proc Dict_getdef {dictValue args} { set keys [lrange $args 0 end-1] if {[tcl::dict::exists $dictValue {*}$keys]} { @@ -4354,6 +5246,8 @@ tcl::namespace::eval punk::args::system { } } + + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::args [tcl::namespace::eval punk::args { diff --git a/src/bootsupport/modules/punk/char-0.1.0.tm b/src/bootsupport/modules/punk/char-0.1.0.tm index 8cb06b1f..43dcd6b5 100644 --- a/src/bootsupport/modules/punk/char-0.1.0.tm +++ b/src/bootsupport/modules/punk/char-0.1.0.tm @@ -2015,7 +2015,7 @@ tcl::namespace::eval punk::char { # ------------------------------------------------------------------------------------------------------ proc grapheme_split_tk {string} { if {![regexp "\[\uFF-\U10FFFF\]" $string]} { - #only ascii - no joiners or unicode + #only ascii (7 or 8 bit) - no joiners or unicode return [split $string {}] } package require tk @@ -2068,14 +2068,14 @@ tcl::namespace::eval punk::char { return $width } proc wcswidth_single {char} { - scan $c %c dec - if {$c <= 255 && !($c < 31 || $c == 127)} { + scan $char %c dec + if {$dec <= 255 && !($dec < 31 || $dec == 127)} { #review - non-printing ascii? why does textutil::wcswidth report 1 ?? #todo - compare with python or other lang wcwidth return 1 - } elseif {$c < 917504 || $c > 917631} { + } elseif {$dec < 917504 || $dec > 917631} { #TODO - various other joiners and non-printing chars - return [textutil::wcswidth_char $c] + return [textutil::wcswidth_char $dec] ;#note textutil::wcswidth_char takes a decimal codepoint! #may return -1 - REVIEW } return 0 @@ -2084,13 +2084,13 @@ tcl::namespace::eval punk::char { set width 0 foreach c [split $string {}] { scan $c %c dec - if {$c <= 255 && !($c < 31 || $c == 127)} { + if {$dec <= 255 && !($dec < 31 || $dec == 127)} { #review - non-printing ascii? why does textutil::wcswidth report 1 ?? #todo - compare with python or other lang wcwidth incr width - } elseif {$c < 917504 || $c > 917631} { + } elseif {$dec < 917504 || $dec > 917631} { #TODO - various other joiners and non-printing chars - set w [textutil::wcswidth_char $c] + set w [textutil::wcswidth_char $dec] ;#takes decimal codepoint if {$w < 0} { return -1 } else { @@ -2117,14 +2117,14 @@ tcl::namespace::eval punk::char { set chunk [tcl::string::range $string $startidx $endidx] set codes [scan $chunk [tcl::string::repeat %c [tcl::string::length $chunk]]] - foreach c $codes { - if {$c <= 255 && !($c < 31 || $c == 127)} { + foreach dec $codes { + if {$dec <= 255 && !($dec < 31 || $dec == 127)} { #review - non-printing ascii? why does textutil::wcswidth report 1 ?? #todo - compare with python or other lang wcwidth incr width - } elseif {$c < 917504 || $c > 917631} { + } elseif {$dec < 917504 || $dec > 917631} { #TODO - various other joiners and non-printing chars - set w [textutil::wcswidth_char $c] + set w [textutil::wcswidth_char $dec] if {$w < 0} { return -1 } else { @@ -2145,18 +2145,18 @@ tcl::namespace::eval punk::char { #TODO set codes [scan $string [tcl::string::repeat %c [tcl::string::length $string]]] set width 0 - foreach c $codes { + foreach dec $codes { #unicode Tags block zero width - if {$c < 917504 || $c > 917631} { - if {$c <= 255} { + if {$dec < 917504 || $dec > 917631} { + if {$dec <= 255} { #review - non-printing ascii? why does textutil::wcswidth report 1 ?? #todo - compare with python or other lang wcwidth - if {!($c < 31 || $c == 127)} { + if {!($dec < 31 || $dec == 127)} { incr width } } else { #TODO - various other joiners and non-printing chars - set w [textutil::wcswidth_char $c] + set w [textutil::wcswidth_char $dec] ;#takes decimal codepoint if {$w < 0} { return -1 } else { @@ -2169,7 +2169,7 @@ tcl::namespace::eval punk::char { } proc wcswidth2 {string} { set codes [scan $string [tcl::string::repeat %c [tcl::string::length $string]]] - set widths [lmap c $codes {textutil::wcswidth_char $c}] + set widths [lmap dec $codes {textutil::wcswidth_char $dec}] if {-1 in $widths} { return -1 } diff --git a/src/bootsupport/modules/punk/console-0.1.1.tm b/src/bootsupport/modules/punk/console-0.1.1.tm index 74365afa..2e10e75b 100644 --- a/src/bootsupport/modules/punk/console-0.1.1.tm +++ b/src/bootsupport/modules/punk/console-0.1.1.tm @@ -102,7 +102,8 @@ namespace eval punk::console { } variable ansi_response_chunk ;#array keyed on callid variable ansi_response_wait ;#array keyed on callid - variable ansi_response_queue ;#list of callids + array set ansi_response_wait {} + variable ansi_response_queue [list];#list of callids variable ansi_response_queuedata ;#dict keyed on callid - with function params # -- @@ -123,10 +124,6 @@ namespace eval punk::console { #ansi escape sequences are possibly preferable esp if terminal is remote to process running punk::console # punk::local commands may be more performant in some circumstances where console is directly attached, but it shouldn't be assumed. e.g ansi::titleset outperforms local::titleset on windows with twapi. - namespace eval ansi { - #ansi escape sequence based terminal/console control functions - namespace export * - } namespace eval local { #non-ansi terminal/console control functions #e.g external utils system API's. @@ -578,12 +575,73 @@ namespace eval punk::console { } - #capturingendregex should capture ANY prefix, whole escape match - and a subcapture of the data we're interested in and match at end of string. - #ie {(.*)(ESC(info)end)$} - #e.g {(.*)(\x1bP44!~([:alnum:])\x1b\\)$} - #we expect 4 results from regexp -indices -inline (overallmatch, prefix, wholeescape,info) + lappend PUNKARGS [list { + @id -id ::punk::console::internal::get_ansi_response_payload + @cmd -name punk::console::internal::get_ansi_response_payload -help\ + "Terminal query helper. + Captures the significant portion (payload as defined by + supplied capturingendregex capture groups) of the input + channel's response to a query placed on the output channel. + Usually this means a write to stdout with a response on + stdin. + This function uses a 'chan event' read handler function + ::punk::console::internal::ansi_response_handler_regex to + read the input channel character by character to ensure it + doesn't overconsume input. + + It can run cooperatively with the punk::repl stdin reader + or other readers if done carefully. + The mechanism to run while other readers are active involves + disabling and re-enabling installed 'chan event' handlers + and possibly using a shared namespace variable + (::punk::console::input_chunks_waiting) to ensure all data + gets to the right handler. (unread data on input prior to this + function being called) + Not fully documented. (source diving required -see punk::repl) + " + @opts + -ignoreok -type boolean -default 0 -help\ + "Experimental/debug + ignore the regex match 'ok' response + and keep going." + -return -type string -default payload -choices {payload dict} -choicelabels { + dict\ + "dict with keys prefix,response,payload,all" + } -help\ + "Return format" + + -terminal -default {stdin stdout} -type list -help\ + "terminal (currently list of in/out channels) (todo - object?)" + -expected_ms -default 100 -type integer -help\ + "Expected number of ms for response from terminal. + 100ms is usually plenty for a local terminal and a + basic query such as cursor position." + @values -min 2 -max 2 + query -type string -help\ + "ANSI sequence such as \x1b\[?6n which + should elicit a response by the terminal + on stdin" + capturingendregex -type string -help\ + "capturingendregex should capture ANY prefix, whole escape match - and a subcapture + of the data we're interested in; and match at end of string. + ie {(.*)(ESC(info)end)$} + e.g {(.*)(\x1bP44!~([:alnum:])\x1b\\)$} + we expect 4 results from regexp -indices -inline (overallmatch, prefix, wholeescape,info)" + }] #todo - check capturingendregex value supplied has appropriate captures and tail-anchor - proc get_ansi_response_payload {query capturingendregex {inoutchannels {stdin stdout}}} { + proc get_ansi_response_payload {args} { + #we pay a few 10s of microseconds to use punk::args::parse (on the happy path) + #seems reasonable for the flexibility in this case. + set argd [punk::args::parse $args withid ::punk::console::internal::get_ansi_response_payload] + lassign [dict values $argd] leaders opts values received + + set inoutchannels [dict get $opts -terminal] + set expected [dict get $opts -expected_ms] + set ignoreok [dict get $opts -ignoreok] + set returntype [dict get $opts -return] + set query [dict get $values query] + set capturingendregex [dict get $values capturingendregex] + lassign $inoutchannels input output #chunks from input that need to be handled by readers @@ -595,10 +653,12 @@ namespace eval punk::console { #In other contexts there may not even be another input reader #REVIEW - what if there is existing data in input_chunks_waiting - is it for us? - #temp - let's keep alert to it until we decide if it's legit/required.. - if {[info exists input_chunks_waiting($input)] && [llength $input_chunks_waiting($input)]} { - #puts stderr "[punk::ansi::a+ cyan bold]get_ansi_response_payload called while input_chunks_waiting($input) contained data: $input_chunks_waiting($input)[punk::ansi::a]" - } + #This occurs for example with key held down on autorepeat and is normal + #enable it here for debug/testing only + #if {[info exists input_chunks_waiting($input)] && [llength $input_chunks_waiting($input)]} { + # puts stderr "[punk::ansi::a+ cyan bold]get_ansi_response_payload called while input_chunks_waiting($input) contained data: [punk::ansi::a][ansistring VIEW $input_chunks_waiting($input)]" + #} + if {!$::punk::console::ansi_available} { return "" } @@ -615,17 +675,33 @@ namespace eval punk::console { upvar ::punk::console::ansi_response_wait waitvar upvar ::punk::console::ansi_response_queue queue upvar ::punk::console::ansi_response_queuedata queuedata - upvar ::punk::console::ansi_response_clock clock + upvar ::punk::console::ansi_response_tslaunch tslaunch + upvar ::punk::console::ansi_response_tsclock tsclock upvar ::punk::console::ansi_response_timeoutid timeoutid - set accumulator($callid) "" - set waitvar($callid) "" - lappend queue $callid + set accumulator($callid) "" + set waitvar($callid) "" + + lappend queue $callid + if {[llength $queue] > 1} { + #while {[lindex $queue 0] ne $callid} {} + set queuedata($callid) $args + set runningid [lindex $queue 0] + while {$runningid ne $callid} { + vwait ::punk::console::ansi_response_wait + set runningid [lindex $queue 0] + if {$runningid ne $callid} { + set ::punk::console::ansi_response_wait($runningid) $::punk::console::ansi_response_wait($runningid) + update ;#REVIEW - probably a bad idea + after 10 + } + } + } #todo - use a linked array and an accumulatorid and waitvar id? When can there be more than one terminal query in-flight? - set existing_handler [fileevent $input readable] ;#review! + set existing_handler [chan event $input readable] ;#review! set this_handler ::punk::console::internal::ansi_response_handler_regex if {[lindex $existing_handler 0] eq $this_handler} { puts stderr "[punk::ansi::a+ red]Warning for callid $callid get_ansi_response_payload called while existing ansi response handler in place[a]: $this_handler" @@ -633,109 +709,145 @@ namespace eval punk::console { flush stderr if {[lindex $queue 0] ne $callid} { + error "get_ansi_response_payload - re-entrancy unrecoverable" } - error "get_ansi_response_payload - re-entrancy unrecoverable" } + chan event $input readable {} - fileevent $input readable {} - - set input_state [fconfigure $input] - #todo - make timeout configurable? - set waitvarname "::punk::console::ansi_response_wait($callid)" - #500ms is generally plenty for a terminal to respond.. but not in some cases. e.g event loop busy with stdin keypress?? review - set timeoutid($callid) [after 1000 [list set $waitvarname timedout]] - - #JMN # - stderr vs stdout #It has to be same channel as used by functions such as test_char_width or erroneous results returned for those functions #(presumably race conditions as to when data hits console?) #review - experiment changing this and calling functions to stderr and see if it works #review - Are there disadvantages to using stdout vs stderr? - #puts stdout "sending console request [ansistring VIEW $query]" - puts -nonewline $output $query;flush $output + + set previous_input_state [chan configure $input] + #chan configure $input -blocking 0 + + #todo - make timeout configurable? + set waitvarname "::punk::console::ansi_response_wait($callid)" + #todo - test and save rawstate so we don't disableRaw if console was already raw if {![tsv::get console is_raw]} { set was_raw 0 punk::console::enableRaw + #after 0 [list chan event $input readable [list $this_handler $input $callid $capturingendregex]] + incr expected 50 ;#review + set timeoutid($callid) [after $expected [list set $waitvarname timedout]] + #puts stdout "sending console request [ansistring VIEW $query]" } else { set was_raw 1 + set timeoutid($callid) [after $expected [list set $waitvarname timedout]] } - fconfigure $input -blocking 0 - # - #in handler - its used for a boolean match (capturing aspect not used) - set clock($callid) [clock millis] ;#time of launch - may be delay before first event depending on what's going on + chan configure $input -blocking 0 - #first shot without using filevent, call the stdin reader directly - maybe it's there already - #This can be significantly faster than setting up a fileevent (2024 e.g 1.5ms vs 65ms) + set tslaunch($callid) [clock millis] ;#time of launch - may be delay before first event depending on what's going on + set tsclock($callid) $tslaunch($callid) + #write before console enableRaw vs after?? + #There seem to be problems (e.g on WSL) if we write too early - the output ends up on screen but we don't read it + puts -nonewline $output $query;flush $output $this_handler $input $callid $capturingendregex - if {$waitvar($callid) ne "ok"} { - fileevent $input readable [list $this_handler $input $callid $capturingendregex] + + if {$ignoreok || $waitvar($callid) ne "ok"} { + chan event $input readable [list $this_handler $input $callid $capturingendregex] } - #JMN #response from terminal #e.g for cursor position \033\[46;1R - - if {[set waitvar($callid)] eq ""} { - vwait ::punk::console::ansi_response_wait($callid) + #after 0 [list $this_handler $input $callid $capturingendregex] + set remaining $expected + if {$waitvar($callid) eq ""} { + set lastvwait [clock millis] + vwait ::punk::console::ansi_response_wait($callid) #puts stderr ">>>> end vwait1 $waitvar($callid)<<<<" - while {[string match extend-* $waitvar($callid)]} { - set extension [lindex [split $waitvar($callid) -] 1] - #puts stderr "get_ansi_response_payload Extending timeout by $extension" - #after cancel $timeoutid($callid) - set timeoutid($callid) [after $extension [list set $waitvarname timedout]] - vwait ::punk::console::ansi_response_wait($callid) + while {[string match extend-* $waitvar($callid)] || ($ignoreok && $waitvar($callid) eq "ok")} { + if {[string match extend-* $waitvar($callid)]} { + set extension [lindex [split $waitvar($callid) -] 1] + if {$extension eq ""} { + puts "blank extension $waitvar($callid)" + puts "->[set $waitvar($callid]<-" + } + puts stderr "get_ansi_response_payload Extending timeout by $extension" + after cancel $timeoutid($callid) + set total_elapsed [expr {[clock millis] - $tslaunch($callid)}] + set last_elapsed [expr {[clock millis] - $lastvwait}] + set remaining [expr {$remaining - $last_elapsed}] + if {$remaining < 0} {set remaining 0} + set newtime [expr {$remaining + $extension}] + set timeoutid($callid) [after $newtime [list set $waitvarname timedout]] + set lastvwait [clock millis] + vwait ::punk::console::ansi_response_wait($callid) + } else { + #ignoreok - reapply the handler that disabled itself due to 'ok' + chan event $input readable [list $this_handler $input $callid $capturingendregex] + set lastvwait [clock millis] + vwait ::punk::console::ansi_response_wait($callid) + } } } - #response handler automatically removes it's own fileevent - fileevent $input readable {} ;#explicit remove anyway - review + #response handler automatically removes it's own chan event + chan event $input readable {} ;#explicit remove anyway - review if {$waitvar($callid) ne "timedout"} { after cancel $timeoutid($callid) } else { - puts stderr "timeout in get_ansi_response_payload. callid $callid Ansi request was:[ansistring VIEW -lf 1 -vt 1 $query]" + puts stderr "timeout (timediff [expr {[clock millis] - $tslaunch($callid)}]ms) in get_ansi_response_payload. callid $callid Ansi request was:[ansistring VIEW -lf 1 -vt 1 $query]" } if {$was_raw == 0} { punk::console::disableRaw } + #restore $input state - fconfigure $input -blocking [dict get $input_state -blocking] + #it *might* be ok to restore entire state on an input channel + #(it's not always on all channels - e.g stdout has -winsize which is read-only) + #Safest to only restore what we think we've modified. + fconfigure $input -blocking [dict get $previous_input_state -blocking] - set response [set accumulator($callid)] + set input_read [set accumulator($callid)] - if {$response ne ""} { - set got_match [regexp -indices $capturingendregex $response _match_indices prefix_indices response_indices payload_indices] + if {$input_read ne ""} { + set got_match [regexp -indices $capturingendregex $input_read _match_indices prefix_indices response_indices payload_indices] if {$got_match} { - set responsedata [string range $response {*}$response_indices] - set payload [string range $response {*}$payload_indices] - set prefixdata [string range $response {*}$prefix_indices] - if {$prefixdata ne ""} { - #puts stderr "Warning - get_ansi_response_payload read extra data at start - '[ansistring VIEW -lf 1 $prefixdata]' (response=[ansistring VIEW -lf 1 $responsedata])" + set responsedata [string range $input_read {*}$response_indices] + set payload [string range $input_read {*}$payload_indices] + set prefixdata [string range $input_read {*}$prefix_indices] + if {!$ignoreok && $prefixdata ne ""} { + #puts stderr "Warning - get_ansi_response_payload read extra data at start - '[ansistring VIEW -lf 1 $prefixdata]' (responsedata=[ansistring VIEW -lf 1 $responsedata])" lappend input_chunks_waiting($input) $prefixdata } } else { #timedout - or eof? - puts stderr "get_ansi_response_payload callid:$callid regex match '$capturingendregex' to data '[ansistring VIEW -lf 1 -vt 1 $response]' not found" - lappend input_chunks_waiting($input) $response - set payload "" + if {!$ignoreok} { + puts stderr "get_ansi_response_payload callid:$callid regex match '$capturingendregex' to input_read '[ansistring VIEW -lf 1 -vt 1 $input_read]' not found" + lappend input_chunks_waiting($input) $input_read + set payload "" + } else { + set responsedata "" + set payload "" + set prefixdata "" + } } } else { #timedout or eof? and nothing read - set payload "" + set responsedata "" + set prefixdata "" + set payload "" } + # ------------------------------------------------------------------------------------- + # Other input readers + # ------------------------------------------------------------------------------------- #is there a way to know if existing_handler is input_chunks_waiting aware? if {[string length $existing_handler] && [lindex $existing_handler 0] ne $this_handler} { #puts "get_ansi_response_payload reinstalling ------>$existing_handler<------" - fileevent $input readable $existing_handler - #we may have consumed all pending input on $input - so there may be no trigger for the readable fileevent + chan event $input readable $existing_handler + #this_handler may have consumed all pending input on $input - so there may be no trigger for the readable chan event for existing_handler if {[llength $input_chunks_waiting($input)]} { #This is experimental If a handler is aware of input_chunks_waiting - there should be no need to schedule a trigger #If it isn't, but the handler can accept an existing chunk of data as a 'waiting' argument - we could trigger and pass it the waiting chunks - but there's no way to know its API. @@ -772,33 +884,49 @@ namespace eval punk::console { #The input_chunks_waiting may really belong to the existing_handler we found - but if it doesn't consume them they will end up being read by the repl_handler when it eventually re-enables. #todo - some better structure than just a list of waiting chunks indexed by input channel, so repl/other handlers can determine the context in which these waiting chunks were generated? } elseif {[package provide punk::repl::codethread] ne "" && [punk::repl::codethread::is_running]} { - if {[llength $input_chunks_waiting($input)]} { + #if {[llength $input_chunks_waiting($input)]} { #don't trigger the repl handler manually - we will inevitably get things out of order - as it knows when to enable/disable itself based on whether chunks are waiting. #triggering it by putting it on the eventloop will potentially result in re-entrancy #The cooperating reader must be designed to consume waiting chunks and only reschedule it's channel read handler once all waiting chunks have been consumed. #puts stderr "[punk::ansi::a+ green bold]--> repl_handler has chunks to consume [ansistring VIEW $input_chunks_waiting($input)][punk::ansi::a]" - } + #} if {[eof $input]} { #test - puts stdout "restarting repl" + puts stdout "get_ansi_response_payload experimental - restarting repl" repl::reopen stdin } } + # ------------------------------------------------------------------------------------- - catch { - unset accumulator($callid) - unset waitvar($callid) - dict unset queuedata $callid - } - if {[llength $queue] > 1} { - set next_callid [lindex $queue 1] + + + unset -nocomplain accumulator($callid) + unset -nocomplain waitvar($callid) + unset -nocomplain timeoutid($callid) + unset -nocomplain tsclock($callid) + unset -nocomplain tslaunch($callid) + dict unset queuedata $callid + + lpop queue 0 + if {[llength $queue] > 0} { + set next_callid [lindex $queue 0] set waitvar($callid) go_ahead + #set nextdata [set queuedata($next_callid)] } - lpop queue 0 + #set punk::console::chunk "" - return $payload + if {$returntype eq "dict"} { + return [dict create\ + prefix $prefixdata\ + payload $payload\ + response $responsedata\ + all $input_read\ + ] + } else { + return $payload + } } @@ -811,43 +939,66 @@ namespace eval punk::console { proc ansi_response_handler_regex {chan callid endregex} { upvar ::punk::console::ansi_response_chunk chunks upvar ::punk::console::ansi_response_wait waits - upvar ::punk::console::ansi_response_clock clock ;#initial time in millis was set when fileevent was created + upvar ::punk::console::ansi_response_tslaunch tslaunch ;#initial time in millis was set when chan event was created + upvar ::punk::console::ansi_response_tsclock tsclock #endregex should explicitly have a trailing $ set status [catch {read $chan 1} bytes] if { $status != 0 } { # Error on the channel - fileevent $chan readable {} + chan event $chan readable {} puts "ansi_response_handler_regex error reading $chan: $bytes" - set waits($callid) [list error_read status $status bytes $bytes] + set waits($callid) [list error error_read status $status bytes $bytes] } elseif {$bytes ne ""} { + #puts stderr . ;flush stderr # Successfully read the channel #puts "got: [string length $bytes]bytes" - append chunks($callid) $bytes + set sofar [append chunks($callid) $bytes] #puts stderr [ansistring VIEW $chunks($callid)] - if {[regexp $endregex $chunks($callid)]} { - fileevent $chan readable {} + #review - what is min length of any ansiresponse? + #endregex is capturing - but as we are only testing the match here + #it should perform the same as if it were non-capturing + if {[string length $sofar] > 3 && [regexp $endregex $sofar]} { #puts stderr "matched - setting ansi_response_wait($callid) ok" + chan event $chan readable {} set waits($callid) ok } else { - if {[string length $chunks($callid)] % 10 == 0 || $clock($callid) - [clock millis] > 50} { - after cancel $::punk::console::ansi_response_timeoutid($callid) - set waits($callid) extend-1000 + # 30ms 16ms? + set tsnow [clock millis] + set total_elapsed [expr {[set tslaunch($callid)] - $tsnow}] + set last_elapsed [expr {[set tsclock($callid)] - $tsnow}] + if {[string length $chunks($callid)] % 10 == 0 || $last_elapsed > 16} { + if {$total_elapsed > 3000} { + #REVIEW + #too long since initial read handler launched.. + #is other data being pumped into stdin? Eventloop starvation? Did we miss our codes? + #For now we'll stop extending the timeout. + after cancel $::punk::console::ansi_response_timeoutid($callid) + set waits($callid) [list error error_ansi_response_handler_regex_too_long_reading] + } else { + if {$last_elapsed > 0} { + after cancel $::punk::console::ansi_response_timeoutid($callid) + set waits($callid) extend-[expr {min(16,$last_elapsed)}] + } + } } + set tsclock(callid) [clock millis] } } elseif {[catch {eof $chan}] || [eof $chan]} { - catch {fileevent $chan readable {}} + catch {chan event $chan readable {}} # End of file on the channel #review puts stderr "ansi_response_handler_regex end of file on channel $chan" set waits($callid) eof - } elseif {![catch {fblocked $chan}] && [fblocked $chan]} { - # Read blocked. Just return + } elseif {![catch {chan blocked $chan}] && [chan blocked $chan]} { + # Read blocked is normal. (chan -blocking = 0 but reading only 1 char) # Caller should be using timeout on the wait variable + #set waits($callid) continue + set tsclock($callid) [clock millis] } else { - fileevent $chan readable {} + chan event $chan readable {} # Something else - puts stderr "ansi_response_handler_regex Situation shouldn't be possible. No error and no bytes read on channel $chan but chan is not fblocked or EOF" + puts stderr "ansi_response_handler_regex Situation shouldn't be possible. No error and no bytes read on channel $chan but not chan blocked or EOF" set waits($callid) error_unknown_zerobytes_while_not_blocked_or_eof } } @@ -865,17 +1016,9 @@ namespace eval punk::console { #a and a+ functions are not very useful when emitting directly to console #e.g puts [punk::console::a red]test[punk::console::a cyan] would produce a cyan coloured test as the commands are evaluated first - proc a? {args} { - #stdout - variable ansi_wanted - if {$ansi_wanted <= 0} { - puts -nonewline [punk::ansi::ansistripraw [::punk::ansi::a?]] - } else { - tailcall ansi::a? {*}$args - } - } - punk::args::set_alias ::punk::console::code_a+ ::punk::ansi::a+ + #punk::args::set_alias ::punk::console::code_a+ ::punk::ansi::a+ + lappend PUNKARGS_aliases {::punk::console::code_a+ ::punk::ansi::a+} proc code_a+ {args} { variable ansi_wanted if {$ansi_wanted <= 0} { @@ -885,6 +1028,7 @@ namespace eval punk::console { #tailcall punk::ansi::a+ {*}$args ::punk::ansi::a+ {*}$args } + lappend PUNKARGS_aliases {::punk::console::code_a ::punk::ansi::a} proc code_a {args} { variable ansi_wanted if {$ansi_wanted <= 0} { @@ -893,6 +1037,7 @@ namespace eval punk::console { #tailcall punk::ansi::a {*}$args ::punk::ansi::a {*}$args } + lappend PUNKARGS_aliases {::punk::console::code_a? ::punk::ansi::a?} proc code_a? {args} { variable ansi_wanted if {$ansi_wanted <= 0} { @@ -901,6 +1046,15 @@ namespace eval punk::console { tailcall ::punk::ansi::a? {*}$args } } + #proc a? {args} { + # #stdout + # variable ansi_wanted + # if {$ansi_wanted <= 0} { + # puts -nonewline [punk::ansi::ansistripraw [::punk::ansi::a?]] + # } else { + # tailcall ansi::a? {*}$args + # } + #} #REVIEW! this needs reworking. #It needs to be clarified as to what ansi off is supposed to do. @@ -968,38 +1122,36 @@ namespace eval punk::console { return [expr {!$colour_disabled}] } - - namespace eval ansi { - proc a {args} { - puts -nonewline [::punk::ansi::a {*}$args] - } - proc a? {args} { - puts -nonewline stdout [::punk::ansi::a? {*}$args] - } - proc a+ {args} { - puts -nonewline [::punk::ansi::a+ {*}$args] - } - proc clear {} { - puts -nonewline stdout [punk::ansi::clear] - } - proc clear_above {} { - puts -nonewline stdout [punk::ansi::clear_above] + #test - find a better place to set terminal type + variable is_vt52 0 + proc vt52 {{onoff {}}} { + #todo - return to colour state beforehand?. support 0-15 vt52 colours? + #we shouldn't have to trun off colour to enter vt52 - we should make punk::console emit correct codes + variable is_vt52 + if {$onoff eq ""} { + return $is_vt52 } - proc clear_below {} { - puts -nonewline stdout [punk::ansi::clear_below] + if {![string is boolean -strict $onoff]} { + error "vt52 setting must be a boolean - or empty to query" } - proc clear_all {} { - puts -nonewline stdout [punk::ansi::clear_all] - } - proc reset {} { - puts -nonewline stdout [punk::ansi::reset] + if {$is_vt52} { + if {!$onoff} { + puts -nonewline "\x1b<" + set is_vt52 0 + colour on + } + } else { + if {$onoff} { + unset_mode DECANM + set is_vt52 1 + colour off + } else { + puts -nonewline "\x1b<" + #emit even though our is_vt52 flag thinks it's on. Should be harmless if underlying terminal already vt100+ + } } + return $is_vt52 } - namespace import ansi::clear - namespace import ansi::clear_above - namespace import ansi::clear_below - namespace import ansi::clear_all - namespace import ansi::reset namespace eval local { proc set_codepage_output {cpname} { @@ -1018,22 +1170,117 @@ namespace eval punk::console { error "set_codepage_input unimplemented on $::tcl_platform(platform)" } } + lappend PUNKARGS [list { + @id -id ::punk::console::local::echo + @cmd -name punk::console::local::echo -help\ + "Use stty on unix, or twapi on windows to set terminal + local input echo on/off - experimental" + @values -min 0 -max 1 + onoff -type boolean -default "" -help\ + "Omit or pass empty string to query current echo state." + }] + proc echo {args} { + set argd [punk::args::parse $args withid ::punk::console::local::echo] + set onoff [dict get $argd values onoff] + + set is_windows [string equal "windows" $::tcl_platform(platform)] + if {$onoff eq ""} { + #query + if {$is_windows} { + package require twapi + set inputstate [twapi::get_console_input_mode] + return [dict get $inputstate -echoinput] + } else { + #counterintuitively - the human format (-a) seems more consistent across platforms than the machine readable (-g) formats + #for now, quick and dirty look for echo in the list seems to work on wsl & freebsd at least. + set tstate [exec stty -a] + if {[lsearch $tstate echo] > 0} { + return 1 + } else { + return 0 + } + } + } else { + if {![string is boolean -strict $onoff]} { + error "::punk::console::local::echo requires boolean argument to set on or off" + } + if {$is_windows} { + set onoff [expr {true && $onoff}] ;#ensure true,yes etc are converted to 1|0 + set conh [twapi::get_console_handle stdin] + twapi::modify_console_input_mode $conh -echoinput $onoff + + return $onoff + } else { + if {$onoff} { + {*}[auto_execok stty] echo + return 1 + } else { + {*}[auto_execok stty] -echo + return 0 + } + } + } + } } namespace import local::set_codepage_output namespace import local::set_codepage_input + + lappend PUNKARGS [list { + @id -id ::punk::console::show_input_response + @cmd -name punk::console::show_input_response -help\ + "" + @opts + -terminal -default {stdin stdout} -type list -help\ + "terminal (currently list of in/out channels) (todo - object?)" + -expected_ms -type integer -default 500 -help\ + "Number of ms to wait for response" + @values -min 1 -max 1 + request -type string -help\ + "ANSI sequence such as \x1b\[?6n which + should elicit a response by the terminal + on stdin" + }] + proc show_input_response {args} { + set argd [punk::args::parse $args withid ::punk::console::show_input_response] + lassign [dict values $argd] leaders opts values received + set request [dict get $values request] + set inoutchannels [dict get $opts -terminal] + set expected [dict get $opts -expected_ms] + + set capturingregex {(((.*)))$} ;#capture entire response same as response-payload + set ts_start [clock millis] + set response [punk::console::internal::get_ansi_response_payload -ignoreok 1 -return dict -expected_ms $expected -terminal $inoutchannels $request $capturingregex] + set ts_end [clock millis] + puts stderr $response + set out "" + dict for {k v} $response { + append out "$k [ansistring VIEW $v]" \n + } + append out "totalms [expr {$ts_end - $ts_start}]" + return $out + } + # -- --- --- --- --- --- --- #get_ansi_response functions #review - can these functions sensibly be used on channels not attached to the local console? #ie can we default to {stdin stdout} but allow other channel pairs? # -- --- --- --- --- --- --- proc get_cursor_pos {{inoutchannels {stdin stdout}}} { + if {$::punk::console::is_vt52} { + error "vt52 can't perform get_cursor_pos" + } #response from terminal #e.g \033\[46;1R set capturingregex {(.*)(\x1b\[([0-9]+;[0-9]+)R)$} ;#must capture prefix,entire-response,response-payload set request "\033\[6n" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] + #some terminals fail to respond properly to \x1b\[6n but do respond to \x1b\[?6n and vice-versa :/ + #todo - what? + #often terminals that fail will just put the raw request code on stdin - we could detect that and then + #try the other? + return $payload } proc get_checksum_rect {id page t l b r {inoutchannels {stdin stdout}}} { @@ -1041,13 +1288,13 @@ namespace eval punk::console { #re e.g {(.*)(\x1b\[P44!~([[:alnum:]])\x1b\[\\)$} set capturingregex [string map [list %id% $id] {(.*)(\x1bP%id%!~([[:alnum:]]+)\x1b\\)$}] set request "\x1b\[${id}\;${page}\;$t\;$l\;$b\;$r*y" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } proc get_device_status {{inoutchannels {stdin stdout}}} { set capturingregex {(.*)(\x1b\[([0-9]+)n)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[5n" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } @@ -1083,7 +1330,7 @@ namespace eval punk::console { #set capturingregex {(.*)(\x1b\[\?6[0-9][;]*([;0-9]+)c)$} ;#must capture prefix,entire-response,response-payload set capturingregex {(.*)(\x1b\[\?([0-9]*[;0-9]+)c)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[c" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] set last_da1_result $payload return $payload } @@ -1093,14 +1340,14 @@ namespace eval punk::console { set capturingregex {(.*)(\x1b\[\>([0-9]*[;][0-9]*[;][0-1]c))$} ;#must capture prefix,entire-response,response-payload #expect CSI > X;10|20;0|1c - docs suggest X should be something like 61. In practice we see 0 or 1 (windows) REVIEW set request "\x1b\[>c" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } proc get_device_attributes_tertiary {{inoutchannels {stdin stdout}}} { #DA3 set capturingregex {(.*)(\x1bP!\|([0-9]{8})\x1b\\)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[=c" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } proc get_terminal_id {{inoutchannels {stdin stdout}}} { @@ -1115,7 +1362,7 @@ namespace eval punk::console { #set capturingregex {(.*)(\x1bP2$u((?:[0-9]+)*(?:\/[0-9]+)*)\x1b\\)$} set capturingregex {(.*)(\x1bP2\$u(.*)\x1b\\)$} set request "\x1b\[2\$w" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] set tabstops [split $payload "/"] return $tabstops } @@ -1263,18 +1510,29 @@ namespace eval punk::console { } #keep out of catch - no point in even trying a restore move if we can't get start position - just fail here. + #no vt52 equiv? may as well strip all vt52 from here? lassign [get_cursor_pos_list $inoutchannels] start_row start_col - + variable is_vt52 + if {!$is_vt52} { + set movefunc "punk::ansi::move" + set func_coff "punk::ansi::cursor_off" + set func_con "punk::ansi::cursor_on" + } else { + set movefunc "punk::ansi::vt52move" + set func_coff "punk::ansi::cursor_off_vt52" + set func_con "punk::ansi::cursor_on_vt52" + } if {[catch { #some terminals (conemu on windows) scroll the viewport when we make a big move down like this - a move to 1 1 immediately after cursor_save doesn't seem to fix that. #This issue also occurs when switching back from the alternate screen buffer - so perhaps that needs to be addressed elsewhere. - puts -nonewline $out [punk::ansi::cursor_off][punk::ansi::move 2000 2000] + + puts -nonewline $out [$func_coff][$movefunc 2000 2000] lassign [get_cursor_pos_list $inoutchannels] lines cols - puts -nonewline $out [punk::ansi::move $start_row $start_col][punk::console::cursor_on];flush stdout + puts -nonewline $out [$movefunc $start_row $start_col][$func_con];flush stdout set result [list columns $cols rows $lines] } errM]} { - puts -nonewline $out [punk::ansi::move $start_row $start_col] - puts -nonewline $out [punk::ansi::cursor_on] + puts -nonewline $out [$movefunc $start_row $start_col] + puts -nonewline $out [$func_con] error "$errM" } else { return $result @@ -1316,21 +1574,24 @@ namespace eval punk::console { proc get_xterm_size {{inoutchannels {stdin stdout}}} { set capturingregex {(.*)(\x1b\[8;([0-9]+;[0-9]+)t)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[18t" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] lassign [split $payload {;}] rows cols return [list columns $cols rows $rows] } proc get_xterm_pixels {{inoutchannels {stdin stdout}}} { set capturingregex {(.*)(\x1b\[4;([0-9]+;[0-9]+)t)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[14t" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] lassign [split $payload {;}] height width return [list width $width height $height] } + + + proc get_mode_line_wrap {{inoutchannels {stdin stdout}}} { set capturingregex {(.*)(\x1b\[\?7;([0-9]+)\$y)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[?7\$p" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } #Terminals generally default to LNM being reset (off) ie enter key sends a lone @@ -1339,7 +1600,7 @@ namespace eval punk::console { proc get_mode_LNM {{inoutchannels {stdin stdout}}} { set capturingregex {(.*)(\x1b\[\?20;([0-9]+)\$y)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[?20\$p" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } #DECRPM responses e.g: @@ -1359,7 +1620,7 @@ namespace eval punk::console { } set capturingregex [string map [list %MODE% $m] {(.*)(\x1b\[\?%MODE%;([0-9]+)\$y)$}] ;#must capture prefix,entire-response,response-payload set request "\x1b\[?$m\$p" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } proc set_mode {num_or_name {inoutchannels {stdin stdout}}} { @@ -1373,7 +1634,7 @@ namespace eval punk::console { error "punk::console::set_mode unrecognised mode '$num_or_name'. Known mode names: [dict keys $decmode_names]" } } - return "\x1b\[?${m}h" + puts -nonewline "\x1b\[?${m}h" } proc unset_mode {num_or_name {inoutchannels {stdin stdout}}} { if {[string is integer -strict $num_or_name]} { @@ -1386,7 +1647,7 @@ namespace eval punk::console { error "punk::console::unset_mode unrecognised mode '$num_or_name'. Known mode names: [dict keys $decmode_names]" } } - return "\x1b\[?${m}l" + puts -nonewline "\x1b\[?${m}l" } @@ -1584,16 +1845,6 @@ namespace eval punk::console { return [dict create available $is_available mode $m] } - namespace eval ansi { - proc cursor_on {} { - puts -nonewline stdout [punk::ansi::cursor_on] - } - proc cursor_off {} { - puts -nonewline stdout [punk::ansi::cursor_off] - } - } - namespace import ansi::cursor_on - namespace import ansi::cursor_off #review - the concept of using local mechanisms at all (ie apis) vs ansi is not necessarily something we want/need to support. #For the system to be really useful if needs to operate in conditions where the terminal is remote @@ -1625,24 +1876,6 @@ namespace eval punk::console { } } - namespace eval ansi { - proc titleset {windowtitle} { - puts -nonewline stdout [punk::ansi::titleset $windowtitle] - } - } - #namespace import ansi::titleset - proc titleset {windowtitle} { - variable ansi_wanted - if { $ansi_wanted <= 0} { - punk::console::local::titleset $windowtitle - } else { - ansi::titleset $windowtitle - } - } - #no known pure-ansi solution - proc titleget {} { - return [local::titleget] - } proc infocmp {} { set cmd1 [auto_execok infocmp] @@ -1685,16 +1918,113 @@ namespace eval punk::console { return [split $data ";"] } + #channel? namespace eval ansi { + variable PUNKARGS + #ansi escape sequence based terminal/console control functions + namespace export * + + #proc a {args} { + # puts -nonewline [::punk::ansi::a {*}$args] + #} + #proc a+ {args} { + # puts -nonewline [::punk::ansi::a+ {*}$args] + #} + #proc a? {args} { + # puts -nonewline stdout [::punk::ansi::a? {*}$args] + #} + proc clear {} { + puts -nonewline stdout [punk::ansi::clear] + } + proc clear_above {} { + puts -nonewline stdout [punk::ansi::clear_above] + } + proc clear_below {} { + puts -nonewline stdout [punk::ansi::clear_below] + } + proc clear_all {} { + puts -nonewline stdout [punk::ansi::clear_all] + } + proc reset {} { + puts -nonewline stdout [punk::ansi::reset] + } + proc cursor_on {} { + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::cursor_on] + } else { + puts -nonewline stdout [punk::ansi::cursor_on_vt52] + } + } + proc cursor_off {} { + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::cursor_off] + } else { + puts -nonewline stdout [punk::ansi::cursor_off_vt52] + } + } + + lappend PUNKARGS [list { + @id -id ::punk::console::ansi::move + @cmd -name punk::console::move -help\ + {Return an ANSI or vt52 sequence to move cursor to row,col + (aka: cursor home) + + The sequence emitted will depend on the mode of the + terminal as stored in the consolehandle. + Directly setting the mode via raw escape sequences: + e.g unset_mode DECANM for vt52 + or puts \x1b< to return to ANSI + will not necessarily update the application of + the change in terminal state. Major state changes + such as this should be done via provided functions + that keep the REPL state in sync with the underlying + terminal state. + + For ANSI the sequence is of the form: + ESC[;H + (CSI row ; col H) + This sequence will generally not be understood by + terminals that are in vt52 mode. + + For VT52 the sequence is of the form: + ESCY + This sequence will generally not be understood by + terminals that are not in vt52 mode even if higher + modes are supported. + + } + @values -min 2 -max 2 + row -type integer -help\ + "row number - starting at 1" + col -type integer -help\ + "column number - starting at 1" + }] proc move {row col} { - puts -nonewline stdout [punk::ansi::move $row $col] + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + return [punk::ansi::move $row $col] + } else { + return [punk::ansi::vt52move $row $col] + } } proc move_forward {n} { - puts -nonewline stdout [punk::ansi::move_forward $n] + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::move_forward $n] + } else { + puts -nonewline stdout [punk::ansi::vt52move_forward $n] + } } proc move_back {n} { - puts -nonewline stdout [punk::ansi::move_back $n] + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::move_back $n] + } else { + puts -nonewline stdout [punk::ansi::vt52move_back $n] + } } proc move_up {n} { puts -nonewline stdout [punk::ansi::move_up $n] @@ -1703,21 +2033,101 @@ namespace eval punk::console { puts -nonewline stdout [punk::ansi::move_down $n] } proc move_column {col} { - puts -nonewline stdout [punk::ansi::move_column $col] + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::move_column $col] + } else { + puts -nonewline stdout [punk::ansi::vt52move_column $col] + } } proc move_row {row} { puts -nonewline stdout [punk::ansi::move_row $row] } proc move_emit {row col data args} { - puts -nonewline stdout [punk::ansi::move_emit $row $col $data {*}$args] + upvar ::punk::console::is_v52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::move_emit $row $col $data {*}$args] + } else { + puts -nonewline stdout [punk::ansi::v52move_emit $row $col $data {*}$args] + } } proc move_emit_return {row col data args} { + #todo detect if in raw mode or not? + set is_in_raw 0 lassign [punk::console::get_cursor_pos_list] orig_row orig_col - set out "" - append out [punk::ansi::move_emit $row $col $data {*}$args] + + set commands "" + append commands [punk::ansi::move_emit $row $col $data {*}$args] + foreach {row col data} $args { + append commands [punk::ansi::move_emit $row $col $data {*}$args] + } if {!$is_in_raw} { incr orig_row -1 } + append commands [punk::ansi::move $orig_row $orig_col] + puts -nonewline stdout $commands + return "" + } + proc move_emitblock_return {row col textblock} { + lassign [punk::console::get_cursor_pos_list] orig_row orig_col + + set commands "" + foreach ln [split $textblock \n] { + append commands [punk::ansi::move_emit $row $col $ln] + incr row + } + append commands [punk::ansi::move $orig_row $orig_col] + puts -nonewline $commands + return + } + #we can be (slightly?) faster and more efficient if we use the consoles cursor_save_dec command - but each savecursor overrides any previous one. + #leave cursor_off/cursor_on to caller who can wrap more efficiently.. + proc cursorsave_move_emit_return {row col data args} { + upvar ::punk::console::is_vt52 is_vt52 + #JMN + set commands "" + if {!$is_vt52} { + append commands [punk::ansi::cursor_save_dec] + append commands [punk::ansi::move_emit $row $col $data] + foreach {row col data} $args { + append commands [punk::ansi::move_emit $row $col $data] + } + append commands [punk::ansi::cursor_restore_dec] + } else { + append commands [punk::ansi::cursor_save_vt52] + append commands [punk::ansi::vt52move_emit $row $col $data] + foreach {row col data} $args { + append commands [punk::ansi::vt52move_emit $row $col $data] + } + append commands [punk::ansi::cursor_restore_vt52] + } + puts -nonewline stdout $commands; flush stdout + } + proc cursorsave_move_emitblock_return {row col textblock} { + set commands "" + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + append commands [punk::ansi::cursor_save_dec] + foreach ln [split $textblock \n] { + append commands [punk::ansi::move_emit $row $col $ln] + incr row + } + append commands [punk::ansi::cursor_restore_dec] + } else { + append commands [punk::ansi::cursor_save_vt52] + foreach ln [split $textblock \n] { + append commands [punk::ansi::vt52move_emit $row $col $ln] + incr row + } + append commands [punk::ansi::cursor_restore_vt52] + } + puts -nonewline stdout $commands;flush stdout + return + } + proc move_call_return {row col script} { + lassign [punk::console::get_cursor_pos_list] orig_row orig_col + move $row $col + uplevel 1 $script move $orig_row $orig_col } proc scroll_up {n} { @@ -1772,28 +2182,49 @@ namespace eval punk::console { proc delete_lines {count} { puts -nonewline \x1b\[${count}M } + proc titleset {windowtitle} { + puts -nonewline stdout [punk::ansi::titleset $windowtitle] + } + proc test_decaln {} { + puts -nonewline stdout [punk::ansi::test_decaln] + } + } + namespace import ::punk::console::ansi::* + catch {rename titleset ""} + #namespace import ansi::titleset + proc titleset {windowtitle} { + variable ansi_wanted + if { $ansi_wanted <= 0} { + punk::console::local::titleset $windowtitle + } else { + ansi::titleset $windowtitle + } + } + #no known pure-ansi solution + proc titleget {} { + return [local::titleget] + } + + foreach ansicmd [list ::punk::console::ansi::move] { + set ctail [namespace tail $ansicmd] + set arglist [info args $ansicmd] + set argcall "" + if {[llength $arglist]} { + foreach a [lrange $arglist 0 end-1] { + append argcall "\$$a " + } + if {[lindex $arglist end] eq "args"} { + append argcall {{*}$args} + } else { + append argcall "\$[lindex $arglist end]" + } + } + catch {rename $ctail ""} + proc $ctail $arglist [string map [list %ansicmd% $ansicmd %argcall% $argcall] { + puts -nonewline [%ansicmd% %argcall%] + }] } - namespace import ansi::move - namespace import ansi::move_emit - namespace import ansi::move_forward - namespace import ansi::move_back - namespace import ansi::move_up - namespace import ansi::move_down - namespace import ansi::move_column - namespace import ansi::move_row - namespace import ansi::cursor_save - namespace import ansi::cursor_restore - namespace import ansi::cursor_save_dec - namespace import ansi::cursor_restore_dec - namespace import ansi::scroll_up - namespace import ansi::scroll_down - namespace import ansi::enable_alt_screen - namespace import ansi::disable_alt_screen - namespace import ansi::insert_spaces - namespace import ansi::delete_characters - namespace import ansi::erase_characters - namespace import ansi::insert_lines - namespace import ansi::delete_lines + #experimental @@ -1812,90 +2243,25 @@ namespace eval punk::console { puts -nonewline [punk::ansi::erase_eol][punk::ansi::move_column $col]$text cursor_restore } - proc move_emit_return {row col data args} { - #todo detect if in raw mode or not? - set is_in_raw 0 - lassign [punk::console::get_cursor_pos_list] orig_row orig_col - set commands "" - append commands [punk::ansi::move_emit $row $col $data] - foreach {row col data} $args { - append commands [punk::ansi::move_emit $row $col $data] - } - if {!$is_in_raw} { - incr orig_row -1 - } - append commands [punk::ansi::move $orig_row $orig_col] - puts -nonewline stdout $commands - return "" - } - #we can be (slightly?) faster and more efficient if we use the consoles cursor_save_dec command - but each savecursor overrides any previous one. - #leave cursor_off/cursor_on to caller who can wrap more efficiently.. - proc cursorsave_move_emit_return {row col data args} { - set commands "" - append commands [punk::ansi::cursor_save_dec] - append commands [punk::ansi::move_emit $row $col $data] - foreach {row col data} $args { - append commands [punk::ansi::move_emit $row $col $data] - } - append commands [punk::ansi::cursor_restore_dec] - puts -nonewline stdout $commands; flush stdout - } - proc move_emitblock_return {row col textblock} { + #this doesn't work - we would need an internal virtual screen structure to pick up cursor attributes from arbitrary locations? + # ncurses and its ilk may have something like that - but we specifically want to avoid curses libraries + proc pick {row col} { lassign [punk::console::get_cursor_pos_list] orig_row orig_col - - set commands "" - foreach ln [split $textblock \n] { - append commands [punk::ansi::move_emit $row $col $ln] - incr row - } - append commands [punk::ansi::move $orig_row $orig_col] - puts -nonewline $commands - return - } - proc cursorsave_move_emitblock_return {row col textblock} { - set commands "" - append commands [punk::ansi::cursor_save_dec] - foreach ln [split $textblock \n] { - append commands [punk::ansi::move_emit $row $col $ln] - incr row - } - append commands [punk::ansi::cursor_restore_dec] - puts -nonewline stdout $commands;flush stdout - return - } - proc move_call_return {row col script} { + set test "" + #set test [a green Yellow] + move_emit $row $col $test\0337 + puts -nonewline \0338\033\[${orig_row}\;${orig_col}H + } + proc pick_emit {row col data} { + set test "" + #set test [a green Purple] lassign [punk::console::get_cursor_pos_list] orig_row orig_col - move $row $col - uplevel 1 $script - move $orig_row $orig_col + move_emit $row $col $test\0337 + puts -nonewline \0338\033\[${orig_row}\;${orig_col}H$data } - #this doesn't work - we would need an internal virtual screen structure to pick up cursor attributes from arbitrary locations? - # ncurses and its ilk may have something like that - but we specifically want to avoid curses libraries - proc pick {row col} { - lassign [punk::console::get_cursor_pos_list] orig_row orig_col - set test "" - #set test [a green Yellow] - move_emit $row $col $test\0337 - puts -nonewline \0338\033\[${orig_row}\;${orig_col}H - } - proc pick_emit {row col data} { - set test "" - #set test [a green Purple] - lassign [punk::console::get_cursor_pos_list] orig_row orig_col - move_emit $row $col $test\0337 - puts -nonewline \0338\033\[${orig_row}\;${orig_col}H$data - } - # -- --- --- --- --- --- - namespace eval ansi { - proc test_decaln {} { - puts -nonewline stdout [punk::ansi::test_decaln] - } - } - namespace import ansi::test_decaln - namespace eval clock { #map chars of chars "0" to "?"" ie 0x30 to x3f @@ -2152,7 +2518,7 @@ namespace eval punk::console { puts stderr "punk::console WARNING: no modern unicode support in this Tcl version. High unicode values not properly supported. (string length \\U00010000 : $high_unicode_length should be 1)" } else { set can_high_unicode 1 - set can_regex_high_unicode [string match [regexp -all -inline {[\U80-\U0010FFFF]} \U0001F525] \U0001F525] + set can_regex_high_unicode [string equal [regexp -all -inline {[\U80-\U0010FFFF]} \U0001F525] \U0001F525] if {!$can_regex_high_unicode} { puts stderr "punk::console warning: TCL version cannot perform braced regex of high unicode" } @@ -2235,6 +2601,10 @@ namespace eval punk::console::check { +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::console ::punk::console::internal ::punk::console::local ::punk::console::ansi +} diff --git a/src/bootsupport/modules/punk/lib-0.1.1.tm b/src/bootsupport/modules/punk/lib-0.1.1.tm index 1381af87..09a73385 100644 --- a/src/bootsupport/modules/punk/lib-0.1.1.tm +++ b/src/bootsupport/modules/punk/lib-0.1.1.tm @@ -246,6 +246,58 @@ tcl::namespace::eval punk::lib::compat { #outside of lmap - don't know of any particularly nice ways to flatten to subindex 1 of each element.. #flattening then lsearch with -stride and * would be nice - but it's not avail in 8.6 + if {![info exists ::auto_index(readFile)]} { + if {[info commands ::readFile] eq ""} { + proc ::readFile {filename {mode text}} { + #readFile not seen in auto_index or as command: installed by punk::lib + # Parse the arguments + set MODES {binary text} + set ERR [list -level 1 -errorcode [list TCL LOOKUP MODE $mode]] + set mode [tcl::prefix match -message "mode" -error $ERR $MODES $mode] + + # Read the file + set f [open $filename [dict get {text r binary rb} $mode]] + try { + return [read $f] + } finally { + close $f + } + } + } + } + if {![info exists ::auto_index(writeFile)]} { + if {[info commands ::writeFile] eq ""} { + proc ::writeFile {args} { + #writeFile not seen in auto_index or as command: installed by punk::lib + # Parse the arguments + switch [llength $args] { + 2 { + lassign $args filename data + set mode text + } + 3 { + lassign $args filename mode data + set MODES {binary text} + set ERR [list -level 1 -errorcode [list TCL LOOKUP MODE $mode]] + set mode [tcl::prefix match -message "mode" -error $ERR $MODES $mode] + } + default { + set COMMAND [lindex [info level 0] 0] + return -code error -errorcode {TCL WRONGARGS} "wrong # args: should be \"$COMMAND filename ?mode? data\"" + } + } + + # Write the File + set f [open $filename [dict get {text w binary wb} $mode]] + try { + puts -nonewline $f $data + } finally { + close $f + } + } + } + } + if {"::lpop" ne [info commands ::lpop]} { #puts stderr "Warning - no built-in lpop" interp alias {} lpop {} ::punk::lib::compat::lpop @@ -1021,35 +1073,35 @@ namespace eval punk::lib { -separator -default "%sep%" -roottype -default "dict" -substructure -default {} - -channel -default stdout -help "existing channel - or 'none' to return as string" + -channel -default stdout -help\ + "existing channel - or 'none' to return as string" @values -min 1 -max -1 dictvar -type string -help "name of variable. Can be a dict, list or array" patterns -type string -default "*" -multiple 1 -help {Multiple patterns can be specified as separate arguments. - Each pattern consists of 1 or more segments separated by the hierarchy separator (forward slash) - The system uses similar patterns to the punk pipeline pattern-matching system. - The default assumed type is dict - but an array will automatically be extracted into key value pairs so will also work. - Segments are classified into list,dict and string operations. - Leading % indicates a string operation - e.g %# gives string length - A segment with a single @ is a list operation e.g @0 gives first list element, @1-3 gives the lrange from 1 to 3 - A segment containing 2 @ symbols is a dict operation. e.g @@k1 retrieves the value for dict key 'k1' - The operation type indicator is not always necessary if lower segments in the hierarchy are of the same type as the previous one. - e.g1 pdict env */%# - the pattern starts with default type dict, so * retrieves all keys & values, - the next hierarchy switches to a string operation to get the length of each value. - e.g2 pdict env W* S* - Here we supply 2 patterns, each in default dict mode - to display keys and values where the keys match the glob patterns - e.g3 pdict punk_testd */* - This displays 2 levels of the dict hierarchy. - Note that if the sublevel can't actually be interpreted as a dictionary (odd number of elements or not a list at all) - - then the normal = separator will be replaced with a coloured (or underlined if colour off) 'mismatch' indicator. - e.g4 set list {{k1 v1 k2 v2} {k1 vv1 k2 vv2}}; pdict list @0-end/@@k2 @*/@@k1 - Here we supply 2 separate pattern hierarchies, where @0-end and @* are list operations and are equivalent - The second level segement in each pattern switches to a dict operation to retrieve the value by key. - When a list operation such as @* is used - integer list indexes are displayed on the left side of the = for that hierarchy level. - + Each pattern consists of 1 or more segments separated by the hierarchy separator (forward slash) + The system uses similar patterns to the punk pipeline pattern-matching system. + The default assumed type is dict - but an array will automatically be extracted into key value pairs so will also work. + Segments are classified into list,dict and string operations. + Leading % indicates a string operation - e.g %# gives string length + A segment with a single @ is a list operation e.g @0 gives first list element, @1-3 gives the lrange from 1 to 3 + A segment containing 2 @ symbols is a dict operation. e.g @@k1 retrieves the value for dict key 'k1' + The operation type indicator is not always necessary if lower segments in the hierarchy are of the same type as the previous one. + e.g1 pdict env */%# + the pattern starts with default type dict, so * retrieves all keys & values, + the next hierarchy switches to a string operation to get the length of each value. + e.g2 pdict env W* S* + Here we supply 2 patterns, each in default dict mode - to display keys and values where the keys match the glob patterns + e.g3 pdict punk_testd */* + This displays 2 levels of the dict hierarchy. + Note that if the sublevel can't actually be interpreted as a dictionary (odd number of elements or not a list at all) + - then the normal = separator will be replaced with a coloured (or underlined if colour off) 'mismatch' indicator. + e.g4 set list {{k1 v1 k2 v2} {k1 vv1 k2 vv2}}; pdict list @0-end/@@k2 @*/@@k1 + Here we supply 2 separate pattern hierarchies, where @0-end and @* are list operations and are equivalent + The second level segement in each pattern switches to a dict operation to retrieve the value by key. + When a list operation such as @* is used - integer list indexes are displayed on the left side of the = for that hierarchy level. } }] #puts stderr "$argspec" @@ -1091,7 +1143,8 @@ namespace eval punk::lib { set sep " [punk::ansi::a+ Green]=$RST " ;#stick to basic default colours for wider terminal support set sep_mismatch " [punk::ansi::a+ Brightred undercurly underline undt-white]mismatch$RST " } - package require punk ;#we need pipeline pattern matching features + package require punk::pipe + #package require punk ;#we need pipeline pattern matching features package require textblock set argd [punk::args::get_dict [string map [list %sep% $sep %sep_mismatch% $sep_mismatch] { @@ -1102,23 +1155,29 @@ namespace eval punk::lib { -channel -default none -trimright -default 1 -type boolean -help\ "Trim whitespace off rhs of each line. - This can help prevent a single long line that wraps in terminal from making - every line wrap due to long rhs padding. - " - -separator -default {%sep%} -help "Separator column between keys and values" - -separator_mismatch -default {%sep_mismatch%} -help "Separator to use when patterns mismatch" - -roottype -default "dict" -help "list,dict,string" - -ansibase_keys -default "" -help "ansi list for each level in -substructure. e.g \[list \[a+ red\] \[a+ web-green\]\]" + This can help prevent a single long line that wraps in terminal from making + every line wrap due to long rhs padding." + -separator -default {%sep%} -help\ + "Separator column between keys and values" + -separator_mismatch -default {%sep_mismatch%} -help\ + "Separator to use when patterns mismatch" + -roottype -default "dict" -help\ + "list,dict,string" + -ansibase_keys -default "" -help\ + "ansi list for each level in -substructure. e.g \[list \[a+ red\] \[a+ web-green\]\]" -substructure -default {} -ansibase_values -default "" - -keytemplates -default {\$\{$key\}} -type list -help "list of templates for keys at each level" + -keytemplates -default {\$\{$key\}} -type list -help\ + "list of templates for keys at each level" -keysorttype -default "none" -choices {none dictionary ascii integer real} -keysortdirection -default increasing -choices {increasing decreasing} -debug -default 0 -type boolean -help\ "When enabled, produces some rudimentary debug output on stderr" @values -min 1 -max -1 - dictvalue -type list -help "dict or list value" - patterns -default "*" -type string -multiple 1 -help "key or key glob pattern" + dictvalue -type list -help\ + "dict or list value" + patterns -default "*" -type string -multiple 1 -help\ + "key or key glob pattern" }] $args] #for punk::lib - we want to reduce pkg dependencies. @@ -1201,7 +1260,7 @@ namespace eval punk::lib { set segments [split $pattern_nest /] set levelpatterns [lindex $segments 0] ;#possibly comma separated patterns #we need to use _split_patterns to separate (e.g to protect commas that appear within quotes) - set patterninfo [punk::_split_patterns $levelpatterns] + set patterninfo [punk::pipe::lib::_split_patterns $levelpatterns] #puts stderr "showdict-->_split_patterns: $patterninfo" foreach v_idx $patterninfo { lassign $v_idx v idx @@ -1479,7 +1538,7 @@ namespace eval punk::lib { # -- --- --- --- set substructure "" set pnext [lindex $segments 1] - set patterninfo [punk::_split_patterns $levelpatterns] + set patterninfo [punk::pipe::lib::_split_patterns $levelpatterns] if {[llength $patterninfo] == 0} { # // ? -review - what does this mean? for xpath this would mean at any level set substructure [lindex $pattern_this_structure end] @@ -2043,18 +2102,32 @@ namespace eval punk::lib { concat {*}[uplevel 1 lmap {*}$args] } - proc dict_getdef {dictValue args} { - if {[llength $args] < 1} { - error {wrong # args: should be "dict_getdef dictValue ?key ...? key default"} - } - set keys [lrange $args -1 end-1] - if {[tcl::dict::exists $dictValue {*}$keys]} { - return [tcl::dict::get $dictValue {*}$keys] - } else { - return [lindex $args end] + #proc dict_getdef {dictValue args} { + # if {[llength $args] < 1} { + # error {wrong # args: should be "dict_getdef dictValue ?key ...? key default"} + # } + # set keys [lrange $args -1 end-1] + # if {[tcl::dict::exists $dictValue {*}$keys]} { + # return [tcl::dict::get $dictValue {*}$keys] + # } else { + # return [lindex $args end] + # } + #} + if {[info commands ::tcl::dict::getdef] eq ""} { + proc dict_getdef {dictValue args} { + set keys [lrange $args 0 end-1] + if {[tcl::dict::exists $dictValue {*}$keys]} { + return [tcl::dict::get $dictValue {*}$keys] + } else { + return [lindex $args end] + } } + } else { + #we pay a minor perf penalty for the wrap + interp alias "" ::punk::lib::dict_getdef "" ::tcl::dict::getdef } + #proc sample1 {p1 n args} { # #*** !doctools # #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] @@ -2722,6 +2795,7 @@ namespace eval punk::lib { } return [join $result \n] } + #dedent? proc undent {text} { if {$text eq ""} { return "" @@ -3795,7 +3869,7 @@ namespace eval punk::lib { } } - + #*** !doctools #[list_end] [comment {--- end definitions namespace punk::lib ---}] @@ -4142,12 +4216,10 @@ tcl::namespace::eval punk::lib::debug { proc showdict {args} {} } -if {![info exists ::punk::args::register::NAMESPACES]} { - namespace eval ::punk::args::register { - set ::punk::args::register::NAMESPACES [list] ;#use fully qualified so 8.6 doesn't find existing var in global namespace - } +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::lib } -lappend ::punk::args::register::NAMESPACES ::punk::lib # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::lib [tcl::namespace::eval punk::lib { diff --git a/src/bootsupport/modules/punk/mix/cli-0.3.1.tm b/src/bootsupport/modules/punk/mix/cli-0.3.1.tm index 9e463eff..5d38fad8 100644 --- a/src/bootsupport/modules/punk/mix/cli-0.3.1.tm +++ b/src/bootsupport/modules/punk/mix/cli-0.3.1.tm @@ -177,7 +177,8 @@ namespace eval punk::mix::cli { } } } - cd $sourcefolder + #cd $sourcefolder + #use run so that stdout visible as it goes if {![catch {run --timeout=55000 -debug [info nameofexecutable] $sourcefolder/make.tcl {*}$args} exitinfo]} { #todo - notify if exit because of timeout! @@ -185,11 +186,11 @@ namespace eval punk::mix::cli { set exitcode [dict get $exitinfo exitcode] } else { puts stderr "Error unable to determine exitcode. err: $exitinfo" - cd $startdir + #cd $startdir return false } - cd $startdir + #cd $startdir if {$exitcode != 0} { puts stderr "FAILED with exitcode $exitcode" return false @@ -364,10 +365,10 @@ namespace eval punk::mix::cli { #ignore trailing .tm .TM if present #if version doesn't pass validation - treat it as part of the modulename and return empty version string without error #Up to caller to validate. - proc split_modulename_version {modulename} { - set lastpart [namespace tail $modulename] + proc split_modulename_version {fullmodulename} { + set lastpart [namespace tail $fullmodulename] set lastpart [file tail $lastpart] ;# should be ok to use file tail now that we've ensured no namespace components - if {[string equal -nocase [file extension $modulename] ".tm"]} { + if {[string equal -nocase [file extension $fullmodulename] ".tm"]} { set fileparts [split [file rootname $lastpart] -] } else { set fileparts [split $lastpart -] @@ -380,7 +381,13 @@ namespace eval punk::mix::cli { set namesegment [join $fileparts -] set versionsegment "" } - return [list $namesegment $versionsegment] + set base [namespace qualifiers $fullmodulename] + if {$base ne ""} { + set modulename "${base}::$namesegment" + } else { + set modulename $namesegment + } + return [list $modulename $versionsegment] } proc get_status {{workingdir ""} args} { diff --git a/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm b/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm index 47c75d33..05e94a25 100644 --- a/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm +++ b/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm @@ -31,16 +31,42 @@ namespace eval punk::mix::commandset::layout { namespace export * + namespace eval argdoc { + proc layout_names {} { + if {[catch {punk::mix::commandset::layout::lib::layouts_dict *} ldict]} { + #REVIEW + return "punk.project" + } else { + return [dict keys $ldict] + } + } + } #per layout functions - proc files {{layout ""}} { - set argd [punk::args::get_dict { - @id -id ::punk::mix::commandset::layout::files - @values -min 1 -max 1 - layout -type string -minsize 1 - } [list $layout]] + punk::args::define { + @dynamic + @id -id ::punk::mix::commandset::layout::files + -datetime -default "%Y-%m-%dT%H:%M:%S" -help\ + "Datetime format for mtime. Use empty string for no datetime output" + @values -min 1 -max 1 + layout -type string -choices {${[punk::mix::commandset::layout::argdoc::layout_names]}} + } + proc files {args} { + set argd [punk::args::get_by_id ::punk::mix::commandset::layout::files $args] + set layout [dict get $argd values layout] + set dtformat [dict get $argd opts -datetime] set allfiles [lib::layout_all_files $layout] - return [join $allfiles \n] + if {$dtformat eq ""} { + return [join $allfiles \n] + } else { + set out "" + foreach f $allfiles { + set mtime [dict get [file stat $f] mtime] + append out "$f [clock format $mtime -format $dtformat]" \n + } + set out [string range $out 0 end-1] + return $out + } } proc templatefiles {layout} { set templatefiles_and_tags [lib::layout_scan_for_template_files $layout] @@ -166,7 +192,7 @@ namespace eval punk::mix::commandset::layout { } proc as_dict {args} { - tailcall punk::mix::commandset::layout::lib::layouts_dict {*}$args + punk::mix::commandset::layout::lib::layouts_dict {*}$args } proc references_as_dict {args} { package require punk::cap diff --git a/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm b/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm index b5539021..b964d228 100644 --- a/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm +++ b/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm @@ -1,5 +1,5 @@ # -*- tcl -*- -# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from -buildversion.txt +# Maintenance Instruction: leave the 999999.xxx.x as is and use 'deck make' or src/make.tcl to update from -buildversion.txt # # Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. # Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. @@ -304,11 +304,12 @@ namespace eval punk::mix::commandset::loadedlib { } set versions [package versions [lindex $libfound 0]] - if {$has_natsort} { - set versions [natsort::sort $versions] - } else { - set versions [lsort $versions] - } + set versions [lsort -command {package vcompare} $versions] + #if {$has_natsort} { + # set versions [natsort::sort $versions] + #} else { + # set versions [lsort $versions] + #} if {![llength $versions]} { error "No version numbers found for library/module $libfound - sorry, you will need to copy it across manually" } diff --git a/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm b/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm index 41206d0c..ae21d348 100644 --- a/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm +++ b/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm @@ -120,17 +120,20 @@ namespace eval punk::mix::commandset::module { return $table } - #return all module templates with repeated ones suffixed with .2 .3 etc + + #return all module templates with repeated ones suffixed with #2 #3 etc + punk::args::define { + @id -id ::punk::mix::commandset::module::templates_dict + @cmd -name templates_dict -help\ + "Templates from module and project paths" + -startdir -default "" -help\ + "Project folder used in addition to module paths" + -not -default "" -multiple 1 + @values + globsearches -default * -multiple 1 + } proc templates_dict {args} { - set argspec { - @id -id ::punk::mix::commandset::module::templates_dict - @cmd -name templates_dict -help "Templates from module and project paths" - -startdir -default "" -help "Project folder used in addition to module paths" - -not -default "" -multiple 1 - @values - globsearches -default * -multiple 1 - } - set argd [punk::args::get_dict $argspec $args] + set argd [punk::args::get_by_id ::punk::mix::commandset::module::templates_dict $args] package require punk::cap if {[punk::cap::capability_has_handler punk.templates]} { set template_folder_dict [punk::cap::call_handler punk.templates get_itemdict_moduletemplates {*}$args] @@ -154,10 +157,11 @@ namespace eval punk::mix::commandset::module { the higher version number will be used. " -license -default + -author -default -multiple 1 -template -default punk.module -type -default "[lindex $moduletypes 0]" -choices {$moduletypes} -force -default 0 -type boolean -help\ - "If set true, will overwrite an existing .tm file if there is one. + "If set true, will OVERWRITE an existing .tm file if there is one. If false (default) an error will be raised if there is a conflict." -quiet -default 0 -type boolean -help\ "Suppress information messages on stdout" @@ -262,6 +266,7 @@ namespace eval punk::mix::commandset::module { } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_license [dict get $opts -license] + set opt_authors [dict get $opts -author] ;#-multiple true # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_template [dict get $opts -template] if {[regexp {.*[?*].*} $opt_template]} { @@ -403,7 +408,7 @@ namespace eval punk::mix::commandset::module { #for now the user has the option to override any templates and remove %moduletemplate% if it is a security/privacy concern #Don't put literal %x% in the code for the commandset::module itself - to stop them being seen by layout scanner as replacable tokens - set tagnames [list moduletemplate $moduletemplate project $projectname pkg $modulename year $year license $opt_license version $infile_version] + set tagnames [list moduletemplate $moduletemplate project $projectname pkg $modulename year $year license $opt_license authors $opt_authors version $infile_version] set strmap [list] foreach {tag val} $tagnames { lappend strmap %$tag% $val diff --git a/src/bootsupport/modules/punk/mix/commandset/project-0.1.0.tm b/src/bootsupport/modules/punk/mix/commandset/project-0.1.0.tm index 27ec8503..2ff8ac06 100644 --- a/src/bootsupport/modules/punk/mix/commandset/project-0.1.0.tm +++ b/src/bootsupport/modules/punk/mix/commandset/project-0.1.0.tm @@ -109,7 +109,26 @@ namespace eval punk::mix::commandset::project { } - + namespace eval argdoc { + set layout_dict [punk::cap::call_handler punk.templates get_itemdict_projectlayouts] + variable LAYOUTNAMES [dict keys $layout_dict] + } + punk::args::define { + @id -id ::punk::mix::commandset::project::new + @cmd -name "punk::mix::commandset::project::new" -help\ + "" + @leaders -min 1 -max 1 + project -type string -help\ + "Project name or path. + If just a name is given ... (todo)" + @opts + -type -default plain + -empty -default 0 -type boolean + -force -default 0 -type boolean + -update -default 0 -type boolean + -confirm -default 1 -type boolean + -layout -default "punk.project" -choices {${$::punk::mix::commandset::project::argdoc::LAYOUTNAMES}} + } proc new {newprojectpath_or_name args} { #*** !doctools @@ -300,7 +319,17 @@ namespace eval punk::mix::commandset::project { } } } elseif {$project_dir_exists && $opt_update} { - puts stderr "mix new WARNING: -update 1 was supplied. Will copy layout $layout_path using -update option to add missing items" + set warnmsg "mix new WARNING: -update 1 was supplied. Will copy layout $layout_path using -update option to add missing items" + if {$opt_confirm} { + puts stderr $warnmsg + set msg "Do you want to proceed to possibly overwrite some existing files in $projectdir? Y|N" + set answer [util::askuser $msg] + if {[string tolower $answer] ne "y"} { + puts stderr "mix new aborting due to user response '$answer' (required Y|y to proceed) use -confirm 0 to avoid prompt." + return + } + } + puts stderr $warnmsg } set fossil_repo_file "" @@ -366,28 +395,40 @@ namespace eval punk::mix::commandset::project { #default antiglob_dir_core will stop .fossil* from being updated - which is generally desirable as these are likely to be customized if {$opt_force} { puts stdout "copying layout files - with force applied - overwrite all-targets" - set resultdict [punkcheck::install $layout_path $projectdir -installer project.new -overwrite ALL-TARGETS -antiglob_paths $antipaths -antiglob_dir $antiglob_dir] + set resultdict [punkcheck::install $layout_path $projectdir -installer project.new -createempty 1 -overwrite ALL-TARGETS -antiglob_paths $antipaths -antiglob_dir $antiglob_dir] } else { puts stdout "copying layout files - (if source file changed)" - set resultdict [punkcheck::install $layout_path $projectdir -installer project.new -overwrite installedsourcechanged-targets -antiglob_paths $antipaths -antiglob_dir $antiglob_dir] + set resultdict [punkcheck::install $layout_path $projectdir -installer project.new -createempty 1 -overwrite installedsourcechanged-targets -antiglob_paths $antipaths -antiglob_dir $antiglob_dir] } puts stdout [punkcheck::summarize_install_resultdict $resultdict] - puts stdout "copying layout src/doc files (if target missing)" - set resultdict [punkcheck::install $layout_path/src/doc $projectdir/src/doc -punkcheck_folder $projectdir -installer project.new -overwrite SYNCED-TARGETS] - puts stdout [punkcheck::summarize_install_resultdict $resultdict] + if {[file exists $layout_path/src/doc]} { + puts stdout "copying layout src/doc files (if target missing)" + set resultdict [punkcheck::install $layout_path/src/doc $projectdir/src/doc -createdir 1 -punkcheck_folder $projectdir -installer project.new -overwrite SYNCED-TARGETS] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + } else { + puts stdout "no src/doc in source template - update not required" + } #target folders .fossil-custom and .fossil-settings may not exist. use -createdir 1 to ensure existence. #In this case we need to override the default dir antiglob - as .fossil-xxx folders need to be installed from template if missing, or if target is uncustomized. ## default_antiglob_dir_core [list "#*" "_aside" ".git" ".fossil*"] set override_antiglob_dir_core [list #* _aside .git] - puts stdout "copying layout src/.fossil-custom files (if target missing or uncustomised)" - set resultdict [punkcheck::install $layout_path/.fossil-custom $projectdir/.fossil-custom -createdir 1 -punkcheck_folder $projectdir -installer project.new -antiglob_dir_core $override_antiglob_dir_core -overwrite SYNCED-TARGETS] - puts stdout [punkcheck::summarize_install_resultdict $resultdict] + if {[file exists $layout_path/.fossil-custom]} { + puts stdout "copying layout src/.fossil-custom files (if target missing or uncustomised)" + set resultdict [punkcheck::install $layout_path/.fossil-custom $projectdir/.fossil-custom -createdir 1 -createempty 1 -punkcheck_folder $projectdir -installer project.new -antiglob_dir_core $override_antiglob_dir_core -overwrite SYNCED-TARGETS] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + } else { + puts stdout "no .fossil-custom in source template - update not required" + } - puts stdout "copying layout src/.fossil-settings files (if target missing or uncustomised)" - set resultdict [punkcheck::install $layout_path/.fossil-settings $projectdir/.fossil-settings -createdir 1 -punkcheck_folder $projectdir -installer project.new -antiglob_dir_core $override_antiglob_dir_core -overwrite SYNCED-TARGETS] - puts stdout [punkcheck::summarize_install_resultdict $resultdict] + if {[file exists $layout_path/.fossil-settings]} { + puts stdout "copying layout src/.fossil-settings files (if target missing or uncustomised)" + set resultdict [punkcheck::install $layout_path/.fossil-settings $projectdir/.fossil-settings -createdir 1 -createempty 1 -punkcheck_folder $projectdir -installer project.new -antiglob_dir_core $override_antiglob_dir_core -overwrite SYNCED-TARGETS] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + } else { + puts stdout "no .fossil-settings in source template - update not required" + } #scan all files in template # @@ -395,30 +436,19 @@ namespace eval punk::mix::commandset::project { set templatefiles [punk::mix::commandset::layout::lib::layout_scan_for_template_files $opt_layout] set stripprefix [file normalize $layout_path] - #set tagmap [list [lib::template_tag project] $projectname] - #todo - get from somewhere - set alltag_substitutions [list project $projectname] - + set tagmap [list [lib::template_tag project] $projectname] if {[llength $templatefiles]} { puts stdout "Filling template file placeholders with the following tag map:" - foreach {placeholder value} $alltag_substitutions { + foreach {placeholder value} $tagmap { puts stdout " $placeholder -> $value" } } - foreach templatefullpath_and_tags $templatefiles { - lassign $templatefullpath_and_tags templatefullpath tags_present - + foreach templatefullpath $templatefiles { set templatetail [punk::repo::path_strip_alreadynormalized_prefixdepth $templatefullpath $stripprefix] set fpath [file join $projectdir $templatetail] if {[file exists $fpath]} { set fd [open $fpath r]; fconfigure $fd -translation binary; set data [read $fd]; close $fd - set tagmap [list] - dict for {t v} $alltag_substitutions { - if {$t in $tags_present} { - lappend tagmap [lib::template_tag $t] $v - } - } set data2 [string map $tagmap $data] if {$data2 ne $data} { puts stdout "updated template file: $fpath" diff --git a/src/bootsupport/modules/punk/nav/fs-0.1.0.tm b/src/bootsupport/modules/punk/nav/fs-0.1.0.tm index 5d601b3a..140f2678 100644 --- a/src/bootsupport/modules/punk/nav/fs-0.1.0.tm +++ b/src/bootsupport/modules/punk/nav/fs-0.1.0.tm @@ -281,7 +281,8 @@ tcl::namespace::eval punk::nav::fs { } } - if {[file pathtype $a1] ne "relative"} { + if {![regexp {[*?]} $a1] && [file pathtype $a1] ne "relative"} { + #non-relative non-glob if { ![string match //zipfs:/* $a1]} { if {[file type $a1] eq "directory"} { cd $a1 diff --git a/src/bootsupport/modules/punk/ns-0.1.0.tm b/src/bootsupport/modules/punk/ns-0.1.0.tm index 8fa9ce89..4eb6526d 100644 --- a/src/bootsupport/modules/punk/ns-0.1.0.tm +++ b/src/bootsupport/modules/punk/ns-0.1.0.tm @@ -26,9 +26,16 @@ tcl::namespace::eval ::punk::ns::evaluator { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::ns { - variable ns_current "::" + variable ns_current + #allow presetting + if {![info exists ::punk::ns::ns_current]} { + set ns_current :: + } + variable ns_re_cache [dict create] ;#cache regular expressions used in globmatchns namespace export nsjoin nsprefix nstail nsparts nseval nschildren nsimport_noclobber corp + namespace path {::punk::lib ::punk::ansi} ;#list_as_lines etc + catch { package require debug debug define punk.ns.compile @@ -1259,7 +1266,7 @@ tcl::namespace::eval punk::ns { } else { set report_namespaces $matched_namespaces } - punk::args::update_definitions + punk::args::update_definitions $report_namespaces set nsdict_list [list] foreach ch $report_namespaces { @@ -1371,9 +1378,9 @@ tcl::namespace::eval punk::ns { #use aliases glob - because aliases can be present with or without leading :: #NOTE: alias may not have matching command in the relevant namespce (renamed alias) so we can't just start with commands and check if it's an alias if we want to show all aliases if {$weird_ns} { - set raw_aliases [nseval_ifexists $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. + set raw_aliases [nseval_ifexists $location [list ::punk::lib::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. } else { - set raw_aliases [tcl::namespace::eval $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. + set raw_aliases [tcl::namespace::eval $location [list ::punk::lib::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. } #set raw_aliases [nseval $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. set aliases [list] @@ -1620,6 +1627,7 @@ tcl::namespace::eval punk::ns { if {$has_punkargs} { #set id [string trimleft $fq :] set id $fq + punk::args::update_definitions [list [namespace qualifiers $id]] if {[::punk::args::id_exists $id]} { lappend usageinfo $c } else { @@ -1969,7 +1977,8 @@ tcl::namespace::eval punk::ns { #todo - -cache or -refresh to configure whether we introspect ensembles/objects each time? # - as this is interactive generally introspection should be ok at the top level # but if we need to go down multiple levels of subcommands generating/testing prefixes - could be an issue ?? - punk::args::define -dynamic 0 { + punk::args::define { + @dynamic @id -id ::punk::ns::arginfo @cmd -name punk::ns::arginfo -help\ "Show usage info for a command. @@ -1995,20 +2004,20 @@ tcl::namespace::eval punk::ns { -return -type string -default table -choices {string table tableobject} - } {${[punk::args::resolved_def -type @opts ::punk::args::arg_error -scheme]}} { + } {${[punk::args::resolved_def -types opts ::punk::args::arg_error -scheme]}} { -- -type none -help\ "End of options marker - Use this if the command to view begins with a -" + Use this if the command to view begins with a -" @values -min 1 commandpath -help\ "command (may be alias, ensemble, tcl::oo object, tepam proc etc)" subcommand -optional 1 -multiple 1 -default {} -help\ "subcommand if commandpath is an ensemble. - Multiple subcommands can be supplied if ensembles are further nested" + Multiple subcommands can be supplied if ensembles are further nested" } proc arginfo {args} { - lassign [dict values [punk::args::get_by_id ::punk::ns::arginfo $args]] leaders opts values received + lassign [dict values [punk::args::parse $args withid ::punk::ns::arginfo]] leaders opts values received #review - setting this afterwards is an architecture smell - we should be able to override the default in the dynamic part #todo - enable retrieving by id just the record_opts part - so we can treat as a dict directly, as well as easily apply it as a different flag name. @@ -2018,7 +2027,6 @@ tcl::namespace::eval punk::ns { set querycommand [dict get $values commandpath] set queryargs [dict get $values subcommand] - punk::args::update_definitions ;#ensure any packages that register PUNKARGS have been loaded #todo - similar to corp? review corp resolution process @@ -2087,6 +2095,16 @@ tcl::namespace::eval punk::ns { } } + #check for a direct match first + if {[info commands ::punk::args::id_exists] ne ""} { + if {![llength $queryargs]} { + punk::args::update_definitions [list [namespace qualifiers $origin]] + if {[punk::args::id_exists $origin]} { + return [uplevel 1 [list punk::args::usage {*}$opts $origin]] + } + } + } + #ns::cmdtype only detects alias type on 8.7+? set initial_cmdtype [punk::ns::cmdtype $origin] switch -- $initial_cmdtype { @@ -2137,31 +2155,40 @@ tcl::namespace::eval punk::ns { set id $origin if {[info commands ::punk::args::id_exists] ne ""} { - #cycle through longest first checking for id matching ::cmd ?subcmd..? - #REVIEW - this doesn't cater for prefix callable subcommands! + + + #check longest first checking for id matching ::cmd ?subcmd..? + #REVIEW - this doesn't cater for prefix callable subcommands set argcopy $queryargs - while {[llength $argcopy]} { - if {[punk::args::id_exists [list $id {*}$argcopy]]} { - return [uplevel 1 [list punk::args::usage {*}$opts [list $id {*}$argcopy]]] + if {[llength $queryargs]} { + punk::args::update_definitions [list [namespace qualifiers $id]] + if {[punk::args::id_exists [list $id {*}$queryargs]]} { + return [uplevel 1 [list punk::args::usage {*}$opts [list $id {*}$queryargs]]] } - lpop argcopy } + #while {[llength $argcopy]} { + # if {[punk::args::id_exists [list $id {*}$argcopy]]} { + # return [uplevel 1 [list punk::args::usage {*}$opts [list $id {*}$argcopy]]] + # } + # lpop argcopy + #} #didn't find any exact matches #traverse from other direction taking prefixes into account + punk::args::update_definitions [list [namespace qualifiers $id]] if {[punk::args::id_exists $id]} { #cycle forward through leading values - set def [punk::args::get_def $id] + set spec [punk::args::get_spec $id] if {[llength $queryargs]} { set nextqueryargs [list] ;#build a list of prefix-resolved queryargs set queryargs_untested $queryargs foreach q $queryargs { - if {[llength [dict get $def LEADER_NAMES]]} { - set subitems [dict get $def LEADER_NAMES] + if {[llength [dict get $spec LEADER_NAMES]]} { + set subitems [dict get $spec LEADER_NAMES] if {[llength $subitems]} { set next [lindex $subitems 0] - set arginfo [dict get $def ARG_INFO $next] + set arginfo [dict get $spec ARG_INFO $next] set allchoices [list] set choices [punk::args::system::Dict_getdef $arginfo -choices {}] @@ -2184,16 +2211,22 @@ tcl::namespace::eval punk::ns { #we have our first difference - recurse with new query args #set numvals [expr {[llength $queryargs]+1}] #return [ punk::ns::arginfo {*}[lrange $args 0 end-$numvals] $querycommand {*}$nextqueryargs {*}$queryargs_untested] - + #puts "===> testing arginfo {*}$opts $querycommand {*}$nextqueryargs {*}$queryargs_untested" return [ punk::ns::arginfo {*}$opts $querycommand {*}$nextqueryargs {*}$queryargs_untested] } #check if subcommands so far have a custom args def - set currentid [list $querycommand {*}$nextqueryargs] + #set currentid [list $querycommand {*}$nextqueryargs] + set currentid [list $id {*}$nextqueryargs] if {[punk::args::id_exists $currentid]} { - set def [punk::args::get_def $currentid + set spec [punk::args::get_spec $currentid] } else { #We can get no further with custom defs + #It is possible we have a documented lower level subcommand but missing the intermediate + #e.g if ::trace remove command was specified and is documented - it will be found above + #but if ::trace remove is not documented and the query is "::trace remove com" + #There is no way to determine com is a prefix as we don't have the intermediate documented -choice info available. + #that's probably ok. break } } @@ -2307,7 +2340,7 @@ tcl::namespace::eval punk::ns { set implementations [::info object call $origin $c1] #result documented as list of 4 element lists #set callinfo [lindex $implementations 0] - set def "" + set oodef "" foreach impl $implementations { lassign $impl generaltype mname location methodtype switch -- $generaltype { @@ -2323,7 +2356,7 @@ tcl::namespace::eval punk::ns { return [uplevel 1 [list punk::args::usage {*}$opts $idcustom]] } } - set def [::info object definition $origin $c1] + set oodef [::info object definition $origin $c1] } else { #set id "[string trimleft $location :] $c1" ;# " " set idcustom "$location $c1" @@ -2332,7 +2365,7 @@ tcl::namespace::eval punk::ns { return [uplevel 1 [list punk::args::usage {*}$opts $idcustom]] } } - set def [::info class definition $location $c1] + set oodef [::info class definition $location $c1] } break } @@ -2342,10 +2375,9 @@ tcl::namespace::eval punk::ns { } } } - if {$def ne ""} { - #assert - if we pre + if {$oodef ne ""} { set autoid "(autodef)$location $c1" - set arglist [lindex $def 0] + set arglist [lindex $oodef 0] set argdef [punk::lib::tstr -return string { @id -id "${$autoid}" @cmd -name "${$location} ${$c1}" -help\ @@ -2368,7 +2400,7 @@ tcl::namespace::eval punk::ns { append argdef \n "[lindex $a 0] -default {[lindex $a 1]} -optional 1" } default { - error "punk::ns::arginfo unexpected argument signature '$arglist'\ndef:$def\nimplementaions:$implementations" + error "punk::ns::arginfo unexpected oo argument signature '$arglist'\noodef:$oodef\nimplementations:$implementations" } } incr i @@ -2427,7 +2459,7 @@ tcl::namespace::eval punk::ns { @id -id ${$idauto} @cmd -name "Object: ${$origin}" -help\ "Instance of class: ${$class} (info autogenerated)" - @values -min 1 + @leaders -min 1 }] append argdef \n $vline punk::args::define $argdef @@ -2542,7 +2574,7 @@ tcl::namespace::eval punk::ns { @cmd -help\ "(autogenerated) ensemble: ${$origin}" - @values -min 1 + @leaders -min 1 }] append argdef \n $vline punk::args::define $argdef @@ -2977,84 +3009,100 @@ tcl::namespace::eval punk::ns { If not supplied, caller's namespace is used." -prefix -optional 1 -help\ "string prefix for command names in target namespace" - @values -min 1 -max 1 - sourcepattern -type string -optional 0 -help\ - "Glob pattern for source namespace. + @values -min 1 -max -1 + sourcepattern -type string -optional 0 -multiple 1 -help\ + "Glob pattern(s) for exported commands in source namespace(s). Globbing only active in the tail segment. - e.g ::mynamespace::*" + e.g ::mynamespace::a* ::mynamespace::j*" } proc nsimport_noclobber {args} { lassign [dict values [punk::args::get_by_id ::punk::ns::nsimport_noclobber $args]] leaders opts values received - set sourcepattern [dict get $values sourcepattern] + set sourcepatterns [dict get $values sourcepattern] - set source_ns [tcl::namespace::qualifiers $sourcepattern] - if {![tcl::namespace::exists $source_ns]} { - error "nsimport_noclobber error namespace $source_ns not found" - } set nscaller [uplevel 1 {namespace current}] if {![dict exists $received -targetnamespace]} { set target_ns $nscaller } else { set target_ns [dict get $opts -targetnamespace] if {![string match ::* $target_ns]} { - set target_ns [punk::nsjoin $nscaller $target_ns] + set target_ns [punk::ns::nsjoin $nscaller $target_ns] } } + set all_imported [list] + set nstemp ::punk::ns::temp_import - set a_export_patterns [tcl::namespace::eval $source_ns {namespace export}] - set a_commands [info commands $sourcepattern] - set a_tails [lmap v $a_commands {tcl::namespace::tail $v}] - set a_exported_tails [list] - foreach epattern $a_export_patterns { - set matches [lsearch -all -inline $a_tails $epattern] - foreach m $matches { - if {$m ni $a_exported_tails} { - lappend a_exported_tails $m + foreach pat $sourcepatterns { + set source_ns [tcl::namespace::qualifiers $pat] + if {![tcl::namespace::exists $source_ns]} { + error "nsimport_noclobber error namespace $source_ns not found" + } + + set a_export_patterns [tcl::namespace::eval $source_ns {namespace export}] + set a_commands [info commands $pat] + #puts "-->commands:'$a_commands'" + set a_tails [lmap v $a_commands {tcl::namespace::tail $v}] + set a_exported_tails [list] + foreach epattern $a_export_patterns { + set matches [lsearch -all -inline $a_tails $epattern] + foreach m $matches { + #we will be using namespace import one by one on commands. + #we must protect glob chars that may exist in the actual command names. + #e.g nsimport_noclobber ::punk::ansi::a? + # will import a+ and a? + #but nsimport_noclobber {::punk::ansi::a\?} + # must import only a? + set m [string map {\\ \\\\ ? \\? * \\* \[ \\[ \] \\]} $m] + if {$m ni $a_exported_tails} { + lappend a_exported_tails $m + } } } - } - set nstemp ::punk::ns::temp_import - if {[tcl::dict:::exists $received -prefix]} { - set pfx [dict get $opts -prefix] - set imported_commands [list] - if {[namespace exists $nstemp]} { - namespace delete $nstemp - } - namespace eval $nstemp {} - foreach e $a_exported_tails { - set imported [tcl::namespace::eval $nstemp [string map [list $e $source_ns $pfx $target_ns] { - set cmd "" - if {![catch {namespace import ::}]} { - #renaming will fail if target already exists - #renaming a command into another namespace still results in a command with 'info cmdtype' = 'import' - if {![catch {rename [punk::ns::nsjoin ]}]} { - set cmd + + + if {[tcl::dict:::exists $received -prefix]} { + #import via temporary/intermediate namespace + set pfx [dict get $opts -prefix] + set imported_commands [list] + if {[namespace exists $nstemp]} { + namespace delete $nstemp + } + namespace eval $nstemp {} + foreach e $a_exported_tails { + set imported [apply {{tgtns func srcns pfx tmpns} { + set cmd "" + if {![catch {::tcl::namespace::eval $tmpns [list ::namespace import ${srcns}::$func]}]} { + #renaming will fail if target already exists + #renaming a command into another namespace still results in a command with 'info cmdtype' = 'import' + if {![catch {::tcl::namespace::eval $tmpns [list ::rename $func [::punk::ns::nsjoin $tgtns $pfx$func]]}]} { + set cmd $pfx$func + } } + set cmd + } } $target_ns $e $source_ns $pfx $nstemp] + if {$imported ne ""} { + lappend imported_commands $imported } - set cmd - }]] - if {$imported ne ""} { - lappend imported_commands $imported } - } - namespace delete $nstemp - return $imported_commands - } - - set imported_commands [list] - foreach e $a_exported_tails { - set imported [tcl::namespace::eval $target_ns [string map [list $e $source_ns] { - set cmd "" - if {![catch {namespace import ::}]} { - set cmd + namespace delete $nstemp + } else { + #no prefix - direct import + set imported_commands [list] + foreach e $a_exported_tails { + set imported [apply {{tgtns func srcns} { + set cmd "" + if {![catch {tcl::namespace::eval $tgtns [list namespace import ${srcns}::$func]}]} { + set cmd $func + } + set cmd + } } $target_ns $e $source_ns] + if {$imported ne ""} { + lappend imported_commands $imported + } } - set cmd - }]] - if {[string length $imported]} { - lappend imported_commands $imported } + lappend all_imported {*}$imported_commands } - return $imported_commands + return $all_imported } #todo - use ns::nsimport_noclobber instead ? @@ -3092,7 +3140,23 @@ tcl::namespace::eval punk::ns { interp alias {} corp {} punk::ns::corp interp alias {} i {} punk::ns::arginfo - + #An example of using punk::args in a pipeline + punk::args::define { + @id -id ::i+ + @cmd -name "i+" -help\ + "Display command help side by side" + @values + cmds -multiple 1 -help\ + "Command names for which to show help info" + } + interp alias {} i+ {}\ + .=args> punk::args::get_by_id ::i+ |argd>\ + .=>2 dict get values cmds |cmds>\ + .=cmds>2 lmap c {i -return tableobject {*}$c} |objs>\ + .=objs>2 lmap t {$t configure -show_vseps 0 -show_edge 1} |>\ + .=objs>2 lmap t {$t print} |tables>\ + .=objs>2 lmap t {$t destroy} |>\ + .=tables>* textblock::join -- 1} { + # --------------------------------------------------------------- + #An attempt to detect dll/so loaded and try to load same version + #dll/so files are often named with version numbers that don't contain dots or a version number at all + #e.g sqlite3400.dll Thread288.dll + set pkgloadedinfo [lsearch -nocase -inline -index 1 [info loaded] $pkg] + + if {[llength $pkgloadedinfo]} { + puts stderr "--> pkg not already 'provided' but shared object seems to be loaded: $pkgloadedinfo - and multiple versions available" + lassign $pkgloadedinfo path name + set lcpath [string tolower $path] + #first attempt to find a match for our loaded sharedlib path in a *simple* package ifneeded statement. + set lcpath_to_version [dict create] + foreach av $available_versions { + set scr [package ifneeded $pkg $av] + #ifneeded script not always a valid tcl list + if {![catch {llength $scr} scrlen]} { + if {$scrlen == 3 && [lindex $scr 0] eq "load" && [string match -nocase [lindex $scr 2] $pkg]} { + dict set lcpath_to_version [string tolower [lindex $scr 1]] $av + } + } } - } - } - if {[llength $pkgloadedinfo]} { - puts stderr "--> pkg not present but shared object seems to be loaded: $pkgloadedinfo" - lassign $pkgloadedinfo path name - set lcpath [string tolower $path] - set obj [file tail $lcpath] - if {[string match tcl9* $obj]} { - set obj [string range $obj 4 end] - } elseif {[string match lib* $obj]} { - set obj [string range $obj 3 end] - } - set pkginfo [file rootname $obj] - #e.g Thread2.8.8 - if {[regexp {^([a-zA-Z\-]+)(.*)} $pkginfo _match lname lversion]} { - if {[string tolower $lname] eq [string tolower $pkg]} { + if {[dict exists $lcpath_to_version $lcpath]} { + set lversion [dict get $lcpath_to_version $lcpath] + } else { + #fallback to a best effort guess based on the path + set lversion [::punk::packagepreference::system::slibpath_guess_pkgversion $path $pkg] + } + if {$lversion ne ""} { #name matches pkg #hack for known dll version mismatch if {[string tolower $pkg] eq "thread" && $lversion eq "30b3"} { @@ -240,9 +259,11 @@ tcl::namespace::eval punk::packagepreference { }] if {[dict get $stackrecord implementation] ne ""} { set impl [dict get $stackrecord implementation] ;#use hardcoded name rather than slower (but more flexible) commandstack::get_next_command - puts stdout "punk::packagepreference renamed ::package to $impl" + #puts stdout "punk::packagepreference renamed ::package to $impl" + return 1 } else { puts stderr "punk::packagepreference failed to rename ::package" + return 0 } #puts stdout [info body ::package] } @@ -297,14 +318,94 @@ tcl::namespace::eval punk::packagepreference::lib { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[section Internal] -#tcl::namespace::eval punk::packagepreference::system { +tcl::namespace::eval punk::packagepreference::system { #*** !doctools #[subsection {Namespace punk::packagepreference::system}] #[para] Internal functions that are not part of the API + variable PUNKARGS + + lappend PUNKARGS [list { + @id -id ::punk::packagepreference::system::slibpath_guess_pkgversion + @cmd -name punk::packagepreference::system::slibpath_guess_pkgversion -help\ + "Assistance function to determine pkg version from the information + obtained from [info loaded]. This is used to try to avoid loading a different + version of a binary package in another thread/interp when the package isn't + present in the interp, but [info loaded] indicates the binary is already loaded. + The more general/robust way to avoid this is to ensure ::auto_path and + tcl::tm::list are the same in each interp/thread. + + This call should only be used as a fallback in case a binary package has a more + complex ifneeded script. If the ifneeded script for a binary package is a + straightforward 'load ' - then that information + should be used to determine the version by matching + rather than this one. + + Takes a path to a shared lib (.so/.dll), and the name of its providing + package, and return the version of the package if possible to determine + from the path. + The filename portion of the lib is often missing a version number or has + a version number that has been shortened (e.g dots removed). + The filename itself is first checked for a version number - but the number + is ignored if it doesn't contain any dots. + (prefix is checked to match with $pkgname, with a possible additional prefix + of lib or tcl) + Often (even usually) the parent or grandparent folder will be named as + per the package name with a proper version. If so we can return it, + otherwise return empty string. + The parent/grandparent matching will be done by looking for a case + insensitive match of the prefix to $pkgname. + " + @values -min 1 + libpath -help "Full path to shared library (.so,.dll etc)" + pkgname -help "" + }] + proc slibpath_guess_pkgversion {libpath pkgname} { + set root [file rootname [file tail $libpath]] + set namelen [string length $pkgname] + regexp {^(tcl(?:[0-9])+){0,1}(.*)} $root _match tclxx root ;#regexp will match anything - but only truncate leading tclXX.. + set testv "" + if {[string match -nocase $pkgname* $root]} { + set testv [string range $root $namelen end] + } elseif {[string match -nocase lib$pkgname* $root]} { + set testv [string range $root $namelen+3 end] + } + if {[string first . $testv] > 0} { + if {![catch [list package vcompare $testv $testv]]} { + #testv has an inner dot and is understood by tcl as a valid version number + return $testv + } + } + #no valid dotted version found directly on dll or so filename + set parent [file dirname $libpath] ;#parent folder is often some differentiator for platform or featureset (e.g win-x64) + set grandparent [file dirname $parent] + foreach path [list $parent $grandparent] { + set segment [file tail $path] + if {$segment eq "bin"} { + continue + } + set testv "" + if {[string match -nocase $pkgname* $segment]} { + set testv [string range $segment $namelen end] + } elseif {[string match -nocase critcl_$pkgname* $segment]} { + set testv [string range $segment $namelen+7 end] + } + #we don't look for dot in parent/grandparent version - a bare integer here after the will be taken to be the version + if {![catch [list package vcompare $testv $testv]]} { + return $testv + } + } + #review - sometimes path and lib are named only for major.minor but package provides major.minor.subversion + #using returned val to attempt to package require -exact major.minor will fail to load major.minor.subversion + return "" + } +} +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::packagepreference ::punk::packagepreference::system +} -#} # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::packagepreference [tcl::namespace::eval punk::packagepreference { diff --git a/src/bootsupport/modules/punk/path-0.1.0.tm b/src/bootsupport/modules/punk/path-0.1.0.tm index ede3e18b..51e74719 100644 --- a/src/bootsupport/modules/punk/path-0.1.0.tm +++ b/src/bootsupport/modules/punk/path-0.1.0.tm @@ -651,11 +651,16 @@ namespace eval punk::path { -call-depth-internal -default 0 -type integer -antiglob_paths -default {} -help\ "list of path patterns to exclude - may include * and ** path segments e.g /usr/**" + may include * and ** path segments e.g + /usr/** (exlude subfolders based at /usr but not + files within /usr itself) + **/_aside (exlude files where _aside is last segment) + **/_aside/* (exclude folders one below an _aside folder) + **/_aside/** (exclude all folders with _aside as a segment)" @values -min 0 -max -1 -optional 1 -type string - tailglobs -multiple 1 -help\ + tailglobs -default * -multiple 1 -help\ "Patterns to match against filename portion (last segment) of each file path - within the directory tree being searched." + within the directory tree being searched." } #todo - implement treefiles which acts like dirfiles but allows path globbing in the same way as punk::ns::ns/ @@ -671,29 +676,29 @@ namespace eval punk::path { #[para] list of path patterns to exclude - may include * and ** path segments e.g /usr/** #[para]no natsorting - so order is dependent on filesystem - set argd [punk::args::get_by_id ::punk::path::treefilenames $args] + set argd [punk::args::parse $args withid ::punk::path::treefilenames] lassign [dict values $argd] leaders opts values received - set tailglobs [dict values $values] + set tailglobs [dict get $values tailglobs] # -- --- --- --- --- --- --- set opt_antiglob_paths [dict get $opts -antiglob_paths] set CALLDEPTH [dict get $opts -call-depth-internal] # -- --- --- --- --- --- --- - if {![dict exists $received -directory]} { - set opt_dir [pwd] - } else { - set opt_dir [dict get $opts -directory] - } # -- --- --- --- --- --- --- set files [list] if {$CALLDEPTH == 0} { + #set opts [dict merge $opts [list -directory $opt_dir]] + if {![dict exists $received -directory]} { + set opt_dir [pwd] + } else { + set opt_dir [dict get $opts -directory] + } if {![file isdirectory $opt_dir]} { return [list] } - set opts [dict merge $opts [list -directory $opt_dir]] - if {![llength $tailglobs]} { - lappend tailglobs * - } + } else { + #assume/require to exist in any recursive call + set opt_dir [dict get $opts -directory] } set skip 0 diff --git a/src/bootsupport/modules/punk/pipe-1.0.tm b/src/bootsupport/modules/punk/pipe-1.0.tm new file mode 100644 index 00000000..0b5501ac --- /dev/null +++ b/src/bootsupport/modules/punk/pipe-1.0.tm @@ -0,0 +1,853 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from -buildversion.txt +# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.3.tm +# +# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. +# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# (C) 2025 +# +# @@ Meta Begin +# Application punk::pipe 1.0 +# Meta platform tcl +# Meta license MIT +# @@ Meta End + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# doctools header +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[manpage_begin shellspy_module_punk::pipe 0 1.0] +#[copyright "2025"] +#[titledesc {Module API}] [comment {-- Name section and table of contents description --}] +#[moddesc {-}] [comment {-- Description at end of page heading --}] +#[require punk::pipe] +#[keywords module] +#[description] +#[para] - + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section Overview] +#[para] overview of punk::pipe +#[subsection Concepts] +#[para] - + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[subsection dependencies] +#[para] packages used by punk::pipe +#[list_begin itemized] + +package require Tcl 8.6- +#*** !doctools +#[item] [package {Tcl 8.6}] + +# #package require frobz +# #*** !doctools +# #[item] [package {frobz}] + +#*** !doctools +#[list_end] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section API] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# oo::class namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#tcl::namespace::eval punk::pipe::class { + #*** !doctools + #[subsection {Namespace punk::pipe::class}] + #[para] class definitions + #if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} { + #*** !doctools + #[list_begin enumerated] + + # oo::class create interface_sample1 { + # #*** !doctools + # #[enum] CLASS [class interface_sample1] + # #[list_begin definitions] + + # method test {arg1} { + # #*** !doctools + # #[call class::interface_sample1 [method test] [arg arg1]] + # #[para] test method + # puts "test: $arg1" + # } + + # #*** !doctools + # #[list_end] [comment {-- end definitions interface_sample1}] + # } + + #*** !doctools + #[list_end] [comment {--- end class enumeration ---}] + #} +#} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +tcl::namespace::eval punk::pipe { + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + # Base namespace + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + #*** !doctools + #[subsection {Namespace punk::pipe}] + #[para] Core API functions for punk::pipe + #[list_begin definitions] + + + + #proc sample1 {p1 n args} { + # #*** !doctools + # #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] + # #[para]Description of sample1 + # #[para] Arguments: + # # [list_begin arguments] + # # [arg_def tring p1] A description of string argument p1. + # # [arg_def integer n] A description of integer argument n. + # # [list_end] + # return "ok" + #} + + #https://randomascii.wordpress.com/2012/02/25/comparing-floating-point-numbers-2012-edition/ + # + #we can't provide a float comparison suitable for every situation, + #but we should pick something reasonable, keep it stable, and document it. + proc float_almost_equal {a b} { + package require math::constants + set diff [expr {abs($a - $b)}] + if {$diff <= $::math::constants::eps} { + return 1 + } + set A [expr {abs($a)}] + set B [expr {abs($b)}] + set largest [expr {($B > $A) ? $B : $A}] + return [expr {$diff <= $largest * $::math::constants::eps}] + } + + #debatable whether boolean_almost_equal is more surprising than helpful. + #values from a calculation that are extremely close to zero but aren't false could also be surprising - especially if they compare equal numerically + #perhaps a fuzzy-boolean is a step too far for a default - but it's inline with float-comparison for pattern-matching. + #alternatively - use an even more complex classifier? (^&~) ? + proc boolean_almost_equal {a b} { + if {[string is double -strict $a]} { + if {[float_almost_equal $a 0]} { + set a 0 + } + } + if {[string is double -strict $b]} { + if {[float_almost_equal $b 0]} { + set b 0 + } + } + #must handle true,no etc. + expr {($a && 1) == ($b && 1)} + } + + #boolean could be tr, true, y, ye, yes,Yes, 1 , 0 etc. + proc boolean_equal {a b} { + #equivalenttly xnor: expr {!(($a && 1) ^ ($b && 1))} ;# less clear and no discernable timing benefit. + expr {($a && 1) == ($b && 1)} + } + + + proc val [list [list v [lreplace x 0 0]]] {return $v} + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::pipe ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Secondary API namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +tcl::namespace::eval punk::pipe::lib { + tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase + tcl::namespace::path [tcl::namespace::parent] + #*** !doctools + #[subsection {Namespace punk::pipe::lib}] + #[para] Secondary functions that are part of the API + #[list_begin definitions] + + #proc utility1 {p1 args} { + # #*** !doctools + # #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] + # #[para]Description of utility1 + # return 1 + #} + + #map rhs to names suitable to use in pipemcd proc name (whitespace mapping) + # (for .= and = pipecmds) + proc pipecmd_namemapping {rhs} { + #used to build a command from a pattern which could contain :: - we need to map it to keep it a single command in the desired namespace. + #glob chars will prevent us using simple test {[info commands $cmd] eq ""} to test existence + #we could use the test {$cmd in [info commands]} - but mapping away globchars is more robust, allowing the simpler test + #set rhs [string trim $rhs];#ignore all leading & trailing whitespace + set rhs [string trimleft $rhs] + #--- + #REVIEW! + #set rhs [regsub -all {\s{1,}} $rhs {}] ;#collapse all internal whitespace to a single token + #This stops us matching {/@**@x x} vs {/@**@x x} + #--- + + set rhs [tcl::string::map {: ? * [ ] \\ {"} " " } $rhs] + #review - we don't expect other command-incompatible chars such as colon? + return $rhs + } + + # relatively slow on even small sized scripts + #proc arg_is_script_shaped2 {arg} { + # set re {^(\s|;|\n)$} + # set chars [split $arg ""] + # if {[lsearch -regex $chars $re] >=0} { + # return 1 + # } else { + # return 0 + # } + #} + + #exclude quoted whitespace + proc arg_is_script_shaped {arg} { + if {[tcl::string::first \n $arg] >= 0} { + return 1 + } elseif {[tcl::string::first ";" $arg] >= 0} { + return 1 + } elseif {[tcl::string::first " " $arg] >= 0 || [tcl::string::first \t $arg] >= 0} { + lassign [_rhs_tail_split $arg] _ part2 ;#will have part2 if unquoted whitespace found + return [expr {$part2 ne ""}] + } else { + return 0 + } + } + + #split top level of patterns only. + proc _split_patterns_memoized {varspecs} { + set name_mapped [pipecmd_namemapping $varspecs] + set cmdname ::punk::pipecmds::split_patterns::_$name_mapped + if {[info commands $cmdname] ne ""} { + return [$cmdname] + } + set result [_split_patterns $varspecs] + proc $cmdname {} [list return $result] + #debug.punk.pipe.compile {proc $cmdname} 4 + return $result + } + + + #note - empty data after trailing , is ignored. (comma as very last character) + # - fix by documentation only. double up trailing comma e.g ,, if desired to return pattern match plus all at end! + #todo - move to punk::pipe + proc _split_patterns {varspecs} { + + set varlist [list] + # @ @@ - list and dict functions + # / level separator + # # list count, ## dict size + # % string functions + # ! not + set var_terminals [list "@" "/" "#" "%" "!" ">" "<"] ;# (> required for insertionspecs at rhs of = & .= ) + #right bracket ) also ends a var - but is different depending on whether var is array or basic. For array - it forms part of the varname + + #except when prefixed directly by pin classifier ^ + set protect_terminals [list "^"] ;# e.g sequence ^# + #also - an atom usually doesn't need the / as a terminal - because it can't match a missing element unless it's empty string + #ie the one usecase is '/n to match either empty string or missing item at position n. For this one usecase - we miss the capability to atom match paths/urls .. '/usr/local/et' + set in_brackets 0 ;#count depth + set in_atom 0 + set token "" + set end_var_posn -1 ;#first var_terminal encountered within each comma delimited section + set token_index 0 ;#index of terminal char within each token + set indq 0 + set inbraces 0 + set inesc 0 ;#whether last char was backslash (see also punk::escv) + set prevc "" + set char_index 0 + #if {[string index $varspecs end] eq ","} { + # set varspecs [string range $varspecs 0 end-1] + #} + set charcount 0 + foreach c [split $varspecs ""] { + incr charcount + if {$indq} { + if {$inesc} { + #puts stderr "inesc adding '$c'" + append token \\$c + } else { + if {$c eq {"}} { + set indq 0 + } else { + append token $c + } + } + } elseif {$inbraces} { + if {$inesc} { + append token \\$c + } else { + if {$c eq "\}"} { + incr inbraces -1 + if {$inbraces} { + append token $c + } + } elseif {$c eq "\{"} { + incr inbraces + if {$inbraces} { + append token $c + } + } else { + append token $c + } + } + } elseif {$in_atom} { + #ignore dquotes/brackets in atoms - pass through + append token $c + #set nextc [lindex $chars $char_index+1] + if {$c eq "'"} { + set in_atom 0 + } + } elseif {$in_brackets > 0} { + append token $c + if {$c eq ")"} { + incr in_brackets -1 + } + } else { + if {$c eq {"}} { + if {!$inesc} { + set indq 1 + } else { + append token $c + } + } elseif {$c eq "\{"} { + if {!$inesc} { + set inbraces 1 + } else { + append token $c + } + } elseif {$c eq ","} { + #set var $token + #set spec "" + #if {$end_var_posn > 0} { + # #tcl scan with %s will not handle whitespace as desired. Be explicit using string range instead. + # #lassign [scan $token %${end_var_posn}s%s] var spec + # set var [string range $token 0 $end_var_posn-1] + # set spec [string range $token $end_var_posn end] ;#key section includes the terminal char which ended the var and starts the spec + #} else { + # if {$end_var_posn == 0} { + # set var "" + # set spec $token + # } + #} + #lappend varlist [list [string trim $var] [string trim $spec]] + #set token "" + #set token_index -1 ;#reduce by 1 because , not included in next token + #set end_var_posn -1 + } else { + append token $c + switch -exact -- $c { + ' { + set in_atom 1 + } + ( { + incr in_brackets + } + default { + if {$end_var_posn == -1 && (($c in $var_terminals) && ($prevc ni $protect_terminals))} { + set end_var_posn $token_index + } + } + } + } + if {$c eq ","} { + set var $token + set spec "" + if {$end_var_posn > 0} { + #tcl scan with %s will not handle whitespace as desired. Be explicit using string range instead. + #lassign [scan $token %${end_var_posn}s%s] var spec + set var [string range $token 0 $end_var_posn-1] + set spec [string range $token $end_var_posn end] ;#key section includes the terminal char which ended the var and starts the spec + } else { + if {$end_var_posn == 0} { + set var "" + set spec $token + } + } + lappend varlist [list [string trim $var] $spec] + set token "" + set token_index -1 + set end_var_posn -1 + + } + } + + if {$charcount == [string length $varspecs]} { + if {!($indq || $inbraces || $in_atom || $in_brackets)} { + if {$c ne ","} { + set var $token + set spec "" + if {$end_var_posn > 0} { + #tcl scan with %s will not handle whitespace as desired. Be explicit using string range instead. + #lassign [scan $token %${end_var_posn}s%s] var spec + set var [string range $token 0 $end_var_posn-1] + set spec [string range $token $end_var_posn end] ;#key section includes the terminal char which ended the var and starts the spec + } else { + if {$end_var_posn == 0} { + set var "" + set spec $token + } + } + lappend varlist [list [string trim $var] $spec] + set token "" + set token_index -1 + set end_var_posn -1 + } + } + } + + set prevc $c + if {$c eq "\\"} { + #review + if {$inesc} { + set inesc 0 + } else { + set token [string range $token 0 end-1] + set inesc 1 + } + } else { + set inesc 0 + } + incr token_index + incr char_index + } + + #if {[string length $token]} { + # #lappend varlist [splitstrposn $token $end_var_posn] + # set var $token + # set spec "" + # if {$end_var_posn > 0} { + # #lassign [scan $token %${end_var_posn}s%s] var spec + # set var [string range $token 0 $end_var_posn-1] + # set spec [string range $token $end_var_posn end] ;#key section includes the terminal char which ended the var and starts the spec + # } else { + # if {$end_var_posn == 0} { + # set var "" + # set spec $token + # } + # } + # #lappend varlist [list [string trim $var] [string trim $spec]] + # #spec needs to be able to match whitespace too + # lappend varlist [list [string trim $var] $spec] + #} + + return $varlist + } + + #todo - consider whether we can use < for insertion/iteration combinations + # =a<,b< iterate once through + # =a><,b>< cartesian product + # =a<>,b<> ??? zip ? + # + # ie = {a b c} |> .=< inspect + # would call inspect 3 times, once for each argument + # .= list {a b c} {x y z} |a/0,b/1> .=a><,b>< list + # would produce list of cartesian pairs? + # + proc _split_equalsrhs {insertionpattern} { + #map the insertionpattern so we can use faster globless info command search + set name_mapped [pipecmd_namemapping $insertionpattern] + set cmdname ::punk::pipecmds::split_rhs::_$name_mapped + if {[info commands $cmdname] ne ""} { + return [$cmdname] + } + + set lst_var_indexposition [_split_patterns_memoized $insertionpattern] + set i 0 + set return_triples [list] + foreach v_pos $lst_var_indexposition { + lassign $v_pos v index_and_position + #e.g varname@@data/ok>0 varname/1/0>end + #ensure only one ">" is detected + if {![string length $index_and_position]} { + set indexspec "" + set positionspec "" + } else { + set chars [split $index_and_position ""] + set posns [lsearch -all $chars ">"] + if {[llength $posns] > 1} { + error "pipesyntax error in segment insertion pattern '$insertionpattern' -v '$v' multiple '>' characters. Pattern not understood." "_split_equalsrhs $insertionpattern" [list pipesyntax insertionpattern_invalid] + } + if {![llength $posns]} { + set indexspec $index_and_position + set positionspec "" + } else { + set splitposn [lindex $posns 0] + set indexspec [string range $index_and_position 0 $splitposn-1] + set positionspec [string range $index_and_position $splitposn+1 end] + } + } + + #review - + if {($positionspec in [list "*" "/*" "@*" "/" "@"]) || ($v eq "*" && $positionspec eq "")} { + set star "" + if {$v eq "*"} { + set v "" + set star "*" + } + if {[string index $positionspec end] eq "*"} { + set star "*" + } + #it is always possible to insert at end of list regardless of current length - so /end* and @end* are equivalent + #as are /end and @end + #lset lst_var_indexposition $i [list $v "/end$star"] + set triple [list $v $indexspec "/end$star"] + } else { + if {$positionspec eq ""} { + #e.g just =varname + #lset lst_var_indexposition $i [list $v "/end"] + set triple [list $v $indexspec "/end"] + #error "pipesyntax error in segment insertionpattern '$insertionpattern' - v '$v' missing position spec e.g /0" + } else { + if {[string index $indexspec 0] ni [list "" "/" "@"]} { + error "pipesyntax error in segment insertionpattern '$insertionpattern' - v '$v' bad index spec '$indexspec'" "_split_equalsrhs $insertionpattern" [list pipesyntax insertionpattern_invalid] + } + set triple [list $v $indexspec $positionspec] + } + } + lappend return_triples $triple + incr i + } + proc $cmdname {} [list return $return_triples] + return $return_triples + } + + proc _rhs_tail_split {fullrhs} { + set inq 0; set indq 0 + set equalsrhs "" + set i 0 + foreach ch [split $fullrhs ""] { + if {$inq} { + append equalsrhs $ch + if {$ch eq {'}} { + set inq 0 + } + } elseif {$indq} { + append equalsrhs $ch + if {$ch eq {"}} { + set indq 0 + } + } else { + switch -- $ch { + {'} { + set inq 1 + } + {"} { + set indq 1 + } + " " { + #whitespace outside of quoting + break + } + 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - a - b - c - d - e - f - g - h - i - j - k - l - m - n - o - p - q - r - s - t - u - v - w - x - y - z {} + default { + #\t not a literal for switch jumpTable bytecompile - review - can we do it without for example string mapping to (and without a literal binary tab in source file)? + #we can't (reliably?) put \t as one of our switch keys + # + if {$ch eq "\t"} { + break + } + } + } + append equalsrhs $ch + } + incr i + } + set tail [tcl::string::range $fullrhs $i end] + return [list $equalsrhs $tail] + } + + #todo - recurse into bracketed sub parts + #JMN3 + #e.g @*/(x@0,y@2) + proc _var_classify {multivar} { + set cmdname ::punk::pipecmds::var_classify::_[pipecmd_namemapping $multivar] + if {[info commands $cmdname] ne ""} { + return [$cmdname] + } + + + #comma seems a natural choice to split varspecs, + #but also for list and dict subelement access + #/ normally indicates some sort of hierarchical separation - (e.g in filesytems) + #so / will indicate subelements e.g @0/1 for lindex $list 0 1 + #set valsource_key_list [_split_var_key_at_unbracketed_comma $multivar] + set valsource_key_list [_split_patterns_memoized $multivar] + + + + #mutually exclusive - atom/pin + #set map [list "" ' ^ &] ;#0 = default/var/not-yet-determined 1 = atom 2 = pin + #set var_class [lmap var $valsource_key_list {expr {([set m [lsearch $map [string index [lindex $var 0] 0]]] >= 0) ? [list $var $m] : [list $var 0]}}] + #0 - novar + #1 - atom ' + #2 - pin ^ + #3 - boolean & + #4 - integer + #5 - double + #6 - var + #7 - glob (no classifier and contains * or ?) + #8 - numeric + #9 - > (+) + #10 - < (-) + + set var_names [list] + set var_class [list] + set varspecs_trimmed [list] ;#raw varspecs without pin/atom modifiers - or empty string for glob + + + set leading_classifiers [list "'" "&" "^" ] + set trailing_classifiers [list + -] + set possible_number_start [list - + . 0 1 2 3 4 5 6 7 8 9 > <] + + foreach v_key $valsource_key_list { + lassign $v_key v key + set vname $v ;#default + set classes [list] + if {$v eq ""} { + lappend var_class [list $v_key 0] + lappend varspecs_trimmed $v_key + } else { + set lastchar [string index $v end] + switch -- $lastchar { + + { + lappend classes 9 + set vname [string range $v 0 end-1] + } + - { + lappend classes 10 + set vname [string range $v 0 end-1] + } + } + set firstchar [string index $v 0] + switch -- $firstchar { + ' { + lappend var_class [list $v_key 1] + #set vname [string range $v 1 end] + lappend varspecs_trimmed [list $vname $key] + } + ^ { + lappend classes [list 2] + #use vname - may already have trailing +/- stripped + set vname [string range $vname 1 end] + set secondclassifier [string index $v 1] + switch -- $secondclassifier { + "&" { + #pinned boolean + lappend classes 3 + set vname [string range $v 2 end] + } + "#" { + #pinned numeric comparison instead of string comparison + #e.g set x 2 + # this should match: ^#x.= list 2.0 + lappend classes 8 + set vname [string range $vname 1 end] + } + "*" { + #pinned glob + lappend classes 7 + set vname [string range $v 2 end] + } + } + #todo - check for second tag - & for pinned boolean? + #consider requiring ^# for numeric comparisons. currently no way to do a strictly string comparison on pinned variables.... default ^var really shouldn't be doing any magic. + #while we're at it.. pinned glob would be nice. ^* + #maybe even pinned scan ^% ? regex? ^/ or ^? these would be hard to have corresponding literals in the pattern mini-lang. + #These all limit the range of varnames permissible - which is no big deal. + lappend var_class [list $v_key $classes] + lappend varspecs_trimmed [list $vname $key] + } + & { + #we require boolean literals to be single-quoted so we can use cross-binding on boolean vars. + #ie &true is the variable true whereas &'true' or &'1' &'t' etc are literal booleans + #allow exception of &1 &0 to be literal booleans - because we disallow 0 & 1 as varnames in other contexts anyway - so it would be more consistent not to treat as varnames here. + lappend var_class [list $v_key 3] + set vname [string range $v 1 end] + lappend varspecs_trimmed [list $vname $key] + } + default { + if {([string first ? $v]) >=0 || ([string first * $v] >=0)} { + lappend var_class [list $v_key 7] ;#glob + #leave vname as the full glob + lappend varspecs_trimmed [list "" $key] + } else { + #scan vname not v - will either be same as v - or possibly stripped of trailing +/- + set numtestv [join [scan $vname %lld%s] ""] ;# handles octals (leading zeros), ok for use with bignums, decimal points and sci notation - fails to handle leading dot e.g .5 + #leading . still need to test directly for double + if {[string is double -strict $vname] || [string is double -strict $numtestv]} { + if {[string is integer -strict $numtestv]} { + #this will pick up boolean 1 or 0 - but that's ok - they require "&" marker if boolean comparison desired + #integer test before double.. + #note there is also string is wide (string is wideinteger) for larger ints.. + lappend classes 4 + lappend var_class [list $v_key $classes] + lappend varspecs_trimmed $v_key + } else { + #double + #sci notation 1e123 etc + #also large numbers like 1000000000 - even without decimal point - (tcl bignum) + lappend classes 5 + lappend var_class [list $v_key $classes] + lappend varspecs_trimmed $v_key + } + } else { + lappend var_class [list $v_key 6] ;#var + lappend varspecs_trimmed $v_key + } + } + } + } + } + lappend var_names $vname + } + + set result [list var_names $var_names var_class $var_class varspecs_trimmed $varspecs_trimmed] + + proc $cmdname {} [list return $result] + #JMN + #debug.punk.pipe.compile {proc $cmdname} + return $result + } + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::pipe::lib ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[section Internal] +#tcl::namespace::eval punk::pipe::system { + #*** !doctools + #[subsection {Namespace punk::pipe::system}] + #[para] Internal functions that are not part of the API + + + +#} + + +# == === === === === === === === === === === === === === === +# Sample 'about' function with punk::args documentation +# == === === === === === === === === === === === === === === +tcl::namespace::eval punk::pipe { + tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase + variable PUNKARGS + variable PUNKARGS_aliases + + lappend PUNKARGS [list { + @id -id "(package)punk::pipe" + @package -name "punk::pipe" -help\ + "Package + Description" + }] + + namespace eval argdoc { + #namespace for custom argument documentation + proc package_name {} { + return punk::pipe + } + proc about_topics {} { + #info commands results are returned in an arbitrary order (like array keys) + set topic_funs [info commands [namespace current]::get_topic_*] + set about_topics [list] + foreach f $topic_funs { + set tail [namespace tail $f] + lappend about_topics [string range $tail [string length get_topic_] end] + } + return $about_topics + } + proc default_topics {} {return [list Description outline *]} + + # ------------------------------------------------------------- + # get_topic_ functions add more to auto-include in about topics + # ------------------------------------------------------------- + proc get_topic_Description {} { + punk::args::lib::tstr [string trim { + punk pipeline features + } \n] + } + proc get_topic_License {} { + return "MIT" + } + proc get_topic_Version {} { + return $::punk::pipe::version + } + proc get_topic_Contributors {} { + set authors {{Julian Noble }} + set contributors "" + foreach a $authors { + append contributors $a \n + } + if {[string index $contributors end] eq "\n"} { + set contributors [string range $contributors 0 end-1] + } + return $contributors + } + proc get_topic_outline {} { + punk::args::lib::tstr -return string { + todo.. + } + } + # ------------------------------------------------------------- + } + + # we re-use the argument definition from punk::args::standard_about and override some items + set overrides [dict create] + dict set overrides @id -id "::punk::pipe::about" + dict set overrides @cmd -name "punk::pipe::about" + dict set overrides @cmd -help [string trim [punk::args::lib::tstr { + About punk::pipe + }] \n] + dict set overrides topic -choices [list {*}[punk::pipe::argdoc::about_topics] *] + dict set overrides topic -choicerestricted 1 + dict set overrides topic -default [punk::pipe::argdoc::default_topics] ;#if -default is present 'topic' will always appear in parsed 'values' dict + set newdef [punk::args::resolved_def -antiglobs -package_about_namespace -override $overrides ::punk::args::package::standard_about *] + lappend PUNKARGS [list $newdef] + proc about {args} { + package require punk::args + #standard_about accepts additional choices for topic - but we need to normalize any abbreviations to full topic name before passing on + set argd [punk::args::parse $args withid ::punk::pipe::about] + lassign [dict values $argd] _leaders opts values _received + punk::args::package::standard_about -package_about_namespace ::punk::pipe::argdoc {*}$opts {*}[dict get $values topic] + } +} +# end of sample 'about' function +# == === === === === === === === === === === === === === === + +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::pipe +} + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide punk::pipe [tcl::namespace::eval punk::pipe { + variable pkg punk::pipe + variable version + set version 1.0 +}] +return + +#*** !doctools +#[manpage_end] + diff --git a/src/bootsupport/modules/punk/repl/codethread-0.1.1.tm b/src/bootsupport/modules/punk/repl/codethread-0.1.1.tm index 6158fdce..feee9d87 100644 --- a/src/bootsupport/modules/punk/repl/codethread-0.1.1.tm +++ b/src/bootsupport/modules/punk/repl/codethread-0.1.1.tm @@ -114,6 +114,10 @@ tcl::namespace::eval punk::repl::codethread { variable output_stdout "" variable output_stderr "" + #review/test + catch {package require punk::ns} + catch {package rquire punk::repl} + #variable xyz #*** !doctools @@ -191,9 +195,14 @@ tcl::namespace::eval punk::repl::codethread { #shennanigans to keep compiled script around after call. #otherwise when $script goes out of scope - internal rep of vars set in script changes. #The shimmering may be no big deal(?) - but debug/analysis using tcl::unsupported::representation becomes impossible. - interp eval code [list ::punk::lib::set_clone ::codeinterp::clonescript $script] ;#like objclone + + #interp eval code [list ::punk::lib::set_clone ::codeinterp::clonescript $script] ;#like objclone + interp eval code [list ::codeinterp::set_clone ::codeinterp::clonescript $script] ;#like objclone + + interp eval code {lappend ::codeinterp::run_command_cache $::codeinterp::clonescript} + interp eval code { - lappend ::codeinterp::run_command_cache $::codeinterp::clonescript + #lappend ::codeinterp::run_command_cache $::codeinterp::clonescript if {[llength $::codeinterp::run_command_cache] > 2000} { set ::codeinterp::run_command_cache [lrange $::codeinterp::run_command_cache 1750 end][unset ::codeinterp::run_command_cache] } @@ -205,10 +214,19 @@ tcl::namespace::eval punk::repl::codethread { package require punk::ns punk::ns::nseval_ifexists $::punk::ns::ns_current $::codeinterp::clonescript } else { + if {![namespace exists $::punk::ns::ns_current]} { + namespace eval $::punk::ns::ns_current { + puts stderr "Created namespace: $::punk::ns::ns_current" + } + } tcl::namespace::inscope $::punk::ns::ns_current $::codeinterp::clonescript } } } result] + #temp test for subshell experimentation + #if {$status == 1} { + # puts stderr "--codethread::runscript error--------\n$::errorInfo" + #} flush stdout diff --git a/src/bootsupport/modules/punk/repo-0.1.1.tm b/src/bootsupport/modules/punk/repo-0.1.1.tm index 063a13c0..f53a06fd 100644 --- a/src/bootsupport/modules/punk/repo-0.1.1.tm +++ b/src/bootsupport/modules/punk/repo-0.1.1.tm @@ -107,14 +107,16 @@ namespace eval punk::repo { } - #lappend PUNKARGS [list -dynamic 1 { + #lappend PUNKARGS [list { + # @dynamic # @id -id ::punk::repo::fossil_proxy # @cmd -name fossil -help "fossil executable # " # @argdisplay -header "fossil help" -body {${[runout -n fossil help]}} # } ""] - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + @dynamic @id -id ::punk::repo::fossil_proxy @cmd -name fossil -help "fossil executable" ${[punk::repo::get_fossil_usage]} @@ -123,20 +125,24 @@ namespace eval punk::repo { #experiment - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + @dynamic @id -id "::punk::repo::fossil_proxy diff" @cmd -name "fossil diff" -help "fossil diff " @argdisplay -header "fossil help diff" -body {${[runout -n fossil help diff]}} } ""] - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + #todo - remove this comment - testing dynamic directive + @dynamic @id -id "::punk::repo::fossil_proxy add" @cmd -name "fossil add" -help "fossil add " @argdisplay -header "fossil help add" -body {${[runout -n fossil help add]}} } ""] #TODO - #lappend PUNKARGS [list -dynamic 1 { + #lappend PUNKARGS [list { + # @dynamic # @id -glob 1 -id "::punk::repo::fossil_proxy *" -aliases {fs} # @cmd -name "fossil add" -help "fossil add # " @@ -1699,12 +1705,10 @@ namespace eval punk::repo::lib { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -if {![info exists ::punk::args::register::NAMESPACES]} { - namespace eval ::punk::args::register { - set ::punk::args::register::NAMESPACES [list] ;#use fully qualified so 8.6 doesn't find existing var in global namespace - } +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::repo } -lappend ::punk::args::register::NAMESPACES ::punk::repo # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ diff --git a/src/bootsupport/modules/punk/zip-0.1.1.tm b/src/bootsupport/modules/punk/zip-0.1.1.tm index 2895b024..99bc359d 100644 --- a/src/bootsupport/modules/punk/zip-0.1.1.tm +++ b/src/bootsupport/modules/punk/zip-0.1.1.tm @@ -194,6 +194,12 @@ tcl::namespace::eval punk::zip { Defaults to the value of base. If empty string is given to -resultrelative the paths returned are effectively absolute paths." + -emptydirs -default 0 -type boolean -help\ + "Whether to include directory trees in the result which had no + matches for the given fileglobs. + Intermediate dirs are always returned if there is a match with + fileglobs further down even if -emptdirs is 0. + " -excludes -default "" -help "list of glob expressions to match against files and exclude" -subpath -default "" -help\ "May contain glob chars for folder elements" @@ -205,6 +211,7 @@ tcl::namespace::eval punk::zip { set fileglobs [dict get $argd values fileglobs] set subpath [dict get $argd opts -subpath] set excludes [dict get $argd opts -excludes] + set emptydirs [dict get $argd opts -emptydirs] set received [dict get $argd received] @@ -242,13 +249,32 @@ tcl::namespace::eval punk::zip { if {!$excluded} {lappend result [file join $prefix $file]} } foreach dir [glob -nocomplain -tails -types d -directory $base -- [file join $subpath *]] { - set subdir_entries [walk -subpath $dir -excludes $excludes $base {*}$fileglobs] - if {[llength $subdir_entries]>0} { - #NOTE: trailing slash required for entries to be recognised as 'file type' = "directory" - #This is true for 2024 Tcl9 mounted zipfs at least. zip utilities such as 7zip seem(icon correct) to recognize dirs with or without trailing slash - #Although there are attributes on some systems to specify if entry is a directory - it appears trailing slash should always be used for folder names. - set result [list {*}$result "[file join $prefix $dir]/" {*}$subdir_entries] + set submatches [walk -subpath $dir -emptydirs $emptydirs -excludes $excludes $base {*}$fileglobs] + set subdir_entries [list] + set thisdir_match [list] + set has_file 0 + foreach sd $submatches { + set fullpath [file join $prefix $sd] ;#file join destroys trailing slash + if {[string index $sd end] eq "/"} { + lappend subdir_entries $fullpath/ + } else { + set has_file 1 + lappend subdir_entries $fullpath + } + } + if {$emptydirs} { + set thisdir_match [list "[file join $prefix $dir]/"] + } else { + if {$has_file} { + set thisdir_match [list "[file join $prefix $dir]/"] + } else { + set subdir_entries [list] + } } + #NOTE: trailing slash required for entries to be recognised as 'file type' = "directory" + #This is true for 2024 Tcl9 mounted zipfs at least. zip utilities such as 7zip seem(icon correct) to recognize dirs with or without trailing slash + #Although there are attributes on some systems to specify if entry is a directory - it appears trailing slash should always be used for folder names. + set result [list {*}$result {*}$thisdir_match {*}$subdir_entries] } return $result } diff --git a/src/bootsupport/modules/punkcheck-0.1.0.tm b/src/bootsupport/modules/punkcheck-0.1.0.tm index 3b4217df..db8a3db5 100644 --- a/src/bootsupport/modules/punkcheck-0.1.0.tm +++ b/src/bootsupport/modules/punkcheck-0.1.0.tm @@ -1170,6 +1170,7 @@ namespace eval punkcheck { } #skip writing punkcheck during checksum/timestamp checks + #todo - punk::args - fetch from punkcheck::install (with overrides) proc install_tm_files {srcdir basedir args} { set defaults [list\ -glob *.tm\ @@ -1209,13 +1210,71 @@ namespace eval punkcheck { return [lindex $args end] } } + lappend PUNKARGS [list { + @id -id ::punkcheck::install + @cmd -name ::punkcheck::install -help\ + "Unidirectional file transfer to possibly non-empty target folder." + @leaders -min 2 -max 2 + srcdir -type directory + tgtdir -type directory + -call-depth-internal -type integer -default 0 -help "(internal recursion tracker)" + -subdirlist -type list -default "" -help "(primarily internal - length generally matching -call-depth-internal)" + -max_depth -type integer -default 1000 -help\ + "Deepest subdirectory - use -1 for no limit." + -createdir -type boolean -default 0 -help\ + "Whether to create the folder at tgtdir. + Any required subdirectories are created regardless of this setting." + -createempty -type boolean -default 0 -help\ + "Whether to create folders at target that had no matches for our glob" + -glob -type string -default "*" -help\ + "Pattern matching for source file(s) to copy. Can be glob based or exact match." + -antiglob_file_core -default {${[::punkcheck::default_antiglob_file_core]}} + -antiglob_file -default "" + -antiglob_dir_core -default {${[::punkcheck::default_antiglob_dir_core]}} + -antiglob_dir -default "" + -antiglob_paths -default {} + -overwrite -default no-targets\ + -choices {no-targets newer-targets older-targets all-targets installedsourcechanged-targets synced-targets}\ + -choicecolumns 1\ + -choicelabels { + no-targets "only copy files that are missing at the target" + newer-targets "copy files with older source timestamp over newer + target timestamp and those missing at the target + (a form of 'restore' operation)" + older-targets "copy files with newer source timestamp over older + target timestamp and those missing at the target" + all-targets "copy regardless of timestamp at target" + installedsourcechanged-targets "copy if the target doesn't exist or the source changed" + synced-targets "copy if the target doesn't exist or the source changed + and the target cksum is the same as the last INSTALL-RECORD -targets_cksums entry" + } + -source_checksum -default comparestore -choicecolumns 3 -choices {compare store comparestore false true}\ + -choicelabels { + true "same as comparestore" + } + -punkcheck_folder -default target -choices {target source project} -choicerestricted 0 -help\ + "The location of the .punkcheck file to track installations and checksums. + The default value 'target' is generally recommended. + Can also be an absolute path to a folder." + -punkcheck_records -default "" -help\ + "Empty string or a parsed TDL records structure. + e.g + {tag FILEINFO - ... body { + {tag INSTALL-RECORD - ... body {}} + ... + }... + }" + -installer -default "punkcheck::install" -help\ + "A user nominated string that is stored in the .punkcheck file + This might be the name of a script or installation process." + }] ## unidirectional file transfer to possibly non empty folder #default of -overwrite no-targets will only copy files that are missing at the target # -overwrite newer-targets will copy files with older source timestamp over newer target timestamp and those missing at the target (a form of 'restore' operation) # -overwrite older-targets will copy files with newer source timestamp over older target timestamp and those missing at the target # -overwrite all-targets will copy regardless of timestamp at target # -overwrite installedsourcechanged-targets will copy if the target doesn't exist or the source changed - # -overwrite synced-targets will copy if the target doesn't exist or the source changed and the target cksum is the same as the last INSTALL-RECORD targets_cksums entry + # -overwrite synced-targets will copy if the target doesn't exist or the source changed and the target cksum is the same as the last INSTALL-RECORD -targets_cksums entry # review - timestamps unreliable # - what about slightly mismatched system clocks and mounted filesystems? caller responsibility to verify first? # if timestamp exactly equal - should we check content-hash? This is presumably only likely to occur deliberately(maliciously?) @@ -1243,6 +1302,7 @@ namespace eval punkcheck { -max_depth 1000\ -subdirlist {}\ -createdir 0\ + -createempty 0\ -glob *\ -antiglob_file_core "\uFFFF"\ -antiglob_file "" \ @@ -1271,13 +1331,14 @@ namespace eval punkcheck { #(as opposed to a more 'standard' mechanism of adjusting srcdir & tgtdir as we move down the tree) #It comes from build_modules_from_source_to_base where we need to keep track of position relative to our targetdir starting point to handle submodules e.g pkg::something::mypkg-0.1.tm #It could have been handled with some other parameter such as -depth, but this -subdirlist mechanism, whilst perhaps not beautiful, is straightforward enough - #and may be less error prone than doing slightly more opaue path manipulations at each recursion level to determine where we started + #and may be less error prone than doing slightly more opaque path manipulations at each recursion level to determine where we started #For consistency - we'll use the same mechanism in various recursive directory walking procedures such as this one. - set CALLDEPTH [dict get $opts -call-depth-internal] ;#added for extra debug/sanity checking - clearer test for initial function call ie CALLDPEPTH = 0 + set CALLDEPTH [dict get $opts -call-depth-internal] ;#added for extra debug/sanity checking - clearer test for initial function call ie CALLDEPTH = 0 set max_depth [dict get $opts -max_depth] ;# -1 for no limit set subdirlist [dict get $opts -subdirlist] ;# generally should be same length as CALLDEPTH - but user could prefill set fileglob [dict get $opts -glob] set createdir [dict get $opts -createdir] ;#defaults to zero to help avoid mistakes with initial target dir - required target subdirs are created regardless of this setting + set opt_createempty [dict get $opts -createempty] if {$CALLDEPTH == 0} { #expensive to normalize but we need to do it at least once @@ -1285,6 +1346,13 @@ namespace eval punkcheck { set tgtdir [file normalize $tgtdir] if {$createdir} { file mkdir $tgtdir + } else { + if {![file exists $tgtdir]} { + error "punkcheck::install base target dir:'$tgtdir' doesn't exist (srcdir:$srcdir tgtdir:$tgtdir args:'$args')" + } + } + if {([file type $srcdir] ni [list directory]) || ([file type $tgtdir] ni [list directory])} { + error "punkcheck::install requires source and target dirs to be of type 'directory' type current source: [file type $srcdir] type current target: [file type $tgtdir]" } #now the values we build from these will be properly cased } @@ -1450,13 +1518,7 @@ namespace eval punkcheck { if {![file exists $current_source_dir]} { - error "copy_files_from_source_to_target current source dir:'$current_source_dir' doesn't exist (srcdir:$srcdir tgtdir:$tgtdir args:'$args')" - } - if {![file exists $current_target_dir]} { - error "copy_files_from_source_to_target current target dir:'$current_target_dir' doesn't exist (srcdir:$srcdir tgtdir:$tgtdir args:'$args')" - } - if {([file type $current_source_dir] ni [list directory]) || ([file type $current_target_dir] ni [list directory])} { - error "copy_files_from_source_to_target requires source and target dirs to be of type 'directory' type current source: [file type $current_source_dir] type current target: [file type $current_target_dir]" + error "punkcheck::install current source dir:'$current_source_dir' doesn't exist (srcdir:$srcdir tgtdir:$tgtdir args:'$args')" } set files_copied [list] @@ -1500,7 +1562,13 @@ namespace eval punkcheck { # SOURCE -type file -path ../src/modules/jjjetc-999999.0a1.0.tm -cksum b646fc2ee88cbd068d2e946fe929b7aea96bd39d -cksum_all_opts {-cksum_content 1 -cksum_meta 0 -cksum_acls 0 -cksum_usetar 0 -cksum_algorithm sha1} -changed 0 -metadata_us 3338 # } #} - + + if {[llength $match_list]} { + #example - target dir has a file where there is a directory at the source + if {[file exists $current_target_dir] && ([file type $current_target_dir] ni [list directory])} { + error "punkcheck::install target subfolder $current_target_dir exists but is not of type 'directory'. Type current target folder: [file type $current_target_dir]" + } + } #proc get_relativecksum_from_base_and_fullpath {base fullpath args} @@ -1579,10 +1647,12 @@ namespace eval punkcheck { set is_skip 0 if {$overwrite_what eq "all-targets"} { + file mkdir $current_target_dir file copy -force $current_source_dir/$m $current_target_dir lappend files_copied $current_source_dir/$m } else { if {![file exists $current_target_dir/$m]} { + file mkdir $current_target_dir file copy $current_source_dir/$m $current_target_dir set new_tgt_cksum_info [punk::mix::base::lib::cksum_path $current_target_dir/$m] lappend files_copied $current_source_dir/$m @@ -1592,6 +1662,7 @@ namespace eval punkcheck { installedsourcechanged-targets { if {[llength $changed]} { #An unrecorded installation is considered a source change (from unknown/unrecorded source to recorded) + file mkdir $current_target_dir file copy -force $current_source_dir/$m $current_target_dir set new_tgt_cksum_info [punk::mix::base::lib::cksum_path $current_target_dir/$m] lappend files_copied $current_source_dir/$m @@ -1619,6 +1690,7 @@ namespace eval punkcheck { set target_cksum_compare "norecord" } if {$is_target_unmodified_since_install} { + file mkdir $current_target_dir file copy -force $current_source_dir/$m $current_target_dir set new_tgt_cksum_info [punk::mix::base::lib::cksum_path $current_target_dir/$m] lappend files_copied $current_source_dir/$m @@ -1642,6 +1714,12 @@ namespace eval punkcheck { } } } + #target dir was created as necessary if files matched above + #now ensure target dir exists if -createempty true + if {$opt_createempty && ![file exists $current_target_dir]} { + file mkdir $current_target_dir + } + set ts_now [clock microseconds] @@ -1724,10 +1802,9 @@ namespace eval punkcheck { continue } - - if {![file exists $current_target_dir/$d]} { - file mkdir $current_target_dir/$d - } + #if {![file exists $current_target_dir/$d]} { + # file mkdir $current_target_dir/$d + #} set sub_opts_1 [list\ @@ -2096,8 +2173,10 @@ namespace eval punkcheck { - - +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punkcheck +} diff --git a/src/bootsupport/modules/punkcheck/cli-0.1.0.tm b/src/bootsupport/modules/punkcheck/cli-0.1.0.tm index 609df5c3..bbf882a0 100644 --- a/src/bootsupport/modules/punkcheck/cli-0.1.0.tm +++ b/src/bootsupport/modules/punkcheck/cli-0.1.0.tm @@ -64,6 +64,8 @@ namespace eval punkcheck::cli { #vfs can mask mounted files - so we can't just use 'file type' or glob with -type f ##set files [glob -nocomplain -dir $fullpath -type f *] package require punk::nav::fs + + #TODO - get all files in tree!!! set folderinfo [punk::nav::fs::dirfiles_dict $fullpath] set files [concat [dict get $folderinfo files] [dict get $folderinfo underlayfiles]] } diff --git a/src/bootsupport/modules/shellfilter-0.1.9.tm b/src/bootsupport/modules/shellfilter-0.1.9.tm index 25ba28b1..d70d657c 100644 --- a/src/bootsupport/modules/shellfilter-0.1.9.tm +++ b/src/bootsupport/modules/shellfilter-0.1.9.tm @@ -751,6 +751,12 @@ namespace eval shellfilter::chan { } else { + #REVIEW - this holding a buffer without emitting as we go is ugly. + # - we may do better to detect and retain the opener, then use that opener to avoid false splits within the sequence. + # - we'd then need to detect the appropriate close to restart splitting and codestacking + # - we may still need to retain and append the data to the opener (in some cases?) - which is a slight memory issue - but at least we would emit everything immediately. + + #puts "-->esc but no detect" #no complete ansi codes - but at least one esc is present if {[string last \x1b $buf] == [llength $buf]-1} { @@ -1118,8 +1124,8 @@ namespace eval shellfilter::stack { proc status {{pipename *} args} { variable pipelines set pipecount [dict size $pipelines] - set tableprefix "$pipecount pipelines active\n" - set t [textblock::class::table new $tableprefix] + set tabletitle "$pipecount pipelines active" + set t [textblock::class::table new $tabletitle] $t add_column -headers [list channel-ident] $t add_column -headers [list device-info localchan] $t configure_column 1 -header_colspans {3} @@ -1402,7 +1408,8 @@ namespace eval shellfilter::stack { } dict set pipelines $pipename stack $stack } - show_pipeline $pipename -note "after_remove $remove_id" + #JMNJMN 2025 review! + #show_pipeline $pipename -note "after_remove $remove_id" return 1 } @@ -1607,7 +1614,9 @@ namespace eval shellfilter::stack { #puts stdout "==" #puts stdout "==>stack: $stack" #puts stdout "==" - show_pipeline $pipename -note "after_add $transformname $args" + + #JMNJMN + #show_pipeline $pipename -note "after_add $transformname $args" return $id } proc show_pipeline {pipename args} { diff --git a/src/bootsupport/modules/textblock-0.1.3.tm b/src/bootsupport/modules/textblock-0.1.3.tm index 56651d21..8d66978f 100644 --- a/src/bootsupport/modules/textblock-0.1.3.tm +++ b/src/bootsupport/modules/textblock-0.1.3.tm @@ -62,14 +62,16 @@ catch {package require patternpunk} package require overtype #safebase interps as at 2024-08 can't access deeper paths - even though they are below the supposed safe list. -if {[catch { - package require term::ansi::code::macros ;#required for frame if old ansi g0 used - review - make package optional? -} errM]} { - #catch this too in case stderr not available - catch { - puts stderr "textblock package failed to load term::ansi::code::macros with error: $errM" - } -} +#2025 - required term::ansi features for altg now built in to textblock +#the deeper paths issue is still a potential issue for some packages - review +#if {[catch { +# package require term::ansi::code::macros ;#required for frame if old ansi g0 used - review - make package optional? +#} errM]} { +# #catch this too in case stderr not available +# catch { +# puts stderr "textblock package failed to load term::ansi::code::macros with error: $errM" +# } +#} package require textutil @@ -139,7 +141,8 @@ tcl::namespace::eval textblock { # hash_algorithm -optional 1 -choices {${[::textblock::argdoc::hash_algorithm_choices]}} -help\ # "algorithm choice" - punk::args::define -dynamic 1 { + punk::args::define { + @dynamic @id -id ::textblock::use_hash @cmd -name "textblock::use_hash" -help\ "Hashing algorithm to use for framecache lookup. @@ -4068,12 +4071,12 @@ tcl::namespace::eval textblock { return $frametypes } - tcl::namespace::eval cd { - #todo - save and restore existing tcl::namespace::export in case macros::cd has default exports in future - tcl::namespace::eval ::term::ansi::code::macros::cd {tcl::namespace::export *} - tcl::namespace::import ::term::ansi::code::macros::cd::* - tcl::namespace::eval ::term::ansi::code::macros::cd {tcl::namespace::export -clear} - } + #tcl::namespace::eval cd { + # #todo - save and restore existing tcl::namespace::export in case macros::cd has default exports in future + # tcl::namespace::eval ::term::ansi::code::macros::cd {tcl::namespace::export *} + # tcl::namespace::import ::term::ansi::code::macros::cd::* + # tcl::namespace::eval ::term::ansi::code::macros::cd {tcl::namespace::export -clear} + #} proc spantest {} { set t [list_as_table -columns 5 -return tableobject {a b c d e aa bb cc dd ee X Y}] $t configure_column 0 -headers [list span3 "1-span4\n2-span4 second line" span5/5 "span-all etc blah 123 hmmmmm" span2] @@ -5071,7 +5074,7 @@ tcl::namespace::eval textblock { #only call width functions if known_samewidth - otherwise let the pad algorithm below determine it as we go if {$known_samewidth ne "" && $known_samewidth} { if {$known_blockwidth eq ""} { - set datawidth [textblock::widthtopline $block + set datawidth [textblock::widthtopline $block] } else { set datawidth $known_blockwidth } @@ -6214,16 +6217,22 @@ tcl::namespace::eval textblock { switch -- $f { "altg" { #old style ansi escape sequences with alternate graphics page G0 - set hl [cd::hl] + #set hl [cd::hl] + set hl [punk::ansi::g0 q] set hlt $hl set hlb $hl - set vl [cd::vl] + #set vl [cd::vl] + set vl [punk::ansi::g0 x] set vll $vl set vlr $vl - set tlc [cd::tlc] - set trc [cd::trc] - set blc [cd::blc] - set brc [cd::brc] + #set tlc [cd::tlc] + set tlc [punk::ansi::g0 l] + #set trc [cd::trc] + set trc [punk::ansi::g0 k] + #set blc [cd::blc] + set blc [punk::ansi::g0 m] + #set brc [cd::brc] + set brc [punk::ansi::g0 j] #horizontal and vertical bar joins set hltj $hlt @@ -7417,13 +7426,15 @@ tcl::namespace::eval textblock { set blc \U1fb7c ;#legacy block set brc \U1fb7f ;#legacy block - if {[punk::console::check::has_bug_legacysymbolwidth]} { - #rather than totally fail on some mixed layout that happens to use block2 - just degrade it - but prevent alignment problems - set sp \u00a0 ;#non breaking space (plain space may act transparent in some use cases) - set tlc $sp - set trc $sp - set blc $sp - set brc $sp + if {(![interp issafe])} { + if {![catch {punk::console::check::has_bug_legacysymbolwidth} symbug] && $symbug} { + #rather than totally fail on some mixed layout that happens to use block2 - just degrade it - but prevent alignment problems + set sp \u00a0 ;#non breaking space (plain space may act transparent in some use cases) + set tlc $sp + set trc $sp + set blc $sp + set brc $sp + } } #horizontal and vertical bar joins @@ -7555,12 +7566,12 @@ tcl::namespace::eval textblock { @cmd -name textblock::frame_cache -help\ "Display or clear the frame cache." -pretty -default 1 -help\ - "Uses 'pdict textblock::frame_cache */*' for prettier output - Either way this is set, output requires long lines and may - still wrap in an ugly manner. Try 'textblock::use_cache md5' - to shorten the argument display and reduce wrapping. + "Uses 'pdict textblock::frame_cache */*' for prettier output + Either way this is set, output requires long lines and may + still wrap in an ugly manner. Try 'textblock::use_cache md5' + to shorten the argument display and reduce wrapping. " - @values -min 0 -max 1 + @values -min 0 -max -1 action -default {display} -choices {clear size info display} -choicelabels { clear "Clear the textblock::frame_cache dictionary." } -help "Perform an action on the frame cache." @@ -7569,6 +7580,8 @@ tcl::namespace::eval textblock { set argd [punk::args::get_by_id ::textblock::frame_cache $args] set action [dict get $argd values action] variable frame_cache + set all_values_dict [dict get $argd values] + set action_values [lrange [dict values $all_values_dict] 1 end] switch -- $action { clear { set size [dict size $frame_cache] @@ -7589,8 +7602,65 @@ tcl::namespace::eval textblock { error "frame_cache -action '$action' not understood. Valid actions: clear size info display" } } + if {[llength $action_values]} { + return [frame_cache_display -pretty [dict get $argd opts -pretty] {*}$action_values] + } else { + return [frame_cache_display -pretty [dict get $argd opts -pretty]] + } + } + punk::args::define { + @dynamic + @id -id ::textblock::frame_cache_display + @opts + ${[::punk::args::resolved_def -types opts ::textblock::frame_cache -pretty]} + @values -min 0 -max 2 + startindex -default "" -type indexexpression -help\ + "If both startindex and endindex are missing/empty, it is treated as + startindex 0 endindex end. (ie displays all records) + If only startindex has a value - the frame_cache record at that + index will be displayed" + endindex -default "" -type indexexpression + } + proc frame_cache_display {args} { + set argd [punk::args::get_by_id ::textblock::frame_cache_display $args] + variable frame_cache + lassign [dict values [dict get $argd values]] startidx endidx + set limit "" + if {$startidx ne ""} { + if {$endidx ne ""} { + if {$startidx eq $endidx} { + set limit "index" + } else { + set limit "range" + } + } else { + set limit "index" + } + } else { + set limit "all" + } + + set display_dict {} + switch -- $limit { + all { + set display_dict $frame_cache + } + index { + set k [lindex [dict keys $frame_cache] $startidx] + if {$k ne ""} { + set display_dict [dict create $k [dict get $frame_cache $k]] + } + } + range { + set keys [lrange [dict keys $frame_cache] $startidx $endidx] + foreach k $keys { + dict set display_dict $k [dict get $frame_cache $k] + } + } + } + if {[dict get $argd opts -pretty]} { - set out [pdict -chan none frame_cache */*] + set out [pdict -chan none display_dict */*] } else { set out "" if {[catch { @@ -7599,7 +7669,7 @@ tcl::namespace::eval textblock { set termwidth 80 } - tcl::dict::for {k v} $frame_cache { + tcl::dict::for {k v} $display_dict { lassign $v _f frame _used used set fwidth [textblock::widthtopline $frame] #review - are cached frames uniform width lines? @@ -7651,7 +7721,8 @@ tcl::namespace::eval textblock { # ${[textblock::frame_samples]} #todo punk::args alias for centre center etc? - punk::args::define -dynamic 1 { + punk::args::define { + @dynamic @id -id ::textblock::frame @cmd -name "textblock::frame"\ -help "Frame a block of text with a border." @@ -8208,9 +8279,11 @@ tcl::namespace::eval textblock { } altg { set tbar [tcl::string::repeat $hlt $frame_inner_width] - set tbar [cd::groptim $tbar] + #set tbar [cd::groptim $tbar] + set tbar [punk::ansi::groptim $tbar] set bbar [tcl::string::repeat $hlb $frame_inner_width] - set bbar [cd::groptim $bbar] + #set bbar [cd::groptim $bbar] + set bbar [punk::ansi::groptim $bbar] } default { set tbar [tcl::string::repeat $hlt $frame_inner_width] diff --git a/src/bootsupport/modules/tomlish-1.1.1.tm b/src/bootsupport/modules/tomlish-1.1.1.tm index 3e13e75d..0c8d0b1a 100644 --- a/src/bootsupport/modules/tomlish-1.1.1.tm +++ b/src/bootsupport/modules/tomlish-1.1.1.tm @@ -716,6 +716,7 @@ namespace eval tomlish { set toml [::tomlish::to_toml $tomlish] } + #TODO use huddle? proc from_json {json} { set jstruct [::tomlish::json_struct $json] return [::tomlish::from_json_struct $jstruct] @@ -1080,11 +1081,13 @@ namespace eval tomlish::decode { # For this reason, we also do absolutely no line-ending transformations based on platform. # All line-endings are maintained as is, and even a file with mixed cr crlf line-endings will be correctly interpreted and can be 'roundtripped' - proc toml {s} { + proc toml {args} { #*** !doctools - #[call [fun toml] [arg s]] + #[call [fun toml] [arg arg...]] #[para] return a Tcl list of tomlish tokens + set s [join $args \n] + namespace upvar ::tomlish::parse is_parsing is_parsing set is_parsing 1 @@ -2380,7 +2383,7 @@ namespace eval tomlish::parse { squotedkey {PUSHSPACE "itable-keyval-space" state "itable-keyval-syntax"}\ endinlinetable "POPSPACE"\ startquote "quoted-key"\ - startsquote {TOSTATE "squoted-key" comment "jn-ok"}\ + startsquote {TOSTATE "squoted-key" comment "jn-testing"}\ comma "itable-space"\ comment "err-state"\ eof "err-state"\ diff --git a/src/bootsupport/modules_tcl8/include_modules.config b/src/bootsupport/modules_tcl8/include_modules.config index 59e31647..aca4c02e 100644 --- a/src/bootsupport/modules_tcl8/include_modules.config +++ b/src/bootsupport/modules_tcl8/include_modules.config @@ -5,5 +5,6 @@ #each entry - base module set bootsupport_modules [list\ modules_tcl8 thread\ + modules_tcl8/thread/platform *\ ] diff --git a/src/bootsupport/modules_tcl8/win32_x86_64_tcl8-2.8.9.tm b/src/bootsupport/modules_tcl8/win32_x86_64_tcl8-2.8.9.tm new file mode 100644 index 0000000000000000000000000000000000000000..d50bcf4a035fbd54b899346d25894ee08a9b2cd4 GIT binary patch literal 79939 zcmce+1yqz>+cr#xl#+tP&|T8qQUcOQ4=^-C4BgTpAs`{$CEXz)-6s$Y|T#j??z0ZB-aUOe*cL0BTs6DM50OnSo)D~cC4>SWg z0UVq_4j`}@$c*jI-{u3TEkIz96VMrC25^B`fh_=b_GS+DW`crtKpT(|RGQI`7r!jB zG6#6+nF5_nEdgG)n}O|}?0~jbo*;mp71-P!05Ns4a&R{Afk}f+fd0$t7YQ&GKu%8f zP5`PO@&Pc#AfxdG9I$N><7#!>&5G&Xm z2+$k^umVG8IRKnM5N9VVQ)erCFhq=z>X%J@e)$G7g65}w0FWbqiVEQE4WQJ!H3;Nx z1#yM|{uuv%uRj&w7iE4`4FYn8*=lCx1o)v2^j~109q2E8ep&o;x)Bg;X5CoRALJ&1#?mGkYaKZUUx{B--R0H}Bf)V05?zRiaJ z^cqxScIqFYWrcb14|%`!B*fmu$@GVH|F(|(??Tv|?S9d~2LQ5#fPRx=)c?pGm`5NE zKxf0xs+ zski>HwFQAKpcP0XVE_;j0dPPkJAs^CoWKAtpI?IwTLOE2T_*W|y-XCK_qWaeO-a~} zu)KlR3slE{m5{+6fggta^zSV?{VZ;n(BG!xA1h#=w$QYI!sZV@x&PKi*tFjp^82?x z^We8W`{xRn`L?D&2*}9U4pwAF5Rio(2n+=$Js8qK5!>0`*52*Uvj3}up`~PC@DGju zk_W9yD4N2+6aq8hpYohdZ3P9L?F0pFpo zwoX8>1+?w`U3;kgFyH^J4*z2h05qcv07BF*P|$*b4#>&b)&mMf5NH>M$^S>tU{=E( z6KG-B{C4!8iSy4lzxa*j7eoHF4q%Zocd@mFLZ%H6W~jBj6|_;9+Jm9}AMmS?+r|M+ zDVSsffS@4EMA%xuZ5y&Thc@mXLVyq`*?`&#mGs9eCy=9yl@sW_0qytBn_v&##IYz*-MArA265yrvqSp=%4uHKA zj1QVx!V(vnZ}tEaXd8smC1{buhHr_ZD@-g@x}c!aZF2-UoBl&7n6=a(pc6E8f6@Yo zAdJSrmi}0EtCs^bVVq&_VOj8dAyDE8ZO9Kf9&)jA2nYgx74mcCk1l;H?Ds;Cvx5R?!0p(c`2PK;g8o_LKV1!Qg8=~aoZ#f_0=}hNP&YzD=U{g06V{*9>_#uhFh2n4_YbaJ*b2SP&y1w|mNjlv2O%B!J~|6A@ta|Yr90*L)S zt$wHtRouY^N(QL@i~4`X^uK!GeNC3<^7cii(QllD?k_)7EyrkU-cjg zFo(7|=y6&fYywTipC$?ZZtdR}{S*XoF*OB&pr>(tC^o@p)=%8Lo%&b4{Z)>DKh68~ zO#6pl|Ni-lX;Ls`hXKBegM|~&?3OS>Zv~v7b!`PjKPdb|)9wf8n_Ia<6Yy3OSRw!S zjs8h5{!roHM}EZg?-~BjF#h(`_@Af0|1rY9xZno|xV>F~MfZn~p=keqx%tn)LnHUY zRk!k>txxZ7Uk(1d^L_yv7w`{_exuKSt&pGhCx2a(m_r-XZJPXX*oK~yVH^uuBDc3N zw+-tDeF4z?jnw_SuD=hZ&+k!y8j3|fT>T5(0zh0$pmZ2|YPN@#KG4<;)=puq5Jonj z+BsW-p!jZT32U~{GdcAB0d^+;!AV>}U@Pb}D4@ci6$+TJ)(AU|xqyExg+>w9iht{; zpSKGCmr?$Q$p6X`sm+15wkA+|3o9rX_(Kcs4-WMYNw7kpR+eM~XhZ46Eo(7_@_K0Z zgt_9D1=xYiVD}IJsNWy}RsalOU}Hb>1j=NfoEpXqAiod9Kg$f30Z>_g!O4FuAlUjp zkoQ0M`JYDpFX8@{pg=4DRDWeD>^|~OF@I76sM~&6_eXw0KmSPMf6q^tCx0H$?V!6r zOOi_7{4e29&IKhHu27u5y-Q^M>BQShL|Bsj@FX_^`)!WGy!&6X9yS5?+@6ul z0D6C9{2%=P4=rxh`8EIkbwilE|3w1-ziAV&&Hhqa^Cu9~nE!y$Uo`%&3d7|5{{Y9Z zZGI2Q|332j`Tud_3Juf`*8jh9>pxua>mI*;gZ(1m@JGT!6BLS#e_a)lJW)hM!iR%{ zLxV%&rP0pNCRPf?hlf+$Lx5w2LxuaJoj^}sTn~-h`FV|axs9N7iJ$c$8$X)>yR#(} zH_aaM3$U5l+TPqC!ok5K?7s2x*4RAcXroWXio|uhN2Qwmx_K@uCp_+zoSNGJ%IF|U zE=pJg0rEY3+F*mIJMhgW)etE{RS9Joll8k{Y`Mu zzNe;a2{b4bU0sXre}6wz$m=!gQGPr;%*8b}EKJbAGq=l|%8GZbm~UH8z8GUoBqlYeJ_Xk(d9=2dt#7-j+djiwJTc^5R9(!^sNs4TvY;&S>_x!H zDPAgTJH@4|Y19k9&cn%lOkVKiRtM_k*0YMIyo<;_dmI(=Pv*N;TIy6=rZUdQ&I4G3 z{2m}JR<9JuUm&Gg`hsz7DQ-}cxeaLNjy&CO265lktMfzNFn4`>7qYs)5brI{|Bb~a zMgE|jxp0Y~4I?ys$^`=xj(8>nxc90&tp_6`hU3{jk+IkE;CcCL;HG6XhxX#rR&UQH zT`lnHe52*T8=T8GuS1>O#xkPXlW@A>F)TV$3z+wTd%^s>R_DGmQeIO}1$5(4MB8%6 zKkB(c2(HWNjE_$rojzd`Hmz^_IONeJu5!>~(K|fATR)@Jx>N+-d}PRzcJnB2se4vx zH(OtV^UC*J{;b{Sz~|m2*4HOrULjnt8ll~2Bc@Z4x_x_RPk99v%A`gt-w!7rBrsHL zFBEWWBgXXo^8CwY`AFgWLd!N{+cu(;C*@&L`*m&nMrXckmt=ENO(rw;m^-Ho-up3f zD^g7X0X7HU9+NgNj?R{O2`t`x|K_)uS!Cw6#4v}eE@;O)Yn(YEHfqEJ?mW}$-p&?Q zy~vZ)#aqPn&~POUkgO_b*2^sc37HhSBA*m(lXk60m*)FB1P@TVZi=;Q7j2n~)0Iq|T~_wm8;`MX zq;JSr%in(GZnG@BJMR_4V1X@h8B|UYs3qOh`_$q7#c-!6#9_(Av9#2elh=lf!j8M++oRK~ZwIo=a7JrS`O~_UPSPa~JJ8)#(b!2& zrjNspDnC~h)T)wL#Mg)9@xR`nnRh(Y(H}S%d#BxAH6Nhn^_Ec8T3y>u7H1OdeO9yc zmc0zBZ@wB_FUzd4p2yp3|5|oK>`sKoqRk6kT91v`T`+4)67p+5!Oe%t7Ww6%be5iw z4`!pftCET^29MWDzU+ORhW+*0>Ssv(+)KkZ)+UvzGil+m`O6aK_?AKi!M zi$C9qfrzjFM{(xh%yvQLy^dFXkCIEv#J~ZasUJh@)yK0iywW`Lc|~+^`kFI4Bq!8O zCai|E{bLw>kQff>KkSBQiy3>+K5#4V_9aOko0&Ae+On5U+%l5*kRU7Avt6PuE;K=) zgRJN`YOH?&kvfWNUEzVewVRT@9XKaUNm;r(aOW{1RaBy9A6mWRK|L5w z_U>66hMwjcRh#k&$~U7Bc)@-#z~H`M*=n}3ZN3{0f;&_2DW^Bq3?gF~P z8d|s9`wbNx5!F)yN-xK7YA5Qx6>7Fs|F0}_QZKVV-YH_-+n_0!O6pCSrIs!y+|0t` zUwr#)?m|$1kmZ#fAq(0`?3hkT@`A;|1J9|4JY^!ZeZD-{3LS}&e8Kea=nV6b=aXV@ z6j%%&e95iaChR`mHf^eRFbXg{@`tCmKT^g|;_>_e>ePqPUN??Py(Q$&YFM)H7XvYs zZKTfYu{D|-FHKs9N33H8dK!k_UGLhlwJC|(*H-K+IRO`g5qMbbkZp!?y0qMUB084M5+S+r>ps z?Mlhf*u%@OrrLdI_$Uf)`fjN;UcLmX?E1B7VF|Nm%?m~WHTE>!QzpK)r)@Ti`TsPIE>Cr=RR>oXG2k5tbms)qL^3 z6rDjYjlu-ZFFYotWqn?Y;f`84{f<|kI9U}hs;&UX2QQxoX~-Tfs@kzV!kvc@X?-jU zoJ1`)!9T%fYb`V_(TiRtS2n)AS)e=cn(LjybF=SnPOw^4A59o9SOY|$FlD0m4L!sdCZ$1tWO44kBd!^SsAQZdX zK?2*y-L{Na*Jc)kBhE7jnqv%5dYd>0Os@Z&qFHHL;DWf`_l6K9>-5G*gL_Ev z8vXjPS-I-Nxa7O~7h(ti*PuKsYjjKzPhAJr3j-7cp*1A?a(mMSFGlj77g925WzqZ-#bJa)#4at=pf9{^o&v<0}rS{U2BEnw+PRk?) zj#TDA&e5~7?&`#CmCwGhks&V0^Ss_G^NAs4h{^Bl&?GB;v}U61p-LLIL9>FNOggZE zsC}h4w}Ixi5qAHp2a>1)?QVKrm4;9q%jw&?07`^_MDq`63uvI}MLdnLLy96McAn!5 z>$S zuFvY{9Ci13y&z(btbWzFm6=U{#G=?|Y zVa5t#@|<3J!4u`8-la{2C*JysXNxHYwB{3^=pO1W^s`m^z{N6@DK2hqgDWN%EC;CE zy~sz{yU0bhn^k$PJS8@Kv7BW;Hr?PYw0N|2al&d;K18r-rOfF%r|DPRG1zaqEIyuL zo3^Z)6JQQ7l&+z-f|J5tbg)oq`tt$!DPmt2{yKA}W2&O@w?C(`2ScS!P1TY^5 zWTp3~tlRRO|^{DwJ&rf4(8M$lai=E~Iq_hJ!jzKN&NbQ`o`h6}m zZ$2g#|qXQT9zX_;S7^gi7O|GV8mpy_NAsMTKFZ^#|Qza9YP z?FLk8UlO0ZjC@ydp(Y8phLHw=gxAikcG*{pIE6D<7{Ry8YgR`(_R;1KJKPalUQqG4 zzQfjMEr>t62tEq0rf@$_JP6L=t`1XFc`2GOsPA(ngBg=tPAPDjgjT;H8t=4+^5EXZn`J? z2iWqNmJimB&~{ofnF?|b2OK1}gnwaTU-kps`}EUG$08&{8KEgg#$+J-FUzM!wm z`YdGbi3taClh7u@}a_?H8wv~D@wn)x=sBP5@hxI{_*^H55<{0k|#=@8C zM|eCUdFVl?0GB6-sYkN_j|l~e##NT~dxpsd zc2@x*#&c>8rm)ZiD=-S5#|Z&kvhV`MiA$iJ@V)dD`s7n=ACuEww(3$=L=i<-TV{mp z79ag(z(NVwxx5zC2y~F?Aj{p8JWHxx-=o@XHmZG7@`aS;g|6Cq0WFEe7j<9$B$4Y% z5l?YrpC08#6SvrtnQUL*xDBl8(X$xio9R=o;mls3Exf{LhilX^SFX4F!@U%)*7N65 z0bwSxHo{XpcoO0RnY)_-5fMk#sAxME*wq&Lvl0n1HqQ_qlgGcbaw)z4(E3Dt9quKc zogb12v2?v`+1kiEl#n~3Tw-dFc3Lvv%3jgU*WTcuDh`=+ETNM?B_emnxo_8cT}E`X z1I*1ki$Y<(KF@{jE%O`hMNKXX8p}WFjW8zZ%Q{Lt)ZN{4J2fW+7%$q|l3b9TrF3Y# za7st)dqI(gdeo6i?*Oqz&+M^&D9F;c=iDl!p-OQ_wMN=1pg$yb zsbf2*ilRn5jM<7F$E(w1z4qz1C7vEGkRW&sN!e{_>y_^qKCWIRh8@?|sgP0t&@7>G zHh{vrGw@oi-~5C8<+EY6g>P%~83$P0G4x+OHjX_uCWRv`$?d0RWsi%uYfd<_!^S}A zRVEkS&!67s`u^hFfftUfyOXgVw|{{}kNpYYm0r}9G}AH<>BhkO^qJj3?i|9YZ|&>f zoWO3p2jPxVsteIHv5+uVzS%XuySmulMHR&{JzN_*LY|Z}m(25Z2?=X8q0)vLo`eJO zC$qDO8p4h&3wI&8YhOv@eNeDxd$Lv*RCr~3!@|rkty1>Z#|OYHJ&Yqcf_0qJR2oj#hy_D=wGrwtzc?)S#LA8=YjQiS(e=W-YKb6F8S z?Y@_=${*X}jn;7*ohW^=0RMr3`qL5i__q-ms%>F^^SuK`r=rySOyap(pH^cP6(iP< zd>urkKFA`}EMdn_1MG5VJ4s(X#6p>!!3)%@B>AlO9M1BzU%g=+MXZTT{xd;{|LWss z^Zd>yix#pxmeG9di6zVxPeKYM#Y+cC?M3^g{H&&Tp1)+Rg@i5a>ddXf?JfJ8JOK3z@&)f9K^szl~8~5;dODW zXt_VFh!B!qZ(ob!XE?@+lLptcr#oQ?G-cTF^IlKD@TRIw;ZXs+6tR>3H@lA0?Xs?~ zY^Y?Jo}}n@?HyFAZ+5u~Y$T5qjIjb@ngX68jfT!LAAXR!+QN=Zn3kT}p&c6qRZkuA zu8Hp2oru#Nkb1)nWL+b>c03vOnhTl+j|KBRSbXebQdjY?*4j(IYTwdyuqvg5a+g1y zzR!xE@VVe?K9abbusuL1tXKY! zm~M+uk)fO_UcemkD63ni#GAMDa;G72aO-eTJqt6NXpIa=`1r$~{XF`a(xPW4=Tr$j zT>*uK+dBL9JQ9Ln<^9-+t8Lz@Z4-DUzrE9gr`LE&0nD!D9lKI)eo=Tptxwk8RUUp! zw8*XSq(zajMJEam4t1C2KWW1+T~f?h4d?IUbSVvgDY=oZbo_2#5x~mVpN+R?i`W$^ zN-qtLG1t?jq8Wn&!~2ANV$>~#mwS7lpP(DSO&SL&2?53&6d>>)_;&-W$!CfYk|D^0 z_p-R>m>%heoX)s@m#Qmw>qS2n+IO73c_h9LqPYZ^h}ZH+h3aLUHQI0vZjD>R=@c=X zn925Bv4a$+6f*fuOy2sdY=kCy6Ky?ss^DBDEt`}ZI**^vWUpG($hbi=ork>=4RN9r zpU^|nP40GR8f2!LqnF^jey7gR8Z_Sd9C^Z{oBe&-1OHX!I9{1==`5(^+x|v2TvwC* zOWoo_9(;w7@)yp`2WDtHCbDX|k*BOE2HwDeNK~AOaT}Z+XHNg&*W=_ufgpyk5K$!# zbcL1xHM~)Ohk{x>72hmO4jndD+zJ)jjU)WmDkyKweCZv+L1qyx*1lUT+OH$FgCUV0 zr7%579Z*FZ<_xUPru zwL1zgvd(%Tvbmi6+mKbFdTEc*hvJuHd#cg%g|=3OT5oVtDpQ{CaU^ViveNPhfFR+I zOyhi;Xd=(h^%yt_bU#=Rt*zJzt)=w1QztFNH(an4zhEthuydZro0s{{1f$XAMt2;$ zDzK;2;H!+S6gp$DRA`R0aahos(1)4P$9QA+h*rO&i8X{%T|7UKjt-g&2hXo$C_C$= zyyc=%f}p}rMwn(rw8_5-OCuj8Sl>V(rRY&{lx>QlK8@v`rdG&x0@83DJD9lu&|@Zd zg?MCM?d8XZIpK@Vu(AwEF=rjKMBnv)v5m_Vl)QF-eZmaOuV%!8~0DZ*#iBCq^s zl=KGM$#-4BZFxhT6*PSYV#q$9z#}oC=)ksEIt6VwZn-lOhbQYsG7ki91S6teoz142 zS&lw+e6nRE)m-b7o{P;FQzbJqVtP=N(l__exJzM_a~jZl2);&62#P$3Hyy=dJvjT$ zD99RF%DWyUP<)=LQ$!H7F)6age*%QC@iYazR4g6Jj|!2%-R$*!x0uzD|F~c;vr#Z` z_vV$bmpn?6g+$kB*kFHxm?u*gL8=r7+i}OrVCxQ{j2#MhGN~&0B85Zv_ndqR%xtM` zLl>!uOmRcyt$j0uJIdDyw&HneS|p@7!34Imb~5mS_HuSA;Hk6Ea@nmPkep+3jiq#i ziLRu2H|}s(kx0L!9o~5VsiZy9oqar0;Y2%H<{D*$PwSzi*(g5iQaIHYQ`tw36sB2f zN}^5Omc4Wz4OaU}B+KzcM_eSO2S-f{uwQ7Bp5$wfFU&?8Yr#Kj7jL5_uH|j;(D#vT zcCn^mlCZ|ljcKxbAwlXF9zpC`b!>WeUsMi-lsFXb#2x)!x162u%bbt#q1>`3VUv0aIF8C)aFW>sO9SyJn!r+{e~5vnK)a=md%df^q%w(~ z>x4Od;`#*WCEr+kzmWfBezm!H+R^?V6sAGD;T!I6JfZy3u2c4TE6 z7UxTP%pOLo*e@cCSzSt*is{+WHRq{pQvXq<^ZdeWMEM>o8D?-Vkhxq&3d!~P3XuWb zW9%+9(so2t$He%|G6t6dlB2Pn(eGZ_QsZR`YKpO6B+?n+9o{7~5SZWD~AeskV7v>_WX-ns{Pq-dj+rJ+GCM2a5fl*uyVPbbtH zJ~wiK@@{q$Z8roi4o=eZ5+f>*HuXOF-8p|wEfNCm-m}Se zp5C)n60J%h3(~eEw396_mjOhTjwv7_t=jkd=$R2*xYwBGiU$YnF%rrYYDFCsEto=m zYE>SYB2{0xlT0T!eLB*&COES34P{3+T<=l@Oh(_a;!&#)0a7*{*q-U%6S~*LQN`S4 zR#6d4fgnP1I+uv~F4r&mC~(=&M1yUY1gqJMEcWJ;%u5B|SJ!8`Mi$cT!(;E{g=ifvA5?%MPl}*@QnG$M^1O5h?h^Tx+rJ?W6l@323hZxle5Xvnwp+2=d{u^ z9(6A1&Jp@igAcWR3hWPEzbuKLj*H_&B!}SW?ibm$w-R3+GZbYS7<*p@b%0evrk|;{4j~i0Z!X@l?)J&{7aiq` z1z+xBe4zVuoGRYRX!YLuy;=&9u_mBBDIX)~k=R|$JVnoV1((Io@y?Y!2v zQ=+kss%>0&pA{=pC8Uc*`wAnZqUm9m-oPbct1L4{7YB?Qghjc~E&O&uA8rj=? z;xIjUd(j?+*awcjx#=z1%+bUY)Su>_?n)9SVf70bF(Ia~Z)vaz>epBz+o?{w38~^n zmzVR5+LNSnx9OsaeYU%^PfJgJzobB(rk0agXuj&}5smxbG386FFjo?0 zIi*KNs6Nh)w`6pqJl_NM`)uz0#fPu+L?zg>l^vu#%1hh0x)^G>B5$ryJPCL|uq?f@ zKxq>^s=B^oF`Yx~)tp(S(o?qx3Y-EcCnOaR*VBM-Bwnlktnl*hc<#Xz>=? z5N0NQS%h!Gz2~Fwc}Iw|NKclSPj;&qTpQR?B@mpco}04AaVbkKSFb#5=qGUIAP7V! ze63D>fAP^O#PdxJ5_X{8z}*;w?2M?&#!s!}z$*LiDL{#IT2&?C3_8F0aCz(&a}l-?k4WmH>?IP9h$O($-CK?-#cv2n&noVJz%1&kZY|QW>kTc zu78VT(zzij;k;Lu8NNa_o8y^E$I6PufP)4wN-s+G=FdyGc2r^_Pz$M08)QewC%Ws^ zxRa*drVj}>z+-!RY;ret9QCQ1#N9jcGC5QTct-1=^wu>#-vql{Oz_Hm&MYpwanyLP zm*%c^gHlIwL`dwas9OoW7~7e$y8djnbqH^Tb$)4A0oQX`;!>QTwt_5ZI_fL@zOp5w zC`Ub+65Ab{2}ejiGuu+$m~vfo(=$h%>* zq?jA4sI}?(A+sqPmC9Y6=PSZ~5bJF0Xv2i+Z?;7Re{yW2gUc-ACYI_OgmZNLf`nzV7!1YJ38nFXqCFPC*=^NMRyV+ZJf^`VezwFcbaRD!UPY9Snn?GD6Q>x zxKFS=4_B#uIIujIQSkBWLR!Jc;Kov=HMl+PVXQ28;KJF!;H>hw_FUSVZG1dt1TXJ> z9AW*-w8s%B4^b<(((?kJ9GKCRzcT7P*FuFwy1x(X15%ntsCi=2xRgd z_yX>!s3g3hfE*UCFGpnBu^L*ikuOe`o#j&KMZC9U^Ibaz_uPC9&u{G0zg!?&j%c@K zU7<^ksE~7JzGk*L)cm+6QKxsvIJ4HyNz`tq)UdWWv!*`Wqw?jm)+MgZp(Nz+iDJVV zw#^|63*J??!Vt(?X4l<;e?d3ZtwDWz=By zja9ys;i5!56%e&c_42m#gTc|L-C@mvb9^za<{sqI2Ri+L$o>9F9l3oh3x4oy8fKJr zV|xPliygL2cp~rH8rDm?;vvoZ=EO&d9rydqs%8dQN7OJ`&A;2Y&(}bOurmB~ z%v^qNxFMBfxtpXXcrw?^Gs2H}T?3U=K0mJA^jrz^#@)GPDWZ2#Xuy%>6rX@%2Y*wS z{?$9_c|Ms0dso?1B-N%dyyaPf0sPJH!pU0}d_t}d);Y;2KTwjQMDRRI*hN<&TrNh> zu=HYDYL^uQ34eR_WT4A9HDzutP?k|hN2Mi8>4 zb+nM1<7#{FXpF&X7gmmUWc){Tbqc!o!nAp3A`_aDCyL2Na;ILBlT50F>BWOoRs=2- zdyj)FK*ZdnKChJ)o+dm^!Mle3C>KH?ecgZ`J~>IiyDYWnl<`rgA)fCUx-KrIO?R;Q zCZo3?n+ffn4m~w+lxablW@y^PUuG~eolp>bwBU|@rtWE-6hmv6q)CN4RolIIf zP*e%7Fw^`h6S}akzLz28?IpZFbvVm+BlsZufLFCi0!@y!+%w1mUThz|ab<_>$we2( zE9Caifgk-Vi(7pSq+e=Dv`;m3FI8TTymt=)ucY1O<)eR?AM>i+8S~0=n@*MSFnk2H zM%t@5-U-dQ$fiOD+adQ@I`Zy0V?k!Jcr&2-d*Q%aJ2kM}LSL8a{piKmiKHj<3Li}S zsemGIU+>J?H_Vf4)x2D%I}2c)OVjv_BEyaYdDM8}^d(%iWU?)mTVQrl@Z3&C`Ex>r zeFU!dhe~@Ugm+iaLw-wqGz%%8oyCe}p24Lls~rnP1?XV5KJCjn?&C{An)jR7gY2Hf zarS5?{dUYDBhTR?*zYKOy&Sq4jdc!Z7(r2JeqV-~4)wckpP4#+d}P!j2~VGKlzWyx-Y z9}G#D;oA({t06d%dWhBmux6SQK*{K+E5Yk8e|YE7R9s_B&y*CNn*`qO2J6O1sHkZ|77pgxJFmwm5t&dp#FHpP>{+Dn%! zb~2K{-h=SwGFHFQg4sIesYExCKTw#)&e(Ubo!*YeGN_|JFypR{j+U)TcRI`L<@xd5 z9{-yRtcB!@P`>R1IppUre1i;8TxJSQi*iT|1v*?_<8bV=qWdL(kwe z?i=M?!|zyU|Ke_cEuLDzri_Y(zc*FnmjDs#Ssq?OqRE0BANV_BQ<5~X=GdHjZk1$F zU{sz4bu=k`H2h3gR^7opt_``Bo;Pj|tenQ?n%14%OP@rIEsBF1%IfFeHQO|% zA|HPnv+xG&j!@4N&wQ$$uC12Rs>!9paYJadEO{YD_gy;DLu7HzGY*Sc)i`4D%|uyq zR!esl_l=GFP1p4JM-(QD2yICjfgoRpMX5>MAdj<$#)be!n~!pS*76Mw7VArHTyj-7 z8NK@9imv9w&$^bLnNgt}Ad+G7E@FLuK~NZ`@n*5~g{?-}!ktJt%ZOR!E+Wh3KTqx`3Nb! z)S;&Zui-vE1B&8!*aGt2c_yTCpO+?1l9`=v8Tog`FyN}f4)TsTiLu>_UvHPt-$z92^R9%POSx(7l#gLsNQh{gp~nT5&duNvM~ zPu;s;b~dt&rlkO}J|`U!SHlCp9uX!X8B=(S5v}SrbLISs0msWPm(Zq8DrU9cfz^{Y ziqG0mm*IXf8GS67ij%C$Lf5p;Q(}m&2FH1?8Y{D=fcl3cuG*RTCTjC8WN(T5T;#)J zu!a}g(AJ^t)N2oxK|7XJSs@$lbHS(^k;ELy2yGK+kn%_6}ZcblQchemtYJE8p8P5gqur!JOvX zw1v7Lfh*AKJKg1BeTY(RXyhHoNkOe1Yzk-2DE{%hn}YGhlbvtr(s#j+?o#F-94n{J zqrP#_qZb>ViqBTm_D-4&+ztIs%H_k)x2@t#D1J5N;$D^V6lGW4W7+7ISG80vT zU`H9fDCk~)?{Z;0FkxodXi;4vdcHChkzOOPy|8}}V`kA-p`RDGdy++@^XvV1)<|he z;AlVeAEF<**>%_Veg zyu(REh8$RIpU>g&k~^e>oL__Vb}8SlR=MbwboI)=u2?Tm8TZ1lH{^fLJqx0uS?Miort3MmvDgNp2-wRvB5@J=`<%rL>_G$6 zjT@0ta%qJ_A`DV*`rInNG!Zs`H^OxkoUTC6il%m?=H6&|X`!_jkKy9cU2RCkAloIA zpr@(=cuN)Ju_CS?FNoz4n17(Qe1Csh5~%I26}=VzHFLooUoBV|@!J7A(|9&jQ47k| zXAa2P-q*F!DA=RVNg@nx0X6%6(@l&U1u3F^d4|urH(%N3jpi7 z+0}Xl%sMb$zm=V-Voo6&wyoTmT9_(%s7Dr`JyzF0M2hb%7oJ-k09~Zb7wS1mlFmj%4Ld_If=yn`+XqGI_|IN#mH54w1^L9$g+9W8 zV4d1`&`i3DeJmCkaFc4 z%jeD=%`_jt5d2do(vF*1Drci55;pwJYe&}F$;<`J6KBpsw&Y#0R{g|!>oJ-ZRQan9 z^fJXLwm3*_gzpq|dhZLJuWMybNud!7^g3G2TQ_15fvF)yHi~IU{Z1v|*~^mlZW#?6 zDhi(7#Ls)YEM#IY26~ep^AFcYq|;6)hc4sFLH|4JE9?hS#@j$^A;iU}IxpUq2F%r> z`8SW>DJq=vHmFh=FUgl^Ggg!oml3aNu+^*(wWKT_NV@;jQO~pgy_P4WhAxvMkc1KX zt6O;HO}HyoW=p`RBqM9u`bT@!ckKb4T%`FY9LXXZ6J1Ta*%TuDb6q>sXXB$Ja^q5Q zuUs!z(G~_@Q6b{>*F3(~)~(QCt8ZQex6}9kqU0g0k@bcAkYNAQG)EQjX9e;7YYM%I~DlSuk<05iKxxxwK zcZq6~O6`e1Ow&m0b5!3yer)RP?U=%~#6n_-ugmpnrRPz5I98iz_punj+yoMSPq$6Q zdWPVEGO~9g_9~I%&_Y7LNW6&a+iZg8U&wD_SNV_1pfT7FQaBeWxEz3-MJe!an;xL*5;IPUgy=SQ{6t0iL6+}&6CxqB()o~_o;a$;}~q>6>f_JZDX z4)48R8PXKv#Pj1fs6u>Iv+~-|QZn^3(ubABNX4X`7B3iG* z_pFCcmkPtwx>53c)&i!Pn=M}Dd;3##G%~(dlgm(1=A66QbX|Ef_Vuw%Eu_^(l{&Pr z72zC{1^Q;xRbeB81=&MD=ulL%C!|RE(47_QWcpFvJHj`FE)YKX1_H1qxosW?h9z0m z<@h5p3KgD3L>=UByBJg@V zl-Bbp>}Xs6Lm_!dsjv8G?s7>Sa&JFsPg1;iur>oS{aD#UJ7GNrEDZ~5uQey?QFY>% zcd}ZeHgjcnO}H~K6b86eU#*vgli$6ZbYppd#It}A4i|zEaP9w?P~u^kaQ$eVr5lmJ z5@B8(k>!PVEe|3I1T`X?XEtYZsirQ3ri-dZE%BhjxGlc)ogr#v0vi63H7Wg=P~^*c zN4GN)Rcr!*>2_!160}E(ePL10kEHDaE*3;T;zk@i7B2n1iW^M&?yj9c;oS^JcFwH? zf@n<|H;x+9oX_~@h!*YG5%_nb!pHgb>$H4bnMTOzRQhE&%R<%`{bdSBtY4tQOFIN5 zU$7i5Gm@*|ReT$r{X*W^e9#&zhN$N}{cRxcC6)>x2S@win&*+<@iK)6J&0zr0arJkEgm;S zo1rBG#&eI=t^{nKP_TS#ku_r{vFL4KJT=Eh7HIjzN&MQ}l(Gf;2+K^i??wlXny{1@ zH>h>`mDO`BUR(P*16d>x^@+=1NZ_;w^-);*nodr3m8_GOI45709KO8Ra0-SF0= zUMS+`KO!v(j;X`7Md3Q9oJD(>@m)ZG&Q>`{D24gVXl&Lb?+`6iKbI!Xw+3SckZ#d! zbfRu$RQSk~l1k+3;+sl0Y9s$Lp@$@Lx;{7WS&n@h`5BVpu~TQ2LS^PoV*PP-l-Fj- zk}DYfm+}Yd&c69)grf>Iw&v_HKUm?&y*3h>>~;QbSo`tyIVZ;#ZT|c7Z#Db%9;n^l z3>Uw1Y?tO0dOydMyj!^_daWBiHs5g>vkl&ECgLbwBXuNPIbu=z+{zlA#=y^7AIpQ& zMz+_`xs-a$g+Y2*?Nc1*D1HIw{q+sZc0BF;hc1eu;zv8(S9{w%8CRvVDdI1HgbcXt z_7)Gqi4Tn(nc#u!8&!8-`ul}L&diyZ@{c)`N%=*eD4-5nq-j~VnLIj~%T`~0_1JrI zde7j9CoqGh-lyQq9^=Erd0z-mvE+hG;rJ~Zf$Fk>PNTy=hb>kGA#M=`5uGqLsB-U%-Q>#ol1 z1U<0TW|%ZCr3Ho@L?^IpIb8`BQ|;r?Q!(|2Qhe-U%36Hvw5?mR->f8>)-67~Lg{|C zy1FP{LMEm3QR9tW@@Ubf$GT_bLvCJ<8nT9kuM@4`lbe)3tM0uYQ7BntA3hD6P0@ez zg_T^RF7mNo?QD|u`Of4nDC5Mt)%^0&dhmP(C$jTh(4&QjdwJ(Mdz$Atb{71;S9-Os zFCGR(m$rq!AyZgiB;YRoI{wh}ePQX>NX0Q&O!{|`Pu!M`Y1cyPrfdOJLB z7O8@UNF}vViUswyqZCDeLKM*ju~7yVKXyaen#y-DLMUetf2dzKq~`KRPxy{OI=6a?HzP#}n!lx52dl}^mq8F=9F6a;( z1J;ut{O~8Z6yFo%w?>j=yO1Rz(9VZ^aAST5Ip zi%~~kD9bZ{;{u(Wh4(w&jX@O4KLgQmOJo?Gqz!uGGrk*A-f+inK4WraQZU-ZHq=LN zvzfiKh1XcbbO~FkproP<*TSNOVOUfh%`%SW&zK9jJpYw!%*Z-_AEN7SccZD=+QJ?=fV=Z~mq&>_R<_hNL9)gKs5+6kRTbya+!TrY~ zJH%+|wYYbL2U#`;gXuRX#_;PKlwnzWY$k8=Xld7OI`@A{usV2KTGH}i4SW40Dy3Q+ zJw-Whcm)>zsW0d~ywO7Jvm5dKBlLb9PYT~jSn+54FvHi`pXtMgC+I@}KYV5W@X#Upa5aAT$o%1d_RxpH_~Gy7 z58nOsp$~poYW{Hc0s8R6%kW{I`NNl=(TA__!&LK!=h@6Z!4DPiA?~w;D=*j&5;ClQ3C}wh+(n`$_9qQDx5P9S=)iJhZ@PcP@O8id z>GkLw04i}=NFH)E>08sCc+~(MW)UB=$C}V+heu!8zWNhkr&#=$+vj?^70dWs@0`$y zfsF5-^z$qnJsl1yBkiJV^rmP>hA3?g=d1Q#*=)}@e{-R*DY|d)&`sh}QRxpdX#WOL zaSXr+TqTpPx8!uCZe4KZ@&|XA%UkZl(}Nwhs=p-iF1_J(EzzT)pJT@IvF_CPO77d+ z3w?W|cEOwx++;DI+U@?!q7b@`>`=4W$;g3aCPyr7Ls7=K`CToYsavXPPp$!0H;SdS z&th2n3#Z|*Qq;r!e#TwUJJeTb-znzLC7j;v~190<2xi(jKHkAj&w$u$0mHV9y z6i?KoUB*iJC40r1=BfHMn`w?8Cci-e`&CNsJ4#*vIDhU&A`ko7c6Qc}>Bg0EL2?Y) zZgR#!`N5CpjvXN0T>he#eaSz^d^1`H7hU)%R7=nPThjn>ANeyoHU-kJVnEzR{sZfo z-|Me!EPfk(OSZm%MQ?Iyc6u`CGfO@xQjWPXX1nn)3qD=qHyqT!O6&mdYmTNeSQ2E= zx}JQ&9BrOp+7}W zHSP)t#O#moIzYUiGRUni9qhcJl5X}Mn8DBN&Zewor^uV_Ii9U7nsT`6-_FpYw#Vou zY`%5Hnat1`n(T9{Zy~QG@^IDvDFYLMR&pUf4tPD zz5+iJ)hxe+IiF$UWOB}7xYXk6>vO_?xvBs#M$08j!G;J*hUCek-9c$rV+OY+Cr`3~ zV5Y%y_3n6=$-ide^KAVy%X?%nn8VkI(b`;Fcn;c&zUyGk>M73hp4aVS z4PA!)m&K8*X*rH^pC?;dKcmh>o?kc^t@D6nbC`!QBVhTpAiGafK8$Fs#}+;Zwiq7j zr3I!aXdd0}yo$2t|q7Q|w_yyVhQN8eD8k2`)Zk9D!45`4KGf z3~~;h(*noI3%>&0(@PJUpC zH^5Xt=i}V20&(NvS8!n-b5hP5T;4?BKQA&A~`-x_<;Ub_am*GTs<9m1Tn0 zaDKI&mTk*!cK+pXOTWjl#X3J-fa>m_aX!Y-z!1h#;0(xVzXy3A!w^fKf0+atCwYTb z_ObE1&a)}iEp|%p&>8d`e#g3g=brD(@q>7!-}Ntd!x(bJ+!L-%#~9jmi}!_Z1gVL9 z74$rVOn&Or?TN1@-i{~-VIGqmhGS^B=?xkuMvOFJD83?1Jd#5b{&7t zfG-=*j4z{K`ags(a{-8*zdHlIR7F(~pwE-wcb(@HeJuUAN+>MeS zn&Vyn13p>vy~6Nr|DEOqT`sNBg~APjmIKwue~R)kNnJ+zQx~S&K}G$6^`u}@YDIMg zY%(iRW@NVd@}U%)F6_o+k>Q5|hzNQl23m1IkzlbGH1ZN6jq=7^$>pjCP zA!eeP$ushxTS5Mgju??0j9 z$!^)sF5LrOb(LH;5I~aGV1>s(6FdfTcnky~72y%LbHy5WrZe5R%;)>;zV!KCdxrf7 zouFg)>-XO3Abj26*Z%A^Ju1bO!SW2G)I_WH$A5 zXcnS?`97XX%lQFR^7K?mw-24Rv-8$8`%p*_`Bn`3u&aI$ZBiWM?cW%dn-UTNavyfZ zw$Q9aj~wuZ=(JK2xJRl;KQbcO>d!lw?d4^5h^Ri8fE{I&`MyvXZ_%&K_6$B=+LY4m zDi6c&R$uPJFc@pfX|%DZn7<3{E3G^RLbI=oBKwNK?JM#(nw^1dtYlw#+sLa70?b;~ zWM}Arz4Bd2-z)1+Yjy^Vk5RL`Xo8Dpk^Q5;HzfbsM;5bGIEU@ZQze=edOeDok;J+g z0|-_;L3?uh6M8=bc|Yp?%zPDl|1>j#T%JC-4aVRO8hPQ>tvu2o#_JtFm{#v*qu$@T zSeZ}sGV7Re^~;4ct{)Z}^Y2QtZ&-5&3|pd6$Tstxa_?vqA}XbeAO8^>YU51i)uY)^ z<2Vi6w+t$A#V~OST{Cw%BHKwo>SwvpbF5nz$zAnxxf~t~3zXAkn&6+`1@hlLOk{m) zAzSf9)0o6F7G8fa3#Gli{JuO`oJ}#y{Q?X>$@c)*Qu;m3FqFt+=3#K!!dL-LTM`k& zZbn-#9z@VH!|QTQ;(dVmd83fKpGPbWKaghovKwnsWAb;0@v4ur@mlSJV;DVs@BrN< z@BlaUnaN9P3oM+L%d#LER5eEZZ>Xy9poyw9tL5h$-(gH8PxLgVcMW+K*EZUj5xy$g zX^)&QDq~4p$7notT^nN}n>i?keho}yftJsmmwbipCpk)c31!T%f1L)fM`Jp`t~dH6 zI^Lz0Giq6US$8@f#OU}Xvg{|2j%}x{_R{XxJ*ZJaue^H0J_&TAE{45}1Rr(H5%~4f z6!T%M-k&zqPGhJ~8%KHckIBN0HH-L7qp-D1-@)@iVbZfWS-Es6wS`Lqj;HksGNyIJ z!`K}*Em4~M8G~d)O766t-)Y*=^8|H}qv~+eCdUP70ejaJ zzRkLfa^bU2Vh985pl%}TGAB=#FQ2Vny!0CF0U0FTI(cS!`D_3pyTFPc12>4$Q-}k} zS9QCKHNT9ZoLu~*fugOSawiQ!H*}u{HpB5q&o`)rm@_#aV=d#zf!L{|cFLN4J6*Za zi$#^YEy3G8<+H*2Ph=hSdA|E=KQ&MvucBzho3KP_bdiX`Gf(Uw!@_f$sLB&-38-6u z|Ih;dYApwHFHvg1B5H4*;Xs+`3n}-Cy5EO9AwNF44^m=mOWhs1ox4Mwc8aGF|H70; zoS%Znvr=jKV(g7w`u!HspQplywc^yr==@mIyf@4(X!kzomxkQvF+VD!E73tMA00IF z$e{o;>4%iUi+@Ex$<*AhBg2xj(B9Dx-Lh}a*D`C@XbB$@W?${_=#X582`KVH#ci;# ztiyg(ub)3U514^`bAIISPy$IOoRNYpvLEJ|!1ws(+0>TglBtw0T@HEmL`Lr}=efTw z*6(G}FVwTM3-v_#p-S{7->*S|*>f3uncl+hP3a*MizqoR+M=6QkUu!4qr@f$F(aLr znv~x&{S}r;beQqkX0C^1=@+(d-prCS3f?creDoDad`Z?<?9y{L(30^qdP8 zrupR7T_R5Y#OjUP-TyW~XJgE(HMz%XUoqv&WS)fPt$5-*+KMO4)3?+u=KJw1-kWT~ zgQh(}y0udH!zVVn6x|n;HZ=AjbLIAsbdZjj>=gOTeBbfPS;piU3fL*V{yxLn79s%q z&Z7X8K3wao0?}|%DyY9D;5vT7Sjzsb#*pt zqyqEaPwg-_#V-5#r=gEgHZ-*m4Sru?{Bt*cS{i&D-So({Wg8lEDVj~m-m;NjA7Wgv z9^c6JsJlgGB`tK+QL3EGI@7t|M05siGcJ*DQ)_Qy_ZBjHQ(H)0VWelGkYkpd3Fh$v z!@WI`6=bN$9=p*vQR>Bto-qg0)b96XEjYwN^#@G_38h@Af!?=ONFV#72ZVqW_Lf9y zG#?T8Tb;@NPUPXDpyupEPlTuno9G~K43o|O(p_-EzgZ0_rB}>lVc>MfQLuSm=8eh> z!9)BmD35JV%XjYtokf&KPy#E!;nW;*&&Mlf46`(Ps^Jr*&t0&3S-K~#cHg>BK>7F| zXf&Vhs`ml~l-v{fGo}SvdOHP%zkodAoYZqX_An@C$s*oU5p5Q>UuEbt%m=H-tmeLCxyUFb=}<@#0x(#r>ftzol+Gt z_d2^dKh5xuvFCcPzKe&XS2pRXfI`xcejnpKDZx0qx5>ut48SnR6}^p(PrK(O4>sQm z6V(*N#N*pr1%Gkao99|IQpZ;HInv?7Uuo4>^tO%*(`c3bVB~0`K$U^)yg|v?^C(l2 zed@tmZ4|fSgH^jUD4(bMFFdFDFW`;ui7!q59LU!n10m(Fw=xa)FX-sQYF1ln;(c3* zWnIR-*EuuwerKBc{Ryu<(NcRq9u?fzMRy$i{ZYJ!f%i9poL)@$74L>$m{CCOe=84( zO+4R~CjTJY0{$^cyR>Txg?Fudg#6wcA0eKx5`+BJ>&I&sjBs(jhwIJAQv|V9BW1u^ z>ENgdc{5&#EGkC4vcsZ(hqN`zIKlmX|zNgO4t!3>1rZqMVZM znn^d87VJrW-9tVs5NQf;n#ZLvEy-c{GQh(_51FO0M4B|FUFK>_%lOv}grK@px~rBC zc%v`fVMH0Dod|S4PM{5~$l^BwgPHjd52mpA<=p;|F8fSLj|Vd5SNh93o`2FZzdrwe z=hv#{pVsFG;!lmw;xa4ug1HIi8w*WSGSh!A7{qfCG9RVQD;m+~HA9PkvgYO+_Pe<_ zr*U*eD~065>Ec#U@-8QLz??OFT%K3UY2K${1;=(7 z*1O9{4660%83mam?bu2ZnN!b_^i12ktNu#TFl$(|(YidFt9}f-Ow(>kNyt!h7wo`t zok#us5gxcmN)LtMzN{xO#Mo#Ieq;PXzhPPfRuIFbLH2%W4o^L12;Wn?3Eu%q3vCX6 zV&@7O5wjgs(>shr5S9=@UA~r1CEo=6Ab@c3{dpb_+g(`y+iY6cH)iYCufC$61Db)t zgK6pdf?tKx456By-9y>Cjj{n|4^5MAYk|8@e~j{(GL!*%{}aNO7Q%=Vemdc}nyfQ; zk#fj8jqirYM=?yEW6)m(?S@4w(yUR>KWSvjJ%-M=YiVUEKPsgeSwWU;w82w)BfF6> z0@%c8A8nINbJvgz^bfiN5#=Mi!+pJ;zXOG%Y3SaXe}i&G7teongWSKJYHO)-Qq0t` zT+3v~GPZ`ilag-Tz6P&*5I@6ZE6XJB?o;Cud&9=%fKPj(4JK@dzz{WXLOOSJ9ooH1&20F(y<$ zrZWZPCHeenHFoQ08&d$1L-g~pnX}CKOxk+D5bDn^A221gPxUfy& zMM7RH=C-JJwj1s_c4$dG=MWv-BeGV2h*oJ}YGsh+pVCk@%Rto{?Yho_b(;E!G4nH^ z9EQy=+RJXw!kay-3-$y+0u2x)Bu5h8V5xrQ$Zn9P9ulLqdA9IOk%h41_81L#1A?|P zm273iXp2xh(L1AVCXz!fkpmrqUGX{NE&X@W2-yZeu1nu>TSpCD+VnIfm!PzXn4be< z5&vT96WdS2VC-(*Q^u zMq-NjLt%eEJfQhanNj(x2Xru4O+mRKd2 z?)i8NUyl%R-24HTn4b17rFpNZkUlX{2q3aj-bI(VFJ_uN1%3sUc~0Q-+MRUwJ_w_~ z+~}|5!N?T6lWk&%bmwYVd4AbpH0~_^JUp64?9vDa^?0c{GM&`$DUoIjV1pLbL9F`u zP+imGSp$&|bvR>6hNTo6%&&D*vJX6vo>kMDly+*v(9hAf)|C6|X*fH8f`< z3Mvz?a#9!qv+!#K-Vww%_5fZ_`0#hefj@5A>ZKevmHU0V>6vb1yoiXmEFTHC{-2C< zXsJcGx=(t(5eXOfRr3ozhIT}oCox6805!4_AZQmE(rX1#8WEJ{pl+Y#S1N>x$={Qv zL8@Zn282o2n~VCs8_gen3BynLF+q^_NjbXQ#(q=glFX1asalM_w~Uq;wL50)dTluc zW>yKh#NGWG9(MUggu9^XN+pR*e2GZ2ENDvHZ@Qm3%P`W98IFYi1wVRT!!v0qM?bkfnMyno>#;w5?%-|lLT0%-gPcxs?*t@%e{B;_w(4VL2 zE95r&%k+4kDFE*uHCTH{c_TBK$dACbyHO7)p^;*?VDh)Mvy9^oX1Y-{D@$8^l!w47 zuShpY?BM#&L!-IkZ#OJAw~a=oawGINDv$bU>TMjq=ti?P?e-}FrZbacKDR31jYhS#l{hfk(|^9pN*zZ?4?J?|n8(ov97@BI=4 zwdm;K!qf&oXa(q>l1VApM)&C*cf~LozC!*RKmyFLN3o$A32;RU7JQ)P9mL)dK>42WvT?R zz@K_ZZJDSy4!(YJkJT4AvEKirp1Z1+luGLpXufa;=Dx(aJlH)w|a3A_j zL8^F@&-GF~G1Kt#2ujb99R8Yq&c~GyoH?Zi<>vteXL(+pzj$80Yw`DJ75&QO@1a|R z${rvo6-|%_$?Q3ED&zWw471*JuitU=t$}|&(Cr$)>!(_-0bFe^p8G?$;)ATkpD`C- zcf4Ei&U-Ayr<#j*9_?0qhqd^%=Hf3L=~nz5YjLN!_!VDuzk}0Se3$ux#KRrkiqEzd zf5Tk-=ZCu$zr|cUJWnrr&7p2ZueB7dl5>{eVjQZ%WXOuSC-;6k9`p{rxBU-`e zMfZ<2a<8{&`JbfSA$IX~yE*@p$daO$*escmqpze={JuQopDZ)?49xU9WG8IcLz5J6 zd{S^N?jSz8a3RmDC~^y48-l}C-;YuUZbr8EwT)?(CG75AJgWK~z8V4LUCI(ITef^N zC93if2b<5e;Me)pE+ZdpznYT${M{thQ37@?V;9xr=cQ_Hdd&a_Nn|_jJqZdL zam)e<1Jj#>_WP|U+X6}%yq)ji!A#d8NJ>~f-Q}mv`5~?2uQ$e@h@>=sKVG$=s6V{^ z<>@oYFWjEN&Z4#lC+{>T4x5H^+-*i2w7ICazr-X187&!;tGw0H&Y_z~k?zfnR?|dz z;@)-)9#i`7VBz4yp1GHNIy`vXEMkVh8ammcbW7(8Yz$NIz`$3KDla%p_67{?sl^M+ zCIJoxpn+uh)CN>m$*Qyo2a%P*@^?=`+(Q2#K&?qGB~CVnxIh-HMML@8)&?a|&IYbx zcPzA3p!IV%fk`vHyek+eQxlTz&qEWOwkS&fPEkHLp!ic{hnTJBUF8E}z@D1Y{a9X| z$`1oD8~lt(rhDwkfMwu|`Um*iqfNla^MRhr(}A{;t56Bm`}-fLI}(fe2sB)u3ZD{>q{x18Cg4!~7%cb{vf+qI$tKXV&4v_-qo=5j z#-6AsI*MUwIdc<`E`l`KhuHz8WQF`do}OWYQdM)`LXglRdlUKGzEQ5e|15WqehCyL@Hp{U${ zhrvx)JOSU>IO#mh?YdZru8QZS<*FS{;zgPr+F(Rj&By!>iegQVoTVjCD`*PHQ@l9; z;r`-JT?#5}f#Q9x#ppEdAG(^daz|GSBb7d1+qi9F@GX|LG)l|4B0-y`OD zOXdwR?B+glVCs{r{_rZQ8<{`Btc*a@C3C;fFWk{{e6ujW3{7vUkkkO(|C`#%Qk!Z9 zZ;_p_sCi0TOQh^qfVw87`2+ObP5Or+_a@9YZ&hbkhM`>~cNZHZ!1e zcrD~ykfp?R{BsgxEF}TTdW+u9{kNJ4&dVt$pi|D*%vUIYTh$5XaqlbMRF?^xVE}vg zOQ!>uhe6hf9zja^UZWJ2gR?}b6pDA$<>O>aS_<|IT^0Q%Bcxoh&B^>CgK}uFQ{DIy z0x&R$@|OmSKgat7G0l0wIvi(!3u!D+U9p<}>s-7`Z>|CVS;;pVl7~fpHdu}ZznB9tr z$rNu~RIb>I@qe%jBzp&=t6^adh3^Q;eZ1;Ve#a5Mh4c%AqNY>S(4vGtG2+Z!ixz7R zpayjR`XVih=Bo+)T=okdDY%po7wIjcM}6x>>-Jw{tnIzlM!5X)#T_K>o>Q&y99@1% zJZ#Dz-|PQl?_1!bEUv!i*?aCANFYEW3j_&DFyS8Lk}GU*b1{jCm%40{4O!W2*4+&O zL;(Yp7^8^y*0w-vYg?_<_O146Kr5)NQnXg8RlJAdTe052TfYC9ndjMOHwn_de&73h zzt{Zo?3w$VnK?6aX6DQp?dto{m4oXyZama$r|tfyemvCm+r#SWr2ii`4_=h?K$ts1G+yvx_%gW1R>%lMuk7>Mg=U7`r{Wz zB#p{%mCd+SBl7uAO$CdJ~o-DewJVs$TH}iSHl=jnfUu zDT@wFLkZh+PCq% zqdBU+d1N__@>)rc2Pe-f8MtYMr1q7|dNSshpL@AIZOg+&)sYP#(D6P{X?xFm-pD9Nm3J_2le;B)n$CNujYA*&aC@$E*sW6rmkqR+1J z?U`1|(o}+ZIC_n?Z^?14>iH=>+@V8VXa)ttSu*h4u^mx)ZaxACnZQj2V#lA>>H6~A zSP+$)`8757(fa84+VrHh<#W`ddk2+^OB}5l^d4K>`2^9gbEt85MI0YW3Jv?Oz9DA3 z4T=6sf?UsDh)Q~Q>Yq3_N_^64*<34#PF#Zq-CXfLU+;x{ZQ>$c$;oxh4Y4>mD0!t? z8jCou^rqxQw5T$;h>aBrkH=)Z1|F}Z`%&r)TYn@+FDHL8WPkL@kn)}gNi*-~o?L{+ zw4ZK-R&4!nT@tFImT|#{4@qdiMM7&NF2Lo&DvI7syYT_K*Jlztm$m21?R$E|tEi7; zBxbqNmiG1kEnhruGRsBN1Z{xws|Y6$$8o+YwpDD1$}96KjE?VryM=f1)jrHcM?D;UPg~cJjCe`W-n1L8q~5!)eCj{D_9-PrkCmrYzgp7udqel}@~Qox zidkt}H_I)z6&2mDRM5E?-{2gy!$#t&iiWs4!Q=vQuGU#6FQ&Drm|rH*dP;-dU3S<>w`?#rFQEZl;A| z`9gk}Us?3I;D1;2Y{;EeLGQvHF6U2a$O)MgVdu$<&SEAm>rwN&dfrrYn0I=Yd{)^T z`Mphdo{~1qM2#Gs$nmAp; zqd(A1Hq5&EeV(a&w3EtxHwY!gmsMld3vSbC{WS_*#LLLzLcPaz?{km2pf1q%RNSsN3!1I9H9u=OdjuDtJimYTs&b~1&_b#JyQO`Jzgb`y?PIm(87F> zJnqqZJo$I-@i2MZcr9r!-ug}ToI#vAt2fE!NkzTty-a@WAWnXXIewhTf4gp@X~F4k z4@5WVU)rYUD;oL2aOxxABQ~x|+pK zb?GfRdvz_YF6GbPuI)?d^au8sA3r}veh(wleplS)rf&I{q)Ua5S2QFq+B_WMqMy%+OV zZS%D;Gvg1%LV&ON9_MSmv|e8SwC=;acXus4Z1f10epvo3c=_0<==+OGURMo`LjU<}G(RYuI^GX|)BCb$wxk`QV z@=>w+;8!EW^p%-j!_+5Ex%zvOrP4k3AzwIE`@`Y>lHQnO9d(^z{$(|$yi5Kkq%MIN*D z9?y%p_&M^(-bAFCIe8hs+C3d(QvcyiGz+KQA{EM359l>?MD^9>PoSX@l+jaZ>seyj z+IKaUeEG?6ER4CoOdB&VJNLe2!qim6_dToWN@J0&$6nrBI#Axtx;|Dmrt=N!?!5y$ z#I6j&(B8vkrj5TP*)*$oAFMz-ir_lBRK*v%6`E`h#o7I2_ujM5GZp>ms>!_(yItt~ zH@7V#CKm*-_f-?6YaghcN4glgXUdB2{?kBh-m$k^2J7d`FXVMpVskeAli$|*$hr4T zDpY}n8|j^J71)MmV0+3;y{!X9?_4#0>IuT8ytnxCN>WeP+fZnCD(}*z+5SIH0Dh}Y zn)Z+Fbf|muS{TzDrR4}E;wnJd7k?EW(f@m|{1R9E|3(w^gMy_U4A_wIeg z#J9Yc+IlLe#V$gv+X_GAdO6;6c0Hyz_r7Lw^~@Sel4m{#7lz|ozO~3`qs=Am$~qmC z;RUuz45QOOS>$D&)7kFj+zrKrQSagVdt{L?91%ebSmyCO?1&>(s2xbt!+U)ElM zIDaVVsWx?;bfn!dM!bym00yePuNZ}95Aq}tUsVV{Z|mb%uPS_j9*QZD>y;%y?Bz<( zU3Jg2d35Ld&heDC1;*}uCGs_yp5->Kp1Z}F79dH`(zH?K^HGw&r=^$Y76`6g_B^LR5ydquXzph%)Vu*y4dL6fApQ<>BZUoXAtkNrgORL$4CgRTRe={ zfAM%)S~rdcWB9f!>zm{hi!!~Y{!mT*}_Mw0Rm2^Na4oM~glDYxDD{&Qqv z%$@VW+XUqzA>PTv-l|g-{pRwc&i%#w$>;txpYT&$+C{nHY`Q(}HWhwIq82M?Kh!1n z0c)L2FI07(B;BRxb|iCablY4#xyLK{I`vic6p^eQ0aCPOaP@5Bx3Rh2-NHj8F4(hY z8(+{LobTa^brz48PX z^YW}&td{4W@%r!L$B&-;sbw^d`uJ{&oNu0``KClS;gDbKgi|7B96!xAq955}=bS8> zb3Pa&1+e*Rpt?EdS$JT+arJc4d_%D-m6tHvX4(3SHWMpIFSpUVj^$ZYu_ZJKeG~LI zZ35x9f!^mM^*Zw12^v^psNyi`E;p*{Y)W+mrX~f*%>RD-{v9qSK=+fM*NE)Z4 zll_yqhJ}vvt9qJq9sGUBcS);J_bdJ5xC+X34|1)>PWi-#deJy~zm={Zd53V1x#%4K z`sLv9)QN&0=JVJeu(ao8dfHi3niWauzeec7-1>J;yaB#AE#N1H{I2fN{wq!n47hqC zxdr^9VLcz()^2q5w1J~~o`|4Q`5Q@bcgo&;WPFYjc3;@tWPPGo~GTkleZnBndUQzhN~ zapfwN$^eM0s{07)iStra#N>JXCr5Gi*~W`vnpgUm$sz5R&cje*=`t!puB))`XpSn^ zPJ6#x_`PTHX6n?aS&BmQOHXo^;N=Pk4|JwVFmF0uH9dN`F9T3(&Ev8Yz10fG@puf5 zS^XEp;Ftv*3#5HRmW|7NSffbN)~r@P^|Vdd^feP@1!SLHgpOav#{#Mv<>jLrxjazp z`y!yeOLD}jgLFpi=cJd>Z#@yS_!Jv;tN9Z-sNg)Icd-B64-tx#ZEpJkuOM_gepjKJ z+d6EnrX!VmUpG}LZxUOmQsKFa;;E27Gi_Ve)8HT~#; z)_dj;7Dh=&)JEI`A}alecWuA^9=MwWoW6{rf5tpEGVJ>+&feMQW^>W}O497}C?9b) zV8l6Bz|Xv`nk5vZx~~GE!W)@4xFq(aT9x zqN=COQML8;jvqUF7G^Azce-io=poJsKPrd(4HbnS9!po}B@Fl#7@V(eadjUTf`>9I zdVQQCYg&-Rt`i+RYtkBfdn`n*qi9E=tpwx+TS<3DF4-&8p-f*@+qH2owz7w;SHYK9 z`NbaU1)^`?7nQ?!S3W@ylX2ROUBrt%Cin`e-6O}efM3$QZ>&5PxW{rj=L1q_T@TYQ zAms-4c8={M+hhM??}lEHRZaqbPm0$ZwAWWRzrhCZ``G|#R~G9j8iI+O`Qtnv&81zz zz2aPuUnK&MPYePzLpf=4K0L5ItFpU~9}7Oi^+CO%L{^li{UWVm%i|GxvaKZTcY6yT z-`>?eB) zyB6No#cwfk`lKgXyJz3sCC@g0&fV*xW@K^$mLO79&Z* zTrLtT=XAQpbL`LCNfqB~yi(qrL#O;t|LVJ+9zCMhr%I2R92=|lCse^Q&PY13l&8A5 ztbCp=aFw)s|%;qe5uj2z!$u_{Z$G{97{q7hp z?@`z%(k<^TR=W2t>sqjns<7kuvHRrtsrm1ldDpfGeq_J-xy^Fp=?X3{O}bV;HbzEo zJro%kRr?y%XMTxQuMSq@=gduL-L83th-E)XtT58OJF@FzB~q<>;ehssdvi|S&CmA! zNucPx$jjP2Mqp(?y>UUe_d5PFCZd-A3znEi6CR0^&noPT?Xi+GBn`D#6v$W6=#(G* zY^6)cxzNd=iLQP=K9G6KZG6k(7Xz7%{F#81NwetOzQ0+n;|f3I zLRmoW8yg8>8-g5|$>mJ4vicYCE6${*^%l7GpF>BEaqmy6470{B`{|C&>BeHu>_y0>SHeDsjY`PMmRTr&NdAUZ16fstu;pWOKDBxp`~W`TrE%1f8ApQ zIz3mKT*~pZUp(RJvAL9wXcKS?>6u+~P1nidw5>02>YWRojAyX<70NtqYpIyl*51$G zr|f=$wyAnko}Gajz4lXW{3iaeRqV!g?@Ow;iKlW1hodi1Yo`4|mZo?MN^_+?+;ZW8)2lKXcclj3c2sVLXX*5r$NGOMrRx!zzDuaSO|%F@*WUKA3aG?Yv-E<-6sd0BdIZ@o>zYEWDA0AIC%6o;vK{uiRRW1*F`FS z&8HS>vV@m3JhNRzpQqhOTY*kG;n>J|t)j=$Zg}x?aoq6=)|B0Ik8b!p_WbB%{{gPR zXYSF)&!fdo+cKA~ik55pL()BR=dqvh`AiE(TG5ZbrH11zYx|5-)A2&oN7&SJE)A(J zLyW^cNu+h|v4OwP1fPNtAc1e!lkm8+=Mp>V*nE)|fSNiv z=fLFJ9h$!99`lcpHXUO>hq#H+S2y^RLPFL3)I_moz+a~94r1h(eFH_}R~|Bt-NYOF z(ktaDbWR;Nm0?Wkhu5)tyABK-`=NTCWL`iqpG01%JTI}m!1Wf+E)q!$WZuD(Oi8#> z+~1#4c<5LX>DLAV=Av3DG!i_T||s_g#W1Q|DSlU#&|l!;Z^yB=u#EpGne zrN`u%wuR)gIt!4JtH=E9^+M8)___V&>({dwt?Z6VqVprEyML?4+{PnB{?@;Mn3m^s z@57kuxK~F@kJ-6iC@gpoO*w15Xv!>2-_>Dir~W_KghJGJKo|w zWOi(qk_r9inqm;^|21gw*v-248dHvv4#3PyC`Q3RtTy`XSUg1y}s%E1y1Ep zn~Q2I7>n36{loBImz88lyQNR?l}#lGwm0p;l8kcvSTHOrSuNDDXO#3hLC(qDSd$*e z)A+}p;$&C%URTk+kj>}>qwz#2i6&WB(SeTFz&vR0Ge6aTm}`4KVe7mS?AiCG^K-V% z^MTt%&ZbgidT{eR!mVRj%jUJfsG~IP!P*RG@1^!E7%VMlxl&RC&gYd4kK`Ro5${nw zlIJY?Br>JsA)9u5+`q=c+vHW&Urha%qW=3t{gkr7*#cu zEvQnSS20R;QT0b_K;m_@q-WE1@pjis9JLA}S{1)Tk;f}QyEVYCy0;+~zh%jEsl4bw zD4`q(x{CV1yaK_>qC*|8@-^%MqEnah{INvh7kOJ`fUHavbad5In~c=|vi0$eZV9tDQ;=Y}4Ij8O=#}yaF zE!g=`^vLjbS{-n#%X7seQ%@8=-alXvd$f;me<#<6#}^DzRfyO((4>~Sx%B*>cwBzd zxBoejfb$V8ek%`EMXQE`a@*kvu^NdAr%=pWw3zC67)!sp`M9S!H&{+G{Li^aVcXOF z577%FpDBEH>^eNqzm`<0(fbBHtlQduu|Yo8Vd=LTrO`+#SQAR<>drF;-2-4zd7x9} zw<0b-JLPvwk@@{o(enF_VQ_v;L+2+)-zWQ@;X6>`y^yr>N8~g|{de6|(u2h!CR*zq z{Vu}kYKX`0ep0N}&f)44pLh0V-kK*K<{^D`zZ~HD0ceY-CBA(*1@JwXUz*gWtx#L_ zxYQA(ZxQwV6r?|3@4uS2quGjCzyES!ehOYWf3{>!kbX!oPR_YjFO53yhX;$2Q?U9IP7>M&pl_?kfEF zTD||U^g&~Wo;aT5%bIA%)!OG9*NSwnlW@I+mrHoDgv%tHFX34dj*Y?R=#$nMmT5r# zZBHuuzL7=$RCo4Y{8PTb|A8|_z9%L8jf96K9FXw$5}Kw6m@HxXlvupu{}xF9yt4!> zkZ|@{r;ayV`~?!0o@P4n@tqRZoM!$z^F_EHNO)gbE=QsI77z=IMx-Yz|5 zK7C)%?uNMVM=Wu8TVw6TarPrNVRs}5xJml&k?u^w?b6*jLO_>d2*0VWWK-}kKfnq zh_r^ho@Pg@C(!KoIwrCvm;zouMVCg0FYE}kM;syVDqlF_4S5k7zk2U*s|U`^*UXyW zhOn2n`vPjxOu+f`J3YP#%O@{SquiGDINE6POZlG{GM6Iy{bmw^OFW zCOVqiy#f{QT3{k$0q4b9qKh4i!%ZPyFtS*OzsFDE)`?hQ2Vv$3t@0uP4&Z=N1s!d^ zaM%}E#TuM-6(!|taX8|Mbc7dc$xz14-iW8E6&MelHcMm`RMU=@P8yid(&c; z?_J{!MA|%|)ogMz%kKzu`U1`E0p2w5BtThu*~Dq6(Dn|0v!l`LKmbR3iz6C&njf|z2A#uVS*pbjB)=Gx(cwoUN=HG?)Bxd*V6Z(zcy;&L);Ypne+wVaMG)Z019415WU8wWuQfJr z`Yg43QNB&>A+Mv;6XrzQ-WH@m^L+zgCCXYtc^XG%0 zq83>Ts?`@Y27pvpABm_?%dtJs;#<`bie}1dgve2IQ9GgL5c2xbd{H}fEzP2~x8@)^ zgl6?bVyvjd59%yQ&z+9G+0fvkqe&e|ZzVNOhv4u^nTF--kXv zxp}G#O^Hxw3_WCQ^@K4Fcmo)F{9X_~(3Z_iz7v`3>jGzCk>&Fvl%uT!KdqiM7);S2 zFo-w;9c_*1u^3d4U>io2u*_J@0n&o1QOCB%_72_!MW<;GB8?z*H%tZr^vFni$g_$D zDj*{(5WU4m!?9YyA_YFU$YDoR+Wh&Lix8N#H(rj>hJ`UGcLeB{hG$=(Da2%1J;5OL z7g0(<^uhKZYikGP`rDgUGl6_4jAmd&(n!p=-phPpk#{5YpN>GIHkjaVaueplX0-xk zmCG8GofSQ(*(s(*=}#^`9zkD73^pC;GZTpj!W~Vmjv<0gRP)s(+SU>Au2nOL_}aYf z9T@f0M7VD>p0HAVQi)N`7-l*{?SWN}$hu&(!_J@21M2Ld&UhC>L1!gmr16i^bu7>! zwPXR=z?YKl4EfODLuM-f$egbtuXYX|EnhZ>NIP0Ts#i>D zc{1GZi;Jt3Biia{Cap%%AiCN;MSEbbM3*0?S(?4!NT_|C=tms^4nq95lmCiolJOZk z<}VU#ZwFf;Am=JEL~vAF(9dKU$j>qH6nq_z%_fJDKz^Gq(AgeZP5n6EhlZps0p196 zVN;vd4vTfc(9t>q#9HLHdDaec^96WBIg68vOiJgXW&<{WdIh?;8jb1F9GaIFf>`>E@>TGw=T1|4FLb)gC6Hjl`U2WQ^4VB~Z{258XrMQEhNa1Ra+ z+zUE%&=c~2J)v2EVt@u(!)&;8(EB4Eg!DKjPM>(LLj-nAjy5l?l6>K|;g;u)k59cn#P*2&6Ptu@Un%#|cAnn8N);-t zGrx1rEJq0AAq{b~O2cwsexi_XZEi-V4Lc?WIg^QD%hv`@E*}FS=YbrK<-Sm)!{a}{ z!;AJ3OFX`~nT)0Bx(JmVgrTLPl}n9R8)}arEj1=zu{ELNISSTJUQ6LF5DP>{FzoGU zZpV~_`NqS!Cah5+?M?04!VXzZPt?*MK3*e;fEYi0c)}LWg98J5lwCjgOp{v!G+|E; zPIIjDdHv1m>@9lJ|6l)SXDpd+ zXVxmr4)}CBVT)0n9~*}1Kxwr1@j)jkMOO4nT=xX`}ms49k6IL_#z4q_#nPbln&sHS&VImc{|{Y zv5ehCVE`{4$Jo7u4`4$!W4|FY;P=Ke_6JH6Fna=HufyyB?86e|eM%GX>`CBJ&PN#m zx8loyc{||8__APTxs3e)UoOmh0N0&~^1{3cuq%(TataSPb1KRLb1~rcXQM3S4mdCk zYXV9qpRu3f+X8bR;EU54y9MSWfax=UKg!B0M3-oLe%Rb z;9Q5i01xBKg82yGvc70GfX^>y>>)}Y@RAjb9e{Zy;OL8h8_W*C5AeNBd0mY46~6Z=9l)$hNMHwH z0I$0gWrKM;;M%XDJz(Ah_`A!1C(M0-KO%kkFz*4Jwi0;4TmblE56VF9fEPA`9$+S2 z<1aLU9$-EKc##*hMecyURiFWwgMhPI8G9DyVnBK$tDn+orF{p+PLR7#i1L^k6m}f& zH9znsGvN9F@PK&}U{yP480K2Q@mBy(m>qyi@LfvofHtffTVb{X&bbQh4s$VJ^VOgU zn1g^LH=%ARE@1O!@U!F&Slxwor*r@lwxMn*9l#a%-iCQ4;C_53U_J;~+Kv1!KzP8r z@!4VC132P3)Gf>oz@7M}!Ax*W5AY{J_7j8H$WT9kv`ypZvuaqivd5xHw|WX7x2P259UpPOTPtrhPf87c_)T0n1g`N zei!Qpn2!M3zlZvVnc!9UHc(u^LwBS66b7*K`{;w@4)`g)os`!PfWr^b9|;G*I((19 zyb|z1dS(v+hG$0W=1qW^{g{tnb^xxzHxK3@ z;5+!rVLlFc5?{kbq{|TPhHnMT2anR*KxiA73jjyF4LYZE0GrXz~XG<|^jycl%?_>B*NC(Jtmm5)%L^f?P7vR{7Yq0@zTd!n1kj@>>;Sm~HX0Q6ESUlC!uKMj19%+Yk&6ZFH7e|N zn70GkO>nzdz@_-!hq)H;5qu}8EPxiX!ak)ifOpahc9$Scz!rbo5C)~S4?>U z-hi)`!T{clZw1VI0AIp)Ddh#2nV_&{m>q!2@%dq133wa62&I{%uo?I^P&$CO;@fhG z@;{dS;}nu?Wyz(s0_#dk&|GWkGobG)i58YP!%|>gX$l%^4Sk9lR{v3$I$ap6iCJeD z3k)ljpkgsHOR1qi!TcR#wwal&)Kp+xX$UH{(%z`E>(hu2OZn~4ysH|1>d@i$4G})o#!`1A79^~+1+BG~KGQ+Nks;fmPFH@lE-3DyxVXdRLutOM zOOwJ~Geo$|B$nA~9y*QT%A9CsiOL8jusTf|HXE3EhEl-W`Wo5R`m#~@&==6jaAlx+ zsf()@JxvW)j`+48E*#;q?_a=W#t`jWI!r&K@S(WyL%GG*kG>v<>I3@n>+|FEI(jg@ zQX1C`(T4GD5+8=AH)iO5ACIq!Pdsg4zA}{#G5$2hjaBhu*Y3Es+jp9@F;rT^wNE^a zo@(s)qQ3e?`7@ zHU1aouc6$i&(@*O4n@yuzmDgnhI1dToiY zTAkarJ87?R=-#qcx^I{89tj_k@L37pmhgQE4YvxIacgY4xpDSs(!LN{DllJdP_<)3c68=@fe@bY(O~6qSPM2_wgexSBNO+5cJ0<+hZL#@3 zD(%lncwEBd+XXyR!s6Rw<1Lf+1_>{duvNm4gd5`GeO=mbk#M(!KZy(XRlENG*{+k7 za(-2zEaZ#$nmqn`DNlBuQbCe)@y=|EVW~Ib@`NM&?i6D?j5Ou=JbvH$L1`Q}y1bq> zgPhs-%=Lb+H^>f{8~kA;x15WZeq@f7M8kY&*2}apb|Ldb+I=)9y4^vy+Z$Np3sHIo zVeeEOvY0#Ujkp8ePB#}F9m9~jzrBgEv8*NJCFyHZo42j0EeN{drXW&ZM<#wpVS_0g z2{pB%bY_vV+Y?%a*p{em4P#bm>*Urk%&pzvaR)r8oK6{Ttlp>7*X)({5ltKIw(5gV_%a%(Pwv$v@u;&rzN$i*Gu*YPGZ5qu7F`?Ts;vz66A0-ub{jR_Hx z2%8t<$5D%kTO|BJ25oFHbE|g>)l^zK0-`}zFi&H9D8k#tL)iP;8@Vqt!6h7N_O-j| zMoxRcy{07?@&zI-%r@AkQ+lz~L4INBl|I-f+~f%$&JS6OxD>#4F={;z@c%A1Q7hlg zP1MTwkjd`_)%=)D0rI|AnBbj&^qW2F{JvGKh@S)-2@S4CfzeaRww|Q4F-kEQNkSI` zqVk2`c@=fl6|R{xIHN{mA>2GcUw&ISztb1UM~&r!Le_Wz{e}63`2{jy9>V1f4y$XU z*zgMwR{i4Qw0b?kn839NqyOTk($CZ%{mvOpeWx?L;{J7Z+zRlK;=;LWY(*R^^e8pDg|A-u732U;X`$|5Gr-V1A-^ zr0fc7&f4wRowvJS_q^T3yK8r^*xkB2 zxO>xX=1^D$je+;~-GAWzgZDpwKV4W*7+sp)v}-%k*t4roOUI5h3V8gLJofh8J9qEd z-M5<(P)K}@WpQl3YRP}+Zs=RZSM$;4b4H^xn!Y`rj)cEbFJ2ifd z^{Ri+AoBb0lo|6)94dq1g#?~~yzrwsr5%hm7)Pb>T{{c3nsAI%x348J_6 z)rZtGv-p(Zp9!nsRed%^rwqTgQw^``w;5$PRrt@gY52(dH#7b}?f-km&}viRg)LlK zeSxE_s7MM(JM!D+%)*Z++_umYiNF-;2zVE+@&>#iUlVy?vAQtOjx~hGk-y53Uo*o& zO!C52fsUdgmYfyGO6rFcvtns#^@Ny>?qRtj%rt4*4diUI`ssc$|LF*XeX9aOy9j*D zQ6KJLu!dW)`il!@GD{E*XtKrx8T%?_WU>yChho$096ReoETqP{D^`?M)HYPsRJ-dc z%4+J$*&UZ8WjqfrrDAQ9m+J!HmwqozO8Jzu%0-=*_&uw_>}$f^6m_rjHnoSE*=0!+ za=4h1<{_`!F?UkRN;6H!)m#xnttW)_Uxe-$uM~-8MdQ#l<4_yFt;Re_=|4=ssLW>A z#uA3s*GYugT~<@wP_d$c9W>dklMf-fQd{V3$BHuDno>(6pHe%6+eZkyO{ty9?IVTV zuGG%r_6%XqQfg;&d#12El-fDmK1$g0l(P0f#Je^kDqyrViEu7Zs@9f;Lo7>JXDRjG zRb^o|#+vvJtn>Oe4Q|bx}Sb?w{fTfTX3d=!QX0RE;@;odv*-T+M0?RBmOIZ40 znaySk%WD)#a`V_8pxc_kUlRd=L3wpt*dYh{SXwQOyMnmDLsOX~We0DEBNX z=^HSZXh1R1*kO8EH35mi5f2$0G>Kd9Lx9=ts=^ubN|@bl{GB;(CY%*ldnbF?oc>Kd zI5>T)T3MgjejN=BY_bTv*K9Q-WF`eaA746QXccykYENUMUPTAILbbb@P1_7)))`~E z2!(C%f~lUd(DY&GwL*SwvI-8kPmYB`35B&XNYj8WoTtBtHI z$>m+;XpYi4QyqkuCG2+i1iYv0SQJYfQIsmS~*2y20I0S<2>Jl0Io5QO_fB?FpBrPvN^_i*MWN58hnk+EnKs52x*5>5^D5CLY~mN z3qZ}a?OYQBYZhVhz$o}zm^XbiAyL4rgny#MttDMpYo&cvdgi1gbafMcrYx%|b=Q(t*WbWxtF*~mew=kD~&gd9Pu%N8%`CxqPnCMmNL^RgDo#{RhCO+tte(?Rmsu{cY~|mT~^|9m6nv9$5uGT zj!S0jTq=Xr0n>un$?ANM5cP0ZUEpe{ z6si&{$`NGBa*QF>7gX`8N=PtRK1xM|~K zj#06xL3Dr@LdSPS8LY%``GSrtWsVJ$dE4he`<7E@(Y@SGcMO}Ht5=`3VEQcIi zwN%bCgz-W$kLUFwx^=F^fTulK#e&<;B-@foS4Bf*RRt^N_2H^1WhESg2DDQZD;4IN zI?x6yi+WU)OS)p^YKW*)g_@M=u!I+430umcs~&}S@@lB4tH%(8m@>P{RM~Cv>&{B-9@7I~>vsGsj)rOW``bLefLmzFWQjeFe^NJd z*DhbOoF!#sec!@um1N5tO`KFQEv>VXvg`&Rc7~g)E&`nqmS?!RvZS$Ov7O;2bwuOH zY-iS=B3u5@a8kDMk1&sV7(ZvgZz>_Y*5~#x<;>iXb|$UsnKFf2M^VhBTEHd>n3uai z25h2$Q&ns8x_~?45AzCi)3JCX26d+7PaK6Y<1DwE^i8^jW=K@+ImyHhCK$7%c8{~f zxwJe$F3hsp$(KoAB;Q7AY}}q;(9PA{DKmKjX9t@oKX&dJR3s!Pm5rROMrdnq?(lov zzA#lbJ7nqPxvDx)GKN2TPMVNO8C212Y5qeTE?6<(l~L~ZSE1cl^0pDQ)Luj0S84<3 zNE$#(fB*$ia#OBNr#re7se<$%@%f4=b4OFupAHeV%pLUlX3m@AmPeUxsjCLOqB1!p zW9W1Hq=_8ek5qKo_~;3{GAT1-1l)-l_zyfiZQ)hoq(8AOE1!J%{_c1oKasL=Y{>|T z6e?-BbN(a;&(uFc&9q!f7g&F&q>)eUNU<@Lrk+IH^#sCJ@DqIHkK>5CMo{z8HnUrX z%|=2-r7qg|M&*3tcNGj4)7)-Z^JR4n^`d{Vom7nn(?#3{Ma?HOld%+{`JFjby$gvZ z@TJV;8gr;zJ7}+voEDH%F;)HFVEQw@2_bKUF9LQaQR?*k<7aSQ;&Z$GBzMA;{mRS{ zBFoVOGH+^1OR{vWgXPANydZ`Ml|U&lDk}^f2r@_8fd@y8?iQ`8`5gY8y@&^-=aT_7Wl&`5T-N=i46 zBT}MgCpIdQly1%^Qo0jXlJ4T9bn_x2rTbz1F+NABOpgd3h!7B1u9PoxoO<`>kbz^$y?m9~A0bp^r#Lb`@ z?6Rh6CfrAF8(%#p8paeK#yDw8rTsR9_!*M>DZa|PVR;ya-}3GHbFyGPEF&q@W9wc= zqW0BrejFk8X!k4uK7B=ZAAQqGzQBe(Qrfo^%P>Qayy>JB0Xno)+#Jf{^({Q_bG>s5-W0domlfI77TR70w) zfGtVcS+WAA!Tl_wRskz?6)-z1S^<_V_9(`#EEVgCE}8Pv@q;uStYB^GZsL;#TlBQ< zSRh&JO7|iqN3wJ-88Ijgm%E{&lvPzn$~rH)F zY$bhd>Jso73svPv6mw*Q(Cz+=WhS=@LBMA$#T0;9|Ek2LR7Pt1Lf-fU5AXzuqDPja zL-+z>5B`8kCF2cY4GovC@vN%d#N9Qo3SZGlyHAECMuk@Q#*uPQ z2zJ_Sx-XsdWdzlvAX zRlE|ridS^2cqM)nuS8ezif$FJ=vMKHeig68tm2iJRlK6D;uYO0UeT}Om7!Mg%HUPJ z62FR97J!%|yl)O2jnG9`Lra=MCx0w}89Htc7Q??P~m{n1~TvJq(gj-`IM|hoR)0GlC zUD^JjkaU4=(o(cZEAxvdEvxD8L_e6e4rAO;IGt%L;a`}x5>9X0N;v&#%QVcX=f^-l znaW_J$AL#>fHKXyNcyKrktR0U9gSLES;xnxi{{K?dFG298Gk_p3*Ri1B78M1b)HUs zCVq({{dW}KQW0n#R#sY`%67dtHbOv;g@Bp#~4)8aN3<;%f@CmBJ&JnT9Tb$6=)c59P}uj!9Iu2!tOW=h)OSZ-}#%J$gSnhB_-p_}DZb_gcT(!=|0h zNy?bFQ}4c>x7cWSk2+y@*3RkyyttckTs%nD*KZe~A{?(?GV;`oV@^+&?Zq4tQor9IT- zW%rrI0;K=SVS)l75%MQ83W)rq+#vV>Vp%8w|YGbkJN(%WV&bL%s3{yE(4#b^B+EHA?FELq-y z#e_sYrM=j9NgC;M{EVk`YSqU)RKwY7f-dDDpvY6rLtH|Fr&6GdU z7#hezsrzAQrPH|7TlE#mIu$XEf76DV`*Nr8fQiIDX@vT>rtQ<7r2oD7*(63P#g=8I zDzK&C*J3?M4N4=IcwEpRPq!0O`LJczbz3^+P7=-zoiiPACktm5#4oq%X@esL-!hA?+egp7ZRYEEe^;OOFp5fLOGgWg&Prfx%9o4LuYt|G=E1jV zwg5wm+l^37?lm4aJ*UGASvgcUc{Xqvq@W$_t?KoCV#p;eO(ly(i!^>LF>4liUBEbL z8Vw58Vd>2pPj8m!PPB2wq_-*ZkQ8VYm1WgYU;;-gjts3sk)bu749~Jz1e<8e%AxVb zqOysmjVY7K&SjHLJ!2ZVCvl0U>&K>%MevNKULMb?@{E>R5o3G$AtJY%DWprf-NfB2 zwKC@IBR-%Y_lY2!TQuF79v0RzVZUqi7@C>Rz|Yy%SpL(h=RYk`{?lAIovPkaUwJWD z1!lf^%DIT0rm>@xL7FP&JdJSISWj!5P_K^Zv}#P}8DGqFE~GMmq0AF)%C>8`4% z0xN}F>MP5zEMHPnSH&eUS;2|S`NTw#z@vKg<78$E?V&J3iC=w$h|5EMEZl86cU5D> zCz&bK%yvU9SS|jdWMwn^EHim0@%9E1^lc9iugC^6Q>*BF(@@Wsq-+$A=P;-VDZ(Mw z&_E-JLD=$G+OP#Mj0BNgG6UtoX#Z zH!*k^yzVy7Dqj;jIgXct9GV*aLH4n*8^|7Hp9q_YY$1OW`&8I1+}9IoZ4R-|gp-X@ z^aX@Ij?aZ#BF|;5a2pVA$#6p>uxxHiC0mdw!e*yr!yRqRAnYSx_XU|TTUIprGLx{4 zg3aIJA*9U0B?~U?YXa@eBJ5)gB)b!4*6d^|aW;8-+kDN;Cj4`y13e;`Ae_z=QD(5j z?BowgnpI>H@OHAK?BvT0q#$Ax1td>i$3|hdSfo9Hr46d`iX!q9F?@ip=(3C>eC~9GIT!Lt6gDsz3|P7`nr4p zuXxrr%zA}ywn1F4LUy{SH{|fjc4(gZm^TW~iH7(!)^?F(F8acdRdQ2K&Q?@O0#$H+ z{N5>zXx3X(_gPQ9cY21pcS_-H2?mQR@vFVl|K)q9|2^`v(@ED(M++-Rn2`7)h|tVW z;Swe%&7)Dl>~12y>C6P;acpLHBh6n4Q@E$y>~8UUR&NkxT zl^@w3qU78C%_O}m_=kIC9@OG)`RXH6?n~gDi#fzO5jTHyTlq;Mu_AVJ*xMxch?M&i z9_1v_>It_pWzQIzLmaGtvQvI)tVC`jBdwT`y%=wQHsYmZzTny*RyhfT%t%b}o5bq@&!EN~KFz7i{pBs4i&_sk5N+gEOem|Dk5j(xsZP@@G=auoOQZD8^ZE8@G#o?x&w$<7W^ubQoyoDVv01 z_p3!w4M}oS=+DZzc5rY%K^WQ``UO7Y?hJ7@vzIKl!g2_PgZM`1lQP98WmOcO&Wi~7 zS2dltV0c4K=R+9YC)}TwQ9sJyxN~_}Hi1&#AxmW-bySCx2c>hr44E1l^Q zJ13G@qGnJJ!})3kjWDdV$+}ZhFvTaOBI-xT%hhx`VdzlP`8o_+2+^8>;SgOZeH7K8 zw#JCe9T&4707?o>1Q5e)aJh^i?Vx7lss3DqoS2}}2@LsaI*VXfK(|nziz}7XNStzfAle;AkCa{V`2x97 zm-N{{TyNc3ph>M3{TgZQk@UAh-L3stF>XLQi7&x(8FF5NZ~j{(YJStb83;$S~J5<>)|3LoAOEyvH8k`4l*_RB4Ku}Vy995 zTpHn$+u3U6%=J|1$yi&i@%UL#N#qkdTrkDD)m<+3n3Bm8$IRfCPWy!u8k)F|1mbNH zh+CTEc5_XMZp>)ym^-Zs)vcWh1M_HJ%y6g)=BYHd*-2TVRhiAFxCNLTF_C!b!j7-S z=WTX})ma|XgF+2H*~gCYd15jc65>bL+kzKa*yahXR>N}?`0W(sL8agm(I$QIdHeQ;j?N>rXYVx;J4D9IFyuEq=lH9@jQ|9sXR0(*$P<7HM;Z{sd*G@-DF36_KpH|QlmQ} zAZ-$64uTbN^T)24(x9mO!9MNa}vB)A&GHJ5|_nFq+-wLHnns>iccqst#ktdW_`I^=@W^YuntxHN*kf!aoiqfcX%g}eLhFV}lZN<+XD4^IO;KqGQekl_**jB=Gz3>Wp>8<8 zK$fU51f`UwF6kQTE@Jj83?q)viQp2yFR+@03}cRPZTF?z8WvU?v)xM@GP-yXgPENE zMXA5Brz1e|mK31)1Pz^ZI=k6P|H5u|(&_DHC!PLocAC4c!R0Qit8Az&D{*PNT;&y| z7c6B3&riyDk9Otx{_){S$>;FeEem;R9YE3x4IxjHSBN!cO}L0<8PBv7SKL{P&pKcu1j7L9=VFp1@yA8<_(Pv zS8;MgU^Gpsr|TY^OkWXB(}yWH%X@E91|h3({WqkFiM>B*(rsMP2;nVI`CwA=cCP5D z&fC<%SKGqeJ{c0*Z zvr(;EYfsTMuTGluE2>l?GwYB=`FN6b_*CGVL*+CL^055aK^IZbe+PTrH{nIfb0*eY z<4AvnnK~r1%avrLHAFk+W5;~V0CLJC z^24Mj5y*+zOh_yoM~Pf`Ay&C z;WeBGd$dsFxn^Wh4){k;xw} z{XR&9Wc_%Bl%t6H`KLDH2WUaqTJHA?Z6a)a4pH$G%%EwB#2O0O#Vb>(ioOq*8-%OS zM8h_uQ5{YO|CoZ$@rF$PJe9Gc*%B=kWZh>{1MNVd>yx;MNq0Uu{0NqN@L5b!ks{Sx z%GuIVW|5c7RNAAvjllOmWHyRw7^fEJPU}ecXVO~D@~HHjN^6yg6z`yPG0;^fEy0(^`!>Oi3O!&96|24^YjLjv3yo%6N81 z;PzK?$H2y&%enIaoIXk-sZv=bM0}+Q>UCRYDN}Uq;gXi`ShN6x@djTWMfxm4Iw+BD z*O1Ollt`a7nUFp+nNITHB;piOXTKPBS2A6+06$Jar)5&CZ@_5>zSQr?M5!};BoL~>Y^#)4X-fOj z^-$QB??nY^jPW1hIf~ zrBNXWvX4+yAqdU^DXI_z*+waPA&3Q>d5sD|kbSJ82|-YavlX2Xgkaudgdq5su0(|( zwit<_*9$@HQ%DG61O+5dUdKjZzeTktFzZl45Y#5t+97<#>?Z+e@>bi5P8(JKj8)kr z-k?-@np%AUFKf+~jirhYXa`b0;bTbq23_6DPO0RrrU@w2uWM^;_c!p}snx>Q7EOeE zhM8Y@Br8HpqK2zb^Z2C#zBbuLX%Enzk8B{dw0fl5v#ozHM$1!P(omw4`L=y8`#BPW z{UcJjTV%+1hV1(iYpn)jBmN-UdKV&&px8#UtnM@|n;Nc+4hsZ<#hh8}_)FOZHePu| z=P#>OSLM09J>P~yih#NW8-7l9qh z5})52bv`Pbb43NzkhXvb*dL+lPA%=;Ecu|}Wgx?aGF4rF@Ra>$TMUy!7er4@#q+IYL z;Z++&C#c3cA-q=Tykw-4!e=Gc>V&=6YWP^-+p6{6x;37XKr=-SvrmMlpX>Q7_l3Bg z&voq6?CkeU#3NdV>nopSTd7Z}L)1_K99N(-C7&V`OUya5mQLJckF0Kx9`%TCQ_LAT z8FaLRa;^$^A{`+w%gmAepD0xhGoy0GT*I}b#tlECbH-C|&eC#^Nj@uQoE^+c@~t*D zL;yA=X98tCc59BckxqsN3!xDnS+PQB9JSP8h0rb|`6yKg&2HdBixfhmBP1Ii;kt8T zhE$#8ndsv~NuG(GKAhwkM^qV3@{D}5m0={$#8%cYl4s;Ok&o@$MKZZsMGlrW+mJ|S zJ1FJY&5lt&O(gw1#H?K7uyOQiLcUeR3M?TdaSg2h%pRnGJI#XqeoR~6%}rq}-NzoxqkKtD z<*)c``xt3(T}k&&NWb&1GBeRS@51Ll@nwqi%e^4aUuPF1*)%${A$bqt(|{&K9y7_QPZ#F$lx!_(`Df56JM0 zUxQIZ;ASBw55oWj;Vsf>oNgFH7t|$@OY~I3iw}%!0YHNw1v{U z3P0Dv)is&B zWC=>`KHr^8RsAed`$LMX{kwVXXNJ~zWSH-#?195c_J2kAx7Nh7U2#AYl*XQHY9NZ z0YeBeS8zf?%o!krH5&-$CQcRzAshUAua55Ou4&C6z{&snul%{E`}M1OuijO!s=KRL z6TeGEdL$qp9uY-)3|!5OFp<{7$(#ri=@K|u6rmz@y^?e@N@K6VW}z%8))g>u-Acqo zn#8dT{C?)PAZ^k(kM{3l$dE|b?XPvT{|w-$iMPKUPS*3~sPdyHcXYQlEMz&;!v1)R zvI$kvz-modj2==5>W(k(Q8tZ1&+UUMk`c!HxwZg^KzF~Roktw)GPrX|gemzeM9J5| z<+TWU1wdO0@kz{WaCvKlwS!X(=up)KtkJqhqhq|$B|@W19F5)q6>sN_z8_BRvm5R4 za#b5fkV01Vu~y6fP{^9uVK?(^(#*&4fhlhQFKE7n3!SkByrpNxL99>lUJw!CLdtUyc60p74B8gxywV( zW;JdOQ&5u#?o;+E*4<#@>gDK!Dy^?Tw=j#O)SqXD*LX^>MkaAk4r!%%x;#9 z>cctT!;mXJF?Xb;%q{rN3(Dv{5X4(38I;v0aPo11WVf4Gab+iwEh$%w>*>OO-%f}9 z9$Bc6<%o%(kAstA>H3C;qxB52dKxS?3ejj60?J(Ye*~Jd+DOc|8Ln3rGV|RCC%uKt zd@q2LuaHWwXEU@*i$C|N;tN4LXNTl%tWGG!sblN$Sgx|HYaejVSl?AEZt_zO{^CzBxgjVRS8&}ZBgONyuN^G<9+*cs$++VwnJZjP!GX%i*@`KBI3Bk7zx>|MH%QG zwM@hJ##wWIq!y3Ci3)?)d9PZ$gS@xp=d7fa`_$4yHS8Rbn4v1t%WMVg6Q+Ps6Kcm7 zPNNN-v6gsyPbc=`#>8+tdGoF)K))?Ard7=aKruFX5Z5@n5f9t&Kt8I_@$<_t-qG=+ zityL)2~QMf4eZUw)q;Y@$x0x5`7=*kO}W%-uX5vW1w_F3D2S{MN9bb3L>`oGnT_t# z2)^5F)!PG6oV-&GN0wiNF8moBJw#6?yT&O?unm6($h!nOH`zvBwK@}P4`FHz|I7cz z>imU5|pTCgz+slz#5cc^8b+Z^)N7ihN<@&KbyI zse#YztAT&y?5p$8WKY47x2Lb(hdrL`tN1Ct4R`u#CH)pJv#-{B`RY^1%d=j-8qDOY zxPYN4`05e#t25hI@5|t;$Drf9g~UoS`6@CWN1H#JA41g63K3dF{VbJgiFJdQl@?q> zylfx$vIdR3PU7@3hHZRIDt{j9eTF<^)wsKnvq_exmGBa!8Y$woK=t-;v?Cw|vsxyB~!>=Ye!N7fx6zL=L5e6gGNd8Gy0h&S#Z z-Wz!*_7U-|H!XKO+oG9vyCWxIoTd{2yR8yCK9o#6)}1fX5kl-IaQnyTqiIHUJM+;QwvQ6;Bu?5aIw`KL ze?bv-QeTClO!$1A6z7?~Tp(|C{AM|ZBd3$<)JZ3LIH|#$v=}eKRw3%7hNo8=Zm$e) z#A8fOb zr~(gHJ(;*_iR`M+sVvu=l*v^qGP&yExNeT%s?*U`3j|mF331gDhpWy;XTvoc^(rDK zr>p8`!R#MJaN&FJYms~JYms~Jm;bxd5%Rt z@-i&?k>^_UV~Vxt$I{SjeDR(v`mrpGCJq<4=Etc)5sSA$zrtCQ{uLB}^ClSXG6dpyTKFI(m|hA>lA1xG9|U z)7QJZ@V%_fq#o@0*ow>aWx{jKX22SSHQo#-qe+SZNMzl>P-!JD@i`{*K5@sBbwLVu z1IE+1$`PL6-U68Su&}6{Rkj~j`_U7{EbGCweF|xGgd!gZMPljbIlUb%8|a2>Z3Tzn z2NQZbFZcm|l^;!SPQ~f|bBel=Ge-!LJ4%0PExtU1jI9r_=IBa3d#eqQP=a;JdHJW4 z+FM!eE`;gIR~W+D%m^uEOXM=rum%aCqbt4{TCdQh?SlF;H%4o0Q)fq8dm3zS9Kl$` zFqj}H3FU$SDl(|oyYBM(FAUIxa+dSHRr^K$uhC^#*?l7QYl0wkglkQHejtypuOZu- zqs4FyM%&_PTy;B^Y)dKsRB3|21 zf;OtX>E1UAPbV#?WN4M7zhG!kU$mz;o#;*Tly!UM8d7T^uXSojkSSWnHw)>CwE-<|S%%W0QNXcQ2q3b3_btRdWXe0PWR7&q0Rnw~GB`-=tE zccqn^jzNohA1?n0|4Z{>v~~;oguML-GFZEn$Wj{Aw)(d}SkmqUbmpB{3SL zP=T*qJRGnewBH<|(wLzXJEC3i=!jq+tRpoq)5@@eO$6Mt+6k+o(+@$6 zlcAD&RPt9C>cfn^6xq|%8Htw=V`Yf;4m@Y^Iq()`$pp0fI8+!dX23pW$yvzk#w=Ps&a7eTm~TuAs0 z_9=ntNp-aoRmD7--TpeRv^9rae1P_|m|bAZF~7tvR^`#AiY=W()ZllwbYYRz(m6HQ z($|2~-`XvmGaVzr#{hWWYU!MMgq4(lGnKHG&LM(45-ul~u$In=^Oo*pR53af?PeD{ z;i9leYU$&Cp`}l;i!1QrC3b;v%=~Y^(9#*`e`_VzG?Sv&Z4tfh3WwL-!DdPi8}+%* zl)eDEdTZ(84X_kU!^ekZSsowixN!p+4iJ)9ua2V7NeWhOVINQly4zsY+ww?(pAC>!To9?kFwCyDe~#{d0&!GCJL zq6dzz(N8ds3okC2g$e8wfQ*3?eKAC)EtR-Lq_P;_5}c%j!*jwqe#yQ_{fc^ii3(7E zffB9>;Qc^3Ruw)Wj5UFoI%?jk))eCYN1<{N3f3lL;Vbek0obRMwVv=i(UzgUZCslFEhgK~vnO%i# zEK^m=8(x&-1)fwaQcwuEU?q?O(?)s082o4=tmmD01YtzH&2Z?^L%w#GADV=KwI`2A+f?rFvi} z5)RwYxuV>t>CD5YPV;LOr%@@&0t?lYMZC}y{E!LwpP%xYU z$+RMsFS8N*ZS$-t;&CS+S#gkC61Q0@vGa(;Le4r^%fqsX1MkM}=-d zP=yxJs9fxH5m9?37@%0RC>0_{84v7P#7CQAh*8*_shm=Be2s}Pl!cE5JAY<@2JB{I zlY^Ps8p>qVVP`nWLwCfJd@?Vf+RSPhB8u)*JGBB}nc0j<<>t#5!5DGD)FvdNUts8mWVr_3Qu zCh>9}K`L1HW8JBgyVR=8z1=7hku!$e(Zj{#F^*sX%^mB;t|pv}tA#+peFi!@cidnd zm4}*Z##(xIT2}^dCnr8CE4u5@`PF*@iN!%USyYHo^~B``FaQjN*LS4|#Coib%V<1&Y#@wURK zc&m>k@~&~E3MMtY31I-!K5ZgTPD~Q$t7}O2H3{ElKE&n1lg$ha9V$EV6tqj7uyGg- z6o*r{K4LO{C{m${PCGSI#H_Vkn*pY|yZ<_8_?+(SUN2LLB4%XnR*rIlMF*cLcD`s0 zM>_zt$;Z&X{a8`9EEkwX1q-RrSQY{39g+(Xi?77bEQpL}i$RFSjT1$X$k&{(ikBoE z5^W2zLj+tCJD>k4$zE%4EG^9$@l# zg5gIe8O4+Td>#lQw&NFYH#E7)6iPl@lrKWCfyM3&#u>;`473jovr94#Le+q03)$AE?Pi3o&c_inXB7^7*?g&jbU`5o4X5G=p0-i4+nM4h z8?09vO@;Xw-tvX;%nT#*Jj(&{hc~u}Xu-52!NGjQ(Im%UK9fTg^S-Bq_dTW5L(4LG zTDd$%BwbMj_x4I#sI(DPnTFF~&N!qu1n=Vs5_C3>4t9(z1lF01HJuV4=klxZvM*KB zexruE)C4-9x7}%CK8^lNrIYw1!y$48IN6RQhw|t$#dK)*Fwxo(@o=a4A7Qe_#hx=3b;uxW5Z=s5+!+QGhw1b5VS;A zVd>ql^j^v5K&vv3!$$E=dNl8($7C2Fj-`e(j`x^Yyr#fz<9J6`n(yYYI@5E48Yd8% zIYG9|iMCx%;&yomPfaJ&S%gC~4alarL*`*6s(5+0Q=(-2h43RX*yNF!hF^4QacYJn z7Dj_k)51y8X>Mz?{i4okH?9%VbYa49hI5w2(S2Ipp;LGH44qlFpv?NNj3Fr3*y2`C zk-JALrafAT?JK2n5Gu>;a^>DZsKOnDDl;g&$_hgNlt22VWJj@Jqze#rrK+UicHma1Dxx=AH!LZ>1#9nzGdcU0EO0@ zns2FDlq{%)8(S&6czPp|l;5}9oQR-1pz1SC|1ZpP zywXe4X4rSDY5bT7%<#1lg1@#1&PG8L=oh8%re6LRa{CX~?Pk0UH?B#kzEX4ab8z1N zP+%IXOz+(TGI&(^3sKLuQUX@bF-M;SmnVX@A|?oSGRkEMK)$hBF90zSk9f-BiHb|j9hC_xk>0XlG=5^1NwhK_A2#FgLu(QF7UQbPyPjps%F4`*mOe)v*{TsHqKW}cSKs>7YZ;W~= zFu1hT41t{l=0Nk%UZ#=X(6`ONsbE3p0ApYB?KJf^a~^<;Q2MJ&Nt?@1CB83_;}W7C zJfM|-)f@w-`jHd`Xxs?3^qP9yEY|xkH0wx_3(X_QuS&1i)5~Uhh3eG{?m)RADfJsr zYYS1G-?xpZ-d_m$n5wQ&sF;>`iOF~nn*AL7$G1VtbtWp`T>M068D6f$LktgR`PKHL$*;KHAPAM6}~hnWbQgNG$}Sc!)<1{eN*F8r;kN(`idHc_t{M0+}N zHCl>K|K|C3k-KdrWo7}o1I7qy#k#MZM;;mt^+>Z%Z-bzuL+{88y4Q?Q;rj!nCE)9z z(%E39tKpVv9_Blo-X?nUfl*e0f$OQj5|n#B)D{ff!K@en<*KGbvyWl2uJw|Nw#&fP z;Fv_TzoIZeOG*wU*8p1Dwq)90)wa+wPk`bo3T z1P%Q3{AN6V-FGIHXrP*yv2QiGe0?^(x(tfxqxVn+m6Vj4MN~(suZNz_HAAn1Uf-ut zdbWAmYV%l#)U(YRxU2cDrdSX(Z^GUJBi=kACXo(ZeBhKJw(E5UA5^}L0I_ItuvkXoro@7o~ zZI-PB*qg*$t4VJMr$y%Y6UixBZiv>e`7pGUm|ENn^_tq$L5S;X(4O_;w7wB6?=Lh; z@_j+|Aq`p+SXx>}`bcmERWHQ&tS1BOhlp`QRKm8_E`jd!i7kO*=(`?JUoc01-ONLp z7oxz+pxEv$fC~qHe?Qbq z8&Jm@uoS4}SqbjRs1|v?8|uz`6YhQ|lm705yFPt&GgpE@ z0{H3=RD0aGBLf^9=lkbFiE^Jl9y3+FH4Qu-3Ywh)x;oq}Iu%b0=-O5NhV$L5=KJ(L zkh%Jcd}#Fg&lKoG{QBY-Gz_))VLis*sAv4e*Sx2nGn54aVr_9PyD zgNN7f@HQSkB*-{k4B=s1fcK7kKNS7HfF*tV`^4SG5sg7a3AB?`w;c1^)#&%2wg{$b z`Jgw{cw`AtH^iDHtd!o5K{||i*NG4^&cL|+qw~`=1ecnlu>Wi^eP@|@OF=pXwIsbv zR%0IB+$_Y`vtT$;V(QDx!gJtiTIpADcwy=r&7$K|7;#J6h$`~*-dd8p6wYQ5hS6AO z`ep!uQJC=R9WVIq@U@q)$kk^;M9A}z#J*rj2_#7=Opidlq)m{`PnvFqP62GvT4?N9 z<``m%%b+{2ybgnL8r7I;rkS=+KRl3TLDB!FIgSpA{Jx6`E0{s)dZkKYxUR!!pEb1e@TR+i1lifR~v@$5A*>l&F4W&`4575&PJ82rm%<^{xW22 zRY}18E-4oFZS&m))szGO70Ab3&39n}5{L5ZNnV#dW9SdiZEtEtwTU--Sagfb3RK2@by9B_u_K0!aG znGQ-xHiz|>n&Sy~jN@h^&*`4>gzPy_KMJ%n!#4@WE0ozg-ORp7nB6fPv!HDKWy%M6~651sjh%y}!l9)1@l%^zoJ~ZNEe%JpE(KAognd1(+9a^SvUt zi%NQWN8LA)y5HTB#RzVpb-%MkFoHpVRgl_I`+wbHss9l0%9=CG@y)~t{DGf%`w}Do zpC}MHXF@GwOHGXV>P5cGEhSN|f9>Y_JA~`!x6Jm|5_0_*<@%v5FW6jvOI7Lo2oCY6 z%bg0SzqQ#XDqQV|1`g|8B3bVZC~AESNou>&Wu%iqHvD?1`9#{!K|c!K;-`jqIJ)Z~ zRJ@T~V$xKHGf*&koHtujAy%%;8ienG(D+LpMz#OJ2>J;gXtd-jxCT`!8`XCdskepI zJKH-Q2}3#(rn~)-x{dF`nYs%Pk0R{XVIGtDLZenp#-2#?K|SjknYo^1s`C_O7W|Lq zF*4?6I8!gi!!-!QJ>#@H^EfTOz-5(-Qg>EL|Hz|zKhMeMlvcx;+JOgLI$ygG4_D=L zN_>ewJxp7*6m@jhY;cg(q-VV>D@EJ@`S0+5QiM~)oypZx@o*NxTJg}02lGtK+4z^I zAx06xz?ooT;Wg%&fs^3}MwC-&zJ@6YZ9KAaVOCb203!bxA@58vRwm*ebVuP~KEjsa z;q(IDc)rY&)p(3Zz)En<`U@e>Ukh9W-CUf779k~`(rSpO`zT5Qdq9*;8v{9EP|?m_%t#B*?b3^d4Z62Mr)pjm)~pzaX+!ONAn{ z<~|y!oBLQ~%G}2z)pLIqshs!ANa4I+MFNY%%UHd8i)g(o?Ru}$=0++n#d~ z9W7wx-TU`C^u0pR@X29Kyd=U@s2vkNT>CdeJr`+UWQh>qKZ*vTUBgZZ1H;9SdPCj; zfy3Qf5-ekI_x2aE9JDPiK`aU{b^=5??oCHH+`Xj=hr2hK;c)jZIaWQcJ&3IKx%Pw_ zPEPHnyy3xc__vty0{X+@?=j`Y*N2ODADQwZ(jfTNDB0o4)%oN_al!mIXDiq4lh^Kq za_Qm9Asip|xK~73#^CM+FGlL0ygv6*AtSAC606U>oC)`{GpKJ_?Q^f6GKRt33%&62 z{Jwi39bhYg9Ps<@1#O_{IpY1b9`}dUe?VS70O)qnmjB=1zv7>@j3;ig7ELR-JX9>* z(HG~d<>7BSt_V9dSQ|75`!aO)v}}m3PsZc9R3MbI>Pj`mTNdLw90|U)&&rOj_yQ=| zl#X>Jl*ICtY=0g1Zl4Kz-yXI%B;R$agI5(@&~rvdXY2e}vQ>$az4HjE|NDb1=J++I zu9>$cm26pqYtOV!T{VBj%422%eA=ng=1l|mG_nNZ)Q!i?w9lrtB-7K_|JKgV+7=Oi z1obEjj-M8r)|J|ng1fx{fS-=;md@VR__Rc-bwd;`hQY~&3P-g#woW>_)5(tRsU2O3 z&f0cmV@G#)8h%@Pl5s$RGpGlEt?~76j>}r6Q>}28g3=x92x1pPV~GwdjVs=y;Dl`b z*&XY&YvTR@kVLYl1q>8x+0@Yq$(7fhJ9wsE0Y*(DO&RSjO~Qr zLInARHuO{2lfcjLq7W>?(T2|?jdW)!1t#@H%EBUHon&(jmkSAopKDaXB?ROB@!aGy zlJ*J|J{_^)*rsd6w#PdY@nq_=>%?8%Fx3yoRU#GdZS9$w#C?XpIDrmhKrRMcmwnKw zuTSL=aEJFUvIG{Ejd%4VH_@B%WU?JI4q%o7QW)sl#9%a=EVwqcqkGQh;ECz>Wa}60 zij0PRmaEw4U4%Qk9ZM9fQ=-eMr933~*@e{A@_EE=yCSj5&%~Q(ms4?xz0b~NrYbX& z`D~m+Hr?{Yc8C@U>m*mZvwZF|HWHAd>l4%KK6^98nle^892<}_#&I{pe@Y}3hzqBp z{JGRWqp+d&FFcvFY1n6(nqnu*pP^BtdmtQG>mz=)#*qq#Yo42y`#M9v$NR9)r=4`S zs)Nx=i<0x|i*I4~!PBHb%YFUDv=jd$C5))Jv}YprFEiwk*^(i+h&u=%vutR>k@Ij# z9!Gq>c61N}f-4^66b`=7zv=AzKl{(v>wDR!t}tHqz3NjNjaPmD=`+5euGp5Lu(4PF zLPpW_8==xi z47JI4gjU+fDs7~dHqlBOX{AlH(neZoldGy`sOm98U1dB*t7^uo0B@C|4kH-jW&J8c zo4(E1ZtO7B1~`1zP}dlD8&BZR6Ho;J_ZaUGoOg_m@$&D+^(Oq>Y~G4Lx0*Xlyt%{t z6<$7TzJfpd&5M2TbFmLNSVJl8^gWCMf7thkAZZG19kro~j4xw&8lr--C0gPgRVU)Yq^WKP5Fnp%1XIQ%VhI03&BK1L>A? z;Ov}>k&E5h^T37iJV*%_jEAz#Evz~?nNCig0UU%)S0txdfpuQ3{yVnu-_`%1AFToW zjJ2SFwQay+iRvt5D3jpUq-lc60n$hzjW(p2LIhPCbtx#Bx|yl@W_3HNdAs@p)#<2+ z*U0c18D1mDYjol@GrVSo*Ua&nw-L=4YYELO83_=^+ACFUhJCY{-Q@VGOI7g8OVuk? zJ=MQWAq#-7Z42p(hUf#LZARObfT3(LMX?y)LN`PEP&G}I?*ryFK6SNmx9@KBp1XY? z;ng<(@BHxdc;K2K{M;1$7XIuEzKcJ1hQ1$CaeFLoSLD}z|3%H@{F-7sZ@!LE>UHy7 zGmut_1_sWn*=D?J{t_xt^6C9E6(%=`ThBJ4r`PyKmNi5fUCir)CC{~f&Xi@3ALuw7)E@l^1) z2>)&H)nI_p-)6ju(pm}9+8J{D2^9#F|GUONFv2~6tz8B3{~P}N&3C0AfLHpz=J$O? zNhxEt8DH~n^9RWJ#Jp{wAZXbtP!JGVWekKa4@FW2=V*&EVViMz=qiAn=YU-mx--Oh zvceRQzY_!fo#q3ko=R^sc7}cu;-OxrPk-Siu+;=qU-HAxOa9mV1obuKqKR_RM5}EA z`%)EEp>JT}KTzaXeOmoC(BSWVdZ3=FMVp0EzA2~&s<(lG?F^DT_XZygBI;AY=ja`j zBA~LWpt29l%X|i?18!k;K{$ET|BPP`z{$IT%Yr`ATyzWij}{0k1GGTs4(<>Gv|Mn2 zmNV;@P8yHJjLUq$?hNbHH}u{dX2Ey~ax-ik!-->9IDq{OND0FmI~D4|OIi=dF`PJt zg@aUs*9Eni+xV%-4_q>S7>?n@F)SRA+)csnFj10Ij>9eiN4IfwCys96AYq{VZt!wY zHQ3lKAq+ysEofM1GsZOlqV(_#d19x&q1t(j9>H0OwQ?NYiKAOMq!sV@uMA*Eb!Fi3 z0PEVV@RfKHL-dpCn-~<|RBzX5=)PV57Uoai(jQ@fNAzcOYSmVFGM-g`kG;z8)yJ_L z|CM$-bl#*0{5+yRt;4;iu^5V&6xet(=|68)_oxsEkp^{b<2~&no$SwzGA{wbB^^NQ z3C-P`Wyps1YhOi9zY3L6PQRr;ihxJ;pE1DC^p_Fvvc8igfjfxHmUZLb0 zvypG+Tp7rlwckk&3zy^#1`b8+5i=ifJ zvj_Cc4Kcahr(U4}!WG)H8lXQ5xe1l(^V(|~1~}Re4{AdseHzksAodRJJDS=^+=End zGu#I75P}_1O zz^^t4n)f|~UED+d$Nhy4?1|8<$Nf*@%_pHM=_W1yb4Uw-*bBb5;RltAXL^4ni8t?) zy2&e9aL%}TC<9kSkr(-I@`Lz(1Sy4n&J;{1pmd|+$Fev1#m?IpGI!$;Yq$BZN%i!w z`5XeCGrw((FvtZ_vN7a?vqoCAsMl;{7JT$zqQCYmKx7t#`P*O)gA{uF1bPKHI6?Cnt4`+T56z{nxmk^QO7xJ83V8}M*%0~hQM7Zz)FvT z>d6h#T^KWugX;TLsrr4|Cuq-~XxCz&c&&b;?jW*HdmlOh<9)o{%x_bM2jPNy(oXF` ztmQ%NRgH(*L2WyNwrk(i95wD&{}+w-f7Pq8FS=U0#(8@{-G;Zfsei!!;}7aPs(iZ< zZoh#&!yEK=qw{t%+Kr6l3K?!cGHl}R^DjPRb8kr1aG|(G;B-DN645w;K0akh>)J<+s zc~6}o^fv#5zZpUUjN|7Tr(CQ;T->LTi{=)b#<^DmgZZ_N6Ei3!&qgSA7G1GJYXr7aT1-?-1^u1r1{D*Ma#V z%-y~XeS@(F`UAkSPxt9>>c-p9zZhGgPl1u3eY($h(=gtKzRcKaZZ&~z`*g_smT7z& z+qwt3NT^Ua_1)()9)Paj*azJ`^g!0>zuaFf*;)r#&h zZ+aE`^;z#@--=%fu~IbQ{04q!;K0Fc$m)vem97TFp^r8F@S;Mub{q}|ca`5)G&~M& zOgxaKo)d8Q*ep1W_{C2aoHhV8WWm9;!uP67sswT!e!G*U)Gpi^Ru`rE3zdH2!#srD_3^7G}nDH4678J8h#imW~Ov=o#kBYS*RsrxH}B>KGZP->%3cICU~k!p1QO z&TQf9Ec@>rmD*1*LreMJ`wWy%aPFy6l#Pnl%vOZp{M5)~&k=@GLU4}OGvSP5IC)mP zGzn*_W`DDwtH)&Yof8>O0m1o-Zolzw|1D-XMFgiYV?8SwPBFo`BBQ6a0?uB`T8_wA zPY2fTv~7wk)$!_>RUYRWubZsd9;(VM&a>YPCFN$6DU@0jup9 zc>bK)&UvoOf#;iDJkRfHb#xFrG|sbk?{FXB?939`p205%buk|P9w7Cm2-y#iW=9Y5 zzW`a}fcW8Or=wIk`}oO*OhFt6{9cEC*iOSV5i;7O z$+8WZj9={?BSMbBZ6{}mkdqN|q6on?5EFAmNEblr=83)eCj9>HWR4@pgx@Yul;!GY zj|ugj@o<(E54USx@o=RT5BCAJekV@S?#-#c7n@%3XKfDg=OtJCY3g%Epo^gPwTp(2 zKQ{nQ^PdhMoGL#fqZjJ>q(@V(mlyIk-lB?A^82?3bCG} z@Qc7E5mN7?abvh>ycX+OC6?L%kRb=HbK!J{19B;TwP-<-@wSz?3G{#i=X(4C@(j`D z{~f;pZ5AQ-W7{2&Un0(G5rWHk?mtuH@GXR_adDORfK7f(+X2}MkX_Dk6F_!4Am0N>VGHNECy`Fo z)=^*9ESv`cr@qT!nE*+2ix6C+uR7uAVG-vX4r%J6{a!;#Z2O=5bPaHupMLN%iN;qSbADpbPfA|t3-an zkUutDEkeeJXe6;Cz+nJM42n1>gy`A_n!``29ilxy20Dmm^i!*px`U0SGmQGVeAFXH zdHLyk2KUpgs+XT)rc3>F7T_$;?5BS2gEMt6Ki!>!pC0e>(}td&PV`icw-6+@?|N@P z<)eVL4(nY3r3!BlCI2OqyaUpPHQy*g(ui}D2suAQhg&w}Du6UQXx#*m`ddYuZvtek z1ATRs&b`j@eEcJB}k_Y3M#J_RKDe?5m1juyv zog&Uyz-jn~2*Led>b8rJdAOj+H$_Mz;(SYlv;bu9w?#+_Ap7qUAr}E;=S~rF6F~O; zK!n^0khMP&J?<`m)Q@)eXw(wWqIOMGlq)lOO1+vr>$YlEr+D^gXGX6Jdi!1J=M z)^-1Eo*Q!DIpNM6`j&O1((}7G-UDIIvv=n33-rNVj!X|rWy$bAK%57}Qd%DP&QBb< zF-~pn79qGUV#C9Zc>pZ+sAGHqkiy3u83;i3{mjwB0%Z3S9MaX(8pov8l02P<1e}3i zh@}Pqvi2!=cA6ON&QAL!U$*s*I}^2M(R;P9s*IQ33q5`LfBoE-U-z6*e9Pp%Jjhmt zk$o9kOEq}3XLdS}gN#o3vo{O+baw?^}aR-e;*i5?@V92^Ep4= zp0=?sz-?oZr)~86hJOx%df%CY-tV$wOG{_-hWIA-$tnM90)7X6GrZp8fK&aVsME~= zNjM8vs)Hh6uR;>-mHGNd%P-%K3r z?gSZDzwIr5#+EnQ5KW{vnWUwqO_pZUgo^eL(Q%om>!&}Y6Usb0@~ z@kuXx=Bs!;^R3JB%om^M;!|AuJoix5ZS(wDEk2>8&uZWD%pvQ`vOlZEnTkSd#>|(| z4nMN&P*{M*<){1K&Ym0Zbm%>^pYFBvo|lnl)K^(G*O%sVKVRnh`o!e=y4O<|Yb{+= zXM7(3b+O&xx;S0QL<^s-H(JluD?OjBCpE6Gh-X|)nXbbbv|`I7sAuOp?taj=jYs7^j@icU9Afys z9P;PZ9Ad&P!^DKz`72gVYF@Tr)-dmiFr4{y!{M+#WytDN7RhZV^(;8E!BLNr31{x2 ztT@Zgtj~@!cgk=$U{aILJoC%|vve;Ue(r_C{j_2-_tPi*_KJ{BKgFDc`stgVarJB~ zu2!g-{1kn8Acwg6vE|F<8RIJYa);&1<2`*DpQut_{-bB?9m*m04qCByhiB|vX8F6Y z-jpl$?tUkG?9Ii$_79h568o7?Y-4yEn~!UiXTe!~W_5O)xrM{va2tDdDz~w7;VO{P z#%>F68;g1N1v_)-3krSQevW6)uw~omHn?qU^R$hvoNGPhyf+6qFUdj9`6ie1_dMmSlxLUowVFNe=U88i{nZt4IeYh~Cjm~~ zyW-e$6+nzJJU33a$D^ruODZr%oT-Qb&d_^eFMKXG+JSQ^QqMA*abE$hem^|U>)0#fdQEXr!dFf$$)`Y1nVsb0PLd7|qk;_9dw7sr z?~A%uPjrF7d!h@?OxYk>`2HN;>O97JtMd%cw>mGjykNi-_Em87R$Hy!D(Kl;{n+x9 z(>ycJy7KJ36|S03d#in(z15Gz?367uC;lD42JIi-o5ll?dWRQG1xU36asogS`$gZu zZC0i@a5eyBp9AMgEcIvUP3HaF=GOt*gb~}k#bKt|IcCpynu6fdCEDFgPiZpLC#NFa(=*5&bxDvGrqgbG8w+sqT}!GLM~_TH|l=|I75FC zW9IV!+3$e71CYW05g~r)f(qXkA>#qk;DF2k$X*9z9+vt*ghT-{^np7*+qUtcE{)bd zg>4Lu$v%tziWQ%a^o-Ai0Un<_;W#>@jje0qHuemJ#V0e`*u$2MUEvv@pUUI$`6JJ- zNCtC=&)co|{G?}m-f!9JQqya6e4UkVtn|z`@ZBbA&u@6z^Zp!SIN2q|is8i>ZGMJj z^TLXp><<@714l?FKJ>PEhN4(Fw$**etxo?;5h)j|3xv7V8J<>mUSRlV3TSmR+qu=< z>>1gX7IUkc>KWN~tJ&vLPAKKp(wwokLQ6P1lzl8*U6I`qaG#q(4}Pp?ZI-@fd~y2X zqofZ%pWe!*Rqg#ANJS3su2^0mtnMoOT~Ne%9{yRI-7eo}YS+#jY(6gso8Ov)%|B_` z{Ku-7&G%b2pY*i({W;kD^_I=!XKI0rHXjUgn}5nvrvo|I{4K-TJk$HxqTXH42N!g9 zo{A6c_U54Xy$4b6g*oW`h8*<%_}N_V?|bU~ogDODt>rLpZ0Y^%j57?V_up80f8JB? zJ9E(co*eYP)zZ6jabU#Z7yELBeFsnz(YJRHl%|m`Nbem4q*o!-(1J7xO?nGRZ-y$p zcaSDEQF_;M-*G49nmq2 z6tv*BDUt*8A@z*3n%=dhKh1_Q>^jq5DsnI7W=6sezw}BJ>3A+(aOKmd!!}Lq7hq*G zjY-J!rg8>1cH?o_rh(ql&xEaC$?Cw?$)ZSDCT%Hf-qp*y!?k1uKa?@#Y+bj9?y5?v zbjT6-MV;aES>kgF<~S+E0R!N0-75!{uk^#Acm;*Y2DgA=1=94@#7&vyP?LUQm72?# z;E8Z*=mC!}Po`OU97cbPuTsweHoRf8Xf>ZYGhnD9QC^m-Fy|feT+BM~`KR5hrqAH_ z7XuDAv7LJwU-KW!b?!C1+>xvnzAHdS6FlB@>aoS-Pi$Q`{?oII|yAl=VO zySzcugdF>>ocmDDeSfWK|D;�L7_a9QGaPI#|M&CdswhsY9W)_itX|)GFhFa%xTQ z>E7Au(SwhK4eiwJx7qN@&n|Ns>VD1CV$t)txm|Qsj-S(Nbepwj&u03XuZzFoKKQ;W z60>KirY2_RA8&wug4qQ$X}HWG8c_@BGe%m*Cc-aPC`NY96JvuqL7ir$T^glb2Bls8 zpy@{%(+G`edX9aoY-G0-+kOJazAwe8LtIch2)-7J6wW|Sq$BIHkldX69!ar5k)Te? z(p4ddqF%f&Ou8Qx#5-%G)!=^nEYa6wo9uuig|aif1r7x^9I>>zIy>s{m0I#b)`TGs zaSbj3U9-mpwSeUH;w7TkOD*{zCgo0Is-+4qN-d??_OmEX!$6(7rIx}2D9jGo!5xEY zN`Zn<`;+6|1mA1vewmR?P@NsD*v=uvm$1P?%n{d267N`F+iFu2G~K}mbvxgWjd895 z?19V1GcaGtJa^YTQMP?qj(s%6>9aVjUtG{iEOLz#qNg$Kk%qk0FI8{_P2=o%$+@pW zak@friY141tN%0h8Y?99MQN84u2^%r4QFYs>03642QB$2A?JQ1#i<3ZsnbK^DY01h zIIQ4*>Uzat7s(-^+NBB{kTrG)PSI_+Vx~AOFb-=OhZUhX?T9x>k#V>`}0rLxwAO%@(GKBXkW;cHPNJ7@AZ49{^W*|2mJHug$}E@eB1B z?_DGG`gOj--iW&Ue{n1NAKYTu{$T)~27)Jn;F$jaQ!foEsWCkVX7YyunM{NO%`3J% zFM*{)W8?Nk#*Bj!rb`%{djoCS9VB+wJ$yzgk`6e9sYoTPY5G|mDu%_iS(Dm{wZp65Wl(x!=9DB55 zePSz+UwnA&W&<)lFS2@DJXiiVaAcoL)A-yNXl%m!qEIOTHxcQww+S`HP_66I&ci%= z_RzZ?_3ve8q)k`U7lveqj?N!uEY-J4{$;>8{+>fY=X10IdKZhfS5~?c);=R&Y@IBu zPRI$zoQoYqEUZmj4H@6G&KDM8j+i9ky9HavPp(HZv>LnH6Ci9$OExg0D_8@++}gxz z$D{V{>hT(v<*`($YzFV;GUV9yCp4$6GLifgzB)yk zOyvJy@((FglBeet=Ok~{LDxAHr}7l1IMbfvdN6emJOu=A16>QoVZA9%&;A44E^uiV z&SSx)ML3+VP@EQ0oIc|G=RVi$r8n59qf?EcojPUIz!ZWttU*Up02;&y0I8u6y~+G$RVAk{^EY)!DC zxL$u)h4YVvLVFQ6_<~Z!P1U5MstO@I?$8?8Zt2JnU2Smt+y--?#X3;&XN=BFZ1@x9 zTvdV1NZwXRglaMd?RFc3z zFca&|+oDCEZnd)$_&Sf#0Sy!h)+6q!T};g`di37)M~uV7z)Ct0EUp8L2Qj!ay|Ub0o?sm}ohXk?(h^!AYZ z9?Gi?W^SPC&)E!K(LZWUY6twzR{7A)gIJ4QNL|CTi@{f~3Nrvor@Vg`thXo?WBjd! z2R1Ah)-3De8FaU}cT?1@R}ad7lB)Y`3C&V=udeqFAz83|=Iinu`(Vne`TCS3ILegd zFBwaFP4?jIDF>Q+prE)^D>zBEvQX1`PNKheejKZpY0*=_T{Emjq%tnf3O)rIv7Teb$!`xYCM-!ttRfpof3)mB*Gl2(D z+IYjMDv@GU%V$jlEay_y{)|c&O%yuLalU?M&A%Ke3;GW59OG4FRR9YXEWb~fjd1ML za-TfxkF1uwk*fbu6Du=&KkF__;@1Pl8Xo5Dv&=le3%eiIb&tR&7{=6~=ZO;!tBG;!MdhzA$ah%%RrKN@va3Avxj3pDF?2!6gG<&o0p zO+k?)TQ6DHDj@cZ#<|7+ZDoZ5t$iJQ%+0o0wlwC!S!H zo{d-cSJe9|Pk+#&5}F?nCsxQ#lLStiq72>$CiM+1u0ciMNfii*n6G$^UrTzA8m{8* z?e2CoT)_o_pI`!^-YF_wlCw;4&xeZ|e0B}ncODKdx{B+^iX`teNhlg^_M77t;MzPC z<~8+e$UEwDh3<@co(WOM;*Y33-N!QdGp!%`4?nq=`i9GtbaH?xrsYqf_immQ-mtF4 zIs(5*3V~P#N(D32%!`Z{aZfrWGg88sZbKr#=1MxPPc3P8k7`yQtHXu{aY$p9UNn+n z+B$rvK*xedIDQQHG=L|~$T9|Wb*A^2=rz#51l)A-VBKTA;h-2xXBW!r;K z0G2vgwyC)fd#mvh;}ccrtSR2D7MGjr_bs;UN{<;}%tn1{A5{uY=`$Gjq(b|ObKVk2 zH8G?Ysv08N<;WyvFa(4xr*^OoXGNcn0X$ ztL`e#^P+1;k zozN82TdbF3M}DZt5V-K66n?V7oc1~f&}1Np*1VZboxy0=JEG>}@hC533uaval!w>D zrbTg5$$sxCUml`kV|*!BM9oDeSJjJ@XYp|{;3?8n?aW{aCOZh>K%Eh86LkjxAEB)_34M!1Gxw)Qz!>U4Cq z#xGKLftM}r`&_mbTio%|7?f${7Y(&+;>TYBu#wn=PW7i>Xud_XN**Ta~JVGzUv*&ZjXVI0u)FVUP2~SCt zXm3#|ZT$Ji?dD{dM8qcP z2b-EDXPokkD~Gki>G)5XfqPPf4KhT8cdWkEQXd<7AcoIA+ck2(??2WE@1gnh*-K}S zV?IJh9Q{sOQt+3~Gsk{&sRZas!Sm?!HxEnFNTqcM71*Zz%F`PbW$wKIYWYeqf&$Ih zR`6QKK$G7)yUJ=L>HMud^Q6L9k^&lq-7S10Qu@VSN?BK-B>jA3m&6rkS12$(Vc)iv zVViS8oulBhelw`e`)0#%d@@d1UEvgu@*I-QM~nIQQj)o;UHs2ZM+!UNpM4s!bIWM_ z5X|^Xd*Xe~ypuO{d=ITb5>~13uKgW*R&0gfbtQKFBdvU~L5Y$0Y0bXwfb^OUJi%tA zrtsMA%bnPLmwo6x@@$KbjA?xDD^7fPl2C5@vY*OiXBQfzYkkhE5rVpq^QO8i-%dgL z4d;6v`w6wy0)ceyB9eZ@};*^u>`QZbZ%$=7Ct5Or6ykC&=FP^W0A z)7evIwW3EjTu`^(M^Jkx^zUB0)ObS^|IuYwe0IOE ztQj;YsQp=FiOxUIjEPInpX<*ghWoLKj3~`AMZ0{A@3uv^cZA<3aOW4l#UfaaT?vB9k|0*a+$b| z=eZz+-a75~eXnhU&pv*V-#caORXrpFtRv1cACOho-zu#&$b6_wmUuVZLwh^VyO5B7 zSBW#}QHOA^P;?aQ-BI(7{;kLc?SzDeLbU<0pmh3;pGK+l#K>ezLcH-C8djuSRh7-m zxu3ND+o0zWOXR8Oz-BXb#R#$n^?`%vqRh?38Rs;%<_B8^K6IrgvoC3*$qk^W72sE5 z{^gOsjI9wj{MKWb`Gz4U^^BO^sZv14C;!D2!>q)Fo9 zqaqkt@XW}byna-!8SyRq%iSMx+YuD9gk&RWv7H;2~2kh?resk~w0 zDhp8)D+FC`7JW>;qSl}uV4AhT@Jn;19uWlT3Hw3Bk9W3|p{=gzRpT>|PXB6-a}-)8 zB@P;_wP?8EBEff{JWeiiV5HPhR-c=sPDw8;wlSR-5;*R*nfaZSpl3k~b29tr z((61)O`20EQQYeI!h~zNI-E3YS}dDnR8VtSgAw+d)|^ z%XdrWy$MNWF+Ck@4{k4IwCMMek)7qV9npcjHZA%bF6TLMkCyR{Jdx96(W+0WB%{Sz z#$kNPJRn--*0k{f-3pK8;1omy3zhh$DUre(R$DZ?Iv&u>9+g3)^>jANrR*Xs^$@Tsn3uyZTrTo=p{LN6(`n=Y!ffl={qFSk;^Zt~*1o;+Tg_38M zH!Z@H;hx0@^yt8DM4C z{lO+5uW-mCFxYSt0*v!3VId;Yh}zbQ&nepCEOGo{(}%aepAF3l>k z_b^xQEQZ@@g&6x)>h{vLj<0^S;8zGsP@AhTD3!H482gy}krny{-%2w!`q`v8)8VUi z0UA<>*h15!eUo8o>`b0+3s0+BWof z$Uf?Z#52W%ex(q7)B3UR-ieL7GI7oe;e;V6z`t?BPcf79;)g9Tifa5gU&w4L%%3eRNylRpIo2 zG_IzIC|N`+aAftP6En5TfjSS?02IJwi6iZlf^GC_{$0*-&gVu}U@&*ROI5s?M*@|r zn7mEtAF+I9MuVOwkLztr9n~jLKe4MvGy_d@+vQOodBF)o-a(Tvd-p!YZkzN*1EFk2 z7RAh!mla1|?E>>;Y`ry6`k6~lma?SRm#L(n9Tk#jEeFvQn~sk^%4!pZ)FQ{#SmT=z z<5y>DjypQx%6xH{rgj^^hCnNpencpBLyg~KbV}qUe!=yZC*qC}RyAPGE|EO9PMkS8 zU0-}tpSAF`^mjmt@9Au}|R&k}wZp{}lRVXSK}k9eFp3BfnQ_lAHCD z&xX<{%ErS-gm|wb0E10+%hd~B&UN$LJgkW1C=;G~r;5?k73J=|FOJCCm6t_WL&AH! zF;HI|Y4Mz2qH_gH%T>v19=5_&_&V`&pZCWsS_(_wzfBJlLvBQB7rnM;y8ad{`ZeOE zOw)3rC8(X}yb9Pl(xk7RxO%D;<#e4#Xwe5$l&@^B*s|ENzUbLIQp_~3+}ZM{F!zXj z5-mD*`s*WS`6?l-oGYTxwZ|Zt?ZO_ykk{0DuS(UqJAJ*b0B$pBMmeWdHzV z0CxfGFb}&|9(IEM&hBEORsm8HRuWIGd~DsM1Vx3UgrtT4hwDNuyoO#!6nA#*)ly7=#4D z#b@IF0KC1Eh$UeiHe71)^&)4_nUl!~_i^4be9SJUK#erhP{pGp7BvwQACadwDi2h3 zI;JlipV^}Si0ZYfCfG1E9(a(+)=4f#td_mVhZuVs5OOVkBfGE26!II(TToa8ACmdI z#~r}UxUV#B7(S<%!?{6aNB{9{+2O*reI98H?W3F=u+i&a3CqH6+U^VY#4n05O&4-q zESD5%Se9>u%yZ|i@ZY;bAL=W#XADOU?MZv{*$z&b_`#LW5x(v(lQk*=w+<$X*&t zzB{Jk`atF|CN$@8bWCX2J4B>?@V)ocHR1g$7IHcpw(SPa;lISBEVS&mwV7!T11NjD z(he#l^6u7op=KzOg}^UCcP80a?AE@usNMEZc~)(CfuS+79OL9%+-5W7T<2!CLHvbi zC3v|W5TFo{l-7v871*P(-~u;i2pDiei6R>Ww-@en9k5r7XZf<~QgJDqYC34vwTz%Mm@wK=;3W600>c4YH~Zk z&yXU`LrBLDuL#{fDfi5i8K6(z!NzK9h+ACgRKeCI8C8BO~G zTq0;@`02U5Zgovr$YeS*84Xw=0&TGwQ8C#TpOBOj^Wpi>O946FiagS3pzj;^U?D5T z(?;{Lh6y*m>b~YT#0BL;$rYl#+%r^5{rZgUOwvPYMq7WZ(W*98j^&T4$ZNS4BHl+- zbf7s()PD$oe2khoI8FqqgMNX$jFUS(h}_0zdw>)nr9vc2{RWf~ni>QG#TZbXk;n`l z^z&F%Eko0^{gX^WM~)kUmk!i(LDPNOvwurys_%A<5z4P>y_}Nnw697RBlZ1>mkqmU zUB>UFchfKhY<-#Znz|D__3B;o4_TzApl6{=!4Bb*`w!E{!A0NZt#jN(r_BL$yaLhu z0lHRRMjEjsI(r`KCYMhM!J~T=M&ULNPWM3iykK%dBl2dua#hJQ%DA5Qcj)&sH!Cg+ z3>H?n0*w0ro#>;g1G$`m`|>a6dyC!725UGC{TO~0NlZvcS-pEwEPM4D^WxVQ77#>t zfF#A!Z9~obJcU6_s4!8&1l8)yLTEzb%HZsRM!$?SdP>A!<=4|Ytv^Cwo*bUx3<~ZY za=MH9_l#{$_RO7y)!F+;zQ4>&u%U4kqkpN}z^;A4&LE#ak79s_9>Y6^Q3RmmcU@s5 ze{PMCRO;Ot0+4m`Km$8XYs8bK>u8cK7i|8y{{{CBG}B`iV+#M6b+fIwzL8qv*qAyv z;TUDE;C3_{Sm+pYKL(=tgT>^|3EkOQADX|fR<(UPP5woFaFYYLOgQ-vZWZ3+(dqlrI?i#q83RLg$|_N^CbCY+aZ4Su4fG2WiAw`Ynxk=y6Xh zToFzbe-8}(b$C^pvHeqJ3ZNYJvaMX6VFGwb&21QxDbQ&Vdc64KJZ8nN*gAmatm-e5>fD*ZRNemZ}+{P5I8MI1C4r^-;Um+nTnR48q6@ zg%14vq;}ns!`3`%nvO>o&u;q-W|%#fUlr4bmlj!=1gfEhBuEn&F2BIHfvdVD-`o*8 zMb?rdCWlkn)o2e@wRY_SmWWLU~>xS95%hY#YT8HU_7 zgsly?GO2>=gtLg;-gpBk1ljo8&`Mt3G+48~;X%f)hJg~|=q>C0B_MqVuXL{B`FL|U z$NBb1qjDBu#>_J-7uUZj_(`Rkw^Yn_=$`h#+-B4KM7d<{dEog)2~l0fdTFVm-!vt2 zAf+%3Dh?q_Q05Tmp`?ASEyPO^Nr=cIUahxaJ)HZ@81DC*dwB`+=d~ZI;|)P=TYg>7 zQ)k35O5^Ov3Qs(Ea2zGOao69Kv1w&bzJ9Sc&C literal 0 HcmV?d00001 diff --git a/src/decktemplates/vendor/punk/modules/template_module-0.0.3.tm b/src/decktemplates/vendor/punk/modules/template_module-0.0.3.tm index f4cfdf22..8889eb7c 100644 --- a/src/decktemplates/vendor/punk/modules/template_module-0.0.3.tm +++ b/src/decktemplates/vendor/punk/modules/template_module-0.0.3.tm @@ -94,18 +94,20 @@ package require Tcl 8.6- #} # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -# Base namespace -# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -tcl::namespace::eval %pkg% { - tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase - #variable xyz + +tcl::namespace::eval %pkg% { + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + # Base namespace + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[subsection {Namespace %pkg%}] #[para] Core API functions for %pkg% #[list_begin definitions] + variable PUNKARGS + + #proc sample1 {p1 n args} { @@ -167,6 +169,112 @@ tcl::namespace::eval %pkg%::lib { #} + + +# == === === === === === === === === === === === === === === +# Sample 'about' function with punk::args documentation +# == === === === === === === === === === === === === === === +tcl::namespace::eval %pkg% { + tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase + variable PUNKARGS + variable PUNKARGS_aliases + + lappend PUNKARGS [list { + @id -id "(package)%pkg%" + @package -name "%pkg%" -help\ + "Package + Description" + }] + + namespace eval argdoc { + #namespace for custom argument documentation + proc package_name {} { + return %pkg% + } + proc about_topics {} { + #info commands results are returned in an arbitrary order (like array keys) + set topic_funs [info commands [namespace current]::get_topic_*] + set about_topics [list] + foreach f $topic_funs { + set tail [namespace tail $f] + lappend about_topics [string range $tail [string length get_topic_] end] + } + #Adjust this function or 'default_topics' if a different order is required + return [lsort $about_topics] + } + proc default_topics {} {return [list Description *]} + + # ------------------------------------------------------------- + # get_topic_ functions add more to auto-include in about topics + # ------------------------------------------------------------- + proc get_topic_Description {} { + punk::args::lib::tstr [string trim { + package %pkg% + description to come.. + } \n] + } + proc get_topic_License {} { + return "%license%" + } + proc get_topic_Version {} { + return "$::%pkg%::version" + } + proc get_topic_Contributors {} { + set authors {%authors%} + set contributors "" + foreach a $authors { + append contributors $a \n + } + if {[string index $contributors end] eq "\n"} { + set contributors [string range $contributors 0 end-1] + } + return $contributors + } + proc get_topic_custom-topic {} { + punk::args::lib::tstr -return string { + A custom + topic + etc + } + } + # ------------------------------------------------------------- + } + + # we re-use the argument definition from punk::args::standard_about and override some items + set overrides [dict create] + dict set overrides @id -id "::%pkg%::about" + dict set overrides @cmd -name "%pkg%::about" + dict set overrides @cmd -help [string trim [punk::args::lib::tstr { + About %pkg% + }] \n] + dict set overrides topic -choices [list {*}[%pkg%::argdoc::about_topics] *] + dict set overrides topic -choicerestricted 1 + dict set overrides topic -default [%pkg%::argdoc::default_topics] ;#if -default is present 'topic' will always appear in parsed 'values' dict + set newdef [punk::args::resolved_def -antiglobs -package_about_namespace -override $overrides ::punk::args::package::standard_about *] + lappend PUNKARGS [list $newdef] + proc about {args} { + package require punk::args + #standard_about accepts additional choices for topic - but we need to normalize any abbreviations to full topic name before passing on + set argd [punk::args::parse $args withid ::%pkg%::about] + lassign [dict values $argd] _leaders opts values _received + punk::args::package::standard_about -package_about_namespace ::%pkg%::argdoc {*}$opts {*}[dict get $values topic] + } +} +# end of sample 'about' function +# == === === === === === === === === === === === === === === + + +# ----------------------------------------------------------------------------- +# register namespace(s) to have PUNKARGS,PUNKARGS_aliases variables checked +# ----------------------------------------------------------------------------- +# variable PUNKARGS +# variable PUNKARGS_aliases +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::%pkg% +} +# ----------------------------------------------------------------------------- + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide %pkg% [tcl::namespace::eval %pkg% { diff --git a/src/make.tcl b/src/make.tcl index de7e055a..6776eb79 100644 --- a/src/make.tcl +++ b/src/make.tcl @@ -18,7 +18,7 @@ namespace eval ::punkboot { variable foldername [file tail $scriptfolder] variable pkg_requirements [list]; variable pkg_missing [list];variable pkg_loaded [list] variable non_help_flags [list -k] - variable help_flags [list -help --help /?] + variable help_flags [list -help --help /? -h] variable known_commands [list project modules vfs info check shell vendorupdate bootsupport vfscommonupdate] } @@ -180,10 +180,14 @@ set bootsupport_module_paths [list] set bootsupport_library_paths [list] if {[file exists [file join $startdir src bootsupport]]} { lappend bootsupport_module_paths [file join $startdir src bootsupport modules] + lappend bootsupport_module_paths [file join $startdir src bootsupport modules_tcl$::tclmajorv] lappend bootsupport_library_paths [file join $startdir src bootsupport lib] + lappend bootsupport_library_paths [file join $startdir src bootsupport lib_tcl$::tclmajorv] } else { lappend bootsupport_module_paths [file join $startdir bootsupport modules] + lappend bootsupport_module_paths [file join $startdir bootsupport modules_tcl$::tclmajorv] lappend bootsupport_library_paths [file join $startdir bootsupport lib] + lappend bootsupport_library_paths [file join $startdir bootsupport lib_tcl$::tclmajorv] } set bootsupport_paths_exist 0 foreach p [list {*}$bootsupport_module_paths {*}$bootsupport_library_paths] { @@ -203,13 +207,13 @@ set sourcesupport_paths_exist 0 #(most?) Modules in src/modules etc should still be runnable directly in certain cases like this where we point to them. if {[file tail $startdir] eq "src"} { #todo - other src 'module' dirs.. - foreach p [list $startdir/modules $startdir/modules_tcl$::tclmajorv] { + foreach p [list $startdir/modules $startdir/modules_tcl$::tclmajorv $startdir/vendormodules $startdir/vendormodules_tcl$::tclmajorv] { if {[file exists $p]} { lappend sourcesupport_module_paths $p } } # -- -- -- - foreach p [list $startdir/vendorlib $startdir/vendorlib_tcl${::tclmajorv}] { + foreach p [list $startdir/lib $startdir/lib_tcl$::tclmajorv $startdir/vendorlib $startdir/vendorlib_tcl$::tclmajorv] { if {[file exists $p]} { lappend sourcesupport_library_paths $p } @@ -266,9 +270,12 @@ if {$bootsupport_paths_exist || $sourcesupport_paths_exist} { package forget $pkg } } - tcl::tm::add {*}$bootsupport_module_paths {*}$sourcesupport_module_paths - set ::auto_path [list {*}$bootsupport_library_paths {*}$sourcesupport_library_paths] + #tcl::tm::add {*}$original_tm_list {*}$bootsupport_module_paths {*}$sourcesupport_module_paths + #set ::auto_path [list {*}$original_auto_path {*}$bootsupport_library_paths {*}$sourcesupport_library_paths] + tcl::tm::add {*}$bootsupport_module_paths {*}$sourcesupport_module_paths + set ::auto_path [list {*}$bootsupport_library_paths {*}$sourcesupport_library_paths] } + puts "----> auto_path $::auto_path" @@ -1046,7 +1053,9 @@ proc ::punkboot::punkboot_gethelp {args} { append h " - before calling this (followed by make project) - you can test using '(.exe) dev'" \n append h " this will load modules from your /module /lib paths instead of from the kit/zipkit" \n \n append h " $scriptname info" \n - append h " - show the name and base folder of the project to be built" \n + append h " - show the name and base folder of the project to be built" \n \n + append h " $scriptname check" \n + append h " - show module/library paths and any potentially problematic packages for running this script" \n append h "" \n if {[llength [dict get $pkg_availability missing]] || [llength [dict get $pkg_availability broken]]} { set has_recommended 0 @@ -1116,6 +1125,7 @@ if {[llength $commands_found] != 1 } { set do_help 1 } if {$do_help} { + puts stdout "Checking package availability..." set ::punkboot::pkg_availability [::punkboot::check_package_availability -quiet 1 $::punkboot::bootsupport_requirements] foreach pkg_request [dict get $::punkboot::pkg_availability loaded] { #puts stderr "---> $pkg_request" @@ -1407,6 +1417,7 @@ if {$::punkboot::command eq "vendorupdate"} { puts stderr "Unable to use punkcheck for vendormodules$which update. Error: $errM" set installation_event "" } + #todo - sync alg with bootsupport_localupdate! foreach {relpath requested_module} $local_modules { set requested_module [string trim $requested_module :] set module_subpath [string map {:: /} [namespace qualifiers $requested_module]] @@ -1488,6 +1499,11 @@ if {$::punkboot::command eq "bootsupport"} { #puts "-- [tcl::tm::list] --" puts stdout "Updating bootsupport from local files" + proc modfile_sort {p1 p2} { + lassign [split [file rootname $p1] -] _ v1 + lassign [split [file rootname $p1] -] _ v2 + package vcompare $v1 $v2 + } proc bootsupport_localupdate {projectroot} { set bootsupport_modules [list] ;#variable populated by include_modules.config file - review set sourcefolder $projectroot/src @@ -1521,57 +1537,66 @@ if {$::punkboot::command eq "bootsupport"} { set boot_event "" } - foreach {relpath module} $bootsupport_modules { - set module [string trim $module :] - set module_subpath [string map [list :: /] [namespace qualifiers $module]] + foreach {relpath modulematch} $bootsupport_modules { + set modulematch [string trim $modulematch :] + set module_subpath [string map [list :: /] [namespace qualifiers $modulematch]] set srclocation [file join $projectroot $relpath $module_subpath] - #puts stdout "$relpath $module $module_subpath $srclocation" - set pkgmatches [glob -nocomplain -dir $srclocation -tail [namespace tail $module]-*] - #lsort won't sort version numbers properly e.g with -dictionary 0.1.1 comes before 0.1 + #puts stdout "$relpath $modulematch $module_subpath $srclocation" + if {[string first - $modulematch]} { + set pkgmatches [glob -nocomplain -dir $srclocation -tail -type f [namespace tail $modulematch]*.tm] + } else { + set pkgmatches [glob -nocomplain -dir $srclocation -tail -type f [namespace tail $modulematch]-*.tm] + } if {![llength $pkgmatches]} { - puts stderr "Missing source for bootsupport module $module - not found in $srclocation" + puts stderr "Missing source for bootsupport module $modulematch - no matches in $srclocation" continue } - set latestfile [lindex $pkgmatches 0] - set latestver [lindex [split [file rootname $latestfile] -] 1] - foreach m $pkgmatches { - lassign [split [file rootname $m] -] _pkg ver - #puts "comparing $ver vs $latestver" - if {[package vcompare $ver $latestver] == 1} { - set latestver $ver - set latestfile $m - } + + set modulematch_is_glob [regexp {[*?\[\]]} $modulematch] + if {!$modulematch_is_glob} { + #if modulematch was specified without globs - only copy latest + #lsort won't sort version numbers properly e.g with -dictionary 0.1.1 comes before 0.1b3 - use helper func + set pkgmatches [lsort -command modfile_sort $pkgmatches] + set latestfile [lindex $pkgmatches end] + #set latestver [lindex [split [file rootname $latestfile] -] 1] + set copy_files $latestfile + } else { + #globs in modulematch - may be different packages matched by glob - copy all versions of matches + #review + set copy_files $pkgmatches } - set srcfile [file join $srclocation $latestfile] - set tgtfile [file join $targetroot $module_subpath $latestfile] - if {$boot_event ne ""} { - #---------- - $boot_event targetset_init INSTALL $tgtfile - $boot_event targetset_addsource $srcfile - #---------- - if {\ - [llength [dict get [$boot_event targetset_source_changes] changed]]\ - || [llength [$boot_event get_targets_exist]] < [llength [$boot_event get_targets]]\ - } { - file mkdir [file dirname $tgtfile] ;#ensure containing folder for target exists - $boot_event targetset_started - # -- --- --- --- --- --- - puts "BOOTSUPPORT module$which update: $srcfile -> $tgtfile" - if {[catch { - file copy -force $srcfile $tgtfile - } errM]} { - $boot_event targetset_end FAILED + foreach cfile $copy_files { + set srcfile [file join $srclocation $cfile] + set tgtfile [file join $targetroot $module_subpath $cfile] + if {$boot_event ne ""} { + #---------- + $boot_event targetset_init INSTALL $tgtfile + $boot_event targetset_addsource $srcfile + #---------- + if {\ + [llength [dict get [$boot_event targetset_source_changes] changed]]\ + || [llength [$boot_event get_targets_exist]] < [llength [$boot_event get_targets]]\ + } { + file mkdir [file dirname $tgtfile] ;#ensure containing folder for target exists + $boot_event targetset_started + # -- --- --- --- --- --- + puts "BOOTSUPPORT module$which update: $srcfile -> $tgtfile" + if {[catch { + file copy -force $srcfile $tgtfile + } errM]} { + $boot_event targetset_end FAILED + } else { + $boot_event targetset_end OK + } + # -- --- --- --- --- --- } else { - $boot_event targetset_end OK + puts -nonewline stderr "." + $boot_event targetset_end SKIPPED } - # -- --- --- --- --- --- + $boot_event end } else { - puts -nonewline stderr "." - $boot_event targetset_end SKIPPED + file copy -force $srcfile $tgtfile } - $boot_event end - } else { - file copy -force $srcfile $tgtfile } } if {$boot_event ne ""} { @@ -1597,13 +1622,14 @@ if {$::punkboot::command eq "bootsupport"} { if {[file exists $project_layout_base]} { set project_layouts [glob -nocomplain -dir $project_layout_base -type d -tail *] foreach layoutname $project_layouts { + puts stdout "Processing layout $project_layout_base/$layoutname" #don't auto-create src/bootsupport - just update it if it exists if {[file exists [file join $project_layout_base $layoutname/src/bootsupport]]} { set antipaths [list\ README.md\ ] - set boot_module_folders [glob -nocomplain -dir $projectroot/src/bootsupport/modules_tcl*] - lappend bootsupport_module_folders "modules" + #set boot_module_folders [list modules {*}[glob -nocomplain -dir $projectroot/src/bootsupport/modules_tcl*]] + set bootsupport_module_folders "modules" foreach bm $bootsupport_module_folders { if {[file exists $projectroot/src/bootsupport/$bm]} { lassign [split $bm _] _bm tclx @@ -1617,12 +1643,33 @@ if {$::punkboot::command eq "bootsupport"} { file mkdir $targetroot puts stdout "BOOTSUPPORT$which layouts/$layoutname: copying from $sourcemodules to $targetroot (if source file changed)" - set resultdict [punkcheck::install $sourcemodules $targetroot -overwrite installedsourcechanged-targets -antiglob_paths $antipaths] + + set resultdict [punkcheck::install $sourcemodules $targetroot\ + -overwrite installedsourcechanged-targets\ + -antiglob_paths $antipaths\ + -installer "punkboot-bootsupport" + ] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] flush stdout } } } + #make.tcl (to be boot.tcl?) is part of bootsupport + set source_bootscript [file join $projectroot src/make.tcl] + set targetroot_bootscript $project_layout_base/$layoutname/src + if {[file exists $source_bootscript]} { + puts stdout "BOOTSUPPORT layouts/$layoutname: copying from $source_bootscript to $targetroot_bootscript (if source file changed)" + set resultdict [punkcheck::install [file dirname $source_bootscript] $targetroot_bootscript\ + -glob make.tcl\ + -max_depth 1\ + -createempty 0\ + -overwrite installedsourcechanged-targets\ + -installer "punkboot-bootsupport" + ] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + flush stdout + } } } else { puts stderr "No layout base at $project_layout_base" diff --git a/src/modules/argparsingtest-999999.0a1.0.tm b/src/modules/argparsingtest-999999.0a1.0.tm index 57f8818d..3e82858e 100644 --- a/src/modules/argparsingtest-999999.0a1.0.tm +++ b/src/modules/argparsingtest-999999.0a1.0.tm @@ -276,7 +276,7 @@ namespace eval argparsingtest { #punk::args is slower than argp - but comparable, and argp doesn't support solo flags proc test1_punkargs {args} { - set argd [punk::args::get_dict { + set argd [punk::args::parse $args withdef { @id -id ::argparsingtest::test1_punkargs @cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" @opts -anyopts 0 @@ -292,7 +292,7 @@ namespace eval argparsingtest { -2 -default 2 -type integer -3 -default 3 -type integer @values - } $args] + }] return [tcl::dict::get $argd opts] } diff --git a/src/modules/funcl-0.1.tm b/src/modules/funcl-0.1.tm index 1d2fe64a..e8430fb0 100644 --- a/src/modules/funcl-0.1.tm +++ b/src/modules/funcl-0.1.tm @@ -9,7 +9,7 @@ package provide funcl [namespace eval funcl { namespace eval funcl { - #from punk + #from punk::pipe proc arg_is_script_shaped {arg} { if {[string first " " $arg] >= 0} { return 1 diff --git a/src/modules/patternpunk-1.1.tm b/src/modules/patternpunk-1.1.tm index 6611eee5..42bd91e6 100644 --- a/src/modules/patternpunk-1.1.tm +++ b/src/modules/patternpunk-1.1.tm @@ -113,7 +113,7 @@ proc TCL {args} { punk::args::define { #Review - @id -id ">punk . poses" + @id -id "::>punk . poses" @cmd -name ">punk . poses" -help "Show or list the poses for the Punk mascot" -censored -default 1 -type boolean -help "Set true to include mild toilet humour poses" -return -default table -choices {list table} @@ -323,15 +323,16 @@ _+ +_ +_+_ } \n] ->punk .. Property fossil [string trim { - .. - > < - \ / v -v \\_/ - \/\\ v . -v_ /|\/ / - \__/ -} \n] +>punk .. Property fossil [punk::args::lib::tstr [string trim { + .. + > < + \ / v + v \\_/ + \/\\ v . + v_ /|\/ / + \__/ +} \n]] + >punk .. Method deck {args} { #todo - themes? set this @this@ @@ -344,7 +345,7 @@ v_ /|\/ / set punk $punk_colour[$this . lhs_air]$RST package require punk::args set standard_frame_types [textblock::frametypes] - set argd [punk::args::get_dict [tstr -return string { + set argd [punk::args::parse $args withdef [tstr -return string { @id -id ">punk . deck" @cmd -name "deck" -help "Punk Deck mascot" -frame -default arc -choices "${$standard_frame_types}" -choicerestricted 0 -choiceprefix 1 @@ -356,7 +357,7 @@ v_ /|\/ / -title -default "PATTERN" -type string -subtitle -default "PUNK" -type string @values -max 0 - }] $args] + }]] set frame_type [dict get $argd opts -frame] set box_map [dict get $argd opts -boxmap] set box_limits [dict get $argd opts -boxlimits] diff --git a/src/modules/punk-0.1.tm b/src/modules/punk-0.1.tm index 738d89c5..a53ea000 100644 --- a/src/modules/punk-0.1.tm +++ b/src/modules/punk-0.1.tm @@ -20,6 +20,21 @@ namespace eval punk { variable cmdexedir set cmdexedir "" + proc sync_package_paths_script {} { + #the tcl::tm namespace doesn't exist until one of the tcl::tm commands + #is run. (they are loaded via ::auto_index triggering load of tm.tcl) + #we call tcl::tm::list to trigger the initial set of tm paths before + #we can override it, otherwise our changes will be lost + #REVIEW - won't work on safebase interp where paths are mapped to {$p(:x:)} etc + return "\ + apply {{ap tmlist} { + set ::auto_path \$ap + tcl::tm::list + set ::tcl::tm::paths \$tmlist + }} {$::auto_path} {[tcl::tm::list]} + " + } + proc rehash {{refresh 0}} { global auto_execs if {!$refresh} { @@ -217,7 +232,7 @@ namespace eval punk { [file exists [set testapp [file join $::env(LOCALAPPDATA) "Microsoft" "WindowsApps" "winget.exe"]]])} { #should be unlikely to get here - unless LOCALAPPDATA missing set windowsappdir [file dirname [lindex [::punk::auto_execok_windows winget.exe] 0]] - puts stderr "(resolved winget by search)" + catch {puts stderr "(resolved winget by search)"} } else { set windowsappdir [file dirname $testapp] } @@ -359,7 +374,7 @@ if {![llength [info commands ::ansistring]]} { } #require aliascore after punk::lib & punk::ansi are loaded package require punk::aliascore ;#mostly punk::lib aliases -punk::aliascore::init +punk::aliascore::init -force 1 package require punk::repl::codethread package require punk::config @@ -370,6 +385,9 @@ package require punk::winpath ;# for windows paths - but has functions that can package require punk::repo package require punk::du package require punk::mix::base +package require base64 + +package require punk::pipe namespace eval punk { # -- --- --- @@ -383,8 +401,10 @@ namespace eval punk { package require punk::assertion if {[catch {namespace import ::punk::assertion::assert} errM]} { - puts stderr "punk error importing punk::assertion::assert\n$errM" - puts stderr "punk::a* commands:[info commands ::punk::a*]" + catch { + puts stderr "punk error importing punk::assertion::assert\n$errM" + puts stderr "punk::a* commands:[info commands ::punk::a*]" + } } punk::assertion::active on # -- --- --- @@ -393,7 +413,7 @@ namespace eval punk { if {[catch { package require pattern } errpkg]} { - puts stderr "Failed to load package pattern error: $errpkg" + catch {puts stderr "Failed to load package pattern error: $errpkg"} } package require shellfilter package require punkapp @@ -524,7 +544,7 @@ namespace eval punk { set loader [zzzload::pkg_wait twapi] } errM]} { if {$loader in [list failed loading]} { - puts stderr "Unexpected problem during thread-load of pkg twapi - zzload::pkg_wait returned $loader" + catch {puts stderr "Unexpected problem during thread-load of pkg twapi - zzload::pkg_wait returned $loader"} } } else { package require twapi @@ -546,13 +566,15 @@ namespace eval punk { #get last command result that was run through the repl proc ::punk::get_runchunk {args} { - set argd [punk::args::get_dict { + set argd [punk::args::parse $args withdef { @id -id ::punk::get_runchunk + @cmd -name "punk::get_runchunk" -help\ + "experimental" @opts -1 -optional 1 -type none -2 -optional 1 -type none @values -min 0 -max 0 - } $args] + }] #todo - make this command run without truncating previous runchunks set runchunks [tsv::array names repl runchunks-*] @@ -637,44 +659,8 @@ namespace eval punk { set ::argc $argc return -code $code $return } - #https://randomascii.wordpress.com/2012/02/25/comparing-floating-point-numbers-2012-edition/ - # - #we can't provide a float comparison suitable for every situation, - #but we pick something reasonable, keep it stable, and document it. - proc float_almost_equal {a b} { - package require math::constants - set diff [expr {abs($a - $b)}] - if {$diff <= $math::constants::eps} { - return 1 - } - set A [expr {abs($a)}] - set B [expr {abs($b)}] - set largest [expr {($B > $A) ? $B : $A}] - return [expr {$diff <= $largest * $math::constants::eps}] - } + - #boolean could be tr, true, y, ye, yes,Yes, 1 , 0 etc. - proc boolean_equal {a b} { - #equivalenttly xnor: expr {!(($a && 1) ^ ($b && 1))} ;# less clear and no discernable timing benefit. - expr {($a && 1) == ($b && 1)} - } - #debatable whether boolean_almost_equal is likely to be surprising or helpful. - #values from a calculation that are extremely close to zero but aren't false could also be surprising - especially if they compare equal numerically - #perhaps a fuzzy-boolean is a step too far for a default - but it's inline with float-comparison for pattern-matching. use an even more complex classifier? (^&~) ? - proc boolean_almost_equal {a b} { - if {[string is double -strict $a]} { - if {[float_almost_equal $a 0]} { - set a 0 - } - } - if {[string is double -strict $b]} { - if {[float_almost_equal $b 0]} { - set b 0 - } - } - #must handle true,no etc. - expr {($a && 1) == ($b && 1)} - } proc varinfo {vname {flag ""}} { @@ -789,142 +775,6 @@ namespace eval punk { scan $s %${p}s%s } - #split top level of patterns only. - proc _split_patterns_memoized {varspecs} { - set name_mapped [pipecmd_namemapping $varspecs] - set cmdname ::punk::pipecmds::split_patterns::_$name_mapped - if {[info commands $cmdname] ne ""} { - return [$cmdname] - } - set result [_split_patterns $varspecs] - proc $cmdname {} [list return $result] - #debug.punk.pipe.compile {proc $cmdname} 4 - return $result - } - proc _split_patterns {varspecs} { - - set varlist [list] - # @ @@ - list and dict functions - # / level separator - # # list count, ## dict size - # % string functions - # ! not - set var_terminals [list "@" "/" "#" "%" "!" ">" "<"] ;# (> required for insertionspecs at rhs of = & .= ) - #right bracket ) also ends a var - but is different depending on whether var is array or basic. For array - it forms part of the varname - - #except when prefixed directly by pin classifier ^ - set protect_terminals [list "^"] ;# e.g sequence ^# - #also - an atom usually doesn't need the / as a terminal - because it can't match a missing element unless it's empty string - #ie the one usecase is '/n to match either empty string or missing item at position n. For this one usecase - we miss the capability to atom match paths/urls .. '/usr/local/et' - set in_brackets 0 ;#count depth - set in_atom 0 - #set varspecs [string trimleft $varspecs ,] - set token "" - #if {[string first "," $varspecs] <0} { - # return $varspecs - #} - set first_term -1 - set token_index 0 ;#index of terminal char within each token - set indq 0 - set inesc 0 ;#whether last char was backslash (see also punk::escv) - set prevc "" - set char_index 0 - foreach c [split $varspecs ""] { - if {$indq} { - if {$inesc} { - #puts stderr "inesc adding '$c'" - append token $c - } else { - if {$c eq {"}} { - set indq 0 - } else { - append token $c - } - } - } elseif {$in_atom} { - #ignore dquotes/brackets in atoms - pass through - append token $c - #set nextc [lindex $chars $char_index+1] - if {$c eq "'"} { - set in_atom 0 - } - } elseif {$in_brackets > 0} { - append token $c - if {$c eq ")"} { - incr in_brackets -1 - } - } else { - if {$c eq {"} && !$inesc} { - set indq 1 - } elseif {$c eq ","} { - #lappend varlist [splitstrposn $token $first_term] - set var $token - set spec "" - if {$first_term > 0} { - #tcl scan with %s will not handle whitespace as desired. Be explicit using string range instead. - #lassign [scan $token %${first_term}s%s] var spec - set var [string range $token 0 $first_term-1] - set spec [string range $token $first_term end] ;#key section includes the terminal char which ended the var and starts the spec - } else { - if {$first_term == 0} { - set var "" - set spec $token - } - } - lappend varlist [list [string trim $var] [string trim $spec]] - set token "" - set token_index -1 ;#reduce by 1 because , not included in next token - set first_term -1 - } else { - append token $c - switch -exact -- $c { - ' { - set in_atom 1 - } - ( { - incr in_brackets - } - default { - if {$first_term == -1 && (($c in $var_terminals) && ($prevc ni $protect_terminals))} { - set first_term $token_index - } - } - } - } - } - set prevc $c - if {$c eq "\\"} { - #review - if {$inesc} { - set inesc 0 - } else { - set token [string range $token 0 end-1] - set inesc 1 - } - } else { - set inesc 0 - } - incr token_index - incr char_index - } - if {[string length $token]} { - #lappend varlist [splitstrposn $token $first_term] - set var $token - set spec "" - if {$first_term > 0} { - #lassign [scan $token %${first_term}s%s] var spec - set var [string range $token 0 $first_term-1] - set spec [string range $token $first_term end] ;#key section includes the terminal char which ended the var and starts the spec - } else { - if {$first_term == 0} { - set var "" - set spec $token - } - } - lappend varlist [list [string trim $var] [string trim $spec]] - } - return $varlist - } proc _split_var_key_at_unbracketed_comma {varspecs} { set varlist [list] set var_terminals [list "@" "/" "#" "!"] @@ -1061,7 +911,7 @@ namespace eval punk { proc destructure {selector data} { # replaced by proc generating destructure_func - - puts stderr "punk::destructure .d. selector:'$selector'" + catch {puts stderr "punk::destructure .d. selector:'$selector'"} set selector [string trim $selector /] upvar v_dict_idx v_dict_idx ;#positional tracker for /@@ - dict position @@ -1506,7 +1356,24 @@ namespace eval punk { #map some problematic things out of the way in a manner that maintains some transparency #e.g glob chars ? * in a command name can make testing using {[info commands $cmd] ne ""} produce spurious results - requiring a stricter (and slower) test such as {$cmd in [info commands $cmd]} #The selector forms part of the proc name - set selector_safe [string map [list ? * {$} "" "\x1b\[" "\x1b\]" {[} {]} :: {;} " " \t \n \r ] $selector] + #review - compare with pipecmd_namemapping + set selector_safe [string map [list\ + ? \ + * \ + \\ \ + {"} \ + {$} \ + "\x1b\[" \ + "\x1b\]" \ + {[} \ + {]} \ + :: \ + {;} \ + " " \ + \t \ + \n \ + \r \ + ] $selector] set cmdname ::punk::pipecmds::destructure::_$selector_safe if {[info commands $cmdname] ne ""} { @@ -1645,7 +1512,7 @@ namespace eval punk { set SUBPATH [join [lrange $subindices 0 $i_keyindex] /] append script \n "# ------- START index:$index subpath:$SUBPATH ------" set lhs $index - append script \n "set lhs $index" + append script \n "set lhs {$index}" set assigned "" append script \n {set assigned ""} @@ -2219,6 +2086,7 @@ namespace eval punk { #vV set keyglob [string range $index 4 end] } + #if $keyglob eq "" - needs to query for dict key that is empty string. if {$get_not} { lappend INDEX_OPERATIONS globkey-get-values-not append script \n [tstr -return string -allowcommands { @@ -2226,7 +2094,7 @@ namespace eval punk { ${[tstr -ret string $tpl_return_mismatch_not_a_dict]} } # set active_key_type "dict" index_operation: globkey-get-values-not - set matched [dict keys $leveldata ${$keyglob}] + set matched [dict keys $leveldata {${$keyglob}}] set assigned [dict values [dict remove $leveldata {*}$matched]] }] @@ -2237,7 +2105,7 @@ namespace eval punk { if {[catch {dict size $leveldata}]} { ${[tstr -ret string $tpl_return_mismatch_not_a_dict]} } - set matched [dict keys $leveldata ${$keyglob}] + set matched [dict keys $leveldata {${$keyglob}}] set assigned [list] foreach m $matched { lappend assigned [dict get $leveldata $m] @@ -2260,7 +2128,7 @@ namespace eval punk { lappend INDEX_OPERATIONS globkey-get-pairs-not append script \n [string map [list $keyglob] { # set active_key_type "dict" index_operation: globkey-get-pairs-not - set matched [dict keys $leveldata ] + set matched [dict keys $leveldata {}] set assigned [dict remove $leveldata {*}$matched] }] @@ -2268,7 +2136,7 @@ namespace eval punk { lappend INDEX_OPERATIONS globkey-get-pairs append script \n [string map [list $keyglob] { # set active_key_type "dict" index_operations: globkey-get-pairs - set matched [dict keys $leveldata ] + set matched [dict keys $leveldata {}] set assigned [dict create] foreach m $matched { dict set assigned $m [dict get $leveldata $m] @@ -2290,7 +2158,7 @@ namespace eval punk { lappend INDEX_OPERATIONS globkey-get-keys-not append script \n [string map [list $keyglob] { # set active_key_type "dict" index_operation: globkey-get-keys-not - set matched [dict keys $leveldata ] + set matched [dict keys $leveldata {}] set assigned [dict keys [dict remove $leveldata {*}$matched]] }] @@ -2298,7 +2166,7 @@ namespace eval punk { lappend INDEX_OPERATIONS globkey-get-keys append script \n [string map [list $keyglob] { # set active_key_type "dict" index_operation: globkey-get-keys - set assigned [dict keys $leveldata ] + set assigned [dict keys $leveldata {}] }] } set level_script_complete 1 @@ -2306,7 +2174,7 @@ namespace eval punk { {@k\*@*} - {@K\*@*} { #dict value glob - return keys set active_key_type "dict" - set keyglob [string range $index 4 end] + set valglob [string range $index 4 end] append script [tstr -return string -allowcommands { if {[catch {dict size $leveldata}]} { ${[tstr -ret string $tpl_return_mismatch_not_a_dict]} @@ -2314,22 +2182,22 @@ namespace eval punk { }] if {$get_not} { lappend INDEX_OPERATIONS globvalue-get-keys-not - append script \n [string map [list $keyglob] { + append script \n [string map [list $valglob] { # set active_key_type "dict" index_operation: globvalue-get-keys-not set assigned [list] tcl::dict::for {k v} $leveldata { - if {![string match "" $v]} { + if {![string match {} $v]} { lappend assigned $k } } }] } else { lappend INDEX_OPERATIONS globvalue-get-keys - append script \n [string map [list $keyglob] { + append script \n [string map [list $valglob] { # set active_key_type "dict" index_operation: globvalue-get-keys set assigned [list] tcl::dict::for {k v} $leveldata { - if {[string match "" $v]} { + if {[string match {} $v]} { lappend assigned $k } } @@ -2340,7 +2208,7 @@ namespace eval punk { {@.\*@*} { #dict value glob - return pairs set active_key_type "dict" - set keyglob [string range $index 4 end] + set valglob [string range $index 4 end] append script [tstr -return string -allowcommands { if {[catch {dict size $leveldata}]} { ${[tstr -ret string $tpl_return_mismatch_not_a_dict]} @@ -2348,22 +2216,22 @@ namespace eval punk { }] if {$get_not} { lappend INDEX_OPERATIONS globvalue-get-pairs-not - append script \n [string map [list $keyglob] { + append script \n [string map [list $valglob] { # set active_key_type "dict" index_operation: globvalue-get-pairs-not set assigned [dict create] tcl::dict::for {k v} $leveldata { - if {![string match $v]} { + if {![string match {} $v]} { dict set assigned $k $v } } }] } else { lappend INDEX_OPERATIONS globvalue-get-pairs - append script \n [string map [list $keyglob] { + append script \n [string map [list $valglob] { # set active_key_type "dict" index_operation: globvalue-get-pairs set assigned [dict create] tcl::dict::for {k v} $leveldata { - if {[string match $v]} { + if {[string match {} $v]} { dict set assigned $k $v } } @@ -2374,7 +2242,7 @@ namespace eval punk { {@V\*@*} - {@v\*@*} { #dict value glob - return values set active_key_type dict - set keyglob [string range $index 4 end] + set valglob [string range $index 4 end] append script [tstr -return string -allowcommands { if {[catch {dict size $leveldata}]} { ${[tstr -ret string $tpl_return_mismatch_not_a_dict]} @@ -2382,11 +2250,11 @@ namespace eval punk { }] if {$get_not} { lappend INDEX_OPERATIONS globvalue-get-values-not - append script \n [string map [list $keyglob] { + append script \n [string map [list $valglob] { # set active_key_type "dict" ;# index_operation: globvalue-get-values-not set assigned [list] tcl::dict::for {k v} $leveldata { - if {![string match $v]} { + if {![string match {} $v]} { lappend assigned $v } } @@ -2394,9 +2262,9 @@ namespace eval punk { } else { lappend INDEX_OPERATIONS globvalue-get-values - append script \n [string map [list $keyglob] { + append script \n [string map [list $valglob] { # set active_key_type "dict" ;#index_operation: globvalue-get-value - set assigned [dict values $leveldata ] + set assigned [dict values $leveldata ] }] } set level_script_complete 1 @@ -2420,14 +2288,14 @@ namespace eval punk { # set active_key_type "dict" ;# index_operation: globkeyvalue-get-pairs-not set assigned [dict create] tcl::dict::for {k v} $leveldata { - if {[string match $k] || [string match $v]} { + if {[string match {} $k] || [string match {} $v]} { dict set assigned $k $v } } }] } - - error "globkeyvalue-get-pairs todo" + set level_script_complete 1 + puts stderr "globkeyvalue-get-pairs review" } @* { set active_key_type "list" @@ -3092,157 +2960,6 @@ namespace eval punk { return $script } - #todo - recurse into bracketed sub parts - #JMN3 - #e.g @*/(x@0,y@2) - proc _var_classify {multivar} { - set cmdname ::punk::pipecmds::var_classify::_[pipecmd_namemapping $multivar] - if {[info commands $cmdname] ne ""} { - return [$cmdname] - } - - - #comma seems a natural choice to split varspecs, - #but also for list and dict subelement access - #/ normally indicates some sort of hierarchical separation - (e.g in filesytems) - #so / will indicate subelements e.g @0/1 for lindex $list 0 1 - #set valsource_key_list [_split_var_key_at_unbracketed_comma $multivar] - set valsource_key_list [_split_patterns_memoized $multivar] - - - - #mutually exclusive - atom/pin - #set map [list "" ' ^ &] ;#0 = default/var/not-yet-determined 1 = atom 2 = pin - #set var_class [lmap var $valsource_key_list {expr {([set m [lsearch $map [string index [lindex $var 0] 0]]] >= 0) ? [list $var $m] : [list $var 0]}}] - #0 - novar - #1 - atom ' - #2 - pin ^ - #3 - boolean & - #4 - integer - #5 - double - #6 - var - #7 - glob (no classifier and contains * or ?) - #8 - numeric - #9 - > (+) - #10 - < (-) - - set var_names [list] - set var_class [list] - set varspecs_trimmed [list] ;#raw varspecs without pin/atom modifiers - or empty string for glob - - - set leading_classifiers [list "'" "&" "^" ] - set trailing_classifiers [list + -] - set possible_number_start [list - + . 0 1 2 3 4 5 6 7 8 9 > <] - - foreach v_key $valsource_key_list { - lassign $v_key v key - set vname $v ;#default - set classes [list] - if {$v eq ""} { - lappend var_class [list $v_key 0] - lappend varspecs_trimmed $v_key - } else { - set lastchar [string index $v end] - switch -- $lastchar { - + { - lappend classes 9 - set vname [string range $v 0 end-1] - } - - { - lappend classes 10 - set vname [string range $v 0 end-1] - } - } - set firstchar [string index $v 0] - switch -- $firstchar { - ' { - lappend var_class [list $v_key 1] - #set vname [string range $v 1 end] - lappend varspecs_trimmed [list $vname $key] - } - ^ { - lappend classes [list 2] - #use vname - may already have trailing +/- stripped - set vname [string range $vname 1 end] - set secondclassifier [string index $v 1] - switch -- $secondclassifier { - "&" { - #pinned boolean - lappend classes 3 - set vname [string range $v 2 end] - } - "#" { - #pinned numeric comparison instead of string comparison - #e.g set x 2 - # this should match: ^#x.= list 2.0 - lappend classes 8 - set vname [string range $vname 1 end] - } - "*" { - #pinned glob - lappend classes 7 - set vname [string range $v 2 end] - } - } - #todo - check for second tag - & for pinned boolean? - #consider requiring ^# for numeric comparisons. currently no way to do a strictly string comparison on pinned variables.... default ^var really shouldn't be doing any magic. - #while we're at it.. pinned glob would be nice. ^* - #maybe even pinned scan ^% ? regex? ^/ or ^? these would be hard to have corresponding literals in the pattern mini-lang. - #These all limit the range of varnames permissible - which is no big deal. - lappend var_class [list $v_key $classes] - lappend varspecs_trimmed [list $vname $key] - } - & { - #we require boolean literals to be single-quoted so we can use cross-binding on boolean vars. - #ie &true is the variable true whereas &'true' or &'1' &'t' etc are literal booleans - #allow exception of &1 &0 to be literal booleans - because we disallow 0 & 1 as varnames in other contexts anyway - so it would be more consistent not to treat as varnames here. - lappend var_class [list $v_key 3] - set vname [string range $v 1 end] - lappend varspecs_trimmed [list $vname $key] - } - default { - if {([string first ? $v]) >=0 || ([string first * $v] >=0)} { - lappend var_class [list $v_key 7] ;#glob - #leave vname as the full glob - lappend varspecs_trimmed [list "" $key] - } else { - #scan vname not v - will either be same as v - or possibly stripped of trailing +/- - set numtestv [join [scan $vname %lld%s] ""] ;# handles octals (leading zeros), ok for use with bignums, decimal points and sci notation - fails to handle leading dot e.g .5 - #leading . still need to test directly for double - if {[string is double -strict $vname] || [string is double -strict $numtestv]} { - if {[string is integer -strict $numtestv]} { - #this will pick up boolean 1 or 0 - but that's ok - they require "&" marker if boolean comparison desired - #integer test before double.. - #note there is also string is wide (string is wideinteger) for larger ints.. - lappend classes 4 - lappend var_class [list $v_key $classes] - lappend varspecs_trimmed $v_key - } else { - #double - #sci notation 1e123 etc - #also large numbers like 1000000000 - even without decimal point - (tcl bignum) - lappend classes 5 - lappend var_class [list $v_key $classes] - lappend varspecs_trimmed $v_key - } - } else { - lappend var_class [list $v_key 6] ;#var - lappend varspecs_trimmed $v_key - } - } - } - } - } - lappend var_names $vname - } - - set result [list var_names $var_names var_class $var_class varspecs_trimmed $varspecs_trimmed] - - proc $cmdname {} [list return $result] - debug.punk.pipe.compile {proc $cmdname} - return $result - } @@ -3263,24 +2980,24 @@ namespace eval punk { return [dict create ismatch 1 result $data setvars {} script {}] #return [dict create ismatch 1 result [list $data] setvars {} script {}] } - set returndict [dict create ismatch 0 result "" setvars {}] - set script "" + set returndict [dict create ismatch 0 result "" setvars {}] + set script "" - set defaults [list -unset 0 -levelup 2 -mismatchinfo 1 -script 0] - set opts [dict merge $defaults $args] - set unset [dict get $opts -unset] - set lvlup [dict get $opts -levelup] - set get_mismatchinfo [dict get $opts -mismatchinfo] + set defaults [list -unset 0 -levelup 2 -mismatchinfo 1 -script 0] + set opts [dict merge $defaults $args] + set unset [dict get $opts -unset] + set lvlup [dict get $opts -levelup] + set get_mismatchinfo [dict get $opts -mismatchinfo] #first classify into var_returntype of either "pipeline" or "segment" #segment returntype is indicated by leading % - set varinfo [_var_classify $multivar] - set var_names [dict get $varinfo var_names] - set var_class [dict get $varinfo var_class] - set varspecs_trimmed [dict get $varinfo varspecs_trimmed] + set varinfo [punk::pipe::lib::_var_classify $multivar] + set var_names [dict get $varinfo var_names] + set var_class [dict get $varinfo var_class] + set varspecs_trimmed [dict get $varinfo varspecs_trimmed] set var_actions [list] set expected_values [list] @@ -3665,7 +3382,7 @@ namespace eval punk { } } } else { - if {[punk::float_almost_equal $testlhs $testval]} { + if {[punk::pipe::float_almost_equal $testlhs $testval]} { lset match_state $i 1 } else { if {$isgreaterthan} { @@ -3744,7 +3461,7 @@ namespace eval punk { } } else { #float_almost_equal will disagree with expr based on scale.. just enough to allow for example [expr 0.2 + 0.1] to equal 0.3 - whereas expr will declare a mismatch - if {[punk::float_almost_equal $lhs $testval]} { + if {[punk::pipe::float_almost_equal $lhs $testval]} { lset match_state $i 1 lset expected_values $i [list var $varname spec $lhsspec info match-float-almost-equal lhs $lhs rhs $val] } else { @@ -3760,7 +3477,7 @@ namespace eval punk { # Also - the setting of the variable x is normalized to 1 or 0 only. (true & false would perhaps be nicer - but 1 & 0 are theoretically more efficient for later comparisons as they can have a pure int rep?.) # todo - consider the booleanString rep. Can/should we return true & false instead and maintain efficiency w.r.t shimmering? # - #punk::boolean_equal $a $b + #punk::pipe::boolean_equal $a $b set extra_match_info "" ;# possible crossbind indication set is_literal_boolean 0 if {$ispin} { @@ -3829,7 +3546,7 @@ namespace eval punk { #may have already matched above..(for variable) if {[lindex $match_state $i] != 1} { - if {![catch {punk::boolean_almost_equal $lhs $val} ismatch]} { + if {![catch {punk::pipe::boolean_almost_equal $lhs $val} ismatch]} { if {$ismatch} { lset match_state $i 1 lset expected_values $i [list var $varname spec $lhsspec info match-boolean-almost-equal$extra_match_info lhs $lhs rhs $val] @@ -4124,18 +3841,6 @@ namespace eval punk { tailcall interp alias {} $targetcmd {} apply [list args [concat "\[concat" [list $cmdcopy] "\$args]"] $nscaller] } - #map rhs to names suitable to use in pipemcd proc name (whitespace mapping) - # (for .= and = pipecmds) - proc pipecmd_namemapping {rhs} { - #used to build a command from a pattern which could contain :: - we need to map it to keep it a single command in the desired namespace. - #glob chars will prevent us using simple test {[info commands $cmd] eq ""} to test existence - #we could use the test {$cmd in [info commands]} - but mapping away globchars is more robust, allowing the simpler test - set rhs [string trim $rhs];#ignore all leading & trailing whitespace - set rhs [regsub -all {\s{1,}} $rhs {}] ;#collapse all internal whitespace to a single token - set rhs [tcl::string::map {: ? * } $rhs] - #review - we don't expect other command-incompatible chars such as colon? - return $rhs - } #same as used in unknown func for initial launch #variable re_assign {^([^\r\n=\{]*)=(.*)} @@ -4151,7 +3856,7 @@ namespace eval punk { #puts stderr ">> match_assign '$scopepattern=$equalsrhs' $args" set fulltail $args set cmdns ::punk::pipecmds - set namemapping [pipecmd_namemapping $equalsrhs] + set namemapping [punk::pipe::lib::pipecmd_namemapping $equalsrhs] #we deliberately don't call pipecmd_namemapping on the scopepattern even though it may contain globs. REVIEW #(we need for example x*= to be available as is via namespace path mechanism (from punk::pipecmds namespace)) @@ -4222,7 +3927,7 @@ namespace eval punk { # as we aren't in a pipleine - there is no data to insert - we proably still need to run _split_equalsrhs to verify the syntax. # review - consider way to turn it off as optimisation for non-pipelined assignment - but generally standard Tcl set could be used for that purpose. # We are probably only here if testing in the repl - in which case the error messages are important. - set var_index_position_list [_split_equalsrhs $equalsrhs] + set var_index_position_list [punk::pipe::lib::_split_equalsrhs $equalsrhs] #we may have an insertion-spec that inserts a literal atom e.g to wrap in "ok" # x='ok'>0/0 data # => {ok data} @@ -4448,84 +4153,6 @@ namespace eval punk { - #todo - consider whether we can use < for insertion/iteration combinations - # =a<,b< iterate once through - # =a><,b>< cartesian product - # =a<>,b<> ??? zip ? - # - # ie = {a b c} |> .=< inspect - # would call inspect 3 times, once for each argument - # .= list {a b c} {x y z} |a/0,b/1> .=a><,b>< list - # would produce list of cartesian pairs? - # - proc _split_equalsrhs {insertionpattern} { - #map the insertionpattern so we can use faster globless info command search - set name_mapped [pipecmd_namemapping $insertionpattern] - set cmdname ::punk::pipecmds::split_rhs::_$name_mapped - if {[info commands $cmdname] ne ""} { - return [$cmdname] - } - - set lst_var_indexposition [punk::_split_patterns_memoized $insertionpattern] - set i 0 - set return_triples [list] - foreach v_pos $lst_var_indexposition { - lassign $v_pos v index_and_position - #e.g varname@@data/ok>0 varname/1/0>end - #ensure only one ">" is detected - if {![string length $index_and_position]} { - set indexspec "" - set positionspec "" - } else { - set chars [split $index_and_position ""] - set posns [lsearch -all $chars ">"] - if {[llength $posns] > 1} { - error "pipesyntax error in segment insertion pattern '$insertionpattern' -v '$v' multiple '>' characters. Pattern not understood." "_split_equalsrhs $insertionpattern" [list pipesyntax insertionpattern_invalid] - } - if {![llength $posns]} { - set indexspec $index_and_position - set positionspec "" - } else { - set splitposn [lindex $posns 0] - set indexspec [string range $index_and_position 0 $splitposn-1] - set positionspec [string range $index_and_position $splitposn+1 end] - } - } - - #review - - if {($positionspec in [list "*" "/*" "@*" "/" "@"]) || ($v eq "*" && $positionspec eq "")} { - set star "" - if {$v eq "*"} { - set v "" - set star "*" - } - if {[string index $positionspec end] eq "*"} { - set star "*" - } - #it is always possible to insert at end of list regardless of current length - so /end* and @end* are equivalent - #as are /end and @end - #lset lst_var_indexposition $i [list $v "/end$star"] - set triple [list $v $indexspec "/end$star"] - } else { - if {$positionspec eq ""} { - #e.g just =varname - #lset lst_var_indexposition $i [list $v "/end"] - set triple [list $v $indexspec "/end"] - #error "pipesyntax error in segment insertionpattern '$insertionpattern' - v '$v' missing position spec e.g /0" - } else { - if {[string index $indexspec 0] ni [list "" "/" "@"]} { - error "pipesyntax error in segment insertionpattern '$insertionpattern' - v '$v' bad index spec '$indexspec'" "_split_equalsrhs $insertionpattern" [list pipesyntax insertionpattern_invalid] - } - set triple [list $v $indexspec $positionspec] - } - } - lappend return_triples $triple - incr i - } - proc $cmdname {} [list return $return_triples] - return $return_triples - } - proc _is_math_func_prefix {e1} { #also catch starting brackets.. e.g "(min(4,$x) " if {[regexp {^[^[:alnum:]]*([[:alnum:]]*).*} $e1 _ word]} { @@ -4632,76 +4259,6 @@ namespace eval punk { return $output } - # - # - # relatively slow on even small sized scripts - proc arg_is_script_shaped2 {arg} { - set re {^(\s|;|\n)$} - set chars [split $arg ""] - if {[lsearch -regex $chars $re] >=0} { - return 1 - } else { - return 0 - } - } - - #exclude quoted whitespace - proc arg_is_script_shaped {arg} { - if {[tcl::string::first \n $arg] >= 0} { - return 1 - } elseif {[tcl::string::first ";" $arg] >= 0} { - return 1 - } elseif {[tcl::string::first " " $arg] >= 0 || [tcl::string::first \t $arg] >= 0} { - lassign [_rhs_tail_split $arg] _ part2 ;#will have part2 if unquoted whitespace found - return [expr {$part2 ne ""}] - } else { - return 0 - } - } - proc _rhs_tail_split {fullrhs} { - set inq 0; set indq 0 - set equalsrhs "" - set i 0 - foreach ch [split $fullrhs ""] { - if {$inq} { - append equalsrhs $ch - if {$ch eq {'}} { - set inq 0 - } - } elseif {$indq} { - append equalsrhs $ch - if {$ch eq {"}} { - set indq 0 - } - } else { - switch -- $ch { - {'} { - set inq 1 - } - {"} { - set indq 1 - } - " " { - #whitespace outside of quoting - break - } - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - a - b - c - d - e - f - g - h - i - j - k - l - m - n - o - p - q - r - s - t - u - v - w - x - y - z {} - default { - #\t not a literal for switch jumpTable bytecompile - review - can we do it without for example string mapping to (and without a literal binary tab in source file)? - #we can't (reliably?) put \t as one of our switch keys - # - if {$ch eq "\t"} { - break - } - } - } - append equalsrhs $ch - } - incr i - } - set tail [tcl::string::range $fullrhs $i end] - return [list $equalsrhs $tail] - } # -- #consider possible tilde templating version ~= vs .= @@ -4724,10 +4281,12 @@ namespace eval punk { # test if we have an initial x.=y.= or x.= y.= #nextail is tail for possible recursion based on first argument in the segment - set nexttail [lassign $fulltail next1] ;#tail head + #set nexttail [lassign $fulltail next1] ;#tail head + set next1 [lindex $args 0] switch -- $next1 { pipematch { + set nexttail [lrange $args 1 end] set results [uplevel 1 [list pipematch {*}$nexttail]] debug.punk.pipe {>>> pipematch results: $results} 1 @@ -4767,7 +4326,8 @@ namespace eval punk { #var1 will contain ETC (from entire pipeline), var2 will contain etc (from associated segment) # - if {([set nexteposn [string first = $next1]] >= 0) && (![arg_is_script_shaped $next1]) } { + if {([set nexteposn [string last = $next1]] >= 0) && (![punk::pipe::lib::arg_is_script_shaped $next1]) } { + set nexttail [lrange $args 1 end] #*SUB* pipeline recursion. #puts "======> recurse based on next1:$next1 " if {[string index $next1 $nexteposn-1] eq {.}} { @@ -4824,14 +4384,14 @@ namespace eval punk { set firstargpipe_posn [lsearch $fulltail "<*|"] if {$firstargpipe_posn >=0} { - set tailremaining [lrange $fulltail 0 $firstargpipe_posn-1] - set argslist [lrange $fulltail $firstargpipe_posn+1 end] ;#Note that this could be a whole other pipeline with |> and/or <| elements. - set argpipe [lindex $fulltail $firstargpipe_posn] - set argpipespec [string range $argpipe 1 end-1] ;# strip off < & | from " and/or <| elements. + set argpipe [lindex $fulltail $firstargpipe_posn] + set argpipespec [string range $argpipe 1 end-1] ;# strip off < & | from ">> $segment_members insertion_patterns $insertion_patterns" @@ -5003,7 +4563,7 @@ namespace eval punk { set segment_members_filled [list] set segmenttail $segment_members ;# todo - change to segment_members here to match punk::match_assign - set rhsmapped [pipecmd_namemapping $rhs] + set rhsmapped [punk::pipe::lib::pipecmd_namemapping $rhs] set cmdname "::punk::pipecmds::insertion::_$rhsmapped" #glob chars have been mapped - so we can test by comparing info commands result to empty string if {[info commands $cmdname] eq ""} { @@ -5047,6 +4607,7 @@ namespace eval punk { #review - skip error if varname is 'data' ? #e.g we shouldn't really fail for: #.=>* list a b c <| + #??? Technically #we need to be careful not to insert empty-list as an argument by default error "pipevariable - varname $v not present in pipeline context. pipecontext_vars: [dict keys $dict_tagval] (2)" " pipecontext_vars: [dict keys $dict_tagval]" [list pipevariable variable_not_in_pipeline_scope] } @@ -5294,7 +4855,7 @@ namespace eval punk { set rhs "" set segment_first_is_script 0 if {[llength $next_all_members]} { - if {[arg_is_script_shaped [lindex $next_all_members 0]]} { + if {[punk::pipe::lib::arg_is_script_shaped [lindex $next_all_members 0]]} { set segment_first_word [lindex $next_all_members 0] set segment_first_is_script 1 set segment_op "" @@ -5305,7 +4866,7 @@ namespace eval punk { if {[regexp {^([^ \t\r\n=\{]*)\.=(.*)} $possible_assignment _ returnvarspec rhs]} { set segment_op ".=" set segment_first_word [lindex $next_all_members 1] - set script_like_first_word [arg_is_script_shaped $segment_first_word] + set script_like_first_word [punk::pipe::lib::arg_is_script_shaped $segment_first_word] if {$script_like_first_word} { set segment_first_is_script 1 ;#relative to segment_members which no longer includes the .= } @@ -5741,7 +5302,6 @@ namespace eval punk { #assuming we can't test on cond being present in existing unknown script - because it may be fairly simple and prone to false positives (?) ##This means we can't have 2 different conds with same body if we test for body in unknown. ##if {$body ni $existing} { - package require base64 set scr [base64::encode -maxlen 0 $cond] ;#will only be decoded if the debug is triggered #tcllib has some double-substitution going on.. base64 seems easiest and will not impact the speed of normal execution when debug off. proc ::unknown {args} [string map [list @c@ $cond @b@ $body @scr@ $scr] { @@ -5762,7 +5322,6 @@ namespace eval punk { } proc decodescript {b64} { if {[ catch { - package require base64 base64::decode $b64 } scr]} { return "" @@ -5805,21 +5364,20 @@ namespace eval punk { } # --------------------------- + #---------------- + #for var="val {a b c}" + #proc ::punk::val {{v {}}} {tailcall lindex $v} + #proc ::punk::val {{v {}}} {return $v} ;#2023 - approx 2x faster than the tailcall lindex version + proc ::punk::val [list [list v [purelist]]] {return $v} + #---------------- proc configure_unknown {} { #----------------------------- #these are critical e.g core behaviour or important for repl displaying output correctly - #---------------- - #for var="val {a b c}" - #proc ::punk::val {{v {}}} {tailcall lindex $v} - #proc ::punk::val {{v {}}} {return $v} ;#2023 - approx 2x faster than the tailcall lindex version - proc ::punk::val [list [list v [purelist]]] {return $v} - #---------------- #can't use know - because we don't want to return before original unknown body is called. proc ::unknown {args} [string cat { - package require base64 #set ::punk::last_run_display [list] #set ::repl::last_unknown [lindex $args 0] ;#jn #tsv::set repl last_unknown [lindex $args 0] ;#REVIEW @@ -5865,7 +5423,7 @@ namespace eval punk { #we assume the whole pipeline has been provided as the head #regexp {^([^\t\r\n=]*)\=([^ \t\r\n]*)(.*)} $hd _ pattern equalsrhs tail regexp {^([^\t\r\n=]*)\=([^\r\n]*)} $hd _ pattern fullrhs - lassign [_rhs_tail_split $fullrhs] equalsrhs tail + lassign [punk::pipe::lib::_rhs_tail_split $fullrhs] equalsrhs tail } #NOTE: - it doesn't make sense to call 'namespace' qualifiers or 'namespace tail' on a compound hd such as v,::etc= blah # we only look at leftmost namespace-like thing and need to take account of the pattern syntax @@ -5873,7 +5431,7 @@ namespace eval punk { # the ns is :: and the tail is etc,'::x'= # (Tcl's namespace qualifiers/tail won't help here) if {[string match ::* $hd]} { - set patterns [punk::_split_patterns_memoized $hd] + set patterns [punk::pipe::lib::_split_patterns_memoized $hd] #get a pair-list something like: {::x /0} {etc {}} set ns [namespace qualifiers [lindex $patterns 0 0]] set nslen [string length $ns] @@ -5887,7 +5445,7 @@ namespace eval punk { } else { set nscaller [uplevel 1 [list ::namespace current]] #jmn - set rhsmapped [pipecmd_namemapping $equalsrhs] + set rhsmapped [punk::pipe::lib::pipecmd_namemapping $equalsrhs] set commands [uplevel 1 [list ::info commands $pattern=$rhsmapped]] ;#uplevel - or else we are checking from perspective of this namespace ::punk #we must check for exact match of the command in the list - because command could have glob chars. if {"$pattern=$rhsmapped" in $commands} { @@ -5980,7 +5538,7 @@ namespace eval punk { #regexp {^([^ \t\r\n=\{]*)\.=([^ \t\r\n]*)(.*)} $hd _ pattern equalsrhs argstail regexp {^([^ \t\r\n=\{]*)\.=([^\r\n]*)} $hd _ pattern fullrhs - lassign [_rhs_tail_split $fullrhs] equalsrhs argstail + lassign [punk::pipe::lib::_rhs_tail_split $fullrhs] equalsrhs argstail } #tailcall ::punk::match_assign $pattern $equalsrhs {*}$argstail @@ -6051,7 +5609,7 @@ namespace eval punk { tailcall {*}[list ::punk::pipeline = "" "" {*}$arglist] } - set is_script [punk::arg_is_script_shaped $assign] + set is_script [punk::pipe::lib::arg_is_script_shaped $assign] if {!$is_script && [string index $assign end] eq "="} { #set re_dotequals {^([^ \t\r\n=\{]*)\.=$} @@ -6111,7 +5669,7 @@ namespace eval punk { set cmdlist [list ::punk::pipeline .= "" "" {*}$arglist] } elseif {$assign eq "="} { set cmdlist [list ::punk::pipeline = "" "" {*}$arglist] - } elseif {![punk::arg_is_script_shaped $assign] && [string index $assign end] eq "="} { + } elseif {![punk::pipe::lib::arg_is_script_shaped $assign] && [string index $assign end] eq "="} { #set re_dotequals {^([^ \t\r\n=\{]*)\.=$} # set dumbeditor {\}} #set re_equals {^([^ \t\r\n=\{]*)=$} @@ -6228,7 +5786,7 @@ namespace eval punk { } elseif {$assign eq "="} { #set cmdlist [list ::punk::pipeline = "" "" {*}$arglist] set cmdlist [list ::= {*}$arglist] - } elseif {![punk::arg_is_script_shaped $assign] && [string first "=" $assign] >= 0} { + } elseif {![punk::pipe::lib::arg_is_script_shaped $assign] && [string first "=" $assign] >= 0} { #set re_dotequals {^([^ \t\r\n=\{]*)\.=$} #set dumbeditor {\}} #set re_equals {^([^ \t\r\n=\{]*)=$} @@ -7214,14 +6772,25 @@ namespace eval punk { #An implementation of a notoriously controversial metric. proc LOC {args} { set argspecs [subst { + @dynamic + @id -id ::punk::LOC + @cmd -name punk::LOC -help\ + "LOC - lines of code. + An implementation of a notoriously controversial metric" -dir -default "\uFFFF" -exclude_dupfiles -default 1 -type boolean + ${[punk::args::resolved_def ::punk::path::treefilenames -antiglob_paths]} -exclude_punctlines -default 1 -type boolean + -show_largest -default 0 -type integer -help\ + "Report the top largest linecount files. + The value represents the number of files + to report on." + #we could map away whitespace and use string is punct - but not as flexible? review -punctchars -default { [list \{ \} \" \\ - _ + = . > , < ' : \; ` ~ ! @ # \$ % ^ & * \[ \] ( ) | / ?] } }] set argd [punk::args::get_dict $argspecs $args] - lassign [dict values $argd] leaders opts vals - set searchspecs [dict values $vals] + lassign [dict values $argd] leaders opts values received + set searchspecs [dict values $values] # -- --- --- --- --- --- set opt_dir [dict get $opts -dir] @@ -7229,19 +6798,36 @@ namespace eval punk { set opt_dir [pwd] ;#pwd can take over a ms on windows in a not terribly deep path even with SSDs - so as a general rule we don't use it in the original defaults list } # -- --- --- --- --- --- - set opt_exclude_dupfiles [dict get $opts -exclude_dupfiles] - set opt_exclude_punctlines [dict get $opts -exclude_punctlines] ;#exclude lines that consist purely of whitespace and the chars in -punctchars - set opt_punctchars [dict get $opts -punctchars] + set opt_exclude_dupfiles [dict get $opts -exclude_dupfiles] + set opt_exclude_punctlines [dict get $opts -exclude_punctlines] ;#exclude lines that consist purely of whitespace and the chars in -punctchars + set opt_punctchars [dict get $opts -punctchars] + set opt_largest [dict get $opts -show_largest] # -- --- --- --- --- --- set filepaths [punk::path::treefilenames -dir $opt_dir {*}$searchspecs] set loc 0 set dupfileloc 0 - set seentails [list] + set seentails [dict create] + set seencksums [dict create] ;#key is cksum value is list of paths + set largestloc [dict create] set dupfilecount 0 - set extensions [list] + set extensions [list] set purepunctlines 0 + set dupinfo [dict create] + set has_hashfunc [expr {![catch {package require sha1}]}] + set notes "" + if {$has_hashfunc} { + set dupfilemech sha1 + if {$opt_exclude_punctlines} { + append notes "checksums are on content stripped of whitespace lines,trailing whitespace, and pure punct lines. Does not indicate file contents equal.\n" + } else { + append notes "checksums are on content stripped of whitespace lines and trailing whitespace. Does not indicate file contents equal.\n" + } + } else { + set dupfilemech filetail + append notes "dupfilemech filetail because sha1 not loadable\n" + } foreach fpath $filepaths { set isdupfile 0 set floc 0 @@ -7250,38 +6836,106 @@ namespace eval punk { if {$ext ni $extensions} { lappend extensions $ext } + if {[catch {fcat $fpath} contents]} { + puts stderr "Error processing $fpath\n $contents" + continue + } + set lines [linelist -line {trimright} -block {trimall} $contents] if {!$opt_exclude_punctlines} { - set floc [llength [linelist -line {trimright} -block {trimall} [fcat $fpath]]] + set floc [llength $lines] + set comparedlines $lines } else { - set lines [linelist -line {trimright} -block {trimall} [fcat $fpath]] set mapawaypunctuation [list] foreach p $opt_punctchars empty {} { lappend mapawaypunctuation $p $empty } + set comparedlines [list] foreach ln $lines { if {[string length [string trim [string map $mapawaypunctuation $ln]]] > 0} { incr floc + lappend comparedlines $ln } else { incr fpurepunctlines } } } - if {[file tail $fpath] in $seentails} { - set isdupfile 1 - incr dupfilecount - incr dupfileloc $floc + if {$opt_largest > 0} { + dict set largestloc $fpath $floc + } + if {$has_hashfunc} { + set cksum [sha1::sha1 [encoding convertto utf-8 [join $comparedlines \n]]] + if {[dict exists $seencksums $cksum]} { + set isdupfile 1 + incr dupfilecount + incr dupfileloc $floc + dict lappend seencksums $cksum $fpath + } else { + dict set seencksums $cksum [list $fpath] + } + } else { + if {[dict exists $seentails [file tail $fpath]]} { + set isdupfile 1 + incr dupfilecount + incr dupfileloc $floc + } } if {!$isdupfile || ($isdupfile && !$opt_exclude_dupfiles)} { incr loc $floc incr purepunctlines $fpurepunctlines } - lappend seentails [file tail $fpath] + dict lappend seentails [file tail $fpath] $fpath + #lappend seentails [file tail $fpath] } + if {$has_hashfunc} { + dict for {cksum paths} $seencksums { + if {[llength $paths] > 1} { + dict set dupinfo checksums $cksum $paths + } + } + } + dict for {tail paths} $seentails { + if {[llength $paths] > 1} { + dict set dupinfo sametail $tail $paths + } + } + if {$opt_exclude_punctlines} { - return [list loc $loc filecount [llength $filepaths] dupfiles $dupfilecount dupfileloc $dupfileloc extensions $extensions purepunctuationlines $purepunctlines] + set result [dict create\ + loc $loc\ + filecount [llength $filepaths]\ + dupfiles $dupfilecount\ + dupfilemech $dupfilemech\ + dupfileloc $dupfileloc\ + dupinfo $dupinfo\ + extensions $extensions\ + purepunctuationlines $purepunctlines\ + notes $notes\ + ] + } else { + set result [dict create\ + loc $loc\ + filecount [llength $filepaths]\ + dupfiles $dupfilecount\ + dupfilemech $dupfilemech\ + dupfileloc $dupfileloc\ + dupinfo $dupinfo\ + extensions $extensions\ + notes $notes\ + ] + } + if {$opt_largest > 0} { + set largest_n [dict create] + set sorted [lsort -stride 2 -index 1 -decreasing -integer $largestloc] + set kidx 0 + for {set i 0} {$i < $opt_largest} {incr i} { + if {$kidx+1 > [llength $sorted]} {break} + dict set largest_n [lindex $sorted $kidx] [lindex $sorted $kidx+1] + incr kidx 2 + } + dict set result largest $largest_n } - return [list loc $loc filecount [llength $filepaths] dupfiles $dupfilecount dupfileloc $dupfileloc extensions $extensions] + return $result } @@ -7397,79 +7051,79 @@ namespace eval punk { @id -id ::punk::inspect @cmd -name punk::inspect -help\ "Function to display values - used pimarily in a punk pipeline. - The raw value arguments (not options) are always returned to pass - forward in the pipeline. - (pipeline data inserted at end of each |...> segment is passed as single item unless - inserted with an expanding insertion specifier such as .=>* ) - e.g1: - .= list a b c |v1,/1-end,/0>\\ - .=>* inspect -label i1 -- |>\\ - .=v1> inspect -label i2 -- |>\\ - string toupper - (3) i1: {a b c} {b c} a - (1) i2: a b c - - - A B C - " + The raw value arguments (not options) are always returned to pass + forward in the pipeline. + (pipeline data inserted at end of each |...> segment is passed as single item unless + inserted with an expanding insertion specifier such as .=>* ) + e.g1: + .= list a b c |v1,/1-end,/0>\\ + .=>* inspect -label i1 -- |>\\ + .=v1> inspect -label i2 -- |>\\ + string toupper + (3) i1: {a b c} {b c} a + (1) i2: a b c + + - A B C + " -label -type string -default "" -help\ "An optional label to help distinguish output when multiple - inspect statements are in a pipeline. This appears after the - bracketed count indicating number of values supplied. - e.g (2) MYLABEL: val1 val2 - The label can include ANSI codes. - e.g - inspect -label [a+ red]mylabel -- val1 val2 val3 - " + inspect statements are in a pipeline. This appears after the + bracketed count indicating number of values supplied. + e.g (2) MYLABEL: val1 val2 + The label can include ANSI codes. + e.g + inspect -label [a+ red]mylabel -- val1 val2 val3 + " -limit -type int -default 20 -help\ "When multiple values are passed to inspect - limit the number - of elements displayed in -channel output. - When truncation has occured an elipsis indication (...) will be appended. - e.g - .= lseq 20 to 50 by 3 |> .=>* inspect -limit 4 -- |> .=>* tcl::mathop::+ - (11) 20 23 26 29... + of elements displayed in -channel output. + When truncation has occured an elipsis indication (...) will be appended. + e.g + .= lseq 20 to 50 by 3 |> .=>* inspect -limit 4 -- |> .=>* tcl::mathop::+ + (11) 20 23 26 29... - - 385 + - 385 - For no limit - use -limit -1 - " + For no limit - use -limit -1 + " -channel -type string -default stderr -help\ "An existing open channel to write to. If value is any of nul, null, /dev/nul - the channel output is disabled. This effectively disables inspect as the args - are simply passed through in the return to continue the pipeline. - " + the channel output is disabled. This effectively disables inspect as the args + are simply passed through in the return to continue the pipeline. + " -showcount -type boolean -default 1 -help\ "Display a leading indicator in brackets showing the number of arg values present." -ansi -type integer -default 1 -nocase 1 -choices {0 1 2 VIEW 3 VIEWCODES 4 VIEWSTYLES} -choicelabels { 0 "Strip ANSI codes from display - of values. The disply output will - still be colourised if -ansibase has - not been set to empty string or - [a+ normal]. The stderr or stdout - channels may also have an ansi colour. - (see 'colour off' or punk::config)" + of values. The disply output will + still be colourised if -ansibase has + not been set to empty string or + [a+ normal]. The stderr or stdout + channels may also have an ansi colour. + (see 'colour off' or punk::config)" 1 "Leave value as is" 2 "Display the ANSI codes and - other control characters inline - with replacement indicators. - e.g esc, newline, space, tab" + other control characters inline + with replacement indicators. + e.g esc, newline, space, tab" VIEW "Alias for 2" 3 "Display as per 2 but with - colourised ANSI replacement codes." + colourised ANSI replacement codes." VIEWCODES "Alias for 3" 4 "Display ANSI and control - chars in default colour, but - apply the contained ansi to - the text portions so they display - as they would for -ansi 1" - VIEWSTYLE "Alias for 4" - } + chars in default colour, but + apply the contained ansi to + the text portions so they display + as they would for -ansi 1" + VIEWSTYLE "Alias for 4" + } -ansibase -type ansistring -default {${[a+ brightgreen]}} -help\ "Base ansi code(s) that will apply to output written to the chosen -channel. - If there are ansi resets in the displayed values - output will revert to this base. - Does not affect return value." + If there are ansi resets in the displayed values - output will revert to this base. + Does not affect return value." -- -type none -help\ "End of options marker. - It is advisable to use this, as data in a pipeline may often begin with -" + It is advisable to use this, as data in a pipeline may often begin with -" @values -min 0 -max -1 arg -type string -optional 1 -multiple 1 -help\ @@ -7946,8 +7600,7 @@ namespace eval punk { interp alias {} know {} punk::know interp alias {} know? {} punk::know? - #interp alias {} arg {} punk::val - interp alias {} val {} punk::val + #interp alias {} val {} punk::val interp alias {} exitcode {} punk::exitcode interp alias {} hide {} punkapp::hide_console ;#will only work if controllable toplevels exist diff --git a/src/modules/punk/aliascore-999999.0a1.0.tm b/src/modules/punk/aliascore-999999.0a1.0.tm index 7da06446..6f30d962 100644 --- a/src/modules/punk/aliascore-999999.0a1.0.tm +++ b/src/modules/punk/aliascore-999999.0a1.0.tm @@ -105,6 +105,7 @@ tcl::namespace::eval punk::aliascore { #functions must be in export list of their source namespace set aliases [tcl::dict::create\ + val ::punk::pipe::val\ aliases ::punk::lib::aliases\ alias ::punk::lib::alias\ tstr ::punk::lib::tstr\ @@ -123,12 +124,12 @@ tcl::namespace::eval punk::aliascore { colour ::punk::console::colour\ ansi ::punk::console::ansi\ color ::punk::console::colour\ + a? ::punk::console::code_a?\ + A? {::punk::console::code_a? forcecolor}\ a+ ::punk::console::code_a+\ A+ {::punk::console::code_a+ forcecolour}\ a ::punk::console::code_a\ A {::punk::console::code_a forcecolour}\ - a? ::punk::console::code_a?\ - A? {::punk::console::code_a? forcecolor}\ smcup ::punk::console::enable_alt_screen\ rmcup ::punk::console::disable_alt_screen\ ] diff --git a/src/modules/punk/ansi-999999.0a1.0.tm b/src/modules/punk/ansi-999999.0a1.0.tm index 24c4f1bf..0a2b0457 100644 --- a/src/modules/punk/ansi-999999.0a1.0.tm +++ b/src/modules/punk/ansi-999999.0a1.0.tm @@ -137,7 +137,7 @@ tcl::namespace::eval punk::ansi::class { @id -id "::punk::ansi::class::class_ansi render_to_input_line" @cmd -name "punk::ansi::class::class_ansi render_to_input_line" -help\ "render string from line 0 to line - (experimental/debug)" + (experimental/debug)" -dimensions -type string -help\ "WxH where W is integer width >= 1 and H is integer heigth >= 1" -minus -type integer -help\ @@ -584,25 +584,38 @@ tcl::namespace::eval punk::ansi { set base $CWD } } + if {[info commands file] eq ""} { + #probably a safe interp + return "UNAVAILABLE" + } return [file join $base src/testansi] } - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + @dynamic @id -id ::punk::ansi::example @cmd -name punk::ansi::example -help "Display .ans image files in a grid that will fit in console " - -colwidth -default 82 -help "Width of each column - default of 82 will fit a standard 80wide ansi image (when framed) - You can specify a narrower width to truncate images on the right side" - -folder -default "${[punk::ansi::Get_ansifolder]}" -help "Base folder for files if relative paths are used. - Defaults to /src/testansi - where projectbase is determined from current directory. + -colwidth -default 82 -help\ + "Width of each column - default of 82 will fit a standard 80wide ansi image + (when framed) + You can specify a narrower width to truncate images on the right side" + -folder -default "${[punk::ansi::Get_ansifolder]}" -help\ + "Base folder for files if relative paths are used. + Defaults to /src/testansi - where projectbase is determined + from the current directory. " @values -min 0 -max -1 - files -default {belinda.ans bot.ans flower.ans fish.ans} -multiple true -help "List of filenames - leave empty to display 4 defaults" + files -default {belinda.ans bot.ans flower.ans fish.ans} -multiple true -help\ + "List of filenames - leave empty to display 4 defaults" } ""] proc example {args} { set argd [punk::args::get_by_id ::punk::ansi::example $args] set colwidth [dict get $argd opts -colwidth] + if {[info commands file] eq ""} { + error "file command unavailable - punk::ansi::example cannot be shown" + } set ansifolder [file normalize [dict get $argd opts -folder]] set fnames [dict get $argd values files] @@ -617,6 +630,16 @@ tcl::namespace::eval punk::ansi { puts stderr "Ensure ansi test files exist: $fnames" #error "punk::ansi::example Cannot find example files" } + set termsize [punk::console:::get_size] + set termcols [dict get $termsize columns] + set margin 4 ;#review + set freewidth [expr {$termcols-$margin}] + if {$freewidth < $colwidth} { + puts stderr "[a+ red bold]punk::ansi::example freewidth: $freewidth < colwidth: $colwidth TRUNCATING IMAGES[a]" + set colwidth $freewidth + } + set per_row [expr {$freewidth / $colwidth}] + set missingbase [a+ yellow][textblock::block [expr {$colwidth-2}] 23 ?][a] ;#assuming standard frame - subtract 2 for left/right borders set pics [list] foreach f $fnames { @@ -636,10 +659,6 @@ tcl::namespace::eval punk::ansi { } } - set termsize [punk::console:::get_size] - set margin 4 - set freewidth [expr {[tcl::dict::get $termsize columns]-$margin}] - set per_row [expr {$freewidth / $colwidth}] set rowlist [list] ;# { { } { } } set heightlist [list] ;# { { } { } } @@ -737,22 +756,23 @@ tcl::namespace::eval punk::ansi { #review - can terminals handle SGR codes within a PM? #Wezterm will hide PM,SOS,APC - but not any part following an SGR code - i.e it seems to terminate hiding before the ST (apparently at the ) proc controlstring_PM {text} { - return "\x1b^${text}\033\\" + #dquotes with trailing \\ in string will confuse silly editors + return \x1b^${text}\033\\ } proc controlstring_PM8 {text} { - return "\x9e${text}\x9c" + return \x9e${text}\x9c } proc controlstring_SOS {text} { - return "\x1bX${text}\033\\" + return \x1bX${text}\033\\ } proc controlstring_SOS8 {text} { - return "\x98${text}\x9c" + return \x98${text}\x9c } proc controlstring_APC {text} { - return "\x1b_${text}\033\\" + return \x1b_${text}\033\\ } proc controlstring_APC8 {text} { - return "\x9f${text}\x9c" + return \x9f${text}\x9c } #there is also the SGR hide code (8) which has intermittent terminal support #This doesn't change the output length - so support is tricky to detec. (terminal checksum report?) @@ -843,10 +863,79 @@ tcl::namespace::eval punk::ansi { return $out } + + #Wrap text in ansi codes to switch to DEC alternate graphics character set. + #todo vt52 versions proc g0 {text} { return \x1b(0$text\x1b(B } + variable altg_map [dict create\ + hl q\ + vl x\ + tlc l\ + trc k\ + blc m\ + ltj t\ + rtj u\ + ttj w\ + btj v\ + rtj u\ + fwj n\ + ] + proc altg_map {names} { + variable altg_map + set result [list] + foreach nm $names { + if {[dict exists $altg_map $nm]} { + lappend result [dict get $altg_map $nm] + } else { + lappend "" + } + } + return $result + } + + # -------------------------------- + # Taken from term::ansi::code::ctrl + # -------------------------------- + #Note that SYN (\016) seems to put terminals in a state + #where alternate graphics are not processed. + #an ETB (\017) needs to be sent to get alt graphics working again. + #It isn't known what software utilises SYN/ETB within altg sequences + # (presumably to alternate between the charsets within a graphics-on/graphics-off section) + #but as modern emulators seem to react to it, we should handle it. + #REVIEW - this mapping not fully understood + #used by groptim + variable grforw + variable grback + variable _ + + foreach _ { + ! \" # $ % & ' ( ) * + , - . / + 0 1 2 3 4 5 6 7 8 9 : ; < = > + ? @ A B C D E F G H I J K L M + N O P Q R S T U V W X Y Z [ ^ + \\ ] + } { + lappend grforw \016$_ $_\016 + lappend grback $_\017 \017$_ + } + unset _ + # ------------------------------ + #REVIEW - see forward/backward map in term::ansi::code::macros::cd::groptim - what are they for?? + proc groptim {string} { + variable grforw + variable grback + set offon \x1b(B\x1b(0 ;#)) ;#editor highlighting comment + set onoff \x1b(0\x1b(B ;#)) ;#editor highlighting comment + while {![string equal $string [set new [string map [list $offon {} $onoff {}] [string map $grback [string map $grforw $string]]]]]} { + set string $new + } + return $string + } + # -------------------------------- + proc ansistrip_gx {text} { #e.g "\033(0" - select VT100 graphics for character set G0 #e.g "\033(B" - reset @@ -854,10 +943,10 @@ tcl::namespace::eval punk::ansi { #e.g "\033)X" - where X is any char other than 0 to reset ?? #return [convert_g0 $text] - return [tcl::string::map [list "\x1b(0" "" \x1b(B" "" "\x1b)0" "" "\x1b)X" ""] $text] + return [tcl::string::map [list \x1b(0 "" \x1b(B "" \x1b)0 "" \x1b)X ""] $text] } proc stripansi_gx {text} { - return [tcl::string::map [list "\x1b(0" "" \x1b(B" "" "\x1b)0" "" "\x1b)X" ""] $text] + return [tcl::string::map [list \x1b(0 "" \x1b(B "" \x1b)0 "" \x1b)X ""] $text] } @@ -1459,7 +1548,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu tcl::dict::set opts $k $v } default { - error "colourmap1 unrecognised option $k. Known-options: [tcl::dict::keys $opts] + error "colourmap1 unrecognised option $k. Known-options: [tcl::dict::keys $opts]" } } } @@ -2358,11 +2447,11 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu lappend PUNKARGS [list { @id -id ::punk::ansi::sgr_cache @cmd -name punk::ansi::sgr_cache -help\ - "Convenience function to view and optionally clear the ansi character attribute cache (ansi SGR codes) - " + "Convenience function to view and optionally clear the ansi character attribute cache + (ansi SGR codes)" -action -default "" -choices "clear" -help\ "-action clear will unset the keys in the punk::ansi::sgr_cache dict - This is called automatically when setting 'colour false' in the console" + This is called automatically when setting 'colour false' in the console" -pretty -default 1 -type boolean -help\ "use 'pdict punk::ansi::sgr_cache */%str,%ansiview' output" @@ -2882,7 +2971,8 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set SGR_samples [dict create] foreach k [dict keys $SGR_map] { - dict set SGR_samples $k "[punk::ansi::a+ $k]sample\x1b\[m" + #indent of 1 space is important for clarity in i -return string a+ output + dict set SGR_samples $k " [punk::ansi::a+ $k]sample\x1b\[m" } lappend PUNKARGS [list { @id -id ::punk::ansi::a+ @@ -2895,23 +2985,23 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu code -type string -optional 1 -multiple 1 -choices {}\ -choicelabels {}\ -choicecolumns 5 -choiceprefix 0 -choicerestricted 0 -help\ - "SGR code from the list below, or an integer corresponding to the code e.g 31 = red. - A leading capital letter indicates a codename applies to the background colour. - Other accepted codes are: - term- Term- foreground/background where int is 0-255 terminal color - term- Term- foreground/background - rgb--- Rgb--- foreground/background where are the - 0-255 int values for red, green and blue. - rgb# Rgb# where is a 6 char hex colour e.g rgb#C71585 - web- Web- + "SGR code from the list below, or an integer corresponding to the code e.g 31 = red. + A leading capital letter indicates a codename applies to the background colour. + Other accepted codes are: + term- Term- foreground/background where int is 0-255 terminal color + term- Term- foreground/background + rgb--- Rgb--- foreground/background where are the + 0-255 int values for red, green and blue. + rgb# Rgb# where is a 6 char hex colour e.g rgb#C71585 + web- Web- - The acceptable values for and can be queried using - punk::ansi::a? term - and - punk::ansi::a? web + The acceptable values for and can be queried using + punk::ansi::a? term + and + punk::ansi::a? web - Example to set foreground red and background cyan followed by a reset: - set str \"[a+ red Cyan]sample text[a]\" + Example to set foreground red and background cyan followed by a reset: + set str \"[a+ red Cyan]sample text[a]\" " }]] @@ -3264,7 +3354,55 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu return $result } - proc ansiwrap {codes text} { + lappend PUNKARGS [list { + @id -id ::punk::ansi::ansiwrap + @cmd -name punk::ansi::ansiwrap -help\ + "Wrap a string with ANSI codes from + supplied codelist(s) followed by trailing + ANSI reset. + + Codes are numbers or strings as indicated + in the output of the colour information + function: punk::ansi::a? + + No leading reset is applied - so when + placing resultant text, any existing + SGR codes that aren't overridden may + still take effect. + + For finer control use the a+ and a + functions eg + set x \"[a+ red]text [a+ bold]etc[a]\" + " + @leaders -min 0 -max -1 + codelist -multiple 1 -default {} -type list -help\ + "ANSI names/ints as understood by 'a?' + (Not actual ANSI as output by a+) + These can be supplied individually or + as a list or lists" + @values -min 1 -max 1 + text -type string -help\ + "String to wrap with ANSI (SGR)" + }] + #proc ansiwrap {codes text} { + # return [a {*}$codes]$text[a] + #} + proc ansiwrap2 {args} { + set argd [punk::args::parse $args withid ::punk::ansi::ansiwrap] + set codelists [dict get $argd leaders codelist] + set text [dict get $argd values text] + set codes [concat {*}$codelists] ;#flatten + return [a {*}$codes]$text[a] + } + proc ansiwrap {args} { + if {[llength $args] < 1} { + #minimal args parsing - unhappy path only + punk::args::parse $args withid ::punk::ansi::ansiwrap + return + } + set text [lindex $args end] + set codelists [lrange $args 0 end-1] + set codes [concat {*}$codelists] ;#flatten return [a {*}$codes]$text[a] } @@ -3300,6 +3438,14 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[call [fun reset_soft]] return \x1b\[!p } + proc SYN {} { + #syn seems to disable alternate graphics mode temporarily on modern terminals + return \016 + } + proc ETB {} { + #This is a form of soft reset for the state where a SYN was sent - re-enabling altg processing + return \017 + } proc reset_colour {} { #*** !doctools #[call [fun reset_colour]] @@ -3341,6 +3487,12 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[call [fun cursor_off]] return "\033\[?25l" } + proc cursor_on_vt52 {} { + return \x1be + } + proc cursor_off_vt52 {} { + return \x1bf + } # REVIEW - osc8 replays etc for split lines? - textblock #Hyperlinks (a.k.a. HTML-like anchors) in terminal emulators https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda @@ -3387,6 +3539,24 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } # -- --- --- --- --- + lappend PUNKARGS [list { + @id -id ::punk::ansi::move + @cmd -name punk::ansi::move -help\ + {Return an ANSI sequence to move cursor to row,col + (aka: cursor home) + + Sequence is of the form: + \x1b[;H + (CSI row ; col H) + This sequence will not be understood by old vt52 + terminals. see also vt52_move. + } + @values -min 2 -max 2 + row -type integer -help\ + "row number - starting at 1" + col -type integer -help\ + "column number - starting at 1" + }] proc move {row col} { #*** !doctools #[call [fun move] [arg row] [arg col]] @@ -3394,6 +3564,44 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[para]aka cursor home return \033\[${row}\;${col}H } + #NOTE vt52 uses ESC Y line column + # where line and column are ascii codes whose values are +31 + # vt52 can be entered/exited via escapes + # This means we probably need to to wrap enter/exit vt52 and keep this state - as we don't have a standard way to query for terminal type + # (vt52 supports ESC Z - but vt100 sometimes? doesn't - and querying at each output would be slow anyway, even if there was a common query :/ ) + + lappend PUNKARGS [list { + @id -id ::punk::ansi::vt52move + @cmd -name punk::ansi::vt52move -help\ + {Return a VT52 sequence to move cursor to row,col + (aka: cursor home) + + Sequence is of the form: + ESCY + This sequence will generally not be understood by terminals + that are not in vt52 mode (e.g DECANM unset). + } + @values -min 2 -max 2 + row -type integer -help\ + "row number - starting at 1" + col -type integer -help\ + "column number - starting at 1" + }] + proc vt52move {row col} { + #test + set r [format %c [expr {$row + 31}]] + set c [format %c [expr {$col + 31}]] + return \x1bY${r}${c} + } + proc vt52color {int} { + if {[string is integer -strict $int]} { + if {$int < 0 || $int > 15} { + error "vt52color unsupported - only 0 to 15 available" + } + } + set char [format %c [expr {$int + 31}]] + return \x1bb${char} + } proc move_emit {row col data args} { #*** !doctools #[call [fun move_emit] [arg row] [arg col] [arg data] [opt {row col data...}]] @@ -3424,6 +3632,27 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } return $out } + proc vt52move_emit {row col data args} { + #Todo - G code? + set out "" + if {$row eq "this"} { + #append out \033\[\;${col}G$data + append out [vt52move_column $col]$data + } else { + #append out \033\[${row}\;${col}H$data + append out [vt52move $row $col]$data + } + foreach {row col data} $args { + if {$row eq "this"} { + append out [vt52move_column $col]$data + #append out \033\[\;${col}G$data + } else { + #append out \033\[${row}\;${col}H$data + append out [vt52move $row $col]$data + } + } + return $out + } proc move_emitblock {row col textblock} { #*** !doctools #[call [fun move_emitblock] [arg row] [arg col] [arg textblock]] @@ -3434,31 +3663,63 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } return $commands } + proc vt52move_emitblock {row col textblock} { + #*** !doctools + #[call [fun move_emitblock] [arg row] [arg col] [arg textblock]] + set commands "" + foreach ln [split $textblock \n] { + append commands [punk::ansi::vt52move_emit $row $col $ln] + incr row + } + return $commands + } proc move_forward {{n 1}} { #*** !doctools #[call [fun move_forward] [arg n]] return \033\[${n}C } + proc vt52move_forward {{n 1}} { + return [string repeat \x1bC $n] + } proc move_back {{n 1}} { #*** !doctools #[call [fun move_back] [arg n]] return \033\[${n}D } + proc vt52move_back {{n 1}} { + return [string repeat \x1bD $n] + } proc move_up {{n 1}} { #*** !doctools #[call [fun move_up] [arg n]] return \033\[${n}A } + proc vt52move_up {{n 1}} { + return [string repeat \x1bA $n] + } proc move_down {{n 1}} { #*** !doctools #[call [fun move_down] [arg n]] return \033\[${n}B } + proc vt52move_down {{n 1}} { + return [string repeat \x1bB $n] + } proc move_column {col} { #*** !doctools #[call [fun move_column] [arg col]] return \x1b\[${col}G } + proc vt52move_column {col} { + #This is a bit of a fudge - as there is no command to move to a specific column. + #without tracking state - we settle for moving back enough times to ensure we're at column 1 - and then move forward. + #inefficient - but will have to do I guess. + #review - max term width vt52? env var LINES and env var COLUMNS ? + # also ESC R CR - set window size + set back [string repeat \x1bD 132] + set fwd [string repeat \x1bC [expr {$col - 1}]] + return $back$fwd + } proc move_row {row} { #*** !doctools #[call [fun move_row] [arg row]] @@ -3496,6 +3757,13 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[para] DECRC return \x1b8 } + proc cursor_save_vt52 {} { + return \x1bj + } + proc cursor_restore_vt52 {} { + return \x1bk + } + # -- --- --- --- --- #CRM Show Control Character Mode proc enable_crm {} { @@ -3550,18 +3818,131 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu # \x1b\[?7\;1\$y # \x1b\[?7\;2\$y #where 1 = set, 2 = unset. (0 = mode not recognised, 3 = permanently set, 4 = permanently unset) + + #https://wiki.tau.garden/dec-modes/ + #(DEC,xterm,contour,mintty,kitty etc) + #https://invisible-island.net/xterm/ctlseqs/ctlseqs.html#h2-Mouse-Tracking + + #names for other alt_screen mechanismk: 1047,1048 vs 1049? + #variable decmode_names [dict create\ + # DECANM 2\ + # origin 6\ + # DECCOLM 3\ + # line_wrap 7\ + # LNM 20\ + # alt_screen 1049\ + # grapheme_clusters 2027\ + # bracketed_paste 2004\ + # mouse_sgr 1006\ + # mouse_urxvt 1015\ + # mouse_sgr_pixel 1016\ + #] + variable decmode_data { + 1 { + {origin DEC description "DECCKM - Cursor Keys Mode" names {DECCKM cursor_keys}} + } + 2 { + {origin DEC description "DECANM - ANSI/VT52 Mode" names {DECANM} note { +Disable to turn on VT52 emulation. +In VT52 mode - use \x1b< to exit. + } + } + } + 3 { + {origin DEC description "DECCOLM - Column" names {DECCOLM}} + } + 4 { + {origin DEC description "DECSCLM - Scrolling" names {DECSCLM}} + } + 5 { + {origin DEC description "DECSCNM - Screen Mode (light or dark screen)" names {DECSNM lightmode}} + } + 7 { + {origin DEC description "DECAWM - Auto Wrap Mode" names {DECAWM line_wrap}} + } + 9 { + {origin "xterm" description "X10 compatibility mouse" names {SET_X10_MOUSE mouse_tracking} note { +Escape sequence on button press only. +CSI M CbCxCy (6 chars) +Coords limited to 223 (=255 - 32) + } + } + {origin DEC description "DECINLM - Interlace Mode (obsolete?)" names {DECINLM}} + } + 20 { + {origin DEC description "LNM - Line Feed/New Line Mode" names {LNM} note { +For terminals that support LNM, the default is off +meaning a lone CR respresents the character emitted +when enter is pushed. Turning LNM on would mean that +CR LF is sent when hitting enter. This feature is +not commonly supported, and the default will normally +be as if this was off - ie lone CR. + } + } + } + 25 { + {origin DEC description "DECTCEM - Text Cursor Enable Mode" names {DECTCEM cursor_enable}} + } + 47 { + {origin xterm description "xterm alternate buffer" names {xterm_altbuf}} + {origin DEC description "DECGRPM - Graphics Rotated Print Mode (obsolete?)" names {DECGRPM}} + } + 66 { + {origin DEC description "DECNKM - Numeric Keypad Mode" names {DECNKM}} + } + 1000 { + {origin "xterm" description "VT200 compatibility mouse" names {SET_VT200_MOUSE} note { +Escape sequence on both button press and release. +CSI M CbCxCy + } + } + } + 1004 { + {origin "xterm" description "Send FocusIn/FocusOut events" names {mouse_focus_event}} + } + 1005 { + {origin "xterm" description "Enable UTF-8 Mouse Mode" names {mouse_utf8 mouse_utf8_extended}} + } + 1006 { + {origin "xterm" description "Enable SGR Mouse Mode" names {mouse_sgr mouse_sgr_extended} note{ +SET_SGR_EXT_MODE_MOUSE - extended compared to x10 mouse protocol which limits x y coords +to 223 (=255 - 32) + } + } + } + 1015 { + {origin "urxvt" description "Enable urxvt Mouse Mode" names {mouse_urxvt}} + } + 1016 { + {origin "xterm" description "Enable SGR Pixel Mouse Mode" names {mouse_sgr_pixel}} + } + 1047 { + {origin "xterm" description "Alternate Buffer" names {alt_buffer_only}} + } + 1049 { + {origin "xterm" description "Alternate Buffer with save cursor" names {alt_buffer alt_screen}} + } + 2004 { + {origin "xterm" description "Set bracketed paste mode" names {bracketed_paste}} + } + 2027 { + {origin Contour description "Grapheme Cluster Processing" names {grapheme_clusters}} + } + } + set decmode_names [dict create] + dict for {code items} $decmode_data { + foreach itm $items { + set names [dict get $itm names] + foreach nm $names { + dict set decmode_names $nm $code + } + } + } + + + + - #names for other alt_screen mechanisms: 1047,1048 vs 1049? - variable decmode_names [dict create\ - line_wrap 7\ - LNM 20\ - alt_screen 1049\ - grapheme_clusters 2027\ - bracketed_paste 2004\ - mouse_sgr_extended 1006\ - mouse_urxvt 1015\ - mouse_sgr 1016\ - ] proc query_mode {num_or_name} { if {[string is integer -strict $num_or_name]} { set m $num_or_name @@ -3674,11 +4055,17 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[para]Erase to start of line, leaving cursor position alone. return \033\[1K } + proc vt52erase_sol {} { + return \x1bo + } proc erase_eol {} { #*** !doctools #[call [fun erase_eol]] return \033\[K } + proc vt52erase_eol {} { + return \x1bK + } #see also clear_above clear_below # -- --- --- --- --- @@ -3732,6 +4119,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu proc cursor_pos_extended {} { #includes page e.g ^[[47;3;1R + #(but not on all terminals - some (freebsd?) will report as per 6n e.g ^[[74;3R) return \033\[?6n } @@ -3789,6 +4177,9 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[para]This may not work on terminals which have multiple panes/windows return "\033\]2;$windowtitle\033\\" ;#works for xterm and most derivatives } + proc vt52titleset {windowtitle} { + return \x1bS$windowtitle\r + } #titleget - https://invisible-island.net/xterm/xterm.faq.html#how2_title #no cross-platform ansi-only mechanism ? @@ -4672,8 +5063,14 @@ tcl::namespace::eval punk::ansi::ta { variable re_osc_open {(?:\x1b\]|\u009d).*} - variable standalone_code_map [list \x1bc "" \x1b7 "" \x1b8 "" \x1bM "" \x1bE "" \x1bD "" \x1bH "" \x1b= "" \x1b> "" \x1b#3 "" \x1b#4 "" \x1b#5 "" \x1b#6 "" \x1b#8 ""] - variable re_standalones {(?:\x1bc|\x1b7|\x1b8|\x1bM|\x1bE|\x1bD|\x1bD|\x1bH|\x1b=|\x1b>|\x1b#3|\x1b#4|\x1b#5|\x1b#6|\x1b#8)} + #variable standalone_code_map [list \x1bc "" \x1b7 "" \x1b8 "" \x1bM "" \x1bE "" \x1bD "" \x1bH "" \x1b= "" \x1b> "" \x1b#3 "" \x1b#4 "" \x1b#5 "" \x1b#6 "" \x1b#8 ""] + variable re_standalones {(?:\x1bc|\x1b7|\x1b8|\x1bM|\x1bD|\x1bE|\x1bH|\x1b=|\x1b>|\x1b#3|\x1b#4|\x1b#5|\x1b#6|\x1b#8)} + variable re_standalones_vt52 {(?:\x1bZ)} + + #ESC Y move, ESC b foreground colour + #ESC F - gr-on ESC G - gr-off + variable re_vt52_open {(?:\x1bY|\x1bb|\x1bF)} + #\x1bc vt52 bgcolour conflict ?? #if we don't split on altgraphics too and separate them out - it's easy to get into a horrible mess variable re_g0_group {(?:\x1b\(0)(?:(?!\x1b\(B).)*\x1b\(B} @@ -4686,7 +5083,7 @@ tcl::namespace::eval punk::ansi::ta { #regex to capture the start of string/privacy message/application command block including the contents and string terminator (ST) #non-greedy by exclusion of ST terminators in body - #we need to match \x1b\\ not just \x1b There could be colour codes nested in a privacy msg/string + #we need to match \x1b\\ not just \x1b There could be colour codes nested in a privacy msg/string (not widely supported?) #even if terminals generally don't support that - it's quite possible for an ansi code to get nested this way - and we'd prefer it not to break our splits #Just checking for \x1b will terminate the match too early #we also need to track the start of ST terminated code and not add it for replay (in the ansistring functions) @@ -4705,17 +5102,44 @@ tcl::namespace::eval punk::ansi::ta { #handrafted TRIE version of above. Somewhat difficult to construct and maintain. TODO - find a regexp TRIE generator that works with Tcl regexes #This does make things quicker - but it's too early to finalise the detect/split regexes (e.g missing \U0090 ) - will need to be redone. #variable re_ansi_detect {(?:\x1b(?:\((?:0|B)|\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|c|7|8|M|E|D|H|=|>|(?:#(?:3|4|5|6|8))))|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]|(?:\u009d)(?:[^\u009c]*)?\u009c} - variable re_ansi_detect {(?:\x1b(?:\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|\((?:0|B)|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|c|7|8|M|E|D|H|=|>|(?:#(?:3|4|5|6|8))))|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]|(?:\u009d)(?:[^\u009c]*)?\u009c} + + #NOTE - the literal # char can cause problems in expanded syntax - even though it's within a bracketed section. \# seems to work though. + #vt52 specific |<|A|B|C|I|J|K|L|M|Z|(?:Y(?:..))|(?:b(?:.)| + #https://freemint.github.io/tos.hyp/en/VT_52_terminal.html + #what to with ESC c vs vt52 ESC c (background colour) ??? + #we probably need to use a separate re_ansi_detect for vt52 + + #although it's stated later terminals are backwards compatible with vt52 - that doesn't seem to mean for example a vt100 will process vt52 codes at the same time as ansi codes + #ie - when DECANM is on - VT52 codes are *not* processed + + #todo - ansi mode and cursor key mode set ? + # arrow keys -> ESC O A, ESC O B, ESC O C, ESC O D + # plus more for auxiliary keypad codes in keypad application mode (and some in numeric mode) + + variable re_ansi_detect {(?x) + (?:\x1b(?:\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|c|7|8|M|D|E|H|=|>|<|A|B|C|I|J|K|L|M|Z|(?:Y(?:..))|(?:b(?:.))|\((?:0|B)|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|(?:\#(?:3|4|5|6|8)))) + |(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c) + |(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e] + |(?:\u009d)(?:[^\u009c]*)?\u009c + } + #--- + # -- --- --- --- #variable re_csi_code {(?:\x1b\[|\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]} - variable re_ansi_detect_open "${re_csi_open}|${re_osc_open}|${re_standalones}|${re_ST_open}|${re_g0_open}" + variable re_ansi_detect_open "${re_csi_open}|${re_osc_open}|${re_standalones}|${re_standalones_vt52}|${re_ST_open}|${re_g0_open}|${re_vt52_open}" #may be same as detect - kept in case detect needs to diverge #variable re_ansi_split "${re_csi_code}|${re_esc_osc1}|${re_esc_osc2}|${re_esc_osc3}|${re_standalones}|${re_ST}|${re_g0_open}|${re_g0_close}" set re_ansi_split $re_ansi_detect + variable re_ansi_split_multi + if {[string first (?x) $re_ansi_split] == 0} { + set re_ansi_split_multi "(?x)(?:[string range ${re_ansi_split} 4 end])+" + } else { + set re_ansi_split_multi "(?:${re_ansi_split})+" + } lappend PUNKARGS [list -dynamic 0 { @id -id ::punk::ansi::ta::detect @@ -4922,81 +5346,46 @@ tcl::namespace::eval punk::ansi::ta { # -- --- --- --- --- --- #Split $text to a list containing alternating ANSI colour codes and text. #ANSI colour codes are always on the second element, fourth, and so on. - #(ie plaintext on odd list-indices ansi on even indices) + #(ie plaintext on even list-indices ansi on odd indices) + #result of split on non-empty string always has an odd length - with indices 0 and end always being plaintext (possibly empty string) # Example: - #ta_split_codes "" # => "" - #ta_split_codes "a" # => "a" - #ta_split_codes "a\e[31m" # => {"a" "\e[31m"} - #ta_split_codes "\e[31ma" # => {"" "\e[31m" "a"} - #ta_split_codes "\e[31ma\e[0m" # => {"" "\e[31m" "a" "\e[0m"} - #ta_split_codes "\e[31ma\e[0mb" # => {"" "\e[31m" "a" "\e[0m", "b"} - #ta_split_codes "\e[31m\e[0mb" # => {"" "\e[31m\e[0m" "b"} + #split_codes "" # => "" + #split_codes "a" # => "a" + #split_codes "a\e[31m" # => {"a" "\e[31m" ""} + #split_codes "\e[31ma" # => {"" "\e[31m" "a"} + #split_codes "\e[31ma\e[0m" # => {"" "\e[31m" "a" "\e[0m" ""} + #split_codes "\e[31ma\e[0mb" # => {"" "\e[31m" "a" "\e[0m", "b"} + #split_codes "\e[31m\e[0mb" # => {"" "\e[31m\e[0m" "b"} # proc split_codes {text} { - variable re_ansi_split - set re "(?:${re_ansi_split})+" - return [_perlish_split $re $text] + variable re_ansi_split_multi + return [_perlish_split $re_ansi_split_multi $text] } #micro optimisations on split_codes to avoid function calls and make re var local tend to yield very little benefit (sub uS diff on calls that commonly take 10s/100s of uSeconds) - #like split_codes - but each ansi-escape is split out separately (with empty string of plaintext between codes so odd/even plain ansi still holds) + #like split_codes - but each ansi-escape is split out separately (with empty string of plaintext between codes so even/odd indices for plain ansi still holds) #- the slightly simpler regex than split_codes means that it will be slightly faster than keeping the codes grouped. - proc split_codes_single2 {text} { - variable re_ansi_split - return [_perlish_split $re_ansi_split $text] - } - proc split_codes_single3 {text} { - #copy from re_ansi_split - _perlish_split {(?:\x1b(?:\((?:0|B)|\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|c|7|8|M|E|D|H|=|>|(?:#(?:3|4|5|6|8))))|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]|(?:\u009d)(?:[^\u009c]*)?\u009c} $text - } - proc split_codes_single4 {text} { - if {$text eq ""} { - return {} - } - variable re_ansi_split - set re $re_ansi_split - #variable re_ansi_detect1 - #set re $re_ansi_detect1 - set list [list] - set start 0 - - #set re {(?:\x1b(?:\((?:0|B)|\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|c|7|8|M|E|D|H|=|>|(?:#(?:3|4|5|6|8))))|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]|(?:\u009d)(?:[^\u009c]*)?\u009c} - #We can get $matchEnd < $matchStart; we need to ensure there is an exit condition for non-greedy empty results REVIEW - #while {[regexp -start $start -indices -- {(?:\x1b(?:\((?:0|B)|\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|c|7|8|M|E|D|H|=|>|(?:#(?:3|4|5|6|8))))|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]|(?:\u009d)(?:[^\u009c]*)?\u009c} $text match]} {} - while {[regexp -start $start -indices -- $re $text match]} { - lassign $match matchStart matchEnd - #puts "->start $start ->match $matchStart $matchEnd" - lappend list [tcl::string::range $text $start $matchStart-1] - if {$matchEnd < $matchStart} { - set e $matchStart - incr start - } else { - set e $matchEnd - set start [expr {$matchEnd+1}] - } - lappend list [tcl::string::range $text $matchStart $e] - if {$start >= [tcl::string::length $text]} { - break - } - } - return [lappend list [tcl::string::range $text $start end]] - } proc split_codes_single {text} { if {$text eq ""} { return {} } variable re_ansi_split set next 0 - set b -1 + #set b -1 set list [list] set coderanges [regexp -indices -all -inline -- $re_ansi_split $text] foreach cr $coderanges { lappend list [tcl::string::range $text $next [lindex $cr 0]-1] [tcl::string::range $text [lindex $cr 0] [lindex $cr 1]] set next [expr {[lindex $cr 1]+1}] + #set next [lindex $cr 1]+1 ;#text index-expression for string range } lappend list [tcl::string::range $text $next end] return $list } + proc split_codes_single2 {text} { + variable re_ansi_split + return [_perlish_split $re_ansi_split $text] + } proc get_codes_single {text} { variable re_ansi_split regexp -all -inline -- $re_ansi_split $text @@ -5008,7 +5397,7 @@ tcl::namespace::eval punk::ansi::ta { return {} } set next 0 - set b -1 + #set b -1 set list [list] set coderanges [regexp -indices -all -inline -- $re $text] foreach cr $coderanges { @@ -5103,29 +5492,6 @@ tcl::namespace::eval punk::ansi::ta { #return [lappend list [tcl::string::range $text $start end]] yield [tcl::string::range $text $start end] } - proc _perlish_split2 {re text} { - if {[tcl::string::length $text] == 0} { - return {} - } - set list [list] - set start 0 - #We can get $matchEnd < $matchStart; we need to ensure there is an exit condition for non-greedy empty results REVIEW - while {[regexp -start $start -indices -- $re $text match]} { - lassign $match matchStart matchEnd - #puts "->start $start ->match $matchStart $matchEnd" - if {$matchEnd < $matchStart} { - lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::index $text $matchStart] - incr start - } else { - lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::range $text $matchStart $matchEnd] - set start [expr {$matchEnd+1}] - } - if {$start >= [tcl::string::length $text]} { - break - } - } - return [lappend list [tcl::string::range $text $start end]] - } proc _ws_split {text} { regexp -all -inline {(?:\S+)|(?:\s+)} $text } @@ -7429,12 +7795,10 @@ tcl::namespace::eval punk::ansi::internal { #todo - document interp alias {} ansistring {} ::punk::ansi::ansistring -if {![info exists ::punk::args::register::NAMESPACES]} { - namespace eval ::punk::args::register { - set NAMESPACES [list] - } +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::ansi ::punk::ansi::class ::punk::ansi::ta } -lappend ::punk::args::register::NAMESPACES ::punk::ansi ::punk::ansi::class ::punk::ansi::ta # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready diff --git a/src/modules/punk/args-999999.0a1.0.tm b/src/modules/punk/args-999999.0a1.0.tm index 7ec78339..aae5119a 100644 --- a/src/modules/punk/args-999999.0a1.0.tm +++ b/src/modules/punk/args-999999.0a1.0.tm @@ -226,15 +226,26 @@ tcl::namespace::eval punk::args::register { #[para] The punk::args package will then test for a public list variable ::PUNKARGS containing argument definitions when it needs to. #[list_begin definitions] + #Although the actual punk::args::define calls are not too sluggish, there could be *many*. + #in a multi-interp environment, we want to be lazy about loading argdefs until they're actually required, + #especially since a fair proportion may be for documentation purposes rather than parsing args. + # -- --- --- --- --- --- --- --- - #cooperative with packages that define some punk args but may need to do so lazily - #These could be loaded prior to punk::args being loaded - variable NAMESPACES + #cooperative with packages that define some punk args but do so lazily + #These could be loaded prior to punk::args being loaded - so check existence of NAMESPACES var first + variable NAMESPACES ;#just declaring it with variable doesn't yet mean it 'exists' from 'info exists' perspective if {![info exists ::punk::args::register::NAMESPACES]} { - set NAMESPACES [list] + set ::punk::args::register::NAMESPACES [list] } # -- --- --- --- --- --- --- --- + variable loaded_packages [list] ;#fully loaded + variable loaded_info [dict create] ;#time + variable scanned_packages [list] ;#packages scanned for ids used to update namespace_docpackages + variable scanned_info [dict create] ;#time and idcount + #some packages, e.g punk::args::tclcore document other namespaces. + #when punk::args::update_definitions gets a query for a namespace - we need to load argdefs from registered sources + variable namespace_docpackages [dict create] #*** !doctools #[list_end] [comment {--- end definitions namespace punk::args::register ---}] @@ -250,14 +261,15 @@ tcl::namespace::eval punk::args { variable PUNKARGS ;#list of our own punk::args function argument definitions - loaded with punk::args::define at the end. tcl::namespace::export {[a-z]*} - variable argdata_cache - variable argdefcache_by_id - variable argdefcache_unresolved ;#key = original template list supplied to 'define', value = 2-element list: (tstr-parsed split of template) & (unresolved params) - variable id_counter - set argdata_cache [tcl::dict::create] - set argdefcache_by_id [tcl::dict::create] - set argdefcache_unresolved [tcl::dict::create] - set id_counter 0 + variable rawdef_cache [tcl::dict::create] ;#key on rawdef list - return dict of {-id -dynamic 0|1} + variable id_cache_rawdef [tcl::dict::create] + variable id_cache_spec [tcl::dict::create] + + variable argdefcache_unresolved [tcl::dict::create] ;#key = original template list supplied to 'define', value = 2-element list: (tstr-parsed split of template) & (unresolved params) + + variable argdata_cache [tcl::dict::create] + + variable id_counter 0 #*** !doctools #[subsection {Namespace punk::args}] @@ -321,22 +333,22 @@ tcl::namespace::eval punk::args { %B%@id%N% ?opt val...? options: -id %B%@cmd%N% ?opt val...? - options -name -help + options: -name -help %B%@leaders%N% ?opt val...? - options -min -max + options: -min -max (used for leading args that come before switches/opts) %B%@opts%N% ?opt val...? - options -any + options: -any %B%@values%N% ?opt val...? - options -min -max + options: -min -max (used for trailing args that come after switches/opts) %B%@argdisplay%N% ?opt val...? - options -header (text for header row of table) + options: -header (text for header row of table) -body (text to replace autogenerated arg info) %B%@doc%N% ?opt val...? - options -name -url + options: -name -url %B%@seealso%N% ?opt val...? - options -name -url (for footer - unimplemented) + options: -name -url (for footer - unimplemented) Some other options normally present on custom arguments are available to use with the @leaders @opts @values directives to set defaults @@ -418,6 +430,15 @@ tcl::namespace::eval punk::args { streaming and checksumming. The -choices list is equivalent to a -choicegroups dict entry where the key (groupname) is the empty string. + -choicemultiple (default {1 1}) + is a pair representing min and max number of choices + that can be present in the value. + If is a single integer it is equivalent to a + specified with the same integer for both min and max. + Max of -1 represents no upper limit. + If allows more than one choice the value is a list + consisting of items in the choices made available through + entries in -choices/-choicegrups. -minsize (type dependant) -maxsize (type dependant) -range (type dependant) @@ -425,27 +446,27 @@ tcl::namespace::eval punk::args { " -dynamic -type boolean -default 0 -help\ - "If -dynamic is true, tstr interpolations of the form \$\{\$var\} - are re-evaluated on each call. - If the definition is being used not just as documentation, but is also - used within the function to parse args, e.g using punk::args::get_by_id, - then it should be noted that there is a slight performance penalty for the - dynamic case. - It is often not significant, perhaps depending on what vars/commands are - used but -dynamic true might be less desirable if the command is used in - inner loops in more performance-sensitive code. + "If -dynamic is true, tstr interpolations of the form \$\{\$var\} + are re-evaluated on each call. + If the definition is being used not just as documentation, but is also + used within the function to parse args, e.g using punk::args::get_by_id, + then it should be noted that there is a slight performance penalty for the + dynamic case. + It is often not significant, perhaps depending on what vars/commands are + used but -dynamic true might be less desirable if the command is used in + inner loops in more performance-sensitive code. " @values -min 1 -max -1 text -type string -multiple 1 -help\ - "Block(s) of text representing the argument definition for a command. - At least one must be supplied. If multiple, they are joined together with \\n. - Using multiple text arguments may be useful to mix curly-braced and double-quoted - strings to have finer control over interpolation when defining arguments. - (this can also be handy for sections that pull resolved definition lines - from existing definitions (by id) for re-use of argument specifications and help text) - - e.g the following definition passes 2 blocks as text arguments - definition { + "Block(s) of text representing the argument definition for a command. + At least one must be supplied. If multiple, they are joined together with \\n. + Using multiple text arguments may be useful to mix curly-braced and double-quoted + strings to have finer control over interpolation when defining arguments. + (this can also be handy for sections that pull resolved definition lines + from existing definitions (by id) for re-use of argument specifications and help text) + + e.g the following definition passes 2 blocks as text arguments + definition { @id -id ::myns::myfunc @cmd -name myns::myfunc -help\\ \"Description of command\" @@ -454,13 +475,18 @@ tcl::namespace::eval punk::args { -option1 -default blah -type string #The following option defines a flag style option (solo) -flag1 -default 0 -type none -help\\ - \"Info about flag1\" + \"Info about flag1 + subsequent help lines auto-dedented by whitespace to left + of corresponding record start (in this case -flag1) + + first 4 spaces if they are all present. + This line has no extra indent relative to first line 'Info about flag1' + This line indented a further 6 chars\" @values -min 1 -max -1 #Items that don't begin with * or - are value definitions v1 -type integer -default 0 thinglist -type string -multiple 1 - } \"*doc -name Manpage: -url \[myfunc_manpage_geturl myns::myfunc]\" + } \"*doc -name Manpage: -url \[myfunc_manpage_geturl myns::myfunc]\" " }]] @@ -475,6 +501,7 @@ tcl::namespace::eval punk::args { -nocase 0\ -choiceprefix 1\ -choicerestricted 1\ + -choicemultiple {1 1}\ -multiple 0\ -regexprepass {}\ -validationtransform {}\ @@ -488,6 +515,7 @@ tcl::namespace::eval punk::args { -nocase 0\ -choiceprefix 1\ -choicerestricted 1\ + -choicemultiple {1 1}\ -multiple 0\ -regexprepass {}\ -validationtransform {}\ @@ -501,6 +529,7 @@ tcl::namespace::eval punk::args { -nocase 0\ -choiceprefix 1\ -choicerestricted 1\ + -choicemultiple {1 1}\ -multiple 0\ -regexprepass {}\ -validationtransform {}\ @@ -569,8 +598,23 @@ tcl::namespace::eval punk::args { #] } proc define {args} { + dict get [resolve {*}$args] id + } + proc resolve {args} { + variable rawdef_cache + variable id_cache_rawdef + if {[dict exists $rawdef_cache $args]} { + set id [dict get $rawdef_cache $args -id] + set is_dynamic [dict get $rawdef_cache $args -dynamic] + } else { + set id [rawdef_id $args] + set is_dynamic [rawdef_is_dynamic $args] + dict set rawdef_cache $args [dict create -id $id -dynamic $is_dynamic] + dict set id_cache_rawdef $id $args + } + + variable argdata_cache - variable argdefcache_by_id variable argdefcache_unresolved @@ -592,7 +636,6 @@ tcl::namespace::eval punk::args { punk::args::get_by_id ::punk::args::define {} return } - set is_dynamic 0 if {[lindex $args 0] eq "-dynamic"} { set is_dynamic [lindex $args 1] set textargs [lrange $args 2 end] @@ -699,14 +742,18 @@ tcl::namespace::eval punk::args { if {![tcl::info::complete $test_complete]} { #append linebuild [string trimleft $rawline] \n if {$in_record} { - if {[tcl::string::length $lastindent]} { - #trim only the whitespace corresponding to last indent - not all whitespace on left - if {[tcl::string::first $lastindent $rawline] == 0} { - set trimmedline [tcl::string::range $rawline [tcl::string::length $lastindent] end] - append linebuild $trimmedline \n - } else { - append linebuild $rawline \n - } + #trim only the whitespace corresponding to last record indent or lastindent + 4 spaces - not all whitespace on left + #this allows alignment of multiline help strings to left margin whilst maintaining a visual indent in source form. + #Aligning subsequent lines with the record, or aligning 4 spaces in are equivalent. + #ie to indent lines further - whitespace should be added 4+ columns in from the record-line start position. + #(this leaves an oddity if indenting is only 1 2 or 3 spaces mixed with longer indents as we don't check for it.. REVIEW) + #(note string first "" $str is fast and returns -1) + if {[tcl::string::first "$lastindent " $rawline] == 0} { + set trimmedline [tcl::string::range $rawline [tcl::string::length "$lastindent "] end] + append linebuild $trimmedline \n + } elseif {[tcl::string::first $lastindent $rawline] == 0} { + set trimmedline [tcl::string::range $rawline [tcl::string::length $lastindent] end] + append linebuild $trimmedline \n } else { append linebuild $rawline \n } @@ -719,14 +766,13 @@ tcl::namespace::eval punk::args { } } else { set in_record 0 - if {[tcl::string::length $lastindent]} { - #trim only the whitespace corresponding to last indent - not all whitespace on left - if {[tcl::string::first $lastindent $rawline] == 0} { - set trimmedline [tcl::string::range $rawline [tcl::string::length $lastindent] end] - append linebuild $trimmedline - } else { - append linebuild $rawline - } + #trim only the whitespace corresponding to last record indent or lastindent + 4 spaces - not all whitespace on left + if {[tcl::string::first "$lastindent " $rawline] == 0} { + set trimmedline [tcl::string::range $rawline [tcl::string::length "$lastindent "] end] + append linebuild $trimmedline + } elseif {[tcl::string::first $lastindent $rawline] == 0} { + set trimmedline [tcl::string::range $rawline [tcl::string::length $lastindent] end] + append linebuild $trimmedline } else { append linebuild $rawline } @@ -734,10 +780,13 @@ tcl::namespace::eval punk::args { set linebuild "" } } - set cmd_info {} - set id_info {} ;#e.g -children ?? - set doc_info {} + set cmd_info {} + set package_info {} + set id_info {} ;#e.g -children ?? + set doc_info {} set argdisplay_info {} ;#optional override of autogenerated 'Arg Type Default Multi Help' table + set seealso_info {} + set keywords_info {} ###set leader_min 0 ###set leader_max 0 ;#default 0 but if leader_min is set switches to -1 for no limit #set leader_max "" @@ -745,7 +794,7 @@ tcl::namespace::eval punk::args { set opt_any 0 set val_min 0 set val_max -1 ;#-1 for no limit - set DEF_definition_id "" + set DEF_definition_id $id #form_defs set F [dict create _default [New_command_form _default]] @@ -840,20 +889,26 @@ tcl::namespace::eval punk::args { set at_specs $record_values switch -- [tcl::string::range $directive_name 1 end] { + dynamic { + set is_dynamic 1 + } id { + #disallow duplicate @id line ? + #review - nothing to stop multiple @id lines - or redefining as auto (which is ignored?) + #id An id will be allocated if no id line present or the -id value is "auto" - if {$DEF_definition_id ne ""} { - #disallow duplicate @id line - error "punk::args::define - @id already set. Existing value $DEF_definition_id\n[join $args \n]" - } + if {[dict exists $at_specs -id]} { - set DEF_definition_id [dict get $at_specs -id] - } else { - set DEF_definition_id auto + set thisid [dict get $at_specs -id] + if {$thisid ni [list $id auto]} { + error "punk::args::define @id mismatch existing: $id vs $thisid" + } } set id_info $at_specs } ref { + #a reference within the definition + #e.g see punk::args::tclcore ::after #global reference dict - independent of forms #ignore refs without an -id #store all keys except -id @@ -867,10 +922,10 @@ tcl::namespace::eval punk::args { #(if we were to take from a definition - we would have to check and maybe change this def to -dynamic.. ?) #perhaps we could allow -dynamic as a flag here - but IFF this define is already -dynamic (?) #That is possibly too complicated and/or unnecessary? - #however.. as it stands we have define -dynamic 1 making *immediate* resolutions .. is that really desirable? + #however.. as it stands we have define @dynamic making *immediate* resolutions .. is that really desirable? if {[dict exists $at_specs -id]} { - set copyfrom [get_def [dict get $at_specs -id]] + set copyfrom [get_spec [dict get $at_specs -id]] #we don't copy the @id info from the source #for now we only copy across if nothing set.. #todo - bring across defaults for empty keys at targets? @@ -942,6 +997,9 @@ tcl::namespace::eval punk::args { } #new form keys already created if they were needed (done for all records that have -form ) } + package { + set package_info [dict merge $package_info $at_specs] + } cmd { #allow arbitrary - review set cmd_info [dict merge $cmd_info $at_specs] @@ -968,7 +1026,7 @@ tcl::namespace::eval punk::args { -anyopts { set opt_any $v } - -minsize - -maxsize - -range - -choices - -choicegroups - -choicecolumns - -choicelabels - -choiceinfo - -choiceprefix - -choiceprefixdenylist - -choicerestricted { + -minsize - -maxsize - -range - -choices - -choicegroups - -choicemultiple - -choicecolumns - -choicelabels - -choiceinfo - -choiceprefix - -choiceprefixdenylist - -choicerestricted { #review - only apply to certain types? tcl::dict::set tmp_optspec_defaults $k $v } @@ -1014,7 +1072,7 @@ tcl::namespace::eval punk::args { tcl::dict::set tmp_optspec_defaults $k $v } default { - set known { -any -anyopts -minsize -maxsize -range -choices -choicegroups -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted -nocase\ + set known { -any -anyopts -minsize -maxsize -range -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted -nocase\ -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ -regexprepass -regexprefail -regexprefailmsg -validationtransform\ @@ -1052,10 +1110,16 @@ tcl::namespace::eval punk::args { } dict set F $fid LEADER_MAX $v } - -minsize - -maxsize - -range - -choices - -choicegroups - -choicecolumns - -choicelabels - -choiceinfo - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -nocase { + -minsize - -maxsize - -range - -choices - -choicegroups - -choicemultiple - -choicecolumns - -choicelabels - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -nocase { #review - only apply to certain types? tcl::dict::set tmp_leaderspec_defaults $k $v } + -choiceinfo { + if {[llength $v] %2 != 0} { + error "punk::args::define - key '-choiceinfo' requires a dictionary value as an argument. got $v id:$DEF_definition_id" + } + tcl::dict::set tmp_leaderspec_defaults $k $v + } -nominsize - -nomaxsize - -norange - -nochoices - -nochoicelabels { #-choicegroups? if {$v} { @@ -1100,7 +1164,7 @@ tcl::namespace::eval punk::args { default { set known { -min -minvalues -max -maxvalues\ -minsize -maxsize -range\ - -choices -choicegroups -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted\ + -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted\ -nocase -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ -regexprepass -regexprefail -regexprefailmsg -validationtransform\ @@ -1138,12 +1202,18 @@ tcl::namespace::eval punk::args { } set val_max $v } - -minsize - -maxsize - -range - -choices - -choicegroups - -choicecolumns - -choicelabels - -choiceinfo - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -nocase { + -minsize - -maxsize - -range - -choices - -choicemultiple - -choicecolumns - -choicelabels - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -nocase { #review - only apply to certain types? tcl::dict::set tmp_valspec_defaults $k $v } + -choiceinfo - -choicegroups { + if {[llength $v] % 2 != 0} { + error "punk::args::define - key '$k' requires a dictionary value as an argument. got $v id:$DEF_definition_id" + } + tcl::dict::set tmp_valspec_defaults $k $v + } -nominsize - -nomaxsize - -norange - -nochoices - -nochoicelabels { - # -choicegoups ?? + # -choicegroups ?? if {$v} { set k2 -[string range $k 3 end] ;#strip 'no' tcl::dict::unset tmp_valspec_defaults $k2 @@ -1186,7 +1256,7 @@ tcl::namespace::eval punk::args { default { set known { -min -minvalues -max -maxvalues\ -minsize -maxsize -range\ - -choices -choicegroups -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted\ + -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted\ -nocase\ -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ @@ -1203,6 +1273,11 @@ tcl::namespace::eval punk::args { seealso { #todo! #like @doc, except displays in footer, multiple - sub-table? + set seealso_info [dict merge $seealso_info $at_specs] + } + keywords { + #review - put as option on @cmd instead? @cmd -name xxx -keywords {blah etc hmm} ?? + set keywords_info [dict merge $keywords_info $at_specs] } default { error "punk::args::define - unrecognised @ line in '$rec'. Expected @id @cmd @form... @leaders @opts @values @doc @argdisplay - use @@name if paramname needs to be @name @id:$DEF_definition_id" @@ -1331,7 +1406,7 @@ tcl::namespace::eval punk::args { } } -default - -solo - -range - - -choices - -choicegroups - -choicecolumns - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -choicelabels - -choiceinfo - + -choices - -choicegroups - -choicemultiple - -choicecolumns - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -choicelabels - -choiceinfo - -minsize - -maxsize - -nocase - -optional - -multiple - -validate_ansistripped - -allow_ansi - -strip_ansi - -help - -ARGTYPE - -regexprepass - -regexprefail - -regexprefailmsg @@ -1376,7 +1451,7 @@ tcl::namespace::eval punk::args { } } } else { - set known_argopts [list -form -default -type -range -minsize -maxsize -choices -choicegroups -choicecolumns -choiceprefix -choiceprefixdenylist -choicerestricted\ + set known_argopts [list -form -default -type -range -minsize -maxsize -choices -choicegroups -choicemultiple -choicecolumns -choiceprefix -choiceprefixdenylist -choicerestricted\ -nocase -optional -multiple -validate_ansistripped -allow_ansi -strip_ansi -help\ -regexprepass -regexprefail -regexprefailmsg -validationtransform\ ] @@ -1426,10 +1501,10 @@ tcl::namespace::eval punk::args { } ;# end foreach rec $records - if {$DEF_definition_id eq "" || [tcl::string::tolower $DEF_definition_id] eq "auto"} { - variable id_counter - set DEF_definition_id "autoid_[incr id_counter]" - } + #if {$DEF_definition_id eq "" || [tcl::string::tolower $DEF_definition_id] eq "auto"} { + # variable id_counter + # set DEF_definition_id "autoid_[incr id_counter]" + #} #check ALL forms not just form_ids_active (record_form_ids) @@ -1521,9 +1596,11 @@ tcl::namespace::eval punk::args { VAL_CHECKS_DEFAULTS [dict get $F $firstformid VAL_CHECKS_DEFAULTS]\ cmd_info $cmd_info\ doc_info $doc_info\ + package_info $package_info\ argdisplay_info $argdisplay_info\ + seealso_info $seealso_info\ id_info $id_info\ - temp_F $F\ + FORMS $F\ form_names [dict keys $F]\ FORM_INFO $form_info\ ] @@ -1533,42 +1610,75 @@ tcl::namespace::eval punk::args { #also cache resolved version tcl::dict::set argdata_cache $optionspecs $argdata_dict } - #tcl::dict::set argdefcache_by_id $DEF_definition_id $optionspecs - tcl::dict::set argdefcache_by_id $DEF_definition_id $args + + #tcl::dict::set id_cache_rawdef $DEF_definition_id $args #puts "xxx:$result" return $argdata_dict } #return raw definition list as created with 'define' - proc rawdef {id} { - variable argdefcache_by_id + # - possibly with unresolved dynamic parts + proc raw_def {id} { + variable id_cache_rawdef set realid [real_id $id] - #return the raw definition - possibly with unresolved dynamic parts - if {![dict exists $argdefcache_by_id $realid]} { + if {![dict exists $id_cache_rawdef $realid]} { return "" } - return [tcl::dict::get $argdefcache_by_id $realid] + return [tcl::dict::get $id_cache_rawdef $realid] } namespace eval argdoc { - variable resolved_def_TYPE_CHOICES {* @id @cmd @leaders @opts @values @doc} + variable resolved_def_TYPE_CHOICES {* @id @package @cmd @ref @doc @argdisplay @seealso @leaders @opts @values leaders opts values} + variable resolved_def_TYPE_CHOICEGROUPS { + directives {@id @package @cmd @ref @doc @argdisplay @seealso} + argumenttypes {leaders opts values} + remaining_defaults {@leaders @opts @values} + } - lappend PUNKARGS [list -dynamic 0 [string map [list %TYPECHOICES% $resolved_def_TYPE_CHOICES] { + lappend PUNKARGS [list [string map [list %TYPECHOICES% $resolved_def_TYPE_CHOICES %TYPECHOICEGROUPS% $resolved_def_TYPE_CHOICEGROUPS] { @id -id ::punk::args::resolved_def @cmd -name punk::args::resolved_def -help\ - "" + "Resolves or retrieves the previously resolved definition and + uses the 'spec' form to build a response in definition format. + + Pulling argument definition data from another function is a form + of tight coupling to the other function that should be done with + care. + + Note that the directives @leaders @opts @values may appear multiple + times in a source definition - applying defaults for arguments that + follow. When retrieving these - there is only a single result for + each that represents the defaults after all have been applied. + When retrieving -types * each of these will be positioned before + the arguments of that type - but this doesn't mean there was a single + leading directive for this argument type in the source definition. + Each argument has already had its complete specification recorded in + its own result. + + When manually specifying -types, the order @leaders then @opts then + @values must be maintained - but if they are placed before their + corresponding arguments, they will not affect the retrieved arguments + as these arguments are already fully spec'd. The defaults from the + source can be removed by adding @leaders, @opts @values to the + -antiglobs list, but again - this won't affect the existing arguments. + Each argument can have members of its spec overridden using the + -override dictionary. + " @leaders -min 0 -max 0 @opts -form -default 0 -help\ - "UNIMPLEMENTED - Ordinal index or name of command form" - -type -default * -choices {%TYPECHOICES%} -choiceprefix 0 -multiple 1 + "Ordinal index or name of command form" + + #no restriction on number of types/repetitions? + -types -default * -choices {%TYPECHOICES%} -choicegroups {%TYPECHOICEGROUPS%} -choiceprefix 0 -choicemultiple {0 -1} + -antiglobs -default {} -type list -help\ + "Glob patterns for directive or argument/flags to + be suppressed" -override -type dict -optional 1 -default "" -help\ "dict of dicts. Key in outer dict is the name of a directive or an argument. Inner dict is a map of overrides/additions (- ...) for that line. - (unimplemented). " @values -min 1 -max -1 id -type string -help\ @@ -1597,23 +1707,24 @@ tcl::namespace::eval punk::args { proc resolved_def {args} { set opts [dict create\ - -type {}\ + -types {}\ -form 0\ + -antiglobs {}\ -override {}\ ] if {[llength $args] < 1} { #must have at least id - punk::args::get_by_id ::punk::args::resolved_def $args + punk::args::parse $args withid ::punk::args::resolved_def return } set patterns [list] - #a definition id must not begin with "-" + #a definition id must not begin with "-" ??? review for {set i 0} {$i < [llength $args]} {incr i} { set a [lindex $args $i] - if {$a eq "-type"} { + if {$a in {-type -types}} { incr i - dict lappend opts -type [lindex $args $i] + dict set opts -types [lindex $args $i] } elseif {[string match -* $a]} { incr i dict set opts $a [lindex $args $i] @@ -1623,7 +1734,7 @@ tcl::namespace::eval punk::args { break } if {$i == [llength $args]-1} { - punk::args::get_by_id ::punk::args::resolved_def $args + punk::args::parse $args withid ::punk::args::resolved_def return } } @@ -1632,47 +1743,121 @@ tcl::namespace::eval punk::args { } dict for {k v} $opts { switch -- $k { - -form - -type - -override {} + -form - -types - -antiglobs - -override {} default { - punk::args::get_by_id ::punk::args::resolved_def $args + punk::args::parse $args withid ::punk::args::resolved_def return } } } - set typelist [dict get $opts -type] + set typelist [dict get $opts -types] if {[llength $typelist] == 0} { set typelist {*} } foreach type $typelist { if {$type ni $::punk::args::argdoc::resolved_def_TYPE_CHOICES} { - punk::args::get_by_id ::punk::args::resolved_def $args + punk::args::parse $args withid ::punk::args::resolved_def return } } - variable argdefcache_by_id + + variable id_cache_rawdef set realid [real_id $id] if {$realid ne ""} { - set deflist [tcl::dict::get $argdefcache_by_id $realid] + set deflist [tcl::dict::get $id_cache_rawdef $realid] set result "" - set specdict [uplevel 1 [list ::punk::args::define {*}$deflist]] - set arg_info [dict get $specdict ARG_INFO] - set argtypes [dict create @opts option @leaders leader @values value] + set specdict [uplevel 1 [list ::punk::args::resolve {*}$deflist]] + + set opt_form [dict get $opts -form] + if {[string is integer -strict $opt_form]} { + set formname [lindex [dict get $specdict form_names] $opt_form] + } else { + set formname $opt_form + } + set opt_override [dict get $opts -override] + + #set arg_info [dict get $specdict ARG_INFO] + set arg_info [dict get $specdict FORMS $formname ARG_INFO] + set argtypes [dict create leaders leader opts option values value] + + set opt_antiglobs [dict get $opts -antiglobs] + set directives [lsearch -all -inline -exact -not $::punk::args::argdoc::resolved_def_TYPE_CHOICES *] + set suppressed_directives [list] + set suppressed_args [list] + foreach ag $opt_antiglobs { + foreach d $directives { + if {[string match $ag $d]} { + lappend suppressed_directives $d + } + } + foreach argname [dict keys $arg_info] { + if {[string match $ag $argname]} { + lappend suppressed_args $argname + } + } + } + set suppressed_directives [lsort -unique $suppressed_directives] + set suppressed_args [lsort -unique $suppressed_args] + + set included_directives [punk::args::system::punklib_ldiff $directives $suppressed_directives] + + set globbed [list] + foreach pat $patterns { + set matches [dict keys $arg_info $pat] + lappend globbed {*}$matches + } + set globbed [lsort -unique $globbed] + set included_args [punk::args::system::punklib_ldiff $globbed $suppressed_args] + foreach type $typelist { switch -exact -- $type { * { - append result \n "@id -id [dict get $specdict id]" - append result \n "@cmd [dict get $specdict cmd_info]" - append result \n "@doc [dict get $specdict doc_info]" - foreach tp {leader option value} { - foreach pat $patterns { - set matches [dict keys $arg_info $pat] - foreach m $matches { - set def [dict get $arg_info $m] - if {[dict get $def -ARGTYPE] eq $tp} { - set def [dict remove $def -ARGTYPE] - append result \n "$m $def" + if {"@id" in $included_directives} { + if {[dict exists $opt_override @id]} { + append result \n "@id [dict merge [dict create -id [dict get $specdict id]] [dict get $opt_override @id]]" + } else { + append result \n "@id -id [dict get $specdict id]" + } + } + foreach directive {@package @cmd @doc @seealso @argdisplay} { + set dshort [string range $directive 1 end] + if {"$directive" in $included_directives} { + if {[dict exists $opt_override $directive]} { + append result \n "$directive [dict merge [dict get $specdict ${dshort}_info] [dict get $opt_override $directive]]" + } else { + append result \n "$directive [dict get $specdict ${dshort}_info]" + } + } + } + #output ordered by leader, option, value + foreach pseudodirective {leaders opts values} tp {leader option value} { + set directive "@$pseudodirective" + switch -- $directive { + @leaders {set defaults_key leaderspec_defaults} + @opts {set defaults_key optspec_defaults} + @values {set defaults_key valspec_defaults} + } + + if {"$directive" in $included_directives} { + if {[dict exists $opt_override "$directive"]} { + append result \n "$directive [dict merge [dict get $specdict $defaults_key] [dict get $opt_override $directive]]" + } else { + append result \n "$directive [dict get $specdict $defaults_key]" + } + } + + if {$pseudodirective in $included_directives} { + foreach m $included_args { + set argspec [dict get $arg_info $m] + if {[dict get $argspec -ARGTYPE] eq $tp} { + set argspec [dict remove $argspec -ARGTYPE] + if {[dict exists $opt_override $m]} { + append result \n "$m [dict merge $argspec [dict get $opt_override $m]]" + } else { + append result \n "$m $argspec" + } } } } @@ -1680,27 +1865,52 @@ tcl::namespace::eval punk::args { } @id { - #only a single id record can exist - append result \n "@id -id [dict get $specdict id]" - } - @cmd { - #only a single @cmd record can exist - #merged if multiple in original def (?) - append result \n "@cmd [dict get $specdict cmd_info]" + if {"@id" in $included_directives} { + #only a single id record can exist + if {[dict exists $opt_override @id]} { + append result \n "@id [dict merge [dict create -id [dict get $specdict id]] [dict get $opt_override @id]]" + } else { + append result \n "@id -id [dict get $specdict id]" + } + } } - @doc { - #only a single @doc record can exist - append result \n "@doc [dict get $specdict doc_info]" + @package - @cmd - @doc - @seealso - @argdisplay { + if {"$type" in $included_directives} { + set tp [string range $type 1 end] ;# @package -> package + if {[dict exists $opt_override $type]} { + append result \n "$type [dict merge [dict get $specdict ${tp}_info] [dict get $opt_override $type]]" + } else { + append result \n "$type [dict get $specdict ${tp}_info]" + } + } } @leaders - @opts - @values { - #option, - foreach pat $patterns { - set matches [dict keys $arg_info $pat] - foreach m $matches { - set def [dict get $arg_info $m] - if {[dict get $def -ARGTYPE] eq [dict get $argtypes $type]} { - set def [dict remove $def -ARGTYPE] - append result \n "$m $def" + #these are the active defaults for further arguments + if {"$type" in $included_directives} { + switch -- $type { + @leaders {set defaults_key leaderspec_defaults} + @opts {set defaults_key optspec_defaults} + @values {set defaults_key valspec_defaults} + } + if {[dict exists $opt_override $type]} { + append result \n "$type [dict merge [dict get $specdict leaderspec_defaults] [dict get $opt_override $type]]" + } else { + append result \n "$type [dict get $specdict leaderspec_defaults]" + } + } + } + leaders - opts - values { + #pseudo-directives + if {$type in $included_directives} { + foreach m $included_args { + set argspec [dict get $arg_info $m] + if {[dict get $argspec -ARGTYPE] eq [dict get $argtypes $type]} { + set argspec [dict remove $argspec -ARGTYPE] + if {[dict exists $opt_override $m]} { + append result \n "$m [dict merge $argspec [dict get $opt_override $m]]" + } else { + append result \n "$m $argspec" + } } } } @@ -1714,12 +1924,12 @@ tcl::namespace::eval punk::args { } } - proc get_spec_values {id {patternlist *}} { - variable argdefcache_by_id + proc resolved_def_values {id {patternlist *}} { + variable id_cache_rawdef set realid [real_id $id] if {$realid ne ""} { - set speclist [tcl::dict::get $argdefcache_by_id $realid] - set specdict [define {*}$speclist] + set speclist [tcl::dict::get $id_cache_rawdef $realid] + set specdict [resolve {*}$speclist] set arg_info [dict get $specdict ARG_INFO] set valnames [dict get $specdict VAL_NAMES] set result "" @@ -1744,18 +1954,69 @@ tcl::namespace::eval punk::args { } } } - #proc get_spec_leaders ?? - #proc get_spec_opts ?? + #proc resolved_def_leaders ?? + #proc resolved_def_opts ?? - proc get_def {id} { - return [define {*}[rawdef $id]] + proc get_spec {id} { + set rdef [raw_def $id] + if {$rdef eq ""} {return} + return [resolve {*}$rdef] #if {[id_exists $id]} { - # return [define {*}[rawdef $id]] + # return [resolve {*}[raw_def $id]] #} } proc is_dynamic {id} { - set deflist [rawdef $id] - return [expr {[lindex $deflist 0] eq "-dynamic" && [lindex $deflist 1]} ] + variable id_cache_rawdef + variable rawdef_cache + set deflist [raw_def $id] + if {[dict exists $rawdef_cache $deflist -dynamic]} { + return [dict get $rawdef_cache $deflist -dynamic] + } + return [rawdef_is_dynamic $deflist] + #@dynamic only has meaning as 1st element of a def in the deflist + } + + #@id must be within first 4 lines of a block - or assign auto + #review - @dynamic block where -id not explicitly set? - disallow? + proc rawdef_id {rawdef} { + set id "" + foreach d $rawdef { + foreach ln [lrange [split $d \n] 0 4] { + if {[regexp {\s*(\S+)(.*)} $ln _match firstword rest]} { + if {$firstword eq "@id"} { + if {[llength $rest] %2 == 0 && [dict exists $rest -id]} { + set id [dict get $rest -id] + break + } + } + } + } + if {$id ne ""} { + break + } + } + if {$id eq "" || [string tolower $id] eq "auto"} { + variable id_counter + set id "autoid_[incr id_counter]" + } + #puts "==>id: $id" + return $id + } + #test the rawdef for @dynamic directive + proc rawdef_is_dynamic {rawdef} { + #temporary - old way + set flagged_dynamic [expr {[lindex $rawdef 0] eq "-dynamic" && [lindex $rawdef 1]} ] + if {$flagged_dynamic} { + return true + } + foreach d $rawdef { + if {[regexp {\s*(\S+)} $d _match firstword]} { + if {$firstword eq "@dynamic"} { + return true + } + } + } + return false } variable aliases @@ -1770,19 +2031,19 @@ tcl::namespace::eval punk::args { "exact id or glob pattern for ids" }] proc get_ids {{match *}} { - variable argdefcache_by_id + variable id_cache_rawdef variable aliases - return [list {*}[tcl::dict::keys $aliases $match] {*}[tcl::dict::keys $argdefcache_by_id $match]] + return [list {*}[tcl::dict::keys $aliases $match] {*}[tcl::dict::keys $id_cache_rawdef $match]] } #we don't automatically test for (autodef)$id - only direct ids and aliases proc id_exists {id} { - variable argdefcache_by_id variable aliases if {[tcl::dict::exists $aliases $id]} { return 1 } - tcl::dict::exists $argdefcache_by_id $id + variable id_cache_rawdef + tcl::dict::exists $id_cache_rawdef $id } proc set_alias {alias id} { variable aliases @@ -1800,16 +2061,18 @@ tcl::namespace::eval punk::args { } proc real_id {id} { - variable argdefcache_by_id + variable id_cache_rawdef variable aliases if {[tcl::dict::exists $aliases $id]} { set id [tcl::dict::get $aliases $id] } - if {[tcl::dict::exists $argdefcache_by_id $id]} { + if {[tcl::dict::exists $id_cache_rawdef $id]} { return $id } else { - if {![llength [update_definitions]]} { - if {[tcl::dict::exists $argdefcache_by_id (autodef)$id]} { + set check_updates [list [namespace qualifiers $id]] + if {![llength [update_definitions $check_updates]]} { + #nothing new loaded + if {[tcl::dict::exists $id_cache_rawdef (autodef)$id]} { return (autodef)$id } return "" @@ -1817,10 +2080,10 @@ tcl::namespace::eval punk::args { if {[tcl::dict::exists $aliases $id]} { set id [tcl::dict::get $aliases $id] } - if {[tcl::dict::exists $argdefcache_by_id $id]} { + if {[tcl::dict::exists $id_cache_rawdef $id]} { return $id } - if {[tcl::dict::exists $argdefcache_by_id (autodef)$id]} { + if {[tcl::dict::exists $id_cache_rawdef (autodef)$id]} { return (autodef)$id } return "" @@ -1828,42 +2091,188 @@ tcl::namespace::eval punk::args { } } - variable loaded_packages - set loaded_packages [list] + proc status {} { + upvar ::punk::args::register::NAMESPACES registered + upvar ::punk::args::register::loaded_packages loaded_packages + upvar ::punk::args::register::loaded_info loaded_info + upvar ::punk::args::register::scanned_packages scanned_packages + upvar ::punk::args::register::scanned_info scanned_info + set result "" + # [format %-${w0}s $idtail] + set widest [tcl::mathfunc::max {*}[lmap v [list {*}$registered "Registered"] {string length $v}]] + append result "[format %-${widest}s Registered] Scanned_ids Scantime_us Loaded_defs Loadtime_us" \n + set width_c2 [string length "Scanned_ids"] + set width_c3 [string length "Scantime_us"] + set width_c4 [string length "Loaded_defs"] + set width_c5 [string length "Loadtime_us"] + set count_unloaded 0 + set count_loaded 0 + foreach ns $registered { + if {$ns in $scanned_packages} { + set ids [dict get $scanned_info $ns idcount] + set scan_us [dict get $scanned_info $ns time] + } else { + set ids "" + set scan_us "" + } + if {$ns in $loaded_packages} { + incr count_loaded + set ldefs [dict get $loaded_info $ns defcount] + set load_us [dict get $loaded_info $ns time] + } else { + incr count_unloaded + set ldefs "" + set load_us "" + } + append result "[format %-${widest}s $ns] [format %${width_c2}s $ids] [format %${width_c3}s $scan_us] [format %${width_c4}s $ldefs] [format %${width_c5}s $load_us]" \n + } + append result "\nPackages - Registered: [llength $registered] Loaded: $count_loaded Unloaded: $count_unloaded" + return $result + } + + #scanned_packages (list) + #namespace_docpackages (dict) + proc update_definitions {{nslist *}} { + if {[set gposn [lsearch $nslist {}]] >= 0} { + lset nslist $gposn :: + } + upvar ::punk::args::register::NAMESPACES registered ;#list + upvar ::punk::args::register::loaded_packages loaded_packages ;#list + upvar ::punk::args::register::loaded_info loaded_info ;#dict + upvar ::punk::args::register::scanned_packages scanned_packages ;#list + upvar ::punk::args::register::scanned_info scanned_info ;#dict + upvar ::punk::args::register::namespace_docpackages namespace_docpackages ;#dict - proc update_definitions {} { + + #puts stderr "-->update_definitions '$nslist'" #needs to run quickly - especially when no package namespaces to be scanned for argdefs - #e.g - get's called for each subcommand of an ensemble (could be many) + #e.g - gets called for each subcommand of an ensemble (could be many) # It needs to get called in each arginfo call as we don't know what namespace origins or aliases may be involved in resolving a command. #we could possibly get away with not calling it for nested calls (such as with ensemble subcommands) but the code to avoid calls is probably more complex/slow than any gain avoiding the fast-path below. # -- --- --- --- --- --- # common-case fast-path - variable loaded_packages - upvar ::punk::args::register::NAMESPACES pkgs - if {[llength $loaded_packages] == [llength $pkgs]} { + + if {[llength $loaded_packages] == [llength $registered]} { #the only valid mechanism to add to 'loaded_packages' is with this function - so if lengths are equal, nothing to do. + #assert - if all are registered - then all have been scanned ( return {} } # -- --- --- --- --- --- - set unloaded [punklib_ldiff $pkgs $loaded_packages] + set unscanned [punklib_ldiff $registered $scanned_packages] + if {[llength $unscanned]} { + foreach pkgns $unscanned { + set idcount 0 + set ts_start [clock microseconds] + if {[info exists ${pkgns}::PUNKARGS]} { + set seen_documentedns [list] ;#seen per pkgns + foreach definitionlist [set ${pkgns}::PUNKARGS] { + #namespace eval $evalns [list punk::args::define {*}$definitionlist] + set id [rawdef_id $definitionlist] + if {[string match autoid_* $id]} { + puts stderr "update_definitions - unexpected autoid during scan of $pkgns - skipping" + puts stderr "definition:\n" + foreach d $definitionlist { + set out "" + foreach ln [split $d \n] { + append out " " $ln \n + } + puts $out + } + continue + } + #todo - detect duplicate ids (last will silently win.. should be reported somewhere) + incr idcount + set documentedns [namespace qualifiers $id] + if {$documentedns eq ""} {set documentedns ::} + if {$documentedns ni $seen_documentedns} { + #don't add own ns as a key in namespace_docpackages + if {$documentedns ne $pkgns} { + dict lappend namespace_docpackages $documentedns $pkgns + } + lappend seen_documentedns $documentedns + } + } + } + set ts_end [clock microseconds] + set diff [expr {$ts_end - $ts_start}] + dict set scanned_info $pkgns [dict create time $diff idcount $idcount] + #we count it as scanned even if PUNKARGS didn't exist + #(registered the namespace, variable PUNKARGS may or may not be declared, but didn't set PUNKARGS) + lappend scanned_packages $pkgns + } + } + + + + if {"*" in $nslist} { + set needed [punklib_ldiff $registered $loaded_packages] + } else { + set needed [list] + foreach pkgns $nslist { + if {$pkgns in $registered && $pkgns ni $loaded_packages} { + lappend needed $pkgns + } + #argdoc sub namespace is a standard place to put defs that match the namespace below + #(generally the PUNKARGS in a namespace should apply to own ns) + set docns ${pkgns}::argdoc + if {[namespace exists $docns]} { + if {($pkgns in $registered || $docns in $registered) && $docns ni $needed && $docns ni $loaded_packages} { + lappend needed $docns + } + } + if {[dict exists $namespace_docpackages $pkgns]} { + #this namespace has other argdef sources + foreach docns [dict get $namespace_docpackages $pkgns] { + if {$docns ni $loaded_packages} { + lappend needed $docns + } + } + } + } + } + + + set newloaded [list] - foreach pkgns $unloaded { - #puts -nonewline stderr . ;#debugging - see actual loads + foreach pkgns $needed { + #puts stderr "update_definitions Loading: $pkgns" + set ts_start [clock microseconds] + set def_count 0 if {![catch { if {[info exists ${pkgns}::PUNKARGS]} { + set docns ${pkgns}::argdoc + if {[namespace exists $docns]} { + namespace eval ${pkgns}::argdoc { + set epath [namespace path] + set pkgns [namespace parent] + if {$pkgns ni $epath} { + namespace path [list {*}$epath $pkgns] ;#add to tail + } + + } + set evalns $docns + } else { + set evalns $pkgns + } foreach definitionlist [set ${pkgns}::PUNKARGS] { - namespace eval $pkgns [list punk::args::define {*}$definitionlist] + namespace eval $evalns [list punk::args::define {*}$definitionlist] + incr def_count } } + + #process list of 2-element lists if {[info exists ${pkgns}::PUNKARGS_aliases]} { foreach adef [set ${pkgns}::PUNKARGS_aliases] { punk::args::set_alias {*}$adef } } } errMsg]} { + set ts_end [clock microseconds] + set diff [expr {$ts_end - $ts_start}] lappend loaded_packages $pkgns lappend newloaded $pkgns + dict set loaded_info $pkgns [dict create time $diff defcount $def_count] } else { puts stderr "punk::args::update_definitions error - failed to load PUNKARGS definitions for $pkgns\nerr:$errMsg" } @@ -1875,7 +2284,8 @@ tcl::namespace::eval punk::args { #This mechanism gets less-than-useful results for oo methods #e.g {$obj} proc Get_caller {} { - set call_level -3 + #set call_level -3 ;#for get_dict call + set call_level -4 set cmdinfo [tcl::dict::get [tcl::info::frame $call_level] cmd] #puts "-->$cmdinfo" #puts "-->[tcl::info::frame -3]" @@ -1918,7 +2328,7 @@ tcl::namespace::eval punk::args { @values -min 0 -max 0 }] proc test_get_dict {args} { - punk::args::get_dict {*}[punk::args::rawdef ::punk::args::test1] $args + punk::args::get_dict {*}[punk::args::raw_def ::punk::args::test1] $args } proc test_get_by_id {args} { punk::args::get_by_id ::punk::args::test1 $args @@ -1960,22 +2370,22 @@ tcl::namespace::eval punk::args { " @leaders -min 2 -max 2 msg -type string -help\ - "error message to display immediately prior to usage table. - May be empty string to just display usage. + "Error message to display immediately prior to usage table. + May be empty string to just display usage. " spec_dict -type dict -help\ - "Dictionary of argument specifications. - This is the internal format parsed from - the textual definition. It contains the data - organised/optimised to allow the final arg - parser/validator to make decisions. + "Dictionary of argument specifications. + This is the internal format parsed from + the textual definition. It contains the data + organised/optimised to allow the final arg + parser/validator to make decisions. " @opts -badarg -type string -help\ "name of an argument to highlight" -aserror -type boolean -help\ - "If true, the usage table is raised as an error message, - otherwise it is returned as a value." + "If true, the usage table is raised as an error message, + otherwise it is returned as a value." -return -choices {string table tableobject} -choicelabels { string "no table layout" tableobject "table object cmd" @@ -2133,6 +2543,8 @@ tcl::namespace::eval punk::args { } + #set RST [a] + set RST "\x1b\[m" set t "" ;#possible oo table object - may be tested for objectiness at the end so needs to exist. #REVIEW - risk of accidental indefinite recursion if functions used here also use punk::args::get_dict and there is an argument error @@ -2158,7 +2570,7 @@ tcl::namespace::eval punk::args { append errmsg \n } else { if {($returntype in {table tableobject}) && !$has_textblock} { - append errmsg \n "$CLR(errormsg)(layout package textblock is missing)[a]" \n + append errmsg \n "$CLR(errormsg)(layout package textblock is missing)$RST" \n } else { append errmsg \n } @@ -2181,7 +2593,7 @@ tcl::namespace::eval punk::args { set blank_header_col [list] if {$cmdname ne ""} { lappend blank_header_col "" - set cmdname_display $CLR(cmdname)$cmdname[a] + set cmdname_display $CLR(cmdname)$cmdname$RST } else { set cmdname_display "" } @@ -2194,7 +2606,7 @@ tcl::namespace::eval punk::args { } if {$docurl ne ""} { lappend blank_header_col "" - set docurl_display [a+ white]$docurl[a] + set docurl_display [a+ white]$docurl$RST } else { set docurl_display "" } @@ -2216,7 +2628,7 @@ tcl::namespace::eval punk::args { lappend blank_header_col "" } if {$use_table} { - set t [textblock::class::table new $CLR(title)Usage[a]] + set t [textblock::class::table new "$CLR(title)Usage$RST"] $t add_column -headers $blank_header_col -minwidth 3 $t add_column -headers $blank_header_col @@ -2295,19 +2707,18 @@ tcl::namespace::eval punk::args { #potentially require coordination with header colspans? $t add_row [list "" $argdisplay_body] } else { - if {$argdisplay_header ne "" + if {$argdisplay_header ne ""} { lappend errlines $argdisplay_header } lappend errlines {*}$argdisplay_body } } else { - set RST [a] #set A_DEFAULT [a+ brightwhite Brightgreen] set A_DEFAULT "" set A_BADARG $CLR(badarg) - set greencheck $CLR(check)\u2713[a] ;#green tick - set soloflag $CLR(solo)\u2690[a] ;#flag - may be replacement char in old dos prompt (?) + set greencheck $CLR(check)\u2713$RST ;#green tick + set soloflag $CLR(solo)\u2690$RST ;#flag - may be replacement char in old dos prompt (?) set A_PREFIX $CLR(choiceprefix) ;#use a+ so colour off can apply if {$A_PREFIX eq "" || $A_PREFIX eq [a+ underline]} { #A_PREFIX can resolve to empty string if colour off @@ -2380,6 +2791,11 @@ tcl::namespace::eval punk::args { set allchoices_originalcase [list] set choices [Dict_getdef $arginfo -choices {}] set choicegroups [Dict_getdef $arginfo -choicegroups {}] + set choicemultiple [dict get $arginfo -choicemultiple] + if {[string is integer -strict $choicemultiple]} { + set choicemultiple [list $choicemultiple $choicemultiple] + } + lassign $choicemultiple choicemultiple_min choicemultiple_max set choicecolumns [Dict_getdef $arginfo -choicecolumns 4] set choiceprefixdenylist [Dict_getdef $arginfo -choiceprefixdenylist {}] if {[Dict_getdef $arginfo -multiple 0]} { @@ -2416,6 +2832,17 @@ tcl::namespace::eval punk::args { set choicelabeldict [Dict_getdef $arginfo -choicelabels {}] set formattedchoices [dict create] ;#use dict rather than array to preserve order append help " Choices$prefixmsg$casemsg" + if {$choicemultiple_max > 1 || $choicemultiple_max == -1} { + if {$choicemultiple_max == -1} { + append help \n " The value can be a list of $choicemultiple_min or more of these choices" + } else { + if {$choicemultiple_min eq $choicemultiple_max} { + append help \n " The value must be a list of $choicemultiple_min of these choices" + } else { + append help \n " The value can be a list of $choicemultiple_min to $choicemultiple_max of these choices" + } + } + } if {![dict get $arginfo -choiceprefix] || [catch {package require punk::trie}]} { #append help "\n " [join [dict get $arginfo -choices] "\n "] if {[dict size $choicelabeldict]} { @@ -2513,7 +2940,7 @@ tcl::namespace::eval punk::args { #append help \n[textblock::join -- " " [$choicetableobj print]] } else { if {$groupname ne ""} { - append help \n \n "$CLR(groupname)Group: $groupname[a]" + append help \n \n "$CLR(groupname)Group: $groupname$RST" } else { append help \n } @@ -2527,15 +2954,15 @@ tcl::namespace::eval punk::args { if {$usetable} { #these will be displayed after all table entries if {$groupname eq ""} { - dict set choicetable_footers "" " $CLR(errormsg)(no choices defined for main group)[a]" + dict set choicetable_footers "" " $CLR(errormsg)(no choices defined for main group)$RST" } else { - dict set choicetable_footers $groupname " $CLR(errormsg)(no choices defined for group $groupname)[a]" + dict set choicetable_footers $groupname " $CLR(errormsg)(no choices defined for group $groupname)$RST" } } else { if {$groupname eq ""} { - append help \n " " $CLR(errormsg)(no choices defined)[a] + append help \n " " $CLR(errormsg)(no choices defined)$RST } else { - append help \n " " $CLR(errormsg)(no choices defined for group $groupname)[a] + append help \n " " $CLR(errormsg)(no choices defined for group $groupname)$RST } } } @@ -2561,7 +2988,7 @@ tcl::namespace::eval punk::args { $obj destroy } if {[dict size $choicetable_footers]} { - foreach groupname [dict keys $formattedchoices { + foreach groupname [dict keys $formattedchoices] { if {[dict exists $choicetable_footers $groupname]} { append help \n [dict get $choicetable_footers $groupname] } @@ -2570,6 +2997,7 @@ tcl::namespace::eval punk::args { #review. use -type to restrict additional choices - may be different to values in the -choices if {![dict get $arginfo -choicerestricted]} { + #when -choicemultiple - the -type refers to each selection if {[dict get $arginfo -type] eq "string"} { append help "\n (values not in defined choices are allowed)" } else { @@ -2609,7 +3037,7 @@ tcl::namespace::eval punk::args { } } else { #review - formatting will be all over the shop due to newlines in typesshow, help - set arghelp "[a+ bold]$argshow[a] TYPE:$typeshow DEFAULT:$default MULTI:$multiple\n" + set arghelp "[a+ bold]$argshow$RST TYPE:$typeshow DEFAULT:$default MULTI:$multiple\n" foreach ln [split $help \n] { append arghelp " $ln" \n } @@ -2666,35 +3094,40 @@ tcl::namespace::eval punk::args { } - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + @dynamic @id -id ::punk::args::usage @cmd -name punk::args::usage -help\ - "Return usage information for a command. + "Return usage information for a command identified by an id. + This will only work for commands where a punk::args definition exists - for the command and an id has been defined for it. + for the command and an id has been defined for it. The id for custom + help for a command should match the fully qualified name of the command. + Many commands (such as ensembles and oo objects) may have argument - documentation generated dynamically and not have an id. + documentation generated dynamically and may not yet have an id. + IDs for autogenenerated help are prefixed e.g (autodef)::myensemble. + Generally punk::ns::arginfo (aliased as i in the punk shell) should be used in preference - as it will search for a documentation - mechanism and call this as necessary. + mechanism and call punk::args::usage as necessary. " -return -default table -choices {string table tableobject} - } {${[punk::args::resolved_def -type @opts ::punk::args::arg_error -scheme]}} { + } {${[punk::args::resolved_def -types opts ::punk::args::arg_error -scheme]}} { @values -min 0 -max 1 id -help\ - "exact id. - Will usually match the command name" + "Exact id. + Will usually match the command name" }] proc usage {args} { lassign [dict values [punk::args::get_by_id ::punk::args::usage $args]] leaders opts values received set id [dict get $values id] - set definitionlist [rawdef $id] - if {[llength $definitionlist] == 0} { + set real_id [real_id $id] + if {$real_id eq ""} { error "punk::args::usage - no such id: $id" } - #by placing scheme before the supplied args - it can be overridden - arg_error "" [uplevel 1 [list punk::args::define {*}$definitionlist]] -scheme punk_info {*}$opts -aserror 0 + arg_error "" [punk::args::get_spec $real_id] -scheme punk_info {*}$opts -aserror 0 } lappend PUNKARGS [list { @@ -2704,13 +3137,13 @@ tcl::namespace::eval punk::args { id arglist -type list -help\ "list containing arguments to be parsed as per the - argument specification identified by the supplied id." + argument specification identified by the supplied id." }] #deprecate? proc get_by_id {id arglist} { - set definitionlist [punk::args::rawdef $id] + set definitionlist [punk::args::raw_def $id] if {[llength $definitionlist] == 0} { error "punk::args::get_by_id - no such id: $id" } @@ -2734,62 +3167,86 @@ tcl::namespace::eval punk::args { @cmd -name punk::args::parse -help\ "parse and validate command arguments based on a definition. - In the 'withid' form the definition is a pre-existing - record that has been created with ::punk::args::define. - In the 'withdef' form - the definition is created on the - first call and cached thereafter. + In the 'withid' form the definition is a pre-existing record that has been + created with ::punk::args::define, or indirectly by adding a definition to + the PUNKARGS variable in a namespace which is then registered in + punk::args::register::NAMESPACES, or by a previous call to punk::parse + using 'withdef' and a definition block containing an @id -id directive. + + In the 'withdef' form - the definition is created on the first call and + cached thereafter, if the id didn't already exist. - form1: parse ?-flag val?... -- $arglist withid $id - form2: parse ?-flag val?... -- $arglist withdef $def ?$def? + form1: parse $arglist ?-flag val?... withid $id + form2: parse $arglist ?-flag val?... withdef $def ?$def? see punk::args::define" + @form -form {withid withdef} + @leaders -min 1 -max 1 + arglist -type list -optional 0 -help\ + "Arguments to parse - supplied as a single list" + @opts - -form -type list -default * -help\ + -form -type list -default * -help\ "Restrict parsing to the set of forms listed. - Forms are the orthogonal sets of arguments a - command can take - usually described in 'synopsis' - entries. - " + Forms are the orthogonal sets of arguments a + command can take - usually described in 'synopsis' + entries." #default to enhanced errorstyle despite slow 'catch' (unhappy path) performance #todo - configurable per interp/namespace - -errorstyle -type string -default enhanced -choices {enhanced standard minimal} - @values -min 3 - sep -optional 0 -choices "--" + -errorstyle -type string -default enhanced -choices {enhanced standard minimal} + @values -min 2 - @form -form withid -synopsis "parse ?-form {int|...}? ?-errorstyle ? -- withid $id" + @form -form withid -synopsis "parse arglist ?-form {int|...}? ?-errorstyle ? withid $id" withid -type literal -help\ "The literal value 'withid'" id -type string -help\ "id of punk::args definition for a command" - @form -form withdef -synopsis "parse ?-form {int|...}? ?-errorstyle ? -- withdef $def ?$def?" + @form -form withdef -synopsis "parse arglist ?-form {int|...}? ?-errorstyle ? withdef $def ?$def?" withdef -type literal -help\ "The literal value 'withdef'" + + #todo - make -dynamic obsolete - use @dynamic directive instead def -type string -multiple 1 -optional 0 -help\ "Each remaining argument is a block of text - defining argument definitions. - As a special case, -dynamic may be - specified as the 1st 2 arguments. These are - not treated as an indicator to punk::args - about how to process the definition." + defining argument definitions. + As a special case, -dynamic may be + specified as the 1st 2 arguments. These are + treated as an indicator to punk::args about + how to process the definition." }] proc parse {args} { set tailtype "" ;#withid|withdef - set split [lsearch -exact $args --] ;#first -- + if {[llength $args] < 3} { + error "punk::args::parse - invalid call. < 3 args" + } + set parseargs [lindex $args 0] + set tailargs [lrange $args 1 end] + + set split [lsearch -exact $tailargs withid] if {$split < 0} { - #punk::args::usage arg_error? - error "punk::args::parse - invalid call. End of opts marker -- is required even if no options are present." + set split [lsearch -exact $tailargs withdef] + if {$split < 0} { + #punk::args::usage arg_error? + error "punk::args::parse - invalid call. keyword withid|withdef required" + } else { + set tailtype withdef + } + } else { + set tailtype withid + } + + set opts [lrange $tailargs 0 $split-1] ;#repeated flags will override earlier. That's ok here. + if {[llength $opts] % 2} { + error "punk::args::parse Even number of -flag val pairs required after arglist" } - set opts [lrange $args 0 $split-1] ;#repeated flags will override earlier. That's ok here. - set arglist [lindex $args $split+1] - set tailtype [lindex $args $split+2] set defaultopts [dict create\ -form {*}\ -errorstyle enhanced\ ] - + set opts [dict merge $opts $defaultopts] dict for {k v} $opts { switch -- $k { -form - -errorstyle { @@ -2802,24 +3259,43 @@ tcl::namespace::eval punk::args { } switch -- $tailtype { withid { - if {[llength [lrange $args $split+3 end]] != 1} { + if {[llength [lrange $tailargs $split+1 end]] != 1} { error "punk::args::parse - invalid call. Expected exactly one argument after 'withid'" } - set id [lindex $args $split+3] - return "parse [llength $arglist] args withid $id, options:$opts" + set id [lindex $tailargs $split+1] + #puts stdout "punk::args::parse [llength $parseargs] args withid $id, options: $opts" + set deflist [raw_def $id] + if {[llength $deflist] == 0} { + error "punk::args::parse - no such id: $id" + } } withdef { - set deflist [lrange $args $split+3 end] + set deflist [lrange $tailargs $split+1 end] if {[llength $deflist] < 1} { error "punk::args::parse - invalid call. Expected at least one argument after 'withdef'" } - return "parse [llength $arglist] with [llength $deflist] definition blocks, options:$opts" + #puts stdout "punk::args::parse [llength $parseargs] args with [llength $deflist] definition blocks, options: $opts" } default { error "punk::args::parse - invalid call. Argument following arglist must be 'withid' or 'withdef'" } } - + try { + set result [punk::args::get_dict {*}$deflist $parseargs] + } trap {PUNKARGS} {msg opts} { + #trap punk::args argument validation/parsing errors and decide here + #whether to display basic error - or full usage if configured. + puts stderr "PUNKARGS: $msg\n$opts" + return + } trap {} {msg opts} { + #review + #puts stderr "$msg\n$opts" + #quote from DKF: The reason for using return -code error vs error or throw depends on where the error is. If the problem is in your code, use error or throw. + #If the problem is in your caller (e.g., because they gave you bad arguments) then use return -code error. Simple. + throw [dict get $opts -errorcode] [dict get $opts -errorinfo] + return + } + return $result } proc parseXXX {args} { #no solo flags allowed for parse function itself. (ok for arglist being parsed) @@ -2920,19 +3396,14 @@ tcl::namespace::eval punk::args { # @values -multiple 1 #} $args - set is_dynamic 0 - if {[lindex $args 0] eq "-dynamic"} { - set is_dynamic [lindex $args 1] - } set rawargs [lindex $args end] ;# args values to be parsed - #we take a definition list rather than argspecs - because the definition could be dynamic set definition_args [lrange $args 0 end-1] #if definition has been seen before, #define will either return a permanently cached argspecs (-dynamic 0) - or # use a cached pre-split definition with parameters to dynamically generate a new (or limitedly cached?) argspecs. - set argspecs [uplevel 1 [list ::punk::args::define {*}$definition_args]] + set argspecs [uplevel 1 [list ::punk::args::resolve {*}$definition_args]] # ----------------------------------------------- # Warning - be aware of all vars thrown into this space (from tail end of 'definition' proc) @@ -3397,22 +3868,22 @@ tcl::namespace::eval punk::args { #puts "---opts_and_values:$opts_and_values" #puts "---argstate:$argstate" tcl::dict::for {argname v} $opts_and_values { - set thisarg [tcl::dict::get $argstate $argname] - #set thisarg_keys [tcl::dict::keys $thisarg] - set thisarg_checks [tcl::dict::get $arg_checks $argname] - set is_multiple [tcl::dict::get $thisarg -multiple] - set is_allow_ansi [tcl::dict::get $thisarg -allow_ansi] - set is_validate_ansistripped [tcl::dict::get $thisarg -validate_ansistripped] - set is_strip_ansi [tcl::dict::get $thisarg -strip_ansi] - set has_default [tcl::dict::exists $thisarg -default] + set thisarg [tcl::dict::get $argstate $argname] + #set thisarg_keys [tcl::dict::keys $thisarg] + set thisarg_checks [tcl::dict::get $arg_checks $argname] + set is_multiple [tcl::dict::get $thisarg -multiple] + set is_allow_ansi [tcl::dict::get $thisarg -allow_ansi] + set is_validate_ansistripped [tcl::dict::get $thisarg -validate_ansistripped] + set is_strip_ansi [tcl::dict::get $thisarg -strip_ansi] + set has_default [tcl::dict::exists $thisarg -default] if {$has_default} { set defaultval [tcl::dict::get $thisarg -default] } - set type [tcl::dict::get $thisarg -type] - set has_choices [expr {[tcl::dict::exists $thisarg -choices] || [tcl::dict::exists $thisarg -choicegroups]}] - set regexprepass [tcl::dict::get $thisarg -regexprepass] - set regexprefail [Dict_getdef $thisarg -regexprefail ""] ;#aliased to dict getdef in tcl9 - set validationtransform [tcl::dict::get $thisarg -validationtransform] + set type [tcl::dict::get $thisarg -type] + set has_choices [expr {[tcl::dict::exists $thisarg -choices] || [tcl::dict::exists $thisarg -choicegroups]}] + set regexprepass [tcl::dict::get $thisarg -regexprepass] + set regexprefail [Dict_getdef $thisarg -regexprefail ""] ;#aliased to dict getdef in tcl9 + set validationtransform [tcl::dict::get $thisarg -validationtransform] if {$is_multiple} { @@ -3443,13 +3914,18 @@ tcl::namespace::eval punk::args { set choiceprefix [tcl::dict::get $thisarg -choiceprefix] set choiceprefixdenylist [Dict_getdef $thisarg -choiceprefixdenylist {}] set choicerestricted [tcl::dict::get $thisarg -choicerestricted] + set choicemultiple [tcl::dict::get $thisarg -choicemultiple] + if {[string is integer -strict $choicemultiple]} { + set choicemultiple [list $choicemultiple $choicemultiple] + } + lassign $choicemultiple choicemultiple_min choicemultiple_max set nocase [tcl::dict::get $thisarg -nocase] set choices [Dict_getdef $thisarg -choices {}] set choicegroups [Dict_getdef $thisarg -choicegroups {}] set allchoices $choices if {[dict size $choicegroups]} { - dict for {groupname clist} $choicegroups { - lappend allchoices {*}$clist + dict for {groupname groupmembers} $choicegroups { + lappend allchoices {*}$groupmembers } } #note we can legitimately have dups in allchoices - if a choice should be documented to display in multiple groups @@ -3468,115 +3944,159 @@ tcl::namespace::eval punk::args { } } set idx 0 ;# - #opts/values_dict $argname member has been populated with the actual entered choices - which might be prefixes + #leaders_dict/opts/values_dict $argname member has been populated with the actual entered choices - which might be prefixes #assert llength $vlist == llength [dict get $dname $argname] # (unless there was a default and the option wasn't specified) set vlist_validate [list] set vlist_check_validate [list] foreach e $vlist e_check $vlist_check { - if {$nocase} { - set casemsg " (case insensitive)" - set choices_test [tcl::string::tolower $allchoices] - #Don't lcase the denylist - even in nocase mode! - #set choiceprefixdenylist [tcl::string::tolower $choiceprefixdenylist] - set v_test [tcl::string::tolower $e_check] + set allchoices_in_list 0 + if {$choicemultiple_max > 1 || $choicemultiple_max == -1} { + #vlist and vlist_check can be list of lists if -multiple and -choicemultiple + #each e represents 0 or more choice selections + set c_list $e + set c_check_list $e_check + #todo? check if entire list matches default? } else { - set casemsg " (case sensitive)" - set v_test $e_check - set choices_test $allchoices + #only one choice at a time - ensure single entry in c_list c_check_list + set c_list [list $e] + set c_check_list [list $e_check] } - set choice_in_list 0 - set matches_default [expr {$has_default && $e eq $defaultval}] - if {!$matches_default} { - if {$choiceprefix} { - #can we handle empty string as a choice? It should just work - REVIEW/test - set choice_exact_match 0 - if {$e_check in $allchoices} { - #for case when there are case-differenced duplicates - allow exact match to avoid selecting earlier match of another casing - set chosen $e_check - set choice_in_list 1 - set choice_exact_match 1 - } elseif {$v_test in $choices_test} { - set chosen $v_test - set choice_in_list 1 - } else { - #PREFIX check required - any 'chosen' here is not an exact match or it would have matched above. - #assert - if empty string was a provided choice and empty string was a provided arg - we would have matched above. - #in this block we can treat empty result from prefix match as a non-match - if {$nocase} { - #nocase implies that our entered value doesn't have to match case of choices - - #but we would still like to select the best match if there are case-dups. - #e.g arg -choices {delete Delete} -nocase 1 -choiceprefixdenylist delete - # selecting Del will find Delete, del will match delete (and raise error) - # but DEL will also match delete rather than Delete - so again an error is raised. - #This is counterintuitive with -nocase - #This is probably such an edge case that best served with documentation as a feature-not-bug - #Rationale being that in a nocase situation it's arbitrary/counterintuitive to consider DEL, or DeL a better match for Delete than delete? - #The choice of the user to use -choiceprefixdenylist along with case-dups is the issue. - - set bestmatch [tcl::prefix::match -error "" [lsort -unique $allchoices] $e_check] - if {$bestmatch eq ""} { - set chosen [tcl::prefix::match -error "" [lsort -unique $choices_test] $v_test] - set choice_in_list [expr {$chosen ne ""}] - #we + + + #----------------------------------- + #fast fail on the wrong number of choices + if {[llength $c_list] < $choicemultiple_min} { + set msg "Option $argname for [Get_caller] requires at least $choicemultiple_min choices. Received [llength $c_list] choices." + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list choicecount [llength $c_list] minchoices $choicemultiple_min maxchoices $choicemultiple_max] -badarg $argname]] $msg + } + if {$choicemultiple_max != -1 && [llength $c_list] > $choicemultiple_max} { + set msg "Option $argname for [Get_caller] requires at most $choicemultiple_max choices. Received [llength $c_list] choices." + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list choicecount [llength $c_list] minchoices $choicemultiple_min maxchoices $choicemultiple_max] -badarg $argname]] $msg + } + #----------------------------------- + + set choice_idx 0 ;#we need to overwrite raw-choice (which may be prefix) with a value from the choice list + foreach c $c_list c_check $c_check_list { + if {$nocase} { + set casemsg " (case insensitive)" + set choices_test [tcl::string::tolower $allchoices] + #Don't lcase the denylist - even in nocase mode! + #set choiceprefixdenylist [tcl::string::tolower $choiceprefixdenylist] + set v_test [tcl::string::tolower $c_check] + } else { + set casemsg " (case sensitive)" + set v_test $c_check + set choices_test $allchoices + } + set choice_in_list 0 + set matches_default [expr {$has_default && $c eq $defaultval}] ;# defaultval when -choicemultiple could be a list? + if {!$matches_default} { + if {$choiceprefix} { + #can we handle empty string as a choice? It should just work - REVIEW/test + set choice_exact_match 0 + if {$c_check in $allchoices} { + #for case when there are case-differenced duplicates - allow exact match to avoid selecting earlier match of another casing + set chosen $c_check + set choice_in_list 1 + set choice_exact_match 1 + } elseif {$v_test in $choices_test} { + set chosen $v_test + set choice_in_list 1 + } else { + #PREFIX check required - any 'chosen' here is not an exact match or it would have matched above. + #assert - if empty string was a provided choice and empty string was a provided arg - we would have matched above. + #in this block we can treat empty result from prefix match as a non-match + if {$nocase} { + #nocase implies that our entered value doesn't have to match case of choices - + #but we would still like to select the best match if there are case-dups. + #e.g arg -choices {delete Delete} -nocase 1 -choiceprefixdenylist delete + # selecting Del will find Delete, del will match delete (and raise error) + # but DEL will also match delete rather than Delete - so again an error is raised. + #This is counterintuitive with -nocase + #This is probably such an edge case that best served with documentation as a feature-not-bug + #Rationale being that in a nocase situation it's arbitrary/counterintuitive to consider DEL, or DeL a better match for Delete than delete? + #The choice of the user to use -choiceprefixdenylist along with case-dups is the issue. + + set bestmatch [tcl::prefix::match -error "" [lsort -unique $allchoices] $c_check] + if {$bestmatch eq ""} { + set chosen [tcl::prefix::match -error "" [lsort -unique $choices_test] $v_test] + #now pick the earliest match in the actually defined list so that case of chosen always matches a defined entry with casing + set chosen [lsearch -inline -nocase $allchoices $chosen] + set choice_in_list [expr {$chosen ne ""}] + } else { + set chosen $bestmatch + set choice_in_list 1 + } } else { - set chosen $bestmatch - set choice_in_list 1 + set chosen [tcl::prefix::match -error "" [lsort -unique $allchoices] $c_check] + if {$chosen eq ""} { + set choice_in_list 0 + } else { + set choice_in_list 1 + } } - } else { - set chosen [tcl::prefix::match -error "" [lsort -unique $allchoices] $e_check] - if {$chosen eq ""} { + #override choice_in_list if in deny list + #don't allow prefixing for elements from -choiceprefixdenylist + #we still use all elements to calculate the prefixes though + #review - case difference edge cases in choiceprefixdenylist !todo + if {$chosen in $choiceprefixdenylist} { set choice_in_list 0 - } else { - set choice_in_list 1 + set chosen "" } } - #override choice_in_list if in deny list - #don't allow prefixing for elements from -choiceprefixdenylist - #we still use all elements to calculate the prefixes though - #review - case difference edge cases in choiceprefixdenylist !todo - if {$chosen in $choiceprefixdenylist} { - set choice_in_list 0 - set chosen "" - } - } - if {$choice_in_list && !$choice_exact_match} { - if {$is_multiple} { - set existing [tcl::dict::get [set $dname] $argname] - lset existing $idx $chosen - tcl::dict::set $dname $argname $existing - } else { - tcl::dict::set $dname $argname $chosen + if {$choice_in_list && !$choice_exact_match} { + if {$choicemultiple_max != -1 && $choicemultiple_max < 2} { + if {$is_multiple} { + set existing [tcl::dict::get [set $dname] $argname] + lset existing $idx $chosen + tcl::dict::set $dname $argname $existing + } else { + tcl::dict::set $dname $argname $chosen + } + } else { + if {$is_multiple} { + set existing_all [tcl::dict::get [set $dname] $argname] + lset existing_all $idx $choice_idx $chosen + tcl::dict::set $dname $argname $existing_all + } else { + set existing [tcl::dict::get [set $dname] $argname] + lset existing $choice_idx $chosen + tcl::dict::set $dname $argname $existing + } + } } + } else { + #value as stored in $dname is ok + set choice_in_list [expr {$v_test in $choices_test}] } - } else { - #value as stored in $dname is ok - set choice_in_list [expr {$v_test in $choices_test}] } - } - if {!$choice_in_list && !$matches_default} { - if {!$choicerestricted} { - #if {$is_multiple} { - # set existing [tcl::dict::get [set $dname] $argname] - # lset existing $idx $v_test - # tcl::dict::set $dname $argname $existing - #} else { - # tcl::dict::set $dname $argname $v_test - #} - lappend vlist_validate $e - lappend vlist_check_validate $e_check - } else { - #unhappy path - if {$choiceprefix} { - set prefixmsg " (or a unique prefix of a value)" + if {!$choice_in_list && !$matches_default} { + if {!$choicerestricted} { + #if {$is_multiple} { + # set existing [tcl::dict::get [set $dname] $argname] + # lset existing $idx $v_test + # tcl::dict::set $dname $argname $existing + #} else { + # tcl::dict::set $dname $argname $v_test + #} + lappend vlist_validate $c + lappend vlist_check_validate $c_check } else { - set prefixmsg "" + #unhappy path + if {$choiceprefix} { + set prefixmsg " (or a unique prefix of a value)" + } else { + set prefixmsg "" + } + arg_error "Option $argname for [Get_caller] must be one of the listed values:\n [join $allchoices "\n "]\n$casemsg$prefixmsg. Received: '$c'" $argspecs -badarg $argname } - arg_error "Option $argname for [Get_caller] must be one of the listed values:\n [join $allchoices "\n "]\n$casemsg$prefixmsg. Received: '$e'" $argspecs -badarg $argname } + incr choice_idx } + incr idx } #reduce our vlist and vlist_check lists by removing choice matches as they need to be passed through without validation @@ -3588,10 +4108,11 @@ tcl::namespace::eval punk::args { if {[llength $vlist] && $has_default} { set vlist_validate [list] set vlist_check_validate [list] - foreach e $vlist e_check $vlist_check { - if {$e_check ne $defaultval} { - lappend vlist_validate $e - lappend vlist_check_validate $e + foreach c $vlist c_check $vlist_check { + #for -choicemultiple with default that could be a list use 'ni' ?? review + if {$c_check ne $defaultval} { + lappend vlist_validate $c + lappend vlist_check_validate $c } } set vlist $vlist_validate @@ -3854,7 +4375,12 @@ tcl::namespace::eval punk::args { xdigit { foreach e $vlist e_check $vlist_check { if {![tcl::string::is $type $e_check]} { - arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e'" $argspecs -badarg $argname + set msg "Option $argname for [Get_caller] requires type '$type'. Received: '$e'" + #try trap? + #return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type]]] $result + #throw ? + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname]] $msg + arg_error $msg $argspecs -badarg $argname } } } @@ -4012,59 +4538,104 @@ tcl::namespace::eval punk::args::lib { lappend PUNKARGS [list { @id -id ::punk::args::lib::tstr @cmd -name punk::args::lib::tstr -help\ - "A rough equivalent of js template literals" + "A rough equivalent of js template literals + + Substitutions: + \$\{$varName\} + \$\{[myCommand]\} + (when -allowcommands flag is given)" -allowcommands -default 0 -type none -help\ - "if -allowcommands is present, placeholder can contain commands - e.g {\$\{plaintext0 [lindex $var 0] plaintext2\}}" - -return -default list -choices {dict list string args}\ + "If -allowcommands is present, placeholder can contain commands + e.g {\$\{plaintext0 [lindex $var 0] plaintext2\}}" + -undent -default 1 -type boolean -help\ + "undent/dedent the template lines. + The longest common prefix of whitespace is removed" + -indent -default "" -type string -help\ + "String with which to indent the template + prior to substitution. + If -undent is enabled, that is performed + first, then the indent is applied." + -paramindents -default line -choices {none line position} -choicelabels { + line\ + " Use leading whitespace in + the line in which the + placeholder occurs." + position\ + " Use the position in + the line in which the + placeholder occurs." + none\ + " No indents applied to + subsequent placeholder value + lines. This will usually + result in text awkwardly + ragged unless the source code + has also been aligned with the + left margin or the value has + been manually padded." + } -help\ + "How indenting is done for subsequent lines in a + multi-line placeholder substitution value. + The 1st line or a single line value is always + placed at the placeholder. + paramindents are performed after the main + template has been indented/undented. + (indenting by position does not calculate + unicode double-wide or grapheme cluster widths) + " + #choicelabels indented by 1 char is clearer for -return string - and reasonable in table + -return -default string -choices {dict list string args}\ -choicelabels { dict\ - "Return a dict with keys - 'template', 'params' and - 'errors'" - string\ - "Return a single result - being the string with - placeholders substituted." - list\ - "Return a 2 element list. - The first is itself a list - of plaintext portions of the - template, split at each point - at which placeholders were - present. The second element - of the outer list is a list - of placeholder values if -eval - is 1, or a list of the raw - placeholder strings if -eval - is 0." - args\ - "Return a list where the first - element is a list of template - plaintext sections as per the - 'list' return mechanism, but the - placeholder items are individual - items in the returned list. - This can be useful when passing - the expanded result of a tstr - command to another function - which expects the placeholders - as individual arguments" + " Return a dict with keys + 'template', 'params' and + 'errors'" + string\ + " Return a single result + being the string with + placeholders substituted." + list\ + " Return a 2 element list. + The first is itself a list + of plaintext portions of the + template, split at each point + at which placeholders were + present. The second element + of the outer list is a list + of placeholder values if -eval + is 1, or a list of the raw + placeholder strings if -eval + is 0." + args\ + " Return a list where the first + element is a list of template + plaintext sections as per the + 'list' return mechanism, but the + placeholder items are individual + items in the returned list. + This can be useful when passing + the expanded result of a tstr + command to another function + which expects the placeholders + as individual arguments" } -eval -default 1 -type boolean -help\ "Whether to evaluate the \$\{\} placeholders. - When -return is string, -eval should generally be set to 1. - For a string return, -eval 0 will result in the raw contents of \$\{\} being substituted. - contained variables in that case should be braced, or the variable name is likely to collide - with surrounding text. - e.g tstr -return string -eval 0 {plaintext\$\{\$\{var\}\}plaintext} -> plaintext\$\{var\}plaintext" + When -return is string, -eval should generally be set to 1. + For a string return, -eval 0 will result in the raw contents of \$\{\} being substituted. + contained variables in that case should be braced or whitespace separated, or the variable + name is likely to collide with surrounding text. + e.g tstr -return string -eval 0 {plaintext\$\{\$\{var\}\}plaintext} -> plaintext\$\{var\}plaintext" @values -min 0 -max 1 templatestring -help\ "This argument should be a braced string containing placeholders such as \$\{$var\} e.g {The value is \$\{$var\}.} - where $var will be substituted from the calling context - The placeholder itself can contain plaintext portions as well as variables. - It can contain commands in square brackets if -allowcommands is true - e.g tstr -return string -allowcommands {Tcl Version:\$\{[info patch]\} etc}" + where $var will be substituted from the calling context + The placeholder itself can contain plaintext portions as well as variables. + It can contain commands in square brackets if -allowcommands is true + e.g tstr -return string -allowcommands {Tcl Version:\$\{[info patch]\} etc} + + Escape sequences such as \\n and unicode escapes are processed within placeholders. + " }] proc tstr {args} { @@ -4080,8 +4651,11 @@ tcl::namespace::eval punk::args::lib { set arglist [lrange $args 0 end-1] set opts [dict create\ -allowcommands 0\ + -undent 1\ + -indent ""\ + -paramindents line\ -eval 1\ - -return list\ + -return string\ ] if {"-allowcommands" in $arglist} { set arglist [::punk::args::system::punklib_ldiff $arglist -allowcommands] @@ -4089,21 +4663,21 @@ tcl::namespace::eval punk::args::lib { } if {[llength $arglist] % 2 != 0} { if {[info commands ::punk::args::get_by_id] ne ""} { - punk::args::get_by_id ::punk::args::tstr $args + punk::args::get_by_id ::punk::args::lib::tstr $args return } else { error "punk::args::lib::tstr expected option/value pairs prior to last argument" } } dict for {k v} $arglist { - set fullk [tcl::prefix::match -error "" {-allowcommands -return -eval} $k] + set fullk [tcl::prefix::match -error "" {-allowcommands -indent -undent -paramindents -return -eval} $k] switch -- $fullk { - -return - -eval { + -indent - -undent - -paramindents - -return - -eval { dict set opts $fullk $v } default { if {[info commands ::punk::args::get_by_id] ne ""} { - punk::args::get_by_id ::punk::args::tstr $args + punk::args::get_by_id ::punk::args::lib::tstr $args return } else { error "punk::args::lib::tstr unknown option $k. Known options: [dict keys $opts]" @@ -4112,6 +4686,12 @@ tcl::namespace::eval punk::args::lib { } } set opt_allowcommands [dict get $opts -allowcommands] + set opt_paramindents [dict get $opts -paramindents] + set test_paramindents [tcl::prefix::match -error "" {none line position} $opt_paramindents] + if {$test_paramindents ni {none line position}} { + error "punk::args::lib::tstr option -paramindents invalid value '$opt_paramindents'. Must be one of none, line, position or an unambiguous abbreviation thereof." + } + set opt_paramindents $test_paramindents set opt_return [dict get $opts -return] set opt_return [tcl::prefix::match -error "" {args dict list string} $opt_return] if {$opt_return eq ""} { @@ -4124,6 +4704,15 @@ tcl::namespace::eval punk::args::lib { set nocommands "" } + set opt_undent [dict get $opts -undent] + if {$opt_undent} { + set templatestring [punk::args::lib::undent $templatestring] + } + set opt_indent [dict get $opts -indent] + if {$opt_indent ne ""} { + set templatestring [punk::args::lib::indent $templatestring $opt_indent] + } + #set parts [_tstr_split $templatestring] if {[string first \$\{ $templatestring] < 0} { set parts [list $templatestring] @@ -4135,6 +4724,14 @@ tcl::namespace::eval punk::args::lib { set params [list] set idx 0 set errors [dict create] + set lastline "" ;#todo - first line has placeholder? + set pt1 [lindex $parts 0] + set lastline_posn [string last \n $pt1] + if {$lastline_posn >= 0} { + set lastline [string range $pt1 $lastline_posn+1 end] + } else { + set lastline $pt1 + } foreach {pt expression} $parts { lappend textchunks $pt incr idx ;#pt incr @@ -4143,18 +4740,39 @@ tcl::namespace::eval punk::args::lib { if {$idx == [llength $parts]} { break } + set lastline_posn [string last \n $pt] + if {$lastline_posn >= 0} { + set lastline [string range $pt $lastline_posn+1 end] + } #lappend expressions $expression + #---------------------- + #REVIEW - JMN + #TODO - debug punk::args loading of @dynamic defs + #puts "-- $expression" + #---------------------- + #brk1 - literal newline not {\n} + set leader "" + if {[set brk1 [string first \n $expression]] >= 0} { + #undent left of paramstart only for lines of expression that arent on opening ${..} line + set tail [string range $expression $brk1+1 end] + set leader [string repeat " " [string length $lastline]] + set undentedtail [punk::args::lib::undentleader $tail $leader] + #set undentedtail [punk::lib::undent [string range $expression $brk1+1 end]] + set expression "[string range $expression 0 $brk1]$undentedtail" + } if {$opt_eval} { if {[catch [list uplevel 1 [list ::subst {*}$nocommands $expression]] result]} { lappend params [string cat \$\{ $expression \}] dict set errors [expr {[llength $params]-1}] $result } else { + set result [string map [list \n "\n$leader"] $result] lappend params $result } #lappend params [uplevel 1 [list ::subst {*}$nocommands $expression]] } else { - lappend params $expression + lappend params [subst -nocommands -novariables $expression] } + append lastline [lindex $params end] ;#for current expression's position calc incr idx ;#expression incr } @@ -4167,7 +4785,9 @@ tcl::namespace::eval punk::args::lib { dict for {i e} $errors { append einfo "parameter $i error: $e" \n } - puts stderr "tstr errors:\n$einfo\n]" + #REVIEW!!! + #TODO - fix + #puts stderr "tstr errors:\n$einfo\n" } switch -- $opt_return { @@ -4179,9 +4799,46 @@ tcl::namespace::eval punk::args::lib { return [list $textchunks {*}$params] } string { + #todo - flag to disable indent-matching behaviour for multiline param? set out "" + set pt1 [lindex $parts 0] + set lastline_posn [string last \n $pt1] + if {$lastline_posn >= 0} { + set lastline [string range $pt1 $lastline_posn+1 end] + } else { + set lastline $pt1 + } foreach pt $textchunks param $params { - append out $pt $param + if {$opt_paramindents eq "none"} { + append out $pt $param + } else { + set lastline_posn [string last \n $pt] + if {$lastline_posn >= 0} { + set lastline [string range $pt $lastline_posn+1 end] + } + if {$opt_paramindents eq "line"} { + regexp {(\s*).*} $lastline _all lastindent + } else { + #position + #TODO - detect if there are grapheme clusters + #This regsub doesn't properly space unicode double-wide chars or clusters + set lastindent "[regsub -all {\S} $lastline " "] " + } + if {$lastindent ne ""} { + set paramlines [split $param \n] + if {[llength $paramlines] == 1} { + append out $pt $param + } else { + append out $pt [lindex $paramlines 0] + foreach nextline [lrange $paramlines 1 end] { + append out \n $lastindent $nextline + } + } + } else { + append out $pt $param + } + append lastline $param + } } return $out } @@ -4239,7 +4896,7 @@ tcl::namespace::eval punk::args::lib { } } else { if {$in_placeholder == 2} { - #skip opening bracket + #skip opening bracket dollar sign set in_placeholder 1 } else { append echars $ch @@ -4294,11 +4951,248 @@ tcl::namespace::eval punk::args::lib { return [lappend list [tcl::string::range $text $start end]] } + #like textutil::adjust::indent - but doesn't strip trailing lines, and doesn't implement skip parameter. + proc indent {text {prefix " "}} { + set result [list] + foreach line [split $text \n] { + if {[string trim $line] eq ""} { + lappend result "" + } else { + lappend result $prefix[string trimright $line] + } + } + return [join $result \n] + } + #dedent? + proc undent {text} { + if {$text eq ""} { + return "" + } + set lines [split $text \n] + set nonblank [list] + foreach ln $lines { + if {[string trim $ln] eq ""} { + continue + } + lappend nonblank $ln + } + set lcp [longestCommonPrefix $nonblank] + if {$lcp eq ""} { + return $text + } + regexp {^([\t ]*)} $lcp _m lcp + if {$lcp eq ""} { + return $text + } + set len [string length $lcp] + set result [list] + foreach ln $lines { + if {[string trim $ln] eq ""} { + lappend result "" + } else { + lappend result [string range $ln $len end] + } + } + return [join $result \n] + } + + #hacky + proc undentleader {text leader} { + #leader usually whitespace - but doesn't have to be + if {$text eq ""} { + return "" + } + set lines [split $text \n] + set nonblank [list] + foreach ln $lines { + if {[string trim $ln] eq ""} { + continue + } + lappend nonblank $ln + } + lappend nonblank "${leader}!!" + set lcp [longestCommonPrefix $nonblank] + if {$lcp eq ""} { + return $text + } + #regexp {^([\t ]*)} $lcp _m lcp + #lcp can be shorter than leader + set lcp [string range $lcp 0 [string length $leader]-1] + + if {$lcp eq ""} { + return $text + } + set len [string length $lcp] + set result [list] + foreach ln $lines { + if {[string trim $ln] eq ""} { + lappend result "" + } else { + lappend result [string range $ln $len end] + } + } + return [join $result \n] + } + #A version of textutil::string::longestCommonPrefixList + proc longestCommonPrefix {items} { + if {[llength $items] <= 1} { + return [lindex $items 0] + } + set items [lsort $items[unset items]] + set min [lindex $items 0] + set max [lindex $items end] + #if first and last of sorted list share a prefix - then all do (first and last of sorted list are the most different in the list) + #(sort order nothing to do with length - e.g min may be longer than max) + if {[string length $min] > [string length $max]} { + set temp $min + set min $max + set max $temp + } + set n [string length $min] + set prefix "" + set i -1 + while {[incr i] < $n && ([set c [string index $min $i]] eq [string index $max $i])} { + append prefix $c + } + return $prefix + } + #*** !doctools #[list_end] [comment {--- end definitions namespace punk::args::lib ---}] } + +tcl::namespace::eval punk::args::argdocbase { + namespace export * + #use a? to test and create literal ansi here rather than relying on punk::ansi package presence + #e.g + #% a? bold + #- bold │SGR 1│sample│â›[1msample + #- ──────┼─────┼──────┼────────── + #- RESULT│ │sample│â›[1msample + proc B {} {return \x1b\[1m} ;#a+ bold + proc N {} {return \x1b\[22m} ;#a+ normal + proc I {} {return \x1b\[3m} ;#a+ italic + proc NI {} {return \x1b\[23m} ;#a+ noitalic + +} # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +tcl::namespace::eval punk::args::package { + variable PUNKARGS + lappend PUNKARGS [list { + @dynamic + @id -id "::punk::args::package::standard_about" + @cmd -name "%pkg%::about" -help\ + "About %pkg% + ... + " + -package_about_namespace -type string -optional 0 -help\ + "Namespace containing the package about procedures + Must contain " + -return\ + -type string\ + -default table\ + -choices {string table tableobject}\ + -choicelabels { + string\ + "A basic text layout" + table\ + "layout in table borders + (requires package: textblock)" + tableobject\ + "textblock::class::table object instance" + }\ + -help\ + "Choose the return type of the 'about' information" + topic -optional 1\ + -nocase 1\ + -default {*}\ + -choices {Description License Version Contact *}\ + -choicerestricted 0\ + -choicelabels { + + }\ + -multiple 1\ + -help\ + "Topic to display. Omit or specify as * to see all. + If * is included with explicit topics, * represents + the remaining unmentioned topics." + }] + proc standard_about {args} { + set argd [punk::args::parse $args withid ::punk::args::package::standard_about] + lassign [dict values $argd] leaders OPTS values received + + set pkgns [dict get $OPTS -package_about_namespace] + if {[info commands ${pkgns}::package_name] eq ""} { + error "punk::args::package::standard_about unable to find function ${pkgns}::package_name" + } + set pkgname [${pkgns}::package_name] + + set opt_return [dict get $OPTS -return] + set all_topics [${pkgns}::about_topics] + if {![dict exists $received topic]} { + set topics $all_topics + } else { + # * represents all remaining topics not explicitly mentioned. + set val_topics [dict get $values topic] ;#if -multiple is true, this is a list + set explicit_topics [lsearch -all -inline -exact -not $val_topics "*"] + set topics [list] + foreach t $val_topics { + if {$t eq "*"} { + foreach a $all_topics { + if {$a ni $explicit_topics} { + lappend topics $a + } + } + } else { + lappend topics $t + } + } + } + if {$opt_return ne "string"} { + package require textblock ;#table support + set is_table 1 + set title [string cat {[} $pkgname {]} ] + set t [textblock::class::table new -title $title] + $t configure -frametype double -minwidth [expr {[string length $title]+2}] + + } else { + set topiclens [lmap t $topics {string length $t}] + set widest_topic [tcl::mathfunc::max {*}$topiclens] + set is_table 0 + set about "$pkgname\n" + append about [string repeat - $widest_topic] \n + } + foreach topic $topics { + if {[llength [info commands ::${pkgns}::get_topic_$topic]] == 1} { + set topic_contents [::${pkgns}::get_topic_$topic] + } else { + set topic_contents "" + } + if {!$is_table} { + set content_lines [split $topic_contents \n] + append about [format %-${widest_topic}s $topic] " " [lindex $content_lines 0] \n + foreach ln [lrange $content_lines 1 end] { + append about [format %-${widest_topic}s ""] " " $ln \n + } + } else { + $t add_row [list $topic $topic_contents] + } + } + + if {!$is_table} { + return $about + } else { + if {$opt_return eq "tableobject"} { + return $t + } + set result [$t print] + $t destroy + return $result + } + } + +} #usually we would directly call arg definitions near the defining proc, # so that the proc could directly use the definition in its parsing. @@ -4314,7 +5208,7 @@ tcl::namespace::eval punk::args::lib { # set PUNKARGS "" #} -lappend ::punk::args::register::NAMESPACES ::punk::args::argdoc ::punk::args ::punk::args::lib +lappend ::punk::args::register::NAMESPACES ::punk::args::argdoc ::punk::args ::punk::args::lib ::punk::args::package # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools @@ -4326,8 +5220,6 @@ tcl::namespace::eval punk::args::system { #dict get value with default wrapper for tcl 8.6 if {[info commands ::tcl::dict::getdef] eq ""} { - #package require punk::lib - #interp alias "" ::punk::args::Dict_getdef "" ::punk::lib::dict_getdef proc Dict_getdef {dictValue args} { set keys [lrange $args 0 end-1] if {[tcl::dict::exists $dictValue {*}$keys]} { @@ -4354,6 +5246,8 @@ tcl::namespace::eval punk::args::system { } } + + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::args [tcl::namespace::eval punk::args { diff --git a/src/modules/punk/args/tclcore-999999.0a1.0.tm b/src/modules/punk/args/tclcore-999999.0a1.0.tm index 723be151..64a86473 100644 --- a/src/modules/punk/args/tclcore-999999.0a1.0.tm +++ b/src/modules/punk/args/tclcore-999999.0a1.0.tm @@ -141,9 +141,11 @@ tcl::namespace::eval punk::args::tclcore { variable PUNKARGS + package require punk::ansi + tcl::namespace::import ::punk::ansi::a+ # -- --- --- --- --- #non colour SGR codes - # we can use these directly via ${$I} etc without marking a definition with -dynamic + # we can use these directly via ${$I} etc without marking a definition with @dynamic #This is because they don't need to change when colour switched on and off. set I [a+ italic] set NI [a+ noitalic] @@ -151,6 +153,132 @@ tcl::namespace::eval punk::args::tclcore { set N [a+ normal] # -- --- --- --- --- + + namespace eval argdoc { + variable PUNKARGS + + lappend PUNKARGS [list { + @id -id ::punk::args::tclcore::argdoc::ensemble_subcommands_definition + @cmd -name ::punk::args::tclcore::argdoc::ensemble_subcommands_definition -help\ + "Helper function to return a punk::args definition snippet for subcommands" + @leaders -max 0 -min 0 + -groupdict -default {} -type dict -help\ + "Dictionary keyed on arbitrary groupname, where value + is a list of known subcommands that should be displayed + by groupname. Each groupname forms the title of a subtable + in the choices list. + Subcommands not assigned to a groupname will appear first + in an untitled subtable." + -columns -default 4 -type integer -help\ + "Max number of columns for all subtables in the choices + display area" + @values -min 1 -max 1 + ensemble -optional 0 -help\ + "Name of ensemble command" + + }] + proc ensemble_subcommands_definition {args} { + #args manually parsed - with use of argdef for unhappy-path only + if {![llength $args]} { + punk::args::get_by_id ::punk::args::tclcore::argdoc::ensemble_subcommands_definition $args + return + } + set ensemble [lindex $args end] + set optlist [lrange $args 0 end-1] + if {[llength $optlist] % 2} { + punk::args::get_by_id ::punk::args::tclcore::argdoc::ensemble_subcommands_definition $args + return + } + set defaults [dict create\ + -groupdict {}\ + -columns 4\ + ] + set optlist [dict merge $defaults $optlist] + dict for {k v} $optlist { + switch -- $k { + -groupdict - -columns {} + default { + punk::args::get_by_id ::punk::args::tclcore::argdoc::ensemble_subcommands_definition $args + return + } + } + } + set opt_groupdict [dict get $optlist -groupdict] + set opt_columns [dict get $optlist -columns] + + package require punk::ns + set subdict [punk::ns::ensemble_subcommands -return dict $ensemble] + set allsubs [dict keys $subdict] + # ---------------------------------------------- + # manually defined group members may have subcommands that are obsoleted/missing + # we choose to make the situation obvious by re-classifying into a corresponding group with the " - MISSING" suffix + set checked_groupdict [dict create] + dict for {g members} $opt_groupdict { + set validmembers {} + set invalidmembers {} + foreach m $members { + if {$m in $allsubs} { + lappend validmembers $m + } else { + lappend invalidmembers $m + } + } + dict set checked_groupdict $g $validmembers + if {[llength $invalidmembers]} { + dict set checked_groupdict "${g}_MISSING" $invalidmembers + } + } + if {[dict exists $checked_groupdict ""]} { + set others [dict get $checked_groupdict ""] + dict unset checked_groupdict "" + } else { + set others [list] + } + + #REVIEW + set debug 0 + if {$debug} { + puts "punk::args::tclcore::argdoc::ensemble_subcommands_definition" + if {[catch { + ::punk::lib::pdict checked_groupdict + } msg]} { + puts stderr "punk::args::tclcore::ensemble_subcommands_definition Cannot call pdict\n$msg" + } + puts -------------------- + puts "$checked_groupdict" + puts -------------------- + } + + set opt_groupdict $checked_groupdict + # ---------------------------------------------- + set allgrouped [list] + dict for {g members} $opt_groupdict { + lappend allgrouped {*}$members + } + foreach sc $allsubs { + if {$sc ni $allgrouped} { + if {$sc ni $others} { + lappend others $sc + } + } + } + + set argdef "" + append argdef "subcommand -choicegroups \{" \n + append argdef " \"\" \{$others\}" \n + dict for {g members} $opt_groupdict { + append argdef " \"$g\" \{$members\}" \n + } + append argdef " \} -choicecolumns $opt_columns" \n + + #todo -choicelabels + #detect subcommand further info available e.g if oo or ensemble or punk::args id exists.. + #consider a different mechanism to add a label on rhs of same line as choice (for (i) marker) + + return $argdef + } + } + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- # library commands loaded via auto_index # -- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -171,44 +299,7 @@ tcl::namespace::eval punk::args::tclcore { } "@doc -name Manpage: -url [manpage_tcl library]" ] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- - #todo - make generic - take command and known_groups_dict - proc info_subcommands {} { - package require punk::ns - set subdict [punk::ns::ensemble_subcommands -return dict info] - set allsubs [dict keys $subdict] - dict set groups "system" {hostname library nameofexecutable patchlevel script sharedlibextension tclversion} - dict set groups "{proc introspection}" {args body default} - dict set groups "variables" {constant consts exists globals locals vars} - dict set groups "{oo object introspection}" {class object} - - set allgrouped [list] - dict for {g members} $groups { - lappend allgrouped {*}$members - } - set others [list] - foreach sc $allsubs { - if {$sc ni $allgrouped} { - lappend others $sc - } - } - - set argdef "" - append argdef "subcommand -choicegroups \{" \n - append argdef " \"\" \{$others\}" \n - dict for {g members} $groups { - append argdef " $g \{$members\}" \n - } - append argdef " \}" \n - - #todo -choicelabels - #detect subcommand further info available e.g if oo or ensemble or punk::args id exists.. - #consider a different mechanism to add a label on rhs of same line as choice (for (i) marker) - - return $argdef - } - - - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { #test of @form @id -id ::AFTER @cmd -name "Builtin: after" -help\ @@ -223,7 +314,8 @@ tcl::namespace::eval punk::args::tclcore { @form -form {schedule_ms} -synopsis "after ms ?script...?" #@values -form {*} #note "classify next argument as a value not a leader" - ms -form {*} -type int + ms -form {*} -type int -help\ + "milliseconds" @values -form {delay} -min 1 -max 1 @values -form {schedule_ms} -min 2 script -form {schedule_ms} -multiple 1 -optional 1 ref-help common_script_help @@ -252,12 +344,28 @@ tcl::namespace::eval punk::args::tclcore { } "@doc -name Manpage: -url [manpage_tcl after]" ] - lappend PUNKARGS [list -dynamic 1 { + namespace eval argdoc { + #todo - make generic - take command and known_groups_dict + proc info_subcommands {} { + #package require punk::ns + #set subdict [punk::ns::ensemble_subcommands -return dict info] + #set allsubs [dict keys $subdict] + dict set groups "system" {hostname library nameofexecutable patchlevel script sharedlibextension tclversion} + dict set groups "proc introspection" {args body default} + dict set groups "variables" {constant consts exists globals locals vars} + dict set groups "oo object introspection" {class object} + + return [ensemble_subcommands_definition -groupdict $groups -columns 4 info] + } + } + lappend PUNKARGS [list { + @dynamic @id -id ::info @cmd -name "Builtin: info" -help\ "Information about the state of the Tcl interpreter" - @values - ${[punk::args::tclcore::info_subcommands]} + @leaders -min 1 -max 1 + ${[punk::args::tclcore::argdoc::info_subcommands]} + @values -min 0 } "@doc -name Manpage: -url [manpage_tcl array]" ] @@ -279,10 +387,10 @@ tcl::namespace::eval punk::args::tclcore { @cmd -name "binary encode base64" -maxlen -type integer -help\ "Indicates that the output should be split into lines of no more than length - characters. By default, lines are not split." + characters. By default, lines are not split." -wrapchar -type character -default \n -help\ "Indicates that, when lines are split because of the -maxlen option, character - should be used to separate lines. By default, this is a newline character, \"\\n\"." + should be used to separate lines. By default, this is a newline character, \"\\n\"." @values -min 1 -max 1 data -type string } ] @@ -291,8 +399,8 @@ tcl::namespace::eval punk::args::tclcore { @cmd -name "binary decode base64" -strict -type none -help\ "Instructs the decoder to throw an error if it encounters any characters that - are not strictly part of the encoding itself. Otherwise it ignores them. - RFC 2045 calls for base64 decoders to be non-strict." + are not strictly part of the encoding itself. Otherwise it ignores them. + RFC 2045 calls for base64 decoders to be non-strict." @values -min 1 -max 1 data -type string } ] @@ -318,7 +426,7 @@ tcl::namespace::eval punk::args::tclcore { @cmd -name "binary encode hex" -strict -type none -help\ "Instructs the decoder to throw an error if it encounters whitespace - characters. Otherwise it ignores them." + characters. Otherwise it ignores them." @values -min 1 -max 1 data -type string } "@doc -name Manpage: -url [manpage_tcl binary]" ] @@ -340,16 +448,16 @@ tcl::namespace::eval punk::args::tclcore { @cmd -name "binary encode uuencode" -maxlen -type integer -default 61 -range {5 85} -help\ "Indicates the maximum number of characters to produce for each encoded line. - The valid range is 5 to 85. Line lengths outside that range cannot be - accommodated by the encoding format." + The valid range is 5 to 85. Line lengths outside that range cannot be + accommodated by the encoding format." -wrapchar -type string -default \n -help\ "Indicates the character(s) to use to mark the end of each encoded line. - Acceptable values are a sequence of zero or more character from the set - { \\x09 (TAB), \\x0B (VT), \\x0C (FF), \\x0D (CR) } followed by zero or - one newline \\x0A (LF). Any other values are rejected because they would - generate encoded text that could not be decoded. The default value is a - single newline. - " + Acceptable values are a sequence of zero or more character from the set + { \\x09 (TAB), \\x0B (VT), \\x0C (FF), \\x0D (CR) } followed by zero or + one newline \\x0A (LF). Any other values are rejected because they would + generate encoded text that could not be decoded. The default value is a + single newline. + " @values -min 1 -max 1 data -type string } ] @@ -359,9 +467,9 @@ tcl::namespace::eval punk::args::tclcore { @cmd -name "binary decode uuencode" -strict -type none -help\ "Instructs the decoder to throw an error if it encounters anything outside - of the standard encoding format. Without this option, the decoder tolerates - some deviations, mostly to forgive reflows of lines between the encoder and - decoder." + of the standard encoding format. Without this option, the decoder tolerates + some deviations, mostly to forgive reflows of lines between the encoder and + decoder." @values -min 1 -max 1 data -type string } ] @@ -389,7 +497,7 @@ tcl::namespace::eval punk::args::tclcore { @cmd -name "Builtin: tcl::chan::tell" -help\ "Returns a number giving the current access position within the underlying data stream for the channel named channel. This value returned is a byte - offset that can be passed to ${[a+ bold]}chan seek${[a normal]} in order + offset that can be passed to ${[a+ bold]}chan seek${[a+ normal]} in order to set the channel to a particular position. Note that this value is in terms of bytes, not characters like ${[a+ bold]}chan read${[a+ normal]}. The value returned is -1 for channels that do not support seeking." @@ -398,7 +506,25 @@ tcl::namespace::eval punk::args::tclcore { "" } "@doc -name Manpage: -url [manpage_tcl chan]" ] + lappend PUNKARGS [list { + @id -id ::tcl::chan::truncate + @cmd -name "Builtin: tcl::chan::truncate" -help\ + "Sets the byte length of the underlying data stream for the channel to be + length (or to the current byte offset within the underlying data stream if + length is omitted). The channel is flushed before truncation." + #todo - auto synopsis? + @form -synopsis\ + "chan truncate channel ?length?" + @values + channel -help \ + "" + length -optional 1 -type integer + } "@doc -name Manpage: -url [manpage_tcl chan]" ] + + + #TODO - autocreate argdef namespace and import B N etc + # ${[B]import[N]} lappend PUNKARGS [list { @id -id ::tcl::info::cmdtype @cmd -name "Builtin: tcl::info::cmdtype" -help\ @@ -498,13 +624,13 @@ tcl::namespace::eval punk::args::tclcore { name } "@doc -name Manpage: -url [manpage_tcl namespace]" ] + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- lappend PUNKARGS [list { @id -id ::tcl::process::status @cmd -name "Builtin: tcl::process::status" -help\ "Returns a dictionary mapping subprocess PIDs to their respective status. - if ${$I}pids${$NI} is specified as a list of PIDs then the command - only returns the status of the matching subprocesses if they exist, and - raises an error otherwise. + If ${$I}pids${$NI} is specified as a list of PIDs then the command + only returns the status of the matching subprocesses if they exist. For active processes, the status is an empty value. For terminated processes, the status is a list with the following format: {code ?msg errorCode?} @@ -525,17 +651,31 @@ tcl::namespace::eval punk::args::tclcore { " -wait -type none -optional 1 -help\ "By default the command returns immediately (the underlying Tcl_WaitPid - is called with the WNOHANG flag set) unless this switch is set. if pids - is specified as a list of PIDS then the command waits until the status - of the matching subprocesses are avaliable. If pids was not specified, - this command will wait for all known subprocesses." + is called with the WNOHANG flag set) unless this switch is set. if pids + is specified as a list of PIDS then the command waits until the status + of the matching subprocesses are avaliable. If pids was not specified, + this command will wait for all known subprocesses." -- -type none -optional 1 -help\ "Marks the end of switches. The argument following this one will be - treated as the first arg even if it starts with a -." + treated as the first arg even if it starts with a -." + @values -min 0 -max 1 + pids -type list -optional 1 -help\ + "A list of PIDs" + } "@doc -name Manpage: -url [manpage_tcl namespace]" ] + + lappend PUNKARGS [list { + @id -id ::tcl::process::purge + @cmd -name "Builtin: tcl::process::purge" -help\ + "Cleans up all data associated with terminated subprocesses. If pids is + specified as a list of PIDs then the command only cleans up data for + the matching subprocesses if they exist. If a process listed is still + active, this command does nothing to that process. + Any PID that does not correspond to a subprocess is ignored." @values -min 0 -max 1 pids -type list -optional 1 -help\ "A list of PIDs" } "@doc -name Manpage: -url [manpage_tcl namespace]" ] + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ############################################################################################################################################################ # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -549,30 +689,19 @@ tcl::namespace::eval punk::args::tclcore { #categorise array subcommands based on currently known groupings. #we do this dynamically because Tcl ensembles (even some core ones) can have subcommands added at runtime. proc array_subcommands {} { - package require punk::ns - set subdict [punk::ns::ensemble_subcommands array] - set expected_searchcmds {startsearch anymore nextelement donesearch} - set searchcmds [list] - foreach sc $expected_searchcmds { - if {$sc in [dict keys $subdict]} { - lappend searchcmds $sc - } - } - set argdef "" - append argdef "subcommand -choicegroups \{" \n - append argdef " \"\" \{" \n - append argdef " [dict keys [dict remove $subdict {*}$searchcmds]]" \n - append argdef " \}" \n - append argdef " \"search\" \{" \n - append argdef " $searchcmds" \n - append argdef " \}" \n - append argdef " \} -choicecolumns 4 " \n - - return $argdef + #puts "--array_subcommands frames:" + #for {set i 0} {$i <= [info frame]} {incr i} { + # puts "$i [info frame $i]" + #} + + #dict set groups "" {bogus names} ;#test adding both existant and nonexistant to the default group + dict set groups "search" {startsearch anymore nextelement donesearch} + return [ensemble_subcommands_definition -groupdict $groups -columns 4 array] } } - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + @dynamic @id -id ::array @cmd -name "Builtin: array" -help\ "Manipulate array variables" @@ -584,7 +713,7 @@ tcl::namespace::eval punk::args::tclcore { # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { @id -id ::const @cmd -name "Builtin: const" -help\ "Create and initialise a constant. @@ -671,6 +800,28 @@ tcl::namespace::eval punk::args::tclcore { } "@doc -name Manpage: -url [manpage_tcl ledit]" # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + punk::args::define { + @id -id ::lremove + @cmd -name "builtin: lremove" -help\ + "Remove elements from a list by index + lremove returns a new list formed by simultaneously removing zero or + more elements of list at each of the indices given by an arbitrary + number of index arguments. The indices may be in any order and may be + repeated; the element at index will only be removed once. The index + values are interpreted the same as index values for the command + 'string index', supporting simple index arithmetic and indices relative + to the end of the list. 0 refers to the first element of the list, and + end refers to the last element of the list." + @values -min 1 -max -1 + list -type list -help\ + "tcl list as a value" + index -type indexexpression -multiple 1 -optional 1 + + @seealso -commands {list lappend lassign ledit lindex linsert llength lmap lpop lrange lrepeat lreplace lreverse lsearch lseq lset lsort} + } "@doc -name Manpage: -url [manpage_tcl lremove]" + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @id -id ::lpop @@ -681,15 +832,15 @@ tcl::namespace::eval punk::args::tclcore { varName -type string -help\ "Existing list variable name" index -type indexexpression -default end -optional 1 -multiple 1 -help\ - "When presented with a single index, the lpop command addresses - the index'th element in it, removes it from the list and returns - the element. - If index is negative or greater or equal than the number of - elements in the list in the variable called varName, an error occurs. - If addition index arguments are supplied, then each argument is used - in turn to address an element within a sublist designated by the - previous indexing operation, allowing the script to remove elements - in sublists, similar to lindex and lset." + "When presented with a single index, the lpop command addresses + the index'th element in it, removes it from the list and returns + the element. + If index is negative or greater or equal than the number of + elements in the list in the variable called varName, an error occurs. + If addition index arguments are supplied, then each argument is used + in turn to address an element within a sublist designated by the + previous indexing operation, allowing the script to remove elements + in sublists, similar to lindex and lset." } "@doc -name Manpage: -url [manpage_tcl lpop]" # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @@ -700,8 +851,7 @@ tcl::namespace::eval punk::args::tclcore { The index values first and last are interpreted the same as index values for the command 'string index', supporting simple index arithmetic and indices relative to the end of the list. - e.g lrange {a b c} 0 end-1 - " + e.g lrange {a b c} 0 end-1" @values -min 3 -max 3 list -type list -help\ "tcl list as a value" @@ -749,18 +899,17 @@ tcl::namespace::eval punk::args::tclcore { " @values -min 1 -max 2 varName -type string -help\ - "name of scalar or array variable + "name of scalar or array variable scalar variable e.g myvar array element e.g myarray(identifier.x) namespaced scalar variable e.g ::ns1::myvar namespaced array element e.g ::ns1::myarray(subelement) - Nested datastructures may be simulated with an array by using - some programmer chosen convention to seperate levels. - e.g set myarray(config,0) \"val1\" - set myarray(config,1) \"etc\" - set myarray(data,0) {a b c} - see the dict command for an alternative datastructure. - " + Nested datastructures may be simulated with an array by using + some programmer chosen convention to seperate levels. + e.g set myarray(config,0) \"val1\" + set myarray(config,1) \"etc\" + set myarray(data,0) {a b c} + see the dict command for an alternative datastructure." value -type any -optional 1 } "@doc -name Manpage: -url [manpage_tcl set]" # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -790,16 +939,16 @@ tcl::namespace::eval punk::args::tclcore { @id -id ::tcl::string::compare @cmd -name "builtin: tcl::string::compare" -help\ - "Perform a character-by-character comparison of strings string1 and string2. + "Perform a character-by-character comparison of strings string1 and string2. Returns -1, 0, or 1, dpending on whether string1 is lexicographically lessthan, equal to, or greater than string2" -nocase -type none -help\ - "If -nocase is specified, then the strings are compared in a case insensitive manner." + "If -nocase is specified, then the strings are compared in a case insensitive manner." -length -type integer -help\ - "If -length is specified, then only the first length characters are used in the comparison. - If -length is negative, it is ignored." + "If -length is specified, then only the first length characters are used in the comparison. + If -length is negative, it is ignored." @values -min 2 -max 2 string1 -type string @@ -810,15 +959,15 @@ tcl::namespace::eval punk::args::tclcore { @id -id ::tcl::string::equal @cmd -name "builtin: tcl::string::equal" -help\ - "Perform a character-by-character comparison of strings string1 and string2. + "Perform a character-by-character comparison of strings string1 and string2. Returns 1 if string1 and string2 are identical, or 0 when not." -nocase -type none -help\ - "If -nocase is specified, then the strings are compared in a case insensitive manner." + "If -nocase is specified, then the strings are compared in a case insensitive manner." -length -type integer -help\ - "If -length is specified, then only the first length characters are used in the comparison. - If -length is negative, it is ignored." + "If -length is specified, then only the first length characters are used in the comparison. + If -length is negative, it is ignored." @values -min 2 -max 2 string1 -type string @@ -892,14 +1041,14 @@ tcl::namespace::eval punk::args::tclcore { @id -id ::tcl::string::replace @cmd -name "builtin: tcl::string::replace" -help\ "Removes a range of consecutive characters from string, starting with the character whose - index is first and ending with the character whose index is last - (Using the forms described in STRING_INDICES). An index of 0 refers to the first - character of the string. First and last may be specified as for the index method. - If first is less than zero then it is treated as if it were zero, and if last is - greater than or equal to the length of the string then it is treated as if it were - end. The initial string is returned untouched, if first is greater than last, or if - first is equal to or greater than the length of the inital string, or last is less - than 0." + index is first and ending with the character whose index is last + (Using the forms described in STRING_INDICES). An index of 0 refers to the first + character of the string. First and last may be specified as for the index method. + If first is less than zero then it is treated as if it were zero, and if last is + greater than or equal to the length of the string then it is treated as if it were + end. The initial string is returned untouched, if first is greater than last, or if + first is equal to or greater than the length of the inital string, or last is less + than 0." @values -min 3 -max 3 string -type string first -type indexexpression @@ -912,7 +1061,7 @@ tcl::namespace::eval punk::args::tclcore { @id -id ::tcl::string::totitle @cmd -name "builtin: tcl::string::totitle" -help\ "Returns a value equal to string except that the first character in string is converted to - it's Unicode title case variant (or upper case if there is no title case variant) and the + its Unicode title case variant (or upper case if there is no title case variant) and the rest of the string is converted to lower case." @values -min 1 -max 1 @@ -934,9 +1083,9 @@ tcl::namespace::eval punk::args::tclcore { string -type string charIndex -type indexexpression -help\ "integer or simple expresssion. - e.g end - e.g end-1 - e.g M+N" + e.g end + e.g end-1 + e.g M+N" } "@doc -name Manpage: -url [manpage_tcl string]" punk::args::define { @@ -951,12 +1100,12 @@ tcl::namespace::eval punk::args::tclcore { string -type string charIndex -type indexexpression -help\ "integer or simple expresssion. - e.g end - e.g end-1 - e.g M+N" + e.g end + e.g end-1 + e.g M+N" } "@doc -name Manpage: -url [manpage_tcl string]" - punk::args::define [punk::lib::tstr -return string { + punk::args::define [punk::args::lib::tstr -return string { @id -id ::tcl::string::is @cmd -name "builtin: tcl::string::is" -help\ "Returns 1 if string is a valid member of the specified character class, otherwise returns 0. @@ -989,132 +1138,344 @@ tcl::namespace::eval punk::args::tclcore { }\ -choicelabels { alnum\ - " Any Unicode alphabet - or digit character" + " Any Unicode alphabet + or digit character" alpha\ - " Any Unicode alphabet - character" + " Any Unicode alphabet + character" ascii\ - " Any character with - a value less than \\u0080 - (those that are in the - 7-bit ascii range)" + " Any character with + a value less than \\u0080 + (those that are in the + 7-bit ascii range)" boolean\ - " Any of the forms allowed - to Tcl_GetBoolean" + " Any of the forms allowed + to Tcl_GetBoolean" control\ - " Any Unicode control char" + " Any Unicode control char" dict\ - " Any proper dict structure, - with optional surrounding - whitespace. In case of - improper dict structure, 0 - is returned and the varname - will contain the index of - the \"element\" where the - dict parsing fails or -1 if - this cannot be determined." + " Any proper dict structure, + with optional surrounding + whitespace. In case of + improper dict structure, 0 + is returned and the varname + will contain the index of + the \"element\" where the + dict parsing fails or -1 if + this cannot be determined." digit\ - " Any Unicode digit char. - Note that this includes - chars outside of the \[0-9\] - range." + " Any Unicode digit char. + Note that this includes + chars outside of the \[0-9\] + range." double\ - " Any of the forms allowed - to Tcl_GetDoubleFromObj. - ${$A_WARN}With optional surrounding${$A_RST} - ${$A_WARN}whitespace.${$A_RST}" + " Any of the forms allowed + to Tcl_GetDoubleFromObj. + ${$A_WARN}With optional surrounding${$A_RST} + ${$A_WARN}whitespace.${$A_RST}" entier\ - " Synonym for integer" + " Synonym for integer" false\ - " Any of the forms allowed - to Tcl_GetBoolean where the - value is false" + " Any of the forms allowed + to Tcl_GetBoolean where the + value is false" graph\ - " Any Unicode printing char - except space." + " Any Unicode printing char + except space." integer\ - " Any of the valid string - formats for an integer value - of arbitrary size in Tcl, - ${$A_WARN}with optional surrounding${$A_RST} - ${$A_WARN}whitespace${$A_RST}. The formats - accepted are exactly those - accepted by the C routine - Tcl_GetBignumFromObj." + " Any of the valid string + formats for an integer value + of arbitrary size in Tcl, + ${$A_WARN}with optional surrounding${$A_RST} + ${$A_WARN}whitespace${$A_RST}. The formats + accepted are exactly those + accepted by the C routine + Tcl_GetBignumFromObj." list\ - " Any proper list structure, - with optional surrounding - whitespace. In case of - improper list structure, 0 - is returned and the varname - will contain the index of - the \"element\" where list - parsing fails, or -1 if - this cannot be determined" + " Any proper list structure, + with optional surrounding + whitespace. In case of + improper list structure, 0 + is returned and the varname + will contain the index of + the \"element\" where list + parsing fails, or -1 if + this cannot be determined" lower\ - " Any Unicode lower case - alphabet character" + " Any Unicode lower case + alphabet character" print\ - " Any Unicode printing - character, including space" + " Any Unicode printing + character, including space" punct\ - " Any Unicode punctuation - character." + " Any Unicode punctuation + character." space\ - " Any Unicode whitespace - character, mongolian vowel - separator (U+180e), - zero width space (U+200b), - word joiner (U+2060) or - zero width no-break space - (U+feff) (=BOM)" + " Any Unicode whitespace + character, mongolian vowel + separator (U+180e), + zero width space (U+200b), + word joiner (U+2060) or + zero width no-break space + (U+feff) (=BOM)" true\ - " Any of the forms allowed - to Tcl_GetBoolean where the - value is true" + " Any of the forms allowed + to Tcl_GetBoolean where the + value is true" upper\ - " Any upper case alphabet - character in the Unicode - character set" + " Any upper case alphabet + character in the Unicode + character set" wideinteger\ - " Any of the valid forms - for a wide integer in Tcl, - ${$A_WARN}with optional surrounding${$A_RST} - ${$A_WARN}whitespace${$A_RST}. In case of - overflow in the value, 0 is - returned and the varname - will contain -1." + " Any of the valid forms + for a wide integer in Tcl, + ${$A_WARN}with optional surrounding${$A_RST} + ${$A_WARN}whitespace${$A_RST}. In case of + overflow in the value, 0 is + returned and the varname + will contain -1." wordchar\ - " Any Unicode word char. - That is any alphanumeric - character, and any - Unicode connector - punctuation characters - (e.g. underscore)" + " Any Unicode word char. + That is any alphanumeric + character, and any + Unicode connector + punctuation characters + (e.g. underscore)" xdigit\ - " Any hexadecimal digit - character, and any Unicode - connector punctuation - characters (e.g. underscore)" - + " Any hexadecimal digit + character ([0-9A-Fa-f])." }\ -help\ - "character class - In the case of boolean, true and false, if the function will return 0, then the - varname will always be set to 0, due to the varied nature of a valid boolean value" + "character class + In the case of boolean, true and false, if the function will return 0, then the + varname will always be set to 0, due to the varied nature of a valid boolean value" -strict -type none -help\ "If -strict is specified, then an empty string returns 0, - otherwise an empty string will return 1 on any class" + otherwise an empty string will return 1 on any class" -failindex -type variablename -help\ "If -failindex is specified, then if the function returns 0, - the index in the string where the class was no longer valid will be stored - in the variable named." + the index in the string where the class was no longer valid will be stored + in the variable named." @values -min 1 -max 1 string -type string -optional 0 }] "@doc -name Manpage: -url [manpage_tcl string]" + + #a test of going deeper - we should be able to define these by reference to above text + #e.g dict get [lrange [punk::args::resolved_def -types leaders ::tcl::string::is class] 1 end] -choicelabels xdigit + #set string_class_choices [dict get [lrange [punk::args::resolved_def -types leaders ::tcl::string::is class] 1 end] -choices] + set string_class_choicelabels [dict get [lrange [punk::args::resolved_def -types leaders ::tcl::string::is class] 1 end] -choicelabels] + dict for {sclass slabel} $string_class_choicelabels { + punk::args::define [string map [list %sc% $sclass %slabel% $slabel] { + @id -id "::tcl::string::is %sc%" + @cmd -name "builtin: string is %sc%" -help\ + {%slabel%} + ${[punk::args::resolved_def -types opts ::tcl::string::is -*]} + @values -min 1 -max 1 + string -type string -optional 0 + }] "@doc -name Manpage: -url [manpage_tcl string]" + } + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + + punk::args::define { + @id -id ::trace + @cmd -name "builtin: trace" -help\ + "Monitor variable accesses, command usages and command executions + " + @form -synopsis "trace option ?arg arg...?" + option -choicegroups { + "" {add remove info} + obsolete {variable vdelete vinfo} + }\ + -choiceinfo { + add {subhelp "::trace add"} + } + + } "@doc -name Manpage: -url [manpage_tcl trace]" + + punk::args::define { + @id -id "::trace add" + @cmd -name "builtin: trace add" -help\ + "" + @form -synopsis "trace add type name ops ?args?" + @leaders + type -choicegroups { + "" {command execution variable} + }\ + -choiceinfo { + command {subhelp "::trace add command"} + } + + } "@doc -name Manpage: -url [manpage_tcl trace]" + + punk::args::define { + @id -id "::trace add command" + @cmd -name "builtin: trace add command" -help\ + "Arrange for commandPrefix to be executed (with additional arguments) + whenever command name is modified in one of the ways given by the list + ops. Name will be resolved using the usual namespace resolution rules + used by commands. If the command does not exist, an error will be thrown." + name -type string -help\ + "Name of command" + ops -type list -choices {rename delete} -choiceprefix 0 -choicemultiple {1 2}\ + -choicelabels { + rename\ + " Invoke commandPrefix whenever the traced command + is renamed. Note that renaming to the empty string + is considered deletion, and will not be traced with + 'rename'" + delete\ + " Invoke commandPrefix when the traced command is deleted. + Commands can be deleted explicitly using the rename command to + rename the command to an empty string. Commands are also deleted + when the interpreter is deleted, but traces will not be invoked + because there is no interpreter in which to execute them." + }\ + -help\ + "Indicates which operations are of interest." + commandPrefix -type string -help\ + "When the trace triggers, depending on the operations being traced, a + number of arguments are appended to commandPrefix so that the actual + command is as follows: + -------------------------------- + commandPrefix oldName newName op + -------------------------------- + OldName and newName give the traced command's current (old) name, + and the name to which it is being renamed (the empty string if this + is a \"delete\" operation). Op indicates what operation is being + performed on the command, and is one of rename or delete as defined + above. The trace operation cannot be used to stop a command from being + deleted. Tcl will always remove the command once the trace is complete. + Recursive renaming or deleting will not cause further traces of the + same type to be evaluated, so a delete trace which itself deletes a + command, or a rename trace which itself renames the command will not + cause further trace evaluations to occur. Both oldName and newName are + fully qualified with any namespace(s) in which they appear. + " + } "@doc -name Manpage: -url [manpage_tcl trace]" + + + punk::args::define { + @id -id "::trace add execution" + @cmd -name "builtin: trace add execution" -help\ + "Arrange for commandPrefix to be executed (with additional arguments) + whenever command name is executed, with traces occurring at the points + indicated by the list ops. Name will be resolved using the usual namespace + resolution ruls used by commands. If the command does not exist, and error + will be thrown" + name -type string -help\ + "Name of command" + # --------------------------------------------------------------- + ops -type list -choices {enter leave enterstep leavestep} -choiceprefix 0\ + -choicemultiple {1 4}\ + -choicecolumns 2\ + -choicelabels { + enter\ + " Invoke commandPrefix whenever the command name is executed, + just before the actual execution takes place." + leave\ + " Invoke commandPrefix whenever the command name is executed, + just after the actual execution takes place." + enterstep\ + " Invoke commandPrefix for every Tcl command which is executed + from the start of the execution of the procedure name until + that procedure finishes. CommandPrefix is invoked just before + the actual execution of the Tcl command being reported takes + place. For example if we have + \"proc foo {} { puts \"hello\" }\", then an enterstep trace + would be invoked just before \"puts \"hello\"\" is executed. + Setting an enterstep trace on a command name that does not + refer to a procedure will not result in an error and is + simply ignored." + leavestep\ + " Invoke commandPrefix for every Tcl command which is executed + from the start of the execution of the procedure name until + that procedure finishes. CommandPrefix is invoked just after + the actual execution of the Tcl command being reported takes + place. Setting a leavestep trace on a command name that does + not refer to a procedure will not result in an error and is + simply ignored." + }\ + -help\ + "Indicates which operations are of interest." + commandPrefix -type string -help\ + "When the trace triggers, depending on the operation being traced, a + number of arguments are appended to commandPrefix so that the actual + command is as follows: + For enter and enterstep operations: + ------------------------------- + commandPrefix command-string op + ------------------------------- + Command-string give the complete current command being executed + (the traced command for a enter operation, an arbitrary command + for an enterstep operation), including all arguments in their + fully expanded form. Op indicates what operation is being performed + on the command execution, and is on of enter or enterstep as + defined above. The trace operation can be used to stop the command + from executing, by deleting the command in question. Of course when + the command is subsequently executed, an \"invalid command\" error + will occur. + For leave and leavestep operations: + ------------------------------------------- + commandPrefix command-string code result op + ------------------------------------------- + Command-string gives the complete current command being executed + (the traced command for a leave operation, an arbitrary command + for a leavestep operation), including all arguments in their + fully expanded form. Code give the result code of that execution, + and result the result string. Op indicates what operation is being + performed on the command execution and is one of leave or leavestep + as defined above. + + Note that the creation of many enterstep or leavestep traces can + lead to unintuitive results, since the invoked commands from one + trace can themselves lead to further command invocations for other + traces. + + CommandPrefix executes in the same context as the code that invoked + the traced operation: thus the commandPrefix, if invoked from a + procedure, will have access to the same local variables as code in the + procedure. This context may be different thatn the context in which + the trace was created. If commandPrefix invokes a procedure (which + it normally does) then the procedure will have to use upvar or uplevel + commands if it wishes to access the local variables of the code which + invoked the trace operation. + + While commandPrefix is executing during an execution trace, traces on + name are temporarily disabled. This allows the commandPrefix to execute + name in its body without invoking any other traces again. If an error + occurs while executing the commandPrefix, then the command name as a + whole will return that same error. + + When multiple traces are set on name, then for enter and enterstep + operations, the traced commands are invoked in the reverse order of how + the traces were originally created; and for leave and leavestep operations, + the traced commands are invoked in the original order of creation. + + The behaviour of execution traces is currently undefined for a command name + imported into another namespace. + " + } "@doc -name Manpage: -url [manpage_tcl trace]" + + punk::args::define { + @id -id "::trace remove command" + @cmd -name "builtin: trace remove command" -help\ + "If there is a trace set on command name with the operations and command + given by opList and commandPrefix, then the trace is removed, so that + commandPrefix will never again be invoked. Returns an empty string. If + name does not exist, the command will throw an error" + @values + name -type string -help\ + "Name of command" + opList -type list -help\ + "A list of one or more of the following items: + rename + delete" + commandPrefix + } "@doc -name Manpage: -url [manpage_tcl trace]" + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @id -id ::variable @@ -1147,11 +1508,16 @@ tcl::namespace::eval punk::args::tclcore { # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + namespace eval argdoc { + if {[catch {zlib::pkgconfig get zlibVersion} ZLIBVERSION]} { + set ZLIBVERSION "(unknown)" + } + } punk::args::define { @id -id ::zlib @cmd -name "builtin: ::zlib" -help\ - "zlib - compression and decompression operations - " + "zlib - compression and decompression operations + zlib version: ${$::punk::args::tclcore::argdoc::ZLIBVERSION}" @leaders -min 1 -max 1 subcommand -type string\ -choicecolumns 2\ @@ -1261,12 +1627,10 @@ tcl::namespace::eval punk::args::tclcore::lib { #} # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -if {![info exists ::punk::args::register::NAMESPACES]} { - namespace eval ::punk::args::register { - set ::punk::args::register::NAMESPACES [list] ;#use fully qualified so 8.6 doesn't find existing var in global namespace - } +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::args::tclcore ::punk::args::tclcore::argdoc } -lappend ::punk::args::register::NAMESPACES ::punk::args::tclcore ## Ready package provide punk::args::tclcore [tcl::namespace::eval punk::args::tclcore { diff --git a/src/modules/punk/basictelnet-999999.0a1.0.tm b/src/modules/punk/basictelnet-999999.0a1.0.tm index 229e89e1..ee2b834e 100644 --- a/src/modules/punk/basictelnet-999999.0a1.0.tm +++ b/src/modules/punk/basictelnet-999999.0a1.0.tm @@ -46,12 +46,11 @@ #[list_begin itemized] package require Tcl 8.6- +package require punk::args #*** !doctools #[item] [package {Tcl 8.6}] +#[item] [package {punk::args}] -# #package require frobz -# #*** !doctools -# #[item] [package {frobz}] #*** !doctools #[list_end] @@ -457,16 +456,72 @@ namespace eval punk::basictelnet { } } - proc telnet {{server localhost} {port telnet}} { + punk::args::define { + @id -id ::punk::basictelnet::telnet + @cmd -name punk::basictelnet::telnet -help\ + "Connect to a telnet server or other TCP based service. + The terminal can then be used to interact with the service. + " + -mode -choices {line raw} -default line + -mouse -type boolean -default 0 -help\ + "Whether to enable mouse events" + @values -min 1 -max 2 + server -type string -help\ + "Hostname or IP address" + port -type integer -range {1 65535} -default 23 -help\ + "TCP port" + } + proc telnet {args} { + set argd [punk::args::get_by_id ::punk::basictelnet::telnet $args] + set server [dict get $argd values server] + set port [dict get $argd values port] + set tmode [dict get $argd opts -mode] + set mouse [dict get $argd opts -mouse] + + #todo - check for vt52 and don't try DEC queries + if {[info commands ::mode] eq ""} { + puts stderr "::mode command for terminal is unavailable - please set line/raw mode manually on the terminal" + } else { + set priormode [mode] + if {$tmode ne $priormode} { + ::mode $tmode + } + } + if {[catch {set priormouse [punk::console::get_mode mouse_sgr]}]} { + set priormouse -1 + if {$mouse} { + puts stderr "Cannot determine mouse_sgr mode - assuming terminal doesn't support mouse" + } + } + + #decmode 1006 (SET_SGR_EXT_MODE_MOUSE) + #decmode 1016 (SET_PIXEL_POSITION_MOUSE) + #mouse_sgr 1 - mouse on + #mouse_sgr 2 - mouse off + if {$mouse} { + if {$priormouse eq "2"} { + punk::console::enable_mouse + } + } else { + if {$priormouse eq "1"} { + punk::console::disable_mouse + } + } + variable debug - variable consolewidth ;#note - this is not terminal width for the telnet output - which needs to be about 80cols narrower if debug is to be displayed on same screen - set consolewidth [dict get [punk::console::get_size] columns] + variable consolewidth 80 ;#note - this is not terminal width for the telnet output - which needs to be about 80cols narrower if debug is to be displayed on same screen + catch {set consolewidth [dict get [punk::console::get_size] columns]} + if {$consolewidth eq ""} { + #vt52? + set consolewidth 80 + } + if {$debug && $consolewidth-$::punk::basictelnet::window_cols < 80} { - puts stderr "Terminal width not wide enough for debug_window width: 80 + telnet window_cols:$::punk::basictelnet::window_cols" + puts stderr "Terminal width '$consolewidth' not wide enough for debug_window width: 80 + telnet window_cols:$::punk::basictelnet::window_cols" puts stderr "Turn off debug, or make terminal window wider" return } elseif {$consolewidth < $::punk::basictelnet::window_cols} { - puts stderr "Terminal width is less than telnet window_cols:$::punk::basictelnet::window_cols" + puts stderr "Terminal width '$consolewidth' is less than telnet window_cols:$::punk::basictelnet::window_cols" puts stderr "Ensure terminal is greater than or equal to punk::basictelnet::window_cols" return } @@ -485,6 +540,16 @@ namespace eval punk::basictelnet { vwait ::punk::basictelnet::closed($sock) unset closed($sock) chan conf stdin -blocking 1 + if {[info commands ::mode] ne ""} { + ::mode $priormode + } + + if {$priormouse eq "2"} { + #mouse was off + punk::console::disable_mouse + } elseif {$priormouse eq "1"} { + punk::console::enable_mouse + } } diff --git a/src/modules/punk/blockletter-999999.0a1.0.tm b/src/modules/punk/blockletter-999999.0a1.0.tm index f159b327..f097deba 100644 --- a/src/modules/punk/blockletter-999999.0a1.0.tm +++ b/src/modules/punk/blockletter-999999.0a1.0.tm @@ -281,9 +281,9 @@ tcl::namespace::eval punk::blockletter::lib { #use tstr when resolving params as a one-off at definition time - #versus slower -dynamic 1 if defaults/choices etc need to reflect the current state of the system. + #versus slower @dynamic if defaults/choices etc need to reflect the current state of the system. punk::args::define [tstr -return string { - @id -id ::punk::blockletter::block + @id -id ::punk::blockletter::lib::block -height -default 2 -width -default 4 -frametype -default {${$::punk::blockletter::default_frametype}} @@ -293,7 +293,7 @@ tcl::namespace::eval punk::blockletter::lib { }] proc block {args} { upvar ::punk::blockletter::default_frametype ft - set argd [punk::args::get_by_id ::punk::blockletter::block $args] + set argd [punk::args::get_by_id ::punk::blockletter::lib::block $args] set bg [dict get $argd opts -bgcolour] set bd [dict get $argd opts -bordercolour] set h [dict get $argd opts -height] diff --git a/src/modules/punk/char-999999.0a1.0.tm b/src/modules/punk/char-999999.0a1.0.tm index 18061c84..94f382c9 100644 --- a/src/modules/punk/char-999999.0a1.0.tm +++ b/src/modules/punk/char-999999.0a1.0.tm @@ -2015,7 +2015,7 @@ tcl::namespace::eval punk::char { # ------------------------------------------------------------------------------------------------------ proc grapheme_split_tk {string} { if {![regexp "\[\uFF-\U10FFFF\]" $string]} { - #only ascii - no joiners or unicode + #only ascii (7 or 8 bit) - no joiners or unicode return [split $string {}] } package require tk @@ -2068,14 +2068,14 @@ tcl::namespace::eval punk::char { return $width } proc wcswidth_single {char} { - scan $c %c dec - if {$c <= 255 && !($c < 31 || $c == 127)} { + scan $char %c dec + if {$dec <= 255 && !($dec < 31 || $dec == 127)} { #review - non-printing ascii? why does textutil::wcswidth report 1 ?? #todo - compare with python or other lang wcwidth return 1 - } elseif {$c < 917504 || $c > 917631} { + } elseif {$dec < 917504 || $dec > 917631} { #TODO - various other joiners and non-printing chars - return [textutil::wcswidth_char $c] + return [textutil::wcswidth_char $dec] ;#note textutil::wcswidth_char takes a decimal codepoint! #may return -1 - REVIEW } return 0 @@ -2084,13 +2084,13 @@ tcl::namespace::eval punk::char { set width 0 foreach c [split $string {}] { scan $c %c dec - if {$c <= 255 && !($c < 31 || $c == 127)} { + if {$dec <= 255 && !($dec < 31 || $dec == 127)} { #review - non-printing ascii? why does textutil::wcswidth report 1 ?? #todo - compare with python or other lang wcwidth incr width - } elseif {$c < 917504 || $c > 917631} { + } elseif {$dec < 917504 || $dec > 917631} { #TODO - various other joiners and non-printing chars - set w [textutil::wcswidth_char $c] + set w [textutil::wcswidth_char $dec] ;#takes decimal codepoint if {$w < 0} { return -1 } else { @@ -2117,14 +2117,14 @@ tcl::namespace::eval punk::char { set chunk [tcl::string::range $string $startidx $endidx] set codes [scan $chunk [tcl::string::repeat %c [tcl::string::length $chunk]]] - foreach c $codes { - if {$c <= 255 && !($c < 31 || $c == 127)} { + foreach dec $codes { + if {$dec <= 255 && !($dec < 31 || $dec == 127)} { #review - non-printing ascii? why does textutil::wcswidth report 1 ?? #todo - compare with python or other lang wcwidth incr width - } elseif {$c < 917504 || $c > 917631} { + } elseif {$dec < 917504 || $dec > 917631} { #TODO - various other joiners and non-printing chars - set w [textutil::wcswidth_char $c] + set w [textutil::wcswidth_char $dec] if {$w < 0} { return -1 } else { @@ -2145,18 +2145,18 @@ tcl::namespace::eval punk::char { #TODO set codes [scan $string [tcl::string::repeat %c [tcl::string::length $string]]] set width 0 - foreach c $codes { + foreach dec $codes { #unicode Tags block zero width - if {$c < 917504 || $c > 917631} { - if {$c <= 255} { + if {$dec < 917504 || $dec > 917631} { + if {$dec <= 255} { #review - non-printing ascii? why does textutil::wcswidth report 1 ?? #todo - compare with python or other lang wcwidth - if {!($c < 31 || $c == 127)} { + if {!($dec < 31 || $dec == 127)} { incr width } } else { #TODO - various other joiners and non-printing chars - set w [textutil::wcswidth_char $c] + set w [textutil::wcswidth_char $dec] ;#takes decimal codepoint if {$w < 0} { return -1 } else { @@ -2169,7 +2169,7 @@ tcl::namespace::eval punk::char { } proc wcswidth2 {string} { set codes [scan $string [tcl::string::repeat %c [tcl::string::length $string]]] - set widths [lmap c $codes {textutil::wcswidth_char $c}] + set widths [lmap dec $codes {textutil::wcswidth_char $dec}] if {-1 in $widths} { return -1 } diff --git a/src/modules/punk/console-999999.0a1.0.tm b/src/modules/punk/console-999999.0a1.0.tm index 76305d9f..745d2ea4 100644 --- a/src/modules/punk/console-999999.0a1.0.tm +++ b/src/modules/punk/console-999999.0a1.0.tm @@ -102,7 +102,8 @@ namespace eval punk::console { } variable ansi_response_chunk ;#array keyed on callid variable ansi_response_wait ;#array keyed on callid - variable ansi_response_queue ;#list of callids + array set ansi_response_wait {} + variable ansi_response_queue [list];#list of callids variable ansi_response_queuedata ;#dict keyed on callid - with function params # -- @@ -123,10 +124,6 @@ namespace eval punk::console { #ansi escape sequences are possibly preferable esp if terminal is remote to process running punk::console # punk::local commands may be more performant in some circumstances where console is directly attached, but it shouldn't be assumed. e.g ansi::titleset outperforms local::titleset on windows with twapi. - namespace eval ansi { - #ansi escape sequence based terminal/console control functions - namespace export * - } namespace eval local { #non-ansi terminal/console control functions #e.g external utils system API's. @@ -578,12 +575,73 @@ namespace eval punk::console { } - #capturingendregex should capture ANY prefix, whole escape match - and a subcapture of the data we're interested in and match at end of string. - #ie {(.*)(ESC(info)end)$} - #e.g {(.*)(\x1bP44!~([:alnum:])\x1b\\)$} - #we expect 4 results from regexp -indices -inline (overallmatch, prefix, wholeescape,info) + lappend PUNKARGS [list { + @id -id ::punk::console::internal::get_ansi_response_payload + @cmd -name punk::console::internal::get_ansi_response_payload -help\ + "Terminal query helper. + Captures the significant portion (payload as defined by + supplied capturingendregex capture groups) of the input + channel's response to a query placed on the output channel. + Usually this means a write to stdout with a response on + stdin. + This function uses a 'chan event' read handler function + ::punk::console::internal::ansi_response_handler_regex to + read the input channel character by character to ensure it + doesn't overconsume input. + + It can run cooperatively with the punk::repl stdin reader + or other readers if done carefully. + The mechanism to run while other readers are active involves + disabling and re-enabling installed 'chan event' handlers + and possibly using a shared namespace variable + (::punk::console::input_chunks_waiting) to ensure all data + gets to the right handler. (unread data on input prior to this + function being called) + Not fully documented. (source diving required -see punk::repl) + " + @opts + -ignoreok -type boolean -default 0 -help\ + "Experimental/debug + ignore the regex match 'ok' response + and keep going." + -return -type string -default payload -choices {payload dict} -choicelabels { + dict\ + "dict with keys prefix,response,payload,all" + } -help\ + "Return format" + + -terminal -default {stdin stdout} -type list -help\ + "terminal (currently list of in/out channels) (todo - object?)" + -expected_ms -default 100 -type integer -help\ + "Expected number of ms for response from terminal. + 100ms is usually plenty for a local terminal and a + basic query such as cursor position." + @values -min 2 -max 2 + query -type string -help\ + "ANSI sequence such as \x1b\[?6n which + should elicit a response by the terminal + on stdin" + capturingendregex -type string -help\ + "capturingendregex should capture ANY prefix, whole escape match - and a subcapture + of the data we're interested in; and match at end of string. + ie {(.*)(ESC(info)end)$} + e.g {(.*)(\x1bP44!~([:alnum:])\x1b\\)$} + we expect 4 results from regexp -indices -inline (overallmatch, prefix, wholeescape,info)" + }] #todo - check capturingendregex value supplied has appropriate captures and tail-anchor - proc get_ansi_response_payload {query capturingendregex {inoutchannels {stdin stdout}}} { + proc get_ansi_response_payload {args} { + #we pay a few 10s of microseconds to use punk::args::parse (on the happy path) + #seems reasonable for the flexibility in this case. + set argd [punk::args::parse $args withid ::punk::console::internal::get_ansi_response_payload] + lassign [dict values $argd] leaders opts values received + + set inoutchannels [dict get $opts -terminal] + set expected [dict get $opts -expected_ms] + set ignoreok [dict get $opts -ignoreok] + set returntype [dict get $opts -return] + set query [dict get $values query] + set capturingendregex [dict get $values capturingendregex] + lassign $inoutchannels input output #chunks from input that need to be handled by readers @@ -595,10 +653,12 @@ namespace eval punk::console { #In other contexts there may not even be another input reader #REVIEW - what if there is existing data in input_chunks_waiting - is it for us? - #temp - let's keep alert to it until we decide if it's legit/required.. - if {[info exists input_chunks_waiting($input)] && [llength $input_chunks_waiting($input)]} { - #puts stderr "[punk::ansi::a+ cyan bold]get_ansi_response_payload called while input_chunks_waiting($input) contained data: $input_chunks_waiting($input)[punk::ansi::a]" - } + #This occurs for example with key held down on autorepeat and is normal + #enable it here for debug/testing only + #if {[info exists input_chunks_waiting($input)] && [llength $input_chunks_waiting($input)]} { + # puts stderr "[punk::ansi::a+ cyan bold]get_ansi_response_payload called while input_chunks_waiting($input) contained data: [punk::ansi::a][ansistring VIEW $input_chunks_waiting($input)]" + #} + if {!$::punk::console::ansi_available} { return "" } @@ -615,17 +675,33 @@ namespace eval punk::console { upvar ::punk::console::ansi_response_wait waitvar upvar ::punk::console::ansi_response_queue queue upvar ::punk::console::ansi_response_queuedata queuedata - upvar ::punk::console::ansi_response_clock clock + upvar ::punk::console::ansi_response_tslaunch tslaunch + upvar ::punk::console::ansi_response_tsclock tsclock upvar ::punk::console::ansi_response_timeoutid timeoutid - set accumulator($callid) "" - set waitvar($callid) "" - lappend queue $callid + set accumulator($callid) "" + set waitvar($callid) "" + + lappend queue $callid + if {[llength $queue] > 1} { + #while {[lindex $queue 0] ne $callid} {} + set queuedata($callid) $args + set runningid [lindex $queue 0] + while {$runningid ne $callid} { + vwait ::punk::console::ansi_response_wait + set runningid [lindex $queue 0] + if {$runningid ne $callid} { + set ::punk::console::ansi_response_wait($runningid) $::punk::console::ansi_response_wait($runningid) + update ;#REVIEW - probably a bad idea + after 10 + } + } + } #todo - use a linked array and an accumulatorid and waitvar id? When can there be more than one terminal query in-flight? - set existing_handler [fileevent $input readable] ;#review! + set existing_handler [chan event $input readable] ;#review! set this_handler ::punk::console::internal::ansi_response_handler_regex if {[lindex $existing_handler 0] eq $this_handler} { puts stderr "[punk::ansi::a+ red]Warning for callid $callid get_ansi_response_payload called while existing ansi response handler in place[a]: $this_handler" @@ -633,109 +709,145 @@ namespace eval punk::console { flush stderr if {[lindex $queue 0] ne $callid} { + error "get_ansi_response_payload - re-entrancy unrecoverable" } - error "get_ansi_response_payload - re-entrancy unrecoverable" } + chan event $input readable {} - fileevent $input readable {} - - set input_state [fconfigure $input] - #todo - make timeout configurable? - set waitvarname "::punk::console::ansi_response_wait($callid)" - #500ms is generally plenty for a terminal to respond.. but not in some cases. e.g event loop busy with stdin keypress?? review - set timeoutid($callid) [after 1000 [list set $waitvarname timedout]] - - #JMN # - stderr vs stdout #It has to be same channel as used by functions such as test_char_width or erroneous results returned for those functions #(presumably race conditions as to when data hits console?) #review - experiment changing this and calling functions to stderr and see if it works #review - Are there disadvantages to using stdout vs stderr? - #puts stdout "sending console request [ansistring VIEW $query]" - puts -nonewline $output $query;flush $output + + set previous_input_state [chan configure $input] + #chan configure $input -blocking 0 + + #todo - make timeout configurable? + set waitvarname "::punk::console::ansi_response_wait($callid)" + #todo - test and save rawstate so we don't disableRaw if console was already raw if {![tsv::get console is_raw]} { set was_raw 0 punk::console::enableRaw + #after 0 [list chan event $input readable [list $this_handler $input $callid $capturingendregex]] + incr expected 50 ;#review + set timeoutid($callid) [after $expected [list set $waitvarname timedout]] + #puts stdout "sending console request [ansistring VIEW $query]" } else { set was_raw 1 + set timeoutid($callid) [after $expected [list set $waitvarname timedout]] } - fconfigure $input -blocking 0 - # - #in handler - its used for a boolean match (capturing aspect not used) - set clock($callid) [clock millis] ;#time of launch - may be delay before first event depending on what's going on + chan configure $input -blocking 0 - #first shot without using filevent, call the stdin reader directly - maybe it's there already - #This can be significantly faster than setting up a fileevent (2024 e.g 1.5ms vs 65ms) + set tslaunch($callid) [clock millis] ;#time of launch - may be delay before first event depending on what's going on + set tsclock($callid) $tslaunch($callid) + #write before console enableRaw vs after?? + #There seem to be problems (e.g on WSL) if we write too early - the output ends up on screen but we don't read it + puts -nonewline $output $query;flush $output $this_handler $input $callid $capturingendregex - if {$waitvar($callid) ne "ok"} { - fileevent $input readable [list $this_handler $input $callid $capturingendregex] + + if {$ignoreok || $waitvar($callid) ne "ok"} { + chan event $input readable [list $this_handler $input $callid $capturingendregex] } - #JMN #response from terminal #e.g for cursor position \033\[46;1R - - if {[set waitvar($callid)] eq ""} { - vwait ::punk::console::ansi_response_wait($callid) + #after 0 [list $this_handler $input $callid $capturingendregex] + set remaining $expected + if {$waitvar($callid) eq ""} { + set lastvwait [clock millis] + vwait ::punk::console::ansi_response_wait($callid) #puts stderr ">>>> end vwait1 $waitvar($callid)<<<<" - while {[string match extend-* $waitvar($callid)]} { - set extension [lindex [split $waitvar($callid) -] 1] - #puts stderr "get_ansi_response_payload Extending timeout by $extension" - #after cancel $timeoutid($callid) - set timeoutid($callid) [after $extension [list set $waitvarname timedout]] - vwait ::punk::console::ansi_response_wait($callid) + while {[string match extend-* $waitvar($callid)] || ($ignoreok && $waitvar($callid) eq "ok")} { + if {[string match extend-* $waitvar($callid)]} { + set extension [lindex [split $waitvar($callid) -] 1] + if {$extension eq ""} { + puts "blank extension $waitvar($callid)" + puts "->[set $waitvar($callid]<-" + } + puts stderr "get_ansi_response_payload Extending timeout by $extension" + after cancel $timeoutid($callid) + set total_elapsed [expr {[clock millis] - $tslaunch($callid)}] + set last_elapsed [expr {[clock millis] - $lastvwait}] + set remaining [expr {$remaining - $last_elapsed}] + if {$remaining < 0} {set remaining 0} + set newtime [expr {$remaining + $extension}] + set timeoutid($callid) [after $newtime [list set $waitvarname timedout]] + set lastvwait [clock millis] + vwait ::punk::console::ansi_response_wait($callid) + } else { + #ignoreok - reapply the handler that disabled itself due to 'ok' + chan event $input readable [list $this_handler $input $callid $capturingendregex] + set lastvwait [clock millis] + vwait ::punk::console::ansi_response_wait($callid) + } } } - #response handler automatically removes it's own fileevent - fileevent $input readable {} ;#explicit remove anyway - review + #response handler automatically removes it's own chan event + chan event $input readable {} ;#explicit remove anyway - review if {$waitvar($callid) ne "timedout"} { after cancel $timeoutid($callid) } else { - puts stderr "timeout in get_ansi_response_payload. callid $callid Ansi request was:[ansistring VIEW -lf 1 -vt 1 $query]" + puts stderr "timeout (timediff [expr {[clock millis] - $tslaunch($callid)}]ms) in get_ansi_response_payload. callid $callid Ansi request was:[ansistring VIEW -lf 1 -vt 1 $query]" } if {$was_raw == 0} { punk::console::disableRaw } + #restore $input state - fconfigure $input -blocking [dict get $input_state -blocking] + #it *might* be ok to restore entire state on an input channel + #(it's not always on all channels - e.g stdout has -winsize which is read-only) + #Safest to only restore what we think we've modified. + fconfigure $input -blocking [dict get $previous_input_state -blocking] - set response [set accumulator($callid)] + set input_read [set accumulator($callid)] - if {$response ne ""} { - set got_match [regexp -indices $capturingendregex $response _match_indices prefix_indices response_indices payload_indices] + if {$input_read ne ""} { + set got_match [regexp -indices $capturingendregex $input_read _match_indices prefix_indices response_indices payload_indices] if {$got_match} { - set responsedata [string range $response {*}$response_indices] - set payload [string range $response {*}$payload_indices] - set prefixdata [string range $response {*}$prefix_indices] - if {$prefixdata ne ""} { - #puts stderr "Warning - get_ansi_response_payload read extra data at start - '[ansistring VIEW -lf 1 $prefixdata]' (response=[ansistring VIEW -lf 1 $responsedata])" + set responsedata [string range $input_read {*}$response_indices] + set payload [string range $input_read {*}$payload_indices] + set prefixdata [string range $input_read {*}$prefix_indices] + if {!$ignoreok && $prefixdata ne ""} { + #puts stderr "Warning - get_ansi_response_payload read extra data at start - '[ansistring VIEW -lf 1 $prefixdata]' (responsedata=[ansistring VIEW -lf 1 $responsedata])" lappend input_chunks_waiting($input) $prefixdata } } else { #timedout - or eof? - puts stderr "get_ansi_response_payload callid:$callid regex match '$capturingendregex' to data '[ansistring VIEW -lf 1 -vt 1 $response]' not found" - lappend input_chunks_waiting($input) $response - set payload "" + if {!$ignoreok} { + puts stderr "get_ansi_response_payload callid:$callid regex match '$capturingendregex' to input_read '[ansistring VIEW -lf 1 -vt 1 $input_read]' not found" + lappend input_chunks_waiting($input) $input_read + set payload "" + } else { + set responsedata "" + set payload "" + set prefixdata "" + } } } else { #timedout or eof? and nothing read - set payload "" + set responsedata "" + set prefixdata "" + set payload "" } + # ------------------------------------------------------------------------------------- + # Other input readers + # ------------------------------------------------------------------------------------- #is there a way to know if existing_handler is input_chunks_waiting aware? if {[string length $existing_handler] && [lindex $existing_handler 0] ne $this_handler} { #puts "get_ansi_response_payload reinstalling ------>$existing_handler<------" - fileevent $input readable $existing_handler - #we may have consumed all pending input on $input - so there may be no trigger for the readable fileevent + chan event $input readable $existing_handler + #this_handler may have consumed all pending input on $input - so there may be no trigger for the readable chan event for existing_handler if {[llength $input_chunks_waiting($input)]} { #This is experimental If a handler is aware of input_chunks_waiting - there should be no need to schedule a trigger #If it isn't, but the handler can accept an existing chunk of data as a 'waiting' argument - we could trigger and pass it the waiting chunks - but there's no way to know its API. @@ -772,33 +884,49 @@ namespace eval punk::console { #The input_chunks_waiting may really belong to the existing_handler we found - but if it doesn't consume them they will end up being read by the repl_handler when it eventually re-enables. #todo - some better structure than just a list of waiting chunks indexed by input channel, so repl/other handlers can determine the context in which these waiting chunks were generated? } elseif {[package provide punk::repl::codethread] ne "" && [punk::repl::codethread::is_running]} { - if {[llength $input_chunks_waiting($input)]} { + #if {[llength $input_chunks_waiting($input)]} { #don't trigger the repl handler manually - we will inevitably get things out of order - as it knows when to enable/disable itself based on whether chunks are waiting. #triggering it by putting it on the eventloop will potentially result in re-entrancy #The cooperating reader must be designed to consume waiting chunks and only reschedule it's channel read handler once all waiting chunks have been consumed. #puts stderr "[punk::ansi::a+ green bold]--> repl_handler has chunks to consume [ansistring VIEW $input_chunks_waiting($input)][punk::ansi::a]" - } + #} if {[eof $input]} { #test - puts stdout "restarting repl" + puts stdout "get_ansi_response_payload experimental - restarting repl" repl::reopen stdin } } + # ------------------------------------------------------------------------------------- - catch { - unset accumulator($callid) - unset waitvar($callid) - dict unset queuedata $callid - } - if {[llength $queue] > 1} { - set next_callid [lindex $queue 1] + + + unset -nocomplain accumulator($callid) + unset -nocomplain waitvar($callid) + unset -nocomplain timeoutid($callid) + unset -nocomplain tsclock($callid) + unset -nocomplain tslaunch($callid) + dict unset queuedata $callid + + lpop queue 0 + if {[llength $queue] > 0} { + set next_callid [lindex $queue 0] set waitvar($callid) go_ahead + #set nextdata [set queuedata($next_callid)] } - lpop queue 0 + #set punk::console::chunk "" - return $payload + if {$returntype eq "dict"} { + return [dict create\ + prefix $prefixdata\ + payload $payload\ + response $responsedata\ + all $input_read\ + ] + } else { + return $payload + } } @@ -811,43 +939,66 @@ namespace eval punk::console { proc ansi_response_handler_regex {chan callid endregex} { upvar ::punk::console::ansi_response_chunk chunks upvar ::punk::console::ansi_response_wait waits - upvar ::punk::console::ansi_response_clock clock ;#initial time in millis was set when fileevent was created + upvar ::punk::console::ansi_response_tslaunch tslaunch ;#initial time in millis was set when chan event was created + upvar ::punk::console::ansi_response_tsclock tsclock #endregex should explicitly have a trailing $ set status [catch {read $chan 1} bytes] if { $status != 0 } { # Error on the channel - fileevent $chan readable {} + chan event $chan readable {} puts "ansi_response_handler_regex error reading $chan: $bytes" - set waits($callid) [list error_read status $status bytes $bytes] + set waits($callid) [list error error_read status $status bytes $bytes] } elseif {$bytes ne ""} { + #puts stderr . ;flush stderr # Successfully read the channel #puts "got: [string length $bytes]bytes" - append chunks($callid) $bytes + set sofar [append chunks($callid) $bytes] #puts stderr [ansistring VIEW $chunks($callid)] - if {[regexp $endregex $chunks($callid)]} { - fileevent $chan readable {} + #review - what is min length of any ansiresponse? + #endregex is capturing - but as we are only testing the match here + #it should perform the same as if it were non-capturing + if {[string length $sofar] > 3 && [regexp $endregex $sofar]} { #puts stderr "matched - setting ansi_response_wait($callid) ok" + chan event $chan readable {} set waits($callid) ok } else { - if {[string length $chunks($callid)] % 10 == 0 || $clock($callid) - [clock millis] > 50} { - after cancel $::punk::console::ansi_response_timeoutid($callid) - set waits($callid) extend-1000 + # 30ms 16ms? + set tsnow [clock millis] + set total_elapsed [expr {[set tslaunch($callid)] - $tsnow}] + set last_elapsed [expr {[set tsclock($callid)] - $tsnow}] + if {[string length $chunks($callid)] % 10 == 0 || $last_elapsed > 16} { + if {$total_elapsed > 3000} { + #REVIEW + #too long since initial read handler launched.. + #is other data being pumped into stdin? Eventloop starvation? Did we miss our codes? + #For now we'll stop extending the timeout. + after cancel $::punk::console::ansi_response_timeoutid($callid) + set waits($callid) [list error error_ansi_response_handler_regex_too_long_reading] + } else { + if {$last_elapsed > 0} { + after cancel $::punk::console::ansi_response_timeoutid($callid) + set waits($callid) extend-[expr {min(16,$last_elapsed)}] + } + } } + set tsclock(callid) [clock millis] } } elseif {[catch {eof $chan}] || [eof $chan]} { - catch {fileevent $chan readable {}} + catch {chan event $chan readable {}} # End of file on the channel #review puts stderr "ansi_response_handler_regex end of file on channel $chan" set waits($callid) eof - } elseif {![catch {fblocked $chan}] && [fblocked $chan]} { - # Read blocked. Just return + } elseif {![catch {chan blocked $chan}] && [chan blocked $chan]} { + # Read blocked is normal. (chan -blocking = 0 but reading only 1 char) # Caller should be using timeout on the wait variable + #set waits($callid) continue + set tsclock($callid) [clock millis] } else { - fileevent $chan readable {} + chan event $chan readable {} # Something else - puts stderr "ansi_response_handler_regex Situation shouldn't be possible. No error and no bytes read on channel $chan but chan is not fblocked or EOF" + puts stderr "ansi_response_handler_regex Situation shouldn't be possible. No error and no bytes read on channel $chan but not chan blocked or EOF" set waits($callid) error_unknown_zerobytes_while_not_blocked_or_eof } } @@ -865,17 +1016,9 @@ namespace eval punk::console { #a and a+ functions are not very useful when emitting directly to console #e.g puts [punk::console::a red]test[punk::console::a cyan] would produce a cyan coloured test as the commands are evaluated first - proc a? {args} { - #stdout - variable ansi_wanted - if {$ansi_wanted <= 0} { - puts -nonewline [punk::ansi::ansistripraw [::punk::ansi::a?]] - } else { - tailcall ansi::a? {*}$args - } - } - punk::args::set_alias ::punk::console::code_a+ ::punk::ansi::a+ + #punk::args::set_alias ::punk::console::code_a+ ::punk::ansi::a+ + lappend PUNKARGS_aliases {::punk::console::code_a+ ::punk::ansi::a+} proc code_a+ {args} { variable ansi_wanted if {$ansi_wanted <= 0} { @@ -885,6 +1028,7 @@ namespace eval punk::console { #tailcall punk::ansi::a+ {*}$args ::punk::ansi::a+ {*}$args } + lappend PUNKARGS_aliases {::punk::console::code_a ::punk::ansi::a} proc code_a {args} { variable ansi_wanted if {$ansi_wanted <= 0} { @@ -893,6 +1037,7 @@ namespace eval punk::console { #tailcall punk::ansi::a {*}$args ::punk::ansi::a {*}$args } + lappend PUNKARGS_aliases {::punk::console::code_a? ::punk::ansi::a?} proc code_a? {args} { variable ansi_wanted if {$ansi_wanted <= 0} { @@ -901,6 +1046,15 @@ namespace eval punk::console { tailcall ::punk::ansi::a? {*}$args } } + #proc a? {args} { + # #stdout + # variable ansi_wanted + # if {$ansi_wanted <= 0} { + # puts -nonewline [punk::ansi::ansistripraw [::punk::ansi::a?]] + # } else { + # tailcall ansi::a? {*}$args + # } + #} #REVIEW! this needs reworking. #It needs to be clarified as to what ansi off is supposed to do. @@ -968,38 +1122,36 @@ namespace eval punk::console { return [expr {!$colour_disabled}] } - - namespace eval ansi { - proc a {args} { - puts -nonewline [::punk::ansi::a {*}$args] - } - proc a? {args} { - puts -nonewline stdout [::punk::ansi::a? {*}$args] - } - proc a+ {args} { - puts -nonewline [::punk::ansi::a+ {*}$args] - } - proc clear {} { - puts -nonewline stdout [punk::ansi::clear] - } - proc clear_above {} { - puts -nonewline stdout [punk::ansi::clear_above] + #test - find a better place to set terminal type + variable is_vt52 0 + proc vt52 {{onoff {}}} { + #todo - return to colour state beforehand?. support 0-15 vt52 colours? + #we shouldn't have to trun off colour to enter vt52 - we should make punk::console emit correct codes + variable is_vt52 + if {$onoff eq ""} { + return $is_vt52 } - proc clear_below {} { - puts -nonewline stdout [punk::ansi::clear_below] + if {![string is boolean -strict $onoff]} { + error "vt52 setting must be a boolean - or empty to query" } - proc clear_all {} { - puts -nonewline stdout [punk::ansi::clear_all] - } - proc reset {} { - puts -nonewline stdout [punk::ansi::reset] + if {$is_vt52} { + if {!$onoff} { + puts -nonewline "\x1b<" + set is_vt52 0 + colour on + } + } else { + if {$onoff} { + unset_mode DECANM + set is_vt52 1 + colour off + } else { + puts -nonewline "\x1b<" + #emit even though our is_vt52 flag thinks it's on. Should be harmless if underlying terminal already vt100+ + } } + return $is_vt52 } - namespace import ansi::clear - namespace import ansi::clear_above - namespace import ansi::clear_below - namespace import ansi::clear_all - namespace import ansi::reset namespace eval local { proc set_codepage_output {cpname} { @@ -1018,22 +1170,117 @@ namespace eval punk::console { error "set_codepage_input unimplemented on $::tcl_platform(platform)" } } + lappend PUNKARGS [list { + @id -id ::punk::console::local::echo + @cmd -name punk::console::local::echo -help\ + "Use stty on unix, or twapi on windows to set terminal + local input echo on/off - experimental" + @values -min 0 -max 1 + onoff -type boolean -default "" -help\ + "Omit or pass empty string to query current echo state." + }] + proc echo {args} { + set argd [punk::args::parse $args withid ::punk::console::local::echo] + set onoff [dict get $argd values onoff] + + set is_windows [string equal "windows" $::tcl_platform(platform)] + if {$onoff eq ""} { + #query + if {$is_windows} { + package require twapi + set inputstate [twapi::get_console_input_mode] + return [dict get $inputstate -echoinput] + } else { + #counterintuitively - the human format (-a) seems more consistent across platforms than the machine readable (-g) formats + #for now, quick and dirty look for echo in the list seems to work on wsl & freebsd at least. + set tstate [exec stty -a] + if {[lsearch $tstate echo] > 0} { + return 1 + } else { + return 0 + } + } + } else { + if {![string is boolean -strict $onoff]} { + error "::punk::console::local::echo requires boolean argument to set on or off" + } + if {$is_windows} { + set onoff [expr {true && $onoff}] ;#ensure true,yes etc are converted to 1|0 + set conh [twapi::get_console_handle stdin] + twapi::modify_console_input_mode $conh -echoinput $onoff + + return $onoff + } else { + if {$onoff} { + {*}[auto_execok stty] echo + return 1 + } else { + {*}[auto_execok stty] -echo + return 0 + } + } + } + } } namespace import local::set_codepage_output namespace import local::set_codepage_input + + lappend PUNKARGS [list { + @id -id ::punk::console::show_input_response + @cmd -name punk::console::show_input_response -help\ + "" + @opts + -terminal -default {stdin stdout} -type list -help\ + "terminal (currently list of in/out channels) (todo - object?)" + -expected_ms -type integer -default 500 -help\ + "Number of ms to wait for response" + @values -min 1 -max 1 + request -type string -help\ + "ANSI sequence such as \x1b\[?6n which + should elicit a response by the terminal + on stdin" + }] + proc show_input_response {args} { + set argd [punk::args::parse $args withid ::punk::console::show_input_response] + lassign [dict values $argd] leaders opts values received + set request [dict get $values request] + set inoutchannels [dict get $opts -terminal] + set expected [dict get $opts -expected_ms] + + set capturingregex {(((.*)))$} ;#capture entire response same as response-payload + set ts_start [clock millis] + set response [punk::console::internal::get_ansi_response_payload -ignoreok 1 -return dict -expected_ms $expected -terminal $inoutchannels $request $capturingregex] + set ts_end [clock millis] + puts stderr $response + set out "" + dict for {k v} $response { + append out "$k [ansistring VIEW $v]" \n + } + append out "totalms [expr {$ts_end - $ts_start}]" + return $out + } + # -- --- --- --- --- --- --- #get_ansi_response functions #review - can these functions sensibly be used on channels not attached to the local console? #ie can we default to {stdin stdout} but allow other channel pairs? # -- --- --- --- --- --- --- proc get_cursor_pos {{inoutchannels {stdin stdout}}} { + if {$::punk::console::is_vt52} { + error "vt52 can't perform get_cursor_pos" + } #response from terminal #e.g \033\[46;1R set capturingregex {(.*)(\x1b\[([0-9]+;[0-9]+)R)$} ;#must capture prefix,entire-response,response-payload set request "\033\[6n" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] + #some terminals fail to respond properly to \x1b\[6n but do respond to \x1b\[?6n and vice-versa :/ + #todo - what? + #often terminals that fail will just put the raw request code on stdin - we could detect that and then + #try the other? + return $payload } proc get_checksum_rect {id page t l b r {inoutchannels {stdin stdout}}} { @@ -1041,13 +1288,13 @@ namespace eval punk::console { #re e.g {(.*)(\x1b\[P44!~([[:alnum:]])\x1b\[\\)$} set capturingregex [string map [list %id% $id] {(.*)(\x1bP%id%!~([[:alnum:]]+)\x1b\\)$}] set request "\x1b\[${id}\;${page}\;$t\;$l\;$b\;$r*y" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } proc get_device_status {{inoutchannels {stdin stdout}}} { set capturingregex {(.*)(\x1b\[([0-9]+)n)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[5n" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } @@ -1083,7 +1330,7 @@ namespace eval punk::console { #set capturingregex {(.*)(\x1b\[\?6[0-9][;]*([;0-9]+)c)$} ;#must capture prefix,entire-response,response-payload set capturingregex {(.*)(\x1b\[\?([0-9]*[;0-9]+)c)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[c" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] set last_da1_result $payload return $payload } @@ -1093,14 +1340,14 @@ namespace eval punk::console { set capturingregex {(.*)(\x1b\[\>([0-9]*[;][0-9]*[;][0-1]c))$} ;#must capture prefix,entire-response,response-payload #expect CSI > X;10|20;0|1c - docs suggest X should be something like 61. In practice we see 0 or 1 (windows) REVIEW set request "\x1b\[>c" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } proc get_device_attributes_tertiary {{inoutchannels {stdin stdout}}} { #DA3 set capturingregex {(.*)(\x1bP!\|([0-9]{8})\x1b\\)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[=c" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } proc get_terminal_id {{inoutchannels {stdin stdout}}} { @@ -1115,7 +1362,7 @@ namespace eval punk::console { #set capturingregex {(.*)(\x1bP2$u((?:[0-9]+)*(?:\/[0-9]+)*)\x1b\\)$} set capturingregex {(.*)(\x1bP2\$u(.*)\x1b\\)$} set request "\x1b\[2\$w" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] set tabstops [split $payload "/"] return $tabstops } @@ -1263,18 +1510,29 @@ namespace eval punk::console { } #keep out of catch - no point in even trying a restore move if we can't get start position - just fail here. + #no vt52 equiv? may as well strip all vt52 from here? lassign [get_cursor_pos_list $inoutchannels] start_row start_col - + variable is_vt52 + if {!$is_vt52} { + set movefunc "punk::ansi::move" + set func_coff "punk::ansi::cursor_off" + set func_con "punk::ansi::cursor_on" + } else { + set movefunc "punk::ansi::vt52move" + set func_coff "punk::ansi::cursor_off_vt52" + set func_con "punk::ansi::cursor_on_vt52" + } if {[catch { #some terminals (conemu on windows) scroll the viewport when we make a big move down like this - a move to 1 1 immediately after cursor_save doesn't seem to fix that. #This issue also occurs when switching back from the alternate screen buffer - so perhaps that needs to be addressed elsewhere. - puts -nonewline $out [punk::ansi::cursor_off][punk::ansi::move 2000 2000] + + puts -nonewline $out [$func_coff][$movefunc 2000 2000] lassign [get_cursor_pos_list $inoutchannels] lines cols - puts -nonewline $out [punk::ansi::move $start_row $start_col][punk::console::cursor_on];flush stdout + puts -nonewline $out [$movefunc $start_row $start_col][$func_con];flush stdout set result [list columns $cols rows $lines] } errM]} { - puts -nonewline $out [punk::ansi::move $start_row $start_col] - puts -nonewline $out [punk::ansi::cursor_on] + puts -nonewline $out [$movefunc $start_row $start_col] + puts -nonewline $out [$func_con] error "$errM" } else { return $result @@ -1316,21 +1574,24 @@ namespace eval punk::console { proc get_xterm_size {{inoutchannels {stdin stdout}}} { set capturingregex {(.*)(\x1b\[8;([0-9]+;[0-9]+)t)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[18t" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] lassign [split $payload {;}] rows cols return [list columns $cols rows $rows] } proc get_xterm_pixels {{inoutchannels {stdin stdout}}} { set capturingregex {(.*)(\x1b\[4;([0-9]+;[0-9]+)t)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[14t" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] lassign [split $payload {;}] height width return [list width $width height $height] } + + + proc get_mode_line_wrap {{inoutchannels {stdin stdout}}} { set capturingregex {(.*)(\x1b\[\?7;([0-9]+)\$y)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[?7\$p" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } #Terminals generally default to LNM being reset (off) ie enter key sends a lone @@ -1339,7 +1600,7 @@ namespace eval punk::console { proc get_mode_LNM {{inoutchannels {stdin stdout}}} { set capturingregex {(.*)(\x1b\[\?20;([0-9]+)\$y)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[?20\$p" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } #DECRPM responses e.g: @@ -1359,7 +1620,7 @@ namespace eval punk::console { } set capturingregex [string map [list %MODE% $m] {(.*)(\x1b\[\?%MODE%;([0-9]+)\$y)$}] ;#must capture prefix,entire-response,response-payload set request "\x1b\[?$m\$p" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } proc set_mode {num_or_name {inoutchannels {stdin stdout}}} { @@ -1373,7 +1634,7 @@ namespace eval punk::console { error "punk::console::set_mode unrecognised mode '$num_or_name'. Known mode names: [dict keys $decmode_names]" } } - return "\x1b\[?${m}h" + puts -nonewline "\x1b\[?${m}h" } proc unset_mode {num_or_name {inoutchannels {stdin stdout}}} { if {[string is integer -strict $num_or_name]} { @@ -1386,7 +1647,7 @@ namespace eval punk::console { error "punk::console::unset_mode unrecognised mode '$num_or_name'. Known mode names: [dict keys $decmode_names]" } } - return "\x1b\[?${m}l" + puts -nonewline "\x1b\[?${m}l" } @@ -1584,16 +1845,6 @@ namespace eval punk::console { return [dict create available $is_available mode $m] } - namespace eval ansi { - proc cursor_on {} { - puts -nonewline stdout [punk::ansi::cursor_on] - } - proc cursor_off {} { - puts -nonewline stdout [punk::ansi::cursor_off] - } - } - namespace import ansi::cursor_on - namespace import ansi::cursor_off #review - the concept of using local mechanisms at all (ie apis) vs ansi is not necessarily something we want/need to support. #For the system to be really useful if needs to operate in conditions where the terminal is remote @@ -1625,24 +1876,6 @@ namespace eval punk::console { } } - namespace eval ansi { - proc titleset {windowtitle} { - puts -nonewline stdout [punk::ansi::titleset $windowtitle] - } - } - #namespace import ansi::titleset - proc titleset {windowtitle} { - variable ansi_wanted - if { $ansi_wanted <= 0} { - punk::console::local::titleset $windowtitle - } else { - ansi::titleset $windowtitle - } - } - #no known pure-ansi solution - proc titleget {} { - return [local::titleget] - } proc infocmp {} { set cmd1 [auto_execok infocmp] @@ -1685,16 +1918,113 @@ namespace eval punk::console { return [split $data ";"] } + #channel? namespace eval ansi { + variable PUNKARGS + #ansi escape sequence based terminal/console control functions + namespace export * + + #proc a {args} { + # puts -nonewline [::punk::ansi::a {*}$args] + #} + #proc a+ {args} { + # puts -nonewline [::punk::ansi::a+ {*}$args] + #} + #proc a? {args} { + # puts -nonewline stdout [::punk::ansi::a? {*}$args] + #} + proc clear {} { + puts -nonewline stdout [punk::ansi::clear] + } + proc clear_above {} { + puts -nonewline stdout [punk::ansi::clear_above] + } + proc clear_below {} { + puts -nonewline stdout [punk::ansi::clear_below] + } + proc clear_all {} { + puts -nonewline stdout [punk::ansi::clear_all] + } + proc reset {} { + puts -nonewline stdout [punk::ansi::reset] + } + proc cursor_on {} { + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::cursor_on] + } else { + puts -nonewline stdout [punk::ansi::cursor_on_vt52] + } + } + proc cursor_off {} { + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::cursor_off] + } else { + puts -nonewline stdout [punk::ansi::cursor_off_vt52] + } + } + + lappend PUNKARGS [list { + @id -id ::punk::console::ansi::move + @cmd -name punk::console::move -help\ + {Return an ANSI or vt52 sequence to move cursor to row,col + (aka: cursor home) + + The sequence emitted will depend on the mode of the + terminal as stored in the consolehandle. + Directly setting the mode via raw escape sequences: + e.g unset_mode DECANM for vt52 + or puts \x1b< to return to ANSI + will not necessarily update the application of + the change in terminal state. Major state changes + such as this should be done via provided functions + that keep the REPL state in sync with the underlying + terminal state. + + For ANSI the sequence is of the form: + ESC[;H + (CSI row ; col H) + This sequence will generally not be understood by + terminals that are in vt52 mode. + + For VT52 the sequence is of the form: + ESCY + This sequence will generally not be understood by + terminals that are not in vt52 mode even if higher + modes are supported. + + } + @values -min 2 -max 2 + row -type integer -help\ + "row number - starting at 1" + col -type integer -help\ + "column number - starting at 1" + }] proc move {row col} { - puts -nonewline stdout [punk::ansi::move $row $col] + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + return [punk::ansi::move $row $col] + } else { + return [punk::ansi::vt52move $row $col] + } } proc move_forward {n} { - puts -nonewline stdout [punk::ansi::move_forward $n] + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::move_forward $n] + } else { + puts -nonewline stdout [punk::ansi::vt52move_forward $n] + } } proc move_back {n} { - puts -nonewline stdout [punk::ansi::move_back $n] + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::move_back $n] + } else { + puts -nonewline stdout [punk::ansi::vt52move_back $n] + } } proc move_up {n} { puts -nonewline stdout [punk::ansi::move_up $n] @@ -1703,21 +2033,101 @@ namespace eval punk::console { puts -nonewline stdout [punk::ansi::move_down $n] } proc move_column {col} { - puts -nonewline stdout [punk::ansi::move_column $col] + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::move_column $col] + } else { + puts -nonewline stdout [punk::ansi::vt52move_column $col] + } } proc move_row {row} { puts -nonewline stdout [punk::ansi::move_row $row] } proc move_emit {row col data args} { - puts -nonewline stdout [punk::ansi::move_emit $row $col $data {*}$args] + upvar ::punk::console::is_v52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::move_emit $row $col $data {*}$args] + } else { + puts -nonewline stdout [punk::ansi::v52move_emit $row $col $data {*}$args] + } } proc move_emit_return {row col data args} { + #todo detect if in raw mode or not? + set is_in_raw 0 lassign [punk::console::get_cursor_pos_list] orig_row orig_col - set out "" - append out [punk::ansi::move_emit $row $col $data {*}$args] + + set commands "" + append commands [punk::ansi::move_emit $row $col $data {*}$args] + foreach {row col data} $args { + append commands [punk::ansi::move_emit $row $col $data {*}$args] + } if {!$is_in_raw} { incr orig_row -1 } + append commands [punk::ansi::move $orig_row $orig_col] + puts -nonewline stdout $commands + return "" + } + proc move_emitblock_return {row col textblock} { + lassign [punk::console::get_cursor_pos_list] orig_row orig_col + + set commands "" + foreach ln [split $textblock \n] { + append commands [punk::ansi::move_emit $row $col $ln] + incr row + } + append commands [punk::ansi::move $orig_row $orig_col] + puts -nonewline $commands + return + } + #we can be (slightly?) faster and more efficient if we use the consoles cursor_save_dec command - but each savecursor overrides any previous one. + #leave cursor_off/cursor_on to caller who can wrap more efficiently.. + proc cursorsave_move_emit_return {row col data args} { + upvar ::punk::console::is_vt52 is_vt52 + #JMN + set commands "" + if {!$is_vt52} { + append commands [punk::ansi::cursor_save_dec] + append commands [punk::ansi::move_emit $row $col $data] + foreach {row col data} $args { + append commands [punk::ansi::move_emit $row $col $data] + } + append commands [punk::ansi::cursor_restore_dec] + } else { + append commands [punk::ansi::cursor_save_vt52] + append commands [punk::ansi::vt52move_emit $row $col $data] + foreach {row col data} $args { + append commands [punk::ansi::vt52move_emit $row $col $data] + } + append commands [punk::ansi::cursor_restore_vt52] + } + puts -nonewline stdout $commands; flush stdout + } + proc cursorsave_move_emitblock_return {row col textblock} { + set commands "" + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + append commands [punk::ansi::cursor_save_dec] + foreach ln [split $textblock \n] { + append commands [punk::ansi::move_emit $row $col $ln] + incr row + } + append commands [punk::ansi::cursor_restore_dec] + } else { + append commands [punk::ansi::cursor_save_vt52] + foreach ln [split $textblock \n] { + append commands [punk::ansi::vt52move_emit $row $col $ln] + incr row + } + append commands [punk::ansi::cursor_restore_vt52] + } + puts -nonewline stdout $commands;flush stdout + return + } + proc move_call_return {row col script} { + lassign [punk::console::get_cursor_pos_list] orig_row orig_col + move $row $col + uplevel 1 $script move $orig_row $orig_col } proc scroll_up {n} { @@ -1772,28 +2182,49 @@ namespace eval punk::console { proc delete_lines {count} { puts -nonewline \x1b\[${count}M } + proc titleset {windowtitle} { + puts -nonewline stdout [punk::ansi::titleset $windowtitle] + } + proc test_decaln {} { + puts -nonewline stdout [punk::ansi::test_decaln] + } + } + namespace import ::punk::console::ansi::* + catch {rename titleset ""} + #namespace import ansi::titleset + proc titleset {windowtitle} { + variable ansi_wanted + if { $ansi_wanted <= 0} { + punk::console::local::titleset $windowtitle + } else { + ansi::titleset $windowtitle + } + } + #no known pure-ansi solution + proc titleget {} { + return [local::titleget] + } + + foreach ansicmd [list ::punk::console::ansi::move] { + set ctail [namespace tail $ansicmd] + set arglist [info args $ansicmd] + set argcall "" + if {[llength $arglist]} { + foreach a [lrange $arglist 0 end-1] { + append argcall "\$$a " + } + if {[lindex $arglist end] eq "args"} { + append argcall {{*}$args} + } else { + append argcall "\$[lindex $arglist end]" + } + } + catch {rename $ctail ""} + proc $ctail $arglist [string map [list %ansicmd% $ansicmd %argcall% $argcall] { + puts -nonewline [%ansicmd% %argcall%] + }] } - namespace import ansi::move - namespace import ansi::move_emit - namespace import ansi::move_forward - namespace import ansi::move_back - namespace import ansi::move_up - namespace import ansi::move_down - namespace import ansi::move_column - namespace import ansi::move_row - namespace import ansi::cursor_save - namespace import ansi::cursor_restore - namespace import ansi::cursor_save_dec - namespace import ansi::cursor_restore_dec - namespace import ansi::scroll_up - namespace import ansi::scroll_down - namespace import ansi::enable_alt_screen - namespace import ansi::disable_alt_screen - namespace import ansi::insert_spaces - namespace import ansi::delete_characters - namespace import ansi::erase_characters - namespace import ansi::insert_lines - namespace import ansi::delete_lines + #experimental @@ -1812,90 +2243,25 @@ namespace eval punk::console { puts -nonewline [punk::ansi::erase_eol][punk::ansi::move_column $col]$text cursor_restore } - proc move_emit_return {row col data args} { - #todo detect if in raw mode or not? - set is_in_raw 0 - lassign [punk::console::get_cursor_pos_list] orig_row orig_col - set commands "" - append commands [punk::ansi::move_emit $row $col $data] - foreach {row col data} $args { - append commands [punk::ansi::move_emit $row $col $data] - } - if {!$is_in_raw} { - incr orig_row -1 - } - append commands [punk::ansi::move $orig_row $orig_col] - puts -nonewline stdout $commands - return "" - } - #we can be (slightly?) faster and more efficient if we use the consoles cursor_save_dec command - but each savecursor overrides any previous one. - #leave cursor_off/cursor_on to caller who can wrap more efficiently.. - proc cursorsave_move_emit_return {row col data args} { - set commands "" - append commands [punk::ansi::cursor_save_dec] - append commands [punk::ansi::move_emit $row $col $data] - foreach {row col data} $args { - append commands [punk::ansi::move_emit $row $col $data] - } - append commands [punk::ansi::cursor_restore_dec] - puts -nonewline stdout $commands; flush stdout - } - proc move_emitblock_return {row col textblock} { + #this doesn't work - we would need an internal virtual screen structure to pick up cursor attributes from arbitrary locations? + # ncurses and its ilk may have something like that - but we specifically want to avoid curses libraries + proc pick {row col} { lassign [punk::console::get_cursor_pos_list] orig_row orig_col - - set commands "" - foreach ln [split $textblock \n] { - append commands [punk::ansi::move_emit $row $col $ln] - incr row - } - append commands [punk::ansi::move $orig_row $orig_col] - puts -nonewline $commands - return - } - proc cursorsave_move_emitblock_return {row col textblock} { - set commands "" - append commands [punk::ansi::cursor_save_dec] - foreach ln [split $textblock \n] { - append commands [punk::ansi::move_emit $row $col $ln] - incr row - } - append commands [punk::ansi::cursor_restore_dec] - puts -nonewline stdout $commands;flush stdout - return - } - proc move_call_return {row col script} { + set test "" + #set test [a green Yellow] + move_emit $row $col $test\0337 + puts -nonewline \0338\033\[${orig_row}\;${orig_col}H + } + proc pick_emit {row col data} { + set test "" + #set test [a green Purple] lassign [punk::console::get_cursor_pos_list] orig_row orig_col - move $row $col - uplevel 1 $script - move $orig_row $orig_col + move_emit $row $col $test\0337 + puts -nonewline \0338\033\[${orig_row}\;${orig_col}H$data } - #this doesn't work - we would need an internal virtual screen structure to pick up cursor attributes from arbitrary locations? - # ncurses and its ilk may have something like that - but we specifically want to avoid curses libraries - proc pick {row col} { - lassign [punk::console::get_cursor_pos_list] orig_row orig_col - set test "" - #set test [a green Yellow] - move_emit $row $col $test\0337 - puts -nonewline \0338\033\[${orig_row}\;${orig_col}H - } - proc pick_emit {row col data} { - set test "" - #set test [a green Purple] - lassign [punk::console::get_cursor_pos_list] orig_row orig_col - move_emit $row $col $test\0337 - puts -nonewline \0338\033\[${orig_row}\;${orig_col}H$data - } - # -- --- --- --- --- --- - namespace eval ansi { - proc test_decaln {} { - puts -nonewline stdout [punk::ansi::test_decaln] - } - } - namespace import ansi::test_decaln - namespace eval clock { #map chars of chars "0" to "?"" ie 0x30 to x3f @@ -2152,7 +2518,7 @@ namespace eval punk::console { puts stderr "punk::console WARNING: no modern unicode support in this Tcl version. High unicode values not properly supported. (string length \\U00010000 : $high_unicode_length should be 1)" } else { set can_high_unicode 1 - set can_regex_high_unicode [string match [regexp -all -inline {[\U80-\U0010FFFF]} \U0001F525] \U0001F525] + set can_regex_high_unicode [string equal [regexp -all -inline {[\U80-\U0010FFFF]} \U0001F525] \U0001F525] if {!$can_regex_high_unicode} { puts stderr "punk::console warning: TCL version cannot perform braced regex of high unicode" } @@ -2235,6 +2601,10 @@ namespace eval punk::console::check { +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::console ::punk::console::internal ::punk::console::local ::punk::console::ansi +} diff --git a/src/modules/punk/lib-999999.0a1.0.tm b/src/modules/punk/lib-999999.0a1.0.tm index b2eb1c67..d5af1000 100644 --- a/src/modules/punk/lib-999999.0a1.0.tm +++ b/src/modules/punk/lib-999999.0a1.0.tm @@ -246,6 +246,58 @@ tcl::namespace::eval punk::lib::compat { #outside of lmap - don't know of any particularly nice ways to flatten to subindex 1 of each element.. #flattening then lsearch with -stride and * would be nice - but it's not avail in 8.6 + if {![info exists ::auto_index(readFile)]} { + if {[info commands ::readFile] eq ""} { + proc ::readFile {filename {mode text}} { + #readFile not seen in auto_index or as command: installed by punk::lib + # Parse the arguments + set MODES {binary text} + set ERR [list -level 1 -errorcode [list TCL LOOKUP MODE $mode]] + set mode [tcl::prefix match -message "mode" -error $ERR $MODES $mode] + + # Read the file + set f [open $filename [dict get {text r binary rb} $mode]] + try { + return [read $f] + } finally { + close $f + } + } + } + } + if {![info exists ::auto_index(writeFile)]} { + if {[info commands ::writeFile] eq ""} { + proc ::writeFile {args} { + #writeFile not seen in auto_index or as command: installed by punk::lib + # Parse the arguments + switch [llength $args] { + 2 { + lassign $args filename data + set mode text + } + 3 { + lassign $args filename mode data + set MODES {binary text} + set ERR [list -level 1 -errorcode [list TCL LOOKUP MODE $mode]] + set mode [tcl::prefix match -message "mode" -error $ERR $MODES $mode] + } + default { + set COMMAND [lindex [info level 0] 0] + return -code error -errorcode {TCL WRONGARGS} "wrong # args: should be \"$COMMAND filename ?mode? data\"" + } + } + + # Write the File + set f [open $filename [dict get {text w binary wb} $mode]] + try { + puts -nonewline $f $data + } finally { + close $f + } + } + } + } + if {"::lpop" ne [info commands ::lpop]} { #puts stderr "Warning - no built-in lpop" interp alias {} lpop {} ::punk::lib::compat::lpop @@ -1021,35 +1073,35 @@ namespace eval punk::lib { -separator -default "%sep%" -roottype -default "dict" -substructure -default {} - -channel -default stdout -help "existing channel - or 'none' to return as string" + -channel -default stdout -help\ + "existing channel - or 'none' to return as string" @values -min 1 -max -1 dictvar -type string -help "name of variable. Can be a dict, list or array" patterns -type string -default "*" -multiple 1 -help {Multiple patterns can be specified as separate arguments. - Each pattern consists of 1 or more segments separated by the hierarchy separator (forward slash) - The system uses similar patterns to the punk pipeline pattern-matching system. - The default assumed type is dict - but an array will automatically be extracted into key value pairs so will also work. - Segments are classified into list,dict and string operations. - Leading % indicates a string operation - e.g %# gives string length - A segment with a single @ is a list operation e.g @0 gives first list element, @1-3 gives the lrange from 1 to 3 - A segment containing 2 @ symbols is a dict operation. e.g @@k1 retrieves the value for dict key 'k1' - The operation type indicator is not always necessary if lower segments in the hierarchy are of the same type as the previous one. - e.g1 pdict env */%# - the pattern starts with default type dict, so * retrieves all keys & values, - the next hierarchy switches to a string operation to get the length of each value. - e.g2 pdict env W* S* - Here we supply 2 patterns, each in default dict mode - to display keys and values where the keys match the glob patterns - e.g3 pdict punk_testd */* - This displays 2 levels of the dict hierarchy. - Note that if the sublevel can't actually be interpreted as a dictionary (odd number of elements or not a list at all) - - then the normal = separator will be replaced with a coloured (or underlined if colour off) 'mismatch' indicator. - e.g4 set list {{k1 v1 k2 v2} {k1 vv1 k2 vv2}}; pdict list @0-end/@@k2 @*/@@k1 - Here we supply 2 separate pattern hierarchies, where @0-end and @* are list operations and are equivalent - The second level segement in each pattern switches to a dict operation to retrieve the value by key. - When a list operation such as @* is used - integer list indexes are displayed on the left side of the = for that hierarchy level. - + Each pattern consists of 1 or more segments separated by the hierarchy separator (forward slash) + The system uses similar patterns to the punk pipeline pattern-matching system. + The default assumed type is dict - but an array will automatically be extracted into key value pairs so will also work. + Segments are classified into list,dict and string operations. + Leading % indicates a string operation - e.g %# gives string length + A segment with a single @ is a list operation e.g @0 gives first list element, @1-3 gives the lrange from 1 to 3 + A segment containing 2 @ symbols is a dict operation. e.g @@k1 retrieves the value for dict key 'k1' + The operation type indicator is not always necessary if lower segments in the hierarchy are of the same type as the previous one. + e.g1 pdict env */%# + the pattern starts with default type dict, so * retrieves all keys & values, + the next hierarchy switches to a string operation to get the length of each value. + e.g2 pdict env W* S* + Here we supply 2 patterns, each in default dict mode - to display keys and values where the keys match the glob patterns + e.g3 pdict punk_testd */* + This displays 2 levels of the dict hierarchy. + Note that if the sublevel can't actually be interpreted as a dictionary (odd number of elements or not a list at all) + - then the normal = separator will be replaced with a coloured (or underlined if colour off) 'mismatch' indicator. + e.g4 set list {{k1 v1 k2 v2} {k1 vv1 k2 vv2}}; pdict list @0-end/@@k2 @*/@@k1 + Here we supply 2 separate pattern hierarchies, where @0-end and @* are list operations and are equivalent + The second level segement in each pattern switches to a dict operation to retrieve the value by key. + When a list operation such as @* is used - integer list indexes are displayed on the left side of the = for that hierarchy level. } }] #puts stderr "$argspec" @@ -1091,7 +1143,8 @@ namespace eval punk::lib { set sep " [punk::ansi::a+ Green]=$RST " ;#stick to basic default colours for wider terminal support set sep_mismatch " [punk::ansi::a+ Brightred undercurly underline undt-white]mismatch$RST " } - package require punk ;#we need pipeline pattern matching features + package require punk::pipe + #package require punk ;#we need pipeline pattern matching features package require textblock set argd [punk::args::get_dict [string map [list %sep% $sep %sep_mismatch% $sep_mismatch] { @@ -1102,23 +1155,29 @@ namespace eval punk::lib { -channel -default none -trimright -default 1 -type boolean -help\ "Trim whitespace off rhs of each line. - This can help prevent a single long line that wraps in terminal from making - every line wrap due to long rhs padding. - " - -separator -default {%sep%} -help "Separator column between keys and values" - -separator_mismatch -default {%sep_mismatch%} -help "Separator to use when patterns mismatch" - -roottype -default "dict" -help "list,dict,string" - -ansibase_keys -default "" -help "ansi list for each level in -substructure. e.g \[list \[a+ red\] \[a+ web-green\]\]" + This can help prevent a single long line that wraps in terminal from making + every line wrap due to long rhs padding." + -separator -default {%sep%} -help\ + "Separator column between keys and values" + -separator_mismatch -default {%sep_mismatch%} -help\ + "Separator to use when patterns mismatch" + -roottype -default "dict" -help\ + "list,dict,string" + -ansibase_keys -default "" -help\ + "ansi list for each level in -substructure. e.g \[list \[a+ red\] \[a+ web-green\]\]" -substructure -default {} -ansibase_values -default "" - -keytemplates -default {\$\{$key\}} -type list -help "list of templates for keys at each level" + -keytemplates -default {\$\{$key\}} -type list -help\ + "list of templates for keys at each level" -keysorttype -default "none" -choices {none dictionary ascii integer real} -keysortdirection -default increasing -choices {increasing decreasing} -debug -default 0 -type boolean -help\ "When enabled, produces some rudimentary debug output on stderr" @values -min 1 -max -1 - dictvalue -type list -help "dict or list value" - patterns -default "*" -type string -multiple 1 -help "key or key glob pattern" + dictvalue -type list -help\ + "dict or list value" + patterns -default "*" -type string -multiple 1 -help\ + "key or key glob pattern" }] $args] #for punk::lib - we want to reduce pkg dependencies. @@ -1201,7 +1260,7 @@ namespace eval punk::lib { set segments [split $pattern_nest /] set levelpatterns [lindex $segments 0] ;#possibly comma separated patterns #we need to use _split_patterns to separate (e.g to protect commas that appear within quotes) - set patterninfo [punk::_split_patterns $levelpatterns] + set patterninfo [punk::pipe::lib::_split_patterns $levelpatterns] #puts stderr "showdict-->_split_patterns: $patterninfo" foreach v_idx $patterninfo { lassign $v_idx v idx @@ -1479,7 +1538,7 @@ namespace eval punk::lib { # -- --- --- --- set substructure "" set pnext [lindex $segments 1] - set patterninfo [punk::_split_patterns $levelpatterns] + set patterninfo [punk::pipe::lib::_split_patterns $levelpatterns] if {[llength $patterninfo] == 0} { # // ? -review - what does this mean? for xpath this would mean at any level set substructure [lindex $pattern_this_structure end] @@ -2043,18 +2102,32 @@ namespace eval punk::lib { concat {*}[uplevel 1 lmap {*}$args] } - proc dict_getdef {dictValue args} { - if {[llength $args] < 1} { - error {wrong # args: should be "dict_getdef dictValue ?key ...? key default"} - } - set keys [lrange $args -1 end-1] - if {[tcl::dict::exists $dictValue {*}$keys]} { - return [tcl::dict::get $dictValue {*}$keys] - } else { - return [lindex $args end] + #proc dict_getdef {dictValue args} { + # if {[llength $args] < 1} { + # error {wrong # args: should be "dict_getdef dictValue ?key ...? key default"} + # } + # set keys [lrange $args -1 end-1] + # if {[tcl::dict::exists $dictValue {*}$keys]} { + # return [tcl::dict::get $dictValue {*}$keys] + # } else { + # return [lindex $args end] + # } + #} + if {[info commands ::tcl::dict::getdef] eq ""} { + proc dict_getdef {dictValue args} { + set keys [lrange $args 0 end-1] + if {[tcl::dict::exists $dictValue {*}$keys]} { + return [tcl::dict::get $dictValue {*}$keys] + } else { + return [lindex $args end] + } } + } else { + #we pay a minor perf penalty for the wrap + interp alias "" ::punk::lib::dict_getdef "" ::tcl::dict::getdef } + #proc sample1 {p1 n args} { # #*** !doctools # #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] @@ -2722,6 +2795,7 @@ namespace eval punk::lib { } return [join $result \n] } + #dedent? proc undent {text} { if {$text eq ""} { return "" @@ -3795,7 +3869,7 @@ namespace eval punk::lib { } } - + #*** !doctools #[list_end] [comment {--- end definitions namespace punk::lib ---}] @@ -4142,12 +4216,10 @@ tcl::namespace::eval punk::lib::debug { proc showdict {args} {} } -if {![info exists ::punk::args::register::NAMESPACES]} { - namespace eval ::punk::args::register { - set ::punk::args::register::NAMESPACES [list] ;#use fully qualified so 8.6 doesn't find existing var in global namespace - } +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::lib } -lappend ::punk::args::register::NAMESPACES ::punk::lib # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::lib [tcl::namespace::eval punk::lib { diff --git a/src/modules/punk/mix/cli-999999.0a1.0.tm b/src/modules/punk/mix/cli-999999.0a1.0.tm index f21b1f60..197821a9 100644 --- a/src/modules/punk/mix/cli-999999.0a1.0.tm +++ b/src/modules/punk/mix/cli-999999.0a1.0.tm @@ -177,7 +177,8 @@ namespace eval punk::mix::cli { } } } - cd $sourcefolder + #cd $sourcefolder + #use run so that stdout visible as it goes if {![catch {run --timeout=55000 -debug [info nameofexecutable] $sourcefolder/make.tcl {*}$args} exitinfo]} { #todo - notify if exit because of timeout! @@ -185,11 +186,11 @@ namespace eval punk::mix::cli { set exitcode [dict get $exitinfo exitcode] } else { puts stderr "Error unable to determine exitcode. err: $exitinfo" - cd $startdir + #cd $startdir return false } - cd $startdir + #cd $startdir if {$exitcode != 0} { puts stderr "FAILED with exitcode $exitcode" return false @@ -364,10 +365,10 @@ namespace eval punk::mix::cli { #ignore trailing .tm .TM if present #if version doesn't pass validation - treat it as part of the modulename and return empty version string without error #Up to caller to validate. - proc split_modulename_version {modulename} { - set lastpart [namespace tail $modulename] + proc split_modulename_version {fullmodulename} { + set lastpart [namespace tail $fullmodulename] set lastpart [file tail $lastpart] ;# should be ok to use file tail now that we've ensured no namespace components - if {[string equal -nocase [file extension $modulename] ".tm"]} { + if {[string equal -nocase [file extension $fullmodulename] ".tm"]} { set fileparts [split [file rootname $lastpart] -] } else { set fileparts [split $lastpart -] @@ -380,7 +381,13 @@ namespace eval punk::mix::cli { set namesegment [join $fileparts -] set versionsegment "" } - return [list $namesegment $versionsegment] + set base [namespace qualifiers $fullmodulename] + if {$base ne ""} { + set modulename "${base}::$namesegment" + } else { + set modulename $namesegment + } + return [list $modulename $versionsegment] } proc get_status {{workingdir ""} args} { diff --git a/src/modules/punk/mix/commandset/layout-999999.0a1.0.tm b/src/modules/punk/mix/commandset/layout-999999.0a1.0.tm index 93ab90d2..731897c7 100644 --- a/src/modules/punk/mix/commandset/layout-999999.0a1.0.tm +++ b/src/modules/punk/mix/commandset/layout-999999.0a1.0.tm @@ -31,16 +31,42 @@ namespace eval punk::mix::commandset::layout { namespace export * + namespace eval argdoc { + proc layout_names {} { + if {[catch {punk::mix::commandset::layout::lib::layouts_dict *} ldict]} { + #REVIEW + return "punk.project" + } else { + return [dict keys $ldict] + } + } + } #per layout functions - proc files {{layout ""}} { - set argd [punk::args::get_dict { - @id -id ::punk::mix::commandset::layout::files - @values -min 1 -max 1 - layout -type string -minsize 1 - } [list $layout]] + punk::args::define { + @dynamic + @id -id ::punk::mix::commandset::layout::files + -datetime -default "%Y-%m-%dT%H:%M:%S" -help\ + "Datetime format for mtime. Use empty string for no datetime output" + @values -min 1 -max 1 + layout -type string -choices {${[punk::mix::commandset::layout::argdoc::layout_names]}} + } + proc files {args} { + set argd [punk::args::get_by_id ::punk::mix::commandset::layout::files $args] + set layout [dict get $argd values layout] + set dtformat [dict get $argd opts -datetime] set allfiles [lib::layout_all_files $layout] - return [join $allfiles \n] + if {$dtformat eq ""} { + return [join $allfiles \n] + } else { + set out "" + foreach f $allfiles { + set mtime [dict get [file stat $f] mtime] + append out "$f [clock format $mtime -format $dtformat]" \n + } + set out [string range $out 0 end-1] + return $out + } } proc templatefiles {layout} { set templatefiles_and_tags [lib::layout_scan_for_template_files $layout] @@ -166,7 +192,7 @@ namespace eval punk::mix::commandset::layout { } proc as_dict {args} { - tailcall punk::mix::commandset::layout::lib::layouts_dict {*}$args + punk::mix::commandset::layout::lib::layouts_dict {*}$args } proc references_as_dict {args} { package require punk::cap diff --git a/src/modules/punk/mix/commandset/loadedlib-999999.0a1.0.tm b/src/modules/punk/mix/commandset/loadedlib-999999.0a1.0.tm index b2eb5a93..193a0202 100644 --- a/src/modules/punk/mix/commandset/loadedlib-999999.0a1.0.tm +++ b/src/modules/punk/mix/commandset/loadedlib-999999.0a1.0.tm @@ -1,5 +1,5 @@ # -*- tcl -*- -# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from -buildversion.txt +# Maintenance Instruction: leave the 999999.xxx.x as is and use 'deck make' or src/make.tcl to update from -buildversion.txt # # Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. # Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. @@ -304,11 +304,12 @@ namespace eval punk::mix::commandset::loadedlib { } set versions [package versions [lindex $libfound 0]] - if {$has_natsort} { - set versions [natsort::sort $versions] - } else { - set versions [lsort $versions] - } + set versions [lsort -command {package vcompare} $versions] + #if {$has_natsort} { + # set versions [natsort::sort $versions] + #} else { + # set versions [lsort $versions] + #} if {![llength $versions]} { error "No version numbers found for library/module $libfound - sorry, you will need to copy it across manually" } diff --git a/src/modules/punk/mix/commandset/module-999999.0a1.0.tm b/src/modules/punk/mix/commandset/module-999999.0a1.0.tm index 1e26a8bd..97e870be 100644 --- a/src/modules/punk/mix/commandset/module-999999.0a1.0.tm +++ b/src/modules/punk/mix/commandset/module-999999.0a1.0.tm @@ -120,17 +120,20 @@ namespace eval punk::mix::commandset::module { return $table } - #return all module templates with repeated ones suffixed with .2 .3 etc + + #return all module templates with repeated ones suffixed with #2 #3 etc + punk::args::define { + @id -id ::punk::mix::commandset::module::templates_dict + @cmd -name templates_dict -help\ + "Templates from module and project paths" + -startdir -default "" -help\ + "Project folder used in addition to module paths" + -not -default "" -multiple 1 + @values + globsearches -default * -multiple 1 + } proc templates_dict {args} { - set argspec { - @id -id ::punk::mix::commandset::module::templates_dict - @cmd -name templates_dict -help "Templates from module and project paths" - -startdir -default "" -help "Project folder used in addition to module paths" - -not -default "" -multiple 1 - @values - globsearches -default * -multiple 1 - } - set argd [punk::args::get_dict $argspec $args] + set argd [punk::args::get_by_id ::punk::mix::commandset::module::templates_dict $args] package require punk::cap if {[punk::cap::capability_has_handler punk.templates]} { set template_folder_dict [punk::cap::call_handler punk.templates get_itemdict_moduletemplates {*}$args] @@ -154,10 +157,11 @@ namespace eval punk::mix::commandset::module { the higher version number will be used. " -license -default + -author -default -multiple 1 -template -default punk.module -type -default "[lindex $moduletypes 0]" -choices {$moduletypes} -force -default 0 -type boolean -help\ - "If set true, will overwrite an existing .tm file if there is one. + "If set true, will OVERWRITE an existing .tm file if there is one. If false (default) an error will be raised if there is a conflict." -quiet -default 0 -type boolean -help\ "Suppress information messages on stdout" @@ -262,6 +266,7 @@ namespace eval punk::mix::commandset::module { } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_license [dict get $opts -license] + set opt_authors [dict get $opts -author] ;#-multiple true # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_template [dict get $opts -template] if {[regexp {.*[?*].*} $opt_template]} { @@ -403,7 +408,7 @@ namespace eval punk::mix::commandset::module { #for now the user has the option to override any templates and remove %moduletemplate% if it is a security/privacy concern #Don't put literal %x% in the code for the commandset::module itself - to stop them being seen by layout scanner as replacable tokens - set tagnames [list moduletemplate $moduletemplate project $projectname pkg $modulename year $year license $opt_license version $infile_version] + set tagnames [list moduletemplate $moduletemplate project $projectname pkg $modulename year $year license $opt_license authors $opt_authors version $infile_version] set strmap [list] foreach {tag val} $tagnames { lappend strmap %$tag% $val diff --git a/src/modules/punk/mix/commandset/project-999999.0a1.0.tm b/src/modules/punk/mix/commandset/project-999999.0a1.0.tm index bf16c030..33a3b44e 100644 --- a/src/modules/punk/mix/commandset/project-999999.0a1.0.tm +++ b/src/modules/punk/mix/commandset/project-999999.0a1.0.tm @@ -109,7 +109,26 @@ namespace eval punk::mix::commandset::project { } - + namespace eval argdoc { + set layout_dict [punk::cap::call_handler punk.templates get_itemdict_projectlayouts] + variable LAYOUTNAMES [dict keys $layout_dict] + } + punk::args::define { + @id -id ::punk::mix::commandset::project::new + @cmd -name "punk::mix::commandset::project::new" -help\ + "" + @leaders -min 1 -max 1 + project -type string -help\ + "Project name or path. + If just a name is given ... (todo)" + @opts + -type -default plain + -empty -default 0 -type boolean + -force -default 0 -type boolean + -update -default 0 -type boolean + -confirm -default 1 -type boolean + -layout -default "punk.project" -choices {${$::punk::mix::commandset::project::argdoc::LAYOUTNAMES}} + } proc new {newprojectpath_or_name args} { #*** !doctools @@ -300,7 +319,17 @@ namespace eval punk::mix::commandset::project { } } } elseif {$project_dir_exists && $opt_update} { - puts stderr "mix new WARNING: -update 1 was supplied. Will copy layout $layout_path using -update option to add missing items" + set warnmsg "mix new WARNING: -update 1 was supplied. Will copy layout $layout_path using -update option to add missing items" + if {$opt_confirm} { + puts stderr $warnmsg + set msg "Do you want to proceed to possibly overwrite some existing files in $projectdir? Y|N" + set answer [util::askuser $msg] + if {[string tolower $answer] ne "y"} { + puts stderr "mix new aborting due to user response '$answer' (required Y|y to proceed) use -confirm 0 to avoid prompt." + return + } + } + puts stderr $warnmsg } set fossil_repo_file "" @@ -366,28 +395,40 @@ namespace eval punk::mix::commandset::project { #default antiglob_dir_core will stop .fossil* from being updated - which is generally desirable as these are likely to be customized if {$opt_force} { puts stdout "copying layout files - with force applied - overwrite all-targets" - set resultdict [punkcheck::install $layout_path $projectdir -installer project.new -overwrite ALL-TARGETS -antiglob_paths $antipaths -antiglob_dir $antiglob_dir] + set resultdict [punkcheck::install $layout_path $projectdir -installer project.new -createempty 1 -overwrite ALL-TARGETS -antiglob_paths $antipaths -antiglob_dir $antiglob_dir] } else { puts stdout "copying layout files - (if source file changed)" - set resultdict [punkcheck::install $layout_path $projectdir -installer project.new -overwrite installedsourcechanged-targets -antiglob_paths $antipaths -antiglob_dir $antiglob_dir] + set resultdict [punkcheck::install $layout_path $projectdir -installer project.new -createempty 1 -overwrite installedsourcechanged-targets -antiglob_paths $antipaths -antiglob_dir $antiglob_dir] } puts stdout [punkcheck::summarize_install_resultdict $resultdict] - puts stdout "copying layout src/doc files (if target missing)" - set resultdict [punkcheck::install $layout_path/src/doc $projectdir/src/doc -punkcheck_folder $projectdir -installer project.new -overwrite SYNCED-TARGETS] - puts stdout [punkcheck::summarize_install_resultdict $resultdict] + if {[file exists $layout_path/src/doc]} { + puts stdout "copying layout src/doc files (if target missing)" + set resultdict [punkcheck::install $layout_path/src/doc $projectdir/src/doc -createdir 1 -punkcheck_folder $projectdir -installer project.new -overwrite SYNCED-TARGETS] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + } else { + puts stdout "no src/doc in source template - update not required" + } #target folders .fossil-custom and .fossil-settings may not exist. use -createdir 1 to ensure existence. #In this case we need to override the default dir antiglob - as .fossil-xxx folders need to be installed from template if missing, or if target is uncustomized. ## default_antiglob_dir_core [list "#*" "_aside" ".git" ".fossil*"] set override_antiglob_dir_core [list #* _aside .git] - puts stdout "copying layout src/.fossil-custom files (if target missing or uncustomised)" - set resultdict [punkcheck::install $layout_path/.fossil-custom $projectdir/.fossil-custom -createdir 1 -punkcheck_folder $projectdir -installer project.new -antiglob_dir_core $override_antiglob_dir_core -overwrite SYNCED-TARGETS] - puts stdout [punkcheck::summarize_install_resultdict $resultdict] + if {[file exists $layout_path/.fossil-custom]} { + puts stdout "copying layout src/.fossil-custom files (if target missing or uncustomised)" + set resultdict [punkcheck::install $layout_path/.fossil-custom $projectdir/.fossil-custom -createdir 1 -createempty 1 -punkcheck_folder $projectdir -installer project.new -antiglob_dir_core $override_antiglob_dir_core -overwrite SYNCED-TARGETS] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + } else { + puts stdout "no .fossil-custom in source template - update not required" + } - puts stdout "copying layout src/.fossil-settings files (if target missing or uncustomised)" - set resultdict [punkcheck::install $layout_path/.fossil-settings $projectdir/.fossil-settings -createdir 1 -punkcheck_folder $projectdir -installer project.new -antiglob_dir_core $override_antiglob_dir_core -overwrite SYNCED-TARGETS] - puts stdout [punkcheck::summarize_install_resultdict $resultdict] + if {[file exists $layout_path/.fossil-settings]} { + puts stdout "copying layout src/.fossil-settings files (if target missing or uncustomised)" + set resultdict [punkcheck::install $layout_path/.fossil-settings $projectdir/.fossil-settings -createdir 1 -createempty 1 -punkcheck_folder $projectdir -installer project.new -antiglob_dir_core $override_antiglob_dir_core -overwrite SYNCED-TARGETS] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + } else { + puts stdout "no .fossil-settings in source template - update not required" + } #scan all files in template # diff --git a/src/modules/punk/nav/fs-999999.0a1.0.tm b/src/modules/punk/nav/fs-999999.0a1.0.tm index 4d2d27b3..091c0347 100644 --- a/src/modules/punk/nav/fs-999999.0a1.0.tm +++ b/src/modules/punk/nav/fs-999999.0a1.0.tm @@ -281,7 +281,8 @@ tcl::namespace::eval punk::nav::fs { } } - if {[file pathtype $a1] ne "relative"} { + if {![regexp {[*?]} $a1] && [file pathtype $a1] ne "relative"} { + #non-relative non-glob if { ![string match //zipfs:/* $a1]} { if {[file type $a1] eq "directory"} { cd $a1 diff --git a/src/modules/punk/ns-999999.0a1.0.tm b/src/modules/punk/ns-999999.0a1.0.tm index 5cb49fbf..f3d3cdf6 100644 --- a/src/modules/punk/ns-999999.0a1.0.tm +++ b/src/modules/punk/ns-999999.0a1.0.tm @@ -26,9 +26,16 @@ tcl::namespace::eval ::punk::ns::evaluator { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::ns { - variable ns_current "::" + variable ns_current + #allow presetting + if {![info exists ::punk::ns::ns_current]} { + set ns_current :: + } + variable ns_re_cache [dict create] ;#cache regular expressions used in globmatchns namespace export nsjoin nsprefix nstail nsparts nseval nschildren nsimport_noclobber corp + namespace path {::punk::lib ::punk::ansi} ;#list_as_lines etc + catch { package require debug debug define punk.ns.compile @@ -1259,7 +1266,7 @@ tcl::namespace::eval punk::ns { } else { set report_namespaces $matched_namespaces } - punk::args::update_definitions + punk::args::update_definitions $report_namespaces set nsdict_list [list] foreach ch $report_namespaces { @@ -1371,9 +1378,9 @@ tcl::namespace::eval punk::ns { #use aliases glob - because aliases can be present with or without leading :: #NOTE: alias may not have matching command in the relevant namespce (renamed alias) so we can't just start with commands and check if it's an alias if we want to show all aliases if {$weird_ns} { - set raw_aliases [nseval_ifexists $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. + set raw_aliases [nseval_ifexists $location [list ::punk::lib::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. } else { - set raw_aliases [tcl::namespace::eval $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. + set raw_aliases [tcl::namespace::eval $location [list ::punk::lib::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. } #set raw_aliases [nseval $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. set aliases [list] @@ -1620,6 +1627,7 @@ tcl::namespace::eval punk::ns { if {$has_punkargs} { #set id [string trimleft $fq :] set id $fq + punk::args::update_definitions [list [namespace qualifiers $id]] if {[::punk::args::id_exists $id]} { lappend usageinfo $c } else { @@ -1969,7 +1977,8 @@ tcl::namespace::eval punk::ns { #todo - -cache or -refresh to configure whether we introspect ensembles/objects each time? # - as this is interactive generally introspection should be ok at the top level # but if we need to go down multiple levels of subcommands generating/testing prefixes - could be an issue ?? - punk::args::define -dynamic 0 { + punk::args::define { + @dynamic @id -id ::punk::ns::arginfo @cmd -name punk::ns::arginfo -help\ "Show usage info for a command. @@ -1995,20 +2004,20 @@ tcl::namespace::eval punk::ns { -return -type string -default table -choices {string table tableobject} - } {${[punk::args::resolved_def -type @opts ::punk::args::arg_error -scheme]}} { + } {${[punk::args::resolved_def -types opts ::punk::args::arg_error -scheme]}} { -- -type none -help\ "End of options marker - Use this if the command to view begins with a -" + Use this if the command to view begins with a -" @values -min 1 commandpath -help\ "command (may be alias, ensemble, tcl::oo object, tepam proc etc)" subcommand -optional 1 -multiple 1 -default {} -help\ "subcommand if commandpath is an ensemble. - Multiple subcommands can be supplied if ensembles are further nested" + Multiple subcommands can be supplied if ensembles are further nested" } proc arginfo {args} { - lassign [dict values [punk::args::get_by_id ::punk::ns::arginfo $args]] leaders opts values received + lassign [dict values [punk::args::parse $args withid ::punk::ns::arginfo]] leaders opts values received #review - setting this afterwards is an architecture smell - we should be able to override the default in the dynamic part #todo - enable retrieving by id just the record_opts part - so we can treat as a dict directly, as well as easily apply it as a different flag name. @@ -2018,7 +2027,6 @@ tcl::namespace::eval punk::ns { set querycommand [dict get $values commandpath] set queryargs [dict get $values subcommand] - punk::args::update_definitions ;#ensure any packages that register PUNKARGS have been loaded #todo - similar to corp? review corp resolution process @@ -2087,6 +2095,16 @@ tcl::namespace::eval punk::ns { } } + #check for a direct match first + if {[info commands ::punk::args::id_exists] ne ""} { + if {![llength $queryargs]} { + punk::args::update_definitions [list [namespace qualifiers $origin]] + if {[punk::args::id_exists $origin]} { + return [uplevel 1 [list punk::args::usage {*}$opts $origin]] + } + } + } + #ns::cmdtype only detects alias type on 8.7+? set initial_cmdtype [punk::ns::cmdtype $origin] switch -- $initial_cmdtype { @@ -2137,31 +2155,40 @@ tcl::namespace::eval punk::ns { set id $origin if {[info commands ::punk::args::id_exists] ne ""} { - #cycle through longest first checking for id matching ::cmd ?subcmd..? - #REVIEW - this doesn't cater for prefix callable subcommands! + + + #check longest first checking for id matching ::cmd ?subcmd..? + #REVIEW - this doesn't cater for prefix callable subcommands set argcopy $queryargs - while {[llength $argcopy]} { - if {[punk::args::id_exists [list $id {*}$argcopy]]} { - return [uplevel 1 [list punk::args::usage {*}$opts [list $id {*}$argcopy]]] + if {[llength $queryargs]} { + punk::args::update_definitions [list [namespace qualifiers $id]] + if {[punk::args::id_exists [list $id {*}$queryargs]]} { + return [uplevel 1 [list punk::args::usage {*}$opts [list $id {*}$queryargs]]] } - lpop argcopy } + #while {[llength $argcopy]} { + # if {[punk::args::id_exists [list $id {*}$argcopy]]} { + # return [uplevel 1 [list punk::args::usage {*}$opts [list $id {*}$argcopy]]] + # } + # lpop argcopy + #} #didn't find any exact matches #traverse from other direction taking prefixes into account + punk::args::update_definitions [list [namespace qualifiers $id]] if {[punk::args::id_exists $id]} { #cycle forward through leading values - set def [punk::args::get_def $id] + set spec [punk::args::get_spec $id] if {[llength $queryargs]} { set nextqueryargs [list] ;#build a list of prefix-resolved queryargs set queryargs_untested $queryargs foreach q $queryargs { - if {[llength [dict get $def LEADER_NAMES]]} { - set subitems [dict get $def LEADER_NAMES] + if {[llength [dict get $spec LEADER_NAMES]]} { + set subitems [dict get $spec LEADER_NAMES] if {[llength $subitems]} { set next [lindex $subitems 0] - set arginfo [dict get $def ARG_INFO $next] + set arginfo [dict get $spec ARG_INFO $next] set allchoices [list] set choices [punk::args::system::Dict_getdef $arginfo -choices {}] @@ -2184,16 +2211,22 @@ tcl::namespace::eval punk::ns { #we have our first difference - recurse with new query args #set numvals [expr {[llength $queryargs]+1}] #return [ punk::ns::arginfo {*}[lrange $args 0 end-$numvals] $querycommand {*}$nextqueryargs {*}$queryargs_untested] - + #puts "===> testing arginfo {*}$opts $querycommand {*}$nextqueryargs {*}$queryargs_untested" return [ punk::ns::arginfo {*}$opts $querycommand {*}$nextqueryargs {*}$queryargs_untested] } #check if subcommands so far have a custom args def - set currentid [list $querycommand {*}$nextqueryargs] + #set currentid [list $querycommand {*}$nextqueryargs] + set currentid [list $id {*}$nextqueryargs] if {[punk::args::id_exists $currentid]} { - set def [punk::args::get_def $currentid + set spec [punk::args::get_spec $currentid] } else { #We can get no further with custom defs + #It is possible we have a documented lower level subcommand but missing the intermediate + #e.g if ::trace remove command was specified and is documented - it will be found above + #but if ::trace remove is not documented and the query is "::trace remove com" + #There is no way to determine com is a prefix as we don't have the intermediate documented -choice info available. + #that's probably ok. break } } @@ -2307,7 +2340,7 @@ tcl::namespace::eval punk::ns { set implementations [::info object call $origin $c1] #result documented as list of 4 element lists #set callinfo [lindex $implementations 0] - set def "" + set oodef "" foreach impl $implementations { lassign $impl generaltype mname location methodtype switch -- $generaltype { @@ -2323,7 +2356,7 @@ tcl::namespace::eval punk::ns { return [uplevel 1 [list punk::args::usage {*}$opts $idcustom]] } } - set def [::info object definition $origin $c1] + set oodef [::info object definition $origin $c1] } else { #set id "[string trimleft $location :] $c1" ;# " " set idcustom "$location $c1" @@ -2332,7 +2365,7 @@ tcl::namespace::eval punk::ns { return [uplevel 1 [list punk::args::usage {*}$opts $idcustom]] } } - set def [::info class definition $location $c1] + set oodef [::info class definition $location $c1] } break } @@ -2342,10 +2375,9 @@ tcl::namespace::eval punk::ns { } } } - if {$def ne ""} { - #assert - if we pre + if {$oodef ne ""} { set autoid "(autodef)$location $c1" - set arglist [lindex $def 0] + set arglist [lindex $oodef 0] set argdef [punk::lib::tstr -return string { @id -id "${$autoid}" @cmd -name "${$location} ${$c1}" -help\ @@ -2368,7 +2400,7 @@ tcl::namespace::eval punk::ns { append argdef \n "[lindex $a 0] -default {[lindex $a 1]} -optional 1" } default { - error "punk::ns::arginfo unexpected argument signature '$arglist'\ndef:$def\nimplementaions:$implementations" + error "punk::ns::arginfo unexpected oo argument signature '$arglist'\noodef:$oodef\nimplementations:$implementations" } } incr i @@ -2427,7 +2459,7 @@ tcl::namespace::eval punk::ns { @id -id ${$idauto} @cmd -name "Object: ${$origin}" -help\ "Instance of class: ${$class} (info autogenerated)" - @values -min 1 + @leaders -min 1 }] append argdef \n $vline punk::args::define $argdef @@ -2542,7 +2574,7 @@ tcl::namespace::eval punk::ns { @cmd -help\ "(autogenerated) ensemble: ${$origin}" - @values -min 1 + @leaders -min 1 }] append argdef \n $vline punk::args::define $argdef @@ -2977,84 +3009,100 @@ tcl::namespace::eval punk::ns { If not supplied, caller's namespace is used." -prefix -optional 1 -help\ "string prefix for command names in target namespace" - @values -min 1 -max 1 - sourcepattern -type string -optional 0 -help\ - "Glob pattern for source namespace. + @values -min 1 -max -1 + sourcepattern -type string -optional 0 -multiple 1 -help\ + "Glob pattern(s) for exported commands in source namespace(s). Globbing only active in the tail segment. - e.g ::mynamespace::*" + e.g ::mynamespace::a* ::mynamespace::j*" } proc nsimport_noclobber {args} { lassign [dict values [punk::args::get_by_id ::punk::ns::nsimport_noclobber $args]] leaders opts values received - set sourcepattern [dict get $values sourcepattern] + set sourcepatterns [dict get $values sourcepattern] - set source_ns [tcl::namespace::qualifiers $sourcepattern] - if {![tcl::namespace::exists $source_ns]} { - error "nsimport_noclobber error namespace $source_ns not found" - } set nscaller [uplevel 1 {namespace current}] if {![dict exists $received -targetnamespace]} { set target_ns $nscaller } else { set target_ns [dict get $opts -targetnamespace] if {![string match ::* $target_ns]} { - set target_ns [punk::nsjoin $nscaller $target_ns] + set target_ns [punk::ns::nsjoin $nscaller $target_ns] } } + set all_imported [list] + set nstemp ::punk::ns::temp_import - set a_export_patterns [tcl::namespace::eval $source_ns {namespace export}] - set a_commands [info commands $sourcepattern] - set a_tails [lmap v $a_commands {tcl::namespace::tail $v}] - set a_exported_tails [list] - foreach epattern $a_export_patterns { - set matches [lsearch -all -inline $a_tails $epattern] - foreach m $matches { - if {$m ni $a_exported_tails} { - lappend a_exported_tails $m + foreach pat $sourcepatterns { + set source_ns [tcl::namespace::qualifiers $pat] + if {![tcl::namespace::exists $source_ns]} { + error "nsimport_noclobber error namespace $source_ns not found" + } + + set a_export_patterns [tcl::namespace::eval $source_ns {namespace export}] + set a_commands [info commands $pat] + #puts "-->commands:'$a_commands'" + set a_tails [lmap v $a_commands {tcl::namespace::tail $v}] + set a_exported_tails [list] + foreach epattern $a_export_patterns { + set matches [lsearch -all -inline $a_tails $epattern] + foreach m $matches { + #we will be using namespace import one by one on commands. + #we must protect glob chars that may exist in the actual command names. + #e.g nsimport_noclobber ::punk::ansi::a? + # will import a+ and a? + #but nsimport_noclobber {::punk::ansi::a\?} + # must import only a? + set m [string map {\\ \\\\ ? \\? * \\* \[ \\[ \] \\]} $m] + if {$m ni $a_exported_tails} { + lappend a_exported_tails $m + } } } - } - set nstemp ::punk::ns::temp_import - if {[tcl::dict:::exists $received -prefix]} { - set pfx [dict get $opts -prefix] - set imported_commands [list] - if {[namespace exists $nstemp]} { - namespace delete $nstemp - } - namespace eval $nstemp {} - foreach e $a_exported_tails { - set imported [tcl::namespace::eval $nstemp [string map [list $e $source_ns $pfx $target_ns] { - set cmd "" - if {![catch {namespace import ::}]} { - #renaming will fail if target already exists - #renaming a command into another namespace still results in a command with 'info cmdtype' = 'import' - if {![catch {rename [punk::ns::nsjoin ]}]} { - set cmd + + + if {[tcl::dict:::exists $received -prefix]} { + #import via temporary/intermediate namespace + set pfx [dict get $opts -prefix] + set imported_commands [list] + if {[namespace exists $nstemp]} { + namespace delete $nstemp + } + namespace eval $nstemp {} + foreach e $a_exported_tails { + set imported [apply {{tgtns func srcns pfx tmpns} { + set cmd "" + if {![catch {::tcl::namespace::eval $tmpns [list ::namespace import ${srcns}::$func]}]} { + #renaming will fail if target already exists + #renaming a command into another namespace still results in a command with 'info cmdtype' = 'import' + if {![catch {::tcl::namespace::eval $tmpns [list ::rename $func [::punk::ns::nsjoin $tgtns $pfx$func]]}]} { + set cmd $pfx$func + } } + set cmd + } } $target_ns $e $source_ns $pfx $nstemp] + if {$imported ne ""} { + lappend imported_commands $imported } - set cmd - }]] - if {$imported ne ""} { - lappend imported_commands $imported } - } - namespace delete $nstemp - return $imported_commands - } - - set imported_commands [list] - foreach e $a_exported_tails { - set imported [tcl::namespace::eval $target_ns [string map [list $e $source_ns] { - set cmd "" - if {![catch {namespace import ::}]} { - set cmd + namespace delete $nstemp + } else { + #no prefix - direct import + set imported_commands [list] + foreach e $a_exported_tails { + set imported [apply {{tgtns func srcns} { + set cmd "" + if {![catch {tcl::namespace::eval $tgtns [list namespace import ${srcns}::$func]}]} { + set cmd $func + } + set cmd + } } $target_ns $e $source_ns] + if {$imported ne ""} { + lappend imported_commands $imported + } } - set cmd - }]] - if {[string length $imported]} { - lappend imported_commands $imported } + lappend all_imported {*}$imported_commands } - return $imported_commands + return $all_imported } #todo - use ns::nsimport_noclobber instead ? @@ -3092,7 +3140,23 @@ tcl::namespace::eval punk::ns { interp alias {} corp {} punk::ns::corp interp alias {} i {} punk::ns::arginfo - + #An example of using punk::args in a pipeline + punk::args::define { + @id -id ::i+ + @cmd -name "i+" -help\ + "Display command help side by side" + @values + cmds -multiple 1 -help\ + "Command names for which to show help info" + } + interp alias {} i+ {}\ + .=args> punk::args::get_by_id ::i+ |argd>\ + .=>2 dict get values cmds |cmds>\ + .=cmds>2 lmap c {i -return tableobject {*}$c} |objs>\ + .=objs>2 lmap t {$t configure -show_vseps 0 -show_edge 1} |>\ + .=objs>2 lmap t {$t print} |tables>\ + .=objs>2 lmap t {$t destroy} |>\ + .=tables>* textblock::join -- 1} { + # --------------------------------------------------------------- + #An attempt to detect dll/so loaded and try to load same version + #dll/so files are often named with version numbers that don't contain dots or a version number at all + #e.g sqlite3400.dll Thread288.dll + set pkgloadedinfo [lsearch -nocase -inline -index 1 [info loaded] $pkg] + + if {[llength $pkgloadedinfo]} { + puts stderr "--> pkg not already 'provided' but shared object seems to be loaded: $pkgloadedinfo - and multiple versions available" + lassign $pkgloadedinfo path name + set lcpath [string tolower $path] + #first attempt to find a match for our loaded sharedlib path in a *simple* package ifneeded statement. + set lcpath_to_version [dict create] + foreach av $available_versions { + set scr [package ifneeded $pkg $av] + #ifneeded script not always a valid tcl list + if {![catch {llength $scr} scrlen]} { + if {$scrlen == 3 && [lindex $scr 0] eq "load" && [string match -nocase [lindex $scr 2] $pkg]} { + dict set lcpath_to_version [string tolower [lindex $scr 1]] $av + } + } } - } - } - if {[llength $pkgloadedinfo]} { - puts stderr "--> pkg not present but shared object seems to be loaded: $pkgloadedinfo" - lassign $pkgloadedinfo path name - set lcpath [string tolower $path] - set obj [file tail $lcpath] - if {[string match tcl9* $obj]} { - set obj [string range $obj 4 end] - } elseif {[string match lib* $obj]} { - set obj [string range $obj 3 end] - } - set pkginfo [file rootname $obj] - #e.g Thread2.8.8 - if {[regexp {^([a-zA-Z\-]+)(.*)} $pkginfo _match lname lversion]} { - if {[string tolower $lname] eq [string tolower $pkg]} { + if {[dict exists $lcpath_to_version $lcpath]} { + set lversion [dict get $lcpath_to_version $lcpath] + } else { + #fallback to a best effort guess based on the path + set lversion [::punk::packagepreference::system::slibpath_guess_pkgversion $path $pkg] + } + if {$lversion ne ""} { #name matches pkg #hack for known dll version mismatch if {[string tolower $pkg] eq "thread" && $lversion eq "30b3"} { @@ -240,9 +259,11 @@ tcl::namespace::eval punk::packagepreference { }] if {[dict get $stackrecord implementation] ne ""} { set impl [dict get $stackrecord implementation] ;#use hardcoded name rather than slower (but more flexible) commandstack::get_next_command - puts stdout "punk::packagepreference renamed ::package to $impl" + #puts stdout "punk::packagepreference renamed ::package to $impl" + return 1 } else { puts stderr "punk::packagepreference failed to rename ::package" + return 0 } #puts stdout [info body ::package] } @@ -297,14 +318,94 @@ tcl::namespace::eval punk::packagepreference::lib { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[section Internal] -#tcl::namespace::eval punk::packagepreference::system { +tcl::namespace::eval punk::packagepreference::system { #*** !doctools #[subsection {Namespace punk::packagepreference::system}] #[para] Internal functions that are not part of the API + variable PUNKARGS + + lappend PUNKARGS [list { + @id -id ::punk::packagepreference::system::slibpath_guess_pkgversion + @cmd -name punk::packagepreference::system::slibpath_guess_pkgversion -help\ + "Assistance function to determine pkg version from the information + obtained from [info loaded]. This is used to try to avoid loading a different + version of a binary package in another thread/interp when the package isn't + present in the interp, but [info loaded] indicates the binary is already loaded. + The more general/robust way to avoid this is to ensure ::auto_path and + tcl::tm::list are the same in each interp/thread. + + This call should only be used as a fallback in case a binary package has a more + complex ifneeded script. If the ifneeded script for a binary package is a + straightforward 'load ' - then that information + should be used to determine the version by matching + rather than this one. + + Takes a path to a shared lib (.so/.dll), and the name of its providing + package, and return the version of the package if possible to determine + from the path. + The filename portion of the lib is often missing a version number or has + a version number that has been shortened (e.g dots removed). + The filename itself is first checked for a version number - but the number + is ignored if it doesn't contain any dots. + (prefix is checked to match with $pkgname, with a possible additional prefix + of lib or tcl) + Often (even usually) the parent or grandparent folder will be named as + per the package name with a proper version. If so we can return it, + otherwise return empty string. + The parent/grandparent matching will be done by looking for a case + insensitive match of the prefix to $pkgname. + " + @values -min 1 + libpath -help "Full path to shared library (.so,.dll etc)" + pkgname -help "" + }] + proc slibpath_guess_pkgversion {libpath pkgname} { + set root [file rootname [file tail $libpath]] + set namelen [string length $pkgname] + regexp {^(tcl(?:[0-9])+){0,1}(.*)} $root _match tclxx root ;#regexp will match anything - but only truncate leading tclXX.. + set testv "" + if {[string match -nocase $pkgname* $root]} { + set testv [string range $root $namelen end] + } elseif {[string match -nocase lib$pkgname* $root]} { + set testv [string range $root $namelen+3 end] + } + if {[string first . $testv] > 0} { + if {![catch [list package vcompare $testv $testv]]} { + #testv has an inner dot and is understood by tcl as a valid version number + return $testv + } + } + #no valid dotted version found directly on dll or so filename + set parent [file dirname $libpath] ;#parent folder is often some differentiator for platform or featureset (e.g win-x64) + set grandparent [file dirname $parent] + foreach path [list $parent $grandparent] { + set segment [file tail $path] + if {$segment eq "bin"} { + continue + } + set testv "" + if {[string match -nocase $pkgname* $segment]} { + set testv [string range $segment $namelen end] + } elseif {[string match -nocase critcl_$pkgname* $segment]} { + set testv [string range $segment $namelen+7 end] + } + #we don't look for dot in parent/grandparent version - a bare integer here after the will be taken to be the version + if {![catch [list package vcompare $testv $testv]]} { + return $testv + } + } + #review - sometimes path and lib are named only for major.minor but package provides major.minor.subversion + #using returned val to attempt to package require -exact major.minor will fail to load major.minor.subversion + return "" + } +} +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::packagepreference ::punk::packagepreference::system +} -#} # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::packagepreference [tcl::namespace::eval punk::packagepreference { diff --git a/src/modules/punk/path-999999.0a1.0.tm b/src/modules/punk/path-999999.0a1.0.tm index 64e29077..a91c94bb 100644 --- a/src/modules/punk/path-999999.0a1.0.tm +++ b/src/modules/punk/path-999999.0a1.0.tm @@ -651,11 +651,16 @@ namespace eval punk::path { -call-depth-internal -default 0 -type integer -antiglob_paths -default {} -help\ "list of path patterns to exclude - may include * and ** path segments e.g /usr/**" + may include * and ** path segments e.g + /usr/** (exlude subfolders based at /usr but not + files within /usr itself) + **/_aside (exlude files where _aside is last segment) + **/_aside/* (exclude folders one below an _aside folder) + **/_aside/** (exclude all folders with _aside as a segment)" @values -min 0 -max -1 -optional 1 -type string - tailglobs -multiple 1 -help\ + tailglobs -default * -multiple 1 -help\ "Patterns to match against filename portion (last segment) of each file path - within the directory tree being searched." + within the directory tree being searched." } #todo - implement treefiles which acts like dirfiles but allows path globbing in the same way as punk::ns::ns/ @@ -671,29 +676,29 @@ namespace eval punk::path { #[para] list of path patterns to exclude - may include * and ** path segments e.g /usr/** #[para]no natsorting - so order is dependent on filesystem - set argd [punk::args::get_by_id ::punk::path::treefilenames $args] + set argd [punk::args::parse $args withid ::punk::path::treefilenames] lassign [dict values $argd] leaders opts values received - set tailglobs [dict values $values] + set tailglobs [dict get $values tailglobs] # -- --- --- --- --- --- --- set opt_antiglob_paths [dict get $opts -antiglob_paths] set CALLDEPTH [dict get $opts -call-depth-internal] # -- --- --- --- --- --- --- - if {![dict exists $received -directory]} { - set opt_dir [pwd] - } else { - set opt_dir [dict get $opts -directory] - } # -- --- --- --- --- --- --- set files [list] if {$CALLDEPTH == 0} { + #set opts [dict merge $opts [list -directory $opt_dir]] + if {![dict exists $received -directory]} { + set opt_dir [pwd] + } else { + set opt_dir [dict get $opts -directory] + } if {![file isdirectory $opt_dir]} { return [list] } - set opts [dict merge $opts [list -directory $opt_dir]] - if {![llength $tailglobs]} { - lappend tailglobs * - } + } else { + #assume/require to exist in any recursive call + set opt_dir [dict get $opts -directory] } set skip 0 diff --git a/src/modules/punk/pcon-999999.0a1.0.tm b/src/modules/punk/pcon-999999.0a1.0.tm new file mode 100644 index 00000000..6e4d3119 --- /dev/null +++ b/src/modules/punk/pcon-999999.0a1.0.tm @@ -0,0 +1,279 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from -buildversion.txt +# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.3.tm +# +# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. +# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# (C) 2025 +# +# @@ Meta Begin +# Application punk::pcon 999999.0a1.0 +# Meta platform tcl +# Meta license MIT +# @@ Meta End + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# doctools header +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[manpage_begin shellspy_module_punk::pcon 0 999999.0a1.0] +#[copyright "2025"] +#[titledesc {Module API}] [comment {-- Name section and table of contents description --}] +#[moddesc {-}] [comment {-- Description at end of page heading --}] +#[require punk::pcon] +#[keywords module] +#[description] +#[para] - + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section Overview] +#[para] overview of punk::pcon +#[subsection Concepts] +#[para] - + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[subsection dependencies] +#[para] packages used by punk::pcon +#[list_begin itemized] + +package require Tcl 8.6- +#*** !doctools +#[item] [package {Tcl 8.6}] + +# #package require frobz +# #*** !doctools +# #[item] [package {frobz}] + +#*** !doctools +#[list_end] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section API] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# oo::class namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#tcl::namespace::eval punk::pcon::class { + #*** !doctools + #[subsection {Namespace punk::pcon::class}] + #[para] class definitions + #if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} { + #*** !doctools + #[list_begin enumerated] + + # oo::class create interface_sample1 { + # #*** !doctools + # #[enum] CLASS [class interface_sample1] + # #[list_begin definitions] + + # method test {arg1} { + # #*** !doctools + # #[call class::interface_sample1 [method test] [arg arg1]] + # #[para] test method + # puts "test: $arg1" + # } + + # #*** !doctools + # #[list_end] [comment {-- end definitions interface_sample1}] + # } + + #*** !doctools + #[list_end] [comment {--- end class enumeration ---}] + #} +#} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +tcl::namespace::eval punk::pcon { + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + # Base namespace + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + #*** !doctools + #[subsection {Namespace punk::pcon}] + #[para] Core API functions for punk::pcon + #[list_begin definitions] + + + + #proc sample1 {p1 n args} { + # #*** !doctools + # #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] + # #[para]Description of sample1 + # #[para] Arguments: + # # [list_begin arguments] + # # [arg_def tring p1] A description of string argument p1. + # # [arg_def integer n] A description of integer argument n. + # # [list_end] + # return "ok" + #} + + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::pcon ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Secondary API namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +tcl::namespace::eval punk::pcon::lib { + tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase + tcl::namespace::path [tcl::namespace::parent] + #*** !doctools + #[subsection {Namespace punk::pcon::lib}] + #[para] Secondary functions that are part of the API + #[list_begin definitions] + + #proc utility1 {p1 args} { + # #*** !doctools + # #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] + # #[para]Description of utility1 + # return 1 + #} + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::pcon::lib ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[section Internal] +#tcl::namespace::eval punk::pcon::system { + #*** !doctools + #[subsection {Namespace punk::pcon::system}] + #[para] Internal functions that are not part of the API + + + +#} + + +# == === === === === === === === === === === === === === === +# Sample 'about' function with punk::args documentation +# == === === === === === === === === === === === === === === +tcl::namespace::eval punk::pcon { + tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase + variable PUNKARGS + variable PUNKARGS_aliases + + lappend PUNKARGS [list { + @id -id "(package)punk::pcon" + @package -name "punk::pcon" -help\ + "Package + Description" + }] + + namespace eval argdoc { + #namespace for custom argument documentation + proc package_name {} { + return punk::pcon + } + proc about_topics {} { + #info commands results are returned in an arbitrary order (like array keys) + set topic_funs [info commands [namespace current]::get_topic_*] + set about_topics [list] + foreach f $topic_funs { + set tail [namespace tail $f] + lappend about_topics [string range $tail [string length get_topic_] end] + } + #Adjust this function or 'default_topics' if a different order is required + return [lsort $about_topics] + } + proc default_topics {} {return [list Description *]} + + # ------------------------------------------------------------- + # get_topic_ functions add more to auto-include in about topics + # ------------------------------------------------------------- + proc get_topic_Description {} { + punk::args::lib::tstr [string trim { + package punk::pcon + description to come.. + } \n] + } + proc get_topic_License {} { + return "MIT" + } + proc get_topic_Version {} { + return "$::punk::pcon::version" + } + proc get_topic_Contributors {} { + set authors {{Julian Noble }} + set contributors "" + foreach a $authors { + append contributors $a \n + } + if {[string index $contributors end] eq "\n"} { + set contributors [string range $contributors 0 end-1] + } + return $contributors + } + proc get_topic_custom-topic {} { + punk::args::lib::tstr -return string { + A custom + topic + etc + } + } + # ------------------------------------------------------------- + } + + # we re-use the argument definition from punk::args::standard_about and override some items + set overrides [dict create] + dict set overrides @id -id "::punk::pcon::about" + dict set overrides @cmd -name "punk::pcon::about" + dict set overrides @cmd -help [string trim [punk::args::lib::tstr { + About punk::pcon + }] \n] + dict set overrides topic -choices [list {*}[punk::pcon::argdoc::about_topics] *] + dict set overrides topic -choicerestricted 1 + dict set overrides topic -default [punk::pcon::argdoc::default_topics] ;#if -default is present 'topic' will always appear in parsed 'values' dict + set newdef [punk::args::resolved_def -antiglobs -package_about_namespace -override $overrides ::punk::args::package::standard_about *] + lappend PUNKARGS [list $newdef] + proc about {args} { + package require punk::args + #standard_about accepts additional choices for topic - but we need to normalize any abbreviations to full topic name before passing on + set argd [punk::args::parse $args withid ::punk::pcon::about] + lassign [dict values $argd] _leaders opts values _received + punk::args::package::standard_about -package_about_namespace ::punk::pcon::argdoc {*}$opts {*}[dict get $values topic] + } +} +# end of sample 'about' function +# == === === === === === === === === === === === === === === + +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::pcon +} + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide punk::pcon [tcl::namespace::eval punk::pcon { + variable pkg punk::pcon + variable version + set version 999999.0a1.0 +}] +return + +#*** !doctools +#[manpage_end] + diff --git a/src/modules/punk/pcon-buildversion.txt b/src/modules/punk/pcon-buildversion.txt new file mode 100644 index 00000000..545690c6 --- /dev/null +++ b/src/modules/punk/pcon-buildversion.txt @@ -0,0 +1,3 @@ +1.0 +#First line must be a semantic version number +#all other lines are ignored. diff --git a/src/modules/punk/pipe-999999.0a1.0.tm b/src/modules/punk/pipe-999999.0a1.0.tm new file mode 100644 index 00000000..22cdc090 --- /dev/null +++ b/src/modules/punk/pipe-999999.0a1.0.tm @@ -0,0 +1,853 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from -buildversion.txt +# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.3.tm +# +# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. +# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# (C) 2025 +# +# @@ Meta Begin +# Application punk::pipe 999999.0a1.0 +# Meta platform tcl +# Meta license MIT +# @@ Meta End + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# doctools header +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[manpage_begin shellspy_module_punk::pipe 0 999999.0a1.0] +#[copyright "2025"] +#[titledesc {Module API}] [comment {-- Name section and table of contents description --}] +#[moddesc {-}] [comment {-- Description at end of page heading --}] +#[require punk::pipe] +#[keywords module] +#[description] +#[para] - + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section Overview] +#[para] overview of punk::pipe +#[subsection Concepts] +#[para] - + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[subsection dependencies] +#[para] packages used by punk::pipe +#[list_begin itemized] + +package require Tcl 8.6- +#*** !doctools +#[item] [package {Tcl 8.6}] + +# #package require frobz +# #*** !doctools +# #[item] [package {frobz}] + +#*** !doctools +#[list_end] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section API] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# oo::class namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#tcl::namespace::eval punk::pipe::class { + #*** !doctools + #[subsection {Namespace punk::pipe::class}] + #[para] class definitions + #if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} { + #*** !doctools + #[list_begin enumerated] + + # oo::class create interface_sample1 { + # #*** !doctools + # #[enum] CLASS [class interface_sample1] + # #[list_begin definitions] + + # method test {arg1} { + # #*** !doctools + # #[call class::interface_sample1 [method test] [arg arg1]] + # #[para] test method + # puts "test: $arg1" + # } + + # #*** !doctools + # #[list_end] [comment {-- end definitions interface_sample1}] + # } + + #*** !doctools + #[list_end] [comment {--- end class enumeration ---}] + #} +#} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +tcl::namespace::eval punk::pipe { + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + # Base namespace + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + #*** !doctools + #[subsection {Namespace punk::pipe}] + #[para] Core API functions for punk::pipe + #[list_begin definitions] + + + + #proc sample1 {p1 n args} { + # #*** !doctools + # #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] + # #[para]Description of sample1 + # #[para] Arguments: + # # [list_begin arguments] + # # [arg_def tring p1] A description of string argument p1. + # # [arg_def integer n] A description of integer argument n. + # # [list_end] + # return "ok" + #} + + #https://randomascii.wordpress.com/2012/02/25/comparing-floating-point-numbers-2012-edition/ + # + #we can't provide a float comparison suitable for every situation, + #but we should pick something reasonable, keep it stable, and document it. + proc float_almost_equal {a b} { + package require math::constants + set diff [expr {abs($a - $b)}] + if {$diff <= $::math::constants::eps} { + return 1 + } + set A [expr {abs($a)}] + set B [expr {abs($b)}] + set largest [expr {($B > $A) ? $B : $A}] + return [expr {$diff <= $largest * $::math::constants::eps}] + } + + #debatable whether boolean_almost_equal is more surprising than helpful. + #values from a calculation that are extremely close to zero but aren't false could also be surprising - especially if they compare equal numerically + #perhaps a fuzzy-boolean is a step too far for a default - but it's inline with float-comparison for pattern-matching. + #alternatively - use an even more complex classifier? (^&~) ? + proc boolean_almost_equal {a b} { + if {[string is double -strict $a]} { + if {[float_almost_equal $a 0]} { + set a 0 + } + } + if {[string is double -strict $b]} { + if {[float_almost_equal $b 0]} { + set b 0 + } + } + #must handle true,no etc. + expr {($a && 1) == ($b && 1)} + } + + #boolean could be tr, true, y, ye, yes,Yes, 1 , 0 etc. + proc boolean_equal {a b} { + #equivalenttly xnor: expr {!(($a && 1) ^ ($b && 1))} ;# less clear and no discernable timing benefit. + expr {($a && 1) == ($b && 1)} + } + + + proc val [list [list v [lreplace x 0 0]]] {return $v} + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::pipe ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Secondary API namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +tcl::namespace::eval punk::pipe::lib { + tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase + tcl::namespace::path [tcl::namespace::parent] + #*** !doctools + #[subsection {Namespace punk::pipe::lib}] + #[para] Secondary functions that are part of the API + #[list_begin definitions] + + #proc utility1 {p1 args} { + # #*** !doctools + # #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] + # #[para]Description of utility1 + # return 1 + #} + + #map rhs to names suitable to use in pipemcd proc name (whitespace mapping) + # (for .= and = pipecmds) + proc pipecmd_namemapping {rhs} { + #used to build a command from a pattern which could contain :: - we need to map it to keep it a single command in the desired namespace. + #glob chars will prevent us using simple test {[info commands $cmd] eq ""} to test existence + #we could use the test {$cmd in [info commands]} - but mapping away globchars is more robust, allowing the simpler test + #set rhs [string trim $rhs];#ignore all leading & trailing whitespace + set rhs [string trimleft $rhs] + #--- + #REVIEW! + #set rhs [regsub -all {\s{1,}} $rhs {}] ;#collapse all internal whitespace to a single token + #This stops us matching {/@**@x x} vs {/@**@x x} + #--- + + set rhs [tcl::string::map {: ? * [ ] \\ {"} " " } $rhs] + #review - we don't expect other command-incompatible chars such as colon? + return $rhs + } + + # relatively slow on even small sized scripts + #proc arg_is_script_shaped2 {arg} { + # set re {^(\s|;|\n)$} + # set chars [split $arg ""] + # if {[lsearch -regex $chars $re] >=0} { + # return 1 + # } else { + # return 0 + # } + #} + + #exclude quoted whitespace + proc arg_is_script_shaped {arg} { + if {[tcl::string::first \n $arg] >= 0} { + return 1 + } elseif {[tcl::string::first ";" $arg] >= 0} { + return 1 + } elseif {[tcl::string::first " " $arg] >= 0 || [tcl::string::first \t $arg] >= 0} { + lassign [_rhs_tail_split $arg] _ part2 ;#will have part2 if unquoted whitespace found + return [expr {$part2 ne ""}] + } else { + return 0 + } + } + + #split top level of patterns only. + proc _split_patterns_memoized {varspecs} { + set name_mapped [pipecmd_namemapping $varspecs] + set cmdname ::punk::pipecmds::split_patterns::_$name_mapped + if {[info commands $cmdname] ne ""} { + return [$cmdname] + } + set result [_split_patterns $varspecs] + proc $cmdname {} [list return $result] + #debug.punk.pipe.compile {proc $cmdname} 4 + return $result + } + + + #note - empty data after trailing , is ignored. (comma as very last character) + # - fix by documentation only. double up trailing comma e.g ,, if desired to return pattern match plus all at end! + #todo - move to punk::pipe + proc _split_patterns {varspecs} { + + set varlist [list] + # @ @@ - list and dict functions + # / level separator + # # list count, ## dict size + # % string functions + # ! not + set var_terminals [list "@" "/" "#" "%" "!" ">" "<"] ;# (> required for insertionspecs at rhs of = & .= ) + #right bracket ) also ends a var - but is different depending on whether var is array or basic. For array - it forms part of the varname + + #except when prefixed directly by pin classifier ^ + set protect_terminals [list "^"] ;# e.g sequence ^# + #also - an atom usually doesn't need the / as a terminal - because it can't match a missing element unless it's empty string + #ie the one usecase is '/n to match either empty string or missing item at position n. For this one usecase - we miss the capability to atom match paths/urls .. '/usr/local/et' + set in_brackets 0 ;#count depth + set in_atom 0 + set token "" + set end_var_posn -1 ;#first var_terminal encountered within each comma delimited section + set token_index 0 ;#index of terminal char within each token + set indq 0 + set inbraces 0 + set inesc 0 ;#whether last char was backslash (see also punk::escv) + set prevc "" + set char_index 0 + #if {[string index $varspecs end] eq ","} { + # set varspecs [string range $varspecs 0 end-1] + #} + set charcount 0 + foreach c [split $varspecs ""] { + incr charcount + if {$indq} { + if {$inesc} { + #puts stderr "inesc adding '$c'" + append token \\$c + } else { + if {$c eq {"}} { + set indq 0 + } else { + append token $c + } + } + } elseif {$inbraces} { + if {$inesc} { + append token \\$c + } else { + if {$c eq "\}"} { + incr inbraces -1 + if {$inbraces} { + append token $c + } + } elseif {$c eq "\{"} { + incr inbraces + if {$inbraces} { + append token $c + } + } else { + append token $c + } + } + } elseif {$in_atom} { + #ignore dquotes/brackets in atoms - pass through + append token $c + #set nextc [lindex $chars $char_index+1] + if {$c eq "'"} { + set in_atom 0 + } + } elseif {$in_brackets > 0} { + append token $c + if {$c eq ")"} { + incr in_brackets -1 + } + } else { + if {$c eq {"}} { + if {!$inesc} { + set indq 1 + } else { + append token $c + } + } elseif {$c eq "\{"} { + if {!$inesc} { + set inbraces 1 + } else { + append token $c + } + } elseif {$c eq ","} { + #set var $token + #set spec "" + #if {$end_var_posn > 0} { + # #tcl scan with %s will not handle whitespace as desired. Be explicit using string range instead. + # #lassign [scan $token %${end_var_posn}s%s] var spec + # set var [string range $token 0 $end_var_posn-1] + # set spec [string range $token $end_var_posn end] ;#key section includes the terminal char which ended the var and starts the spec + #} else { + # if {$end_var_posn == 0} { + # set var "" + # set spec $token + # } + #} + #lappend varlist [list [string trim $var] [string trim $spec]] + #set token "" + #set token_index -1 ;#reduce by 1 because , not included in next token + #set end_var_posn -1 + } else { + append token $c + switch -exact -- $c { + ' { + set in_atom 1 + } + ( { + incr in_brackets + } + default { + if {$end_var_posn == -1 && (($c in $var_terminals) && ($prevc ni $protect_terminals))} { + set end_var_posn $token_index + } + } + } + } + if {$c eq ","} { + set var $token + set spec "" + if {$end_var_posn > 0} { + #tcl scan with %s will not handle whitespace as desired. Be explicit using string range instead. + #lassign [scan $token %${end_var_posn}s%s] var spec + set var [string range $token 0 $end_var_posn-1] + set spec [string range $token $end_var_posn end] ;#key section includes the terminal char which ended the var and starts the spec + } else { + if {$end_var_posn == 0} { + set var "" + set spec $token + } + } + lappend varlist [list [string trim $var] $spec] + set token "" + set token_index -1 + set end_var_posn -1 + + } + } + + if {$charcount == [string length $varspecs]} { + if {!($indq || $inbraces || $in_atom || $in_brackets)} { + if {$c ne ","} { + set var $token + set spec "" + if {$end_var_posn > 0} { + #tcl scan with %s will not handle whitespace as desired. Be explicit using string range instead. + #lassign [scan $token %${end_var_posn}s%s] var spec + set var [string range $token 0 $end_var_posn-1] + set spec [string range $token $end_var_posn end] ;#key section includes the terminal char which ended the var and starts the spec + } else { + if {$end_var_posn == 0} { + set var "" + set spec $token + } + } + lappend varlist [list [string trim $var] $spec] + set token "" + set token_index -1 + set end_var_posn -1 + } + } + } + + set prevc $c + if {$c eq "\\"} { + #review + if {$inesc} { + set inesc 0 + } else { + set token [string range $token 0 end-1] + set inesc 1 + } + } else { + set inesc 0 + } + incr token_index + incr char_index + } + + #if {[string length $token]} { + # #lappend varlist [splitstrposn $token $end_var_posn] + # set var $token + # set spec "" + # if {$end_var_posn > 0} { + # #lassign [scan $token %${end_var_posn}s%s] var spec + # set var [string range $token 0 $end_var_posn-1] + # set spec [string range $token $end_var_posn end] ;#key section includes the terminal char which ended the var and starts the spec + # } else { + # if {$end_var_posn == 0} { + # set var "" + # set spec $token + # } + # } + # #lappend varlist [list [string trim $var] [string trim $spec]] + # #spec needs to be able to match whitespace too + # lappend varlist [list [string trim $var] $spec] + #} + + return $varlist + } + + #todo - consider whether we can use < for insertion/iteration combinations + # =a<,b< iterate once through + # =a><,b>< cartesian product + # =a<>,b<> ??? zip ? + # + # ie = {a b c} |> .=< inspect + # would call inspect 3 times, once for each argument + # .= list {a b c} {x y z} |a/0,b/1> .=a><,b>< list + # would produce list of cartesian pairs? + # + proc _split_equalsrhs {insertionpattern} { + #map the insertionpattern so we can use faster globless info command search + set name_mapped [pipecmd_namemapping $insertionpattern] + set cmdname ::punk::pipecmds::split_rhs::_$name_mapped + if {[info commands $cmdname] ne ""} { + return [$cmdname] + } + + set lst_var_indexposition [_split_patterns_memoized $insertionpattern] + set i 0 + set return_triples [list] + foreach v_pos $lst_var_indexposition { + lassign $v_pos v index_and_position + #e.g varname@@data/ok>0 varname/1/0>end + #ensure only one ">" is detected + if {![string length $index_and_position]} { + set indexspec "" + set positionspec "" + } else { + set chars [split $index_and_position ""] + set posns [lsearch -all $chars ">"] + if {[llength $posns] > 1} { + error "pipesyntax error in segment insertion pattern '$insertionpattern' -v '$v' multiple '>' characters. Pattern not understood." "_split_equalsrhs $insertionpattern" [list pipesyntax insertionpattern_invalid] + } + if {![llength $posns]} { + set indexspec $index_and_position + set positionspec "" + } else { + set splitposn [lindex $posns 0] + set indexspec [string range $index_and_position 0 $splitposn-1] + set positionspec [string range $index_and_position $splitposn+1 end] + } + } + + #review - + if {($positionspec in [list "*" "/*" "@*" "/" "@"]) || ($v eq "*" && $positionspec eq "")} { + set star "" + if {$v eq "*"} { + set v "" + set star "*" + } + if {[string index $positionspec end] eq "*"} { + set star "*" + } + #it is always possible to insert at end of list regardless of current length - so /end* and @end* are equivalent + #as are /end and @end + #lset lst_var_indexposition $i [list $v "/end$star"] + set triple [list $v $indexspec "/end$star"] + } else { + if {$positionspec eq ""} { + #e.g just =varname + #lset lst_var_indexposition $i [list $v "/end"] + set triple [list $v $indexspec "/end"] + #error "pipesyntax error in segment insertionpattern '$insertionpattern' - v '$v' missing position spec e.g /0" + } else { + if {[string index $indexspec 0] ni [list "" "/" "@"]} { + error "pipesyntax error in segment insertionpattern '$insertionpattern' - v '$v' bad index spec '$indexspec'" "_split_equalsrhs $insertionpattern" [list pipesyntax insertionpattern_invalid] + } + set triple [list $v $indexspec $positionspec] + } + } + lappend return_triples $triple + incr i + } + proc $cmdname {} [list return $return_triples] + return $return_triples + } + + proc _rhs_tail_split {fullrhs} { + set inq 0; set indq 0 + set equalsrhs "" + set i 0 + foreach ch [split $fullrhs ""] { + if {$inq} { + append equalsrhs $ch + if {$ch eq {'}} { + set inq 0 + } + } elseif {$indq} { + append equalsrhs $ch + if {$ch eq {"}} { + set indq 0 + } + } else { + switch -- $ch { + {'} { + set inq 1 + } + {"} { + set indq 1 + } + " " { + #whitespace outside of quoting + break + } + 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - a - b - c - d - e - f - g - h - i - j - k - l - m - n - o - p - q - r - s - t - u - v - w - x - y - z {} + default { + #\t not a literal for switch jumpTable bytecompile - review - can we do it without for example string mapping to (and without a literal binary tab in source file)? + #we can't (reliably?) put \t as one of our switch keys + # + if {$ch eq "\t"} { + break + } + } + } + append equalsrhs $ch + } + incr i + } + set tail [tcl::string::range $fullrhs $i end] + return [list $equalsrhs $tail] + } + + #todo - recurse into bracketed sub parts + #JMN3 + #e.g @*/(x@0,y@2) + proc _var_classify {multivar} { + set cmdname ::punk::pipecmds::var_classify::_[pipecmd_namemapping $multivar] + if {[info commands $cmdname] ne ""} { + return [$cmdname] + } + + + #comma seems a natural choice to split varspecs, + #but also for list and dict subelement access + #/ normally indicates some sort of hierarchical separation - (e.g in filesytems) + #so / will indicate subelements e.g @0/1 for lindex $list 0 1 + #set valsource_key_list [_split_var_key_at_unbracketed_comma $multivar] + set valsource_key_list [_split_patterns_memoized $multivar] + + + + #mutually exclusive - atom/pin + #set map [list "" ' ^ &] ;#0 = default/var/not-yet-determined 1 = atom 2 = pin + #set var_class [lmap var $valsource_key_list {expr {([set m [lsearch $map [string index [lindex $var 0] 0]]] >= 0) ? [list $var $m] : [list $var 0]}}] + #0 - novar + #1 - atom ' + #2 - pin ^ + #3 - boolean & + #4 - integer + #5 - double + #6 - var + #7 - glob (no classifier and contains * or ?) + #8 - numeric + #9 - > (+) + #10 - < (-) + + set var_names [list] + set var_class [list] + set varspecs_trimmed [list] ;#raw varspecs without pin/atom modifiers - or empty string for glob + + + set leading_classifiers [list "'" "&" "^" ] + set trailing_classifiers [list + -] + set possible_number_start [list - + . 0 1 2 3 4 5 6 7 8 9 > <] + + foreach v_key $valsource_key_list { + lassign $v_key v key + set vname $v ;#default + set classes [list] + if {$v eq ""} { + lappend var_class [list $v_key 0] + lappend varspecs_trimmed $v_key + } else { + set lastchar [string index $v end] + switch -- $lastchar { + + { + lappend classes 9 + set vname [string range $v 0 end-1] + } + - { + lappend classes 10 + set vname [string range $v 0 end-1] + } + } + set firstchar [string index $v 0] + switch -- $firstchar { + ' { + lappend var_class [list $v_key 1] + #set vname [string range $v 1 end] + lappend varspecs_trimmed [list $vname $key] + } + ^ { + lappend classes [list 2] + #use vname - may already have trailing +/- stripped + set vname [string range $vname 1 end] + set secondclassifier [string index $v 1] + switch -- $secondclassifier { + "&" { + #pinned boolean + lappend classes 3 + set vname [string range $v 2 end] + } + "#" { + #pinned numeric comparison instead of string comparison + #e.g set x 2 + # this should match: ^#x.= list 2.0 + lappend classes 8 + set vname [string range $vname 1 end] + } + "*" { + #pinned glob + lappend classes 7 + set vname [string range $v 2 end] + } + } + #todo - check for second tag - & for pinned boolean? + #consider requiring ^# for numeric comparisons. currently no way to do a strictly string comparison on pinned variables.... default ^var really shouldn't be doing any magic. + #while we're at it.. pinned glob would be nice. ^* + #maybe even pinned scan ^% ? regex? ^/ or ^? these would be hard to have corresponding literals in the pattern mini-lang. + #These all limit the range of varnames permissible - which is no big deal. + lappend var_class [list $v_key $classes] + lappend varspecs_trimmed [list $vname $key] + } + & { + #we require boolean literals to be single-quoted so we can use cross-binding on boolean vars. + #ie &true is the variable true whereas &'true' or &'1' &'t' etc are literal booleans + #allow exception of &1 &0 to be literal booleans - because we disallow 0 & 1 as varnames in other contexts anyway - so it would be more consistent not to treat as varnames here. + lappend var_class [list $v_key 3] + set vname [string range $v 1 end] + lappend varspecs_trimmed [list $vname $key] + } + default { + if {([string first ? $v]) >=0 || ([string first * $v] >=0)} { + lappend var_class [list $v_key 7] ;#glob + #leave vname as the full glob + lappend varspecs_trimmed [list "" $key] + } else { + #scan vname not v - will either be same as v - or possibly stripped of trailing +/- + set numtestv [join [scan $vname %lld%s] ""] ;# handles octals (leading zeros), ok for use with bignums, decimal points and sci notation - fails to handle leading dot e.g .5 + #leading . still need to test directly for double + if {[string is double -strict $vname] || [string is double -strict $numtestv]} { + if {[string is integer -strict $numtestv]} { + #this will pick up boolean 1 or 0 - but that's ok - they require "&" marker if boolean comparison desired + #integer test before double.. + #note there is also string is wide (string is wideinteger) for larger ints.. + lappend classes 4 + lappend var_class [list $v_key $classes] + lappend varspecs_trimmed $v_key + } else { + #double + #sci notation 1e123 etc + #also large numbers like 1000000000 - even without decimal point - (tcl bignum) + lappend classes 5 + lappend var_class [list $v_key $classes] + lappend varspecs_trimmed $v_key + } + } else { + lappend var_class [list $v_key 6] ;#var + lappend varspecs_trimmed $v_key + } + } + } + } + } + lappend var_names $vname + } + + set result [list var_names $var_names var_class $var_class varspecs_trimmed $varspecs_trimmed] + + proc $cmdname {} [list return $result] + #JMN + #debug.punk.pipe.compile {proc $cmdname} + return $result + } + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::pipe::lib ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[section Internal] +#tcl::namespace::eval punk::pipe::system { + #*** !doctools + #[subsection {Namespace punk::pipe::system}] + #[para] Internal functions that are not part of the API + + + +#} + + +# == === === === === === === === === === === === === === === +# Sample 'about' function with punk::args documentation +# == === === === === === === === === === === === === === === +tcl::namespace::eval punk::pipe { + tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase + variable PUNKARGS + variable PUNKARGS_aliases + + lappend PUNKARGS [list { + @id -id "(package)punk::pipe" + @package -name "punk::pipe" -help\ + "Package + Description" + }] + + namespace eval argdoc { + #namespace for custom argument documentation + proc package_name {} { + return punk::pipe + } + proc about_topics {} { + #info commands results are returned in an arbitrary order (like array keys) + set topic_funs [info commands [namespace current]::get_topic_*] + set about_topics [list] + foreach f $topic_funs { + set tail [namespace tail $f] + lappend about_topics [string range $tail [string length get_topic_] end] + } + return $about_topics + } + proc default_topics {} {return [list Description outline *]} + + # ------------------------------------------------------------- + # get_topic_ functions add more to auto-include in about topics + # ------------------------------------------------------------- + proc get_topic_Description {} { + punk::args::lib::tstr [string trim { + punk pipeline features + } \n] + } + proc get_topic_License {} { + return "MIT" + } + proc get_topic_Version {} { + return $::punk::pipe::version + } + proc get_topic_Contributors {} { + set authors {{Julian Noble }} + set contributors "" + foreach a $authors { + append contributors $a \n + } + if {[string index $contributors end] eq "\n"} { + set contributors [string range $contributors 0 end-1] + } + return $contributors + } + proc get_topic_outline {} { + punk::args::lib::tstr -return string { + todo.. + } + } + # ------------------------------------------------------------- + } + + # we re-use the argument definition from punk::args::standard_about and override some items + set overrides [dict create] + dict set overrides @id -id "::punk::pipe::about" + dict set overrides @cmd -name "punk::pipe::about" + dict set overrides @cmd -help [string trim [punk::args::lib::tstr { + About punk::pipe + }] \n] + dict set overrides topic -choices [list {*}[punk::pipe::argdoc::about_topics] *] + dict set overrides topic -choicerestricted 1 + dict set overrides topic -default [punk::pipe::argdoc::default_topics] ;#if -default is present 'topic' will always appear in parsed 'values' dict + set newdef [punk::args::resolved_def -antiglobs -package_about_namespace -override $overrides ::punk::args::package::standard_about *] + lappend PUNKARGS [list $newdef] + proc about {args} { + package require punk::args + #standard_about accepts additional choices for topic - but we need to normalize any abbreviations to full topic name before passing on + set argd [punk::args::parse $args withid ::punk::pipe::about] + lassign [dict values $argd] _leaders opts values _received + punk::args::package::standard_about -package_about_namespace ::punk::pipe::argdoc {*}$opts {*}[dict get $values topic] + } +} +# end of sample 'about' function +# == === === === === === === === === === === === === === === + +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::pipe +} + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide punk::pipe [tcl::namespace::eval punk::pipe { + variable pkg punk::pipe + variable version + set version 999999.0a1.0 +}] +return + +#*** !doctools +#[manpage_end] + diff --git a/src/modules/punk/pipe-buildversion.txt b/src/modules/punk/pipe-buildversion.txt new file mode 100644 index 00000000..545690c6 --- /dev/null +++ b/src/modules/punk/pipe-buildversion.txt @@ -0,0 +1,3 @@ +1.0 +#First line must be a semantic version number +#all other lines are ignored. diff --git a/src/modules/punk/repl-0.1.tm b/src/modules/punk/repl-0.1.tm index 63b82f02..354fa005 100644 --- a/src/modules/punk/repl-0.1.tm +++ b/src/modules/punk/repl-0.1.tm @@ -83,6 +83,8 @@ namespace eval repl { namespace eval punk::repl { tsv::set repl runid 0 + + #todo - key on shell/subshell tsv::set repl runchunks-0 [list] ;#last_run_display @@ -312,23 +314,38 @@ proc punk::repl::reset_terminal {} { } proc punk::repl::get_prompt_config {} { - if {$::tcl_interactive} { - set RST [a] - set resultprompt "[a green bold]-$RST " - set nlprompt "[a green bold].$RST " - set infoprompt "[a green bold]*$RST " - set debugprompt "[a purple bold]~$RST " + if {[catch {punk::console::vt52} is_vt52]} { + set is_vt52 0 + } + if {$is_vt52} { + set resultprompt "52-" + set nlprompt "52." + set infoprompt "52*" + set debugprompt "52~" } else { - set resultprompt "" - set nlprompt "" - set infoprompt "" - set debugprompt "" + if {$::tcl_interactive} { + set RST [a] + set resultprompt "[a green bold]-$RST " + set nlprompt "[a green bold].$RST " + set infoprompt "[a green bold]*$RST " + set debugprompt "[a purple bold]~$RST " + } else { + set resultprompt "" + set nlprompt "" + set infoprompt "" + set debugprompt "" + } } return [list resultprompt $resultprompt nlprompt $nlprompt infoprompt $infoprompt debugprompt $debugprompt] } proc repl::start {inchan args} { puts stderr "-->repl::start $inchan $args" + upvar ::punk::console::input_chunks_waiting input_chunks_waiting + if {![info exists input_chunks_waiting($inchan)]} { + set input_chunks_waiting($inchan) [list] + } + variable codethread #review if {$codethread eq ""} { @@ -356,7 +373,12 @@ proc repl::start {inchan args} { } incr startinstance set loopinstance 0 - thread::send $codethread { + if {[info exists ::punk::ns::ns_current]} { + set start_in_ns $::punk::ns::ns_current + } else { + set start_in_ns :: + } + thread::send $codethread [string map [list %ns1% $start_in_ns] { #set ::punk::repl::codethread::running 1 #the interp in which commands such as d/ run @@ -366,9 +388,9 @@ proc repl::start {inchan args} { namespace eval ::punk::repl::codethread {} set ::punk::repl::codethread::running 1 namespace eval ::punk::ns::ns_current {} - set ::punk::ns::ns_current :: + set ::punk::ns::ns_current %ns1% } - } + }] set commandstr "" # --- @@ -385,14 +407,15 @@ proc repl::start {inchan args} { set ::punk::console::ansi_wanted -1 } } + puts stderr "-->repl::start active on $inchan $args replthread:[thread::id] codethread:$codethread" set prompt_config [punk::repl::get_prompt_config] doprompt "P% " fileevent $inchan readable [list [namespace current]::repl_handler $inchan $prompt_config] set reading 1 - catch { - #set punk::console::tabwidth [punk::console::get_tabstop_apparent_width] - } + #catch { + # set punk::console::tabwidth [punk::console::get_tabstop_apparent_width] + #} vwait [namespace current]::done fileevent $inchan readable {} @@ -900,7 +923,11 @@ namespace eval punk::repl::class { append debug \n "input:[ansistring VIEW -lf 1 -vt 1 $new0] before row:$o_cursor_row after row: $result_row before col:$o_cursor_col after col:$result_col" package require textblock set debug [textblock::frame -checkargs 0 -buildcache 0 $debug] - catch {punk::console::move_emitblock_return $debug_first_row 1 $debug} + if {![punk::console::vt52]} { + catch {punk::console::move_emitblock_return $debug_first_row 1 $debug} + } else { + #?? + } # -- --- --- --- --- --- set o_cursor_col $result_col @@ -1363,8 +1390,9 @@ proc repl::repl_handler {inputchan prompt_config} { lappend input_chunks_waiting($inputchan) $chunk } } else { - if {[fblocked $inputchan]} { - #REVIEW - need to und + #'chan blocked' docs state: 'Note that this only ever returns 1 when the channel has been configured to be non-blocking..' + if {[chan blocked $inputchan]} { + #REVIEW - #todo - figure out why we're here. #can we even put a spinner so we don't keep emitting lines? We probably can't use any ansi functions that need to get a response on stdin..(like get_cursor_pos) #punk::console::get_size is problematic if -winsize not available on the stdout channel - which is the case for certain 8.6 versions at least.. platform variances? @@ -1372,9 +1400,9 @@ proc repl::repl_handler {inputchan prompt_config} { set outconf [chan configure stdout] set RED [punk::ansi::a+ red bold]; set RST [punk::ansi::a] if {"windows" eq $::tcl_platform(platform)} { - set msg "${RED}$inputchan fblocked is true. (line-length Tcl windows channel bug?)$RST \{$allwaiting\}" + set msg "${RED}$inputchan chan blocked is true. (line-length Tcl windows channel bug?)$RST \{$allwaiting\}" } else { - set msg "${RED}$inputchan fblocked is true.$RST \{$allwaiting\}" + set msg "${RED}$inputchan chan blocked is true.$RST \{$allwaiting\}" } set cols "" set rows "" @@ -1483,6 +1511,11 @@ proc repl::repl_handler {inputchan prompt_config} { chan configure $inputchan -translation lf } set chunk [read $inputchan] + #we expect a chan configured with -blocking 0 to be blocked immediately after reads + #test - just bug console for now - try to understand when/how/if a non blocking read occurs. + if {![chan blocked $inputchan]} { + puts stderr "repl_handler->$inputchan not blocked after read" + } punk::repl::repl_handler_restorechannel_if_not_eof $inputchan $original_input_conf uplevel #0 [list repl::repl_process_data $inputchan raw-read $chunk [list] $prompt_config] @@ -1532,6 +1565,10 @@ interp alias {} editbuf {} ::punk::repl::editbuf proc punk::repl::console_debugview {editbuf consolewidth args} { + if {[punk::console::vt52]} { + #topleft? + return [dict create width 0 height 0 topleft 0] + } package require textblock variable debug_repl if {$debug_repl <= 0} { @@ -1578,19 +1615,24 @@ proc punk::repl::console_debugview {editbuf consolewidth args} { set debug_width [textblock::widthtopline $info] set patch_height [expr {2 + $debug_height + 2}] set spacepatch [textblock::block $debug_width $patch_height " "] - puts -nonewline [punk::ansi::cursor_off] + #puts -nonewline [punk::ansi::cursor_off] + punk::console::cursor_off #use non cursorsave versions - cursor save/restore will interfere with any concurrent ansi rendering that uses save/restore - because save/restore is a single item, not a stack. set debug_offset [expr {$consolewidth - $debug_width - $opt_rightmargin}] set row_clear [expr {$opt_row -2}] punk::console::move_emitblock_return $row_clear $debug_offset $spacepatch punk::console::move_emitblock_return $opt_row $debug_offset $info set topleft [list $debug_offset $opt_row] ;#col,row REVIEW - puts -nonewline [punk::ansi::cursor_on] + #puts -nonewline [punk::ansi::cursor_on] + punk::console::cursor_on flush stdout return [dict create width $debug_width height $debug_height topleft $topleft] } proc punk::repl::console_editbufview {editbuf consolewidth args} { + if {[punk::console::vt52]} { + return [dict create width 0] + } package require textblock upvar ::repl::editbuf_list editbuf_list @@ -1647,6 +1689,12 @@ proc punk::repl::console_controlnotification {message consolewidth consoleheight } proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config} { + if {[info exists ::punk::console::is_vt52]} { + set is_vt52 $::punk::console::is_vt52 + } else { + set is_vt52 0 + } + variable loopinstance incr loopinstance upvar ::punk::console::input_chunks_waiting input_chunks_waiting @@ -1765,25 +1813,28 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config error "character 03 -> ctrl-c" } - - #review - configurable? - #translate raw del to backspace del for those terminals that send plain del if {$chunk eq "\x7f"} { + #review - configurable? + #translate raw del to backspace del for those terminals that send plain del set chunk "\b\x7f" - } - #ctrl-bslash - if {$chunk eq "\x1c"} { + } elseif {$chunk eq "\x7f\x7f"} { + #commonly if key held down we will get 2 dels in a row + #review - could get more in a row depending on hardware/os + set chunk "\b\x7f\b\x7f" + } elseif {$chunk eq "\x1c"} { + #ctrl-bslash #try to brutally terminate process #attempt to leave terminal in a reasonable state - punk::mode line + mode line ;#may be aliased to ::repl::interphelpers::mode after 250 {exit 42} return - } - #for now - exit with small delay for tidyup - #ctrl-z - if {$chunk eq "\x1a"} { + } elseif {$chunk eq "\x1a"} { + #for now - exit with small delay for tidyup + #ctrl-z #::punk::repl::handler_console_control "ctrl-z_via_rawloop" - punk::mode line + if {[catch {mode line}]} { + interp eval code {mode line} + } after 1000 {exit 43} return } @@ -1802,7 +1853,8 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config #-------------------------- # editbuf and debugview rhs frames - if {[set ::punk::console::ansi_available]} { + #for now disable entirely on vt52 - we can only do cursor save restore - nothing that requires responses on stdin (?) + if {!$is_vt52 && [set ::punk::console::ansi_available]} { #experimental - use punk::console::get_size to determine current visible width. #This should ideally be using sigwinch or some equivalent to set a value somewhere. #testing each time is very inefficient (1+ms) @@ -1811,7 +1863,14 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config set consolewidth 132 if {$do_checkwidth} { if {[catch {set consolewidth [dict get [punk::console::get_size] columns]} errM]} { - puts stderr "repl_process_data failed on call to punk::console::get_size :$errM" + #review + if {!$is_vt52} { + puts stderr "repl_process_data failed on call to punk::console::get_size :$errM" + } + } + #if chan conf stdout doesn't give dimensions and console doesn't respond to queries - we can get empty results in get_size dict + if {$consolewidth eq ""} { + set consolewidth 132 } } set debug_width 0 @@ -1850,14 +1909,25 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config set leftmargin 3 - puts -nonewline stdout [a+ cyan][punk::ansi::move_column [expr {$leftmargin +1}]][punk::ansi::erase_eol][$editbuf line $cursor_row][a][punk::ansi::move_column [expr {$leftmargin + [$editbuf cursor_column]}]] + if {!$is_vt52} { + puts -nonewline stdout [a+ cyan][punk::ansi::move_column [expr {$leftmargin +1}]][punk::ansi::erase_eol][$editbuf line $cursor_row][a][punk::ansi::move_column [expr {$leftmargin + [$editbuf cursor_column]}]] + } else { + puts -nonewline stdout [a+ cyan][punk::ansi::vt52move_column [expr {$leftmargin +1}]][punk::ansi::vt52erase_eol][$editbuf line $cursor_row][punk::ansi::vt52move_column [expr {$leftmargin + [$editbuf cursor_column]}]] + } #puts -nonewline stdout $chunk flush stdout if {[$editbuf last_char] eq "\n"} { set linelen [punk::ansi::printing_length [$editbuf line $nextsubmit_line_num]] - puts -nonewline stdout [a+ cyan bold][punk::ansi::move_column [expr {$leftmargin +1}]][$editbuf line $nextsubmit_line_num][a][punk::ansi::move_column [expr {$leftmargin + $linelen +1}]] - #screen_last_char_add "\n" input inputline - puts -nonewline stdout [punk::ansi::erase_eol]\n + if {!$is_vt52} { + puts -nonewline stdout [a+ cyan bold][punk::ansi::move_column [expr {$leftmargin +1}]][$editbuf line $nextsubmit_line_num][a][punk::ansi::move_column [expr {$leftmargin + $linelen +1}]] + #screen_last_char_add "\n" input inputline + puts -nonewline stdout [punk::ansi::erase_eol]\n + } else { + puts -nonewline stdout [a+ cyan bold][punk::ansi::vt52move_column [expr {$leftmargin +1}]][$editbuf line $nextsubmit_line_num][punk::ansi::vt52move_column [expr {$leftmargin + $linelen +1}]] + puts -nonewline stdout [punk::ansi::vt52erase_eol]\n + } + + #puts -nonewline stdout \n screen_last_char_add "\n" input inputline set waiting [$editbuf line end] @@ -2077,6 +2147,9 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config set repl_runid [tsv::incr repl runid] tsv::set repl runchunks-$repl_runid [list] ;#last_run_display catch { + #REVIEW - when we launch a subshell and run more than 10 commands, + #we delete runchunks from the outer shell that we'll return to! + #we should use a toplevel key pertaining to the shell/subshell instead of just 'repl' tsv::unset repl runchunks-[expr {$repl_runid - 10}] } @@ -2530,6 +2603,8 @@ proc repl::completion {context ebuf} { } namespace eval repl { + + proc init {args} { if {![info exists ::argv0]} { #error out before we create a thread - punk requires this - review @@ -2579,21 +2654,20 @@ namespace eval repl { error "repl:init codethread: $codethread already exists. use -force 1 to override" } set codethread [thread::create -preserved] - #review - naming of the possibly 2 cond variables parent and child thread - set codethread_cond [thread::cond create] ;#repl::codethread_cond held by parent(repl) vs punk::repl::codethread::replthread_cond held by child(codethread) - set codethread_mutex [thread::mutex create] + set codethread_cond [thread::cond create] ;#repl::codethread_cond held by parent(repl) vs punk::repl::codethread::replthread_cond held by child(codethread) + set codethread_mutex [thread::mutex create] set init_script [string map [list %args% [list $opts]\ - %argv0% [list $::argv0]\ - %argv% [list $::argv]\ - %argc% [list $::argc]\ - %replthread% [thread::id]\ + %argv0% [list $::argv0]\ + %argv% [list $::argv]\ + %argc% [list $::argc]\ + %replthread% [thread::id]\ %replthread_cond% $codethread_cond\ %replthread_interp% [list $opt_callback_interp]\ - %tmlist% [list [tcl::tm::list]]\ - %autopath% [list $::auto_path]\ + %tmlist% [list [tcl::tm::list]]\ + %autopath% [list $::auto_path]\ ] { set ::argv0 %argv0% set ::argv %argv% @@ -2711,6 +2785,9 @@ namespace eval repl { } #todo - add/remove shellfilter stacked ansiwrap } + proc vt52 {args} { + return [thread::send %replthread% [list punk::console::vt52 {*}$args]] + } proc mode args { #with tsv::set console is_raw we don't need to call mode in both the replthread and the codethread # REVIEW - call in local interp? how about if codethread is safe interp? @@ -2735,6 +2812,15 @@ namespace eval repl { proc md5 args { ::md5::md5 {*}$args } + proc fconfigure {args} { + code invokehidden fconfigure {*}$args + } + proc fnormalize name { + code invokehidden tcl:file:normalize $name + } + proc fdirname name { + code invokehidden tcl:file:dirname $name + } } namespace eval ::repl::interpextras { #install using safe::setLogCmd @@ -2775,32 +2861,44 @@ namespace eval repl { namespace export {[a-z]*} namespace ensemble create proc punk {} { - interp eval code { + set ts_start [clock seconds] + set replresult [interp eval code { package require punk::repl repl::init -safe punk repl::start stdin - } + }] + return [list replresult $replresult elapsed [expr {[clock seconds]-$ts_start}]] } proc safe {args} { + set ts_start [clock seconds] interp eval code { package require punk::repl } - interp eval code [list repl::init -safe safe {*}$args] - interp eval code [list repl::start stdin] + interp eval code [list repl::init -safe safe {*}$args] + set replresult [interp eval code [list repl::start stdin]] + + return [list replresult $replresult elapsed [expr {[clock seconds]-$ts_start}]] } proc safebase {args} { + set ts_start [clock seconds] interp eval code { package require punk::repl } - interp eval code [list repl::init -safe safebase {*}$args] - interp eval code [list repl::start stdin] + set codethread [interp eval code [list repl::init -safe safebase {*}$args]] + puts stdout "safebase codethread:$codethread" + set replresult [interp eval code [list repl::start stdin]] + + return [list replresult $replresult elapsed [expr {[clock seconds]-$ts_start}]] } proc punksafe {args} { + set ts_start [clock seconds] interp eval code { package require punk::repl } - interp eval code [list repl::init -safe punksafe {*}$args] - interp eval code [list repl::start stdin] + interp eval code [list repl::init -safe punksafe {*}$args] + set replresult [interp eval code [list repl::start stdin]] + + return [list replresult $replresult elapsed [expr {[clock seconds]-$ts_start}]] } } # -- --- --- --- --- @@ -2819,24 +2917,173 @@ namespace eval repl { switch -- $safe { safe { interp create -safe -- code + package require punk::args + } + safebase { + safe::interpCreate code -nested 1 -autoPath %autopath% + code alias "file normalize" "file normalize" + code alias "file dirname" "file dirname" + code alias "file exists" "file exists" + code alias ::tcl::file::normalize ::tcl::file::normalize + code alias ::tcl::file::dirname ::tcl::file::dirname + code alias ::tcl::file::exists ::tcl::file::exists + #code alias ::punk::console::colour ::punk::console::colour + } + punksafe { + #less safe than safebase - we need file normalize and info script to handle modpod? + package require punk::safe + punk::safe::interpCreate code -autoPath %autopath% + code alias "file normalize" "file normalize" + code alias "file dirname" "file dirname" + code alias "file exists" "file exists" + code alias ::tcl::file::normalize ::tcl::file::normalize + code alias ::tcl::file::dirname ::tcl::file::dirname + code alias ::tcl::file::exists ::tcl::file::exists + code alias ::punk::console::colour ::punk::console::colour + } + punk - 0 { + interp create code + } + punkisland { + #todo + #when no island paths specified - should be like safebase, but without folder hiding and with expanded read to ::auto_path folders + } + } + + interp eval code { + namespace eval codeinterp { + variable errstack {} + variable outstack {} + variable run_command_cache + proc set_clone {varname obj} { + append obj2 $obj {} + uplevel 1 [list set $varname $obj2] + } + } + } + + switch -- $safe { + safe { if {[llength $paths]} { package require punk::island foreach p $paths { punk::island::add code $p } } + interp share "" stdout code + interp share "" stderr code + interp share "" stdin code ;#needed for ANSI queries + + set codehidden [code hidden] + code alias file file + if {"source" in $codehidden} { + code expose source + } + if {"encoding" in $codehidden} { + code expose encoding ;#leave enabled + } + if {"tcl:encoding:system" in $codehidden} { + code expose tcl:encoding:system + code eval {rename ::tcl::encoding::system ""} + code eval {rename tcl:encoding:system ::tcl::encoding::system} + } + #interp alias is available in safe - so it seems unreasonable to disallow 'info cmdtype' + if {"tcl:info:cmdtype" in $codehidden} { + code eval {rename ::tcl::info::cmdtype ""} + code expose tcl:info:cmdtype + code eval {rename tcl:info:cmdtype ::tcl::info::cmdtype} + } + set pkgs [list\ + punk::args\ + punk::pipe\ + cmdline\ + struct::list\ + struct::set\ + textutil::wcswidth\ + textutil::trim\ + textutil::repeat\ + textutil::tabify\ + textutil::split\ + textutil::string\ + textutil::adjust\ + textutil\ + punk::encmime\ + punk::char\ + punk::assertion\ + punk::ansi\ + punk::lib\ + overtype\ + dictutils\ + debug\ + punk::ns\ + textblock\ + punk::args::tclcore\ + punk::aliascore\ + ] + + #pattern looks up versions available of patternlib before loading (but we don't have an index for tm files) todo fix pattern. + # patterncmd\ + # metaface\ + # patternpredator2\ + # patternlib\ + # pattern + + # - no longer required by textblock + # term::ansi::code\ + # term::ansi::code::attr\ + # term::ansi::code::ctrl\ + # term::ansi::code::macros + + #---------- + #all this scanning and loading core packages - we should possibly cache the file data for other interps? + #make sure codethread has scanned for packages - must do for each namespace level + #catch {package require flubber_nonexistent} + set ns_scanned [dict create] + #---------- + set prior_infoscript [code eval {info script}] ;#probably empty that's ok + foreach pkg $pkgs { + if {[catch { + set nsquals [namespace qualifiers $pkg] + if {$nsquals ne ""} { + if {![dict exists $ns_scanned $nsquals]} { + catch {package require ${nsquals}::flubber_nonexistant} ;#force scan + dict set ns_scanned $nsquals 1 + } + } + set versions [lsort -command {package vcompare} [package versions $pkg]] + if {[llength $versions]} { + set v [lindex $versions end] + set path [lindex [package ifneeded $pkg $v] end] + if {[file extension $path] in {.tcl .tm}} { + if {[file exists $path]} { + set data [readFile $path] + code eval [list info script $path] + code eval $data + code eval [list info script $prior_infoscript] + } else { + error "safe - failed to find $path" + } + } else { + error "safe - refusing to attempt load of $pkg from $path - (allowed extensions .tcl .tm)" + } + } else { + error "safe - no versions of $pkg found" + } + } errMsg]} { + puts stderr "safe - failed to load package $pkg\n$errMsg\n$::errorInfo" + } else { + #puts stdout "safe - loaded $pkg from $path" + } + } + code alias file "" + code hide source + #review argv0,argv,argc - interp eval code { - namespace eval ::codeinterp { - variable errstack {} - variable outstack {} - } - set ::argv0 %argv0% - set ::auto_path %autopath% - #puts stdout "safe interp" - #flush stdout - } + #interp eval code { + # set ::argv0 %argv0% + # set ::auto_path %autopath% + #} interp eval code [list set ::tcl_platform(os) $::tcl_platform(os)] interp eval code [list set ::tcl_platform(osVersion) $::tcl_platform(osVersion)] interp eval code [list set ::tcl_platform(machine) $::tcl_platform(machine)] @@ -2851,12 +3098,18 @@ namespace eval repl { interp share {} [shellfilter::stack::item_tophandle stderr] code } + #review + code alias ::shellfilter::stack ::shellfilter::stack + #code alias ::punk::lib::set_clone ::punk::lib::set_clone + #code alias ::aliases ::punk::lib::aliases + code alias ::punk::lib::aliases ::punk::lib::aliases + namespace eval ::codeinterp {} + code alias ::md5::md5 ::repl::interphelpers::md5 code alias exit ::repl::interphelpers::quit } safebase { #safebase - safe::interpCreate code -nested 1 -autopath %autopath% #safe::setLogCmd ::repl::interpextras::safe_msg ;#using setLogcmd early will show the auto_path notice - which is *verbose* #while it may conceivably be useful in debugging safe itself - auto_path and tcl::tm::list can be inspected to show these values in the safe interp itself anyway - so early logging is of limited utility here. if {[llength $paths]} { @@ -2871,15 +3124,13 @@ namespace eval repl { set ::argv {} #puts stdout "safebase interp" #flush stdout - namespace eval ::codeinterp { - variable errstack {} - variable outstack {} - } } interp eval code [list set ::tcl_platform(os) $::tcl_platform(os)] interp eval code [list set ::tcl_platform(osVersion) $::tcl_platform(osVersion)] interp eval code [list set ::tcl_platform(machine) $::tcl_platform(machine)] + code alias ::fconfigure ::repl::interphelpers::fconfigure ;#needed for shellfilter + #code invokehidden package require punk::lib if {"stdout" in [chan names]} { interp share {} stdout code @@ -2893,7 +3144,7 @@ namespace eval repl { } interp eval code { package require punk::lib - package require textblock ;#may fail to load term::ansi::code::macros - (only required for altg) + package require textblock } #JMN @@ -2926,60 +3177,65 @@ namespace eval repl { code alias exit ::repl::interphelpers::quit code alias ::md5::md5 ::repl::interphelpers::md5 - code alias ::fconfigure ::fconfigure ;#needed for shellfilter code alias ::file ::file interp eval code [list package provide md5 $md5version] } - punk - 0 { - interp create code + punksafe { interp eval code { - #safe !=1 and safe !=2, tmlist: %tmlist% - set ::argv0 %argv0% - set ::argv %argv% - set ::argc %argc% - set ::auto_path %autopath% - tcl::tm::remove {*}[tcl::tm::list] - tcl::tm::add {*}[lreverse %tmlist%] - #puts "code interp chan names-->[chan names]" - namespace eval ::codeinterp { - variable errstack {} - variable outstack {} - variable run_command_cache - } + set ::argv0 %argv0% + set ::argc 0 + set ::argv {} + #set ::auto_path %autopath% ;#jmn + #tcl::tm::remove {*}[tcl::tm::list] + #tcl::tm::add {*}[lreverse %tmlist%] + } + interp eval code [list set ::tcl_platform(os) $::tcl_platform(os)] + interp eval code [list set ::tcl_platform(osVersion) $::tcl_platform(osVersion)] + interp eval code [list set ::tcl_platform(machine) $::tcl_platform(machine)] - # -- --- - #review - #we have to blow some time on a rescan to provide more deterministic ordering (match behaviour of initial thread regarding pkg precedence) - #review - can we speed that scan up? - ##catch {package require flobrudder-nonexistant} - # -- --- + code alias ::fconfigure ::repl::interphelpers::fconfigure ;#needed for shellfilter + + if {"stdout" in [chan names]} { + interp share {} stdout code + } else { + interp share {} [shellfilter::stack::item_tophandle stdout] code + } + if {"stderr" in [chan names]} { + interp share {} stderr code + } else { + interp share {} [shellfilter::stack::item_tophandle stderr] code + } + + interp eval code { + package require punk::lib + package require punk::args + package require punk::args::tclcore + package require textblock + } + + interp eval code { if {[catch { - package require vfs - package require vfs::zip - } errM]} { - puts stderr "repl code interp can't load vfs,vfs::zip" + #package require packagetrace + #packagetrace::init + } errM]} { + puts stderr "========================" + puts stderr "code interp error 1:" + puts stderr $errM + puts stderr $::errorInfo + puts stderr "========================" + #error "$errM" } + } - #puts stderr ----- - #puts stderr [join $::auto_path \n] - #puts stderr ----- + interp eval code { if {[catch { - package require punk::config - package require punk::ns - #puts stderr "loading natsort" - #natsort has 'application mode' which can exit. - #Requiring it shouldn't trigger application - but zipfs/vfs interactions confused it in some early versions - package require natsort - #catch {package require packageTrace} - package require punk - package require punk::args - package require punk::args::tclcore - package require shellrun - package require shellfilter + package require punk::config ;#requires: none + #package require punk::console ;#requires: Thread,punk::ansi,punk::args #set running_config $::punk::config::running + package require shellfilter ;#requires: shellthread,Thread apply {running_config { if {[string length [dict get $running_config color_stderr]] && [punk::console::colour]} { lappend ::codeinterp::errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr]]] @@ -2989,63 +3245,85 @@ namespace eval repl { } }} $::punk::config::running - package require textblock - } errM]} { + } errM]} { puts stderr "========================" - puts stderr "code interp error:" + puts stderr "code interp error 2:" puts stderr $errM puts stderr $::errorInfo puts stderr "========================" error "$errM" } } + + interp eval code { + if {[catch { + + #puts stderr "loading natsort" + #natsort has 'application mode' which can exit. + #Requiring it shouldn't trigger application - but zipfs/vfs interactions confused it in some early versions + package require natsort + + #package require punk ;# Thread + #package require shellrun ;#subcommand exists of file + + + #----------------------------------------------------------------------------------------------------------------------------------------- + package require punk::ns ;#requires:punk::lib,punk::args,struct::list,cmdline+(tcllibc),struct::set,punk::ansi,punk::char, + #textutil,textutil::string,textutil::adjust,textutil::repeat,textutil::string,textutil::split,textutil::tabify,textutil::wcswidth + #punk::encmime,punk::assertion + #twapi,platform,registry,debug,overtype,patternpunk,pattern,patterncmd,metaface,patternpredator2,patternlib,dictutils + #----------------------------------------------------------------------------------------------------------------------------------------- + + #package require textblock + } errM]} { + puts stderr "========================" + puts stderr "code interp error 3:" + puts stderr $errM + puts stderr $::errorInfo + puts stderr "========================" + error "$errM" + } + + } + } - punksafe { - package require punk::safe - punk::safe::interpCreate code -autoPath %auto_path% + punk - 0 { interp eval code { - set ::argv0 %argv0% - set ::argc 0 - set ::argv {} + #safe !=1 and safe !=2, tmlist: %tmlist% + set ::argv0 %argv0% + set ::argv %argv% + set ::argc %argc% + set ::auto_path %autopath% tcl::tm::remove {*}[tcl::tm::list] tcl::tm::add {*}[lreverse %tmlist%] - namespace eval ::codeinterp { - variable errstack {} - variable outstack {} - variable run_command_cache - } - } - + #puts "code interp chan names-->[chan names]" - if {"stdout" in [chan names]} { - interp share {} stdout code - } else { - interp share {} [shellfilter::stack::item_tophandle stdout] code - } - if {"stderr" in [chan names]} { - interp share {} stderr code - } else { - interp share {} [shellfilter::stack::item_tophandle stderr] code - } + # -- --- + #review + #we have to blow some time on a rescan to provide more deterministic ordering (match behaviour of initial thread regarding pkg precedence) + #review - can we speed that scan up? + ##catch {package require flobrudder-nonexistant} + # -- --- - interp eval code { - package require punk::lib - package require textblock ;#may fail to load term::ansi::code::macros - (only required for altg) - } + if {[catch { + package require vfs + package require vfs::zip + } errM]} { + puts stderr "repl code interp can't load vfs,vfs::zip" + } + #puts stderr ----- + #puts stderr [join $::auto_path \n] + #puts stderr ----- - interp eval code { if {[catch { - catch { - package require packagetrace - packagetrace::init - } package require punk::config package require punk::ns #puts stderr "loading natsort" #natsort has 'application mode' which can exit. #Requiring it shouldn't trigger application - but zipfs/vfs interactions confused it in some early versions package require natsort + #catch {package require packageTrace} package require punk package require punk::args package require punk::args::tclcore @@ -3070,9 +3348,7 @@ namespace eval repl { puts stderr "========================" error "$errM" } - - } - + } } default { } @@ -3083,6 +3359,7 @@ namespace eval repl { code alias editbuf ::repl::interphelpers::editbuf code alias colour ::repl::interphelpers::colour code alias mode ::repl::interphelpers::mode + code alias vt52 ::repl::interphelpers::vt52 #code alias after ::repl::interphelpers::do_after code alias ::punk::set_repl_last_unknown ::repl::interphelpers::set_repl_last_unknown diff --git a/src/modules/punk/repl/codethread-999999.0a1.0.tm b/src/modules/punk/repl/codethread-999999.0a1.0.tm index 257c4f55..a85674f9 100644 --- a/src/modules/punk/repl/codethread-999999.0a1.0.tm +++ b/src/modules/punk/repl/codethread-999999.0a1.0.tm @@ -114,6 +114,10 @@ tcl::namespace::eval punk::repl::codethread { variable output_stdout "" variable output_stderr "" + #review/test + catch {package require punk::ns} + catch {package rquire punk::repl} + #variable xyz #*** !doctools @@ -191,9 +195,14 @@ tcl::namespace::eval punk::repl::codethread { #shennanigans to keep compiled script around after call. #otherwise when $script goes out of scope - internal rep of vars set in script changes. #The shimmering may be no big deal(?) - but debug/analysis using tcl::unsupported::representation becomes impossible. - interp eval code [list ::punk::lib::set_clone ::codeinterp::clonescript $script] ;#like objclone + + #interp eval code [list ::punk::lib::set_clone ::codeinterp::clonescript $script] ;#like objclone + interp eval code [list ::codeinterp::set_clone ::codeinterp::clonescript $script] ;#like objclone + + interp eval code {lappend ::codeinterp::run_command_cache $::codeinterp::clonescript} + interp eval code { - lappend ::codeinterp::run_command_cache $::codeinterp::clonescript + #lappend ::codeinterp::run_command_cache $::codeinterp::clonescript if {[llength $::codeinterp::run_command_cache] > 2000} { set ::codeinterp::run_command_cache [lrange $::codeinterp::run_command_cache 1750 end][unset ::codeinterp::run_command_cache] } @@ -205,10 +214,19 @@ tcl::namespace::eval punk::repl::codethread { package require punk::ns punk::ns::nseval_ifexists $::punk::ns::ns_current $::codeinterp::clonescript } else { + if {![namespace exists $::punk::ns::ns_current]} { + namespace eval $::punk::ns::ns_current { + puts stderr "Created namespace: $::punk::ns::ns_current" + } + } tcl::namespace::inscope $::punk::ns::ns_current $::codeinterp::clonescript } } } result] + #temp test for subshell experimentation + #if {$status == 1} { + # puts stderr "--codethread::runscript error--------\n$::errorInfo" + #} flush stdout diff --git a/src/modules/punk/repo-999999.0a1.0.tm b/src/modules/punk/repo-999999.0a1.0.tm index 76eed911..3fcb38f6 100644 --- a/src/modules/punk/repo-999999.0a1.0.tm +++ b/src/modules/punk/repo-999999.0a1.0.tm @@ -107,14 +107,16 @@ namespace eval punk::repo { } - #lappend PUNKARGS [list -dynamic 1 { + #lappend PUNKARGS [list { + # @dynamic # @id -id ::punk::repo::fossil_proxy # @cmd -name fossil -help "fossil executable # " # @argdisplay -header "fossil help" -body {${[runout -n fossil help]}} # } ""] - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + @dynamic @id -id ::punk::repo::fossil_proxy @cmd -name fossil -help "fossil executable" ${[punk::repo::get_fossil_usage]} @@ -123,20 +125,24 @@ namespace eval punk::repo { #experiment - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + @dynamic @id -id "::punk::repo::fossil_proxy diff" @cmd -name "fossil diff" -help "fossil diff " @argdisplay -header "fossil help diff" -body {${[runout -n fossil help diff]}} } ""] - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + #todo - remove this comment - testing dynamic directive + @dynamic @id -id "::punk::repo::fossil_proxy add" @cmd -name "fossil add" -help "fossil add " @argdisplay -header "fossil help add" -body {${[runout -n fossil help add]}} } ""] #TODO - #lappend PUNKARGS [list -dynamic 1 { + #lappend PUNKARGS [list { + # @dynamic # @id -glob 1 -id "::punk::repo::fossil_proxy *" -aliases {fs} # @cmd -name "fossil add" -help "fossil add # " @@ -1699,12 +1705,10 @@ namespace eval punk::repo::lib { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -if {![info exists ::punk::args::register::NAMESPACES]} { - namespace eval ::punk::args::register { - set ::punk::args::register::NAMESPACES [list] ;#use fully qualified so 8.6 doesn't find existing var in global namespace - } +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::repo } -lappend ::punk::args::register::NAMESPACES ::punk::repo # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ diff --git a/src/modules/punk/safe-999999.0a1.0.tm b/src/modules/punk/safe-999999.0a1.0.tm index 367d6998..1643b711 100644 --- a/src/modules/punk/safe-999999.0a1.0.tm +++ b/src/modules/punk/safe-999999.0a1.0.tm @@ -458,7 +458,7 @@ tcl::namespace::eval punk::safe { # If we have exactly 2 arguments the semantic is a "configure get" lassign $args child arg - set spec_dict [punk::args::define [punk::args::rawdef punk::safe::interpIC]] + set spec_dict [punk::args::define [punk::args::raw_def punk::safe::interpIC]] set opt_names [dict get $spec_dict opt_names] CheckInterp $child @@ -773,7 +773,7 @@ tcl::namespace::eval punk::safe::system { "::auto_path for the child"} } punk::args::define $OPTS - set optlines [punk::args::resolved_def -type @opts punk::safe::OPTS -*] + set optlines [punk::args::resolved_def -types opts ::punk::safe::OPTS -*] set INTERPCREATE { @id -id ::punk::safe::interpCreate @@ -783,6 +783,7 @@ tcl::namespace::eval punk::safe::system { @leaders child -type string -default "" -regexprefail "^-" -regexprefailmsg "" -optional 1 -help\ "name of the child (optional)" + #opts added separately } append INTERPCREATE \n $optlines append INTERPCREATE \n {@values -max 0} @@ -1020,6 +1021,7 @@ tcl::namespace::eval punk::safe::system { # Add the tcl::tm directories to the access path. set morepaths [::tcl::tm::list] + set morepaths [lreverse $morepaths] ;#JMN - maintains same order when re-adding. set firstpass 1 while {[llength $morepaths]} { set addpaths $morepaths @@ -1059,6 +1061,13 @@ tcl::namespace::eval punk::safe::system { # 'platform/shell-X.tm', i.e arbitrarily deep # subdirectories. lappend morepaths {*}[glob -nocomplain -directory $dir -type d *] + + #experiment + #if {$firstpass} { + # package require punk::zip + # set subs [punk::zip::walk -resultrelative "" $dir *.tm] ;#walk finds files and dirs - dirs have trailing slash + # lappend morepaths {*}[lsearch -all -inline $subs */] + #} } set firstpass 0 } @@ -1142,7 +1151,8 @@ tcl::namespace::eval punk::safe::system { fconfigure $f -encoding $encoding -eofchar \x1A set contents [read $f] close $f - ::interp eval $child [list info script $file] + #::interp eval $child [list info script $file] + ::interp eval $child [list info script $realfile] } msg opt ] @@ -1513,7 +1523,7 @@ tcl::namespace::eval punk::safe::system { # Add (only if needed, avoid duplicates) 1 level of sub directories to an # existing path list. Also removes non directories from the returned # list. - proc AddSubDirs {pathList} { + proc AddSubDirs1 {pathList} { set res {} foreach dir $pathList { if {[file isdirectory $dir]} { @@ -1532,6 +1542,29 @@ tcl::namespace::eval punk::safe::system { } return $res } + proc AddSubDirs {pathList} { + set res {} + foreach dir $pathList { + if {[file isdirectory $dir]} { + # check that we don't have it yet as a children of a previous + # dir + if {$dir ni $res} { + lappend res $dir + } + package require punk::zip + set subs [punk::zip::walk -resultrelative "" $dir *] ;#walk finds files and dirs - dirs have trailing slash + set dirs [lsearch -all -inline $subs */] + foreach sub $dirs { + if {[file isdirectory $sub] && ($sub ni $res)} { + # new sub dir, add it ! + lappend res $sub + } + } + } + } + return $res + } + # # Sets the child auto_path to its recorded access path. Also sets diff --git a/src/modules/punk/winrun-999999.0a1.0.tm b/src/modules/punk/winrun-999999.0a1.0.tm index d416d1b3..5d2ce870 100644 --- a/src/modules/punk/winrun-999999.0a1.0.tm +++ b/src/modules/punk/winrun-999999.0a1.0.tm @@ -39,13 +39,13 @@ namespace eval punk::winrun { proc readchild_handler {chan hpid} { #fileevent $chan readable {} set data [read $chan 4096] - while {![fblocked $chan] && ![eof $chan]} { + while {![chan blocked $chan] && ![eof $chan]} { append data [read $chan 4096] } - puts stdout "-->$data eof:[eof $chan] fblocked [fblocked $chan]" + puts stdout "-->$data eof:[eof $chan] chan blocked [chan blocked $chan]" flush stdout if {![eof $chan]} { - puts stdout "not eof $chan [fconfigure $chan] fblocked:[fblocked $chan]" + puts stdout "not eof $chan [fconfigure $chan] chan blocked:[chan blocked $chan]" #fileevent $chan readable [list punk::winrun::readchild_handler $chan $hpid] } else { #puts "eof: waiting exit process" diff --git a/src/modules/punk/winshell-999999.0a1.0.tm b/src/modules/punk/winshell-999999.0a1.0.tm index 2dc8e837..5131ba57 100644 --- a/src/modules/punk/winshell-999999.0a1.0.tm +++ b/src/modules/punk/winshell-999999.0a1.0.tm @@ -129,6 +129,7 @@ tcl::namespace::eval punk::winshell { set pipename_stdin $pipebase$shellid-stdin set pipename_stdout $pipebase$shellid-stdout set pipename_stderr $pipebase$shellid-stderr + #swapped thisend/child - labels now wrong - todo - relabel or swap back? set h_stdin [twapi::namedpipe_server $pipename_stdin] ;#handle for child process redirection set p_stdin [twapi::namedpipe_client $pipename_stdin] ;#this end set h_stdout [twapi::namedpipe_server $pipename_stdout] ;#handle for child process redirection @@ -138,15 +139,53 @@ tcl::namespace::eval punk::winshell { set p_stderr [twapi::namedpipe_client $pipename_stderr] ;#this end chan configure $p_stderr -blocking 0 - set pid [exec cmd.exe /k >@$h_stdout 2>@$h_stderr <@$h_stdin &] + set pid [exec cmd.exe /k >@$p_stdout 2>@$p_stderr <@$p_stdin &] dict set shellinfo $shellid id $shellid dict set shellinfo $shellid pid $pid - dict set shellinfo $shellid stdin $p_stdin - dict set shellinfo $shellid stdout $p_stdout - dict set shellinfo $shellid stderr $p_stderr + dict set shellinfo $shellid stdin $h_stdin + dict set shellinfo $shellid stdout $h_stdout + dict set shellinfo $shellid stderr $h_stderr return [dict get $shellinfo $shellid] } + variable ack 0 + proc handle_out {chan args} { + variable ack + #if {[catch { + # if {$ack} { + # punk::console::move_emit_return 3 79 "\\" + # set ack 0 + # } else { + # punk::console::move_emit_return 3 79 / + # set ack 1 + # } + #} errM]} { + # puts "err on move_emit_return" + #} + puts -nonewline stdout [punk::ansi::ansistring VIEW [read $chan]] + } + proc handle_err {chan args} { + variable ack + #if {$ack} { + # punk::console::move_emit_return 3 79 - + # set ack 0 + #} else { + # punk::console::move_emit_return 3 79 | + # set ack 1 + #} + puts -nonewline stderr [read $chan] + } + + proc cmdtest {{id ""}} { + set cinfo [cmdexec $id] + set o [dict get $cinfo stdout] + chan conf $o -buffering none -blocking 0 + set e [dict get $cinfo stderr] + chan conf $e -buffering none -blocking 0 + chan event $o readable [list ::punk::winshell::handle_out $o] + chan event $e readable [list ::punk::winshell::handle_err $e] + return $cinfo + } #test with twapi create_process proc cmdcreate {{id ""}} { @@ -255,10 +294,10 @@ tcl::namespace::eval punk::winshell { #review - *no running instance* works with windows taskkill - "*No such process*" works with kill -9 on FreeBSD and linux - other platforms? if {![string match "*no running instance*" $errMsg] && ![string match "*No such process*" $errMsg]} { - lappend failed_kits [list kit $targetkit reason "could not kill running process for $targetkit (using '$killcmd')"] + lappend failed_kits [list reason "could not kill running process for shellid $shellid (using '$killcmd')"] continue } else { - puts stderr " + puts stderr "" } } else { puts stderr "$killcmd ran without error" @@ -267,6 +306,10 @@ tcl::namespace::eval punk::winshell { } + proc shellinfo {} { + variable shellinfo + return $shellinfo + } proc cmdinfo {{id ""}} { variable autoshellid variable shellinfo @@ -279,8 +322,11 @@ tcl::namespace::eval punk::winshell { set info [dict get $shellinfo $shellid] set pid [dict get $info pid] - set statusresult [tcl::process status $pid] - dict set info status $statusresult + catch { + set statusresult [tcl::process status $pid] + dict set info status $statusresult + } + set cmdline [twapi::get_process_commandline $pid] dict set info cmdline $cmdline return [showdict $info] @@ -297,7 +343,11 @@ tcl::namespace::eval punk::winshell { set shellid $id } set pid [dict get $shellinfo $shellid pid] - set statusresult [tcl::process status $pid] + set statusresult "" + catch { + #not in 8.6? + set statusresult [tcl::process status $pid] + } return [dict create id $shellid status $statusresult] } diff --git a/src/modules/punk/zip-999999.0a1.0.tm b/src/modules/punk/zip-999999.0a1.0.tm index 9f7787fe..1b5fa8d7 100644 --- a/src/modules/punk/zip-999999.0a1.0.tm +++ b/src/modules/punk/zip-999999.0a1.0.tm @@ -194,6 +194,12 @@ tcl::namespace::eval punk::zip { Defaults to the value of base. If empty string is given to -resultrelative the paths returned are effectively absolute paths." + -emptydirs -default 0 -type boolean -help\ + "Whether to include directory trees in the result which had no + matches for the given fileglobs. + Intermediate dirs are always returned if there is a match with + fileglobs further down even if -emptdirs is 0. + " -excludes -default "" -help "list of glob expressions to match against files and exclude" -subpath -default "" -help\ "May contain glob chars for folder elements" @@ -205,6 +211,7 @@ tcl::namespace::eval punk::zip { set fileglobs [dict get $argd values fileglobs] set subpath [dict get $argd opts -subpath] set excludes [dict get $argd opts -excludes] + set emptydirs [dict get $argd opts -emptydirs] set received [dict get $argd received] @@ -242,13 +249,32 @@ tcl::namespace::eval punk::zip { if {!$excluded} {lappend result [file join $prefix $file]} } foreach dir [glob -nocomplain -tails -types d -directory $base -- [file join $subpath *]] { - set subdir_entries [walk -subpath $dir -excludes $excludes $base {*}$fileglobs] - if {[llength $subdir_entries]>0} { - #NOTE: trailing slash required for entries to be recognised as 'file type' = "directory" - #This is true for 2024 Tcl9 mounted zipfs at least. zip utilities such as 7zip seem(icon correct) to recognize dirs with or without trailing slash - #Although there are attributes on some systems to specify if entry is a directory - it appears trailing slash should always be used for folder names. - set result [list {*}$result "[file join $prefix $dir]/" {*}$subdir_entries] + set submatches [walk -subpath $dir -emptydirs $emptydirs -excludes $excludes $base {*}$fileglobs] + set subdir_entries [list] + set thisdir_match [list] + set has_file 0 + foreach sd $submatches { + set fullpath [file join $prefix $sd] ;#file join destroys trailing slash + if {[string index $sd end] eq "/"} { + lappend subdir_entries $fullpath/ + } else { + set has_file 1 + lappend subdir_entries $fullpath + } + } + if {$emptydirs} { + set thisdir_match [list "[file join $prefix $dir]/"] + } else { + if {$has_file} { + set thisdir_match [list "[file join $prefix $dir]/"] + } else { + set subdir_entries [list] + } } + #NOTE: trailing slash required for entries to be recognised as 'file type' = "directory" + #This is true for 2024 Tcl9 mounted zipfs at least. zip utilities such as 7zip seem(icon correct) to recognize dirs with or without trailing slash + #Although there are attributes on some systems to specify if entry is a directory - it appears trailing slash should always be used for folder names. + set result [list {*}$result {*}$thisdir_match {*}$subdir_entries] } return $result } diff --git a/src/modules/punkcheck-0.1.0.tm b/src/modules/punkcheck-0.1.0.tm index 3b4217df..db8a3db5 100644 --- a/src/modules/punkcheck-0.1.0.tm +++ b/src/modules/punkcheck-0.1.0.tm @@ -1170,6 +1170,7 @@ namespace eval punkcheck { } #skip writing punkcheck during checksum/timestamp checks + #todo - punk::args - fetch from punkcheck::install (with overrides) proc install_tm_files {srcdir basedir args} { set defaults [list\ -glob *.tm\ @@ -1209,13 +1210,71 @@ namespace eval punkcheck { return [lindex $args end] } } + lappend PUNKARGS [list { + @id -id ::punkcheck::install + @cmd -name ::punkcheck::install -help\ + "Unidirectional file transfer to possibly non-empty target folder." + @leaders -min 2 -max 2 + srcdir -type directory + tgtdir -type directory + -call-depth-internal -type integer -default 0 -help "(internal recursion tracker)" + -subdirlist -type list -default "" -help "(primarily internal - length generally matching -call-depth-internal)" + -max_depth -type integer -default 1000 -help\ + "Deepest subdirectory - use -1 for no limit." + -createdir -type boolean -default 0 -help\ + "Whether to create the folder at tgtdir. + Any required subdirectories are created regardless of this setting." + -createempty -type boolean -default 0 -help\ + "Whether to create folders at target that had no matches for our glob" + -glob -type string -default "*" -help\ + "Pattern matching for source file(s) to copy. Can be glob based or exact match." + -antiglob_file_core -default {${[::punkcheck::default_antiglob_file_core]}} + -antiglob_file -default "" + -antiglob_dir_core -default {${[::punkcheck::default_antiglob_dir_core]}} + -antiglob_dir -default "" + -antiglob_paths -default {} + -overwrite -default no-targets\ + -choices {no-targets newer-targets older-targets all-targets installedsourcechanged-targets synced-targets}\ + -choicecolumns 1\ + -choicelabels { + no-targets "only copy files that are missing at the target" + newer-targets "copy files with older source timestamp over newer + target timestamp and those missing at the target + (a form of 'restore' operation)" + older-targets "copy files with newer source timestamp over older + target timestamp and those missing at the target" + all-targets "copy regardless of timestamp at target" + installedsourcechanged-targets "copy if the target doesn't exist or the source changed" + synced-targets "copy if the target doesn't exist or the source changed + and the target cksum is the same as the last INSTALL-RECORD -targets_cksums entry" + } + -source_checksum -default comparestore -choicecolumns 3 -choices {compare store comparestore false true}\ + -choicelabels { + true "same as comparestore" + } + -punkcheck_folder -default target -choices {target source project} -choicerestricted 0 -help\ + "The location of the .punkcheck file to track installations and checksums. + The default value 'target' is generally recommended. + Can also be an absolute path to a folder." + -punkcheck_records -default "" -help\ + "Empty string or a parsed TDL records structure. + e.g + {tag FILEINFO - ... body { + {tag INSTALL-RECORD - ... body {}} + ... + }... + }" + -installer -default "punkcheck::install" -help\ + "A user nominated string that is stored in the .punkcheck file + This might be the name of a script or installation process." + }] ## unidirectional file transfer to possibly non empty folder #default of -overwrite no-targets will only copy files that are missing at the target # -overwrite newer-targets will copy files with older source timestamp over newer target timestamp and those missing at the target (a form of 'restore' operation) # -overwrite older-targets will copy files with newer source timestamp over older target timestamp and those missing at the target # -overwrite all-targets will copy regardless of timestamp at target # -overwrite installedsourcechanged-targets will copy if the target doesn't exist or the source changed - # -overwrite synced-targets will copy if the target doesn't exist or the source changed and the target cksum is the same as the last INSTALL-RECORD targets_cksums entry + # -overwrite synced-targets will copy if the target doesn't exist or the source changed and the target cksum is the same as the last INSTALL-RECORD -targets_cksums entry # review - timestamps unreliable # - what about slightly mismatched system clocks and mounted filesystems? caller responsibility to verify first? # if timestamp exactly equal - should we check content-hash? This is presumably only likely to occur deliberately(maliciously?) @@ -1243,6 +1302,7 @@ namespace eval punkcheck { -max_depth 1000\ -subdirlist {}\ -createdir 0\ + -createempty 0\ -glob *\ -antiglob_file_core "\uFFFF"\ -antiglob_file "" \ @@ -1271,13 +1331,14 @@ namespace eval punkcheck { #(as opposed to a more 'standard' mechanism of adjusting srcdir & tgtdir as we move down the tree) #It comes from build_modules_from_source_to_base where we need to keep track of position relative to our targetdir starting point to handle submodules e.g pkg::something::mypkg-0.1.tm #It could have been handled with some other parameter such as -depth, but this -subdirlist mechanism, whilst perhaps not beautiful, is straightforward enough - #and may be less error prone than doing slightly more opaue path manipulations at each recursion level to determine where we started + #and may be less error prone than doing slightly more opaque path manipulations at each recursion level to determine where we started #For consistency - we'll use the same mechanism in various recursive directory walking procedures such as this one. - set CALLDEPTH [dict get $opts -call-depth-internal] ;#added for extra debug/sanity checking - clearer test for initial function call ie CALLDPEPTH = 0 + set CALLDEPTH [dict get $opts -call-depth-internal] ;#added for extra debug/sanity checking - clearer test for initial function call ie CALLDEPTH = 0 set max_depth [dict get $opts -max_depth] ;# -1 for no limit set subdirlist [dict get $opts -subdirlist] ;# generally should be same length as CALLDEPTH - but user could prefill set fileglob [dict get $opts -glob] set createdir [dict get $opts -createdir] ;#defaults to zero to help avoid mistakes with initial target dir - required target subdirs are created regardless of this setting + set opt_createempty [dict get $opts -createempty] if {$CALLDEPTH == 0} { #expensive to normalize but we need to do it at least once @@ -1285,6 +1346,13 @@ namespace eval punkcheck { set tgtdir [file normalize $tgtdir] if {$createdir} { file mkdir $tgtdir + } else { + if {![file exists $tgtdir]} { + error "punkcheck::install base target dir:'$tgtdir' doesn't exist (srcdir:$srcdir tgtdir:$tgtdir args:'$args')" + } + } + if {([file type $srcdir] ni [list directory]) || ([file type $tgtdir] ni [list directory])} { + error "punkcheck::install requires source and target dirs to be of type 'directory' type current source: [file type $srcdir] type current target: [file type $tgtdir]" } #now the values we build from these will be properly cased } @@ -1450,13 +1518,7 @@ namespace eval punkcheck { if {![file exists $current_source_dir]} { - error "copy_files_from_source_to_target current source dir:'$current_source_dir' doesn't exist (srcdir:$srcdir tgtdir:$tgtdir args:'$args')" - } - if {![file exists $current_target_dir]} { - error "copy_files_from_source_to_target current target dir:'$current_target_dir' doesn't exist (srcdir:$srcdir tgtdir:$tgtdir args:'$args')" - } - if {([file type $current_source_dir] ni [list directory]) || ([file type $current_target_dir] ni [list directory])} { - error "copy_files_from_source_to_target requires source and target dirs to be of type 'directory' type current source: [file type $current_source_dir] type current target: [file type $current_target_dir]" + error "punkcheck::install current source dir:'$current_source_dir' doesn't exist (srcdir:$srcdir tgtdir:$tgtdir args:'$args')" } set files_copied [list] @@ -1500,7 +1562,13 @@ namespace eval punkcheck { # SOURCE -type file -path ../src/modules/jjjetc-999999.0a1.0.tm -cksum b646fc2ee88cbd068d2e946fe929b7aea96bd39d -cksum_all_opts {-cksum_content 1 -cksum_meta 0 -cksum_acls 0 -cksum_usetar 0 -cksum_algorithm sha1} -changed 0 -metadata_us 3338 # } #} - + + if {[llength $match_list]} { + #example - target dir has a file where there is a directory at the source + if {[file exists $current_target_dir] && ([file type $current_target_dir] ni [list directory])} { + error "punkcheck::install target subfolder $current_target_dir exists but is not of type 'directory'. Type current target folder: [file type $current_target_dir]" + } + } #proc get_relativecksum_from_base_and_fullpath {base fullpath args} @@ -1579,10 +1647,12 @@ namespace eval punkcheck { set is_skip 0 if {$overwrite_what eq "all-targets"} { + file mkdir $current_target_dir file copy -force $current_source_dir/$m $current_target_dir lappend files_copied $current_source_dir/$m } else { if {![file exists $current_target_dir/$m]} { + file mkdir $current_target_dir file copy $current_source_dir/$m $current_target_dir set new_tgt_cksum_info [punk::mix::base::lib::cksum_path $current_target_dir/$m] lappend files_copied $current_source_dir/$m @@ -1592,6 +1662,7 @@ namespace eval punkcheck { installedsourcechanged-targets { if {[llength $changed]} { #An unrecorded installation is considered a source change (from unknown/unrecorded source to recorded) + file mkdir $current_target_dir file copy -force $current_source_dir/$m $current_target_dir set new_tgt_cksum_info [punk::mix::base::lib::cksum_path $current_target_dir/$m] lappend files_copied $current_source_dir/$m @@ -1619,6 +1690,7 @@ namespace eval punkcheck { set target_cksum_compare "norecord" } if {$is_target_unmodified_since_install} { + file mkdir $current_target_dir file copy -force $current_source_dir/$m $current_target_dir set new_tgt_cksum_info [punk::mix::base::lib::cksum_path $current_target_dir/$m] lappend files_copied $current_source_dir/$m @@ -1642,6 +1714,12 @@ namespace eval punkcheck { } } } + #target dir was created as necessary if files matched above + #now ensure target dir exists if -createempty true + if {$opt_createempty && ![file exists $current_target_dir]} { + file mkdir $current_target_dir + } + set ts_now [clock microseconds] @@ -1724,10 +1802,9 @@ namespace eval punkcheck { continue } - - if {![file exists $current_target_dir/$d]} { - file mkdir $current_target_dir/$d - } + #if {![file exists $current_target_dir/$d]} { + # file mkdir $current_target_dir/$d + #} set sub_opts_1 [list\ @@ -2096,8 +2173,10 @@ namespace eval punkcheck { - - +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punkcheck +} diff --git a/src/modules/punkcheck/cli-999999.0a1.0.tm b/src/modules/punkcheck/cli-999999.0a1.0.tm index 000aa1d0..5ebac789 100644 --- a/src/modules/punkcheck/cli-999999.0a1.0.tm +++ b/src/modules/punkcheck/cli-999999.0a1.0.tm @@ -64,6 +64,8 @@ namespace eval punkcheck::cli { #vfs can mask mounted files - so we can't just use 'file type' or glob with -type f ##set files [glob -nocomplain -dir $fullpath -type f *] package require punk::nav::fs + + #TODO - get all files in tree!!! set folderinfo [punk::nav::fs::dirfiles_dict $fullpath] set files [concat [dict get $folderinfo files] [dict get $folderinfo underlayfiles]] } diff --git a/src/modules/shellfilter-0.1.9.tm b/src/modules/shellfilter-0.1.9.tm index 25ba28b1..d70d657c 100644 --- a/src/modules/shellfilter-0.1.9.tm +++ b/src/modules/shellfilter-0.1.9.tm @@ -751,6 +751,12 @@ namespace eval shellfilter::chan { } else { + #REVIEW - this holding a buffer without emitting as we go is ugly. + # - we may do better to detect and retain the opener, then use that opener to avoid false splits within the sequence. + # - we'd then need to detect the appropriate close to restart splitting and codestacking + # - we may still need to retain and append the data to the opener (in some cases?) - which is a slight memory issue - but at least we would emit everything immediately. + + #puts "-->esc but no detect" #no complete ansi codes - but at least one esc is present if {[string last \x1b $buf] == [llength $buf]-1} { @@ -1118,8 +1124,8 @@ namespace eval shellfilter::stack { proc status {{pipename *} args} { variable pipelines set pipecount [dict size $pipelines] - set tableprefix "$pipecount pipelines active\n" - set t [textblock::class::table new $tableprefix] + set tabletitle "$pipecount pipelines active" + set t [textblock::class::table new $tabletitle] $t add_column -headers [list channel-ident] $t add_column -headers [list device-info localchan] $t configure_column 1 -header_colspans {3} @@ -1402,7 +1408,8 @@ namespace eval shellfilter::stack { } dict set pipelines $pipename stack $stack } - show_pipeline $pipename -note "after_remove $remove_id" + #JMNJMN 2025 review! + #show_pipeline $pipename -note "after_remove $remove_id" return 1 } @@ -1607,7 +1614,9 @@ namespace eval shellfilter::stack { #puts stdout "==" #puts stdout "==>stack: $stack" #puts stdout "==" - show_pipeline $pipename -note "after_add $transformname $args" + + #JMNJMN + #show_pipeline $pipename -note "after_add $transformname $args" return $id } proc show_pipeline {pipename args} { diff --git a/src/modules/shellthread-1.6.1.tm b/src/modules/shellthread-1.6.1.tm index f0d3ad8a..c529f234 100644 --- a/src/modules/shellthread-1.6.1.tm +++ b/src/modules/shellthread-1.6.1.tm @@ -398,8 +398,8 @@ namespace eval shellthread::manager { error {wrong # args: should be "dict_getdef dictValue ?key ...? key default"} } set keys [lrange $args 0 end-1] - if {[dict exists $dictValue {*}$keys]} { - return [dict get $dictValue {*}$keys] + if {[tcl::dict::exists $dictValue {*}$keys]} { + return [tcl::dict::get $dictValue {*}$keys] } else { return [lindex $args end] } diff --git a/src/modules/textblock-999999.0a1.0.tm b/src/modules/textblock-999999.0a1.0.tm index 2a4bbc60..9c198427 100644 --- a/src/modules/textblock-999999.0a1.0.tm +++ b/src/modules/textblock-999999.0a1.0.tm @@ -62,14 +62,16 @@ catch {package require patternpunk} package require overtype #safebase interps as at 2024-08 can't access deeper paths - even though they are below the supposed safe list. -if {[catch { - package require term::ansi::code::macros ;#required for frame if old ansi g0 used - review - make package optional? -} errM]} { - #catch this too in case stderr not available - catch { - puts stderr "textblock package failed to load term::ansi::code::macros with error: $errM" - } -} +#2025 - required term::ansi features for altg now built in to textblock +#the deeper paths issue is still a potential issue for some packages - review +#if {[catch { +# package require term::ansi::code::macros ;#required for frame if old ansi g0 used - review - make package optional? +#} errM]} { +# #catch this too in case stderr not available +# catch { +# puts stderr "textblock package failed to load term::ansi::code::macros with error: $errM" +# } +#} package require textutil @@ -139,7 +141,8 @@ tcl::namespace::eval textblock { # hash_algorithm -optional 1 -choices {${[::textblock::argdoc::hash_algorithm_choices]}} -help\ # "algorithm choice" - punk::args::define -dynamic 1 { + punk::args::define { + @dynamic @id -id ::textblock::use_hash @cmd -name "textblock::use_hash" -help\ "Hashing algorithm to use for framecache lookup. @@ -4068,12 +4071,12 @@ tcl::namespace::eval textblock { return $frametypes } - tcl::namespace::eval cd { - #todo - save and restore existing tcl::namespace::export in case macros::cd has default exports in future - tcl::namespace::eval ::term::ansi::code::macros::cd {tcl::namespace::export *} - tcl::namespace::import ::term::ansi::code::macros::cd::* - tcl::namespace::eval ::term::ansi::code::macros::cd {tcl::namespace::export -clear} - } + #tcl::namespace::eval cd { + # #todo - save and restore existing tcl::namespace::export in case macros::cd has default exports in future + # tcl::namespace::eval ::term::ansi::code::macros::cd {tcl::namespace::export *} + # tcl::namespace::import ::term::ansi::code::macros::cd::* + # tcl::namespace::eval ::term::ansi::code::macros::cd {tcl::namespace::export -clear} + #} proc spantest {} { set t [list_as_table -columns 5 -return tableobject {a b c d e aa bb cc dd ee X Y}] $t configure_column 0 -headers [list span3 "1-span4\n2-span4 second line" span5/5 "span-all etc blah 123 hmmmmm" span2] @@ -5071,7 +5074,7 @@ tcl::namespace::eval textblock { #only call width functions if known_samewidth - otherwise let the pad algorithm below determine it as we go if {$known_samewidth ne "" && $known_samewidth} { if {$known_blockwidth eq ""} { - set datawidth [textblock::widthtopline $block + set datawidth [textblock::widthtopline $block] } else { set datawidth $known_blockwidth } @@ -6214,16 +6217,22 @@ tcl::namespace::eval textblock { switch -- $f { "altg" { #old style ansi escape sequences with alternate graphics page G0 - set hl [cd::hl] + #set hl [cd::hl] + set hl [punk::ansi::g0 q] set hlt $hl set hlb $hl - set vl [cd::vl] + #set vl [cd::vl] + set vl [punk::ansi::g0 x] set vll $vl set vlr $vl - set tlc [cd::tlc] - set trc [cd::trc] - set blc [cd::blc] - set brc [cd::brc] + #set tlc [cd::tlc] + set tlc [punk::ansi::g0 l] + #set trc [cd::trc] + set trc [punk::ansi::g0 k] + #set blc [cd::blc] + set blc [punk::ansi::g0 m] + #set brc [cd::brc] + set brc [punk::ansi::g0 j] #horizontal and vertical bar joins set hltj $hlt @@ -7417,13 +7426,15 @@ tcl::namespace::eval textblock { set blc \U1fb7c ;#legacy block set brc \U1fb7f ;#legacy block - if {[punk::console::check::has_bug_legacysymbolwidth]} { - #rather than totally fail on some mixed layout that happens to use block2 - just degrade it - but prevent alignment problems - set sp \u00a0 ;#non breaking space (plain space may act transparent in some use cases) - set tlc $sp - set trc $sp - set blc $sp - set brc $sp + if {(![interp issafe])} { + if {![catch {punk::console::check::has_bug_legacysymbolwidth} symbug] && $symbug} { + #rather than totally fail on some mixed layout that happens to use block2 - just degrade it - but prevent alignment problems + set sp \u00a0 ;#non breaking space (plain space may act transparent in some use cases) + set tlc $sp + set trc $sp + set blc $sp + set brc $sp + } } #horizontal and vertical bar joins @@ -7555,12 +7566,12 @@ tcl::namespace::eval textblock { @cmd -name textblock::frame_cache -help\ "Display or clear the frame cache." -pretty -default 1 -help\ - "Uses 'pdict textblock::frame_cache */*' for prettier output - Either way this is set, output requires long lines and may - still wrap in an ugly manner. Try 'textblock::use_cache md5' - to shorten the argument display and reduce wrapping. + "Uses 'pdict textblock::frame_cache */*' for prettier output + Either way this is set, output requires long lines and may + still wrap in an ugly manner. Try 'textblock::use_cache md5' + to shorten the argument display and reduce wrapping. " - @values -min 0 -max 1 + @values -min 0 -max -1 action -default {display} -choices {clear size info display} -choicelabels { clear "Clear the textblock::frame_cache dictionary." } -help "Perform an action on the frame cache." @@ -7569,6 +7580,8 @@ tcl::namespace::eval textblock { set argd [punk::args::get_by_id ::textblock::frame_cache $args] set action [dict get $argd values action] variable frame_cache + set all_values_dict [dict get $argd values] + set action_values [lrange [dict values $all_values_dict] 1 end] switch -- $action { clear { set size [dict size $frame_cache] @@ -7589,8 +7602,65 @@ tcl::namespace::eval textblock { error "frame_cache -action '$action' not understood. Valid actions: clear size info display" } } + if {[llength $action_values]} { + return [frame_cache_display -pretty [dict get $argd opts -pretty] {*}$action_values] + } else { + return [frame_cache_display -pretty [dict get $argd opts -pretty]] + } + } + punk::args::define { + @dynamic + @id -id ::textblock::frame_cache_display + @opts + ${[::punk::args::resolved_def -types opts ::textblock::frame_cache -pretty]} + @values -min 0 -max 2 + startindex -default "" -type indexexpression -help\ + "If both startindex and endindex are missing/empty, it is treated as + startindex 0 endindex end. (ie displays all records) + If only startindex has a value - the frame_cache record at that + index will be displayed" + endindex -default "" -type indexexpression + } + proc frame_cache_display {args} { + set argd [punk::args::get_by_id ::textblock::frame_cache_display $args] + variable frame_cache + lassign [dict values [dict get $argd values]] startidx endidx + set limit "" + if {$startidx ne ""} { + if {$endidx ne ""} { + if {$startidx eq $endidx} { + set limit "index" + } else { + set limit "range" + } + } else { + set limit "index" + } + } else { + set limit "all" + } + + set display_dict {} + switch -- $limit { + all { + set display_dict $frame_cache + } + index { + set k [lindex [dict keys $frame_cache] $startidx] + if {$k ne ""} { + set display_dict [dict create $k [dict get $frame_cache $k]] + } + } + range { + set keys [lrange [dict keys $frame_cache] $startidx $endidx] + foreach k $keys { + dict set display_dict $k [dict get $frame_cache $k] + } + } + } + if {[dict get $argd opts -pretty]} { - set out [pdict -chan none frame_cache */*] + set out [pdict -chan none display_dict */*] } else { set out "" if {[catch { @@ -7599,7 +7669,7 @@ tcl::namespace::eval textblock { set termwidth 80 } - tcl::dict::for {k v} $frame_cache { + tcl::dict::for {k v} $display_dict { lassign $v _f frame _used used set fwidth [textblock::widthtopline $frame] #review - are cached frames uniform width lines? @@ -7651,7 +7721,8 @@ tcl::namespace::eval textblock { # ${[textblock::frame_samples]} #todo punk::args alias for centre center etc? - punk::args::define -dynamic 1 { + punk::args::define { + @dynamic @id -id ::textblock::frame @cmd -name "textblock::frame"\ -help "Frame a block of text with a border." @@ -8208,9 +8279,11 @@ tcl::namespace::eval textblock { } altg { set tbar [tcl::string::repeat $hlt $frame_inner_width] - set tbar [cd::groptim $tbar] + #set tbar [cd::groptim $tbar] + set tbar [punk::ansi::groptim $tbar] set bbar [tcl::string::repeat $hlb $frame_inner_width] - set bbar [cd::groptim $bbar] + #set bbar [cd::groptim $bbar] + set bbar [punk::ansi::groptim $bbar] } default { set tbar [tcl::string::repeat $hlt $frame_inner_width] diff --git a/src/project_layouts/custom/_project/punk.basic/src/make.tcl b/src/project_layouts/custom/_project/punk.basic/src/make.tcl index de7e055a..6776eb79 100644 --- a/src/project_layouts/custom/_project/punk.basic/src/make.tcl +++ b/src/project_layouts/custom/_project/punk.basic/src/make.tcl @@ -18,7 +18,7 @@ namespace eval ::punkboot { variable foldername [file tail $scriptfolder] variable pkg_requirements [list]; variable pkg_missing [list];variable pkg_loaded [list] variable non_help_flags [list -k] - variable help_flags [list -help --help /?] + variable help_flags [list -help --help /? -h] variable known_commands [list project modules vfs info check shell vendorupdate bootsupport vfscommonupdate] } @@ -180,10 +180,14 @@ set bootsupport_module_paths [list] set bootsupport_library_paths [list] if {[file exists [file join $startdir src bootsupport]]} { lappend bootsupport_module_paths [file join $startdir src bootsupport modules] + lappend bootsupport_module_paths [file join $startdir src bootsupport modules_tcl$::tclmajorv] lappend bootsupport_library_paths [file join $startdir src bootsupport lib] + lappend bootsupport_library_paths [file join $startdir src bootsupport lib_tcl$::tclmajorv] } else { lappend bootsupport_module_paths [file join $startdir bootsupport modules] + lappend bootsupport_module_paths [file join $startdir bootsupport modules_tcl$::tclmajorv] lappend bootsupport_library_paths [file join $startdir bootsupport lib] + lappend bootsupport_library_paths [file join $startdir bootsupport lib_tcl$::tclmajorv] } set bootsupport_paths_exist 0 foreach p [list {*}$bootsupport_module_paths {*}$bootsupport_library_paths] { @@ -203,13 +207,13 @@ set sourcesupport_paths_exist 0 #(most?) Modules in src/modules etc should still be runnable directly in certain cases like this where we point to them. if {[file tail $startdir] eq "src"} { #todo - other src 'module' dirs.. - foreach p [list $startdir/modules $startdir/modules_tcl$::tclmajorv] { + foreach p [list $startdir/modules $startdir/modules_tcl$::tclmajorv $startdir/vendormodules $startdir/vendormodules_tcl$::tclmajorv] { if {[file exists $p]} { lappend sourcesupport_module_paths $p } } # -- -- -- - foreach p [list $startdir/vendorlib $startdir/vendorlib_tcl${::tclmajorv}] { + foreach p [list $startdir/lib $startdir/lib_tcl$::tclmajorv $startdir/vendorlib $startdir/vendorlib_tcl$::tclmajorv] { if {[file exists $p]} { lappend sourcesupport_library_paths $p } @@ -266,9 +270,12 @@ if {$bootsupport_paths_exist || $sourcesupport_paths_exist} { package forget $pkg } } - tcl::tm::add {*}$bootsupport_module_paths {*}$sourcesupport_module_paths - set ::auto_path [list {*}$bootsupport_library_paths {*}$sourcesupport_library_paths] + #tcl::tm::add {*}$original_tm_list {*}$bootsupport_module_paths {*}$sourcesupport_module_paths + #set ::auto_path [list {*}$original_auto_path {*}$bootsupport_library_paths {*}$sourcesupport_library_paths] + tcl::tm::add {*}$bootsupport_module_paths {*}$sourcesupport_module_paths + set ::auto_path [list {*}$bootsupport_library_paths {*}$sourcesupport_library_paths] } + puts "----> auto_path $::auto_path" @@ -1046,7 +1053,9 @@ proc ::punkboot::punkboot_gethelp {args} { append h " - before calling this (followed by make project) - you can test using '(.exe) dev'" \n append h " this will load modules from your /module /lib paths instead of from the kit/zipkit" \n \n append h " $scriptname info" \n - append h " - show the name and base folder of the project to be built" \n + append h " - show the name and base folder of the project to be built" \n \n + append h " $scriptname check" \n + append h " - show module/library paths and any potentially problematic packages for running this script" \n append h "" \n if {[llength [dict get $pkg_availability missing]] || [llength [dict get $pkg_availability broken]]} { set has_recommended 0 @@ -1116,6 +1125,7 @@ if {[llength $commands_found] != 1 } { set do_help 1 } if {$do_help} { + puts stdout "Checking package availability..." set ::punkboot::pkg_availability [::punkboot::check_package_availability -quiet 1 $::punkboot::bootsupport_requirements] foreach pkg_request [dict get $::punkboot::pkg_availability loaded] { #puts stderr "---> $pkg_request" @@ -1407,6 +1417,7 @@ if {$::punkboot::command eq "vendorupdate"} { puts stderr "Unable to use punkcheck for vendormodules$which update. Error: $errM" set installation_event "" } + #todo - sync alg with bootsupport_localupdate! foreach {relpath requested_module} $local_modules { set requested_module [string trim $requested_module :] set module_subpath [string map {:: /} [namespace qualifiers $requested_module]] @@ -1488,6 +1499,11 @@ if {$::punkboot::command eq "bootsupport"} { #puts "-- [tcl::tm::list] --" puts stdout "Updating bootsupport from local files" + proc modfile_sort {p1 p2} { + lassign [split [file rootname $p1] -] _ v1 + lassign [split [file rootname $p1] -] _ v2 + package vcompare $v1 $v2 + } proc bootsupport_localupdate {projectroot} { set bootsupport_modules [list] ;#variable populated by include_modules.config file - review set sourcefolder $projectroot/src @@ -1521,57 +1537,66 @@ if {$::punkboot::command eq "bootsupport"} { set boot_event "" } - foreach {relpath module} $bootsupport_modules { - set module [string trim $module :] - set module_subpath [string map [list :: /] [namespace qualifiers $module]] + foreach {relpath modulematch} $bootsupport_modules { + set modulematch [string trim $modulematch :] + set module_subpath [string map [list :: /] [namespace qualifiers $modulematch]] set srclocation [file join $projectroot $relpath $module_subpath] - #puts stdout "$relpath $module $module_subpath $srclocation" - set pkgmatches [glob -nocomplain -dir $srclocation -tail [namespace tail $module]-*] - #lsort won't sort version numbers properly e.g with -dictionary 0.1.1 comes before 0.1 + #puts stdout "$relpath $modulematch $module_subpath $srclocation" + if {[string first - $modulematch]} { + set pkgmatches [glob -nocomplain -dir $srclocation -tail -type f [namespace tail $modulematch]*.tm] + } else { + set pkgmatches [glob -nocomplain -dir $srclocation -tail -type f [namespace tail $modulematch]-*.tm] + } if {![llength $pkgmatches]} { - puts stderr "Missing source for bootsupport module $module - not found in $srclocation" + puts stderr "Missing source for bootsupport module $modulematch - no matches in $srclocation" continue } - set latestfile [lindex $pkgmatches 0] - set latestver [lindex [split [file rootname $latestfile] -] 1] - foreach m $pkgmatches { - lassign [split [file rootname $m] -] _pkg ver - #puts "comparing $ver vs $latestver" - if {[package vcompare $ver $latestver] == 1} { - set latestver $ver - set latestfile $m - } + + set modulematch_is_glob [regexp {[*?\[\]]} $modulematch] + if {!$modulematch_is_glob} { + #if modulematch was specified without globs - only copy latest + #lsort won't sort version numbers properly e.g with -dictionary 0.1.1 comes before 0.1b3 - use helper func + set pkgmatches [lsort -command modfile_sort $pkgmatches] + set latestfile [lindex $pkgmatches end] + #set latestver [lindex [split [file rootname $latestfile] -] 1] + set copy_files $latestfile + } else { + #globs in modulematch - may be different packages matched by glob - copy all versions of matches + #review + set copy_files $pkgmatches } - set srcfile [file join $srclocation $latestfile] - set tgtfile [file join $targetroot $module_subpath $latestfile] - if {$boot_event ne ""} { - #---------- - $boot_event targetset_init INSTALL $tgtfile - $boot_event targetset_addsource $srcfile - #---------- - if {\ - [llength [dict get [$boot_event targetset_source_changes] changed]]\ - || [llength [$boot_event get_targets_exist]] < [llength [$boot_event get_targets]]\ - } { - file mkdir [file dirname $tgtfile] ;#ensure containing folder for target exists - $boot_event targetset_started - # -- --- --- --- --- --- - puts "BOOTSUPPORT module$which update: $srcfile -> $tgtfile" - if {[catch { - file copy -force $srcfile $tgtfile - } errM]} { - $boot_event targetset_end FAILED + foreach cfile $copy_files { + set srcfile [file join $srclocation $cfile] + set tgtfile [file join $targetroot $module_subpath $cfile] + if {$boot_event ne ""} { + #---------- + $boot_event targetset_init INSTALL $tgtfile + $boot_event targetset_addsource $srcfile + #---------- + if {\ + [llength [dict get [$boot_event targetset_source_changes] changed]]\ + || [llength [$boot_event get_targets_exist]] < [llength [$boot_event get_targets]]\ + } { + file mkdir [file dirname $tgtfile] ;#ensure containing folder for target exists + $boot_event targetset_started + # -- --- --- --- --- --- + puts "BOOTSUPPORT module$which update: $srcfile -> $tgtfile" + if {[catch { + file copy -force $srcfile $tgtfile + } errM]} { + $boot_event targetset_end FAILED + } else { + $boot_event targetset_end OK + } + # -- --- --- --- --- --- } else { - $boot_event targetset_end OK + puts -nonewline stderr "." + $boot_event targetset_end SKIPPED } - # -- --- --- --- --- --- + $boot_event end } else { - puts -nonewline stderr "." - $boot_event targetset_end SKIPPED + file copy -force $srcfile $tgtfile } - $boot_event end - } else { - file copy -force $srcfile $tgtfile } } if {$boot_event ne ""} { @@ -1597,13 +1622,14 @@ if {$::punkboot::command eq "bootsupport"} { if {[file exists $project_layout_base]} { set project_layouts [glob -nocomplain -dir $project_layout_base -type d -tail *] foreach layoutname $project_layouts { + puts stdout "Processing layout $project_layout_base/$layoutname" #don't auto-create src/bootsupport - just update it if it exists if {[file exists [file join $project_layout_base $layoutname/src/bootsupport]]} { set antipaths [list\ README.md\ ] - set boot_module_folders [glob -nocomplain -dir $projectroot/src/bootsupport/modules_tcl*] - lappend bootsupport_module_folders "modules" + #set boot_module_folders [list modules {*}[glob -nocomplain -dir $projectroot/src/bootsupport/modules_tcl*]] + set bootsupport_module_folders "modules" foreach bm $bootsupport_module_folders { if {[file exists $projectroot/src/bootsupport/$bm]} { lassign [split $bm _] _bm tclx @@ -1617,12 +1643,33 @@ if {$::punkboot::command eq "bootsupport"} { file mkdir $targetroot puts stdout "BOOTSUPPORT$which layouts/$layoutname: copying from $sourcemodules to $targetroot (if source file changed)" - set resultdict [punkcheck::install $sourcemodules $targetroot -overwrite installedsourcechanged-targets -antiglob_paths $antipaths] + + set resultdict [punkcheck::install $sourcemodules $targetroot\ + -overwrite installedsourcechanged-targets\ + -antiglob_paths $antipaths\ + -installer "punkboot-bootsupport" + ] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] flush stdout } } } + #make.tcl (to be boot.tcl?) is part of bootsupport + set source_bootscript [file join $projectroot src/make.tcl] + set targetroot_bootscript $project_layout_base/$layoutname/src + if {[file exists $source_bootscript]} { + puts stdout "BOOTSUPPORT layouts/$layoutname: copying from $source_bootscript to $targetroot_bootscript (if source file changed)" + set resultdict [punkcheck::install [file dirname $source_bootscript] $targetroot_bootscript\ + -glob make.tcl\ + -max_depth 1\ + -createempty 0\ + -overwrite installedsourcechanged-targets\ + -installer "punkboot-bootsupport" + ] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + flush stdout + } } } else { puts stderr "No layout base at $project_layout_base" diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/argparsingtest-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/argparsingtest-0.1.0.tm new file mode 100644 index 00000000..1ede846b --- /dev/null +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/argparsingtest-0.1.0.tm @@ -0,0 +1,568 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from -buildversion.txt +# module template: punkshell/src/decktemplates/vendor/punk/modules/template_module-0.0.2.tm +# +# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. +# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# (C) Julian Noble 2024 +# +# @@ Meta Begin +# Application argparsingtest 0.1.0 +# Meta platform tcl +# Meta license MIT +# @@ Meta End + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# doctools header +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[manpage_begin punkshell_module_argparsingtest 0 0.1.0] +#[copyright "2024"] +#[titledesc {Module API}] [comment {-- Name section and table of contents description --}] +#[moddesc {-}] [comment {-- Description at end of page heading --}] +#[require argparsingtest] +#[keywords module] +#[description] +#[para] - + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section Overview] +#[para] overview of argparsingtest +#[subsection Concepts] +#[para] - + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[subsection dependencies] +#[para] packages used by argparsingtest +#[list_begin itemized] + +package require Tcl 8.6- +package require punk::args +package require struct::set +#*** !doctools +#[item] [package {Tcl 8.6}] +#[item] [package {punk::args}] + +# #package require frobz +# #*** !doctools +# #[item] [package {frobz}] + +#*** !doctools +#[list_end] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section API] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# oo::class namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval argparsingtest::class { + #*** !doctools + #[subsection {Namespace argparsingtest::class}] + #[para] class definitions + if {[info commands [namespace current]::interface_sample1] eq ""} { + #*** !doctools + #[list_begin enumerated] + + # oo::class create interface_sample1 { + # #*** !doctools + # #[enum] CLASS [class interface_sample1] + # #[list_begin definitions] + + # method test {arg1} { + # #*** !doctools + # #[call class::interface_sample1 [method test] [arg arg1]] + # #[para] test method + # puts "test: $arg1" + # } + + # #*** !doctools + # #[list_end] [comment {-- end definitions interface_sample1}] + # } + + #*** !doctools + #[list_end] [comment {--- end class enumeration ---}] + } +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Base namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval argparsingtest { + namespace export {[a-z]*} ;# Convention: export all lowercase + #variable xyz + + #*** !doctools + #[subsection {Namespace argparsingtest}] + #[para] Core API functions for argparsingtest + #[list_begin definitions] + + proc test1_ni {args} { + set defaults [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_seps \uFFEF\ + -x ""\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + foreach {k v} $args { + if {$k ni [dict keys $defaults]} { + error "unrecognised option '$k'. Known options [dict keys $defaults]" + } + } + set opts [dict merge $defaults $args] + } + proc test1_switchmerge {args} { + set defaults [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_seps \uFFEF\ + -x ""\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + foreach {k v} $args { + switch -- $k { + -return - -show_edge - -show_seps - -frametype - -x - -y - -z - -1 - -2 - -3 {} + default { + error "unrecognised option '$k'. Known options [dict keys $defaults]" + } + } + } + set opts [dict merge $defaults $args] + } + #if we need to loop to test arg validity anyway - then dict set as we go is slightly faster than a dict merge at the end + proc test1_switch {args} { + set opts [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_seps \uFFEF\ + -x ""\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + foreach {k v} $args { + switch -- $k { + -return - -show_edge - -show_seps - -frametype - -x - -y - -z - -1 - -2 - -3 { + dict set opts $k $v + } + default { + error "unrecognised option '$k'. Known options [dict keys $opts]" + } + } + } + return $opts + } + variable switchopts + set switchopts [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_seps \uFFEF\ + -x ""\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + #slightly slower than just creating the dict within the proc + proc test1_switch_nsvar {args} { + variable switchopts + set opts $switchopts + foreach {k v} $args { + switch -- $k { + -return - -show_edge - -show_seps - -frametype - -x - -y - -z - -1 - -2 - -3 { + dict set opts $k $v + } + default { + error "unrecognised option '$k'. Known options [dict keys $opts]" + } + } + } + return $opts + } + proc test1_switch2 {args} { + set opts [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_seps \uFFEF\ + -x ""\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + set switches [lmap v [dict keys $opts] {list $v -}] + set switches [concat {*}$switches] + set switches [lrange $switches 0 end-1] + foreach {k v} $args { + switch -- $k\ + {*}$switches { + dict set opts $k $v + }\ + default { + error "unrecognised option '$k'. Known options [dict keys $opts]" + } + } + return $opts + } + proc test1_prefix {args} { + set opts [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_seps \uFFEF\ + -x ""\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + foreach {k v} $args { + dict set opts [tcl::prefix::match -message "test1_prefix option $k" {-return -frametype -show_edge -show_seps -x -y -z -1 -2 -3} $k] $v + } + return $opts + } + proc test1_prefix2 {args} { + set opts [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_seps \uFFEF\ + -x ""\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + if {[llength $args]} { + set knownflags [dict keys $opts] + } + foreach {k v} $args { + dict set opts [tcl::prefix::match -message "test1_prefix2 option $k" $knownflags $k] $v + } + return $opts + } + + #punk::args is slower than argp - but comparable, and argp doesn't support solo flags + proc test1_punkargs {args} { + set argd [punk::args::parse $args withdef { + @id -id ::argparsingtest::test1_punkargs + @cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" + @opts -anyopts 0 + -return -default string -type string + -frametype -default \uFFEF -type string + -show_edge -default \uFFEF -type string + -show_seps -default \uFFEF -type string + -join -type none -multiple 1 + -x -default "" -type string + -y -default b -type string + -z -default c -type string + -1 -default 1 -type boolean + -2 -default 2 -type integer + -3 -default 3 -type integer + @values + }] + return [tcl::dict::get $argd opts] + } + + punk::args::define { + @id -id ::test1_punkargs_by_id + @cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" + @opts -anyopts 0 + -return -default string -type string + -frametype -default \uFFEF -type string + -show_edge -default \uFFEF -type string + -show_seps -default \uFFEF -type string + -join -type none -multiple 1 + -x -default "" -type string + -y -default b -type string + -z -default c -type string + -1 -default 1 -type boolean + -2 -default 2 -type integer + -3 -default 3 -type integer + @values + } + proc test1_punkargs_by_id {args} { + set argd [punk::args::get_by_id ::test1_punkargs_by_id $args] + return [tcl::dict::get $argd opts] + } + + punk::args::define { + @id -id ::argparsingtest::test1_punkargs2 + @cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" + @opts -anyopts 0 + -return -default string -type string + -frametype -default \uFFEF -type string + -show_edge -default \uFFEF -type string + -show_seps -default \uFFEF -type string + -join -type none -multiple 1 + -x -default "" -type string + -y -default b -type string + -z -default c -type string + -1 -default 1 -type boolean + -2 -default 2 -type integer + -3 -default 3 -type integer + @values + } + proc test1_punkargs2 {args} { + set argd [punk::args::get_by_id ::argparsingtest::test1_punkargs2 $args] + return [tcl::dict::get $argd opts] + } + + + proc test1_punkargs_validate_ansistripped {args} { + set argd [punk::args::get_dict { + @id -id ::argparsingtest::test1_punkargs_validate_ansistripped + @cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" + @opts -anyopts 0 + -return -default string -type string -choices {string object} -help "return type" + -frametype -default \uFFEF -type string + -show_edge -default \uFFEF -type string + -show_seps -default \uFFEF -type string + -join -type none -multiple 1 + -x -default "" -type string + -y -default b -type string + -z -default c -type string + -1 -default 1 -type boolean -validate_ansistripped true + -2 -default 2 -type integer -validate_ansistripped true + -3 -default 3 -type integer -validate_ansistripped true + @values + } $args] + return [tcl::dict::get $argd opts] + } + + package require opt + variable optlist + tcl::OptProc test1_opt { + {-return string "return type"} + {-frametype \uFFEF "type of frame"} + {-show_edge \uFFEF "show table outer borders"} + {-show_seps \uFFEF "show separators"} + {-join "solo option"} + {-x "" "x val"} + {-y b "y val"} + {-z c "z val"} + {-1 1 "1val"} + {-2 -int 2 "2val"} + {-3 -int 3 "3val"} + } { + set opts [dict create] + foreach v [info locals] { + dict set opts $v [set $v] + } + return $opts + } + + package require cmdline + #cmdline::getoptions is much faster than typedGetoptions + proc test1_cmdline_untyped {args} { + set cmdlineopts_untyped { + {return.arg "string" "return val"} + {frametype.arg \uFFEF "frame type"} + {show_edge.arg \uFFEF "show table borders"} + {show_seps.arg \uFFEF "show table seps"} + {join "join the things"} + {x.arg "" "arg x"} + {y.arg b "arg y"} + {z.arg c "arg z"} + {1.arg 1 "arg 1"} + {2.arg 2 "arg 2"} + {3.arg 3 "arg 3"} + } + + set usage "usage etc" + return [::cmdline::getoptions args $cmdlineopts_untyped $usage] + } + proc test1_cmdline_typed {args} { + set cmdlineopts_typed { + {return.arg "string" "return val"} + {frametype.arg \uFFEF "frame type"} + {show_edge.arg \uFFEF "show table borders"} + {show_seps.arg \uFFEF "show table seps"} + {join "join the things"} + {x.arg "" "arg x"} + {y.arg b "arg y"} + {z.arg c "arg z"} + {1.boolean 1 "arg 1"} + {2.integer 2 "arg 2"} + {3.integer 3 "arg 3"} + } + + set usage "usage etc" + return [::cmdline::typedGetoptions args $cmdlineopts_typed $usage] + } + + catch { + package require argp + argp::registerArgs test1_argp { + { -return string "string" } + { -frametype string \uFFEF } + { -show_edge string \uFFEF } + { -show_seps string \uFFEF } + { -x string "" } + { -y string b } + { -z string c } + { -1 boolean 1 } + { -2 integer 2 } + { -3 integer 3 } + } + } + proc test1_argp {args} { + argp::parseArgs opts + return [array get opts] + } + + package require tepam + tepam::procedure {test1_tepam} { + -args { + {-return -type string -default string} + {-frametype -type string -default \uFFEF} + {-show_edge -type string -default \uFFEF} + {-show_seps -type string -default \uFFEF} + {-join -type none -multiple} + {-x -type string -default ""} + {-y -type string -default b} + {-z -type string -default c} + {-1 -type boolean -default 1} + {-2 -type integer -default 2} + {-3 -type integer -default 3} + } + } { + return [dict create return $return frametype $frametype show_edge $show_edge show_seps $show_seps x $x y $y z $z 1 $1 2 $2 3 $3 join $join] + } + + #multiline values use first line of each record to determine amount of indent to trim + proc test_multiline {args} { + set t3 [textblock::frame t3] + set argd [punk::args::get_dict [subst { + -template1 -default { + ****** + * t1 * + ****** + } + -template2 -default { ------ + ****** + * t2 * + ******} + -template3 -default {$t3} + #substituted or literal values with newlines - no autoindent applied - caller will have to pad appropriately + -template3b -default { + $t3 + ----------------- + $t3 + abc\ndef + } + -template4 -default "****** + * t4 * + ******" + -template5 -default " + + + " + -flag -default 0 -type boolean + }] $args] + return $argd + } + + #proc sample1 {p1 n args} { + # #*** !doctools + # #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] + # #[para]Description of sample1 + # #[para] Arguments: + # # [list_begin arguments] + # # [arg_def tring p1] A description of string argument p1. + # # [arg_def integer n] A description of integer argument n. + # # [list_end] + # return "ok" + #} + + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace argparsingtest ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Secondary API namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval argparsingtest::lib { + namespace export {[a-z]*} ;# Convention: export all lowercase + namespace path [namespace parent] + #*** !doctools + #[subsection {Namespace argparsingtest::lib}] + #[para] Secondary functions that are part of the API + #[list_begin definitions] + + #proc utility1 {p1 args} { + # #*** !doctools + # #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] + # #[para]Description of utility1 + # return 1 + #} + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace argparsingtest::lib ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[section Internal] +namespace eval argparsingtest::system { + #*** !doctools + #[subsection {Namespace argparsingtest::system}] + #[para] Internal functions that are not part of the API + + + +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide argparsingtest [namespace eval argparsingtest { + variable pkg argparsingtest + variable version + set version 0.1.0 +}] +return + +#*** !doctools +#[manpage_end] + diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/commandstack-0.3.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/commandstack-0.3.tm index ee486569..a45eaeaf 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/commandstack-0.3.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/commandstack-0.3.tm @@ -211,7 +211,7 @@ namespace eval commandstack { set new_code [string trim $procbody] if {$current_code eq $new_code} { puts stderr "(commandstack::rename_command) WARNING - renamer '$renamer' has already renamed the '$command' command with same procbody - Aborting rename." - puts stderr [show_stack $command] + puts stderr [::commandstack::show_stack $command] } else { puts stderr "(commandstack::rename_command) WARNING - renamer '$renamer' has already renamed the '$command' command - but appears to be with new code - proceeding." puts stdout "----------" @@ -236,8 +236,7 @@ namespace eval commandstack { set next_target ::commandstack::renamed_commands::${mungedcommand}_${munged_next_implementor}-$mungedrenamer-$tokenid set do_rename 1 } elseif {$next_implementor in {unspecified undetermined}} { - #review - probably don't need a warning anyway - puts stderr "(commandstack::rename_command) WARNING - Something may have renamed the '$command' command. Attempting to cooperate.(untested)" + #could be a standard tcl proc, or from application or package set next_target ::commandstack::renamed_commands::${mungedcommand}_${munged_next_implementor}-$mungedrenamer-$tokenid set do_rename 1 } else { @@ -380,7 +379,8 @@ namespace eval commandstack { #if caller is attempting exact match - use the calling context to resolve in case they didn't supply namespace set commandname_glob [uplevel 1 [list namespace which $commandname_glob]] } - if {[package provide punk::lib] ne ""} { + if {[package provide punk::lib] ne "" && [package provide punk] ne ""} { + #punk pipeline also needed for patterns return [punk::lib::pdict -channel none all_stacks $commandname_glob/@*/@*.@*] } else { set result "" diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/funcl-0.1.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/funcl-0.1.tm index 1d2fe64a..e8430fb0 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/funcl-0.1.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/funcl-0.1.tm @@ -9,7 +9,7 @@ package provide funcl [namespace eval funcl { namespace eval funcl { - #from punk + #from punk::pipe proc arg_is_script_shaped {arg} { if {[string first " " $arg] >= 0} { return 1 diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/include_modules.config b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/include_modules.config index 158166cf..816f3331 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/include_modules.config +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/include_modules.config @@ -18,7 +18,6 @@ set bootsupport_modules [list\ src/vendormodules md5\ src/vendormodules metaface\ src/vendormodules modpod\ - src/vendormodules oolib\ src/vendormodules overtype\ src/vendormodules pattern\ src/vendormodules patterncmd\ @@ -40,6 +39,7 @@ set bootsupport_modules [list\ modules funcl\ modules natsort\ modules punk\ + modules punk::pipe\ modules punkapp\ modules punkcheck\ modules punkcheck::cli\ diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/overtype-1.6.5.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/overtype-1.6.5.tm index fb044b3c..9363fb6d 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/overtype-1.6.5.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/overtype-1.6.5.tm @@ -216,7 +216,9 @@ tcl::namespace::eval overtype { } set optargs [lrange $args 0 end-2] if {[llength $optargs] % 2 == 0} { - lassign [lrange $args end-1 end] underblock overblock + set overblock [lindex $args end] + set underblock [lindex $args end-1] + #lassign [lrange $args end-1 end] underblock overblock set argsflags [lrange $args 0 end-2] } else { set optargs [lrange $args 0 end-1] @@ -1810,8 +1812,10 @@ tcl::namespace::eval overtype { if {[llength $args] < 2} { error {usage: ?-info 0|1? ?-startcolumn ? ?-cursor_column ? ?-cursor_row |""? ?-transparent [0|1|]? ?-expand_right [1|0]? undertext overtext} } - lassign [lrange $args end-1 end] under over - if {[string first \n $under] >= 0} { + set under [lindex $args end-1] + set over [lindex $args end] + #lassign [lrange $args end-1 end] under over + if {[string last \n $under] >= 0} { error "overtype::renderline not allowed to contain newlines in undertext" } #if {[string first \n $over] >=0 || [string first \n $under] >= 0} { @@ -2920,6 +2924,7 @@ tcl::namespace::eval overtype { set leadernorm [tcl::string::range [tcl::string::map [list\ \x1b\[< 1006\ \x1b\[ 7CSI\ + \x1bY 7MAP\ \x1bP 7DCS\ \x90 8DCS\ \x9b 8CSI\ @@ -2948,6 +2953,10 @@ tcl::namespace::eval overtype { #8-bit Device Control String set codenorm [tcl::string::cat $leadernorm [tcl::string::range $code 1 end]] } + 7MAP { + #map to another type of code to share implementation branch + set codenorm $leadernorm[tcl::string::range $code 1 end] + } 7ESC { #set codenorm [tcl::string::cat $leadernorm [tcl::string::range $code 1 end]] set codenorm $leadernorm[tcl::string::range $code 1 end] @@ -2964,6 +2973,30 @@ tcl::namespace::eval overtype { } } + switch -- $leadernorm { + 7MAP { + switch -- [lindex $codenorm 4] { + Y { + #vt52 movement. we expect 2 chars representing position (limited range) + set params [tcl::string::range $codenorm 5 end] + if {[tcl::string::length $params] != 2} { + #shouldn't really get here or need this branch if ansi splitting was done correctly + puts stderr "overtype::renderline ESC Y recognised as vt52 move, but incorrect parameters length ([string length $params] vs expected 2) [ansistring VIEW -lf 1 -vt 1 -nul 1 $code] not implemented codenorm:[ansistring VIEW -lf 1 -vt 1 -nul 1 $codenorm]" + } + set line [tcl::string::index $params 5] + set column [tcl::string::index $params 1] + set r [expr {[scan $line %c] -31}] + set c [expr {[scan $column %c] -31}] + + #MAP to: + #CSI n;m H - CUP - Cursor Position + set leadernorm 7CSI + set codenorm "$leadernorm${r}\;${c}H" + } + } + } + } + #we've mapped 7 and 8bit escapes to values we can handle as literals in switch statements to take advantange of jump tables. switch -- $leadernorm { 1006 { @@ -2982,7 +3015,8 @@ tcl::namespace::eval overtype { {7CSI} - {8CSI} { set param [tcl::string::range $codenorm 4 end-1] #puts stdout "--> CSI [tcl::string::index $leadernorm 0] bit param:$param" - set code_end [tcl::string::index $codenorm end] ;#used for e.g h|l set/unset mode + set code_end [tcl::string::index $codenorm end] ;#used for e.g h|l set/unset mode + switch -exact -- $code_end { A { #Row move - up @@ -3875,6 +3909,7 @@ tcl::namespace::eval overtype { 7ESC { # #re_other_single {\x1b(D|M|E)$} + #also vt52 Y.. #also PM \x1b^...(ST) switch -- [tcl::string::index $codenorm 4] { c { @@ -4586,6 +4621,8 @@ tcl::namespace::eval overtype::priv { set o [lreplace $o $i $i] set ustacks [lreplace $ustacks $i $i] set gxstacks [lreplace $gxstacks $i $i] + } elseif {$i == 0 || $i == $nxt} { + #nothing to do } else { puts stderr "render_delchar - attempt to delchar at index $i >= number of outcols $nxt - shouldn't happen" } diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk-0.1.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk-0.1.tm index 738d89c5..68a14411 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk-0.1.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk-0.1.tm @@ -20,6 +20,21 @@ namespace eval punk { variable cmdexedir set cmdexedir "" + proc sync_package_paths_script {} { + #the tcl::tm namespace doesn't exist until one of the tcl::tm commands + #is run. (they are loaded via ::auto_index triggering load of tm.tcl) + #we call tcl::tm::list to trigger the initial set of tm paths before + #we can override it, otherwise our changes will be lost + #REVIEW - won't work on safebase interp where paths are mapped to {$p(:x:)} etc + return "\ + apply {{ap tmlist} { + set ::auto_path \$ap + tcl::tm::list + set ::tcl::tm::paths \$tmlist + }} {$::auto_path} {[tcl::tm::list]} + " + } + proc rehash {{refresh 0}} { global auto_execs if {!$refresh} { @@ -217,7 +232,7 @@ namespace eval punk { [file exists [set testapp [file join $::env(LOCALAPPDATA) "Microsoft" "WindowsApps" "winget.exe"]]])} { #should be unlikely to get here - unless LOCALAPPDATA missing set windowsappdir [file dirname [lindex [::punk::auto_execok_windows winget.exe] 0]] - puts stderr "(resolved winget by search)" + catch {puts stderr "(resolved winget by search)"} } else { set windowsappdir [file dirname $testapp] } @@ -359,7 +374,7 @@ if {![llength [info commands ::ansistring]]} { } #require aliascore after punk::lib & punk::ansi are loaded package require punk::aliascore ;#mostly punk::lib aliases -punk::aliascore::init +punk::aliascore::init -force 1 package require punk::repl::codethread package require punk::config @@ -383,8 +398,10 @@ namespace eval punk { package require punk::assertion if {[catch {namespace import ::punk::assertion::assert} errM]} { - puts stderr "punk error importing punk::assertion::assert\n$errM" - puts stderr "punk::a* commands:[info commands ::punk::a*]" + catch { + puts stderr "punk error importing punk::assertion::assert\n$errM" + puts stderr "punk::a* commands:[info commands ::punk::a*]" + } } punk::assertion::active on # -- --- --- @@ -393,7 +410,7 @@ namespace eval punk { if {[catch { package require pattern } errpkg]} { - puts stderr "Failed to load package pattern error: $errpkg" + catch {puts stderr "Failed to load package pattern error: $errpkg"} } package require shellfilter package require punkapp @@ -524,7 +541,7 @@ namespace eval punk { set loader [zzzload::pkg_wait twapi] } errM]} { if {$loader in [list failed loading]} { - puts stderr "Unexpected problem during thread-load of pkg twapi - zzload::pkg_wait returned $loader" + catch {puts stderr "Unexpected problem during thread-load of pkg twapi - zzload::pkg_wait returned $loader"} } } else { package require twapi @@ -1061,7 +1078,7 @@ namespace eval punk { proc destructure {selector data} { # replaced by proc generating destructure_func - - puts stderr "punk::destructure .d. selector:'$selector'" + catch {puts stderr "punk::destructure .d. selector:'$selector'"} set selector [string trim $selector /] upvar v_dict_idx v_dict_idx ;#positional tracker for /@@ - dict position diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/aliascore-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/aliascore-0.1.0.tm index 296bb6df..3d1d87e9 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/aliascore-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/aliascore-0.1.0.tm @@ -105,6 +105,7 @@ tcl::namespace::eval punk::aliascore { #functions must be in export list of their source namespace set aliases [tcl::dict::create\ + val ::punk::pipe::val\ aliases ::punk::lib::aliases\ alias ::punk::lib::alias\ tstr ::punk::lib::tstr\ @@ -123,12 +124,12 @@ tcl::namespace::eval punk::aliascore { colour ::punk::console::colour\ ansi ::punk::console::ansi\ color ::punk::console::colour\ + a? ::punk::console::code_a?\ + A? {::punk::console::code_a? forcecolor}\ a+ ::punk::console::code_a+\ A+ {::punk::console::code_a+ forcecolour}\ a ::punk::console::code_a\ A {::punk::console::code_a forcecolour}\ - a? ::punk::console::code_a?\ - A? {::punk::console::code_a? forcecolor}\ smcup ::punk::console::enable_alt_screen\ rmcup ::punk::console::disable_alt_screen\ ] diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm index 422c524e..b367be2a 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm @@ -137,7 +137,7 @@ tcl::namespace::eval punk::ansi::class { @id -id "::punk::ansi::class::class_ansi render_to_input_line" @cmd -name "punk::ansi::class::class_ansi render_to_input_line" -help\ "render string from line 0 to line - (experimental/debug)" + (experimental/debug)" -dimensions -type string -help\ "WxH where W is integer width >= 1 and H is integer heigth >= 1" -minus -type integer -help\ @@ -584,25 +584,38 @@ tcl::namespace::eval punk::ansi { set base $CWD } } + if {[info commands file] eq ""} { + #probably a safe interp + return "UNAVAILABLE" + } return [file join $base src/testansi] } - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + @dynamic @id -id ::punk::ansi::example @cmd -name punk::ansi::example -help "Display .ans image files in a grid that will fit in console " - -colwidth -default 82 -help "Width of each column - default of 82 will fit a standard 80wide ansi image (when framed) - You can specify a narrower width to truncate images on the right side" - -folder -default "${[punk::ansi::Get_ansifolder]}" -help "Base folder for files if relative paths are used. - Defaults to /src/testansi - where projectbase is determined from current directory. + -colwidth -default 82 -help\ + "Width of each column - default of 82 will fit a standard 80wide ansi image + (when framed) + You can specify a narrower width to truncate images on the right side" + -folder -default "${[punk::ansi::Get_ansifolder]}" -help\ + "Base folder for files if relative paths are used. + Defaults to /src/testansi - where projectbase is determined + from the current directory. " @values -min 0 -max -1 - files -default {belinda.ans bot.ans flower.ans fish.ans} -multiple true -help "List of filenames - leave empty to display 4 defaults" + files -default {belinda.ans bot.ans flower.ans fish.ans} -multiple true -help\ + "List of filenames - leave empty to display 4 defaults" } ""] proc example {args} { set argd [punk::args::get_by_id ::punk::ansi::example $args] set colwidth [dict get $argd opts -colwidth] + if {[info commands file] eq ""} { + error "file command unavailable - punk::ansi::example cannot be shown" + } set ansifolder [file normalize [dict get $argd opts -folder]] set fnames [dict get $argd values files] @@ -617,6 +630,16 @@ tcl::namespace::eval punk::ansi { puts stderr "Ensure ansi test files exist: $fnames" #error "punk::ansi::example Cannot find example files" } + set termsize [punk::console:::get_size] + set termcols [dict get $termsize columns] + set margin 4 ;#review + set freewidth [expr {$termcols-$margin}] + if {$freewidth < $colwidth} { + puts stderr "[a+ red bold]punk::ansi::example freewidth: $freewidth < colwidth: $colwidth TRUNCATING IMAGES[a]" + set colwidth $freewidth + } + set per_row [expr {$freewidth / $colwidth}] + set missingbase [a+ yellow][textblock::block [expr {$colwidth-2}] 23 ?][a] ;#assuming standard frame - subtract 2 for left/right borders set pics [list] foreach f $fnames { @@ -636,10 +659,6 @@ tcl::namespace::eval punk::ansi { } } - set termsize [punk::console:::get_size] - set margin 4 - set freewidth [expr {[tcl::dict::get $termsize columns]-$margin}] - set per_row [expr {$freewidth / $colwidth}] set rowlist [list] ;# { { } { } } set heightlist [list] ;# { { } { } } @@ -737,22 +756,23 @@ tcl::namespace::eval punk::ansi { #review - can terminals handle SGR codes within a PM? #Wezterm will hide PM,SOS,APC - but not any part following an SGR code - i.e it seems to terminate hiding before the ST (apparently at the ) proc controlstring_PM {text} { - return "\x1b^${text}\033\\" + #dquotes with trailing \\ in string will confuse silly editors + return \x1b^${text}\033\\ } proc controlstring_PM8 {text} { - return "\x9e${text}\x9c" + return \x9e${text}\x9c } proc controlstring_SOS {text} { - return "\x1bX${text}\033\\" + return \x1bX${text}\033\\ } proc controlstring_SOS8 {text} { - return "\x98${text}\x9c" + return \x98${text}\x9c } proc controlstring_APC {text} { - return "\x1b_${text}\033\\" + return \x1b_${text}\033\\ } proc controlstring_APC8 {text} { - return "\x9f${text}\x9c" + return \x9f${text}\x9c } #there is also the SGR hide code (8) which has intermittent terminal support #This doesn't change the output length - so support is tricky to detec. (terminal checksum report?) @@ -843,10 +863,79 @@ tcl::namespace::eval punk::ansi { return $out } + + #Wrap text in ansi codes to switch to DEC alternate graphics character set. + #todo vt52 versions proc g0 {text} { return \x1b(0$text\x1b(B } + variable altg_map [dict create\ + hl q\ + vl x\ + tlc l\ + trc k\ + blc m\ + ltj t\ + rtj u\ + ttj w\ + btj v\ + rtj u\ + fwj n\ + ] + proc altg_map {names} { + variable altg_map + set result [list] + foreach nm $names { + if {[dict exists $altg_map $nm]} { + lappend result [dict get $altg_map $nm] + } else { + lappend "" + } + } + return $result + } + + # -------------------------------- + # Taken from term::ansi::code::ctrl + # -------------------------------- + #Note that SYN (\016) seems to put terminals in a state + #where alternate graphics are not processed. + #an ETB (\017) needs to be sent to get alt graphics working again. + #It isn't known what software utilises SYN/ETB within altg sequences + # (presumably to alternate between the charsets within a graphics-on/graphics-off section) + #but as modern emulators seem to react to it, we should handle it. + #REVIEW - this mapping not fully understood + #used by groptim + variable grforw + variable grback + variable _ + + foreach _ { + ! \" # $ % & ' ( ) * + , - . / + 0 1 2 3 4 5 6 7 8 9 : ; < = > + ? @ A B C D E F G H I J K L M + N O P Q R S T U V W X Y Z [ ^ + \\ ] + } { + lappend grforw \016$_ $_\016 + lappend grback $_\017 \017$_ + } + unset _ + # ------------------------------ + #REVIEW - see forward/backward map in term::ansi::code::macros::cd::groptim - what are they for?? + proc groptim {string} { + variable grforw + variable grback + set offon \x1b(B\x1b(0 ;#)) ;#editor highlighting comment + set onoff \x1b(0\x1b(B ;#)) ;#editor highlighting comment + while {![string equal $string [set new [string map [list $offon {} $onoff {}] [string map $grback [string map $grforw $string]]]]]} { + set string $new + } + return $string + } + # -------------------------------- + proc ansistrip_gx {text} { #e.g "\033(0" - select VT100 graphics for character set G0 #e.g "\033(B" - reset @@ -854,10 +943,10 @@ tcl::namespace::eval punk::ansi { #e.g "\033)X" - where X is any char other than 0 to reset ?? #return [convert_g0 $text] - return [tcl::string::map [list "\x1b(0" "" \x1b(B" "" "\x1b)0" "" "\x1b)X" ""] $text] + return [tcl::string::map [list \x1b(0 "" \x1b(B "" \x1b)0 "" \x1b)X ""] $text] } proc stripansi_gx {text} { - return [tcl::string::map [list "\x1b(0" "" \x1b(B" "" "\x1b)0" "" "\x1b)X" ""] $text] + return [tcl::string::map [list \x1b(0 "" \x1b(B "" \x1b)0 "" \x1b)X ""] $text] } @@ -1459,7 +1548,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu tcl::dict::set opts $k $v } default { - error "colourmap1 unrecognised option $k. Known-options: [tcl::dict::keys $opts] + error "colourmap1 unrecognised option $k. Known-options: [tcl::dict::keys $opts]" } } } @@ -2358,11 +2447,11 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu lappend PUNKARGS [list { @id -id ::punk::ansi::sgr_cache @cmd -name punk::ansi::sgr_cache -help\ - "Convenience function to view and optionally clear the ansi character attribute cache (ansi SGR codes) - " + "Convenience function to view and optionally clear the ansi character attribute cache + (ansi SGR codes)" -action -default "" -choices "clear" -help\ "-action clear will unset the keys in the punk::ansi::sgr_cache dict - This is called automatically when setting 'colour false' in the console" + This is called automatically when setting 'colour false' in the console" -pretty -default 1 -type boolean -help\ "use 'pdict punk::ansi::sgr_cache */%str,%ansiview' output" @@ -2882,7 +2971,8 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set SGR_samples [dict create] foreach k [dict keys $SGR_map] { - dict set SGR_samples $k "[punk::ansi::a+ $k]sample\x1b\[m" + #indent of 1 space is important for clarity in i -return string a+ output + dict set SGR_samples $k " [punk::ansi::a+ $k]sample\x1b\[m" } lappend PUNKARGS [list { @id -id ::punk::ansi::a+ @@ -2895,23 +2985,23 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu code -type string -optional 1 -multiple 1 -choices {}\ -choicelabels {}\ -choicecolumns 5 -choiceprefix 0 -choicerestricted 0 -help\ - "SGR code from the list below, or an integer corresponding to the code e.g 31 = red. - A leading capital letter indicates a codename applies to the background colour. - Other accepted codes are: - term- Term- foreground/background where int is 0-255 terminal color - term- Term- foreground/background - rgb--- Rgb--- foreground/background where are the - 0-255 int values for red, green and blue. - rgb# Rgb# where is a 6 char hex colour e.g rgb#C71585 - web- Web- + "SGR code from the list below, or an integer corresponding to the code e.g 31 = red. + A leading capital letter indicates a codename applies to the background colour. + Other accepted codes are: + term- Term- foreground/background where int is 0-255 terminal color + term- Term- foreground/background + rgb--- Rgb--- foreground/background where are the + 0-255 int values for red, green and blue. + rgb# Rgb# where is a 6 char hex colour e.g rgb#C71585 + web- Web- - The acceptable values for and can be queried using - punk::ansi::a? term - and - punk::ansi::a? web + The acceptable values for and can be queried using + punk::ansi::a? term + and + punk::ansi::a? web - Example to set foreground red and background cyan followed by a reset: - set str \"[a+ red Cyan]sample text[a]\" + Example to set foreground red and background cyan followed by a reset: + set str \"[a+ red Cyan]sample text[a]\" " }]] @@ -3264,7 +3354,55 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu return $result } - proc ansiwrap {codes text} { + lappend PUNKARGS [list { + @id -id ::punk::ansi::ansiwrap + @cmd -name punk::ansi::ansiwrap -help\ + "Wrap a string with ANSI codes from + supplied codelist(s) followed by trailing + ANSI reset. + + Codes are numbers or strings as indicated + in the output of the colour information + function: punk::ansi::a? + + No leading reset is applied - so when + placing resultant text, any existing + SGR codes that aren't overridden may + still take effect. + + For finer control use the a+ and a + functions eg + set x \"[a+ red]text [a+ bold]etc[a]\" + " + @leaders -min 0 -max -1 + codelist -multiple 1 -default {} -type list -help\ + "ANSI names/ints as understood by 'a?' + (Not actual ANSI as output by a+) + These can be supplied individually or + as a list or lists" + @values -min 1 -max 1 + text -type string -help\ + "String to wrap with ANSI (SGR)" + }] + #proc ansiwrap {codes text} { + # return [a {*}$codes]$text[a] + #} + proc ansiwrap2 {args} { + set argd [punk::args::parse $args withid ::punk::ansi::ansiwrap] + set codelists [dict get $argd leaders codelist] + set text [dict get $argd values text] + set codes [concat {*}$codelists] ;#flatten + return [a {*}$codes]$text[a] + } + proc ansiwrap {args} { + if {[llength $args] < 1} { + #minimal args parsing - unhappy path only + punk::args::parse $args withid ::punk::ansi::ansiwrap + return + } + set text [lindex $args end] + set codelists [lrange $args 0 end-1] + set codes [concat {*}$codelists] ;#flatten return [a {*}$codes]$text[a] } @@ -3300,6 +3438,14 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[call [fun reset_soft]] return \x1b\[!p } + proc SYN {} { + #syn seems to disable alternate graphics mode temporarily on modern terminals + return \016 + } + proc ETB {} { + #This is a form of soft reset for the state where a SYN was sent - re-enabling altg processing + return \017 + } proc reset_colour {} { #*** !doctools #[call [fun reset_colour]] @@ -3341,6 +3487,12 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[call [fun cursor_off]] return "\033\[?25l" } + proc cursor_on_vt52 {} { + return \x1be + } + proc cursor_off_vt52 {} { + return \x1bf + } # REVIEW - osc8 replays etc for split lines? - textblock #Hyperlinks (a.k.a. HTML-like anchors) in terminal emulators https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda @@ -3387,6 +3539,24 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } # -- --- --- --- --- + lappend PUNKARGS [list { + @id -id ::punk::ansi::move + @cmd -name punk::ansi::move -help\ + {Return an ANSI sequence to move cursor to row,col + (aka: cursor home) + + Sequence is of the form: + \x1b[;H + (CSI row ; col H) + This sequence will not be understood by old vt52 + terminals. see also vt52_move. + } + @values -min 2 -max 2 + row -type integer -help\ + "row number - starting at 1" + col -type integer -help\ + "column number - starting at 1" + }] proc move {row col} { #*** !doctools #[call [fun move] [arg row] [arg col]] @@ -3394,6 +3564,44 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[para]aka cursor home return \033\[${row}\;${col}H } + #NOTE vt52 uses ESC Y line column + # where line and column are ascii codes whose values are +31 + # vt52 can be entered/exited via escapes + # This means we probably need to to wrap enter/exit vt52 and keep this state - as we don't have a standard way to query for terminal type + # (vt52 supports ESC Z - but vt100 sometimes? doesn't - and querying at each output would be slow anyway, even if there was a common query :/ ) + + lappend PUNKARGS [list { + @id -id ::punk::ansi::vt52move + @cmd -name punk::ansi::vt52move -help\ + {Return a VT52 sequence to move cursor to row,col + (aka: cursor home) + + Sequence is of the form: + ESCY + This sequence will generally not be understood by terminals + that are not in vt52 mode (e.g DECANM unset). + } + @values -min 2 -max 2 + row -type integer -help\ + "row number - starting at 1" + col -type integer -help\ + "column number - starting at 1" + }] + proc vt52move {row col} { + #test + set r [format %c [expr {$row + 31}]] + set c [format %c [expr {$col + 31}]] + return \x1bY${r}${c} + } + proc vt52color {int} { + if {[string is integer -strict $int]} { + if {$int < 0 || $int > 15} { + error "vt52color unsupported - only 0 to 15 available" + } + } + set char [format %c [expr {$int + 31}]] + return \x1bb${char} + } proc move_emit {row col data args} { #*** !doctools #[call [fun move_emit] [arg row] [arg col] [arg data] [opt {row col data...}]] @@ -3424,6 +3632,27 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } return $out } + proc vt52move_emit {row col data args} { + #Todo - G code? + set out "" + if {$row eq "this"} { + #append out \033\[\;${col}G$data + append out [vt52move_column $col]$data + } else { + #append out \033\[${row}\;${col}H$data + append out [vt52move $row $col]$data + } + foreach {row col data} $args { + if {$row eq "this"} { + append out [vt52move_column $col]$data + #append out \033\[\;${col}G$data + } else { + #append out \033\[${row}\;${col}H$data + append out [vt52move $row $col]$data + } + } + return $out + } proc move_emitblock {row col textblock} { #*** !doctools #[call [fun move_emitblock] [arg row] [arg col] [arg textblock]] @@ -3434,31 +3663,63 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } return $commands } + proc vt52move_emitblock {row col textblock} { + #*** !doctools + #[call [fun move_emitblock] [arg row] [arg col] [arg textblock]] + set commands "" + foreach ln [split $textblock \n] { + append commands [punk::ansi::vt52move_emit $row $col $ln] + incr row + } + return $commands + } proc move_forward {{n 1}} { #*** !doctools #[call [fun move_forward] [arg n]] return \033\[${n}C } + proc vt52move_forward {{n 1}} { + return [string repeat \x1bC $n] + } proc move_back {{n 1}} { #*** !doctools #[call [fun move_back] [arg n]] return \033\[${n}D } + proc vt52move_back {{n 1}} { + return [string repeat \x1bD $n] + } proc move_up {{n 1}} { #*** !doctools #[call [fun move_up] [arg n]] return \033\[${n}A } + proc vt52move_up {{n 1}} { + return [string repeat \x1bA $n] + } proc move_down {{n 1}} { #*** !doctools #[call [fun move_down] [arg n]] return \033\[${n}B } + proc vt52move_down {{n 1}} { + return [string repeat \x1bB $n] + } proc move_column {col} { #*** !doctools #[call [fun move_column] [arg col]] return \x1b\[${col}G } + proc vt52move_column {col} { + #This is a bit of a fudge - as there is no command to move to a specific column. + #without tracking state - we settle for moving back enough times to ensure we're at column 1 - and then move forward. + #inefficient - but will have to do I guess. + #review - max term width vt52? env var LINES and env var COLUMNS ? + # also ESC R CR - set window size + set back [string repeat \x1bD 132] + set fwd [string repeat \x1bC [expr {$col - 1}]] + return $back$fwd + } proc move_row {row} { #*** !doctools #[call [fun move_row] [arg row]] @@ -3496,6 +3757,13 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[para] DECRC return \x1b8 } + proc cursor_save_vt52 {} { + return \x1bj + } + proc cursor_restore_vt52 {} { + return \x1bk + } + # -- --- --- --- --- #CRM Show Control Character Mode proc enable_crm {} { @@ -3550,18 +3818,131 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu # \x1b\[?7\;1\$y # \x1b\[?7\;2\$y #where 1 = set, 2 = unset. (0 = mode not recognised, 3 = permanently set, 4 = permanently unset) + + #https://wiki.tau.garden/dec-modes/ + #(DEC,xterm,contour,mintty,kitty etc) + #https://invisible-island.net/xterm/ctlseqs/ctlseqs.html#h2-Mouse-Tracking + + #names for other alt_screen mechanismk: 1047,1048 vs 1049? + #variable decmode_names [dict create\ + # DECANM 2\ + # origin 6\ + # DECCOLM 3\ + # line_wrap 7\ + # LNM 20\ + # alt_screen 1049\ + # grapheme_clusters 2027\ + # bracketed_paste 2004\ + # mouse_sgr 1006\ + # mouse_urxvt 1015\ + # mouse_sgr_pixel 1016\ + #] + variable decmode_data { + 1 { + {origin DEC description "DECCKM - Cursor Keys Mode" names {DECCKM cursor_keys}} + } + 2 { + {origin DEC description "DECANM - ANSI/VT52 Mode" names {DECANM} note { +Disable to turn on VT52 emulation. +In VT52 mode - use \x1b< to exit. + } + } + } + 3 { + {origin DEC description "DECCOLM - Column" names {DECCOLM}} + } + 4 { + {origin DEC description "DECSCLM - Scrolling" names {DECSCLM}} + } + 5 { + {origin DEC description "DECSCNM - Screen Mode (light or dark screen)" names {DECSNM lightmode}} + } + 7 { + {origin DEC description "DECAWM - Auto Wrap Mode" names {DECAWM line_wrap}} + } + 9 { + {origin "xterm" description "X10 compatibility mouse" names {SET_X10_MOUSE mouse_tracking} note { +Escape sequence on button press only. +CSI M CbCxCy (6 chars) +Coords limited to 223 (=255 - 32) + } + } + {origin DEC description "DECINLM - Interlace Mode (obsolete?)" names {DECINLM}} + } + 20 { + {origin DEC description "LNM - Line Feed/New Line Mode" names {LNM} note { +For terminals that support LNM, the default is off +meaning a lone CR respresents the character emitted +when enter is pushed. Turning LNM on would mean that +CR LF is sent when hitting enter. This feature is +not commonly supported, and the default will normally +be as if this was off - ie lone CR. + } + } + } + 25 { + {origin DEC description "DECTCEM - Text Cursor Enable Mode" names {DECTCEM cursor_enable}} + } + 47 { + {origin xterm description "xterm alternate buffer" names {xterm_altbuf}} + {origin DEC description "DECGRPM - Graphics Rotated Print Mode (obsolete?)" names {DECGRPM}} + } + 66 { + {origin DEC description "DECNKM - Numeric Keypad Mode" names {DECNKM}} + } + 1000 { + {origin "xterm" description "VT200 compatibility mouse" names {SET_VT200_MOUSE} note { +Escape sequence on both button press and release. +CSI M CbCxCy + } + } + } + 1004 { + {origin "xterm" description "Send FocusIn/FocusOut events" names {mouse_focus_event}} + } + 1005 { + {origin "xterm" description "Enable UTF-8 Mouse Mode" names {mouse_utf8 mouse_utf8_extended}} + } + 1006 { + {origin "xterm" description "Enable SGR Mouse Mode" names {mouse_sgr mouse_sgr_extended} note{ +SET_SGR_EXT_MODE_MOUSE - extended compared to x10 mouse protocol which limits x y coords +to 223 (=255 - 32) + } + } + } + 1015 { + {origin "urxvt" description "Enable urxvt Mouse Mode" names {mouse_urxvt}} + } + 1016 { + {origin "xterm" description "Enable SGR Pixel Mouse Mode" names {mouse_sgr_pixel}} + } + 1047 { + {origin "xterm" description "Alternate Buffer" names {alt_buffer_only}} + } + 1049 { + {origin "xterm" description "Alternate Buffer with save cursor" names {alt_buffer alt_screen}} + } + 2004 { + {origin "xterm" description "Set bracketed paste mode" names {bracketed_paste}} + } + 2027 { + {origin Contour description "Grapheme Cluster Processing" names {grapheme_clusters}} + } + } + set decmode_names [dict create] + dict for {code items} $decmode_data { + foreach itm $items { + set names [dict get $itm names] + foreach nm $names { + dict set decmode_names $nm $code + } + } + } + + + + - #names for other alt_screen mechanisms: 1047,1048 vs 1049? - variable decmode_names [dict create\ - line_wrap 7\ - LNM 20\ - alt_screen 1049\ - grapheme_clusters 2027\ - bracketed_paste 2004\ - mouse_sgr_extended 1006\ - mouse_urxvt 1015\ - mouse_sgr 1016\ - ] proc query_mode {num_or_name} { if {[string is integer -strict $num_or_name]} { set m $num_or_name @@ -3674,11 +4055,17 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[para]Erase to start of line, leaving cursor position alone. return \033\[1K } + proc vt52erase_sol {} { + return \x1bo + } proc erase_eol {} { #*** !doctools #[call [fun erase_eol]] return \033\[K } + proc vt52erase_eol {} { + return \x1bK + } #see also clear_above clear_below # -- --- --- --- --- @@ -3732,6 +4119,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu proc cursor_pos_extended {} { #includes page e.g ^[[47;3;1R + #(but not on all terminals - some (freebsd?) will report as per 6n e.g ^[[74;3R) return \033\[?6n } @@ -3789,6 +4177,9 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[para]This may not work on terminals which have multiple panes/windows return "\033\]2;$windowtitle\033\\" ;#works for xterm and most derivatives } + proc vt52titleset {windowtitle} { + return \x1bS$windowtitle\r + } #titleget - https://invisible-island.net/xterm/xterm.faq.html#how2_title #no cross-platform ansi-only mechanism ? @@ -4672,8 +5063,14 @@ tcl::namespace::eval punk::ansi::ta { variable re_osc_open {(?:\x1b\]|\u009d).*} - variable standalone_code_map [list \x1bc "" \x1b7 "" \x1b8 "" \x1bM "" \x1bE "" \x1bD "" \x1bH "" \x1b= "" \x1b> "" \x1b#3 "" \x1b#4 "" \x1b#5 "" \x1b#6 "" \x1b#8 ""] - variable re_standalones {(?:\x1bc|\x1b7|\x1b8|\x1bM|\x1bE|\x1bD|\x1bD|\x1bH|\x1b=|\x1b>|\x1b#3|\x1b#4|\x1b#5|\x1b#6|\x1b#8)} + #variable standalone_code_map [list \x1bc "" \x1b7 "" \x1b8 "" \x1bM "" \x1bE "" \x1bD "" \x1bH "" \x1b= "" \x1b> "" \x1b#3 "" \x1b#4 "" \x1b#5 "" \x1b#6 "" \x1b#8 ""] + variable re_standalones {(?:\x1bc|\x1b7|\x1b8|\x1bM|\x1bD|\x1bE|\x1bH|\x1b=|\x1b>|\x1b#3|\x1b#4|\x1b#5|\x1b#6|\x1b#8)} + variable re_standalones_vt52 {(?:\x1bZ)} + + #ESC Y move, ESC b foreground colour + #ESC F - gr-on ESC G - gr-off + variable re_vt52_open {(?:\x1bY|\x1bb|\x1bF)} + #\x1bc vt52 bgcolour conflict ?? #if we don't split on altgraphics too and separate them out - it's easy to get into a horrible mess variable re_g0_group {(?:\x1b\(0)(?:(?!\x1b\(B).)*\x1b\(B} @@ -4686,7 +5083,7 @@ tcl::namespace::eval punk::ansi::ta { #regex to capture the start of string/privacy message/application command block including the contents and string terminator (ST) #non-greedy by exclusion of ST terminators in body - #we need to match \x1b\\ not just \x1b There could be colour codes nested in a privacy msg/string + #we need to match \x1b\\ not just \x1b There could be colour codes nested in a privacy msg/string (not widely supported?) #even if terminals generally don't support that - it's quite possible for an ansi code to get nested this way - and we'd prefer it not to break our splits #Just checking for \x1b will terminate the match too early #we also need to track the start of ST terminated code and not add it for replay (in the ansistring functions) @@ -4705,17 +5102,44 @@ tcl::namespace::eval punk::ansi::ta { #handrafted TRIE version of above. Somewhat difficult to construct and maintain. TODO - find a regexp TRIE generator that works with Tcl regexes #This does make things quicker - but it's too early to finalise the detect/split regexes (e.g missing \U0090 ) - will need to be redone. #variable re_ansi_detect {(?:\x1b(?:\((?:0|B)|\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|c|7|8|M|E|D|H|=|>|(?:#(?:3|4|5|6|8))))|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]|(?:\u009d)(?:[^\u009c]*)?\u009c} - variable re_ansi_detect {(?:\x1b(?:\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|\((?:0|B)|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|c|7|8|M|E|D|H|=|>|(?:#(?:3|4|5|6|8))))|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]|(?:\u009d)(?:[^\u009c]*)?\u009c} + + #NOTE - the literal # char can cause problems in expanded syntax - even though it's within a bracketed section. \# seems to work though. + #vt52 specific |<|A|B|C|I|J|K|L|M|Z|(?:Y(?:..))|(?:b(?:.)| + #https://freemint.github.io/tos.hyp/en/VT_52_terminal.html + #what to with ESC c vs vt52 ESC c (background colour) ??? + #we probably need to use a separate re_ansi_detect for vt52 + + #although it's stated later terminals are backwards compatible with vt52 - that doesn't seem to mean for example a vt100 will process vt52 codes at the same time as ansi codes + #ie - when DECANM is on - VT52 codes are *not* processed + + #todo - ansi mode and cursor key mode set ? + # arrow keys -> ESC O A, ESC O B, ESC O C, ESC O D + # plus more for auxiliary keypad codes in keypad application mode (and some in numeric mode) + + variable re_ansi_detect {(?x) + (?:\x1b(?:\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|c|7|8|M|D|E|H|=|>|<|A|B|C|I|J|K|L|M|Z|(?:Y(?:..))|(?:b(?:.))|\((?:0|B)|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|(?:\#(?:3|4|5|6|8)))) + |(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c) + |(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e] + |(?:\u009d)(?:[^\u009c]*)?\u009c + } + #--- + # -- --- --- --- #variable re_csi_code {(?:\x1b\[|\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]} - variable re_ansi_detect_open "${re_csi_open}|${re_osc_open}|${re_standalones}|${re_ST_open}|${re_g0_open}" + variable re_ansi_detect_open "${re_csi_open}|${re_osc_open}|${re_standalones}|${re_standalones_vt52}|${re_ST_open}|${re_g0_open}|${re_vt52_open}" #may be same as detect - kept in case detect needs to diverge #variable re_ansi_split "${re_csi_code}|${re_esc_osc1}|${re_esc_osc2}|${re_esc_osc3}|${re_standalones}|${re_ST}|${re_g0_open}|${re_g0_close}" set re_ansi_split $re_ansi_detect + variable re_ansi_split_multi + if {[string first (?x) $re_ansi_split] == 0} { + set re_ansi_split_multi "(?x)(?:[string range ${re_ansi_split} 4 end])+" + } else { + set re_ansi_split_multi "(?:${re_ansi_split})+" + } lappend PUNKARGS [list -dynamic 0 { @id -id ::punk::ansi::ta::detect @@ -4922,81 +5346,46 @@ tcl::namespace::eval punk::ansi::ta { # -- --- --- --- --- --- #Split $text to a list containing alternating ANSI colour codes and text. #ANSI colour codes are always on the second element, fourth, and so on. - #(ie plaintext on odd list-indices ansi on even indices) + #(ie plaintext on even list-indices ansi on odd indices) + #result of split on non-empty string always has an odd length - with indices 0 and end always being plaintext (possibly empty string) # Example: - #ta_split_codes "" # => "" - #ta_split_codes "a" # => "a" - #ta_split_codes "a\e[31m" # => {"a" "\e[31m"} - #ta_split_codes "\e[31ma" # => {"" "\e[31m" "a"} - #ta_split_codes "\e[31ma\e[0m" # => {"" "\e[31m" "a" "\e[0m"} - #ta_split_codes "\e[31ma\e[0mb" # => {"" "\e[31m" "a" "\e[0m", "b"} - #ta_split_codes "\e[31m\e[0mb" # => {"" "\e[31m\e[0m" "b"} + #split_codes "" # => "" + #split_codes "a" # => "a" + #split_codes "a\e[31m" # => {"a" "\e[31m" ""} + #split_codes "\e[31ma" # => {"" "\e[31m" "a"} + #split_codes "\e[31ma\e[0m" # => {"" "\e[31m" "a" "\e[0m" ""} + #split_codes "\e[31ma\e[0mb" # => {"" "\e[31m" "a" "\e[0m", "b"} + #split_codes "\e[31m\e[0mb" # => {"" "\e[31m\e[0m" "b"} # proc split_codes {text} { - variable re_ansi_split - set re "(?:${re_ansi_split})+" - return [_perlish_split $re $text] + variable re_ansi_split_multi + return [_perlish_split $re_ansi_split_multi $text] } #micro optimisations on split_codes to avoid function calls and make re var local tend to yield very little benefit (sub uS diff on calls that commonly take 10s/100s of uSeconds) - #like split_codes - but each ansi-escape is split out separately (with empty string of plaintext between codes so odd/even plain ansi still holds) + #like split_codes - but each ansi-escape is split out separately (with empty string of plaintext between codes so even/odd indices for plain ansi still holds) #- the slightly simpler regex than split_codes means that it will be slightly faster than keeping the codes grouped. - proc split_codes_single2 {text} { - variable re_ansi_split - return [_perlish_split $re_ansi_split $text] - } - proc split_codes_single3 {text} { - #copy from re_ansi_split - _perlish_split {(?:\x1b(?:\((?:0|B)|\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|c|7|8|M|E|D|H|=|>|(?:#(?:3|4|5|6|8))))|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]|(?:\u009d)(?:[^\u009c]*)?\u009c} $text - } - proc split_codes_single4 {text} { - if {$text eq ""} { - return {} - } - variable re_ansi_split - set re $re_ansi_split - #variable re_ansi_detect1 - #set re $re_ansi_detect1 - set list [list] - set start 0 - - #set re {(?:\x1b(?:\((?:0|B)|\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|c|7|8|M|E|D|H|=|>|(?:#(?:3|4|5|6|8))))|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]|(?:\u009d)(?:[^\u009c]*)?\u009c} - #We can get $matchEnd < $matchStart; we need to ensure there is an exit condition for non-greedy empty results REVIEW - #while {[regexp -start $start -indices -- {(?:\x1b(?:\((?:0|B)|\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|c|7|8|M|E|D|H|=|>|(?:#(?:3|4|5|6|8))))|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]|(?:\u009d)(?:[^\u009c]*)?\u009c} $text match]} {} - while {[regexp -start $start -indices -- $re $text match]} { - lassign $match matchStart matchEnd - #puts "->start $start ->match $matchStart $matchEnd" - lappend list [tcl::string::range $text $start $matchStart-1] - if {$matchEnd < $matchStart} { - set e $matchStart - incr start - } else { - set e $matchEnd - set start [expr {$matchEnd+1}] - } - lappend list [tcl::string::range $text $matchStart $e] - if {$start >= [tcl::string::length $text]} { - break - } - } - return [lappend list [tcl::string::range $text $start end]] - } proc split_codes_single {text} { if {$text eq ""} { return {} } variable re_ansi_split set next 0 - set b -1 + #set b -1 set list [list] set coderanges [regexp -indices -all -inline -- $re_ansi_split $text] foreach cr $coderanges { lappend list [tcl::string::range $text $next [lindex $cr 0]-1] [tcl::string::range $text [lindex $cr 0] [lindex $cr 1]] set next [expr {[lindex $cr 1]+1}] + #set next [lindex $cr 1]+1 ;#text index-expression for string range } lappend list [tcl::string::range $text $next end] return $list } + proc split_codes_single2 {text} { + variable re_ansi_split + return [_perlish_split $re_ansi_split $text] + } proc get_codes_single {text} { variable re_ansi_split regexp -all -inline -- $re_ansi_split $text @@ -5008,7 +5397,7 @@ tcl::namespace::eval punk::ansi::ta { return {} } set next 0 - set b -1 + #set b -1 set list [list] set coderanges [regexp -indices -all -inline -- $re $text] foreach cr $coderanges { @@ -5103,29 +5492,6 @@ tcl::namespace::eval punk::ansi::ta { #return [lappend list [tcl::string::range $text $start end]] yield [tcl::string::range $text $start end] } - proc _perlish_split2 {re text} { - if {[tcl::string::length $text] == 0} { - return {} - } - set list [list] - set start 0 - #We can get $matchEnd < $matchStart; we need to ensure there is an exit condition for non-greedy empty results REVIEW - while {[regexp -start $start -indices -- $re $text match]} { - lassign $match matchStart matchEnd - #puts "->start $start ->match $matchStart $matchEnd" - if {$matchEnd < $matchStart} { - lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::index $text $matchStart] - incr start - } else { - lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::range $text $matchStart $matchEnd] - set start [expr {$matchEnd+1}] - } - if {$start >= [tcl::string::length $text]} { - break - } - } - return [lappend list [tcl::string::range $text $start end]] - } proc _ws_split {text} { regexp -all -inline {(?:\S+)|(?:\s+)} $text } @@ -7429,12 +7795,10 @@ tcl::namespace::eval punk::ansi::internal { #todo - document interp alias {} ansistring {} ::punk::ansi::ansistring -if {![info exists ::punk::args::register::NAMESPACES]} { - namespace eval ::punk::args::register { - set NAMESPACES [list] - } +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::ansi ::punk::ansi::class ::punk::ansi::ta } -lappend ::punk::args::register::NAMESPACES ::punk::ansi ::punk::ansi::class ::punk::ansi::ta # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.1.0.tm index 37f8b712..e940dada 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.1.0.tm @@ -226,15 +226,26 @@ tcl::namespace::eval punk::args::register { #[para] The punk::args package will then test for a public list variable ::PUNKARGS containing argument definitions when it needs to. #[list_begin definitions] + #Although the actual punk::args::define calls are not too sluggish, there could be *many*. + #in a multi-interp environment, we want to be lazy about loading argdefs until they're actually required, + #especially since a fair proportion may be for documentation purposes rather than parsing args. + # -- --- --- --- --- --- --- --- - #cooperative with packages that define some punk args but may need to do so lazily - #These could be loaded prior to punk::args being loaded - variable NAMESPACES + #cooperative with packages that define some punk args but do so lazily + #These could be loaded prior to punk::args being loaded - so check existence of NAMESPACES var first + variable NAMESPACES ;#just declaring it with variable doesn't yet mean it 'exists' from 'info exists' perspective if {![info exists ::punk::args::register::NAMESPACES]} { - set NAMESPACES [list] + set ::punk::args::register::NAMESPACES [list] } # -- --- --- --- --- --- --- --- + variable loaded_packages [list] ;#fully loaded + variable loaded_info [dict create] ;#time + variable scanned_packages [list] ;#packages scanned for ids used to update namespace_docpackages + variable scanned_info [dict create] ;#time and idcount + #some packages, e.g punk::args::tclcore document other namespaces. + #when punk::args::update_definitions gets a query for a namespace - we need to load argdefs from registered sources + variable namespace_docpackages [dict create] #*** !doctools #[list_end] [comment {--- end definitions namespace punk::args::register ---}] @@ -250,14 +261,15 @@ tcl::namespace::eval punk::args { variable PUNKARGS ;#list of our own punk::args function argument definitions - loaded with punk::args::define at the end. tcl::namespace::export {[a-z]*} - variable argdata_cache - variable argdefcache_by_id - variable argdefcache_unresolved ;#key = original template list supplied to 'define', value = 2-element list: (tstr-parsed split of template) & (unresolved params) - variable id_counter - set argdata_cache [tcl::dict::create] - set argdefcache_by_id [tcl::dict::create] - set argdefcache_unresolved [tcl::dict::create] - set id_counter 0 + variable rawdef_cache [tcl::dict::create] ;#key on rawdef list - return dict of {-id -dynamic 0|1} + variable id_cache_rawdef [tcl::dict::create] + variable id_cache_spec [tcl::dict::create] + + variable argdefcache_unresolved [tcl::dict::create] ;#key = original template list supplied to 'define', value = 2-element list: (tstr-parsed split of template) & (unresolved params) + + variable argdata_cache [tcl::dict::create] + + variable id_counter 0 #*** !doctools #[subsection {Namespace punk::args}] @@ -321,22 +333,22 @@ tcl::namespace::eval punk::args { %B%@id%N% ?opt val...? options: -id %B%@cmd%N% ?opt val...? - options -name -help + options: -name -help %B%@leaders%N% ?opt val...? - options -min -max + options: -min -max (used for leading args that come before switches/opts) %B%@opts%N% ?opt val...? - options -any + options: -any %B%@values%N% ?opt val...? - options -min -max + options: -min -max (used for trailing args that come after switches/opts) %B%@argdisplay%N% ?opt val...? - options -header (text for header row of table) + options: -header (text for header row of table) -body (text to replace autogenerated arg info) %B%@doc%N% ?opt val...? - options -name -url + options: -name -url %B%@seealso%N% ?opt val...? - options -name -url (for footer - unimplemented) + options: -name -url (for footer - unimplemented) Some other options normally present on custom arguments are available to use with the @leaders @opts @values directives to set defaults @@ -418,6 +430,15 @@ tcl::namespace::eval punk::args { streaming and checksumming. The -choices list is equivalent to a -choicegroups dict entry where the key (groupname) is the empty string. + -choicemultiple (default {1 1}) + is a pair representing min and max number of choices + that can be present in the value. + If is a single integer it is equivalent to a + specified with the same integer for both min and max. + Max of -1 represents no upper limit. + If allows more than one choice the value is a list + consisting of items in the choices made available through + entries in -choices/-choicegrups. -minsize (type dependant) -maxsize (type dependant) -range (type dependant) @@ -425,27 +446,27 @@ tcl::namespace::eval punk::args { " -dynamic -type boolean -default 0 -help\ - "If -dynamic is true, tstr interpolations of the form \$\{\$var\} - are re-evaluated on each call. - If the definition is being used not just as documentation, but is also - used within the function to parse args, e.g using punk::args::get_by_id, - then it should be noted that there is a slight performance penalty for the - dynamic case. - It is often not significant, perhaps depending on what vars/commands are - used but -dynamic true might be less desirable if the command is used in - inner loops in more performance-sensitive code. + "If -dynamic is true, tstr interpolations of the form \$\{\$var\} + are re-evaluated on each call. + If the definition is being used not just as documentation, but is also + used within the function to parse args, e.g using punk::args::get_by_id, + then it should be noted that there is a slight performance penalty for the + dynamic case. + It is often not significant, perhaps depending on what vars/commands are + used but -dynamic true might be less desirable if the command is used in + inner loops in more performance-sensitive code. " @values -min 1 -max -1 text -type string -multiple 1 -help\ - "Block(s) of text representing the argument definition for a command. - At least one must be supplied. If multiple, they are joined together with \\n. - Using multiple text arguments may be useful to mix curly-braced and double-quoted - strings to have finer control over interpolation when defining arguments. - (this can also be handy for sections that pull resolved definition lines - from existing definitions (by id) for re-use of argument specifications and help text) - - e.g the following definition passes 2 blocks as text arguments - definition { + "Block(s) of text representing the argument definition for a command. + At least one must be supplied. If multiple, they are joined together with \\n. + Using multiple text arguments may be useful to mix curly-braced and double-quoted + strings to have finer control over interpolation when defining arguments. + (this can also be handy for sections that pull resolved definition lines + from existing definitions (by id) for re-use of argument specifications and help text) + + e.g the following definition passes 2 blocks as text arguments + definition { @id -id ::myns::myfunc @cmd -name myns::myfunc -help\\ \"Description of command\" @@ -454,13 +475,18 @@ tcl::namespace::eval punk::args { -option1 -default blah -type string #The following option defines a flag style option (solo) -flag1 -default 0 -type none -help\\ - \"Info about flag1\" + \"Info about flag1 + subsequent help lines auto-dedented by whitespace to left + of corresponding record start (in this case -flag1) + + first 4 spaces if they are all present. + This line has no extra indent relative to first line 'Info about flag1' + This line indented a further 6 chars\" @values -min 1 -max -1 #Items that don't begin with * or - are value definitions v1 -type integer -default 0 thinglist -type string -multiple 1 - } \"*doc -name Manpage: -url \[myfunc_manpage_geturl myns::myfunc]\" + } \"*doc -name Manpage: -url \[myfunc_manpage_geturl myns::myfunc]\" " }]] @@ -475,6 +501,7 @@ tcl::namespace::eval punk::args { -nocase 0\ -choiceprefix 1\ -choicerestricted 1\ + -choicemultiple {1 1}\ -multiple 0\ -regexprepass {}\ -validationtransform {}\ @@ -488,6 +515,7 @@ tcl::namespace::eval punk::args { -nocase 0\ -choiceprefix 1\ -choicerestricted 1\ + -choicemultiple {1 1}\ -multiple 0\ -regexprepass {}\ -validationtransform {}\ @@ -501,6 +529,7 @@ tcl::namespace::eval punk::args { -nocase 0\ -choiceprefix 1\ -choicerestricted 1\ + -choicemultiple {1 1}\ -multiple 0\ -regexprepass {}\ -validationtransform {}\ @@ -569,8 +598,23 @@ tcl::namespace::eval punk::args { #] } proc define {args} { + dict get [resolve {*}$args] id + } + proc resolve {args} { + variable rawdef_cache + variable id_cache_rawdef + if {[dict exists $rawdef_cache $args]} { + set id [dict get $rawdef_cache $args -id] + set is_dynamic [dict get $rawdef_cache $args -dynamic] + } else { + set id [rawdef_id $args] + set is_dynamic [rawdef_is_dynamic $args] + dict set rawdef_cache $args [dict create -id $id -dynamic $is_dynamic] + dict set id_cache_rawdef $id $args + } + + variable argdata_cache - variable argdefcache_by_id variable argdefcache_unresolved @@ -592,7 +636,6 @@ tcl::namespace::eval punk::args { punk::args::get_by_id ::punk::args::define {} return } - set is_dynamic 0 if {[lindex $args 0] eq "-dynamic"} { set is_dynamic [lindex $args 1] set textargs [lrange $args 2 end] @@ -699,14 +742,18 @@ tcl::namespace::eval punk::args { if {![tcl::info::complete $test_complete]} { #append linebuild [string trimleft $rawline] \n if {$in_record} { - if {[tcl::string::length $lastindent]} { - #trim only the whitespace corresponding to last indent - not all whitespace on left - if {[tcl::string::first $lastindent $rawline] == 0} { - set trimmedline [tcl::string::range $rawline [tcl::string::length $lastindent] end] - append linebuild $trimmedline \n - } else { - append linebuild $rawline \n - } + #trim only the whitespace corresponding to last record indent or lastindent + 4 spaces - not all whitespace on left + #this allows alignment of multiline help strings to left margin whilst maintaining a visual indent in source form. + #Aligning subsequent lines with the record, or aligning 4 spaces in are equivalent. + #ie to indent lines further - whitespace should be added 4+ columns in from the record-line start position. + #(this leaves an oddity if indenting is only 1 2 or 3 spaces mixed with longer indents as we don't check for it.. REVIEW) + #(note string first "" $str is fast and returns -1) + if {[tcl::string::first "$lastindent " $rawline] == 0} { + set trimmedline [tcl::string::range $rawline [tcl::string::length "$lastindent "] end] + append linebuild $trimmedline \n + } elseif {[tcl::string::first $lastindent $rawline] == 0} { + set trimmedline [tcl::string::range $rawline [tcl::string::length $lastindent] end] + append linebuild $trimmedline \n } else { append linebuild $rawline \n } @@ -719,14 +766,13 @@ tcl::namespace::eval punk::args { } } else { set in_record 0 - if {[tcl::string::length $lastindent]} { - #trim only the whitespace corresponding to last indent - not all whitespace on left - if {[tcl::string::first $lastindent $rawline] == 0} { - set trimmedline [tcl::string::range $rawline [tcl::string::length $lastindent] end] - append linebuild $trimmedline - } else { - append linebuild $rawline - } + #trim only the whitespace corresponding to last record indent or lastindent + 4 spaces - not all whitespace on left + if {[tcl::string::first "$lastindent " $rawline] == 0} { + set trimmedline [tcl::string::range $rawline [tcl::string::length "$lastindent "] end] + append linebuild $trimmedline + } elseif {[tcl::string::first $lastindent $rawline] == 0} { + set trimmedline [tcl::string::range $rawline [tcl::string::length $lastindent] end] + append linebuild $trimmedline } else { append linebuild $rawline } @@ -734,10 +780,13 @@ tcl::namespace::eval punk::args { set linebuild "" } } - set cmd_info {} - set id_info {} ;#e.g -children ?? - set doc_info {} + set cmd_info {} + set package_info {} + set id_info {} ;#e.g -children ?? + set doc_info {} set argdisplay_info {} ;#optional override of autogenerated 'Arg Type Default Multi Help' table + set seealso_info {} + set keywords_info {} ###set leader_min 0 ###set leader_max 0 ;#default 0 but if leader_min is set switches to -1 for no limit #set leader_max "" @@ -745,7 +794,7 @@ tcl::namespace::eval punk::args { set opt_any 0 set val_min 0 set val_max -1 ;#-1 for no limit - set DEF_definition_id "" + set DEF_definition_id $id #form_defs set F [dict create _default [New_command_form _default]] @@ -840,20 +889,26 @@ tcl::namespace::eval punk::args { set at_specs $record_values switch -- [tcl::string::range $directive_name 1 end] { + dynamic { + set is_dynamic 1 + } id { + #disallow duplicate @id line ? + #review - nothing to stop multiple @id lines - or redefining as auto (which is ignored?) + #id An id will be allocated if no id line present or the -id value is "auto" - if {$DEF_definition_id ne ""} { - #disallow duplicate @id line - error "punk::args::define - @id already set. Existing value $DEF_definition_id\n[join $args \n]" - } + if {[dict exists $at_specs -id]} { - set DEF_definition_id [dict get $at_specs -id] - } else { - set DEF_definition_id auto + set thisid [dict get $at_specs -id] + if {$thisid ni [list $id auto]} { + error "punk::args::define @id mismatch existing: $id vs $thisid" + } } set id_info $at_specs } ref { + #a reference within the definition + #e.g see punk::args::tclcore ::after #global reference dict - independent of forms #ignore refs without an -id #store all keys except -id @@ -867,10 +922,10 @@ tcl::namespace::eval punk::args { #(if we were to take from a definition - we would have to check and maybe change this def to -dynamic.. ?) #perhaps we could allow -dynamic as a flag here - but IFF this define is already -dynamic (?) #That is possibly too complicated and/or unnecessary? - #however.. as it stands we have define -dynamic 1 making *immediate* resolutions .. is that really desirable? + #however.. as it stands we have define @dynamic making *immediate* resolutions .. is that really desirable? if {[dict exists $at_specs -id]} { - set copyfrom [get_def [dict get $at_specs -id]] + set copyfrom [get_spec [dict get $at_specs -id]] #we don't copy the @id info from the source #for now we only copy across if nothing set.. #todo - bring across defaults for empty keys at targets? @@ -942,6 +997,9 @@ tcl::namespace::eval punk::args { } #new form keys already created if they were needed (done for all records that have -form ) } + package { + set package_info [dict merge $package_info $at_specs] + } cmd { #allow arbitrary - review set cmd_info [dict merge $cmd_info $at_specs] @@ -968,7 +1026,7 @@ tcl::namespace::eval punk::args { -anyopts { set opt_any $v } - -minsize - -maxsize - -range - -choices - -choicegroups - -choicecolumns - -choicelabels - -choiceinfo - -choiceprefix - -choiceprefixdenylist - -choicerestricted { + -minsize - -maxsize - -range - -choices - -choicegroups - -choicemultiple - -choicecolumns - -choicelabels - -choiceinfo - -choiceprefix - -choiceprefixdenylist - -choicerestricted { #review - only apply to certain types? tcl::dict::set tmp_optspec_defaults $k $v } @@ -1014,7 +1072,7 @@ tcl::namespace::eval punk::args { tcl::dict::set tmp_optspec_defaults $k $v } default { - set known { -any -anyopts -minsize -maxsize -range -choices -choicegroups -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted -nocase\ + set known { -any -anyopts -minsize -maxsize -range -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted -nocase\ -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ -regexprepass -regexprefail -regexprefailmsg -validationtransform\ @@ -1052,10 +1110,16 @@ tcl::namespace::eval punk::args { } dict set F $fid LEADER_MAX $v } - -minsize - -maxsize - -range - -choices - -choicegroups - -choicecolumns - -choicelabels - -choiceinfo - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -nocase { + -minsize - -maxsize - -range - -choices - -choicegroups - -choicemultiple - -choicecolumns - -choicelabels - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -nocase { #review - only apply to certain types? tcl::dict::set tmp_leaderspec_defaults $k $v } + -choiceinfo { + if {[llength $v] %2 != 0} { + error "punk::args::define - key '-choiceinfo' requires a dictionary value as an argument. got $v id:$DEF_definition_id" + } + tcl::dict::set tmp_leaderspec_defaults $k $v + } -nominsize - -nomaxsize - -norange - -nochoices - -nochoicelabels { #-choicegroups? if {$v} { @@ -1100,7 +1164,7 @@ tcl::namespace::eval punk::args { default { set known { -min -minvalues -max -maxvalues\ -minsize -maxsize -range\ - -choices -choicegroups -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted\ + -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted\ -nocase -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ -regexprepass -regexprefail -regexprefailmsg -validationtransform\ @@ -1138,12 +1202,18 @@ tcl::namespace::eval punk::args { } set val_max $v } - -minsize - -maxsize - -range - -choices - -choicegroups - -choicecolumns - -choicelabels - -choiceinfo - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -nocase { + -minsize - -maxsize - -range - -choices - -choicemultiple - -choicecolumns - -choicelabels - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -nocase { #review - only apply to certain types? tcl::dict::set tmp_valspec_defaults $k $v } + -choiceinfo - -choicegroups { + if {[llength $v] % 2 != 0} { + error "punk::args::define - key '$k' requires a dictionary value as an argument. got $v id:$DEF_definition_id" + } + tcl::dict::set tmp_valspec_defaults $k $v + } -nominsize - -nomaxsize - -norange - -nochoices - -nochoicelabels { - # -choicegoups ?? + # -choicegroups ?? if {$v} { set k2 -[string range $k 3 end] ;#strip 'no' tcl::dict::unset tmp_valspec_defaults $k2 @@ -1186,7 +1256,7 @@ tcl::namespace::eval punk::args { default { set known { -min -minvalues -max -maxvalues\ -minsize -maxsize -range\ - -choices -choicegroups -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted\ + -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted\ -nocase\ -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ @@ -1203,6 +1273,11 @@ tcl::namespace::eval punk::args { seealso { #todo! #like @doc, except displays in footer, multiple - sub-table? + set seealso_info [dict merge $seealso_info $at_specs] + } + keywords { + #review - put as option on @cmd instead? @cmd -name xxx -keywords {blah etc hmm} ?? + set keywords_info [dict merge $keywords_info $at_specs] } default { error "punk::args::define - unrecognised @ line in '$rec'. Expected @id @cmd @form... @leaders @opts @values @doc @argdisplay - use @@name if paramname needs to be @name @id:$DEF_definition_id" @@ -1331,7 +1406,7 @@ tcl::namespace::eval punk::args { } } -default - -solo - -range - - -choices - -choicegroups - -choicecolumns - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -choicelabels - -choiceinfo - + -choices - -choicegroups - -choicemultiple - -choicecolumns - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -choicelabels - -choiceinfo - -minsize - -maxsize - -nocase - -optional - -multiple - -validate_ansistripped - -allow_ansi - -strip_ansi - -help - -ARGTYPE - -regexprepass - -regexprefail - -regexprefailmsg @@ -1376,7 +1451,7 @@ tcl::namespace::eval punk::args { } } } else { - set known_argopts [list -form -default -type -range -minsize -maxsize -choices -choicegroups -choicecolumns -choiceprefix -choiceprefixdenylist -choicerestricted\ + set known_argopts [list -form -default -type -range -minsize -maxsize -choices -choicegroups -choicemultiple -choicecolumns -choiceprefix -choiceprefixdenylist -choicerestricted\ -nocase -optional -multiple -validate_ansistripped -allow_ansi -strip_ansi -help\ -regexprepass -regexprefail -regexprefailmsg -validationtransform\ ] @@ -1426,10 +1501,10 @@ tcl::namespace::eval punk::args { } ;# end foreach rec $records - if {$DEF_definition_id eq "" || [tcl::string::tolower $DEF_definition_id] eq "auto"} { - variable id_counter - set DEF_definition_id "autoid_[incr id_counter]" - } + #if {$DEF_definition_id eq "" || [tcl::string::tolower $DEF_definition_id] eq "auto"} { + # variable id_counter + # set DEF_definition_id "autoid_[incr id_counter]" + #} #check ALL forms not just form_ids_active (record_form_ids) @@ -1521,9 +1596,11 @@ tcl::namespace::eval punk::args { VAL_CHECKS_DEFAULTS [dict get $F $firstformid VAL_CHECKS_DEFAULTS]\ cmd_info $cmd_info\ doc_info $doc_info\ + package_info $package_info\ argdisplay_info $argdisplay_info\ + seealso_info $seealso_info\ id_info $id_info\ - temp_F $F\ + FORMS $F\ form_names [dict keys $F]\ FORM_INFO $form_info\ ] @@ -1533,42 +1610,75 @@ tcl::namespace::eval punk::args { #also cache resolved version tcl::dict::set argdata_cache $optionspecs $argdata_dict } - #tcl::dict::set argdefcache_by_id $DEF_definition_id $optionspecs - tcl::dict::set argdefcache_by_id $DEF_definition_id $args + + #tcl::dict::set id_cache_rawdef $DEF_definition_id $args #puts "xxx:$result" return $argdata_dict } #return raw definition list as created with 'define' - proc rawdef {id} { - variable argdefcache_by_id + # - possibly with unresolved dynamic parts + proc raw_def {id} { + variable id_cache_rawdef set realid [real_id $id] - #return the raw definition - possibly with unresolved dynamic parts - if {![dict exists $argdefcache_by_id $realid]} { + if {![dict exists $id_cache_rawdef $realid]} { return "" } - return [tcl::dict::get $argdefcache_by_id $realid] + return [tcl::dict::get $id_cache_rawdef $realid] } namespace eval argdoc { - variable resolved_def_TYPE_CHOICES {* @id @cmd @leaders @opts @values @doc} + variable resolved_def_TYPE_CHOICES {* @id @package @cmd @ref @doc @argdisplay @seealso @leaders @opts @values leaders opts values} + variable resolved_def_TYPE_CHOICEGROUPS { + directives {@id @package @cmd @ref @doc @argdisplay @seealso} + argumenttypes {leaders opts values} + remaining_defaults {@leaders @opts @values} + } - lappend PUNKARGS [list -dynamic 0 [string map [list %TYPECHOICES% $resolved_def_TYPE_CHOICES] { + lappend PUNKARGS [list [string map [list %TYPECHOICES% $resolved_def_TYPE_CHOICES %TYPECHOICEGROUPS% $resolved_def_TYPE_CHOICEGROUPS] { @id -id ::punk::args::resolved_def @cmd -name punk::args::resolved_def -help\ - "" + "Resolves or retrieves the previously resolved definition and + uses the 'spec' form to build a response in definition format. + + Pulling argument definition data from another function is a form + of tight coupling to the other function that should be done with + care. + + Note that the directives @leaders @opts @values may appear multiple + times in a source definition - applying defaults for arguments that + follow. When retrieving these - there is only a single result for + each that represents the defaults after all have been applied. + When retrieving -types * each of these will be positioned before + the arguments of that type - but this doesn't mean there was a single + leading directive for this argument type in the source definition. + Each argument has already had its complete specification recorded in + its own result. + + When manually specifying -types, the order @leaders then @opts then + @values must be maintained - but if they are placed before their + corresponding arguments, they will not affect the retrieved arguments + as these arguments are already fully spec'd. The defaults from the + source can be removed by adding @leaders, @opts @values to the + -antiglobs list, but again - this won't affect the existing arguments. + Each argument can have members of its spec overridden using the + -override dictionary. + " @leaders -min 0 -max 0 @opts -form -default 0 -help\ - "UNIMPLEMENTED - Ordinal index or name of command form" - -type -default * -choices {%TYPECHOICES%} -choiceprefix 0 -multiple 1 + "Ordinal index or name of command form" + + #no restriction on number of types/repetitions? + -types -default * -choices {%TYPECHOICES%} -choicegroups {%TYPECHOICEGROUPS%} -choiceprefix 0 -choicemultiple {0 -1} + -antiglobs -default {} -type list -help\ + "Glob patterns for directive or argument/flags to + be suppressed" -override -type dict -optional 1 -default "" -help\ "dict of dicts. Key in outer dict is the name of a directive or an argument. Inner dict is a map of overrides/additions (- ...) for that line. - (unimplemented). " @values -min 1 -max -1 id -type string -help\ @@ -1597,23 +1707,24 @@ tcl::namespace::eval punk::args { proc resolved_def {args} { set opts [dict create\ - -type {}\ + -types {}\ -form 0\ + -antiglobs {}\ -override {}\ ] if {[llength $args] < 1} { #must have at least id - punk::args::get_by_id ::punk::args::resolved_def $args + punk::args::parse $args withid ::punk::args::resolved_def return } set patterns [list] - #a definition id must not begin with "-" + #a definition id must not begin with "-" ??? review for {set i 0} {$i < [llength $args]} {incr i} { set a [lindex $args $i] - if {$a eq "-type"} { + if {$a in {-type -types}} { incr i - dict lappend opts -type [lindex $args $i] + dict set opts -types [lindex $args $i] } elseif {[string match -* $a]} { incr i dict set opts $a [lindex $args $i] @@ -1623,7 +1734,7 @@ tcl::namespace::eval punk::args { break } if {$i == [llength $args]-1} { - punk::args::get_by_id ::punk::args::resolved_def $args + punk::args::parse $args withid ::punk::args::resolved_def return } } @@ -1632,47 +1743,121 @@ tcl::namespace::eval punk::args { } dict for {k v} $opts { switch -- $k { - -form - -type - -override {} + -form - -types - -antiglobs - -override {} default { - punk::args::get_by_id ::punk::args::resolved_def $args + punk::args::parse $args withid ::punk::args::resolved_def return } } } - set typelist [dict get $opts -type] + set typelist [dict get $opts -types] if {[llength $typelist] == 0} { set typelist {*} } foreach type $typelist { if {$type ni $::punk::args::argdoc::resolved_def_TYPE_CHOICES} { - punk::args::get_by_id ::punk::args::resolved_def $args + punk::args::parse $args withid ::punk::args::resolved_def return } } - variable argdefcache_by_id + + variable id_cache_rawdef set realid [real_id $id] if {$realid ne ""} { - set deflist [tcl::dict::get $argdefcache_by_id $realid] + set deflist [tcl::dict::get $id_cache_rawdef $realid] set result "" - set specdict [uplevel 1 [list ::punk::args::define {*}$deflist]] - set arg_info [dict get $specdict ARG_INFO] - set argtypes [dict create @opts option @leaders leader @values value] + set specdict [uplevel 1 [list ::punk::args::resolve {*}$deflist]] + + set opt_form [dict get $opts -form] + if {[string is integer -strict $opt_form]} { + set formname [lindex [dict get $specdict form_names] $opt_form] + } else { + set formname $opt_form + } + set opt_override [dict get $opts -override] + + #set arg_info [dict get $specdict ARG_INFO] + set arg_info [dict get $specdict FORMS $formname ARG_INFO] + set argtypes [dict create leaders leader opts option values value] + + set opt_antiglobs [dict get $opts -antiglobs] + set directives [lsearch -all -inline -exact -not $::punk::args::argdoc::resolved_def_TYPE_CHOICES *] + set suppressed_directives [list] + set suppressed_args [list] + foreach ag $opt_antiglobs { + foreach d $directives { + if {[string match $ag $d]} { + lappend suppressed_directives $d + } + } + foreach argname [dict keys $arg_info] { + if {[string match $ag $argname]} { + lappend suppressed_args $argname + } + } + } + set suppressed_directives [lsort -unique $suppressed_directives] + set suppressed_args [lsort -unique $suppressed_args] + + set included_directives [punk::args::system::punklib_ldiff $directives $suppressed_directives] + + set globbed [list] + foreach pat $patterns { + set matches [dict keys $arg_info $pat] + lappend globbed {*}$matches + } + set globbed [lsort -unique $globbed] + set included_args [punk::args::system::punklib_ldiff $globbed $suppressed_args] + foreach type $typelist { switch -exact -- $type { * { - append result \n "@id -id [dict get $specdict id]" - append result \n "@cmd [dict get $specdict cmd_info]" - append result \n "@doc [dict get $specdict doc_info]" - foreach tp {leader option value} { - foreach pat $patterns { - set matches [dict keys $arg_info $pat] - foreach m $matches { - set def [dict get $arg_info $m] - if {[dict get $def -ARGTYPE] eq $tp} { - set def [dict remove $def -ARGTYPE] - append result \n "$m $def" + if {"@id" in $included_directives} { + if {[dict exists $opt_override @id]} { + append result \n "@id [dict merge [dict create -id [dict get $specdict id]] [dict get $opt_override @id]]" + } else { + append result \n "@id -id [dict get $specdict id]" + } + } + foreach directive {@package @cmd @doc @seealso @argdisplay} { + set dshort [string range $directive 1 end] + if {"$directive" in $included_directives} { + if {[dict exists $opt_override $directive]} { + append result \n "$directive [dict merge [dict get $specdict ${dshort}_info] [dict get $opt_override $directive]]" + } else { + append result \n "$directive [dict get $specdict ${dshort}_info]" + } + } + } + #output ordered by leader, option, value + foreach pseudodirective {leaders opts values} tp {leader option value} { + set directive "@$pseudodirective" + switch -- $directive { + @leaders {set defaults_key leaderspec_defaults} + @opts {set defaults_key optspec_defaults} + @values {set defaults_key valspec_defaults} + } + + if {"$directive" in $included_directives} { + if {[dict exists $opt_override "$directive"]} { + append result \n "$directive [dict merge [dict get $specdict $defaults_key] [dict get $opt_override $directive]]" + } else { + append result \n "$directive [dict get $specdict $defaults_key]" + } + } + + if {$pseudodirective in $included_directives} { + foreach m $included_args { + set argspec [dict get $arg_info $m] + if {[dict get $argspec -ARGTYPE] eq $tp} { + set argspec [dict remove $argspec -ARGTYPE] + if {[dict exists $opt_override $m]} { + append result \n "$m [dict merge $argspec [dict get $opt_override $m]]" + } else { + append result \n "$m $argspec" + } } } } @@ -1680,27 +1865,52 @@ tcl::namespace::eval punk::args { } @id { - #only a single id record can exist - append result \n "@id -id [dict get $specdict id]" - } - @cmd { - #only a single @cmd record can exist - #merged if multiple in original def (?) - append result \n "@cmd [dict get $specdict cmd_info]" + if {"@id" in $included_directives} { + #only a single id record can exist + if {[dict exists $opt_override @id]} { + append result \n "@id [dict merge [dict create -id [dict get $specdict id]] [dict get $opt_override @id]]" + } else { + append result \n "@id -id [dict get $specdict id]" + } + } } - @doc { - #only a single @doc record can exist - append result \n "@doc [dict get $specdict doc_info]" + @package - @cmd - @doc - @seealso - @argdisplay { + if {"$type" in $included_directives} { + set tp [string range $type 1 end] ;# @package -> package + if {[dict exists $opt_override $type]} { + append result \n "$type [dict merge [dict get $specdict ${tp}_info] [dict get $opt_override $type]]" + } else { + append result \n "$type [dict get $specdict ${tp}_info]" + } + } } @leaders - @opts - @values { - #option, - foreach pat $patterns { - set matches [dict keys $arg_info $pat] - foreach m $matches { - set def [dict get $arg_info $m] - if {[dict get $def -ARGTYPE] eq [dict get $argtypes $type]} { - set def [dict remove $def -ARGTYPE] - append result \n "$m $def" + #these are the active defaults for further arguments + if {"$type" in $included_directives} { + switch -- $type { + @leaders {set defaults_key leaderspec_defaults} + @opts {set defaults_key optspec_defaults} + @values {set defaults_key valspec_defaults} + } + if {[dict exists $opt_override $type]} { + append result \n "$type [dict merge [dict get $specdict leaderspec_defaults] [dict get $opt_override $type]]" + } else { + append result \n "$type [dict get $specdict leaderspec_defaults]" + } + } + } + leaders - opts - values { + #pseudo-directives + if {$type in $included_directives} { + foreach m $included_args { + set argspec [dict get $arg_info $m] + if {[dict get $argspec -ARGTYPE] eq [dict get $argtypes $type]} { + set argspec [dict remove $argspec -ARGTYPE] + if {[dict exists $opt_override $m]} { + append result \n "$m [dict merge $argspec [dict get $opt_override $m]]" + } else { + append result \n "$m $argspec" + } } } } @@ -1714,12 +1924,12 @@ tcl::namespace::eval punk::args { } } - proc get_spec_values {id {patternlist *}} { - variable argdefcache_by_id + proc resolved_def_values {id {patternlist *}} { + variable id_cache_rawdef set realid [real_id $id] if {$realid ne ""} { - set speclist [tcl::dict::get $argdefcache_by_id $realid] - set specdict [define {*}$speclist] + set speclist [tcl::dict::get $id_cache_rawdef $realid] + set specdict [resolve {*}$speclist] set arg_info [dict get $specdict ARG_INFO] set valnames [dict get $specdict VAL_NAMES] set result "" @@ -1744,18 +1954,69 @@ tcl::namespace::eval punk::args { } } } - #proc get_spec_leaders ?? - #proc get_spec_opts ?? + #proc resolved_def_leaders ?? + #proc resolved_def_opts ?? - proc get_def {id} { - return [define {*}[rawdef $id]] + proc get_spec {id} { + set rdef [raw_def $id] + if {$rdef eq ""} {return} + return [resolve {*}$rdef] #if {[id_exists $id]} { - # return [define {*}[rawdef $id]] + # return [resolve {*}[raw_def $id]] #} } proc is_dynamic {id} { - set deflist [rawdef $id] - return [expr {[lindex $deflist 0] eq "-dynamic" && [lindex $deflist 1]} ] + variable id_cache_rawdef + variable rawdef_cache + set deflist [raw_def $id] + if {[dict exists $rawdef_cache $deflist -dynamic]} { + return [dict get $rawdef_cache $deflist -dynamic] + } + return [rawdef_is_dynamic $deflist] + #@dynamic only has meaning as 1st element of a def in the deflist + } + + #@id must be within first 4 lines of a block - or assign auto + #review - @dynamic block where -id not explicitly set? - disallow? + proc rawdef_id {rawdef} { + set id "" + foreach d $rawdef { + foreach ln [lrange [split $d \n] 0 4] { + if {[regexp {\s*(\S+)(.*)} $ln _match firstword rest]} { + if {$firstword eq "@id"} { + if {[llength $rest] %2 == 0 && [dict exists $rest -id]} { + set id [dict get $rest -id] + break + } + } + } + } + if {$id ne ""} { + break + } + } + if {$id eq "" || [string tolower $id] eq "auto"} { + variable id_counter + set id "autoid_[incr id_counter]" + } + #puts "==>id: $id" + return $id + } + #test the rawdef for @dynamic directive + proc rawdef_is_dynamic {rawdef} { + #temporary - old way + set flagged_dynamic [expr {[lindex $rawdef 0] eq "-dynamic" && [lindex $rawdef 1]} ] + if {$flagged_dynamic} { + return true + } + foreach d $rawdef { + if {[regexp {\s*(\S+)} $d _match firstword]} { + if {$firstword eq "@dynamic"} { + return true + } + } + } + return false } variable aliases @@ -1770,19 +2031,19 @@ tcl::namespace::eval punk::args { "exact id or glob pattern for ids" }] proc get_ids {{match *}} { - variable argdefcache_by_id + variable id_cache_rawdef variable aliases - return [list {*}[tcl::dict::keys $aliases $match] {*}[tcl::dict::keys $argdefcache_by_id $match]] + return [list {*}[tcl::dict::keys $aliases $match] {*}[tcl::dict::keys $id_cache_rawdef $match]] } #we don't automatically test for (autodef)$id - only direct ids and aliases proc id_exists {id} { - variable argdefcache_by_id variable aliases if {[tcl::dict::exists $aliases $id]} { return 1 } - tcl::dict::exists $argdefcache_by_id $id + variable id_cache_rawdef + tcl::dict::exists $id_cache_rawdef $id } proc set_alias {alias id} { variable aliases @@ -1800,16 +2061,18 @@ tcl::namespace::eval punk::args { } proc real_id {id} { - variable argdefcache_by_id + variable id_cache_rawdef variable aliases if {[tcl::dict::exists $aliases $id]} { set id [tcl::dict::get $aliases $id] } - if {[tcl::dict::exists $argdefcache_by_id $id]} { + if {[tcl::dict::exists $id_cache_rawdef $id]} { return $id } else { - if {![llength [update_definitions]]} { - if {[tcl::dict::exists $argdefcache_by_id (autodef)$id]} { + set check_updates [list [namespace qualifiers $id]] + if {![llength [update_definitions $check_updates]]} { + #nothing new loaded + if {[tcl::dict::exists $id_cache_rawdef (autodef)$id]} { return (autodef)$id } return "" @@ -1817,10 +2080,10 @@ tcl::namespace::eval punk::args { if {[tcl::dict::exists $aliases $id]} { set id [tcl::dict::get $aliases $id] } - if {[tcl::dict::exists $argdefcache_by_id $id]} { + if {[tcl::dict::exists $id_cache_rawdef $id]} { return $id } - if {[tcl::dict::exists $argdefcache_by_id (autodef)$id]} { + if {[tcl::dict::exists $id_cache_rawdef (autodef)$id]} { return (autodef)$id } return "" @@ -1828,42 +2091,188 @@ tcl::namespace::eval punk::args { } } - variable loaded_packages - set loaded_packages [list] + proc status {} { + upvar ::punk::args::register::NAMESPACES registered + upvar ::punk::args::register::loaded_packages loaded_packages + upvar ::punk::args::register::loaded_info loaded_info + upvar ::punk::args::register::scanned_packages scanned_packages + upvar ::punk::args::register::scanned_info scanned_info + set result "" + # [format %-${w0}s $idtail] + set widest [tcl::mathfunc::max {*}[lmap v [list {*}$registered "Registered"] {string length $v}]] + append result "[format %-${widest}s Registered] Scanned_ids Scantime_us Loaded_defs Loadtime_us" \n + set width_c2 [string length "Scanned_ids"] + set width_c3 [string length "Scantime_us"] + set width_c4 [string length "Loaded_defs"] + set width_c5 [string length "Loadtime_us"] + set count_unloaded 0 + set count_loaded 0 + foreach ns $registered { + if {$ns in $scanned_packages} { + set ids [dict get $scanned_info $ns idcount] + set scan_us [dict get $scanned_info $ns time] + } else { + set ids "" + set scan_us "" + } + if {$ns in $loaded_packages} { + incr count_loaded + set ldefs [dict get $loaded_info $ns defcount] + set load_us [dict get $loaded_info $ns time] + } else { + incr count_unloaded + set ldefs "" + set load_us "" + } + append result "[format %-${widest}s $ns] [format %${width_c2}s $ids] [format %${width_c3}s $scan_us] [format %${width_c4}s $ldefs] [format %${width_c5}s $load_us]" \n + } + append result "\nPackages - Registered: [llength $registered] Loaded: $count_loaded Unloaded: $count_unloaded" + return $result + } + + #scanned_packages (list) + #namespace_docpackages (dict) + proc update_definitions {{nslist *}} { + if {[set gposn [lsearch $nslist {}]] >= 0} { + lset nslist $gposn :: + } + upvar ::punk::args::register::NAMESPACES registered ;#list + upvar ::punk::args::register::loaded_packages loaded_packages ;#list + upvar ::punk::args::register::loaded_info loaded_info ;#dict + upvar ::punk::args::register::scanned_packages scanned_packages ;#list + upvar ::punk::args::register::scanned_info scanned_info ;#dict + upvar ::punk::args::register::namespace_docpackages namespace_docpackages ;#dict - proc update_definitions {} { + + #puts stderr "-->update_definitions '$nslist'" #needs to run quickly - especially when no package namespaces to be scanned for argdefs - #e.g - get's called for each subcommand of an ensemble (could be many) + #e.g - gets called for each subcommand of an ensemble (could be many) # It needs to get called in each arginfo call as we don't know what namespace origins or aliases may be involved in resolving a command. #we could possibly get away with not calling it for nested calls (such as with ensemble subcommands) but the code to avoid calls is probably more complex/slow than any gain avoiding the fast-path below. # -- --- --- --- --- --- # common-case fast-path - variable loaded_packages - upvar ::punk::args::register::NAMESPACES pkgs - if {[llength $loaded_packages] == [llength $pkgs]} { + + if {[llength $loaded_packages] == [llength $registered]} { #the only valid mechanism to add to 'loaded_packages' is with this function - so if lengths are equal, nothing to do. + #assert - if all are registered - then all have been scanned ( return {} } # -- --- --- --- --- --- - set unloaded [punklib_ldiff $pkgs $loaded_packages] + set unscanned [punklib_ldiff $registered $scanned_packages] + if {[llength $unscanned]} { + foreach pkgns $unscanned { + set idcount 0 + set ts_start [clock microseconds] + if {[info exists ${pkgns}::PUNKARGS]} { + set seen_documentedns [list] ;#seen per pkgns + foreach definitionlist [set ${pkgns}::PUNKARGS] { + #namespace eval $evalns [list punk::args::define {*}$definitionlist] + set id [rawdef_id $definitionlist] + if {[string match autoid_* $id]} { + puts stderr "update_definitions - unexpected autoid during scan of $pkgns - skipping" + puts stderr "definition:\n" + foreach d $definitionlist { + set out "" + foreach ln [split $d \n] { + append out " " $ln \n + } + puts $out + } + continue + } + #todo - detect duplicate ids (last will silently win.. should be reported somewhere) + incr idcount + set documentedns [namespace qualifiers $id] + if {$documentedns eq ""} {set documentedns ::} + if {$documentedns ni $seen_documentedns} { + #don't add own ns as a key in namespace_docpackages + if {$documentedns ne $pkgns} { + dict lappend namespace_docpackages $documentedns $pkgns + } + lappend seen_documentedns $documentedns + } + } + } + set ts_end [clock microseconds] + set diff [expr {$ts_end - $ts_start}] + dict set scanned_info $pkgns [dict create time $diff idcount $idcount] + #we count it as scanned even if PUNKARGS didn't exist + #(registered the namespace, variable PUNKARGS may or may not be declared, but didn't set PUNKARGS) + lappend scanned_packages $pkgns + } + } + + + + if {"*" in $nslist} { + set needed [punklib_ldiff $registered $loaded_packages] + } else { + set needed [list] + foreach pkgns $nslist { + if {$pkgns in $registered && $pkgns ni $loaded_packages} { + lappend needed $pkgns + } + #argdoc sub namespace is a standard place to put defs that match the namespace below + #(generally the PUNKARGS in a namespace should apply to own ns) + set docns ${pkgns}::argdoc + if {[namespace exists $docns]} { + if {($pkgns in $registered || $docns in $registered) && $docns ni $needed && $docns ni $loaded_packages} { + lappend needed $docns + } + } + if {[dict exists $namespace_docpackages $pkgns]} { + #this namespace has other argdef sources + foreach docns [dict get $namespace_docpackages $pkgns] { + if {$docns ni $loaded_packages} { + lappend needed $docns + } + } + } + } + } + + + set newloaded [list] - foreach pkgns $unloaded { - #puts -nonewline stderr . ;#debugging - see actual loads + foreach pkgns $needed { + #puts stderr "update_definitions Loading: $pkgns" + set ts_start [clock microseconds] + set def_count 0 if {![catch { if {[info exists ${pkgns}::PUNKARGS]} { + set docns ${pkgns}::argdoc + if {[namespace exists $docns]} { + namespace eval ${pkgns}::argdoc { + set epath [namespace path] + set pkgns [namespace parent] + if {$pkgns ni $epath} { + namespace path [list {*}$epath $pkgns] ;#add to tail + } + + } + set evalns $docns + } else { + set evalns $pkgns + } foreach definitionlist [set ${pkgns}::PUNKARGS] { - namespace eval $pkgns [list punk::args::define {*}$definitionlist] + namespace eval $evalns [list punk::args::define {*}$definitionlist] + incr def_count } } + + #process list of 2-element lists if {[info exists ${pkgns}::PUNKARGS_aliases]} { foreach adef [set ${pkgns}::PUNKARGS_aliases] { punk::args::set_alias {*}$adef } } } errMsg]} { + set ts_end [clock microseconds] + set diff [expr {$ts_end - $ts_start}] lappend loaded_packages $pkgns lappend newloaded $pkgns + dict set loaded_info $pkgns [dict create time $diff defcount $def_count] } else { puts stderr "punk::args::update_definitions error - failed to load PUNKARGS definitions for $pkgns\nerr:$errMsg" } @@ -1875,7 +2284,8 @@ tcl::namespace::eval punk::args { #This mechanism gets less-than-useful results for oo methods #e.g {$obj} proc Get_caller {} { - set call_level -3 + #set call_level -3 ;#for get_dict call + set call_level -4 set cmdinfo [tcl::dict::get [tcl::info::frame $call_level] cmd] #puts "-->$cmdinfo" #puts "-->[tcl::info::frame -3]" @@ -1918,7 +2328,7 @@ tcl::namespace::eval punk::args { @values -min 0 -max 0 }] proc test_get_dict {args} { - punk::args::get_dict {*}[punk::args::rawdef ::punk::args::test1] $args + punk::args::get_dict {*}[punk::args::raw_def ::punk::args::test1] $args } proc test_get_by_id {args} { punk::args::get_by_id ::punk::args::test1 $args @@ -1960,22 +2370,22 @@ tcl::namespace::eval punk::args { " @leaders -min 2 -max 2 msg -type string -help\ - "error message to display immediately prior to usage table. - May be empty string to just display usage. + "Error message to display immediately prior to usage table. + May be empty string to just display usage. " spec_dict -type dict -help\ - "Dictionary of argument specifications. - This is the internal format parsed from - the textual definition. It contains the data - organised/optimised to allow the final arg - parser/validator to make decisions. + "Dictionary of argument specifications. + This is the internal format parsed from + the textual definition. It contains the data + organised/optimised to allow the final arg + parser/validator to make decisions. " @opts -badarg -type string -help\ "name of an argument to highlight" -aserror -type boolean -help\ - "If true, the usage table is raised as an error message, - otherwise it is returned as a value." + "If true, the usage table is raised as an error message, + otherwise it is returned as a value." -return -choices {string table tableobject} -choicelabels { string "no table layout" tableobject "table object cmd" @@ -2133,6 +2543,8 @@ tcl::namespace::eval punk::args { } + #set RST [a] + set RST "\x1b\[m" set t "" ;#possible oo table object - may be tested for objectiness at the end so needs to exist. #REVIEW - risk of accidental indefinite recursion if functions used here also use punk::args::get_dict and there is an argument error @@ -2158,7 +2570,7 @@ tcl::namespace::eval punk::args { append errmsg \n } else { if {($returntype in {table tableobject}) && !$has_textblock} { - append errmsg \n "$CLR(errormsg)(layout package textblock is missing)[a]" \n + append errmsg \n "$CLR(errormsg)(layout package textblock is missing)$RST" \n } else { append errmsg \n } @@ -2181,7 +2593,7 @@ tcl::namespace::eval punk::args { set blank_header_col [list] if {$cmdname ne ""} { lappend blank_header_col "" - set cmdname_display $CLR(cmdname)$cmdname[a] + set cmdname_display $CLR(cmdname)$cmdname$RST } else { set cmdname_display "" } @@ -2194,7 +2606,7 @@ tcl::namespace::eval punk::args { } if {$docurl ne ""} { lappend blank_header_col "" - set docurl_display [a+ white]$docurl[a] + set docurl_display [a+ white]$docurl$RST } else { set docurl_display "" } @@ -2216,7 +2628,7 @@ tcl::namespace::eval punk::args { lappend blank_header_col "" } if {$use_table} { - set t [textblock::class::table new $CLR(title)Usage[a]] + set t [textblock::class::table new "$CLR(title)Usage$RST"] $t add_column -headers $blank_header_col -minwidth 3 $t add_column -headers $blank_header_col @@ -2295,19 +2707,18 @@ tcl::namespace::eval punk::args { #potentially require coordination with header colspans? $t add_row [list "" $argdisplay_body] } else { - if {$argdisplay_header ne "" + if {$argdisplay_header ne ""} { lappend errlines $argdisplay_header } lappend errlines {*}$argdisplay_body } } else { - set RST [a] #set A_DEFAULT [a+ brightwhite Brightgreen] set A_DEFAULT "" set A_BADARG $CLR(badarg) - set greencheck $CLR(check)\u2713[a] ;#green tick - set soloflag $CLR(solo)\u2690[a] ;#flag - may be replacement char in old dos prompt (?) + set greencheck $CLR(check)\u2713$RST ;#green tick + set soloflag $CLR(solo)\u2690$RST ;#flag - may be replacement char in old dos prompt (?) set A_PREFIX $CLR(choiceprefix) ;#use a+ so colour off can apply if {$A_PREFIX eq "" || $A_PREFIX eq [a+ underline]} { #A_PREFIX can resolve to empty string if colour off @@ -2380,6 +2791,11 @@ tcl::namespace::eval punk::args { set allchoices_originalcase [list] set choices [Dict_getdef $arginfo -choices {}] set choicegroups [Dict_getdef $arginfo -choicegroups {}] + set choicemultiple [dict get $arginfo -choicemultiple] + if {[string is integer -strict $choicemultiple]} { + set choicemultiple [list $choicemultiple $choicemultiple] + } + lassign $choicemultiple choicemultiple_min choicemultiple_max set choicecolumns [Dict_getdef $arginfo -choicecolumns 4] set choiceprefixdenylist [Dict_getdef $arginfo -choiceprefixdenylist {}] if {[Dict_getdef $arginfo -multiple 0]} { @@ -2416,6 +2832,17 @@ tcl::namespace::eval punk::args { set choicelabeldict [Dict_getdef $arginfo -choicelabels {}] set formattedchoices [dict create] ;#use dict rather than array to preserve order append help " Choices$prefixmsg$casemsg" + if {$choicemultiple_max > 1 || $choicemultiple_max == -1} { + if {$choicemultiple_max == -1} { + append help \n " The value can be a list of $choicemultiple_min or more of these choices" + } else { + if {$choicemultiple_min eq $choicemultiple_max} { + append help \n " The value must be a list of $choicemultiple_min of these choices" + } else { + append help \n " The value can be a list of $choicemultiple_min to $choicemultiple_max of these choices" + } + } + } if {![dict get $arginfo -choiceprefix] || [catch {package require punk::trie}]} { #append help "\n " [join [dict get $arginfo -choices] "\n "] if {[dict size $choicelabeldict]} { @@ -2513,7 +2940,7 @@ tcl::namespace::eval punk::args { #append help \n[textblock::join -- " " [$choicetableobj print]] } else { if {$groupname ne ""} { - append help \n \n "$CLR(groupname)Group: $groupname[a]" + append help \n \n "$CLR(groupname)Group: $groupname$RST" } else { append help \n } @@ -2527,15 +2954,15 @@ tcl::namespace::eval punk::args { if {$usetable} { #these will be displayed after all table entries if {$groupname eq ""} { - dict set choicetable_footers "" " $CLR(errormsg)(no choices defined for main group)[a]" + dict set choicetable_footers "" " $CLR(errormsg)(no choices defined for main group)$RST" } else { - dict set choicetable_footers $groupname " $CLR(errormsg)(no choices defined for group $groupname)[a]" + dict set choicetable_footers $groupname " $CLR(errormsg)(no choices defined for group $groupname)$RST" } } else { if {$groupname eq ""} { - append help \n " " $CLR(errormsg)(no choices defined)[a] + append help \n " " $CLR(errormsg)(no choices defined)$RST } else { - append help \n " " $CLR(errormsg)(no choices defined for group $groupname)[a] + append help \n " " $CLR(errormsg)(no choices defined for group $groupname)$RST } } } @@ -2561,7 +2988,7 @@ tcl::namespace::eval punk::args { $obj destroy } if {[dict size $choicetable_footers]} { - foreach groupname [dict keys $formattedchoices { + foreach groupname [dict keys $formattedchoices] { if {[dict exists $choicetable_footers $groupname]} { append help \n [dict get $choicetable_footers $groupname] } @@ -2570,6 +2997,7 @@ tcl::namespace::eval punk::args { #review. use -type to restrict additional choices - may be different to values in the -choices if {![dict get $arginfo -choicerestricted]} { + #when -choicemultiple - the -type refers to each selection if {[dict get $arginfo -type] eq "string"} { append help "\n (values not in defined choices are allowed)" } else { @@ -2609,7 +3037,7 @@ tcl::namespace::eval punk::args { } } else { #review - formatting will be all over the shop due to newlines in typesshow, help - set arghelp "[a+ bold]$argshow[a] TYPE:$typeshow DEFAULT:$default MULTI:$multiple\n" + set arghelp "[a+ bold]$argshow$RST TYPE:$typeshow DEFAULT:$default MULTI:$multiple\n" foreach ln [split $help \n] { append arghelp " $ln" \n } @@ -2666,35 +3094,40 @@ tcl::namespace::eval punk::args { } - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + @dynamic @id -id ::punk::args::usage @cmd -name punk::args::usage -help\ - "Return usage information for a command. + "Return usage information for a command identified by an id. + This will only work for commands where a punk::args definition exists - for the command and an id has been defined for it. + for the command and an id has been defined for it. The id for custom + help for a command should match the fully qualified name of the command. + Many commands (such as ensembles and oo objects) may have argument - documentation generated dynamically and not have an id. + documentation generated dynamically and may not yet have an id. + IDs for autogenenerated help are prefixed e.g (autodef)::myensemble. + Generally punk::ns::arginfo (aliased as i in the punk shell) should be used in preference - as it will search for a documentation - mechanism and call this as necessary. + mechanism and call punk::args::usage as necessary. " -return -default table -choices {string table tableobject} - } {${[punk::args::resolved_def -type @opts ::punk::args::arg_error -scheme]}} { + } {${[punk::args::resolved_def -types opts ::punk::args::arg_error -scheme]}} { @values -min 0 -max 1 id -help\ - "exact id. - Will usually match the command name" + "Exact id. + Will usually match the command name" }] proc usage {args} { lassign [dict values [punk::args::get_by_id ::punk::args::usage $args]] leaders opts values received set id [dict get $values id] - set definitionlist [rawdef $id] - if {[llength $definitionlist] == 0} { + set real_id [real_id $id] + if {$real_id eq ""} { error "punk::args::usage - no such id: $id" } - #by placing scheme before the supplied args - it can be overridden - arg_error "" [uplevel 1 [list punk::args::define {*}$definitionlist]] -scheme punk_info {*}$opts -aserror 0 + arg_error "" [punk::args::get_spec $real_id] -scheme punk_info {*}$opts -aserror 0 } lappend PUNKARGS [list { @@ -2704,13 +3137,13 @@ tcl::namespace::eval punk::args { id arglist -type list -help\ "list containing arguments to be parsed as per the - argument specification identified by the supplied id." + argument specification identified by the supplied id." }] #deprecate? proc get_by_id {id arglist} { - set definitionlist [punk::args::rawdef $id] + set definitionlist [punk::args::raw_def $id] if {[llength $definitionlist] == 0} { error "punk::args::get_by_id - no such id: $id" } @@ -2734,62 +3167,86 @@ tcl::namespace::eval punk::args { @cmd -name punk::args::parse -help\ "parse and validate command arguments based on a definition. - In the 'withid' form the definition is a pre-existing - record that has been created with ::punk::args::define. - In the 'withdef' form - the definition is created on the - first call and cached thereafter. + In the 'withid' form the definition is a pre-existing record that has been + created with ::punk::args::define, or indirectly by adding a definition to + the PUNKARGS variable in a namespace which is then registered in + punk::args::register::NAMESPACES, or by a previous call to punk::parse + using 'withdef' and a definition block containing an @id -id directive. + + In the 'withdef' form - the definition is created on the first call and + cached thereafter, if the id didn't already exist. - form1: parse ?-flag val?... -- $arglist withid $id - form2: parse ?-flag val?... -- $arglist withdef $def ?$def? + form1: parse $arglist ?-flag val?... withid $id + form2: parse $arglist ?-flag val?... withdef $def ?$def? see punk::args::define" + @form -form {withid withdef} + @leaders -min 1 -max 1 + arglist -type list -optional 0 -help\ + "Arguments to parse - supplied as a single list" + @opts - -form -type list -default * -help\ + -form -type list -default * -help\ "Restrict parsing to the set of forms listed. - Forms are the orthogonal sets of arguments a - command can take - usually described in 'synopsis' - entries. - " + Forms are the orthogonal sets of arguments a + command can take - usually described in 'synopsis' + entries." #default to enhanced errorstyle despite slow 'catch' (unhappy path) performance #todo - configurable per interp/namespace - -errorstyle -type string -default enhanced -choices {enhanced standard minimal} - @values -min 3 - sep -optional 0 -choices "--" + -errorstyle -type string -default enhanced -choices {enhanced standard minimal} + @values -min 2 - @form -form withid -synopsis "parse ?-form {int|...}? ?-errorstyle ? -- withid $id" + @form -form withid -synopsis "parse arglist ?-form {int|...}? ?-errorstyle ? withid $id" withid -type literal -help\ "The literal value 'withid'" id -type string -help\ "id of punk::args definition for a command" - @form -form withdef -synopsis "parse ?-form {int|...}? ?-errorstyle ? -- withdef $def ?$def?" + @form -form withdef -synopsis "parse arglist ?-form {int|...}? ?-errorstyle ? withdef $def ?$def?" withdef -type literal -help\ "The literal value 'withdef'" + + #todo - make -dynamic obsolete - use @dynamic directive instead def -type string -multiple 1 -optional 0 -help\ "Each remaining argument is a block of text - defining argument definitions. - As a special case, -dynamic may be - specified as the 1st 2 arguments. These are - not treated as an indicator to punk::args - about how to process the definition." + defining argument definitions. + As a special case, -dynamic may be + specified as the 1st 2 arguments. These are + treated as an indicator to punk::args about + how to process the definition." }] proc parse {args} { set tailtype "" ;#withid|withdef - set split [lsearch -exact $args --] ;#first -- + if {[llength $args] < 3} { + error "punk::args::parse - invalid call. < 3 args" + } + set parseargs [lindex $args 0] + set tailargs [lrange $args 1 end] + + set split [lsearch -exact $tailargs withid] if {$split < 0} { - #punk::args::usage arg_error? - error "punk::args::parse - invalid call. End of opts marker -- is required even if no options are present." + set split [lsearch -exact $tailargs withdef] + if {$split < 0} { + #punk::args::usage arg_error? + error "punk::args::parse - invalid call. keyword withid|withdef required" + } else { + set tailtype withdef + } + } else { + set tailtype withid + } + + set opts [lrange $tailargs 0 $split-1] ;#repeated flags will override earlier. That's ok here. + if {[llength $opts] % 2} { + error "punk::args::parse Even number of -flag val pairs required after arglist" } - set opts [lrange $args 0 $split-1] ;#repeated flags will override earlier. That's ok here. - set arglist [lindex $args $split+1] - set tailtype [lindex $args $split+2] set defaultopts [dict create\ -form {*}\ -errorstyle enhanced\ ] - + set opts [dict merge $opts $defaultopts] dict for {k v} $opts { switch -- $k { -form - -errorstyle { @@ -2802,24 +3259,43 @@ tcl::namespace::eval punk::args { } switch -- $tailtype { withid { - if {[llength [lrange $args $split+3 end]] != 1} { + if {[llength [lrange $tailargs $split+1 end]] != 1} { error "punk::args::parse - invalid call. Expected exactly one argument after 'withid'" } - set id [lindex $args $split+3] - return "parse [llength $arglist] args withid $id, options:$opts" + set id [lindex $tailargs $split+1] + #puts stdout "punk::args::parse [llength $parseargs] args withid $id, options: $opts" + set deflist [raw_def $id] + if {[llength $deflist] == 0} { + error "punk::args::parse - no such id: $id" + } } withdef { - set deflist [lrange $args $split+3 end] + set deflist [lrange $tailargs $split+1 end] if {[llength $deflist] < 1} { error "punk::args::parse - invalid call. Expected at least one argument after 'withdef'" } - return "parse [llength $arglist] with [llength $deflist] definition blocks, options:$opts" + #puts stdout "punk::args::parse [llength $parseargs] args with [llength $deflist] definition blocks, options: $opts" } default { error "punk::args::parse - invalid call. Argument following arglist must be 'withid' or 'withdef'" } } - + try { + set result [punk::args::get_dict {*}$deflist $parseargs] + } trap {PUNKARGS} {msg opts} { + #trap punk::args argument validation/parsing errors and decide here + #whether to display basic error - or full usage if configured. + puts stderr "PUNKARGS: $msg\n$opts" + return + } trap {} {msg opts} { + #review + #puts stderr "$msg\n$opts" + #quote from DKF: The reason for using return -code error vs error or throw depends on where the error is. If the problem is in your code, use error or throw. + #If the problem is in your caller (e.g., because they gave you bad arguments) then use return -code error. Simple. + throw [dict get $opts -errorcode] [dict get $opts -errorinfo] + return + } + return $result } proc parseXXX {args} { #no solo flags allowed for parse function itself. (ok for arglist being parsed) @@ -2920,19 +3396,14 @@ tcl::namespace::eval punk::args { # @values -multiple 1 #} $args - set is_dynamic 0 - if {[lindex $args 0] eq "-dynamic"} { - set is_dynamic [lindex $args 1] - } set rawargs [lindex $args end] ;# args values to be parsed - #we take a definition list rather than argspecs - because the definition could be dynamic set definition_args [lrange $args 0 end-1] #if definition has been seen before, #define will either return a permanently cached argspecs (-dynamic 0) - or # use a cached pre-split definition with parameters to dynamically generate a new (or limitedly cached?) argspecs. - set argspecs [uplevel 1 [list ::punk::args::define {*}$definition_args]] + set argspecs [uplevel 1 [list ::punk::args::resolve {*}$definition_args]] # ----------------------------------------------- # Warning - be aware of all vars thrown into this space (from tail end of 'definition' proc) @@ -3397,22 +3868,22 @@ tcl::namespace::eval punk::args { #puts "---opts_and_values:$opts_and_values" #puts "---argstate:$argstate" tcl::dict::for {argname v} $opts_and_values { - set thisarg [tcl::dict::get $argstate $argname] - #set thisarg_keys [tcl::dict::keys $thisarg] - set thisarg_checks [tcl::dict::get $arg_checks $argname] - set is_multiple [tcl::dict::get $thisarg -multiple] - set is_allow_ansi [tcl::dict::get $thisarg -allow_ansi] - set is_validate_ansistripped [tcl::dict::get $thisarg -validate_ansistripped] - set is_strip_ansi [tcl::dict::get $thisarg -strip_ansi] - set has_default [tcl::dict::exists $thisarg -default] + set thisarg [tcl::dict::get $argstate $argname] + #set thisarg_keys [tcl::dict::keys $thisarg] + set thisarg_checks [tcl::dict::get $arg_checks $argname] + set is_multiple [tcl::dict::get $thisarg -multiple] + set is_allow_ansi [tcl::dict::get $thisarg -allow_ansi] + set is_validate_ansistripped [tcl::dict::get $thisarg -validate_ansistripped] + set is_strip_ansi [tcl::dict::get $thisarg -strip_ansi] + set has_default [tcl::dict::exists $thisarg -default] if {$has_default} { set defaultval [tcl::dict::get $thisarg -default] } - set type [tcl::dict::get $thisarg -type] - set has_choices [expr {[tcl::dict::exists $thisarg -choices] || [tcl::dict::exists $thisarg -choicegroups]}] - set regexprepass [tcl::dict::get $thisarg -regexprepass] - set regexprefail [Dict_getdef $thisarg -regexprefail ""] ;#aliased to dict getdef in tcl9 - set validationtransform [tcl::dict::get $thisarg -validationtransform] + set type [tcl::dict::get $thisarg -type] + set has_choices [expr {[tcl::dict::exists $thisarg -choices] || [tcl::dict::exists $thisarg -choicegroups]}] + set regexprepass [tcl::dict::get $thisarg -regexprepass] + set regexprefail [Dict_getdef $thisarg -regexprefail ""] ;#aliased to dict getdef in tcl9 + set validationtransform [tcl::dict::get $thisarg -validationtransform] if {$is_multiple} { @@ -3443,13 +3914,18 @@ tcl::namespace::eval punk::args { set choiceprefix [tcl::dict::get $thisarg -choiceprefix] set choiceprefixdenylist [Dict_getdef $thisarg -choiceprefixdenylist {}] set choicerestricted [tcl::dict::get $thisarg -choicerestricted] + set choicemultiple [tcl::dict::get $thisarg -choicemultiple] + if {[string is integer -strict $choicemultiple]} { + set choicemultiple [list $choicemultiple $choicemultiple] + } + lassign $choicemultiple choicemultiple_min choicemultiple_max set nocase [tcl::dict::get $thisarg -nocase] set choices [Dict_getdef $thisarg -choices {}] set choicegroups [Dict_getdef $thisarg -choicegroups {}] set allchoices $choices if {[dict size $choicegroups]} { - dict for {groupname clist} $choicegroups { - lappend allchoices {*}$clist + dict for {groupname groupmembers} $choicegroups { + lappend allchoices {*}$groupmembers } } #note we can legitimately have dups in allchoices - if a choice should be documented to display in multiple groups @@ -3468,115 +3944,159 @@ tcl::namespace::eval punk::args { } } set idx 0 ;# - #opts/values_dict $argname member has been populated with the actual entered choices - which might be prefixes + #leaders_dict/opts/values_dict $argname member has been populated with the actual entered choices - which might be prefixes #assert llength $vlist == llength [dict get $dname $argname] # (unless there was a default and the option wasn't specified) set vlist_validate [list] set vlist_check_validate [list] foreach e $vlist e_check $vlist_check { - if {$nocase} { - set casemsg " (case insensitive)" - set choices_test [tcl::string::tolower $allchoices] - #Don't lcase the denylist - even in nocase mode! - #set choiceprefixdenylist [tcl::string::tolower $choiceprefixdenylist] - set v_test [tcl::string::tolower $e_check] + set allchoices_in_list 0 + if {$choicemultiple_max > 1 || $choicemultiple_max == -1} { + #vlist and vlist_check can be list of lists if -multiple and -choicemultiple + #each e represents 0 or more choice selections + set c_list $e + set c_check_list $e_check + #todo? check if entire list matches default? } else { - set casemsg " (case sensitive)" - set v_test $e_check - set choices_test $allchoices + #only one choice at a time - ensure single entry in c_list c_check_list + set c_list [list $e] + set c_check_list [list $e_check] } - set choice_in_list 0 - set matches_default [expr {$has_default && $e eq $defaultval}] - if {!$matches_default} { - if {$choiceprefix} { - #can we handle empty string as a choice? It should just work - REVIEW/test - set choice_exact_match 0 - if {$e_check in $allchoices} { - #for case when there are case-differenced duplicates - allow exact match to avoid selecting earlier match of another casing - set chosen $e_check - set choice_in_list 1 - set choice_exact_match 1 - } elseif {$v_test in $choices_test} { - set chosen $v_test - set choice_in_list 1 - } else { - #PREFIX check required - any 'chosen' here is not an exact match or it would have matched above. - #assert - if empty string was a provided choice and empty string was a provided arg - we would have matched above. - #in this block we can treat empty result from prefix match as a non-match - if {$nocase} { - #nocase implies that our entered value doesn't have to match case of choices - - #but we would still like to select the best match if there are case-dups. - #e.g arg -choices {delete Delete} -nocase 1 -choiceprefixdenylist delete - # selecting Del will find Delete, del will match delete (and raise error) - # but DEL will also match delete rather than Delete - so again an error is raised. - #This is counterintuitive with -nocase - #This is probably such an edge case that best served with documentation as a feature-not-bug - #Rationale being that in a nocase situation it's arbitrary/counterintuitive to consider DEL, or DeL a better match for Delete than delete? - #The choice of the user to use -choiceprefixdenylist along with case-dups is the issue. - - set bestmatch [tcl::prefix::match -error "" [lsort -unique $allchoices] $e_check] - if {$bestmatch eq ""} { - set chosen [tcl::prefix::match -error "" [lsort -unique $choices_test] $v_test] - set choice_in_list [expr {$chosen ne ""}] - #we + + + #----------------------------------- + #fast fail on the wrong number of choices + if {[llength $c_list] < $choicemultiple_min} { + set msg "Option $argname for [Get_caller] requires at least $choicemultiple_min choices. Received [llength $c_list] choices." + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list choicecount [llength $c_list] minchoices $choicemultiple_min maxchoices $choicemultiple_max] -badarg $argname]] $msg + } + if {$choicemultiple_max != -1 && [llength $c_list] > $choicemultiple_max} { + set msg "Option $argname for [Get_caller] requires at most $choicemultiple_max choices. Received [llength $c_list] choices." + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list choicecount [llength $c_list] minchoices $choicemultiple_min maxchoices $choicemultiple_max] -badarg $argname]] $msg + } + #----------------------------------- + + set choice_idx 0 ;#we need to overwrite raw-choice (which may be prefix) with a value from the choice list + foreach c $c_list c_check $c_check_list { + if {$nocase} { + set casemsg " (case insensitive)" + set choices_test [tcl::string::tolower $allchoices] + #Don't lcase the denylist - even in nocase mode! + #set choiceprefixdenylist [tcl::string::tolower $choiceprefixdenylist] + set v_test [tcl::string::tolower $c_check] + } else { + set casemsg " (case sensitive)" + set v_test $c_check + set choices_test $allchoices + } + set choice_in_list 0 + set matches_default [expr {$has_default && $c eq $defaultval}] ;# defaultval when -choicemultiple could be a list? + if {!$matches_default} { + if {$choiceprefix} { + #can we handle empty string as a choice? It should just work - REVIEW/test + set choice_exact_match 0 + if {$c_check in $allchoices} { + #for case when there are case-differenced duplicates - allow exact match to avoid selecting earlier match of another casing + set chosen $c_check + set choice_in_list 1 + set choice_exact_match 1 + } elseif {$v_test in $choices_test} { + set chosen $v_test + set choice_in_list 1 + } else { + #PREFIX check required - any 'chosen' here is not an exact match or it would have matched above. + #assert - if empty string was a provided choice and empty string was a provided arg - we would have matched above. + #in this block we can treat empty result from prefix match as a non-match + if {$nocase} { + #nocase implies that our entered value doesn't have to match case of choices - + #but we would still like to select the best match if there are case-dups. + #e.g arg -choices {delete Delete} -nocase 1 -choiceprefixdenylist delete + # selecting Del will find Delete, del will match delete (and raise error) + # but DEL will also match delete rather than Delete - so again an error is raised. + #This is counterintuitive with -nocase + #This is probably such an edge case that best served with documentation as a feature-not-bug + #Rationale being that in a nocase situation it's arbitrary/counterintuitive to consider DEL, or DeL a better match for Delete than delete? + #The choice of the user to use -choiceprefixdenylist along with case-dups is the issue. + + set bestmatch [tcl::prefix::match -error "" [lsort -unique $allchoices] $c_check] + if {$bestmatch eq ""} { + set chosen [tcl::prefix::match -error "" [lsort -unique $choices_test] $v_test] + #now pick the earliest match in the actually defined list so that case of chosen always matches a defined entry with casing + set chosen [lsearch -inline -nocase $allchoices $chosen] + set choice_in_list [expr {$chosen ne ""}] + } else { + set chosen $bestmatch + set choice_in_list 1 + } } else { - set chosen $bestmatch - set choice_in_list 1 + set chosen [tcl::prefix::match -error "" [lsort -unique $allchoices] $c_check] + if {$chosen eq ""} { + set choice_in_list 0 + } else { + set choice_in_list 1 + } } - } else { - set chosen [tcl::prefix::match -error "" [lsort -unique $allchoices] $e_check] - if {$chosen eq ""} { + #override choice_in_list if in deny list + #don't allow prefixing for elements from -choiceprefixdenylist + #we still use all elements to calculate the prefixes though + #review - case difference edge cases in choiceprefixdenylist !todo + if {$chosen in $choiceprefixdenylist} { set choice_in_list 0 - } else { - set choice_in_list 1 + set chosen "" } } - #override choice_in_list if in deny list - #don't allow prefixing for elements from -choiceprefixdenylist - #we still use all elements to calculate the prefixes though - #review - case difference edge cases in choiceprefixdenylist !todo - if {$chosen in $choiceprefixdenylist} { - set choice_in_list 0 - set chosen "" - } - } - if {$choice_in_list && !$choice_exact_match} { - if {$is_multiple} { - set existing [tcl::dict::get [set $dname] $argname] - lset existing $idx $chosen - tcl::dict::set $dname $argname $existing - } else { - tcl::dict::set $dname $argname $chosen + if {$choice_in_list && !$choice_exact_match} { + if {$choicemultiple_max != -1 && $choicemultiple_max < 2} { + if {$is_multiple} { + set existing [tcl::dict::get [set $dname] $argname] + lset existing $idx $chosen + tcl::dict::set $dname $argname $existing + } else { + tcl::dict::set $dname $argname $chosen + } + } else { + if {$is_multiple} { + set existing_all [tcl::dict::get [set $dname] $argname] + lset existing_all $idx $choice_idx $chosen + tcl::dict::set $dname $argname $existing_all + } else { + set existing [tcl::dict::get [set $dname] $argname] + lset existing $choice_idx $chosen + tcl::dict::set $dname $argname $existing + } + } } + } else { + #value as stored in $dname is ok + set choice_in_list [expr {$v_test in $choices_test}] } - } else { - #value as stored in $dname is ok - set choice_in_list [expr {$v_test in $choices_test}] } - } - if {!$choice_in_list && !$matches_default} { - if {!$choicerestricted} { - #if {$is_multiple} { - # set existing [tcl::dict::get [set $dname] $argname] - # lset existing $idx $v_test - # tcl::dict::set $dname $argname $existing - #} else { - # tcl::dict::set $dname $argname $v_test - #} - lappend vlist_validate $e - lappend vlist_check_validate $e_check - } else { - #unhappy path - if {$choiceprefix} { - set prefixmsg " (or a unique prefix of a value)" + if {!$choice_in_list && !$matches_default} { + if {!$choicerestricted} { + #if {$is_multiple} { + # set existing [tcl::dict::get [set $dname] $argname] + # lset existing $idx $v_test + # tcl::dict::set $dname $argname $existing + #} else { + # tcl::dict::set $dname $argname $v_test + #} + lappend vlist_validate $c + lappend vlist_check_validate $c_check } else { - set prefixmsg "" + #unhappy path + if {$choiceprefix} { + set prefixmsg " (or a unique prefix of a value)" + } else { + set prefixmsg "" + } + arg_error "Option $argname for [Get_caller] must be one of the listed values:\n [join $allchoices "\n "]\n$casemsg$prefixmsg. Received: '$c'" $argspecs -badarg $argname } - arg_error "Option $argname for [Get_caller] must be one of the listed values:\n [join $allchoices "\n "]\n$casemsg$prefixmsg. Received: '$e'" $argspecs -badarg $argname } + incr choice_idx } + incr idx } #reduce our vlist and vlist_check lists by removing choice matches as they need to be passed through without validation @@ -3588,10 +4108,11 @@ tcl::namespace::eval punk::args { if {[llength $vlist] && $has_default} { set vlist_validate [list] set vlist_check_validate [list] - foreach e $vlist e_check $vlist_check { - if {$e_check ne $defaultval} { - lappend vlist_validate $e - lappend vlist_check_validate $e + foreach c $vlist c_check $vlist_check { + #for -choicemultiple with default that could be a list use 'ni' ?? review + if {$c_check ne $defaultval} { + lappend vlist_validate $c + lappend vlist_check_validate $c } } set vlist $vlist_validate @@ -3854,7 +4375,12 @@ tcl::namespace::eval punk::args { xdigit { foreach e $vlist e_check $vlist_check { if {![tcl::string::is $type $e_check]} { - arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e'" $argspecs -badarg $argname + set msg "Option $argname for [Get_caller] requires type '$type'. Received: '$e'" + #try trap? + #return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type]]] $result + #throw ? + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname]] $msg + arg_error $msg $argspecs -badarg $argname } } } @@ -4012,59 +4538,104 @@ tcl::namespace::eval punk::args::lib { lappend PUNKARGS [list { @id -id ::punk::args::lib::tstr @cmd -name punk::args::lib::tstr -help\ - "A rough equivalent of js template literals" + "A rough equivalent of js template literals + + Substitutions: + \$\{$varName\} + \$\{[myCommand]\} + (when -allowcommands flag is given)" -allowcommands -default 0 -type none -help\ - "if -allowcommands is present, placeholder can contain commands - e.g {\$\{plaintext0 [lindex $var 0] plaintext2\}}" - -return -default list -choices {dict list string args}\ + "If -allowcommands is present, placeholder can contain commands + e.g {\$\{plaintext0 [lindex $var 0] plaintext2\}}" + -undent -default 1 -type boolean -help\ + "undent/dedent the template lines. + The longest common prefix of whitespace is removed" + -indent -default "" -type string -help\ + "String with which to indent the template + prior to substitution. + If -undent is enabled, that is performed + first, then the indent is applied." + -paramindents -default line -choices {none line position} -choicelabels { + line\ + " Use leading whitespace in + the line in which the + placeholder occurs." + position\ + " Use the position in + the line in which the + placeholder occurs." + none\ + " No indents applied to + subsequent placeholder value + lines. This will usually + result in text awkwardly + ragged unless the source code + has also been aligned with the + left margin or the value has + been manually padded." + } -help\ + "How indenting is done for subsequent lines in a + multi-line placeholder substitution value. + The 1st line or a single line value is always + placed at the placeholder. + paramindents are performed after the main + template has been indented/undented. + (indenting by position does not calculate + unicode double-wide or grapheme cluster widths) + " + #choicelabels indented by 1 char is clearer for -return string - and reasonable in table + -return -default string -choices {dict list string args}\ -choicelabels { dict\ - "Return a dict with keys - 'template', 'params' and - 'errors'" - string\ - "Return a single result - being the string with - placeholders substituted." - list\ - "Return a 2 element list. - The first is itself a list - of plaintext portions of the - template, split at each point - at which placeholders were - present. The second element - of the outer list is a list - of placeholder values if -eval - is 1, or a list of the raw - placeholder strings if -eval - is 0." - args\ - "Return a list where the first - element is a list of template - plaintext sections as per the - 'list' return mechanism, but the - placeholder items are individual - items in the returned list. - This can be useful when passing - the expanded result of a tstr - command to another function - which expects the placeholders - as individual arguments" + " Return a dict with keys + 'template', 'params' and + 'errors'" + string\ + " Return a single result + being the string with + placeholders substituted." + list\ + " Return a 2 element list. + The first is itself a list + of plaintext portions of the + template, split at each point + at which placeholders were + present. The second element + of the outer list is a list + of placeholder values if -eval + is 1, or a list of the raw + placeholder strings if -eval + is 0." + args\ + " Return a list where the first + element is a list of template + plaintext sections as per the + 'list' return mechanism, but the + placeholder items are individual + items in the returned list. + This can be useful when passing + the expanded result of a tstr + command to another function + which expects the placeholders + as individual arguments" } -eval -default 1 -type boolean -help\ "Whether to evaluate the \$\{\} placeholders. - When -return is string, -eval should generally be set to 1. - For a string return, -eval 0 will result in the raw contents of \$\{\} being substituted. - contained variables in that case should be braced, or the variable name is likely to collide - with surrounding text. - e.g tstr -return string -eval 0 {plaintext\$\{\$\{var\}\}plaintext} -> plaintext\$\{var\}plaintext" + When -return is string, -eval should generally be set to 1. + For a string return, -eval 0 will result in the raw contents of \$\{\} being substituted. + contained variables in that case should be braced or whitespace separated, or the variable + name is likely to collide with surrounding text. + e.g tstr -return string -eval 0 {plaintext\$\{\$\{var\}\}plaintext} -> plaintext\$\{var\}plaintext" @values -min 0 -max 1 templatestring -help\ "This argument should be a braced string containing placeholders such as \$\{$var\} e.g {The value is \$\{$var\}.} - where $var will be substituted from the calling context - The placeholder itself can contain plaintext portions as well as variables. - It can contain commands in square brackets if -allowcommands is true - e.g tstr -return string -allowcommands {Tcl Version:\$\{[info patch]\} etc}" + where $var will be substituted from the calling context + The placeholder itself can contain plaintext portions as well as variables. + It can contain commands in square brackets if -allowcommands is true + e.g tstr -return string -allowcommands {Tcl Version:\$\{[info patch]\} etc} + + Escape sequences such as \\n and unicode escapes are processed within placeholders. + " }] proc tstr {args} { @@ -4080,8 +4651,11 @@ tcl::namespace::eval punk::args::lib { set arglist [lrange $args 0 end-1] set opts [dict create\ -allowcommands 0\ + -undent 1\ + -indent ""\ + -paramindents line\ -eval 1\ - -return list\ + -return string\ ] if {"-allowcommands" in $arglist} { set arglist [::punk::args::system::punklib_ldiff $arglist -allowcommands] @@ -4089,21 +4663,21 @@ tcl::namespace::eval punk::args::lib { } if {[llength $arglist] % 2 != 0} { if {[info commands ::punk::args::get_by_id] ne ""} { - punk::args::get_by_id ::punk::args::tstr $args + punk::args::get_by_id ::punk::args::lib::tstr $args return } else { error "punk::args::lib::tstr expected option/value pairs prior to last argument" } } dict for {k v} $arglist { - set fullk [tcl::prefix::match -error "" {-allowcommands -return -eval} $k] + set fullk [tcl::prefix::match -error "" {-allowcommands -indent -undent -paramindents -return -eval} $k] switch -- $fullk { - -return - -eval { + -indent - -undent - -paramindents - -return - -eval { dict set opts $fullk $v } default { if {[info commands ::punk::args::get_by_id] ne ""} { - punk::args::get_by_id ::punk::args::tstr $args + punk::args::get_by_id ::punk::args::lib::tstr $args return } else { error "punk::args::lib::tstr unknown option $k. Known options: [dict keys $opts]" @@ -4112,6 +4686,12 @@ tcl::namespace::eval punk::args::lib { } } set opt_allowcommands [dict get $opts -allowcommands] + set opt_paramindents [dict get $opts -paramindents] + set test_paramindents [tcl::prefix::match -error "" {none line position} $opt_paramindents] + if {$test_paramindents ni {none line position}} { + error "punk::args::lib::tstr option -paramindents invalid value '$opt_paramindents'. Must be one of none, line, position or an unambiguous abbreviation thereof." + } + set opt_paramindents $test_paramindents set opt_return [dict get $opts -return] set opt_return [tcl::prefix::match -error "" {args dict list string} $opt_return] if {$opt_return eq ""} { @@ -4124,6 +4704,15 @@ tcl::namespace::eval punk::args::lib { set nocommands "" } + set opt_undent [dict get $opts -undent] + if {$opt_undent} { + set templatestring [punk::args::lib::undent $templatestring] + } + set opt_indent [dict get $opts -indent] + if {$opt_indent ne ""} { + set templatestring [punk::args::lib::indent $templatestring $opt_indent] + } + #set parts [_tstr_split $templatestring] if {[string first \$\{ $templatestring] < 0} { set parts [list $templatestring] @@ -4135,6 +4724,14 @@ tcl::namespace::eval punk::args::lib { set params [list] set idx 0 set errors [dict create] + set lastline "" ;#todo - first line has placeholder? + set pt1 [lindex $parts 0] + set lastline_posn [string last \n $pt1] + if {$lastline_posn >= 0} { + set lastline [string range $pt1 $lastline_posn+1 end] + } else { + set lastline $pt1 + } foreach {pt expression} $parts { lappend textchunks $pt incr idx ;#pt incr @@ -4143,18 +4740,39 @@ tcl::namespace::eval punk::args::lib { if {$idx == [llength $parts]} { break } + set lastline_posn [string last \n $pt] + if {$lastline_posn >= 0} { + set lastline [string range $pt $lastline_posn+1 end] + } #lappend expressions $expression + #---------------------- + #REVIEW - JMN + #TODO - debug punk::args loading of @dynamic defs + #puts "-- $expression" + #---------------------- + #brk1 - literal newline not {\n} + set leader "" + if {[set brk1 [string first \n $expression]] >= 0} { + #undent left of paramstart only for lines of expression that arent on opening ${..} line + set tail [string range $expression $brk1+1 end] + set leader [string repeat " " [string length $lastline]] + set undentedtail [punk::args::lib::undentleader $tail $leader] + #set undentedtail [punk::lib::undent [string range $expression $brk1+1 end]] + set expression "[string range $expression 0 $brk1]$undentedtail" + } if {$opt_eval} { if {[catch [list uplevel 1 [list ::subst {*}$nocommands $expression]] result]} { lappend params [string cat \$\{ $expression \}] dict set errors [expr {[llength $params]-1}] $result } else { + set result [string map [list \n "\n$leader"] $result] lappend params $result } #lappend params [uplevel 1 [list ::subst {*}$nocommands $expression]] } else { - lappend params $expression + lappend params [subst -nocommands -novariables $expression] } + append lastline [lindex $params end] ;#for current expression's position calc incr idx ;#expression incr } @@ -4167,7 +4785,9 @@ tcl::namespace::eval punk::args::lib { dict for {i e} $errors { append einfo "parameter $i error: $e" \n } - puts stderr "tstr errors:\n$einfo\n]" + #REVIEW!!! + #TODO - fix + #puts stderr "tstr errors:\n$einfo\n" } switch -- $opt_return { @@ -4179,9 +4799,46 @@ tcl::namespace::eval punk::args::lib { return [list $textchunks {*}$params] } string { + #todo - flag to disable indent-matching behaviour for multiline param? set out "" + set pt1 [lindex $parts 0] + set lastline_posn [string last \n $pt1] + if {$lastline_posn >= 0} { + set lastline [string range $pt1 $lastline_posn+1 end] + } else { + set lastline $pt1 + } foreach pt $textchunks param $params { - append out $pt $param + if {$opt_paramindents eq "none"} { + append out $pt $param + } else { + set lastline_posn [string last \n $pt] + if {$lastline_posn >= 0} { + set lastline [string range $pt $lastline_posn+1 end] + } + if {$opt_paramindents eq "line"} { + regexp {(\s*).*} $lastline _all lastindent + } else { + #position + #TODO - detect if there are grapheme clusters + #This regsub doesn't properly space unicode double-wide chars or clusters + set lastindent "[regsub -all {\S} $lastline " "] " + } + if {$lastindent ne ""} { + set paramlines [split $param \n] + if {[llength $paramlines] == 1} { + append out $pt $param + } else { + append out $pt [lindex $paramlines 0] + foreach nextline [lrange $paramlines 1 end] { + append out \n $lastindent $nextline + } + } + } else { + append out $pt $param + } + append lastline $param + } } return $out } @@ -4239,7 +4896,7 @@ tcl::namespace::eval punk::args::lib { } } else { if {$in_placeholder == 2} { - #skip opening bracket + #skip opening bracket dollar sign set in_placeholder 1 } else { append echars $ch @@ -4294,11 +4951,248 @@ tcl::namespace::eval punk::args::lib { return [lappend list [tcl::string::range $text $start end]] } + #like textutil::adjust::indent - but doesn't strip trailing lines, and doesn't implement skip parameter. + proc indent {text {prefix " "}} { + set result [list] + foreach line [split $text \n] { + if {[string trim $line] eq ""} { + lappend result "" + } else { + lappend result $prefix[string trimright $line] + } + } + return [join $result \n] + } + #dedent? + proc undent {text} { + if {$text eq ""} { + return "" + } + set lines [split $text \n] + set nonblank [list] + foreach ln $lines { + if {[string trim $ln] eq ""} { + continue + } + lappend nonblank $ln + } + set lcp [longestCommonPrefix $nonblank] + if {$lcp eq ""} { + return $text + } + regexp {^([\t ]*)} $lcp _m lcp + if {$lcp eq ""} { + return $text + } + set len [string length $lcp] + set result [list] + foreach ln $lines { + if {[string trim $ln] eq ""} { + lappend result "" + } else { + lappend result [string range $ln $len end] + } + } + return [join $result \n] + } + + #hacky + proc undentleader {text leader} { + #leader usually whitespace - but doesn't have to be + if {$text eq ""} { + return "" + } + set lines [split $text \n] + set nonblank [list] + foreach ln $lines { + if {[string trim $ln] eq ""} { + continue + } + lappend nonblank $ln + } + lappend nonblank "${leader}!!" + set lcp [longestCommonPrefix $nonblank] + if {$lcp eq ""} { + return $text + } + #regexp {^([\t ]*)} $lcp _m lcp + #lcp can be shorter than leader + set lcp [string range $lcp 0 [string length $leader]-1] + + if {$lcp eq ""} { + return $text + } + set len [string length $lcp] + set result [list] + foreach ln $lines { + if {[string trim $ln] eq ""} { + lappend result "" + } else { + lappend result [string range $ln $len end] + } + } + return [join $result \n] + } + #A version of textutil::string::longestCommonPrefixList + proc longestCommonPrefix {items} { + if {[llength $items] <= 1} { + return [lindex $items 0] + } + set items [lsort $items[unset items]] + set min [lindex $items 0] + set max [lindex $items end] + #if first and last of sorted list share a prefix - then all do (first and last of sorted list are the most different in the list) + #(sort order nothing to do with length - e.g min may be longer than max) + if {[string length $min] > [string length $max]} { + set temp $min + set min $max + set max $temp + } + set n [string length $min] + set prefix "" + set i -1 + while {[incr i] < $n && ([set c [string index $min $i]] eq [string index $max $i])} { + append prefix $c + } + return $prefix + } + #*** !doctools #[list_end] [comment {--- end definitions namespace punk::args::lib ---}] } + +tcl::namespace::eval punk::args::argdocbase { + namespace export * + #use a? to test and create literal ansi here rather than relying on punk::ansi package presence + #e.g + #% a? bold + #- bold │SGR 1│sample│â›[1msample + #- ──────┼─────┼──────┼────────── + #- RESULT│ │sample│â›[1msample + proc B {} {return \x1b\[1m} ;#a+ bold + proc N {} {return \x1b\[22m} ;#a+ normal + proc I {} {return \x1b\[3m} ;#a+ italic + proc NI {} {return \x1b\[23m} ;#a+ noitalic + +} # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +tcl::namespace::eval punk::args::package { + variable PUNKARGS + lappend PUNKARGS [list { + @dynamic + @id -id "::punk::args::package::standard_about" + @cmd -name "%pkg%::about" -help\ + "About %pkg% + ... + " + -package_about_namespace -type string -optional 0 -help\ + "Namespace containing the package about procedures + Must contain " + -return\ + -type string\ + -default table\ + -choices {string table tableobject}\ + -choicelabels { + string\ + "A basic text layout" + table\ + "layout in table borders + (requires package: textblock)" + tableobject\ + "textblock::class::table object instance" + }\ + -help\ + "Choose the return type of the 'about' information" + topic -optional 1\ + -nocase 1\ + -default {*}\ + -choices {Description License Version Contact *}\ + -choicerestricted 0\ + -choicelabels { + + }\ + -multiple 1\ + -help\ + "Topic to display. Omit or specify as * to see all. + If * is included with explicit topics, * represents + the remaining unmentioned topics." + }] + proc standard_about {args} { + set argd [punk::args::parse $args withid ::punk::args::package::standard_about] + lassign [dict values $argd] leaders OPTS values received + + set pkgns [dict get $OPTS -package_about_namespace] + if {[info commands ${pkgns}::package_name] eq ""} { + error "punk::args::package::standard_about unable to find function ${pkgns}::package_name" + } + set pkgname [${pkgns}::package_name] + + set opt_return [dict get $OPTS -return] + set all_topics [${pkgns}::about_topics] + if {![dict exists $received topic]} { + set topics $all_topics + } else { + # * represents all remaining topics not explicitly mentioned. + set val_topics [dict get $values topic] ;#if -multiple is true, this is a list + set explicit_topics [lsearch -all -inline -exact -not $val_topics "*"] + set topics [list] + foreach t $val_topics { + if {$t eq "*"} { + foreach a $all_topics { + if {$a ni $explicit_topics} { + lappend topics $a + } + } + } else { + lappend topics $t + } + } + } + if {$opt_return ne "string"} { + package require textblock ;#table support + set is_table 1 + set title [string cat {[} $pkgname {]} ] + set t [textblock::class::table new -title $title] + $t configure -frametype double -minwidth [expr {[string length $title]+2}] + + } else { + set topiclens [lmap t $topics {string length $t}] + set widest_topic [tcl::mathfunc::max {*}$topiclens] + set is_table 0 + set about "$pkgname\n" + append about [string repeat - $widest_topic] \n + } + foreach topic $topics { + if {[llength [info commands ::${pkgns}::get_topic_$topic]] == 1} { + set topic_contents [::${pkgns}::get_topic_$topic] + } else { + set topic_contents "" + } + if {!$is_table} { + set content_lines [split $topic_contents \n] + append about [format %-${widest_topic}s $topic] " " [lindex $content_lines 0] \n + foreach ln [lrange $content_lines 1 end] { + append about [format %-${widest_topic}s ""] " " $ln \n + } + } else { + $t add_row [list $topic $topic_contents] + } + } + + if {!$is_table} { + return $about + } else { + if {$opt_return eq "tableobject"} { + return $t + } + set result [$t print] + $t destroy + return $result + } + } + +} #usually we would directly call arg definitions near the defining proc, # so that the proc could directly use the definition in its parsing. @@ -4314,7 +5208,7 @@ tcl::namespace::eval punk::args::lib { # set PUNKARGS "" #} -lappend ::punk::args::register::NAMESPACES ::punk::args::argdoc ::punk::args ::punk::args::lib +lappend ::punk::args::register::NAMESPACES ::punk::args::argdoc ::punk::args ::punk::args::lib ::punk::args::package # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools @@ -4326,8 +5220,6 @@ tcl::namespace::eval punk::args::system { #dict get value with default wrapper for tcl 8.6 if {[info commands ::tcl::dict::getdef] eq ""} { - #package require punk::lib - #interp alias "" ::punk::args::Dict_getdef "" ::punk::lib::dict_getdef proc Dict_getdef {dictValue args} { set keys [lrange $args 0 end-1] if {[tcl::dict::exists $dictValue {*}$keys]} { @@ -4354,6 +5246,8 @@ tcl::namespace::eval punk::args::system { } } + + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::args [tcl::namespace::eval punk::args { diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/char-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/char-0.1.0.tm index 8cb06b1f..43dcd6b5 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/char-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/char-0.1.0.tm @@ -2015,7 +2015,7 @@ tcl::namespace::eval punk::char { # ------------------------------------------------------------------------------------------------------ proc grapheme_split_tk {string} { if {![regexp "\[\uFF-\U10FFFF\]" $string]} { - #only ascii - no joiners or unicode + #only ascii (7 or 8 bit) - no joiners or unicode return [split $string {}] } package require tk @@ -2068,14 +2068,14 @@ tcl::namespace::eval punk::char { return $width } proc wcswidth_single {char} { - scan $c %c dec - if {$c <= 255 && !($c < 31 || $c == 127)} { + scan $char %c dec + if {$dec <= 255 && !($dec < 31 || $dec == 127)} { #review - non-printing ascii? why does textutil::wcswidth report 1 ?? #todo - compare with python or other lang wcwidth return 1 - } elseif {$c < 917504 || $c > 917631} { + } elseif {$dec < 917504 || $dec > 917631} { #TODO - various other joiners and non-printing chars - return [textutil::wcswidth_char $c] + return [textutil::wcswidth_char $dec] ;#note textutil::wcswidth_char takes a decimal codepoint! #may return -1 - REVIEW } return 0 @@ -2084,13 +2084,13 @@ tcl::namespace::eval punk::char { set width 0 foreach c [split $string {}] { scan $c %c dec - if {$c <= 255 && !($c < 31 || $c == 127)} { + if {$dec <= 255 && !($dec < 31 || $dec == 127)} { #review - non-printing ascii? why does textutil::wcswidth report 1 ?? #todo - compare with python or other lang wcwidth incr width - } elseif {$c < 917504 || $c > 917631} { + } elseif {$dec < 917504 || $dec > 917631} { #TODO - various other joiners and non-printing chars - set w [textutil::wcswidth_char $c] + set w [textutil::wcswidth_char $dec] ;#takes decimal codepoint if {$w < 0} { return -1 } else { @@ -2117,14 +2117,14 @@ tcl::namespace::eval punk::char { set chunk [tcl::string::range $string $startidx $endidx] set codes [scan $chunk [tcl::string::repeat %c [tcl::string::length $chunk]]] - foreach c $codes { - if {$c <= 255 && !($c < 31 || $c == 127)} { + foreach dec $codes { + if {$dec <= 255 && !($dec < 31 || $dec == 127)} { #review - non-printing ascii? why does textutil::wcswidth report 1 ?? #todo - compare with python or other lang wcwidth incr width - } elseif {$c < 917504 || $c > 917631} { + } elseif {$dec < 917504 || $dec > 917631} { #TODO - various other joiners and non-printing chars - set w [textutil::wcswidth_char $c] + set w [textutil::wcswidth_char $dec] if {$w < 0} { return -1 } else { @@ -2145,18 +2145,18 @@ tcl::namespace::eval punk::char { #TODO set codes [scan $string [tcl::string::repeat %c [tcl::string::length $string]]] set width 0 - foreach c $codes { + foreach dec $codes { #unicode Tags block zero width - if {$c < 917504 || $c > 917631} { - if {$c <= 255} { + if {$dec < 917504 || $dec > 917631} { + if {$dec <= 255} { #review - non-printing ascii? why does textutil::wcswidth report 1 ?? #todo - compare with python or other lang wcwidth - if {!($c < 31 || $c == 127)} { + if {!($dec < 31 || $dec == 127)} { incr width } } else { #TODO - various other joiners and non-printing chars - set w [textutil::wcswidth_char $c] + set w [textutil::wcswidth_char $dec] ;#takes decimal codepoint if {$w < 0} { return -1 } else { @@ -2169,7 +2169,7 @@ tcl::namespace::eval punk::char { } proc wcswidth2 {string} { set codes [scan $string [tcl::string::repeat %c [tcl::string::length $string]]] - set widths [lmap c $codes {textutil::wcswidth_char $c}] + set widths [lmap dec $codes {textutil::wcswidth_char $dec}] if {-1 in $widths} { return -1 } diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.1.1.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.1.1.tm index 74365afa..2e10e75b 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.1.1.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.1.1.tm @@ -102,7 +102,8 @@ namespace eval punk::console { } variable ansi_response_chunk ;#array keyed on callid variable ansi_response_wait ;#array keyed on callid - variable ansi_response_queue ;#list of callids + array set ansi_response_wait {} + variable ansi_response_queue [list];#list of callids variable ansi_response_queuedata ;#dict keyed on callid - with function params # -- @@ -123,10 +124,6 @@ namespace eval punk::console { #ansi escape sequences are possibly preferable esp if terminal is remote to process running punk::console # punk::local commands may be more performant in some circumstances where console is directly attached, but it shouldn't be assumed. e.g ansi::titleset outperforms local::titleset on windows with twapi. - namespace eval ansi { - #ansi escape sequence based terminal/console control functions - namespace export * - } namespace eval local { #non-ansi terminal/console control functions #e.g external utils system API's. @@ -578,12 +575,73 @@ namespace eval punk::console { } - #capturingendregex should capture ANY prefix, whole escape match - and a subcapture of the data we're interested in and match at end of string. - #ie {(.*)(ESC(info)end)$} - #e.g {(.*)(\x1bP44!~([:alnum:])\x1b\\)$} - #we expect 4 results from regexp -indices -inline (overallmatch, prefix, wholeescape,info) + lappend PUNKARGS [list { + @id -id ::punk::console::internal::get_ansi_response_payload + @cmd -name punk::console::internal::get_ansi_response_payload -help\ + "Terminal query helper. + Captures the significant portion (payload as defined by + supplied capturingendregex capture groups) of the input + channel's response to a query placed on the output channel. + Usually this means a write to stdout with a response on + stdin. + This function uses a 'chan event' read handler function + ::punk::console::internal::ansi_response_handler_regex to + read the input channel character by character to ensure it + doesn't overconsume input. + + It can run cooperatively with the punk::repl stdin reader + or other readers if done carefully. + The mechanism to run while other readers are active involves + disabling and re-enabling installed 'chan event' handlers + and possibly using a shared namespace variable + (::punk::console::input_chunks_waiting) to ensure all data + gets to the right handler. (unread data on input prior to this + function being called) + Not fully documented. (source diving required -see punk::repl) + " + @opts + -ignoreok -type boolean -default 0 -help\ + "Experimental/debug + ignore the regex match 'ok' response + and keep going." + -return -type string -default payload -choices {payload dict} -choicelabels { + dict\ + "dict with keys prefix,response,payload,all" + } -help\ + "Return format" + + -terminal -default {stdin stdout} -type list -help\ + "terminal (currently list of in/out channels) (todo - object?)" + -expected_ms -default 100 -type integer -help\ + "Expected number of ms for response from terminal. + 100ms is usually plenty for a local terminal and a + basic query such as cursor position." + @values -min 2 -max 2 + query -type string -help\ + "ANSI sequence such as \x1b\[?6n which + should elicit a response by the terminal + on stdin" + capturingendregex -type string -help\ + "capturingendregex should capture ANY prefix, whole escape match - and a subcapture + of the data we're interested in; and match at end of string. + ie {(.*)(ESC(info)end)$} + e.g {(.*)(\x1bP44!~([:alnum:])\x1b\\)$} + we expect 4 results from regexp -indices -inline (overallmatch, prefix, wholeescape,info)" + }] #todo - check capturingendregex value supplied has appropriate captures and tail-anchor - proc get_ansi_response_payload {query capturingendregex {inoutchannels {stdin stdout}}} { + proc get_ansi_response_payload {args} { + #we pay a few 10s of microseconds to use punk::args::parse (on the happy path) + #seems reasonable for the flexibility in this case. + set argd [punk::args::parse $args withid ::punk::console::internal::get_ansi_response_payload] + lassign [dict values $argd] leaders opts values received + + set inoutchannels [dict get $opts -terminal] + set expected [dict get $opts -expected_ms] + set ignoreok [dict get $opts -ignoreok] + set returntype [dict get $opts -return] + set query [dict get $values query] + set capturingendregex [dict get $values capturingendregex] + lassign $inoutchannels input output #chunks from input that need to be handled by readers @@ -595,10 +653,12 @@ namespace eval punk::console { #In other contexts there may not even be another input reader #REVIEW - what if there is existing data in input_chunks_waiting - is it for us? - #temp - let's keep alert to it until we decide if it's legit/required.. - if {[info exists input_chunks_waiting($input)] && [llength $input_chunks_waiting($input)]} { - #puts stderr "[punk::ansi::a+ cyan bold]get_ansi_response_payload called while input_chunks_waiting($input) contained data: $input_chunks_waiting($input)[punk::ansi::a]" - } + #This occurs for example with key held down on autorepeat and is normal + #enable it here for debug/testing only + #if {[info exists input_chunks_waiting($input)] && [llength $input_chunks_waiting($input)]} { + # puts stderr "[punk::ansi::a+ cyan bold]get_ansi_response_payload called while input_chunks_waiting($input) contained data: [punk::ansi::a][ansistring VIEW $input_chunks_waiting($input)]" + #} + if {!$::punk::console::ansi_available} { return "" } @@ -615,17 +675,33 @@ namespace eval punk::console { upvar ::punk::console::ansi_response_wait waitvar upvar ::punk::console::ansi_response_queue queue upvar ::punk::console::ansi_response_queuedata queuedata - upvar ::punk::console::ansi_response_clock clock + upvar ::punk::console::ansi_response_tslaunch tslaunch + upvar ::punk::console::ansi_response_tsclock tsclock upvar ::punk::console::ansi_response_timeoutid timeoutid - set accumulator($callid) "" - set waitvar($callid) "" - lappend queue $callid + set accumulator($callid) "" + set waitvar($callid) "" + + lappend queue $callid + if {[llength $queue] > 1} { + #while {[lindex $queue 0] ne $callid} {} + set queuedata($callid) $args + set runningid [lindex $queue 0] + while {$runningid ne $callid} { + vwait ::punk::console::ansi_response_wait + set runningid [lindex $queue 0] + if {$runningid ne $callid} { + set ::punk::console::ansi_response_wait($runningid) $::punk::console::ansi_response_wait($runningid) + update ;#REVIEW - probably a bad idea + after 10 + } + } + } #todo - use a linked array and an accumulatorid and waitvar id? When can there be more than one terminal query in-flight? - set existing_handler [fileevent $input readable] ;#review! + set existing_handler [chan event $input readable] ;#review! set this_handler ::punk::console::internal::ansi_response_handler_regex if {[lindex $existing_handler 0] eq $this_handler} { puts stderr "[punk::ansi::a+ red]Warning for callid $callid get_ansi_response_payload called while existing ansi response handler in place[a]: $this_handler" @@ -633,109 +709,145 @@ namespace eval punk::console { flush stderr if {[lindex $queue 0] ne $callid} { + error "get_ansi_response_payload - re-entrancy unrecoverable" } - error "get_ansi_response_payload - re-entrancy unrecoverable" } + chan event $input readable {} - fileevent $input readable {} - - set input_state [fconfigure $input] - #todo - make timeout configurable? - set waitvarname "::punk::console::ansi_response_wait($callid)" - #500ms is generally plenty for a terminal to respond.. but not in some cases. e.g event loop busy with stdin keypress?? review - set timeoutid($callid) [after 1000 [list set $waitvarname timedout]] - - #JMN # - stderr vs stdout #It has to be same channel as used by functions such as test_char_width or erroneous results returned for those functions #(presumably race conditions as to when data hits console?) #review - experiment changing this and calling functions to stderr and see if it works #review - Are there disadvantages to using stdout vs stderr? - #puts stdout "sending console request [ansistring VIEW $query]" - puts -nonewline $output $query;flush $output + + set previous_input_state [chan configure $input] + #chan configure $input -blocking 0 + + #todo - make timeout configurable? + set waitvarname "::punk::console::ansi_response_wait($callid)" + #todo - test and save rawstate so we don't disableRaw if console was already raw if {![tsv::get console is_raw]} { set was_raw 0 punk::console::enableRaw + #after 0 [list chan event $input readable [list $this_handler $input $callid $capturingendregex]] + incr expected 50 ;#review + set timeoutid($callid) [after $expected [list set $waitvarname timedout]] + #puts stdout "sending console request [ansistring VIEW $query]" } else { set was_raw 1 + set timeoutid($callid) [after $expected [list set $waitvarname timedout]] } - fconfigure $input -blocking 0 - # - #in handler - its used for a boolean match (capturing aspect not used) - set clock($callid) [clock millis] ;#time of launch - may be delay before first event depending on what's going on + chan configure $input -blocking 0 - #first shot without using filevent, call the stdin reader directly - maybe it's there already - #This can be significantly faster than setting up a fileevent (2024 e.g 1.5ms vs 65ms) + set tslaunch($callid) [clock millis] ;#time of launch - may be delay before first event depending on what's going on + set tsclock($callid) $tslaunch($callid) + #write before console enableRaw vs after?? + #There seem to be problems (e.g on WSL) if we write too early - the output ends up on screen but we don't read it + puts -nonewline $output $query;flush $output $this_handler $input $callid $capturingendregex - if {$waitvar($callid) ne "ok"} { - fileevent $input readable [list $this_handler $input $callid $capturingendregex] + + if {$ignoreok || $waitvar($callid) ne "ok"} { + chan event $input readable [list $this_handler $input $callid $capturingendregex] } - #JMN #response from terminal #e.g for cursor position \033\[46;1R - - if {[set waitvar($callid)] eq ""} { - vwait ::punk::console::ansi_response_wait($callid) + #after 0 [list $this_handler $input $callid $capturingendregex] + set remaining $expected + if {$waitvar($callid) eq ""} { + set lastvwait [clock millis] + vwait ::punk::console::ansi_response_wait($callid) #puts stderr ">>>> end vwait1 $waitvar($callid)<<<<" - while {[string match extend-* $waitvar($callid)]} { - set extension [lindex [split $waitvar($callid) -] 1] - #puts stderr "get_ansi_response_payload Extending timeout by $extension" - #after cancel $timeoutid($callid) - set timeoutid($callid) [after $extension [list set $waitvarname timedout]] - vwait ::punk::console::ansi_response_wait($callid) + while {[string match extend-* $waitvar($callid)] || ($ignoreok && $waitvar($callid) eq "ok")} { + if {[string match extend-* $waitvar($callid)]} { + set extension [lindex [split $waitvar($callid) -] 1] + if {$extension eq ""} { + puts "blank extension $waitvar($callid)" + puts "->[set $waitvar($callid]<-" + } + puts stderr "get_ansi_response_payload Extending timeout by $extension" + after cancel $timeoutid($callid) + set total_elapsed [expr {[clock millis] - $tslaunch($callid)}] + set last_elapsed [expr {[clock millis] - $lastvwait}] + set remaining [expr {$remaining - $last_elapsed}] + if {$remaining < 0} {set remaining 0} + set newtime [expr {$remaining + $extension}] + set timeoutid($callid) [after $newtime [list set $waitvarname timedout]] + set lastvwait [clock millis] + vwait ::punk::console::ansi_response_wait($callid) + } else { + #ignoreok - reapply the handler that disabled itself due to 'ok' + chan event $input readable [list $this_handler $input $callid $capturingendregex] + set lastvwait [clock millis] + vwait ::punk::console::ansi_response_wait($callid) + } } } - #response handler automatically removes it's own fileevent - fileevent $input readable {} ;#explicit remove anyway - review + #response handler automatically removes it's own chan event + chan event $input readable {} ;#explicit remove anyway - review if {$waitvar($callid) ne "timedout"} { after cancel $timeoutid($callid) } else { - puts stderr "timeout in get_ansi_response_payload. callid $callid Ansi request was:[ansistring VIEW -lf 1 -vt 1 $query]" + puts stderr "timeout (timediff [expr {[clock millis] - $tslaunch($callid)}]ms) in get_ansi_response_payload. callid $callid Ansi request was:[ansistring VIEW -lf 1 -vt 1 $query]" } if {$was_raw == 0} { punk::console::disableRaw } + #restore $input state - fconfigure $input -blocking [dict get $input_state -blocking] + #it *might* be ok to restore entire state on an input channel + #(it's not always on all channels - e.g stdout has -winsize which is read-only) + #Safest to only restore what we think we've modified. + fconfigure $input -blocking [dict get $previous_input_state -blocking] - set response [set accumulator($callid)] + set input_read [set accumulator($callid)] - if {$response ne ""} { - set got_match [regexp -indices $capturingendregex $response _match_indices prefix_indices response_indices payload_indices] + if {$input_read ne ""} { + set got_match [regexp -indices $capturingendregex $input_read _match_indices prefix_indices response_indices payload_indices] if {$got_match} { - set responsedata [string range $response {*}$response_indices] - set payload [string range $response {*}$payload_indices] - set prefixdata [string range $response {*}$prefix_indices] - if {$prefixdata ne ""} { - #puts stderr "Warning - get_ansi_response_payload read extra data at start - '[ansistring VIEW -lf 1 $prefixdata]' (response=[ansistring VIEW -lf 1 $responsedata])" + set responsedata [string range $input_read {*}$response_indices] + set payload [string range $input_read {*}$payload_indices] + set prefixdata [string range $input_read {*}$prefix_indices] + if {!$ignoreok && $prefixdata ne ""} { + #puts stderr "Warning - get_ansi_response_payload read extra data at start - '[ansistring VIEW -lf 1 $prefixdata]' (responsedata=[ansistring VIEW -lf 1 $responsedata])" lappend input_chunks_waiting($input) $prefixdata } } else { #timedout - or eof? - puts stderr "get_ansi_response_payload callid:$callid regex match '$capturingendregex' to data '[ansistring VIEW -lf 1 -vt 1 $response]' not found" - lappend input_chunks_waiting($input) $response - set payload "" + if {!$ignoreok} { + puts stderr "get_ansi_response_payload callid:$callid regex match '$capturingendregex' to input_read '[ansistring VIEW -lf 1 -vt 1 $input_read]' not found" + lappend input_chunks_waiting($input) $input_read + set payload "" + } else { + set responsedata "" + set payload "" + set prefixdata "" + } } } else { #timedout or eof? and nothing read - set payload "" + set responsedata "" + set prefixdata "" + set payload "" } + # ------------------------------------------------------------------------------------- + # Other input readers + # ------------------------------------------------------------------------------------- #is there a way to know if existing_handler is input_chunks_waiting aware? if {[string length $existing_handler] && [lindex $existing_handler 0] ne $this_handler} { #puts "get_ansi_response_payload reinstalling ------>$existing_handler<------" - fileevent $input readable $existing_handler - #we may have consumed all pending input on $input - so there may be no trigger for the readable fileevent + chan event $input readable $existing_handler + #this_handler may have consumed all pending input on $input - so there may be no trigger for the readable chan event for existing_handler if {[llength $input_chunks_waiting($input)]} { #This is experimental If a handler is aware of input_chunks_waiting - there should be no need to schedule a trigger #If it isn't, but the handler can accept an existing chunk of data as a 'waiting' argument - we could trigger and pass it the waiting chunks - but there's no way to know its API. @@ -772,33 +884,49 @@ namespace eval punk::console { #The input_chunks_waiting may really belong to the existing_handler we found - but if it doesn't consume them they will end up being read by the repl_handler when it eventually re-enables. #todo - some better structure than just a list of waiting chunks indexed by input channel, so repl/other handlers can determine the context in which these waiting chunks were generated? } elseif {[package provide punk::repl::codethread] ne "" && [punk::repl::codethread::is_running]} { - if {[llength $input_chunks_waiting($input)]} { + #if {[llength $input_chunks_waiting($input)]} { #don't trigger the repl handler manually - we will inevitably get things out of order - as it knows when to enable/disable itself based on whether chunks are waiting. #triggering it by putting it on the eventloop will potentially result in re-entrancy #The cooperating reader must be designed to consume waiting chunks and only reschedule it's channel read handler once all waiting chunks have been consumed. #puts stderr "[punk::ansi::a+ green bold]--> repl_handler has chunks to consume [ansistring VIEW $input_chunks_waiting($input)][punk::ansi::a]" - } + #} if {[eof $input]} { #test - puts stdout "restarting repl" + puts stdout "get_ansi_response_payload experimental - restarting repl" repl::reopen stdin } } + # ------------------------------------------------------------------------------------- - catch { - unset accumulator($callid) - unset waitvar($callid) - dict unset queuedata $callid - } - if {[llength $queue] > 1} { - set next_callid [lindex $queue 1] + + + unset -nocomplain accumulator($callid) + unset -nocomplain waitvar($callid) + unset -nocomplain timeoutid($callid) + unset -nocomplain tsclock($callid) + unset -nocomplain tslaunch($callid) + dict unset queuedata $callid + + lpop queue 0 + if {[llength $queue] > 0} { + set next_callid [lindex $queue 0] set waitvar($callid) go_ahead + #set nextdata [set queuedata($next_callid)] } - lpop queue 0 + #set punk::console::chunk "" - return $payload + if {$returntype eq "dict"} { + return [dict create\ + prefix $prefixdata\ + payload $payload\ + response $responsedata\ + all $input_read\ + ] + } else { + return $payload + } } @@ -811,43 +939,66 @@ namespace eval punk::console { proc ansi_response_handler_regex {chan callid endregex} { upvar ::punk::console::ansi_response_chunk chunks upvar ::punk::console::ansi_response_wait waits - upvar ::punk::console::ansi_response_clock clock ;#initial time in millis was set when fileevent was created + upvar ::punk::console::ansi_response_tslaunch tslaunch ;#initial time in millis was set when chan event was created + upvar ::punk::console::ansi_response_tsclock tsclock #endregex should explicitly have a trailing $ set status [catch {read $chan 1} bytes] if { $status != 0 } { # Error on the channel - fileevent $chan readable {} + chan event $chan readable {} puts "ansi_response_handler_regex error reading $chan: $bytes" - set waits($callid) [list error_read status $status bytes $bytes] + set waits($callid) [list error error_read status $status bytes $bytes] } elseif {$bytes ne ""} { + #puts stderr . ;flush stderr # Successfully read the channel #puts "got: [string length $bytes]bytes" - append chunks($callid) $bytes + set sofar [append chunks($callid) $bytes] #puts stderr [ansistring VIEW $chunks($callid)] - if {[regexp $endregex $chunks($callid)]} { - fileevent $chan readable {} + #review - what is min length of any ansiresponse? + #endregex is capturing - but as we are only testing the match here + #it should perform the same as if it were non-capturing + if {[string length $sofar] > 3 && [regexp $endregex $sofar]} { #puts stderr "matched - setting ansi_response_wait($callid) ok" + chan event $chan readable {} set waits($callid) ok } else { - if {[string length $chunks($callid)] % 10 == 0 || $clock($callid) - [clock millis] > 50} { - after cancel $::punk::console::ansi_response_timeoutid($callid) - set waits($callid) extend-1000 + # 30ms 16ms? + set tsnow [clock millis] + set total_elapsed [expr {[set tslaunch($callid)] - $tsnow}] + set last_elapsed [expr {[set tsclock($callid)] - $tsnow}] + if {[string length $chunks($callid)] % 10 == 0 || $last_elapsed > 16} { + if {$total_elapsed > 3000} { + #REVIEW + #too long since initial read handler launched.. + #is other data being pumped into stdin? Eventloop starvation? Did we miss our codes? + #For now we'll stop extending the timeout. + after cancel $::punk::console::ansi_response_timeoutid($callid) + set waits($callid) [list error error_ansi_response_handler_regex_too_long_reading] + } else { + if {$last_elapsed > 0} { + after cancel $::punk::console::ansi_response_timeoutid($callid) + set waits($callid) extend-[expr {min(16,$last_elapsed)}] + } + } } + set tsclock(callid) [clock millis] } } elseif {[catch {eof $chan}] || [eof $chan]} { - catch {fileevent $chan readable {}} + catch {chan event $chan readable {}} # End of file on the channel #review puts stderr "ansi_response_handler_regex end of file on channel $chan" set waits($callid) eof - } elseif {![catch {fblocked $chan}] && [fblocked $chan]} { - # Read blocked. Just return + } elseif {![catch {chan blocked $chan}] && [chan blocked $chan]} { + # Read blocked is normal. (chan -blocking = 0 but reading only 1 char) # Caller should be using timeout on the wait variable + #set waits($callid) continue + set tsclock($callid) [clock millis] } else { - fileevent $chan readable {} + chan event $chan readable {} # Something else - puts stderr "ansi_response_handler_regex Situation shouldn't be possible. No error and no bytes read on channel $chan but chan is not fblocked or EOF" + puts stderr "ansi_response_handler_regex Situation shouldn't be possible. No error and no bytes read on channel $chan but not chan blocked or EOF" set waits($callid) error_unknown_zerobytes_while_not_blocked_or_eof } } @@ -865,17 +1016,9 @@ namespace eval punk::console { #a and a+ functions are not very useful when emitting directly to console #e.g puts [punk::console::a red]test[punk::console::a cyan] would produce a cyan coloured test as the commands are evaluated first - proc a? {args} { - #stdout - variable ansi_wanted - if {$ansi_wanted <= 0} { - puts -nonewline [punk::ansi::ansistripraw [::punk::ansi::a?]] - } else { - tailcall ansi::a? {*}$args - } - } - punk::args::set_alias ::punk::console::code_a+ ::punk::ansi::a+ + #punk::args::set_alias ::punk::console::code_a+ ::punk::ansi::a+ + lappend PUNKARGS_aliases {::punk::console::code_a+ ::punk::ansi::a+} proc code_a+ {args} { variable ansi_wanted if {$ansi_wanted <= 0} { @@ -885,6 +1028,7 @@ namespace eval punk::console { #tailcall punk::ansi::a+ {*}$args ::punk::ansi::a+ {*}$args } + lappend PUNKARGS_aliases {::punk::console::code_a ::punk::ansi::a} proc code_a {args} { variable ansi_wanted if {$ansi_wanted <= 0} { @@ -893,6 +1037,7 @@ namespace eval punk::console { #tailcall punk::ansi::a {*}$args ::punk::ansi::a {*}$args } + lappend PUNKARGS_aliases {::punk::console::code_a? ::punk::ansi::a?} proc code_a? {args} { variable ansi_wanted if {$ansi_wanted <= 0} { @@ -901,6 +1046,15 @@ namespace eval punk::console { tailcall ::punk::ansi::a? {*}$args } } + #proc a? {args} { + # #stdout + # variable ansi_wanted + # if {$ansi_wanted <= 0} { + # puts -nonewline [punk::ansi::ansistripraw [::punk::ansi::a?]] + # } else { + # tailcall ansi::a? {*}$args + # } + #} #REVIEW! this needs reworking. #It needs to be clarified as to what ansi off is supposed to do. @@ -968,38 +1122,36 @@ namespace eval punk::console { return [expr {!$colour_disabled}] } - - namespace eval ansi { - proc a {args} { - puts -nonewline [::punk::ansi::a {*}$args] - } - proc a? {args} { - puts -nonewline stdout [::punk::ansi::a? {*}$args] - } - proc a+ {args} { - puts -nonewline [::punk::ansi::a+ {*}$args] - } - proc clear {} { - puts -nonewline stdout [punk::ansi::clear] - } - proc clear_above {} { - puts -nonewline stdout [punk::ansi::clear_above] + #test - find a better place to set terminal type + variable is_vt52 0 + proc vt52 {{onoff {}}} { + #todo - return to colour state beforehand?. support 0-15 vt52 colours? + #we shouldn't have to trun off colour to enter vt52 - we should make punk::console emit correct codes + variable is_vt52 + if {$onoff eq ""} { + return $is_vt52 } - proc clear_below {} { - puts -nonewline stdout [punk::ansi::clear_below] + if {![string is boolean -strict $onoff]} { + error "vt52 setting must be a boolean - or empty to query" } - proc clear_all {} { - puts -nonewline stdout [punk::ansi::clear_all] - } - proc reset {} { - puts -nonewline stdout [punk::ansi::reset] + if {$is_vt52} { + if {!$onoff} { + puts -nonewline "\x1b<" + set is_vt52 0 + colour on + } + } else { + if {$onoff} { + unset_mode DECANM + set is_vt52 1 + colour off + } else { + puts -nonewline "\x1b<" + #emit even though our is_vt52 flag thinks it's on. Should be harmless if underlying terminal already vt100+ + } } + return $is_vt52 } - namespace import ansi::clear - namespace import ansi::clear_above - namespace import ansi::clear_below - namespace import ansi::clear_all - namespace import ansi::reset namespace eval local { proc set_codepage_output {cpname} { @@ -1018,22 +1170,117 @@ namespace eval punk::console { error "set_codepage_input unimplemented on $::tcl_platform(platform)" } } + lappend PUNKARGS [list { + @id -id ::punk::console::local::echo + @cmd -name punk::console::local::echo -help\ + "Use stty on unix, or twapi on windows to set terminal + local input echo on/off - experimental" + @values -min 0 -max 1 + onoff -type boolean -default "" -help\ + "Omit or pass empty string to query current echo state." + }] + proc echo {args} { + set argd [punk::args::parse $args withid ::punk::console::local::echo] + set onoff [dict get $argd values onoff] + + set is_windows [string equal "windows" $::tcl_platform(platform)] + if {$onoff eq ""} { + #query + if {$is_windows} { + package require twapi + set inputstate [twapi::get_console_input_mode] + return [dict get $inputstate -echoinput] + } else { + #counterintuitively - the human format (-a) seems more consistent across platforms than the machine readable (-g) formats + #for now, quick and dirty look for echo in the list seems to work on wsl & freebsd at least. + set tstate [exec stty -a] + if {[lsearch $tstate echo] > 0} { + return 1 + } else { + return 0 + } + } + } else { + if {![string is boolean -strict $onoff]} { + error "::punk::console::local::echo requires boolean argument to set on or off" + } + if {$is_windows} { + set onoff [expr {true && $onoff}] ;#ensure true,yes etc are converted to 1|0 + set conh [twapi::get_console_handle stdin] + twapi::modify_console_input_mode $conh -echoinput $onoff + + return $onoff + } else { + if {$onoff} { + {*}[auto_execok stty] echo + return 1 + } else { + {*}[auto_execok stty] -echo + return 0 + } + } + } + } } namespace import local::set_codepage_output namespace import local::set_codepage_input + + lappend PUNKARGS [list { + @id -id ::punk::console::show_input_response + @cmd -name punk::console::show_input_response -help\ + "" + @opts + -terminal -default {stdin stdout} -type list -help\ + "terminal (currently list of in/out channels) (todo - object?)" + -expected_ms -type integer -default 500 -help\ + "Number of ms to wait for response" + @values -min 1 -max 1 + request -type string -help\ + "ANSI sequence such as \x1b\[?6n which + should elicit a response by the terminal + on stdin" + }] + proc show_input_response {args} { + set argd [punk::args::parse $args withid ::punk::console::show_input_response] + lassign [dict values $argd] leaders opts values received + set request [dict get $values request] + set inoutchannels [dict get $opts -terminal] + set expected [dict get $opts -expected_ms] + + set capturingregex {(((.*)))$} ;#capture entire response same as response-payload + set ts_start [clock millis] + set response [punk::console::internal::get_ansi_response_payload -ignoreok 1 -return dict -expected_ms $expected -terminal $inoutchannels $request $capturingregex] + set ts_end [clock millis] + puts stderr $response + set out "" + dict for {k v} $response { + append out "$k [ansistring VIEW $v]" \n + } + append out "totalms [expr {$ts_end - $ts_start}]" + return $out + } + # -- --- --- --- --- --- --- #get_ansi_response functions #review - can these functions sensibly be used on channels not attached to the local console? #ie can we default to {stdin stdout} but allow other channel pairs? # -- --- --- --- --- --- --- proc get_cursor_pos {{inoutchannels {stdin stdout}}} { + if {$::punk::console::is_vt52} { + error "vt52 can't perform get_cursor_pos" + } #response from terminal #e.g \033\[46;1R set capturingregex {(.*)(\x1b\[([0-9]+;[0-9]+)R)$} ;#must capture prefix,entire-response,response-payload set request "\033\[6n" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] + #some terminals fail to respond properly to \x1b\[6n but do respond to \x1b\[?6n and vice-versa :/ + #todo - what? + #often terminals that fail will just put the raw request code on stdin - we could detect that and then + #try the other? + return $payload } proc get_checksum_rect {id page t l b r {inoutchannels {stdin stdout}}} { @@ -1041,13 +1288,13 @@ namespace eval punk::console { #re e.g {(.*)(\x1b\[P44!~([[:alnum:]])\x1b\[\\)$} set capturingregex [string map [list %id% $id] {(.*)(\x1bP%id%!~([[:alnum:]]+)\x1b\\)$}] set request "\x1b\[${id}\;${page}\;$t\;$l\;$b\;$r*y" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } proc get_device_status {{inoutchannels {stdin stdout}}} { set capturingregex {(.*)(\x1b\[([0-9]+)n)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[5n" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } @@ -1083,7 +1330,7 @@ namespace eval punk::console { #set capturingregex {(.*)(\x1b\[\?6[0-9][;]*([;0-9]+)c)$} ;#must capture prefix,entire-response,response-payload set capturingregex {(.*)(\x1b\[\?([0-9]*[;0-9]+)c)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[c" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] set last_da1_result $payload return $payload } @@ -1093,14 +1340,14 @@ namespace eval punk::console { set capturingregex {(.*)(\x1b\[\>([0-9]*[;][0-9]*[;][0-1]c))$} ;#must capture prefix,entire-response,response-payload #expect CSI > X;10|20;0|1c - docs suggest X should be something like 61. In practice we see 0 or 1 (windows) REVIEW set request "\x1b\[>c" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } proc get_device_attributes_tertiary {{inoutchannels {stdin stdout}}} { #DA3 set capturingregex {(.*)(\x1bP!\|([0-9]{8})\x1b\\)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[=c" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } proc get_terminal_id {{inoutchannels {stdin stdout}}} { @@ -1115,7 +1362,7 @@ namespace eval punk::console { #set capturingregex {(.*)(\x1bP2$u((?:[0-9]+)*(?:\/[0-9]+)*)\x1b\\)$} set capturingregex {(.*)(\x1bP2\$u(.*)\x1b\\)$} set request "\x1b\[2\$w" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] set tabstops [split $payload "/"] return $tabstops } @@ -1263,18 +1510,29 @@ namespace eval punk::console { } #keep out of catch - no point in even trying a restore move if we can't get start position - just fail here. + #no vt52 equiv? may as well strip all vt52 from here? lassign [get_cursor_pos_list $inoutchannels] start_row start_col - + variable is_vt52 + if {!$is_vt52} { + set movefunc "punk::ansi::move" + set func_coff "punk::ansi::cursor_off" + set func_con "punk::ansi::cursor_on" + } else { + set movefunc "punk::ansi::vt52move" + set func_coff "punk::ansi::cursor_off_vt52" + set func_con "punk::ansi::cursor_on_vt52" + } if {[catch { #some terminals (conemu on windows) scroll the viewport when we make a big move down like this - a move to 1 1 immediately after cursor_save doesn't seem to fix that. #This issue also occurs when switching back from the alternate screen buffer - so perhaps that needs to be addressed elsewhere. - puts -nonewline $out [punk::ansi::cursor_off][punk::ansi::move 2000 2000] + + puts -nonewline $out [$func_coff][$movefunc 2000 2000] lassign [get_cursor_pos_list $inoutchannels] lines cols - puts -nonewline $out [punk::ansi::move $start_row $start_col][punk::console::cursor_on];flush stdout + puts -nonewline $out [$movefunc $start_row $start_col][$func_con];flush stdout set result [list columns $cols rows $lines] } errM]} { - puts -nonewline $out [punk::ansi::move $start_row $start_col] - puts -nonewline $out [punk::ansi::cursor_on] + puts -nonewline $out [$movefunc $start_row $start_col] + puts -nonewline $out [$func_con] error "$errM" } else { return $result @@ -1316,21 +1574,24 @@ namespace eval punk::console { proc get_xterm_size {{inoutchannels {stdin stdout}}} { set capturingregex {(.*)(\x1b\[8;([0-9]+;[0-9]+)t)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[18t" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] lassign [split $payload {;}] rows cols return [list columns $cols rows $rows] } proc get_xterm_pixels {{inoutchannels {stdin stdout}}} { set capturingregex {(.*)(\x1b\[4;([0-9]+;[0-9]+)t)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[14t" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] lassign [split $payload {;}] height width return [list width $width height $height] } + + + proc get_mode_line_wrap {{inoutchannels {stdin stdout}}} { set capturingregex {(.*)(\x1b\[\?7;([0-9]+)\$y)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[?7\$p" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } #Terminals generally default to LNM being reset (off) ie enter key sends a lone @@ -1339,7 +1600,7 @@ namespace eval punk::console { proc get_mode_LNM {{inoutchannels {stdin stdout}}} { set capturingregex {(.*)(\x1b\[\?20;([0-9]+)\$y)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[?20\$p" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } #DECRPM responses e.g: @@ -1359,7 +1620,7 @@ namespace eval punk::console { } set capturingregex [string map [list %MODE% $m] {(.*)(\x1b\[\?%MODE%;([0-9]+)\$y)$}] ;#must capture prefix,entire-response,response-payload set request "\x1b\[?$m\$p" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } proc set_mode {num_or_name {inoutchannels {stdin stdout}}} { @@ -1373,7 +1634,7 @@ namespace eval punk::console { error "punk::console::set_mode unrecognised mode '$num_or_name'. Known mode names: [dict keys $decmode_names]" } } - return "\x1b\[?${m}h" + puts -nonewline "\x1b\[?${m}h" } proc unset_mode {num_or_name {inoutchannels {stdin stdout}}} { if {[string is integer -strict $num_or_name]} { @@ -1386,7 +1647,7 @@ namespace eval punk::console { error "punk::console::unset_mode unrecognised mode '$num_or_name'. Known mode names: [dict keys $decmode_names]" } } - return "\x1b\[?${m}l" + puts -nonewline "\x1b\[?${m}l" } @@ -1584,16 +1845,6 @@ namespace eval punk::console { return [dict create available $is_available mode $m] } - namespace eval ansi { - proc cursor_on {} { - puts -nonewline stdout [punk::ansi::cursor_on] - } - proc cursor_off {} { - puts -nonewline stdout [punk::ansi::cursor_off] - } - } - namespace import ansi::cursor_on - namespace import ansi::cursor_off #review - the concept of using local mechanisms at all (ie apis) vs ansi is not necessarily something we want/need to support. #For the system to be really useful if needs to operate in conditions where the terminal is remote @@ -1625,24 +1876,6 @@ namespace eval punk::console { } } - namespace eval ansi { - proc titleset {windowtitle} { - puts -nonewline stdout [punk::ansi::titleset $windowtitle] - } - } - #namespace import ansi::titleset - proc titleset {windowtitle} { - variable ansi_wanted - if { $ansi_wanted <= 0} { - punk::console::local::titleset $windowtitle - } else { - ansi::titleset $windowtitle - } - } - #no known pure-ansi solution - proc titleget {} { - return [local::titleget] - } proc infocmp {} { set cmd1 [auto_execok infocmp] @@ -1685,16 +1918,113 @@ namespace eval punk::console { return [split $data ";"] } + #channel? namespace eval ansi { + variable PUNKARGS + #ansi escape sequence based terminal/console control functions + namespace export * + + #proc a {args} { + # puts -nonewline [::punk::ansi::a {*}$args] + #} + #proc a+ {args} { + # puts -nonewline [::punk::ansi::a+ {*}$args] + #} + #proc a? {args} { + # puts -nonewline stdout [::punk::ansi::a? {*}$args] + #} + proc clear {} { + puts -nonewline stdout [punk::ansi::clear] + } + proc clear_above {} { + puts -nonewline stdout [punk::ansi::clear_above] + } + proc clear_below {} { + puts -nonewline stdout [punk::ansi::clear_below] + } + proc clear_all {} { + puts -nonewline stdout [punk::ansi::clear_all] + } + proc reset {} { + puts -nonewline stdout [punk::ansi::reset] + } + proc cursor_on {} { + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::cursor_on] + } else { + puts -nonewline stdout [punk::ansi::cursor_on_vt52] + } + } + proc cursor_off {} { + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::cursor_off] + } else { + puts -nonewline stdout [punk::ansi::cursor_off_vt52] + } + } + + lappend PUNKARGS [list { + @id -id ::punk::console::ansi::move + @cmd -name punk::console::move -help\ + {Return an ANSI or vt52 sequence to move cursor to row,col + (aka: cursor home) + + The sequence emitted will depend on the mode of the + terminal as stored in the consolehandle. + Directly setting the mode via raw escape sequences: + e.g unset_mode DECANM for vt52 + or puts \x1b< to return to ANSI + will not necessarily update the application of + the change in terminal state. Major state changes + such as this should be done via provided functions + that keep the REPL state in sync with the underlying + terminal state. + + For ANSI the sequence is of the form: + ESC[;H + (CSI row ; col H) + This sequence will generally not be understood by + terminals that are in vt52 mode. + + For VT52 the sequence is of the form: + ESCY + This sequence will generally not be understood by + terminals that are not in vt52 mode even if higher + modes are supported. + + } + @values -min 2 -max 2 + row -type integer -help\ + "row number - starting at 1" + col -type integer -help\ + "column number - starting at 1" + }] proc move {row col} { - puts -nonewline stdout [punk::ansi::move $row $col] + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + return [punk::ansi::move $row $col] + } else { + return [punk::ansi::vt52move $row $col] + } } proc move_forward {n} { - puts -nonewline stdout [punk::ansi::move_forward $n] + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::move_forward $n] + } else { + puts -nonewline stdout [punk::ansi::vt52move_forward $n] + } } proc move_back {n} { - puts -nonewline stdout [punk::ansi::move_back $n] + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::move_back $n] + } else { + puts -nonewline stdout [punk::ansi::vt52move_back $n] + } } proc move_up {n} { puts -nonewline stdout [punk::ansi::move_up $n] @@ -1703,21 +2033,101 @@ namespace eval punk::console { puts -nonewline stdout [punk::ansi::move_down $n] } proc move_column {col} { - puts -nonewline stdout [punk::ansi::move_column $col] + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::move_column $col] + } else { + puts -nonewline stdout [punk::ansi::vt52move_column $col] + } } proc move_row {row} { puts -nonewline stdout [punk::ansi::move_row $row] } proc move_emit {row col data args} { - puts -nonewline stdout [punk::ansi::move_emit $row $col $data {*}$args] + upvar ::punk::console::is_v52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::move_emit $row $col $data {*}$args] + } else { + puts -nonewline stdout [punk::ansi::v52move_emit $row $col $data {*}$args] + } } proc move_emit_return {row col data args} { + #todo detect if in raw mode or not? + set is_in_raw 0 lassign [punk::console::get_cursor_pos_list] orig_row orig_col - set out "" - append out [punk::ansi::move_emit $row $col $data {*}$args] + + set commands "" + append commands [punk::ansi::move_emit $row $col $data {*}$args] + foreach {row col data} $args { + append commands [punk::ansi::move_emit $row $col $data {*}$args] + } if {!$is_in_raw} { incr orig_row -1 } + append commands [punk::ansi::move $orig_row $orig_col] + puts -nonewline stdout $commands + return "" + } + proc move_emitblock_return {row col textblock} { + lassign [punk::console::get_cursor_pos_list] orig_row orig_col + + set commands "" + foreach ln [split $textblock \n] { + append commands [punk::ansi::move_emit $row $col $ln] + incr row + } + append commands [punk::ansi::move $orig_row $orig_col] + puts -nonewline $commands + return + } + #we can be (slightly?) faster and more efficient if we use the consoles cursor_save_dec command - but each savecursor overrides any previous one. + #leave cursor_off/cursor_on to caller who can wrap more efficiently.. + proc cursorsave_move_emit_return {row col data args} { + upvar ::punk::console::is_vt52 is_vt52 + #JMN + set commands "" + if {!$is_vt52} { + append commands [punk::ansi::cursor_save_dec] + append commands [punk::ansi::move_emit $row $col $data] + foreach {row col data} $args { + append commands [punk::ansi::move_emit $row $col $data] + } + append commands [punk::ansi::cursor_restore_dec] + } else { + append commands [punk::ansi::cursor_save_vt52] + append commands [punk::ansi::vt52move_emit $row $col $data] + foreach {row col data} $args { + append commands [punk::ansi::vt52move_emit $row $col $data] + } + append commands [punk::ansi::cursor_restore_vt52] + } + puts -nonewline stdout $commands; flush stdout + } + proc cursorsave_move_emitblock_return {row col textblock} { + set commands "" + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + append commands [punk::ansi::cursor_save_dec] + foreach ln [split $textblock \n] { + append commands [punk::ansi::move_emit $row $col $ln] + incr row + } + append commands [punk::ansi::cursor_restore_dec] + } else { + append commands [punk::ansi::cursor_save_vt52] + foreach ln [split $textblock \n] { + append commands [punk::ansi::vt52move_emit $row $col $ln] + incr row + } + append commands [punk::ansi::cursor_restore_vt52] + } + puts -nonewline stdout $commands;flush stdout + return + } + proc move_call_return {row col script} { + lassign [punk::console::get_cursor_pos_list] orig_row orig_col + move $row $col + uplevel 1 $script move $orig_row $orig_col } proc scroll_up {n} { @@ -1772,28 +2182,49 @@ namespace eval punk::console { proc delete_lines {count} { puts -nonewline \x1b\[${count}M } + proc titleset {windowtitle} { + puts -nonewline stdout [punk::ansi::titleset $windowtitle] + } + proc test_decaln {} { + puts -nonewline stdout [punk::ansi::test_decaln] + } + } + namespace import ::punk::console::ansi::* + catch {rename titleset ""} + #namespace import ansi::titleset + proc titleset {windowtitle} { + variable ansi_wanted + if { $ansi_wanted <= 0} { + punk::console::local::titleset $windowtitle + } else { + ansi::titleset $windowtitle + } + } + #no known pure-ansi solution + proc titleget {} { + return [local::titleget] + } + + foreach ansicmd [list ::punk::console::ansi::move] { + set ctail [namespace tail $ansicmd] + set arglist [info args $ansicmd] + set argcall "" + if {[llength $arglist]} { + foreach a [lrange $arglist 0 end-1] { + append argcall "\$$a " + } + if {[lindex $arglist end] eq "args"} { + append argcall {{*}$args} + } else { + append argcall "\$[lindex $arglist end]" + } + } + catch {rename $ctail ""} + proc $ctail $arglist [string map [list %ansicmd% $ansicmd %argcall% $argcall] { + puts -nonewline [%ansicmd% %argcall%] + }] } - namespace import ansi::move - namespace import ansi::move_emit - namespace import ansi::move_forward - namespace import ansi::move_back - namespace import ansi::move_up - namespace import ansi::move_down - namespace import ansi::move_column - namespace import ansi::move_row - namespace import ansi::cursor_save - namespace import ansi::cursor_restore - namespace import ansi::cursor_save_dec - namespace import ansi::cursor_restore_dec - namespace import ansi::scroll_up - namespace import ansi::scroll_down - namespace import ansi::enable_alt_screen - namespace import ansi::disable_alt_screen - namespace import ansi::insert_spaces - namespace import ansi::delete_characters - namespace import ansi::erase_characters - namespace import ansi::insert_lines - namespace import ansi::delete_lines + #experimental @@ -1812,90 +2243,25 @@ namespace eval punk::console { puts -nonewline [punk::ansi::erase_eol][punk::ansi::move_column $col]$text cursor_restore } - proc move_emit_return {row col data args} { - #todo detect if in raw mode or not? - set is_in_raw 0 - lassign [punk::console::get_cursor_pos_list] orig_row orig_col - set commands "" - append commands [punk::ansi::move_emit $row $col $data] - foreach {row col data} $args { - append commands [punk::ansi::move_emit $row $col $data] - } - if {!$is_in_raw} { - incr orig_row -1 - } - append commands [punk::ansi::move $orig_row $orig_col] - puts -nonewline stdout $commands - return "" - } - #we can be (slightly?) faster and more efficient if we use the consoles cursor_save_dec command - but each savecursor overrides any previous one. - #leave cursor_off/cursor_on to caller who can wrap more efficiently.. - proc cursorsave_move_emit_return {row col data args} { - set commands "" - append commands [punk::ansi::cursor_save_dec] - append commands [punk::ansi::move_emit $row $col $data] - foreach {row col data} $args { - append commands [punk::ansi::move_emit $row $col $data] - } - append commands [punk::ansi::cursor_restore_dec] - puts -nonewline stdout $commands; flush stdout - } - proc move_emitblock_return {row col textblock} { + #this doesn't work - we would need an internal virtual screen structure to pick up cursor attributes from arbitrary locations? + # ncurses and its ilk may have something like that - but we specifically want to avoid curses libraries + proc pick {row col} { lassign [punk::console::get_cursor_pos_list] orig_row orig_col - - set commands "" - foreach ln [split $textblock \n] { - append commands [punk::ansi::move_emit $row $col $ln] - incr row - } - append commands [punk::ansi::move $orig_row $orig_col] - puts -nonewline $commands - return - } - proc cursorsave_move_emitblock_return {row col textblock} { - set commands "" - append commands [punk::ansi::cursor_save_dec] - foreach ln [split $textblock \n] { - append commands [punk::ansi::move_emit $row $col $ln] - incr row - } - append commands [punk::ansi::cursor_restore_dec] - puts -nonewline stdout $commands;flush stdout - return - } - proc move_call_return {row col script} { + set test "" + #set test [a green Yellow] + move_emit $row $col $test\0337 + puts -nonewline \0338\033\[${orig_row}\;${orig_col}H + } + proc pick_emit {row col data} { + set test "" + #set test [a green Purple] lassign [punk::console::get_cursor_pos_list] orig_row orig_col - move $row $col - uplevel 1 $script - move $orig_row $orig_col + move_emit $row $col $test\0337 + puts -nonewline \0338\033\[${orig_row}\;${orig_col}H$data } - #this doesn't work - we would need an internal virtual screen structure to pick up cursor attributes from arbitrary locations? - # ncurses and its ilk may have something like that - but we specifically want to avoid curses libraries - proc pick {row col} { - lassign [punk::console::get_cursor_pos_list] orig_row orig_col - set test "" - #set test [a green Yellow] - move_emit $row $col $test\0337 - puts -nonewline \0338\033\[${orig_row}\;${orig_col}H - } - proc pick_emit {row col data} { - set test "" - #set test [a green Purple] - lassign [punk::console::get_cursor_pos_list] orig_row orig_col - move_emit $row $col $test\0337 - puts -nonewline \0338\033\[${orig_row}\;${orig_col}H$data - } - # -- --- --- --- --- --- - namespace eval ansi { - proc test_decaln {} { - puts -nonewline stdout [punk::ansi::test_decaln] - } - } - namespace import ansi::test_decaln - namespace eval clock { #map chars of chars "0" to "?"" ie 0x30 to x3f @@ -2152,7 +2518,7 @@ namespace eval punk::console { puts stderr "punk::console WARNING: no modern unicode support in this Tcl version. High unicode values not properly supported. (string length \\U00010000 : $high_unicode_length should be 1)" } else { set can_high_unicode 1 - set can_regex_high_unicode [string match [regexp -all -inline {[\U80-\U0010FFFF]} \U0001F525] \U0001F525] + set can_regex_high_unicode [string equal [regexp -all -inline {[\U80-\U0010FFFF]} \U0001F525] \U0001F525] if {!$can_regex_high_unicode} { puts stderr "punk::console warning: TCL version cannot perform braced regex of high unicode" } @@ -2235,6 +2601,10 @@ namespace eval punk::console::check { +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::console ::punk::console::internal ::punk::console::local ::punk::console::ansi +} diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.1.1.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.1.1.tm index 1381af87..09a73385 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.1.1.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.1.1.tm @@ -246,6 +246,58 @@ tcl::namespace::eval punk::lib::compat { #outside of lmap - don't know of any particularly nice ways to flatten to subindex 1 of each element.. #flattening then lsearch with -stride and * would be nice - but it's not avail in 8.6 + if {![info exists ::auto_index(readFile)]} { + if {[info commands ::readFile] eq ""} { + proc ::readFile {filename {mode text}} { + #readFile not seen in auto_index or as command: installed by punk::lib + # Parse the arguments + set MODES {binary text} + set ERR [list -level 1 -errorcode [list TCL LOOKUP MODE $mode]] + set mode [tcl::prefix match -message "mode" -error $ERR $MODES $mode] + + # Read the file + set f [open $filename [dict get {text r binary rb} $mode]] + try { + return [read $f] + } finally { + close $f + } + } + } + } + if {![info exists ::auto_index(writeFile)]} { + if {[info commands ::writeFile] eq ""} { + proc ::writeFile {args} { + #writeFile not seen in auto_index or as command: installed by punk::lib + # Parse the arguments + switch [llength $args] { + 2 { + lassign $args filename data + set mode text + } + 3 { + lassign $args filename mode data + set MODES {binary text} + set ERR [list -level 1 -errorcode [list TCL LOOKUP MODE $mode]] + set mode [tcl::prefix match -message "mode" -error $ERR $MODES $mode] + } + default { + set COMMAND [lindex [info level 0] 0] + return -code error -errorcode {TCL WRONGARGS} "wrong # args: should be \"$COMMAND filename ?mode? data\"" + } + } + + # Write the File + set f [open $filename [dict get {text w binary wb} $mode]] + try { + puts -nonewline $f $data + } finally { + close $f + } + } + } + } + if {"::lpop" ne [info commands ::lpop]} { #puts stderr "Warning - no built-in lpop" interp alias {} lpop {} ::punk::lib::compat::lpop @@ -1021,35 +1073,35 @@ namespace eval punk::lib { -separator -default "%sep%" -roottype -default "dict" -substructure -default {} - -channel -default stdout -help "existing channel - or 'none' to return as string" + -channel -default stdout -help\ + "existing channel - or 'none' to return as string" @values -min 1 -max -1 dictvar -type string -help "name of variable. Can be a dict, list or array" patterns -type string -default "*" -multiple 1 -help {Multiple patterns can be specified as separate arguments. - Each pattern consists of 1 or more segments separated by the hierarchy separator (forward slash) - The system uses similar patterns to the punk pipeline pattern-matching system. - The default assumed type is dict - but an array will automatically be extracted into key value pairs so will also work. - Segments are classified into list,dict and string operations. - Leading % indicates a string operation - e.g %# gives string length - A segment with a single @ is a list operation e.g @0 gives first list element, @1-3 gives the lrange from 1 to 3 - A segment containing 2 @ symbols is a dict operation. e.g @@k1 retrieves the value for dict key 'k1' - The operation type indicator is not always necessary if lower segments in the hierarchy are of the same type as the previous one. - e.g1 pdict env */%# - the pattern starts with default type dict, so * retrieves all keys & values, - the next hierarchy switches to a string operation to get the length of each value. - e.g2 pdict env W* S* - Here we supply 2 patterns, each in default dict mode - to display keys and values where the keys match the glob patterns - e.g3 pdict punk_testd */* - This displays 2 levels of the dict hierarchy. - Note that if the sublevel can't actually be interpreted as a dictionary (odd number of elements or not a list at all) - - then the normal = separator will be replaced with a coloured (or underlined if colour off) 'mismatch' indicator. - e.g4 set list {{k1 v1 k2 v2} {k1 vv1 k2 vv2}}; pdict list @0-end/@@k2 @*/@@k1 - Here we supply 2 separate pattern hierarchies, where @0-end and @* are list operations and are equivalent - The second level segement in each pattern switches to a dict operation to retrieve the value by key. - When a list operation such as @* is used - integer list indexes are displayed on the left side of the = for that hierarchy level. - + Each pattern consists of 1 or more segments separated by the hierarchy separator (forward slash) + The system uses similar patterns to the punk pipeline pattern-matching system. + The default assumed type is dict - but an array will automatically be extracted into key value pairs so will also work. + Segments are classified into list,dict and string operations. + Leading % indicates a string operation - e.g %# gives string length + A segment with a single @ is a list operation e.g @0 gives first list element, @1-3 gives the lrange from 1 to 3 + A segment containing 2 @ symbols is a dict operation. e.g @@k1 retrieves the value for dict key 'k1' + The operation type indicator is not always necessary if lower segments in the hierarchy are of the same type as the previous one. + e.g1 pdict env */%# + the pattern starts with default type dict, so * retrieves all keys & values, + the next hierarchy switches to a string operation to get the length of each value. + e.g2 pdict env W* S* + Here we supply 2 patterns, each in default dict mode - to display keys and values where the keys match the glob patterns + e.g3 pdict punk_testd */* + This displays 2 levels of the dict hierarchy. + Note that if the sublevel can't actually be interpreted as a dictionary (odd number of elements or not a list at all) + - then the normal = separator will be replaced with a coloured (or underlined if colour off) 'mismatch' indicator. + e.g4 set list {{k1 v1 k2 v2} {k1 vv1 k2 vv2}}; pdict list @0-end/@@k2 @*/@@k1 + Here we supply 2 separate pattern hierarchies, where @0-end and @* are list operations and are equivalent + The second level segement in each pattern switches to a dict operation to retrieve the value by key. + When a list operation such as @* is used - integer list indexes are displayed on the left side of the = for that hierarchy level. } }] #puts stderr "$argspec" @@ -1091,7 +1143,8 @@ namespace eval punk::lib { set sep " [punk::ansi::a+ Green]=$RST " ;#stick to basic default colours for wider terminal support set sep_mismatch " [punk::ansi::a+ Brightred undercurly underline undt-white]mismatch$RST " } - package require punk ;#we need pipeline pattern matching features + package require punk::pipe + #package require punk ;#we need pipeline pattern matching features package require textblock set argd [punk::args::get_dict [string map [list %sep% $sep %sep_mismatch% $sep_mismatch] { @@ -1102,23 +1155,29 @@ namespace eval punk::lib { -channel -default none -trimright -default 1 -type boolean -help\ "Trim whitespace off rhs of each line. - This can help prevent a single long line that wraps in terminal from making - every line wrap due to long rhs padding. - " - -separator -default {%sep%} -help "Separator column between keys and values" - -separator_mismatch -default {%sep_mismatch%} -help "Separator to use when patterns mismatch" - -roottype -default "dict" -help "list,dict,string" - -ansibase_keys -default "" -help "ansi list for each level in -substructure. e.g \[list \[a+ red\] \[a+ web-green\]\]" + This can help prevent a single long line that wraps in terminal from making + every line wrap due to long rhs padding." + -separator -default {%sep%} -help\ + "Separator column between keys and values" + -separator_mismatch -default {%sep_mismatch%} -help\ + "Separator to use when patterns mismatch" + -roottype -default "dict" -help\ + "list,dict,string" + -ansibase_keys -default "" -help\ + "ansi list for each level in -substructure. e.g \[list \[a+ red\] \[a+ web-green\]\]" -substructure -default {} -ansibase_values -default "" - -keytemplates -default {\$\{$key\}} -type list -help "list of templates for keys at each level" + -keytemplates -default {\$\{$key\}} -type list -help\ + "list of templates for keys at each level" -keysorttype -default "none" -choices {none dictionary ascii integer real} -keysortdirection -default increasing -choices {increasing decreasing} -debug -default 0 -type boolean -help\ "When enabled, produces some rudimentary debug output on stderr" @values -min 1 -max -1 - dictvalue -type list -help "dict or list value" - patterns -default "*" -type string -multiple 1 -help "key or key glob pattern" + dictvalue -type list -help\ + "dict or list value" + patterns -default "*" -type string -multiple 1 -help\ + "key or key glob pattern" }] $args] #for punk::lib - we want to reduce pkg dependencies. @@ -1201,7 +1260,7 @@ namespace eval punk::lib { set segments [split $pattern_nest /] set levelpatterns [lindex $segments 0] ;#possibly comma separated patterns #we need to use _split_patterns to separate (e.g to protect commas that appear within quotes) - set patterninfo [punk::_split_patterns $levelpatterns] + set patterninfo [punk::pipe::lib::_split_patterns $levelpatterns] #puts stderr "showdict-->_split_patterns: $patterninfo" foreach v_idx $patterninfo { lassign $v_idx v idx @@ -1479,7 +1538,7 @@ namespace eval punk::lib { # -- --- --- --- set substructure "" set pnext [lindex $segments 1] - set patterninfo [punk::_split_patterns $levelpatterns] + set patterninfo [punk::pipe::lib::_split_patterns $levelpatterns] if {[llength $patterninfo] == 0} { # // ? -review - what does this mean? for xpath this would mean at any level set substructure [lindex $pattern_this_structure end] @@ -2043,18 +2102,32 @@ namespace eval punk::lib { concat {*}[uplevel 1 lmap {*}$args] } - proc dict_getdef {dictValue args} { - if {[llength $args] < 1} { - error {wrong # args: should be "dict_getdef dictValue ?key ...? key default"} - } - set keys [lrange $args -1 end-1] - if {[tcl::dict::exists $dictValue {*}$keys]} { - return [tcl::dict::get $dictValue {*}$keys] - } else { - return [lindex $args end] + #proc dict_getdef {dictValue args} { + # if {[llength $args] < 1} { + # error {wrong # args: should be "dict_getdef dictValue ?key ...? key default"} + # } + # set keys [lrange $args -1 end-1] + # if {[tcl::dict::exists $dictValue {*}$keys]} { + # return [tcl::dict::get $dictValue {*}$keys] + # } else { + # return [lindex $args end] + # } + #} + if {[info commands ::tcl::dict::getdef] eq ""} { + proc dict_getdef {dictValue args} { + set keys [lrange $args 0 end-1] + if {[tcl::dict::exists $dictValue {*}$keys]} { + return [tcl::dict::get $dictValue {*}$keys] + } else { + return [lindex $args end] + } } + } else { + #we pay a minor perf penalty for the wrap + interp alias "" ::punk::lib::dict_getdef "" ::tcl::dict::getdef } + #proc sample1 {p1 n args} { # #*** !doctools # #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] @@ -2722,6 +2795,7 @@ namespace eval punk::lib { } return [join $result \n] } + #dedent? proc undent {text} { if {$text eq ""} { return "" @@ -3795,7 +3869,7 @@ namespace eval punk::lib { } } - + #*** !doctools #[list_end] [comment {--- end definitions namespace punk::lib ---}] @@ -4142,12 +4216,10 @@ tcl::namespace::eval punk::lib::debug { proc showdict {args} {} } -if {![info exists ::punk::args::register::NAMESPACES]} { - namespace eval ::punk::args::register { - set ::punk::args::register::NAMESPACES [list] ;#use fully qualified so 8.6 doesn't find existing var in global namespace - } +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::lib } -lappend ::punk::args::register::NAMESPACES ::punk::lib # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::lib [tcl::namespace::eval punk::lib { diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/cli-0.3.1.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/cli-0.3.1.tm index 9e463eff..5d38fad8 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/cli-0.3.1.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/cli-0.3.1.tm @@ -177,7 +177,8 @@ namespace eval punk::mix::cli { } } } - cd $sourcefolder + #cd $sourcefolder + #use run so that stdout visible as it goes if {![catch {run --timeout=55000 -debug [info nameofexecutable] $sourcefolder/make.tcl {*}$args} exitinfo]} { #todo - notify if exit because of timeout! @@ -185,11 +186,11 @@ namespace eval punk::mix::cli { set exitcode [dict get $exitinfo exitcode] } else { puts stderr "Error unable to determine exitcode. err: $exitinfo" - cd $startdir + #cd $startdir return false } - cd $startdir + #cd $startdir if {$exitcode != 0} { puts stderr "FAILED with exitcode $exitcode" return false @@ -364,10 +365,10 @@ namespace eval punk::mix::cli { #ignore trailing .tm .TM if present #if version doesn't pass validation - treat it as part of the modulename and return empty version string without error #Up to caller to validate. - proc split_modulename_version {modulename} { - set lastpart [namespace tail $modulename] + proc split_modulename_version {fullmodulename} { + set lastpart [namespace tail $fullmodulename] set lastpart [file tail $lastpart] ;# should be ok to use file tail now that we've ensured no namespace components - if {[string equal -nocase [file extension $modulename] ".tm"]} { + if {[string equal -nocase [file extension $fullmodulename] ".tm"]} { set fileparts [split [file rootname $lastpart] -] } else { set fileparts [split $lastpart -] @@ -380,7 +381,13 @@ namespace eval punk::mix::cli { set namesegment [join $fileparts -] set versionsegment "" } - return [list $namesegment $versionsegment] + set base [namespace qualifiers $fullmodulename] + if {$base ne ""} { + set modulename "${base}::$namesegment" + } else { + set modulename $namesegment + } + return [list $modulename $versionsegment] } proc get_status {{workingdir ""} args} { diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm index 47c75d33..05e94a25 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm @@ -31,16 +31,42 @@ namespace eval punk::mix::commandset::layout { namespace export * + namespace eval argdoc { + proc layout_names {} { + if {[catch {punk::mix::commandset::layout::lib::layouts_dict *} ldict]} { + #REVIEW + return "punk.project" + } else { + return [dict keys $ldict] + } + } + } #per layout functions - proc files {{layout ""}} { - set argd [punk::args::get_dict { - @id -id ::punk::mix::commandset::layout::files - @values -min 1 -max 1 - layout -type string -minsize 1 - } [list $layout]] + punk::args::define { + @dynamic + @id -id ::punk::mix::commandset::layout::files + -datetime -default "%Y-%m-%dT%H:%M:%S" -help\ + "Datetime format for mtime. Use empty string for no datetime output" + @values -min 1 -max 1 + layout -type string -choices {${[punk::mix::commandset::layout::argdoc::layout_names]}} + } + proc files {args} { + set argd [punk::args::get_by_id ::punk::mix::commandset::layout::files $args] + set layout [dict get $argd values layout] + set dtformat [dict get $argd opts -datetime] set allfiles [lib::layout_all_files $layout] - return [join $allfiles \n] + if {$dtformat eq ""} { + return [join $allfiles \n] + } else { + set out "" + foreach f $allfiles { + set mtime [dict get [file stat $f] mtime] + append out "$f [clock format $mtime -format $dtformat]" \n + } + set out [string range $out 0 end-1] + return $out + } } proc templatefiles {layout} { set templatefiles_and_tags [lib::layout_scan_for_template_files $layout] @@ -166,7 +192,7 @@ namespace eval punk::mix::commandset::layout { } proc as_dict {args} { - tailcall punk::mix::commandset::layout::lib::layouts_dict {*}$args + punk::mix::commandset::layout::lib::layouts_dict {*}$args } proc references_as_dict {args} { package require punk::cap diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm index b5539021..b964d228 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm @@ -1,5 +1,5 @@ # -*- tcl -*- -# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from -buildversion.txt +# Maintenance Instruction: leave the 999999.xxx.x as is and use 'deck make' or src/make.tcl to update from -buildversion.txt # # Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. # Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. @@ -304,11 +304,12 @@ namespace eval punk::mix::commandset::loadedlib { } set versions [package versions [lindex $libfound 0]] - if {$has_natsort} { - set versions [natsort::sort $versions] - } else { - set versions [lsort $versions] - } + set versions [lsort -command {package vcompare} $versions] + #if {$has_natsort} { + # set versions [natsort::sort $versions] + #} else { + # set versions [lsort $versions] + #} if {![llength $versions]} { error "No version numbers found for library/module $libfound - sorry, you will need to copy it across manually" } diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm index 41206d0c..ae21d348 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm @@ -120,17 +120,20 @@ namespace eval punk::mix::commandset::module { return $table } - #return all module templates with repeated ones suffixed with .2 .3 etc + + #return all module templates with repeated ones suffixed with #2 #3 etc + punk::args::define { + @id -id ::punk::mix::commandset::module::templates_dict + @cmd -name templates_dict -help\ + "Templates from module and project paths" + -startdir -default "" -help\ + "Project folder used in addition to module paths" + -not -default "" -multiple 1 + @values + globsearches -default * -multiple 1 + } proc templates_dict {args} { - set argspec { - @id -id ::punk::mix::commandset::module::templates_dict - @cmd -name templates_dict -help "Templates from module and project paths" - -startdir -default "" -help "Project folder used in addition to module paths" - -not -default "" -multiple 1 - @values - globsearches -default * -multiple 1 - } - set argd [punk::args::get_dict $argspec $args] + set argd [punk::args::get_by_id ::punk::mix::commandset::module::templates_dict $args] package require punk::cap if {[punk::cap::capability_has_handler punk.templates]} { set template_folder_dict [punk::cap::call_handler punk.templates get_itemdict_moduletemplates {*}$args] @@ -154,10 +157,11 @@ namespace eval punk::mix::commandset::module { the higher version number will be used. " -license -default + -author -default -multiple 1 -template -default punk.module -type -default "[lindex $moduletypes 0]" -choices {$moduletypes} -force -default 0 -type boolean -help\ - "If set true, will overwrite an existing .tm file if there is one. + "If set true, will OVERWRITE an existing .tm file if there is one. If false (default) an error will be raised if there is a conflict." -quiet -default 0 -type boolean -help\ "Suppress information messages on stdout" @@ -262,6 +266,7 @@ namespace eval punk::mix::commandset::module { } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_license [dict get $opts -license] + set opt_authors [dict get $opts -author] ;#-multiple true # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_template [dict get $opts -template] if {[regexp {.*[?*].*} $opt_template]} { @@ -403,7 +408,7 @@ namespace eval punk::mix::commandset::module { #for now the user has the option to override any templates and remove %moduletemplate% if it is a security/privacy concern #Don't put literal %x% in the code for the commandset::module itself - to stop them being seen by layout scanner as replacable tokens - set tagnames [list moduletemplate $moduletemplate project $projectname pkg $modulename year $year license $opt_license version $infile_version] + set tagnames [list moduletemplate $moduletemplate project $projectname pkg $modulename year $year license $opt_license authors $opt_authors version $infile_version] set strmap [list] foreach {tag val} $tagnames { lappend strmap %$tag% $val diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/project-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/project-0.1.0.tm index 27ec8503..2ff8ac06 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/project-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/project-0.1.0.tm @@ -109,7 +109,26 @@ namespace eval punk::mix::commandset::project { } - + namespace eval argdoc { + set layout_dict [punk::cap::call_handler punk.templates get_itemdict_projectlayouts] + variable LAYOUTNAMES [dict keys $layout_dict] + } + punk::args::define { + @id -id ::punk::mix::commandset::project::new + @cmd -name "punk::mix::commandset::project::new" -help\ + "" + @leaders -min 1 -max 1 + project -type string -help\ + "Project name or path. + If just a name is given ... (todo)" + @opts + -type -default plain + -empty -default 0 -type boolean + -force -default 0 -type boolean + -update -default 0 -type boolean + -confirm -default 1 -type boolean + -layout -default "punk.project" -choices {${$::punk::mix::commandset::project::argdoc::LAYOUTNAMES}} + } proc new {newprojectpath_or_name args} { #*** !doctools @@ -300,7 +319,17 @@ namespace eval punk::mix::commandset::project { } } } elseif {$project_dir_exists && $opt_update} { - puts stderr "mix new WARNING: -update 1 was supplied. Will copy layout $layout_path using -update option to add missing items" + set warnmsg "mix new WARNING: -update 1 was supplied. Will copy layout $layout_path using -update option to add missing items" + if {$opt_confirm} { + puts stderr $warnmsg + set msg "Do you want to proceed to possibly overwrite some existing files in $projectdir? Y|N" + set answer [util::askuser $msg] + if {[string tolower $answer] ne "y"} { + puts stderr "mix new aborting due to user response '$answer' (required Y|y to proceed) use -confirm 0 to avoid prompt." + return + } + } + puts stderr $warnmsg } set fossil_repo_file "" @@ -366,28 +395,40 @@ namespace eval punk::mix::commandset::project { #default antiglob_dir_core will stop .fossil* from being updated - which is generally desirable as these are likely to be customized if {$opt_force} { puts stdout "copying layout files - with force applied - overwrite all-targets" - set resultdict [punkcheck::install $layout_path $projectdir -installer project.new -overwrite ALL-TARGETS -antiglob_paths $antipaths -antiglob_dir $antiglob_dir] + set resultdict [punkcheck::install $layout_path $projectdir -installer project.new -createempty 1 -overwrite ALL-TARGETS -antiglob_paths $antipaths -antiglob_dir $antiglob_dir] } else { puts stdout "copying layout files - (if source file changed)" - set resultdict [punkcheck::install $layout_path $projectdir -installer project.new -overwrite installedsourcechanged-targets -antiglob_paths $antipaths -antiglob_dir $antiglob_dir] + set resultdict [punkcheck::install $layout_path $projectdir -installer project.new -createempty 1 -overwrite installedsourcechanged-targets -antiglob_paths $antipaths -antiglob_dir $antiglob_dir] } puts stdout [punkcheck::summarize_install_resultdict $resultdict] - puts stdout "copying layout src/doc files (if target missing)" - set resultdict [punkcheck::install $layout_path/src/doc $projectdir/src/doc -punkcheck_folder $projectdir -installer project.new -overwrite SYNCED-TARGETS] - puts stdout [punkcheck::summarize_install_resultdict $resultdict] + if {[file exists $layout_path/src/doc]} { + puts stdout "copying layout src/doc files (if target missing)" + set resultdict [punkcheck::install $layout_path/src/doc $projectdir/src/doc -createdir 1 -punkcheck_folder $projectdir -installer project.new -overwrite SYNCED-TARGETS] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + } else { + puts stdout "no src/doc in source template - update not required" + } #target folders .fossil-custom and .fossil-settings may not exist. use -createdir 1 to ensure existence. #In this case we need to override the default dir antiglob - as .fossil-xxx folders need to be installed from template if missing, or if target is uncustomized. ## default_antiglob_dir_core [list "#*" "_aside" ".git" ".fossil*"] set override_antiglob_dir_core [list #* _aside .git] - puts stdout "copying layout src/.fossil-custom files (if target missing or uncustomised)" - set resultdict [punkcheck::install $layout_path/.fossil-custom $projectdir/.fossil-custom -createdir 1 -punkcheck_folder $projectdir -installer project.new -antiglob_dir_core $override_antiglob_dir_core -overwrite SYNCED-TARGETS] - puts stdout [punkcheck::summarize_install_resultdict $resultdict] + if {[file exists $layout_path/.fossil-custom]} { + puts stdout "copying layout src/.fossil-custom files (if target missing or uncustomised)" + set resultdict [punkcheck::install $layout_path/.fossil-custom $projectdir/.fossil-custom -createdir 1 -createempty 1 -punkcheck_folder $projectdir -installer project.new -antiglob_dir_core $override_antiglob_dir_core -overwrite SYNCED-TARGETS] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + } else { + puts stdout "no .fossil-custom in source template - update not required" + } - puts stdout "copying layout src/.fossil-settings files (if target missing or uncustomised)" - set resultdict [punkcheck::install $layout_path/.fossil-settings $projectdir/.fossil-settings -createdir 1 -punkcheck_folder $projectdir -installer project.new -antiglob_dir_core $override_antiglob_dir_core -overwrite SYNCED-TARGETS] - puts stdout [punkcheck::summarize_install_resultdict $resultdict] + if {[file exists $layout_path/.fossil-settings]} { + puts stdout "copying layout src/.fossil-settings files (if target missing or uncustomised)" + set resultdict [punkcheck::install $layout_path/.fossil-settings $projectdir/.fossil-settings -createdir 1 -createempty 1 -punkcheck_folder $projectdir -installer project.new -antiglob_dir_core $override_antiglob_dir_core -overwrite SYNCED-TARGETS] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + } else { + puts stdout "no .fossil-settings in source template - update not required" + } #scan all files in template # @@ -395,30 +436,19 @@ namespace eval punk::mix::commandset::project { set templatefiles [punk::mix::commandset::layout::lib::layout_scan_for_template_files $opt_layout] set stripprefix [file normalize $layout_path] - #set tagmap [list [lib::template_tag project] $projectname] - #todo - get from somewhere - set alltag_substitutions [list project $projectname] - + set tagmap [list [lib::template_tag project] $projectname] if {[llength $templatefiles]} { puts stdout "Filling template file placeholders with the following tag map:" - foreach {placeholder value} $alltag_substitutions { + foreach {placeholder value} $tagmap { puts stdout " $placeholder -> $value" } } - foreach templatefullpath_and_tags $templatefiles { - lassign $templatefullpath_and_tags templatefullpath tags_present - + foreach templatefullpath $templatefiles { set templatetail [punk::repo::path_strip_alreadynormalized_prefixdepth $templatefullpath $stripprefix] set fpath [file join $projectdir $templatetail] if {[file exists $fpath]} { set fd [open $fpath r]; fconfigure $fd -translation binary; set data [read $fd]; close $fd - set tagmap [list] - dict for {t v} $alltag_substitutions { - if {$t in $tags_present} { - lappend tagmap [lib::template_tag $t] $v - } - } set data2 [string map $tagmap $data] if {$data2 ne $data} { puts stdout "updated template file: $fpath" diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm index 5d601b3a..140f2678 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm @@ -281,7 +281,8 @@ tcl::namespace::eval punk::nav::fs { } } - if {[file pathtype $a1] ne "relative"} { + if {![regexp {[*?]} $a1] && [file pathtype $a1] ne "relative"} { + #non-relative non-glob if { ![string match //zipfs:/* $a1]} { if {[file type $a1] eq "directory"} { cd $a1 diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm index 8fa9ce89..4eb6526d 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm @@ -26,9 +26,16 @@ tcl::namespace::eval ::punk::ns::evaluator { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::ns { - variable ns_current "::" + variable ns_current + #allow presetting + if {![info exists ::punk::ns::ns_current]} { + set ns_current :: + } + variable ns_re_cache [dict create] ;#cache regular expressions used in globmatchns namespace export nsjoin nsprefix nstail nsparts nseval nschildren nsimport_noclobber corp + namespace path {::punk::lib ::punk::ansi} ;#list_as_lines etc + catch { package require debug debug define punk.ns.compile @@ -1259,7 +1266,7 @@ tcl::namespace::eval punk::ns { } else { set report_namespaces $matched_namespaces } - punk::args::update_definitions + punk::args::update_definitions $report_namespaces set nsdict_list [list] foreach ch $report_namespaces { @@ -1371,9 +1378,9 @@ tcl::namespace::eval punk::ns { #use aliases glob - because aliases can be present with or without leading :: #NOTE: alias may not have matching command in the relevant namespce (renamed alias) so we can't just start with commands and check if it's an alias if we want to show all aliases if {$weird_ns} { - set raw_aliases [nseval_ifexists $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. + set raw_aliases [nseval_ifexists $location [list ::punk::lib::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. } else { - set raw_aliases [tcl::namespace::eval $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. + set raw_aliases [tcl::namespace::eval $location [list ::punk::lib::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. } #set raw_aliases [nseval $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. set aliases [list] @@ -1620,6 +1627,7 @@ tcl::namespace::eval punk::ns { if {$has_punkargs} { #set id [string trimleft $fq :] set id $fq + punk::args::update_definitions [list [namespace qualifiers $id]] if {[::punk::args::id_exists $id]} { lappend usageinfo $c } else { @@ -1969,7 +1977,8 @@ tcl::namespace::eval punk::ns { #todo - -cache or -refresh to configure whether we introspect ensembles/objects each time? # - as this is interactive generally introspection should be ok at the top level # but if we need to go down multiple levels of subcommands generating/testing prefixes - could be an issue ?? - punk::args::define -dynamic 0 { + punk::args::define { + @dynamic @id -id ::punk::ns::arginfo @cmd -name punk::ns::arginfo -help\ "Show usage info for a command. @@ -1995,20 +2004,20 @@ tcl::namespace::eval punk::ns { -return -type string -default table -choices {string table tableobject} - } {${[punk::args::resolved_def -type @opts ::punk::args::arg_error -scheme]}} { + } {${[punk::args::resolved_def -types opts ::punk::args::arg_error -scheme]}} { -- -type none -help\ "End of options marker - Use this if the command to view begins with a -" + Use this if the command to view begins with a -" @values -min 1 commandpath -help\ "command (may be alias, ensemble, tcl::oo object, tepam proc etc)" subcommand -optional 1 -multiple 1 -default {} -help\ "subcommand if commandpath is an ensemble. - Multiple subcommands can be supplied if ensembles are further nested" + Multiple subcommands can be supplied if ensembles are further nested" } proc arginfo {args} { - lassign [dict values [punk::args::get_by_id ::punk::ns::arginfo $args]] leaders opts values received + lassign [dict values [punk::args::parse $args withid ::punk::ns::arginfo]] leaders opts values received #review - setting this afterwards is an architecture smell - we should be able to override the default in the dynamic part #todo - enable retrieving by id just the record_opts part - so we can treat as a dict directly, as well as easily apply it as a different flag name. @@ -2018,7 +2027,6 @@ tcl::namespace::eval punk::ns { set querycommand [dict get $values commandpath] set queryargs [dict get $values subcommand] - punk::args::update_definitions ;#ensure any packages that register PUNKARGS have been loaded #todo - similar to corp? review corp resolution process @@ -2087,6 +2095,16 @@ tcl::namespace::eval punk::ns { } } + #check for a direct match first + if {[info commands ::punk::args::id_exists] ne ""} { + if {![llength $queryargs]} { + punk::args::update_definitions [list [namespace qualifiers $origin]] + if {[punk::args::id_exists $origin]} { + return [uplevel 1 [list punk::args::usage {*}$opts $origin]] + } + } + } + #ns::cmdtype only detects alias type on 8.7+? set initial_cmdtype [punk::ns::cmdtype $origin] switch -- $initial_cmdtype { @@ -2137,31 +2155,40 @@ tcl::namespace::eval punk::ns { set id $origin if {[info commands ::punk::args::id_exists] ne ""} { - #cycle through longest first checking for id matching ::cmd ?subcmd..? - #REVIEW - this doesn't cater for prefix callable subcommands! + + + #check longest first checking for id matching ::cmd ?subcmd..? + #REVIEW - this doesn't cater for prefix callable subcommands set argcopy $queryargs - while {[llength $argcopy]} { - if {[punk::args::id_exists [list $id {*}$argcopy]]} { - return [uplevel 1 [list punk::args::usage {*}$opts [list $id {*}$argcopy]]] + if {[llength $queryargs]} { + punk::args::update_definitions [list [namespace qualifiers $id]] + if {[punk::args::id_exists [list $id {*}$queryargs]]} { + return [uplevel 1 [list punk::args::usage {*}$opts [list $id {*}$queryargs]]] } - lpop argcopy } + #while {[llength $argcopy]} { + # if {[punk::args::id_exists [list $id {*}$argcopy]]} { + # return [uplevel 1 [list punk::args::usage {*}$opts [list $id {*}$argcopy]]] + # } + # lpop argcopy + #} #didn't find any exact matches #traverse from other direction taking prefixes into account + punk::args::update_definitions [list [namespace qualifiers $id]] if {[punk::args::id_exists $id]} { #cycle forward through leading values - set def [punk::args::get_def $id] + set spec [punk::args::get_spec $id] if {[llength $queryargs]} { set nextqueryargs [list] ;#build a list of prefix-resolved queryargs set queryargs_untested $queryargs foreach q $queryargs { - if {[llength [dict get $def LEADER_NAMES]]} { - set subitems [dict get $def LEADER_NAMES] + if {[llength [dict get $spec LEADER_NAMES]]} { + set subitems [dict get $spec LEADER_NAMES] if {[llength $subitems]} { set next [lindex $subitems 0] - set arginfo [dict get $def ARG_INFO $next] + set arginfo [dict get $spec ARG_INFO $next] set allchoices [list] set choices [punk::args::system::Dict_getdef $arginfo -choices {}] @@ -2184,16 +2211,22 @@ tcl::namespace::eval punk::ns { #we have our first difference - recurse with new query args #set numvals [expr {[llength $queryargs]+1}] #return [ punk::ns::arginfo {*}[lrange $args 0 end-$numvals] $querycommand {*}$nextqueryargs {*}$queryargs_untested] - + #puts "===> testing arginfo {*}$opts $querycommand {*}$nextqueryargs {*}$queryargs_untested" return [ punk::ns::arginfo {*}$opts $querycommand {*}$nextqueryargs {*}$queryargs_untested] } #check if subcommands so far have a custom args def - set currentid [list $querycommand {*}$nextqueryargs] + #set currentid [list $querycommand {*}$nextqueryargs] + set currentid [list $id {*}$nextqueryargs] if {[punk::args::id_exists $currentid]} { - set def [punk::args::get_def $currentid + set spec [punk::args::get_spec $currentid] } else { #We can get no further with custom defs + #It is possible we have a documented lower level subcommand but missing the intermediate + #e.g if ::trace remove command was specified and is documented - it will be found above + #but if ::trace remove is not documented and the query is "::trace remove com" + #There is no way to determine com is a prefix as we don't have the intermediate documented -choice info available. + #that's probably ok. break } } @@ -2307,7 +2340,7 @@ tcl::namespace::eval punk::ns { set implementations [::info object call $origin $c1] #result documented as list of 4 element lists #set callinfo [lindex $implementations 0] - set def "" + set oodef "" foreach impl $implementations { lassign $impl generaltype mname location methodtype switch -- $generaltype { @@ -2323,7 +2356,7 @@ tcl::namespace::eval punk::ns { return [uplevel 1 [list punk::args::usage {*}$opts $idcustom]] } } - set def [::info object definition $origin $c1] + set oodef [::info object definition $origin $c1] } else { #set id "[string trimleft $location :] $c1" ;# " " set idcustom "$location $c1" @@ -2332,7 +2365,7 @@ tcl::namespace::eval punk::ns { return [uplevel 1 [list punk::args::usage {*}$opts $idcustom]] } } - set def [::info class definition $location $c1] + set oodef [::info class definition $location $c1] } break } @@ -2342,10 +2375,9 @@ tcl::namespace::eval punk::ns { } } } - if {$def ne ""} { - #assert - if we pre + if {$oodef ne ""} { set autoid "(autodef)$location $c1" - set arglist [lindex $def 0] + set arglist [lindex $oodef 0] set argdef [punk::lib::tstr -return string { @id -id "${$autoid}" @cmd -name "${$location} ${$c1}" -help\ @@ -2368,7 +2400,7 @@ tcl::namespace::eval punk::ns { append argdef \n "[lindex $a 0] -default {[lindex $a 1]} -optional 1" } default { - error "punk::ns::arginfo unexpected argument signature '$arglist'\ndef:$def\nimplementaions:$implementations" + error "punk::ns::arginfo unexpected oo argument signature '$arglist'\noodef:$oodef\nimplementations:$implementations" } } incr i @@ -2427,7 +2459,7 @@ tcl::namespace::eval punk::ns { @id -id ${$idauto} @cmd -name "Object: ${$origin}" -help\ "Instance of class: ${$class} (info autogenerated)" - @values -min 1 + @leaders -min 1 }] append argdef \n $vline punk::args::define $argdef @@ -2542,7 +2574,7 @@ tcl::namespace::eval punk::ns { @cmd -help\ "(autogenerated) ensemble: ${$origin}" - @values -min 1 + @leaders -min 1 }] append argdef \n $vline punk::args::define $argdef @@ -2977,84 +3009,100 @@ tcl::namespace::eval punk::ns { If not supplied, caller's namespace is used." -prefix -optional 1 -help\ "string prefix for command names in target namespace" - @values -min 1 -max 1 - sourcepattern -type string -optional 0 -help\ - "Glob pattern for source namespace. + @values -min 1 -max -1 + sourcepattern -type string -optional 0 -multiple 1 -help\ + "Glob pattern(s) for exported commands in source namespace(s). Globbing only active in the tail segment. - e.g ::mynamespace::*" + e.g ::mynamespace::a* ::mynamespace::j*" } proc nsimport_noclobber {args} { lassign [dict values [punk::args::get_by_id ::punk::ns::nsimport_noclobber $args]] leaders opts values received - set sourcepattern [dict get $values sourcepattern] + set sourcepatterns [dict get $values sourcepattern] - set source_ns [tcl::namespace::qualifiers $sourcepattern] - if {![tcl::namespace::exists $source_ns]} { - error "nsimport_noclobber error namespace $source_ns not found" - } set nscaller [uplevel 1 {namespace current}] if {![dict exists $received -targetnamespace]} { set target_ns $nscaller } else { set target_ns [dict get $opts -targetnamespace] if {![string match ::* $target_ns]} { - set target_ns [punk::nsjoin $nscaller $target_ns] + set target_ns [punk::ns::nsjoin $nscaller $target_ns] } } + set all_imported [list] + set nstemp ::punk::ns::temp_import - set a_export_patterns [tcl::namespace::eval $source_ns {namespace export}] - set a_commands [info commands $sourcepattern] - set a_tails [lmap v $a_commands {tcl::namespace::tail $v}] - set a_exported_tails [list] - foreach epattern $a_export_patterns { - set matches [lsearch -all -inline $a_tails $epattern] - foreach m $matches { - if {$m ni $a_exported_tails} { - lappend a_exported_tails $m + foreach pat $sourcepatterns { + set source_ns [tcl::namespace::qualifiers $pat] + if {![tcl::namespace::exists $source_ns]} { + error "nsimport_noclobber error namespace $source_ns not found" + } + + set a_export_patterns [tcl::namespace::eval $source_ns {namespace export}] + set a_commands [info commands $pat] + #puts "-->commands:'$a_commands'" + set a_tails [lmap v $a_commands {tcl::namespace::tail $v}] + set a_exported_tails [list] + foreach epattern $a_export_patterns { + set matches [lsearch -all -inline $a_tails $epattern] + foreach m $matches { + #we will be using namespace import one by one on commands. + #we must protect glob chars that may exist in the actual command names. + #e.g nsimport_noclobber ::punk::ansi::a? + # will import a+ and a? + #but nsimport_noclobber {::punk::ansi::a\?} + # must import only a? + set m [string map {\\ \\\\ ? \\? * \\* \[ \\[ \] \\]} $m] + if {$m ni $a_exported_tails} { + lappend a_exported_tails $m + } } } - } - set nstemp ::punk::ns::temp_import - if {[tcl::dict:::exists $received -prefix]} { - set pfx [dict get $opts -prefix] - set imported_commands [list] - if {[namespace exists $nstemp]} { - namespace delete $nstemp - } - namespace eval $nstemp {} - foreach e $a_exported_tails { - set imported [tcl::namespace::eval $nstemp [string map [list $e $source_ns $pfx $target_ns] { - set cmd "" - if {![catch {namespace import ::}]} { - #renaming will fail if target already exists - #renaming a command into another namespace still results in a command with 'info cmdtype' = 'import' - if {![catch {rename [punk::ns::nsjoin ]}]} { - set cmd + + + if {[tcl::dict:::exists $received -prefix]} { + #import via temporary/intermediate namespace + set pfx [dict get $opts -prefix] + set imported_commands [list] + if {[namespace exists $nstemp]} { + namespace delete $nstemp + } + namespace eval $nstemp {} + foreach e $a_exported_tails { + set imported [apply {{tgtns func srcns pfx tmpns} { + set cmd "" + if {![catch {::tcl::namespace::eval $tmpns [list ::namespace import ${srcns}::$func]}]} { + #renaming will fail if target already exists + #renaming a command into another namespace still results in a command with 'info cmdtype' = 'import' + if {![catch {::tcl::namespace::eval $tmpns [list ::rename $func [::punk::ns::nsjoin $tgtns $pfx$func]]}]} { + set cmd $pfx$func + } } + set cmd + } } $target_ns $e $source_ns $pfx $nstemp] + if {$imported ne ""} { + lappend imported_commands $imported } - set cmd - }]] - if {$imported ne ""} { - lappend imported_commands $imported } - } - namespace delete $nstemp - return $imported_commands - } - - set imported_commands [list] - foreach e $a_exported_tails { - set imported [tcl::namespace::eval $target_ns [string map [list $e $source_ns] { - set cmd "" - if {![catch {namespace import ::}]} { - set cmd + namespace delete $nstemp + } else { + #no prefix - direct import + set imported_commands [list] + foreach e $a_exported_tails { + set imported [apply {{tgtns func srcns} { + set cmd "" + if {![catch {tcl::namespace::eval $tgtns [list namespace import ${srcns}::$func]}]} { + set cmd $func + } + set cmd + } } $target_ns $e $source_ns] + if {$imported ne ""} { + lappend imported_commands $imported + } } - set cmd - }]] - if {[string length $imported]} { - lappend imported_commands $imported } + lappend all_imported {*}$imported_commands } - return $imported_commands + return $all_imported } #todo - use ns::nsimport_noclobber instead ? @@ -3092,7 +3140,23 @@ tcl::namespace::eval punk::ns { interp alias {} corp {} punk::ns::corp interp alias {} i {} punk::ns::arginfo - + #An example of using punk::args in a pipeline + punk::args::define { + @id -id ::i+ + @cmd -name "i+" -help\ + "Display command help side by side" + @values + cmds -multiple 1 -help\ + "Command names for which to show help info" + } + interp alias {} i+ {}\ + .=args> punk::args::get_by_id ::i+ |argd>\ + .=>2 dict get values cmds |cmds>\ + .=cmds>2 lmap c {i -return tableobject {*}$c} |objs>\ + .=objs>2 lmap t {$t configure -show_vseps 0 -show_edge 1} |>\ + .=objs>2 lmap t {$t print} |tables>\ + .=objs>2 lmap t {$t destroy} |>\ + .=tables>* textblock::join -- 1} { + # --------------------------------------------------------------- + #An attempt to detect dll/so loaded and try to load same version + #dll/so files are often named with version numbers that don't contain dots or a version number at all + #e.g sqlite3400.dll Thread288.dll + set pkgloadedinfo [lsearch -nocase -inline -index 1 [info loaded] $pkg] + + if {[llength $pkgloadedinfo]} { + puts stderr "--> pkg not already 'provided' but shared object seems to be loaded: $pkgloadedinfo - and multiple versions available" + lassign $pkgloadedinfo path name + set lcpath [string tolower $path] + #first attempt to find a match for our loaded sharedlib path in a *simple* package ifneeded statement. + set lcpath_to_version [dict create] + foreach av $available_versions { + set scr [package ifneeded $pkg $av] + #ifneeded script not always a valid tcl list + if {![catch {llength $scr} scrlen]} { + if {$scrlen == 3 && [lindex $scr 0] eq "load" && [string match -nocase [lindex $scr 2] $pkg]} { + dict set lcpath_to_version [string tolower [lindex $scr 1]] $av + } + } } - } - } - if {[llength $pkgloadedinfo]} { - puts stderr "--> pkg not present but shared object seems to be loaded: $pkgloadedinfo" - lassign $pkgloadedinfo path name - set lcpath [string tolower $path] - set obj [file tail $lcpath] - if {[string match tcl9* $obj]} { - set obj [string range $obj 4 end] - } elseif {[string match lib* $obj]} { - set obj [string range $obj 3 end] - } - set pkginfo [file rootname $obj] - #e.g Thread2.8.8 - if {[regexp {^([a-zA-Z\-]+)(.*)} $pkginfo _match lname lversion]} { - if {[string tolower $lname] eq [string tolower $pkg]} { + if {[dict exists $lcpath_to_version $lcpath]} { + set lversion [dict get $lcpath_to_version $lcpath] + } else { + #fallback to a best effort guess based on the path + set lversion [::punk::packagepreference::system::slibpath_guess_pkgversion $path $pkg] + } + if {$lversion ne ""} { #name matches pkg #hack for known dll version mismatch if {[string tolower $pkg] eq "thread" && $lversion eq "30b3"} { @@ -240,9 +259,11 @@ tcl::namespace::eval punk::packagepreference { }] if {[dict get $stackrecord implementation] ne ""} { set impl [dict get $stackrecord implementation] ;#use hardcoded name rather than slower (but more flexible) commandstack::get_next_command - puts stdout "punk::packagepreference renamed ::package to $impl" + #puts stdout "punk::packagepreference renamed ::package to $impl" + return 1 } else { puts stderr "punk::packagepreference failed to rename ::package" + return 0 } #puts stdout [info body ::package] } @@ -297,14 +318,94 @@ tcl::namespace::eval punk::packagepreference::lib { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[section Internal] -#tcl::namespace::eval punk::packagepreference::system { +tcl::namespace::eval punk::packagepreference::system { #*** !doctools #[subsection {Namespace punk::packagepreference::system}] #[para] Internal functions that are not part of the API + variable PUNKARGS + + lappend PUNKARGS [list { + @id -id ::punk::packagepreference::system::slibpath_guess_pkgversion + @cmd -name punk::packagepreference::system::slibpath_guess_pkgversion -help\ + "Assistance function to determine pkg version from the information + obtained from [info loaded]. This is used to try to avoid loading a different + version of a binary package in another thread/interp when the package isn't + present in the interp, but [info loaded] indicates the binary is already loaded. + The more general/robust way to avoid this is to ensure ::auto_path and + tcl::tm::list are the same in each interp/thread. + + This call should only be used as a fallback in case a binary package has a more + complex ifneeded script. If the ifneeded script for a binary package is a + straightforward 'load ' - then that information + should be used to determine the version by matching + rather than this one. + + Takes a path to a shared lib (.so/.dll), and the name of its providing + package, and return the version of the package if possible to determine + from the path. + The filename portion of the lib is often missing a version number or has + a version number that has been shortened (e.g dots removed). + The filename itself is first checked for a version number - but the number + is ignored if it doesn't contain any dots. + (prefix is checked to match with $pkgname, with a possible additional prefix + of lib or tcl) + Often (even usually) the parent or grandparent folder will be named as + per the package name with a proper version. If so we can return it, + otherwise return empty string. + The parent/grandparent matching will be done by looking for a case + insensitive match of the prefix to $pkgname. + " + @values -min 1 + libpath -help "Full path to shared library (.so,.dll etc)" + pkgname -help "" + }] + proc slibpath_guess_pkgversion {libpath pkgname} { + set root [file rootname [file tail $libpath]] + set namelen [string length $pkgname] + regexp {^(tcl(?:[0-9])+){0,1}(.*)} $root _match tclxx root ;#regexp will match anything - but only truncate leading tclXX.. + set testv "" + if {[string match -nocase $pkgname* $root]} { + set testv [string range $root $namelen end] + } elseif {[string match -nocase lib$pkgname* $root]} { + set testv [string range $root $namelen+3 end] + } + if {[string first . $testv] > 0} { + if {![catch [list package vcompare $testv $testv]]} { + #testv has an inner dot and is understood by tcl as a valid version number + return $testv + } + } + #no valid dotted version found directly on dll or so filename + set parent [file dirname $libpath] ;#parent folder is often some differentiator for platform or featureset (e.g win-x64) + set grandparent [file dirname $parent] + foreach path [list $parent $grandparent] { + set segment [file tail $path] + if {$segment eq "bin"} { + continue + } + set testv "" + if {[string match -nocase $pkgname* $segment]} { + set testv [string range $segment $namelen end] + } elseif {[string match -nocase critcl_$pkgname* $segment]} { + set testv [string range $segment $namelen+7 end] + } + #we don't look for dot in parent/grandparent version - a bare integer here after the will be taken to be the version + if {![catch [list package vcompare $testv $testv]]} { + return $testv + } + } + #review - sometimes path and lib are named only for major.minor but package provides major.minor.subversion + #using returned val to attempt to package require -exact major.minor will fail to load major.minor.subversion + return "" + } +} +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::packagepreference ::punk::packagepreference::system +} -#} # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::packagepreference [tcl::namespace::eval punk::packagepreference { diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/path-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/path-0.1.0.tm index ede3e18b..51e74719 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/path-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/path-0.1.0.tm @@ -651,11 +651,16 @@ namespace eval punk::path { -call-depth-internal -default 0 -type integer -antiglob_paths -default {} -help\ "list of path patterns to exclude - may include * and ** path segments e.g /usr/**" + may include * and ** path segments e.g + /usr/** (exlude subfolders based at /usr but not + files within /usr itself) + **/_aside (exlude files where _aside is last segment) + **/_aside/* (exclude folders one below an _aside folder) + **/_aside/** (exclude all folders with _aside as a segment)" @values -min 0 -max -1 -optional 1 -type string - tailglobs -multiple 1 -help\ + tailglobs -default * -multiple 1 -help\ "Patterns to match against filename portion (last segment) of each file path - within the directory tree being searched." + within the directory tree being searched." } #todo - implement treefiles which acts like dirfiles but allows path globbing in the same way as punk::ns::ns/ @@ -671,29 +676,29 @@ namespace eval punk::path { #[para] list of path patterns to exclude - may include * and ** path segments e.g /usr/** #[para]no natsorting - so order is dependent on filesystem - set argd [punk::args::get_by_id ::punk::path::treefilenames $args] + set argd [punk::args::parse $args withid ::punk::path::treefilenames] lassign [dict values $argd] leaders opts values received - set tailglobs [dict values $values] + set tailglobs [dict get $values tailglobs] # -- --- --- --- --- --- --- set opt_antiglob_paths [dict get $opts -antiglob_paths] set CALLDEPTH [dict get $opts -call-depth-internal] # -- --- --- --- --- --- --- - if {![dict exists $received -directory]} { - set opt_dir [pwd] - } else { - set opt_dir [dict get $opts -directory] - } # -- --- --- --- --- --- --- set files [list] if {$CALLDEPTH == 0} { + #set opts [dict merge $opts [list -directory $opt_dir]] + if {![dict exists $received -directory]} { + set opt_dir [pwd] + } else { + set opt_dir [dict get $opts -directory] + } if {![file isdirectory $opt_dir]} { return [list] } - set opts [dict merge $opts [list -directory $opt_dir]] - if {![llength $tailglobs]} { - lappend tailglobs * - } + } else { + #assume/require to exist in any recursive call + set opt_dir [dict get $opts -directory] } set skip 0 diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/pipe-1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/pipe-1.0.tm new file mode 100644 index 00000000..0b5501ac --- /dev/null +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/pipe-1.0.tm @@ -0,0 +1,853 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from -buildversion.txt +# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.3.tm +# +# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. +# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# (C) 2025 +# +# @@ Meta Begin +# Application punk::pipe 1.0 +# Meta platform tcl +# Meta license MIT +# @@ Meta End + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# doctools header +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[manpage_begin shellspy_module_punk::pipe 0 1.0] +#[copyright "2025"] +#[titledesc {Module API}] [comment {-- Name section and table of contents description --}] +#[moddesc {-}] [comment {-- Description at end of page heading --}] +#[require punk::pipe] +#[keywords module] +#[description] +#[para] - + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section Overview] +#[para] overview of punk::pipe +#[subsection Concepts] +#[para] - + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[subsection dependencies] +#[para] packages used by punk::pipe +#[list_begin itemized] + +package require Tcl 8.6- +#*** !doctools +#[item] [package {Tcl 8.6}] + +# #package require frobz +# #*** !doctools +# #[item] [package {frobz}] + +#*** !doctools +#[list_end] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section API] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# oo::class namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#tcl::namespace::eval punk::pipe::class { + #*** !doctools + #[subsection {Namespace punk::pipe::class}] + #[para] class definitions + #if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} { + #*** !doctools + #[list_begin enumerated] + + # oo::class create interface_sample1 { + # #*** !doctools + # #[enum] CLASS [class interface_sample1] + # #[list_begin definitions] + + # method test {arg1} { + # #*** !doctools + # #[call class::interface_sample1 [method test] [arg arg1]] + # #[para] test method + # puts "test: $arg1" + # } + + # #*** !doctools + # #[list_end] [comment {-- end definitions interface_sample1}] + # } + + #*** !doctools + #[list_end] [comment {--- end class enumeration ---}] + #} +#} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +tcl::namespace::eval punk::pipe { + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + # Base namespace + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + #*** !doctools + #[subsection {Namespace punk::pipe}] + #[para] Core API functions for punk::pipe + #[list_begin definitions] + + + + #proc sample1 {p1 n args} { + # #*** !doctools + # #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] + # #[para]Description of sample1 + # #[para] Arguments: + # # [list_begin arguments] + # # [arg_def tring p1] A description of string argument p1. + # # [arg_def integer n] A description of integer argument n. + # # [list_end] + # return "ok" + #} + + #https://randomascii.wordpress.com/2012/02/25/comparing-floating-point-numbers-2012-edition/ + # + #we can't provide a float comparison suitable for every situation, + #but we should pick something reasonable, keep it stable, and document it. + proc float_almost_equal {a b} { + package require math::constants + set diff [expr {abs($a - $b)}] + if {$diff <= $::math::constants::eps} { + return 1 + } + set A [expr {abs($a)}] + set B [expr {abs($b)}] + set largest [expr {($B > $A) ? $B : $A}] + return [expr {$diff <= $largest * $::math::constants::eps}] + } + + #debatable whether boolean_almost_equal is more surprising than helpful. + #values from a calculation that are extremely close to zero but aren't false could also be surprising - especially if they compare equal numerically + #perhaps a fuzzy-boolean is a step too far for a default - but it's inline with float-comparison for pattern-matching. + #alternatively - use an even more complex classifier? (^&~) ? + proc boolean_almost_equal {a b} { + if {[string is double -strict $a]} { + if {[float_almost_equal $a 0]} { + set a 0 + } + } + if {[string is double -strict $b]} { + if {[float_almost_equal $b 0]} { + set b 0 + } + } + #must handle true,no etc. + expr {($a && 1) == ($b && 1)} + } + + #boolean could be tr, true, y, ye, yes,Yes, 1 , 0 etc. + proc boolean_equal {a b} { + #equivalenttly xnor: expr {!(($a && 1) ^ ($b && 1))} ;# less clear and no discernable timing benefit. + expr {($a && 1) == ($b && 1)} + } + + + proc val [list [list v [lreplace x 0 0]]] {return $v} + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::pipe ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Secondary API namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +tcl::namespace::eval punk::pipe::lib { + tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase + tcl::namespace::path [tcl::namespace::parent] + #*** !doctools + #[subsection {Namespace punk::pipe::lib}] + #[para] Secondary functions that are part of the API + #[list_begin definitions] + + #proc utility1 {p1 args} { + # #*** !doctools + # #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] + # #[para]Description of utility1 + # return 1 + #} + + #map rhs to names suitable to use in pipemcd proc name (whitespace mapping) + # (for .= and = pipecmds) + proc pipecmd_namemapping {rhs} { + #used to build a command from a pattern which could contain :: - we need to map it to keep it a single command in the desired namespace. + #glob chars will prevent us using simple test {[info commands $cmd] eq ""} to test existence + #we could use the test {$cmd in [info commands]} - but mapping away globchars is more robust, allowing the simpler test + #set rhs [string trim $rhs];#ignore all leading & trailing whitespace + set rhs [string trimleft $rhs] + #--- + #REVIEW! + #set rhs [regsub -all {\s{1,}} $rhs {}] ;#collapse all internal whitespace to a single token + #This stops us matching {/@**@x x} vs {/@**@x x} + #--- + + set rhs [tcl::string::map {: ? * [ ] \\ {"} " " } $rhs] + #review - we don't expect other command-incompatible chars such as colon? + return $rhs + } + + # relatively slow on even small sized scripts + #proc arg_is_script_shaped2 {arg} { + # set re {^(\s|;|\n)$} + # set chars [split $arg ""] + # if {[lsearch -regex $chars $re] >=0} { + # return 1 + # } else { + # return 0 + # } + #} + + #exclude quoted whitespace + proc arg_is_script_shaped {arg} { + if {[tcl::string::first \n $arg] >= 0} { + return 1 + } elseif {[tcl::string::first ";" $arg] >= 0} { + return 1 + } elseif {[tcl::string::first " " $arg] >= 0 || [tcl::string::first \t $arg] >= 0} { + lassign [_rhs_tail_split $arg] _ part2 ;#will have part2 if unquoted whitespace found + return [expr {$part2 ne ""}] + } else { + return 0 + } + } + + #split top level of patterns only. + proc _split_patterns_memoized {varspecs} { + set name_mapped [pipecmd_namemapping $varspecs] + set cmdname ::punk::pipecmds::split_patterns::_$name_mapped + if {[info commands $cmdname] ne ""} { + return [$cmdname] + } + set result [_split_patterns $varspecs] + proc $cmdname {} [list return $result] + #debug.punk.pipe.compile {proc $cmdname} 4 + return $result + } + + + #note - empty data after trailing , is ignored. (comma as very last character) + # - fix by documentation only. double up trailing comma e.g ,, if desired to return pattern match plus all at end! + #todo - move to punk::pipe + proc _split_patterns {varspecs} { + + set varlist [list] + # @ @@ - list and dict functions + # / level separator + # # list count, ## dict size + # % string functions + # ! not + set var_terminals [list "@" "/" "#" "%" "!" ">" "<"] ;# (> required for insertionspecs at rhs of = & .= ) + #right bracket ) also ends a var - but is different depending on whether var is array or basic. For array - it forms part of the varname + + #except when prefixed directly by pin classifier ^ + set protect_terminals [list "^"] ;# e.g sequence ^# + #also - an atom usually doesn't need the / as a terminal - because it can't match a missing element unless it's empty string + #ie the one usecase is '/n to match either empty string or missing item at position n. For this one usecase - we miss the capability to atom match paths/urls .. '/usr/local/et' + set in_brackets 0 ;#count depth + set in_atom 0 + set token "" + set end_var_posn -1 ;#first var_terminal encountered within each comma delimited section + set token_index 0 ;#index of terminal char within each token + set indq 0 + set inbraces 0 + set inesc 0 ;#whether last char was backslash (see also punk::escv) + set prevc "" + set char_index 0 + #if {[string index $varspecs end] eq ","} { + # set varspecs [string range $varspecs 0 end-1] + #} + set charcount 0 + foreach c [split $varspecs ""] { + incr charcount + if {$indq} { + if {$inesc} { + #puts stderr "inesc adding '$c'" + append token \\$c + } else { + if {$c eq {"}} { + set indq 0 + } else { + append token $c + } + } + } elseif {$inbraces} { + if {$inesc} { + append token \\$c + } else { + if {$c eq "\}"} { + incr inbraces -1 + if {$inbraces} { + append token $c + } + } elseif {$c eq "\{"} { + incr inbraces + if {$inbraces} { + append token $c + } + } else { + append token $c + } + } + } elseif {$in_atom} { + #ignore dquotes/brackets in atoms - pass through + append token $c + #set nextc [lindex $chars $char_index+1] + if {$c eq "'"} { + set in_atom 0 + } + } elseif {$in_brackets > 0} { + append token $c + if {$c eq ")"} { + incr in_brackets -1 + } + } else { + if {$c eq {"}} { + if {!$inesc} { + set indq 1 + } else { + append token $c + } + } elseif {$c eq "\{"} { + if {!$inesc} { + set inbraces 1 + } else { + append token $c + } + } elseif {$c eq ","} { + #set var $token + #set spec "" + #if {$end_var_posn > 0} { + # #tcl scan with %s will not handle whitespace as desired. Be explicit using string range instead. + # #lassign [scan $token %${end_var_posn}s%s] var spec + # set var [string range $token 0 $end_var_posn-1] + # set spec [string range $token $end_var_posn end] ;#key section includes the terminal char which ended the var and starts the spec + #} else { + # if {$end_var_posn == 0} { + # set var "" + # set spec $token + # } + #} + #lappend varlist [list [string trim $var] [string trim $spec]] + #set token "" + #set token_index -1 ;#reduce by 1 because , not included in next token + #set end_var_posn -1 + } else { + append token $c + switch -exact -- $c { + ' { + set in_atom 1 + } + ( { + incr in_brackets + } + default { + if {$end_var_posn == -1 && (($c in $var_terminals) && ($prevc ni $protect_terminals))} { + set end_var_posn $token_index + } + } + } + } + if {$c eq ","} { + set var $token + set spec "" + if {$end_var_posn > 0} { + #tcl scan with %s will not handle whitespace as desired. Be explicit using string range instead. + #lassign [scan $token %${end_var_posn}s%s] var spec + set var [string range $token 0 $end_var_posn-1] + set spec [string range $token $end_var_posn end] ;#key section includes the terminal char which ended the var and starts the spec + } else { + if {$end_var_posn == 0} { + set var "" + set spec $token + } + } + lappend varlist [list [string trim $var] $spec] + set token "" + set token_index -1 + set end_var_posn -1 + + } + } + + if {$charcount == [string length $varspecs]} { + if {!($indq || $inbraces || $in_atom || $in_brackets)} { + if {$c ne ","} { + set var $token + set spec "" + if {$end_var_posn > 0} { + #tcl scan with %s will not handle whitespace as desired. Be explicit using string range instead. + #lassign [scan $token %${end_var_posn}s%s] var spec + set var [string range $token 0 $end_var_posn-1] + set spec [string range $token $end_var_posn end] ;#key section includes the terminal char which ended the var and starts the spec + } else { + if {$end_var_posn == 0} { + set var "" + set spec $token + } + } + lappend varlist [list [string trim $var] $spec] + set token "" + set token_index -1 + set end_var_posn -1 + } + } + } + + set prevc $c + if {$c eq "\\"} { + #review + if {$inesc} { + set inesc 0 + } else { + set token [string range $token 0 end-1] + set inesc 1 + } + } else { + set inesc 0 + } + incr token_index + incr char_index + } + + #if {[string length $token]} { + # #lappend varlist [splitstrposn $token $end_var_posn] + # set var $token + # set spec "" + # if {$end_var_posn > 0} { + # #lassign [scan $token %${end_var_posn}s%s] var spec + # set var [string range $token 0 $end_var_posn-1] + # set spec [string range $token $end_var_posn end] ;#key section includes the terminal char which ended the var and starts the spec + # } else { + # if {$end_var_posn == 0} { + # set var "" + # set spec $token + # } + # } + # #lappend varlist [list [string trim $var] [string trim $spec]] + # #spec needs to be able to match whitespace too + # lappend varlist [list [string trim $var] $spec] + #} + + return $varlist + } + + #todo - consider whether we can use < for insertion/iteration combinations + # =a<,b< iterate once through + # =a><,b>< cartesian product + # =a<>,b<> ??? zip ? + # + # ie = {a b c} |> .=< inspect + # would call inspect 3 times, once for each argument + # .= list {a b c} {x y z} |a/0,b/1> .=a><,b>< list + # would produce list of cartesian pairs? + # + proc _split_equalsrhs {insertionpattern} { + #map the insertionpattern so we can use faster globless info command search + set name_mapped [pipecmd_namemapping $insertionpattern] + set cmdname ::punk::pipecmds::split_rhs::_$name_mapped + if {[info commands $cmdname] ne ""} { + return [$cmdname] + } + + set lst_var_indexposition [_split_patterns_memoized $insertionpattern] + set i 0 + set return_triples [list] + foreach v_pos $lst_var_indexposition { + lassign $v_pos v index_and_position + #e.g varname@@data/ok>0 varname/1/0>end + #ensure only one ">" is detected + if {![string length $index_and_position]} { + set indexspec "" + set positionspec "" + } else { + set chars [split $index_and_position ""] + set posns [lsearch -all $chars ">"] + if {[llength $posns] > 1} { + error "pipesyntax error in segment insertion pattern '$insertionpattern' -v '$v' multiple '>' characters. Pattern not understood." "_split_equalsrhs $insertionpattern" [list pipesyntax insertionpattern_invalid] + } + if {![llength $posns]} { + set indexspec $index_and_position + set positionspec "" + } else { + set splitposn [lindex $posns 0] + set indexspec [string range $index_and_position 0 $splitposn-1] + set positionspec [string range $index_and_position $splitposn+1 end] + } + } + + #review - + if {($positionspec in [list "*" "/*" "@*" "/" "@"]) || ($v eq "*" && $positionspec eq "")} { + set star "" + if {$v eq "*"} { + set v "" + set star "*" + } + if {[string index $positionspec end] eq "*"} { + set star "*" + } + #it is always possible to insert at end of list regardless of current length - so /end* and @end* are equivalent + #as are /end and @end + #lset lst_var_indexposition $i [list $v "/end$star"] + set triple [list $v $indexspec "/end$star"] + } else { + if {$positionspec eq ""} { + #e.g just =varname + #lset lst_var_indexposition $i [list $v "/end"] + set triple [list $v $indexspec "/end"] + #error "pipesyntax error in segment insertionpattern '$insertionpattern' - v '$v' missing position spec e.g /0" + } else { + if {[string index $indexspec 0] ni [list "" "/" "@"]} { + error "pipesyntax error in segment insertionpattern '$insertionpattern' - v '$v' bad index spec '$indexspec'" "_split_equalsrhs $insertionpattern" [list pipesyntax insertionpattern_invalid] + } + set triple [list $v $indexspec $positionspec] + } + } + lappend return_triples $triple + incr i + } + proc $cmdname {} [list return $return_triples] + return $return_triples + } + + proc _rhs_tail_split {fullrhs} { + set inq 0; set indq 0 + set equalsrhs "" + set i 0 + foreach ch [split $fullrhs ""] { + if {$inq} { + append equalsrhs $ch + if {$ch eq {'}} { + set inq 0 + } + } elseif {$indq} { + append equalsrhs $ch + if {$ch eq {"}} { + set indq 0 + } + } else { + switch -- $ch { + {'} { + set inq 1 + } + {"} { + set indq 1 + } + " " { + #whitespace outside of quoting + break + } + 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - a - b - c - d - e - f - g - h - i - j - k - l - m - n - o - p - q - r - s - t - u - v - w - x - y - z {} + default { + #\t not a literal for switch jumpTable bytecompile - review - can we do it without for example string mapping to (and without a literal binary tab in source file)? + #we can't (reliably?) put \t as one of our switch keys + # + if {$ch eq "\t"} { + break + } + } + } + append equalsrhs $ch + } + incr i + } + set tail [tcl::string::range $fullrhs $i end] + return [list $equalsrhs $tail] + } + + #todo - recurse into bracketed sub parts + #JMN3 + #e.g @*/(x@0,y@2) + proc _var_classify {multivar} { + set cmdname ::punk::pipecmds::var_classify::_[pipecmd_namemapping $multivar] + if {[info commands $cmdname] ne ""} { + return [$cmdname] + } + + + #comma seems a natural choice to split varspecs, + #but also for list and dict subelement access + #/ normally indicates some sort of hierarchical separation - (e.g in filesytems) + #so / will indicate subelements e.g @0/1 for lindex $list 0 1 + #set valsource_key_list [_split_var_key_at_unbracketed_comma $multivar] + set valsource_key_list [_split_patterns_memoized $multivar] + + + + #mutually exclusive - atom/pin + #set map [list "" ' ^ &] ;#0 = default/var/not-yet-determined 1 = atom 2 = pin + #set var_class [lmap var $valsource_key_list {expr {([set m [lsearch $map [string index [lindex $var 0] 0]]] >= 0) ? [list $var $m] : [list $var 0]}}] + #0 - novar + #1 - atom ' + #2 - pin ^ + #3 - boolean & + #4 - integer + #5 - double + #6 - var + #7 - glob (no classifier and contains * or ?) + #8 - numeric + #9 - > (+) + #10 - < (-) + + set var_names [list] + set var_class [list] + set varspecs_trimmed [list] ;#raw varspecs without pin/atom modifiers - or empty string for glob + + + set leading_classifiers [list "'" "&" "^" ] + set trailing_classifiers [list + -] + set possible_number_start [list - + . 0 1 2 3 4 5 6 7 8 9 > <] + + foreach v_key $valsource_key_list { + lassign $v_key v key + set vname $v ;#default + set classes [list] + if {$v eq ""} { + lappend var_class [list $v_key 0] + lappend varspecs_trimmed $v_key + } else { + set lastchar [string index $v end] + switch -- $lastchar { + + { + lappend classes 9 + set vname [string range $v 0 end-1] + } + - { + lappend classes 10 + set vname [string range $v 0 end-1] + } + } + set firstchar [string index $v 0] + switch -- $firstchar { + ' { + lappend var_class [list $v_key 1] + #set vname [string range $v 1 end] + lappend varspecs_trimmed [list $vname $key] + } + ^ { + lappend classes [list 2] + #use vname - may already have trailing +/- stripped + set vname [string range $vname 1 end] + set secondclassifier [string index $v 1] + switch -- $secondclassifier { + "&" { + #pinned boolean + lappend classes 3 + set vname [string range $v 2 end] + } + "#" { + #pinned numeric comparison instead of string comparison + #e.g set x 2 + # this should match: ^#x.= list 2.0 + lappend classes 8 + set vname [string range $vname 1 end] + } + "*" { + #pinned glob + lappend classes 7 + set vname [string range $v 2 end] + } + } + #todo - check for second tag - & for pinned boolean? + #consider requiring ^# for numeric comparisons. currently no way to do a strictly string comparison on pinned variables.... default ^var really shouldn't be doing any magic. + #while we're at it.. pinned glob would be nice. ^* + #maybe even pinned scan ^% ? regex? ^/ or ^? these would be hard to have corresponding literals in the pattern mini-lang. + #These all limit the range of varnames permissible - which is no big deal. + lappend var_class [list $v_key $classes] + lappend varspecs_trimmed [list $vname $key] + } + & { + #we require boolean literals to be single-quoted so we can use cross-binding on boolean vars. + #ie &true is the variable true whereas &'true' or &'1' &'t' etc are literal booleans + #allow exception of &1 &0 to be literal booleans - because we disallow 0 & 1 as varnames in other contexts anyway - so it would be more consistent not to treat as varnames here. + lappend var_class [list $v_key 3] + set vname [string range $v 1 end] + lappend varspecs_trimmed [list $vname $key] + } + default { + if {([string first ? $v]) >=0 || ([string first * $v] >=0)} { + lappend var_class [list $v_key 7] ;#glob + #leave vname as the full glob + lappend varspecs_trimmed [list "" $key] + } else { + #scan vname not v - will either be same as v - or possibly stripped of trailing +/- + set numtestv [join [scan $vname %lld%s] ""] ;# handles octals (leading zeros), ok for use with bignums, decimal points and sci notation - fails to handle leading dot e.g .5 + #leading . still need to test directly for double + if {[string is double -strict $vname] || [string is double -strict $numtestv]} { + if {[string is integer -strict $numtestv]} { + #this will pick up boolean 1 or 0 - but that's ok - they require "&" marker if boolean comparison desired + #integer test before double.. + #note there is also string is wide (string is wideinteger) for larger ints.. + lappend classes 4 + lappend var_class [list $v_key $classes] + lappend varspecs_trimmed $v_key + } else { + #double + #sci notation 1e123 etc + #also large numbers like 1000000000 - even without decimal point - (tcl bignum) + lappend classes 5 + lappend var_class [list $v_key $classes] + lappend varspecs_trimmed $v_key + } + } else { + lappend var_class [list $v_key 6] ;#var + lappend varspecs_trimmed $v_key + } + } + } + } + } + lappend var_names $vname + } + + set result [list var_names $var_names var_class $var_class varspecs_trimmed $varspecs_trimmed] + + proc $cmdname {} [list return $result] + #JMN + #debug.punk.pipe.compile {proc $cmdname} + return $result + } + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::pipe::lib ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[section Internal] +#tcl::namespace::eval punk::pipe::system { + #*** !doctools + #[subsection {Namespace punk::pipe::system}] + #[para] Internal functions that are not part of the API + + + +#} + + +# == === === === === === === === === === === === === === === +# Sample 'about' function with punk::args documentation +# == === === === === === === === === === === === === === === +tcl::namespace::eval punk::pipe { + tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase + variable PUNKARGS + variable PUNKARGS_aliases + + lappend PUNKARGS [list { + @id -id "(package)punk::pipe" + @package -name "punk::pipe" -help\ + "Package + Description" + }] + + namespace eval argdoc { + #namespace for custom argument documentation + proc package_name {} { + return punk::pipe + } + proc about_topics {} { + #info commands results are returned in an arbitrary order (like array keys) + set topic_funs [info commands [namespace current]::get_topic_*] + set about_topics [list] + foreach f $topic_funs { + set tail [namespace tail $f] + lappend about_topics [string range $tail [string length get_topic_] end] + } + return $about_topics + } + proc default_topics {} {return [list Description outline *]} + + # ------------------------------------------------------------- + # get_topic_ functions add more to auto-include in about topics + # ------------------------------------------------------------- + proc get_topic_Description {} { + punk::args::lib::tstr [string trim { + punk pipeline features + } \n] + } + proc get_topic_License {} { + return "MIT" + } + proc get_topic_Version {} { + return $::punk::pipe::version + } + proc get_topic_Contributors {} { + set authors {{Julian Noble }} + set contributors "" + foreach a $authors { + append contributors $a \n + } + if {[string index $contributors end] eq "\n"} { + set contributors [string range $contributors 0 end-1] + } + return $contributors + } + proc get_topic_outline {} { + punk::args::lib::tstr -return string { + todo.. + } + } + # ------------------------------------------------------------- + } + + # we re-use the argument definition from punk::args::standard_about and override some items + set overrides [dict create] + dict set overrides @id -id "::punk::pipe::about" + dict set overrides @cmd -name "punk::pipe::about" + dict set overrides @cmd -help [string trim [punk::args::lib::tstr { + About punk::pipe + }] \n] + dict set overrides topic -choices [list {*}[punk::pipe::argdoc::about_topics] *] + dict set overrides topic -choicerestricted 1 + dict set overrides topic -default [punk::pipe::argdoc::default_topics] ;#if -default is present 'topic' will always appear in parsed 'values' dict + set newdef [punk::args::resolved_def -antiglobs -package_about_namespace -override $overrides ::punk::args::package::standard_about *] + lappend PUNKARGS [list $newdef] + proc about {args} { + package require punk::args + #standard_about accepts additional choices for topic - but we need to normalize any abbreviations to full topic name before passing on + set argd [punk::args::parse $args withid ::punk::pipe::about] + lassign [dict values $argd] _leaders opts values _received + punk::args::package::standard_about -package_about_namespace ::punk::pipe::argdoc {*}$opts {*}[dict get $values topic] + } +} +# end of sample 'about' function +# == === === === === === === === === === === === === === === + +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::pipe +} + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide punk::pipe [tcl::namespace::eval punk::pipe { + variable pkg punk::pipe + variable version + set version 1.0 +}] +return + +#*** !doctools +#[manpage_end] + diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl/codethread-0.1.1.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl/codethread-0.1.1.tm index 6158fdce..feee9d87 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl/codethread-0.1.1.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl/codethread-0.1.1.tm @@ -114,6 +114,10 @@ tcl::namespace::eval punk::repl::codethread { variable output_stdout "" variable output_stderr "" + #review/test + catch {package require punk::ns} + catch {package rquire punk::repl} + #variable xyz #*** !doctools @@ -191,9 +195,14 @@ tcl::namespace::eval punk::repl::codethread { #shennanigans to keep compiled script around after call. #otherwise when $script goes out of scope - internal rep of vars set in script changes. #The shimmering may be no big deal(?) - but debug/analysis using tcl::unsupported::representation becomes impossible. - interp eval code [list ::punk::lib::set_clone ::codeinterp::clonescript $script] ;#like objclone + + #interp eval code [list ::punk::lib::set_clone ::codeinterp::clonescript $script] ;#like objclone + interp eval code [list ::codeinterp::set_clone ::codeinterp::clonescript $script] ;#like objclone + + interp eval code {lappend ::codeinterp::run_command_cache $::codeinterp::clonescript} + interp eval code { - lappend ::codeinterp::run_command_cache $::codeinterp::clonescript + #lappend ::codeinterp::run_command_cache $::codeinterp::clonescript if {[llength $::codeinterp::run_command_cache] > 2000} { set ::codeinterp::run_command_cache [lrange $::codeinterp::run_command_cache 1750 end][unset ::codeinterp::run_command_cache] } @@ -205,10 +214,19 @@ tcl::namespace::eval punk::repl::codethread { package require punk::ns punk::ns::nseval_ifexists $::punk::ns::ns_current $::codeinterp::clonescript } else { + if {![namespace exists $::punk::ns::ns_current]} { + namespace eval $::punk::ns::ns_current { + puts stderr "Created namespace: $::punk::ns::ns_current" + } + } tcl::namespace::inscope $::punk::ns::ns_current $::codeinterp::clonescript } } } result] + #temp test for subshell experimentation + #if {$status == 1} { + # puts stderr "--codethread::runscript error--------\n$::errorInfo" + #} flush stdout diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repo-0.1.1.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repo-0.1.1.tm index 063a13c0..f53a06fd 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repo-0.1.1.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repo-0.1.1.tm @@ -107,14 +107,16 @@ namespace eval punk::repo { } - #lappend PUNKARGS [list -dynamic 1 { + #lappend PUNKARGS [list { + # @dynamic # @id -id ::punk::repo::fossil_proxy # @cmd -name fossil -help "fossil executable # " # @argdisplay -header "fossil help" -body {${[runout -n fossil help]}} # } ""] - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + @dynamic @id -id ::punk::repo::fossil_proxy @cmd -name fossil -help "fossil executable" ${[punk::repo::get_fossil_usage]} @@ -123,20 +125,24 @@ namespace eval punk::repo { #experiment - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + @dynamic @id -id "::punk::repo::fossil_proxy diff" @cmd -name "fossil diff" -help "fossil diff " @argdisplay -header "fossil help diff" -body {${[runout -n fossil help diff]}} } ""] - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + #todo - remove this comment - testing dynamic directive + @dynamic @id -id "::punk::repo::fossil_proxy add" @cmd -name "fossil add" -help "fossil add " @argdisplay -header "fossil help add" -body {${[runout -n fossil help add]}} } ""] #TODO - #lappend PUNKARGS [list -dynamic 1 { + #lappend PUNKARGS [list { + # @dynamic # @id -glob 1 -id "::punk::repo::fossil_proxy *" -aliases {fs} # @cmd -name "fossil add" -help "fossil add # " @@ -1699,12 +1705,10 @@ namespace eval punk::repo::lib { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -if {![info exists ::punk::args::register::NAMESPACES]} { - namespace eval ::punk::args::register { - set ::punk::args::register::NAMESPACES [list] ;#use fully qualified so 8.6 doesn't find existing var in global namespace - } +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::repo } -lappend ::punk::args::register::NAMESPACES ::punk::repo # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/zip-0.1.1.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/zip-0.1.1.tm index 2895b024..99bc359d 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/zip-0.1.1.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/zip-0.1.1.tm @@ -194,6 +194,12 @@ tcl::namespace::eval punk::zip { Defaults to the value of base. If empty string is given to -resultrelative the paths returned are effectively absolute paths." + -emptydirs -default 0 -type boolean -help\ + "Whether to include directory trees in the result which had no + matches for the given fileglobs. + Intermediate dirs are always returned if there is a match with + fileglobs further down even if -emptdirs is 0. + " -excludes -default "" -help "list of glob expressions to match against files and exclude" -subpath -default "" -help\ "May contain glob chars for folder elements" @@ -205,6 +211,7 @@ tcl::namespace::eval punk::zip { set fileglobs [dict get $argd values fileglobs] set subpath [dict get $argd opts -subpath] set excludes [dict get $argd opts -excludes] + set emptydirs [dict get $argd opts -emptydirs] set received [dict get $argd received] @@ -242,13 +249,32 @@ tcl::namespace::eval punk::zip { if {!$excluded} {lappend result [file join $prefix $file]} } foreach dir [glob -nocomplain -tails -types d -directory $base -- [file join $subpath *]] { - set subdir_entries [walk -subpath $dir -excludes $excludes $base {*}$fileglobs] - if {[llength $subdir_entries]>0} { - #NOTE: trailing slash required for entries to be recognised as 'file type' = "directory" - #This is true for 2024 Tcl9 mounted zipfs at least. zip utilities such as 7zip seem(icon correct) to recognize dirs with or without trailing slash - #Although there are attributes on some systems to specify if entry is a directory - it appears trailing slash should always be used for folder names. - set result [list {*}$result "[file join $prefix $dir]/" {*}$subdir_entries] + set submatches [walk -subpath $dir -emptydirs $emptydirs -excludes $excludes $base {*}$fileglobs] + set subdir_entries [list] + set thisdir_match [list] + set has_file 0 + foreach sd $submatches { + set fullpath [file join $prefix $sd] ;#file join destroys trailing slash + if {[string index $sd end] eq "/"} { + lappend subdir_entries $fullpath/ + } else { + set has_file 1 + lappend subdir_entries $fullpath + } + } + if {$emptydirs} { + set thisdir_match [list "[file join $prefix $dir]/"] + } else { + if {$has_file} { + set thisdir_match [list "[file join $prefix $dir]/"] + } else { + set subdir_entries [list] + } } + #NOTE: trailing slash required for entries to be recognised as 'file type' = "directory" + #This is true for 2024 Tcl9 mounted zipfs at least. zip utilities such as 7zip seem(icon correct) to recognize dirs with or without trailing slash + #Although there are attributes on some systems to specify if entry is a directory - it appears trailing slash should always be used for folder names. + set result [list {*}$result {*}$thisdir_match {*}$subdir_entries] } return $result } diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punkcheck-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punkcheck-0.1.0.tm index 3b4217df..db8a3db5 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punkcheck-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punkcheck-0.1.0.tm @@ -1170,6 +1170,7 @@ namespace eval punkcheck { } #skip writing punkcheck during checksum/timestamp checks + #todo - punk::args - fetch from punkcheck::install (with overrides) proc install_tm_files {srcdir basedir args} { set defaults [list\ -glob *.tm\ @@ -1209,13 +1210,71 @@ namespace eval punkcheck { return [lindex $args end] } } + lappend PUNKARGS [list { + @id -id ::punkcheck::install + @cmd -name ::punkcheck::install -help\ + "Unidirectional file transfer to possibly non-empty target folder." + @leaders -min 2 -max 2 + srcdir -type directory + tgtdir -type directory + -call-depth-internal -type integer -default 0 -help "(internal recursion tracker)" + -subdirlist -type list -default "" -help "(primarily internal - length generally matching -call-depth-internal)" + -max_depth -type integer -default 1000 -help\ + "Deepest subdirectory - use -1 for no limit." + -createdir -type boolean -default 0 -help\ + "Whether to create the folder at tgtdir. + Any required subdirectories are created regardless of this setting." + -createempty -type boolean -default 0 -help\ + "Whether to create folders at target that had no matches for our glob" + -glob -type string -default "*" -help\ + "Pattern matching for source file(s) to copy. Can be glob based or exact match." + -antiglob_file_core -default {${[::punkcheck::default_antiglob_file_core]}} + -antiglob_file -default "" + -antiglob_dir_core -default {${[::punkcheck::default_antiglob_dir_core]}} + -antiglob_dir -default "" + -antiglob_paths -default {} + -overwrite -default no-targets\ + -choices {no-targets newer-targets older-targets all-targets installedsourcechanged-targets synced-targets}\ + -choicecolumns 1\ + -choicelabels { + no-targets "only copy files that are missing at the target" + newer-targets "copy files with older source timestamp over newer + target timestamp and those missing at the target + (a form of 'restore' operation)" + older-targets "copy files with newer source timestamp over older + target timestamp and those missing at the target" + all-targets "copy regardless of timestamp at target" + installedsourcechanged-targets "copy if the target doesn't exist or the source changed" + synced-targets "copy if the target doesn't exist or the source changed + and the target cksum is the same as the last INSTALL-RECORD -targets_cksums entry" + } + -source_checksum -default comparestore -choicecolumns 3 -choices {compare store comparestore false true}\ + -choicelabels { + true "same as comparestore" + } + -punkcheck_folder -default target -choices {target source project} -choicerestricted 0 -help\ + "The location of the .punkcheck file to track installations and checksums. + The default value 'target' is generally recommended. + Can also be an absolute path to a folder." + -punkcheck_records -default "" -help\ + "Empty string or a parsed TDL records structure. + e.g + {tag FILEINFO - ... body { + {tag INSTALL-RECORD - ... body {}} + ... + }... + }" + -installer -default "punkcheck::install" -help\ + "A user nominated string that is stored in the .punkcheck file + This might be the name of a script or installation process." + }] ## unidirectional file transfer to possibly non empty folder #default of -overwrite no-targets will only copy files that are missing at the target # -overwrite newer-targets will copy files with older source timestamp over newer target timestamp and those missing at the target (a form of 'restore' operation) # -overwrite older-targets will copy files with newer source timestamp over older target timestamp and those missing at the target # -overwrite all-targets will copy regardless of timestamp at target # -overwrite installedsourcechanged-targets will copy if the target doesn't exist or the source changed - # -overwrite synced-targets will copy if the target doesn't exist or the source changed and the target cksum is the same as the last INSTALL-RECORD targets_cksums entry + # -overwrite synced-targets will copy if the target doesn't exist or the source changed and the target cksum is the same as the last INSTALL-RECORD -targets_cksums entry # review - timestamps unreliable # - what about slightly mismatched system clocks and mounted filesystems? caller responsibility to verify first? # if timestamp exactly equal - should we check content-hash? This is presumably only likely to occur deliberately(maliciously?) @@ -1243,6 +1302,7 @@ namespace eval punkcheck { -max_depth 1000\ -subdirlist {}\ -createdir 0\ + -createempty 0\ -glob *\ -antiglob_file_core "\uFFFF"\ -antiglob_file "" \ @@ -1271,13 +1331,14 @@ namespace eval punkcheck { #(as opposed to a more 'standard' mechanism of adjusting srcdir & tgtdir as we move down the tree) #It comes from build_modules_from_source_to_base where we need to keep track of position relative to our targetdir starting point to handle submodules e.g pkg::something::mypkg-0.1.tm #It could have been handled with some other parameter such as -depth, but this -subdirlist mechanism, whilst perhaps not beautiful, is straightforward enough - #and may be less error prone than doing slightly more opaue path manipulations at each recursion level to determine where we started + #and may be less error prone than doing slightly more opaque path manipulations at each recursion level to determine where we started #For consistency - we'll use the same mechanism in various recursive directory walking procedures such as this one. - set CALLDEPTH [dict get $opts -call-depth-internal] ;#added for extra debug/sanity checking - clearer test for initial function call ie CALLDPEPTH = 0 + set CALLDEPTH [dict get $opts -call-depth-internal] ;#added for extra debug/sanity checking - clearer test for initial function call ie CALLDEPTH = 0 set max_depth [dict get $opts -max_depth] ;# -1 for no limit set subdirlist [dict get $opts -subdirlist] ;# generally should be same length as CALLDEPTH - but user could prefill set fileglob [dict get $opts -glob] set createdir [dict get $opts -createdir] ;#defaults to zero to help avoid mistakes with initial target dir - required target subdirs are created regardless of this setting + set opt_createempty [dict get $opts -createempty] if {$CALLDEPTH == 0} { #expensive to normalize but we need to do it at least once @@ -1285,6 +1346,13 @@ namespace eval punkcheck { set tgtdir [file normalize $tgtdir] if {$createdir} { file mkdir $tgtdir + } else { + if {![file exists $tgtdir]} { + error "punkcheck::install base target dir:'$tgtdir' doesn't exist (srcdir:$srcdir tgtdir:$tgtdir args:'$args')" + } + } + if {([file type $srcdir] ni [list directory]) || ([file type $tgtdir] ni [list directory])} { + error "punkcheck::install requires source and target dirs to be of type 'directory' type current source: [file type $srcdir] type current target: [file type $tgtdir]" } #now the values we build from these will be properly cased } @@ -1450,13 +1518,7 @@ namespace eval punkcheck { if {![file exists $current_source_dir]} { - error "copy_files_from_source_to_target current source dir:'$current_source_dir' doesn't exist (srcdir:$srcdir tgtdir:$tgtdir args:'$args')" - } - if {![file exists $current_target_dir]} { - error "copy_files_from_source_to_target current target dir:'$current_target_dir' doesn't exist (srcdir:$srcdir tgtdir:$tgtdir args:'$args')" - } - if {([file type $current_source_dir] ni [list directory]) || ([file type $current_target_dir] ni [list directory])} { - error "copy_files_from_source_to_target requires source and target dirs to be of type 'directory' type current source: [file type $current_source_dir] type current target: [file type $current_target_dir]" + error "punkcheck::install current source dir:'$current_source_dir' doesn't exist (srcdir:$srcdir tgtdir:$tgtdir args:'$args')" } set files_copied [list] @@ -1500,7 +1562,13 @@ namespace eval punkcheck { # SOURCE -type file -path ../src/modules/jjjetc-999999.0a1.0.tm -cksum b646fc2ee88cbd068d2e946fe929b7aea96bd39d -cksum_all_opts {-cksum_content 1 -cksum_meta 0 -cksum_acls 0 -cksum_usetar 0 -cksum_algorithm sha1} -changed 0 -metadata_us 3338 # } #} - + + if {[llength $match_list]} { + #example - target dir has a file where there is a directory at the source + if {[file exists $current_target_dir] && ([file type $current_target_dir] ni [list directory])} { + error "punkcheck::install target subfolder $current_target_dir exists but is not of type 'directory'. Type current target folder: [file type $current_target_dir]" + } + } #proc get_relativecksum_from_base_and_fullpath {base fullpath args} @@ -1579,10 +1647,12 @@ namespace eval punkcheck { set is_skip 0 if {$overwrite_what eq "all-targets"} { + file mkdir $current_target_dir file copy -force $current_source_dir/$m $current_target_dir lappend files_copied $current_source_dir/$m } else { if {![file exists $current_target_dir/$m]} { + file mkdir $current_target_dir file copy $current_source_dir/$m $current_target_dir set new_tgt_cksum_info [punk::mix::base::lib::cksum_path $current_target_dir/$m] lappend files_copied $current_source_dir/$m @@ -1592,6 +1662,7 @@ namespace eval punkcheck { installedsourcechanged-targets { if {[llength $changed]} { #An unrecorded installation is considered a source change (from unknown/unrecorded source to recorded) + file mkdir $current_target_dir file copy -force $current_source_dir/$m $current_target_dir set new_tgt_cksum_info [punk::mix::base::lib::cksum_path $current_target_dir/$m] lappend files_copied $current_source_dir/$m @@ -1619,6 +1690,7 @@ namespace eval punkcheck { set target_cksum_compare "norecord" } if {$is_target_unmodified_since_install} { + file mkdir $current_target_dir file copy -force $current_source_dir/$m $current_target_dir set new_tgt_cksum_info [punk::mix::base::lib::cksum_path $current_target_dir/$m] lappend files_copied $current_source_dir/$m @@ -1642,6 +1714,12 @@ namespace eval punkcheck { } } } + #target dir was created as necessary if files matched above + #now ensure target dir exists if -createempty true + if {$opt_createempty && ![file exists $current_target_dir]} { + file mkdir $current_target_dir + } + set ts_now [clock microseconds] @@ -1724,10 +1802,9 @@ namespace eval punkcheck { continue } - - if {![file exists $current_target_dir/$d]} { - file mkdir $current_target_dir/$d - } + #if {![file exists $current_target_dir/$d]} { + # file mkdir $current_target_dir/$d + #} set sub_opts_1 [list\ @@ -2096,8 +2173,10 @@ namespace eval punkcheck { - - +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punkcheck +} diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punkcheck/cli-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punkcheck/cli-0.1.0.tm index 609df5c3..bbf882a0 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punkcheck/cli-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punkcheck/cli-0.1.0.tm @@ -64,6 +64,8 @@ namespace eval punkcheck::cli { #vfs can mask mounted files - so we can't just use 'file type' or glob with -type f ##set files [glob -nocomplain -dir $fullpath -type f *] package require punk::nav::fs + + #TODO - get all files in tree!!! set folderinfo [punk::nav::fs::dirfiles_dict $fullpath] set files [concat [dict get $folderinfo files] [dict get $folderinfo underlayfiles]] } diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/shellfilter-0.1.9.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/shellfilter-0.1.9.tm index 25ba28b1..d70d657c 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/shellfilter-0.1.9.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/shellfilter-0.1.9.tm @@ -751,6 +751,12 @@ namespace eval shellfilter::chan { } else { + #REVIEW - this holding a buffer without emitting as we go is ugly. + # - we may do better to detect and retain the opener, then use that opener to avoid false splits within the sequence. + # - we'd then need to detect the appropriate close to restart splitting and codestacking + # - we may still need to retain and append the data to the opener (in some cases?) - which is a slight memory issue - but at least we would emit everything immediately. + + #puts "-->esc but no detect" #no complete ansi codes - but at least one esc is present if {[string last \x1b $buf] == [llength $buf]-1} { @@ -1118,8 +1124,8 @@ namespace eval shellfilter::stack { proc status {{pipename *} args} { variable pipelines set pipecount [dict size $pipelines] - set tableprefix "$pipecount pipelines active\n" - set t [textblock::class::table new $tableprefix] + set tabletitle "$pipecount pipelines active" + set t [textblock::class::table new $tabletitle] $t add_column -headers [list channel-ident] $t add_column -headers [list device-info localchan] $t configure_column 1 -header_colspans {3} @@ -1402,7 +1408,8 @@ namespace eval shellfilter::stack { } dict set pipelines $pipename stack $stack } - show_pipeline $pipename -note "after_remove $remove_id" + #JMNJMN 2025 review! + #show_pipeline $pipename -note "after_remove $remove_id" return 1 } @@ -1607,7 +1614,9 @@ namespace eval shellfilter::stack { #puts stdout "==" #puts stdout "==>stack: $stack" #puts stdout "==" - show_pipeline $pipename -note "after_add $transformname $args" + + #JMNJMN + #show_pipeline $pipename -note "after_add $transformname $args" return $id } proc show_pipeline {pipename args} { diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/textblock-0.1.3.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/textblock-0.1.3.tm index 56651d21..8d66978f 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/textblock-0.1.3.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/textblock-0.1.3.tm @@ -62,14 +62,16 @@ catch {package require patternpunk} package require overtype #safebase interps as at 2024-08 can't access deeper paths - even though they are below the supposed safe list. -if {[catch { - package require term::ansi::code::macros ;#required for frame if old ansi g0 used - review - make package optional? -} errM]} { - #catch this too in case stderr not available - catch { - puts stderr "textblock package failed to load term::ansi::code::macros with error: $errM" - } -} +#2025 - required term::ansi features for altg now built in to textblock +#the deeper paths issue is still a potential issue for some packages - review +#if {[catch { +# package require term::ansi::code::macros ;#required for frame if old ansi g0 used - review - make package optional? +#} errM]} { +# #catch this too in case stderr not available +# catch { +# puts stderr "textblock package failed to load term::ansi::code::macros with error: $errM" +# } +#} package require textutil @@ -139,7 +141,8 @@ tcl::namespace::eval textblock { # hash_algorithm -optional 1 -choices {${[::textblock::argdoc::hash_algorithm_choices]}} -help\ # "algorithm choice" - punk::args::define -dynamic 1 { + punk::args::define { + @dynamic @id -id ::textblock::use_hash @cmd -name "textblock::use_hash" -help\ "Hashing algorithm to use for framecache lookup. @@ -4068,12 +4071,12 @@ tcl::namespace::eval textblock { return $frametypes } - tcl::namespace::eval cd { - #todo - save and restore existing tcl::namespace::export in case macros::cd has default exports in future - tcl::namespace::eval ::term::ansi::code::macros::cd {tcl::namespace::export *} - tcl::namespace::import ::term::ansi::code::macros::cd::* - tcl::namespace::eval ::term::ansi::code::macros::cd {tcl::namespace::export -clear} - } + #tcl::namespace::eval cd { + # #todo - save and restore existing tcl::namespace::export in case macros::cd has default exports in future + # tcl::namespace::eval ::term::ansi::code::macros::cd {tcl::namespace::export *} + # tcl::namespace::import ::term::ansi::code::macros::cd::* + # tcl::namespace::eval ::term::ansi::code::macros::cd {tcl::namespace::export -clear} + #} proc spantest {} { set t [list_as_table -columns 5 -return tableobject {a b c d e aa bb cc dd ee X Y}] $t configure_column 0 -headers [list span3 "1-span4\n2-span4 second line" span5/5 "span-all etc blah 123 hmmmmm" span2] @@ -5071,7 +5074,7 @@ tcl::namespace::eval textblock { #only call width functions if known_samewidth - otherwise let the pad algorithm below determine it as we go if {$known_samewidth ne "" && $known_samewidth} { if {$known_blockwidth eq ""} { - set datawidth [textblock::widthtopline $block + set datawidth [textblock::widthtopline $block] } else { set datawidth $known_blockwidth } @@ -6214,16 +6217,22 @@ tcl::namespace::eval textblock { switch -- $f { "altg" { #old style ansi escape sequences with alternate graphics page G0 - set hl [cd::hl] + #set hl [cd::hl] + set hl [punk::ansi::g0 q] set hlt $hl set hlb $hl - set vl [cd::vl] + #set vl [cd::vl] + set vl [punk::ansi::g0 x] set vll $vl set vlr $vl - set tlc [cd::tlc] - set trc [cd::trc] - set blc [cd::blc] - set brc [cd::brc] + #set tlc [cd::tlc] + set tlc [punk::ansi::g0 l] + #set trc [cd::trc] + set trc [punk::ansi::g0 k] + #set blc [cd::blc] + set blc [punk::ansi::g0 m] + #set brc [cd::brc] + set brc [punk::ansi::g0 j] #horizontal and vertical bar joins set hltj $hlt @@ -7417,13 +7426,15 @@ tcl::namespace::eval textblock { set blc \U1fb7c ;#legacy block set brc \U1fb7f ;#legacy block - if {[punk::console::check::has_bug_legacysymbolwidth]} { - #rather than totally fail on some mixed layout that happens to use block2 - just degrade it - but prevent alignment problems - set sp \u00a0 ;#non breaking space (plain space may act transparent in some use cases) - set tlc $sp - set trc $sp - set blc $sp - set brc $sp + if {(![interp issafe])} { + if {![catch {punk::console::check::has_bug_legacysymbolwidth} symbug] && $symbug} { + #rather than totally fail on some mixed layout that happens to use block2 - just degrade it - but prevent alignment problems + set sp \u00a0 ;#non breaking space (plain space may act transparent in some use cases) + set tlc $sp + set trc $sp + set blc $sp + set brc $sp + } } #horizontal and vertical bar joins @@ -7555,12 +7566,12 @@ tcl::namespace::eval textblock { @cmd -name textblock::frame_cache -help\ "Display or clear the frame cache." -pretty -default 1 -help\ - "Uses 'pdict textblock::frame_cache */*' for prettier output - Either way this is set, output requires long lines and may - still wrap in an ugly manner. Try 'textblock::use_cache md5' - to shorten the argument display and reduce wrapping. + "Uses 'pdict textblock::frame_cache */*' for prettier output + Either way this is set, output requires long lines and may + still wrap in an ugly manner. Try 'textblock::use_cache md5' + to shorten the argument display and reduce wrapping. " - @values -min 0 -max 1 + @values -min 0 -max -1 action -default {display} -choices {clear size info display} -choicelabels { clear "Clear the textblock::frame_cache dictionary." } -help "Perform an action on the frame cache." @@ -7569,6 +7580,8 @@ tcl::namespace::eval textblock { set argd [punk::args::get_by_id ::textblock::frame_cache $args] set action [dict get $argd values action] variable frame_cache + set all_values_dict [dict get $argd values] + set action_values [lrange [dict values $all_values_dict] 1 end] switch -- $action { clear { set size [dict size $frame_cache] @@ -7589,8 +7602,65 @@ tcl::namespace::eval textblock { error "frame_cache -action '$action' not understood. Valid actions: clear size info display" } } + if {[llength $action_values]} { + return [frame_cache_display -pretty [dict get $argd opts -pretty] {*}$action_values] + } else { + return [frame_cache_display -pretty [dict get $argd opts -pretty]] + } + } + punk::args::define { + @dynamic + @id -id ::textblock::frame_cache_display + @opts + ${[::punk::args::resolved_def -types opts ::textblock::frame_cache -pretty]} + @values -min 0 -max 2 + startindex -default "" -type indexexpression -help\ + "If both startindex and endindex are missing/empty, it is treated as + startindex 0 endindex end. (ie displays all records) + If only startindex has a value - the frame_cache record at that + index will be displayed" + endindex -default "" -type indexexpression + } + proc frame_cache_display {args} { + set argd [punk::args::get_by_id ::textblock::frame_cache_display $args] + variable frame_cache + lassign [dict values [dict get $argd values]] startidx endidx + set limit "" + if {$startidx ne ""} { + if {$endidx ne ""} { + if {$startidx eq $endidx} { + set limit "index" + } else { + set limit "range" + } + } else { + set limit "index" + } + } else { + set limit "all" + } + + set display_dict {} + switch -- $limit { + all { + set display_dict $frame_cache + } + index { + set k [lindex [dict keys $frame_cache] $startidx] + if {$k ne ""} { + set display_dict [dict create $k [dict get $frame_cache $k]] + } + } + range { + set keys [lrange [dict keys $frame_cache] $startidx $endidx] + foreach k $keys { + dict set display_dict $k [dict get $frame_cache $k] + } + } + } + if {[dict get $argd opts -pretty]} { - set out [pdict -chan none frame_cache */*] + set out [pdict -chan none display_dict */*] } else { set out "" if {[catch { @@ -7599,7 +7669,7 @@ tcl::namespace::eval textblock { set termwidth 80 } - tcl::dict::for {k v} $frame_cache { + tcl::dict::for {k v} $display_dict { lassign $v _f frame _used used set fwidth [textblock::widthtopline $frame] #review - are cached frames uniform width lines? @@ -7651,7 +7721,8 @@ tcl::namespace::eval textblock { # ${[textblock::frame_samples]} #todo punk::args alias for centre center etc? - punk::args::define -dynamic 1 { + punk::args::define { + @dynamic @id -id ::textblock::frame @cmd -name "textblock::frame"\ -help "Frame a block of text with a border." @@ -8208,9 +8279,11 @@ tcl::namespace::eval textblock { } altg { set tbar [tcl::string::repeat $hlt $frame_inner_width] - set tbar [cd::groptim $tbar] + #set tbar [cd::groptim $tbar] + set tbar [punk::ansi::groptim $tbar] set bbar [tcl::string::repeat $hlb $frame_inner_width] - set bbar [cd::groptim $bbar] + #set bbar [cd::groptim $bbar] + set bbar [punk::ansi::groptim $bbar] } default { set tbar [tcl::string::repeat $hlt $frame_inner_width] diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/tomlish-1.1.1.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/tomlish-1.1.1.tm index 3e13e75d..0c8d0b1a 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/tomlish-1.1.1.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/tomlish-1.1.1.tm @@ -716,6 +716,7 @@ namespace eval tomlish { set toml [::tomlish::to_toml $tomlish] } + #TODO use huddle? proc from_json {json} { set jstruct [::tomlish::json_struct $json] return [::tomlish::from_json_struct $jstruct] @@ -1080,11 +1081,13 @@ namespace eval tomlish::decode { # For this reason, we also do absolutely no line-ending transformations based on platform. # All line-endings are maintained as is, and even a file with mixed cr crlf line-endings will be correctly interpreted and can be 'roundtripped' - proc toml {s} { + proc toml {args} { #*** !doctools - #[call [fun toml] [arg s]] + #[call [fun toml] [arg arg...]] #[para] return a Tcl list of tomlish tokens + set s [join $args \n] + namespace upvar ::tomlish::parse is_parsing is_parsing set is_parsing 1 @@ -2380,7 +2383,7 @@ namespace eval tomlish::parse { squotedkey {PUSHSPACE "itable-keyval-space" state "itable-keyval-syntax"}\ endinlinetable "POPSPACE"\ startquote "quoted-key"\ - startsquote {TOSTATE "squoted-key" comment "jn-ok"}\ + startsquote {TOSTATE "squoted-key" comment "jn-testing"}\ comma "itable-space"\ comment "err-state"\ eof "err-state"\ diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/make.tcl b/src/project_layouts/custom/_project/punk.project-0.1/src/make.tcl index de7e055a..6776eb79 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/make.tcl +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/make.tcl @@ -18,7 +18,7 @@ namespace eval ::punkboot { variable foldername [file tail $scriptfolder] variable pkg_requirements [list]; variable pkg_missing [list];variable pkg_loaded [list] variable non_help_flags [list -k] - variable help_flags [list -help --help /?] + variable help_flags [list -help --help /? -h] variable known_commands [list project modules vfs info check shell vendorupdate bootsupport vfscommonupdate] } @@ -180,10 +180,14 @@ set bootsupport_module_paths [list] set bootsupport_library_paths [list] if {[file exists [file join $startdir src bootsupport]]} { lappend bootsupport_module_paths [file join $startdir src bootsupport modules] + lappend bootsupport_module_paths [file join $startdir src bootsupport modules_tcl$::tclmajorv] lappend bootsupport_library_paths [file join $startdir src bootsupport lib] + lappend bootsupport_library_paths [file join $startdir src bootsupport lib_tcl$::tclmajorv] } else { lappend bootsupport_module_paths [file join $startdir bootsupport modules] + lappend bootsupport_module_paths [file join $startdir bootsupport modules_tcl$::tclmajorv] lappend bootsupport_library_paths [file join $startdir bootsupport lib] + lappend bootsupport_library_paths [file join $startdir bootsupport lib_tcl$::tclmajorv] } set bootsupport_paths_exist 0 foreach p [list {*}$bootsupport_module_paths {*}$bootsupport_library_paths] { @@ -203,13 +207,13 @@ set sourcesupport_paths_exist 0 #(most?) Modules in src/modules etc should still be runnable directly in certain cases like this where we point to them. if {[file tail $startdir] eq "src"} { #todo - other src 'module' dirs.. - foreach p [list $startdir/modules $startdir/modules_tcl$::tclmajorv] { + foreach p [list $startdir/modules $startdir/modules_tcl$::tclmajorv $startdir/vendormodules $startdir/vendormodules_tcl$::tclmajorv] { if {[file exists $p]} { lappend sourcesupport_module_paths $p } } # -- -- -- - foreach p [list $startdir/vendorlib $startdir/vendorlib_tcl${::tclmajorv}] { + foreach p [list $startdir/lib $startdir/lib_tcl$::tclmajorv $startdir/vendorlib $startdir/vendorlib_tcl$::tclmajorv] { if {[file exists $p]} { lappend sourcesupport_library_paths $p } @@ -266,9 +270,12 @@ if {$bootsupport_paths_exist || $sourcesupport_paths_exist} { package forget $pkg } } - tcl::tm::add {*}$bootsupport_module_paths {*}$sourcesupport_module_paths - set ::auto_path [list {*}$bootsupport_library_paths {*}$sourcesupport_library_paths] + #tcl::tm::add {*}$original_tm_list {*}$bootsupport_module_paths {*}$sourcesupport_module_paths + #set ::auto_path [list {*}$original_auto_path {*}$bootsupport_library_paths {*}$sourcesupport_library_paths] + tcl::tm::add {*}$bootsupport_module_paths {*}$sourcesupport_module_paths + set ::auto_path [list {*}$bootsupport_library_paths {*}$sourcesupport_library_paths] } + puts "----> auto_path $::auto_path" @@ -1046,7 +1053,9 @@ proc ::punkboot::punkboot_gethelp {args} { append h " - before calling this (followed by make project) - you can test using '(.exe) dev'" \n append h " this will load modules from your /module /lib paths instead of from the kit/zipkit" \n \n append h " $scriptname info" \n - append h " - show the name and base folder of the project to be built" \n + append h " - show the name and base folder of the project to be built" \n \n + append h " $scriptname check" \n + append h " - show module/library paths and any potentially problematic packages for running this script" \n append h "" \n if {[llength [dict get $pkg_availability missing]] || [llength [dict get $pkg_availability broken]]} { set has_recommended 0 @@ -1116,6 +1125,7 @@ if {[llength $commands_found] != 1 } { set do_help 1 } if {$do_help} { + puts stdout "Checking package availability..." set ::punkboot::pkg_availability [::punkboot::check_package_availability -quiet 1 $::punkboot::bootsupport_requirements] foreach pkg_request [dict get $::punkboot::pkg_availability loaded] { #puts stderr "---> $pkg_request" @@ -1407,6 +1417,7 @@ if {$::punkboot::command eq "vendorupdate"} { puts stderr "Unable to use punkcheck for vendormodules$which update. Error: $errM" set installation_event "" } + #todo - sync alg with bootsupport_localupdate! foreach {relpath requested_module} $local_modules { set requested_module [string trim $requested_module :] set module_subpath [string map {:: /} [namespace qualifiers $requested_module]] @@ -1488,6 +1499,11 @@ if {$::punkboot::command eq "bootsupport"} { #puts "-- [tcl::tm::list] --" puts stdout "Updating bootsupport from local files" + proc modfile_sort {p1 p2} { + lassign [split [file rootname $p1] -] _ v1 + lassign [split [file rootname $p1] -] _ v2 + package vcompare $v1 $v2 + } proc bootsupport_localupdate {projectroot} { set bootsupport_modules [list] ;#variable populated by include_modules.config file - review set sourcefolder $projectroot/src @@ -1521,57 +1537,66 @@ if {$::punkboot::command eq "bootsupport"} { set boot_event "" } - foreach {relpath module} $bootsupport_modules { - set module [string trim $module :] - set module_subpath [string map [list :: /] [namespace qualifiers $module]] + foreach {relpath modulematch} $bootsupport_modules { + set modulematch [string trim $modulematch :] + set module_subpath [string map [list :: /] [namespace qualifiers $modulematch]] set srclocation [file join $projectroot $relpath $module_subpath] - #puts stdout "$relpath $module $module_subpath $srclocation" - set pkgmatches [glob -nocomplain -dir $srclocation -tail [namespace tail $module]-*] - #lsort won't sort version numbers properly e.g with -dictionary 0.1.1 comes before 0.1 + #puts stdout "$relpath $modulematch $module_subpath $srclocation" + if {[string first - $modulematch]} { + set pkgmatches [glob -nocomplain -dir $srclocation -tail -type f [namespace tail $modulematch]*.tm] + } else { + set pkgmatches [glob -nocomplain -dir $srclocation -tail -type f [namespace tail $modulematch]-*.tm] + } if {![llength $pkgmatches]} { - puts stderr "Missing source for bootsupport module $module - not found in $srclocation" + puts stderr "Missing source for bootsupport module $modulematch - no matches in $srclocation" continue } - set latestfile [lindex $pkgmatches 0] - set latestver [lindex [split [file rootname $latestfile] -] 1] - foreach m $pkgmatches { - lassign [split [file rootname $m] -] _pkg ver - #puts "comparing $ver vs $latestver" - if {[package vcompare $ver $latestver] == 1} { - set latestver $ver - set latestfile $m - } + + set modulematch_is_glob [regexp {[*?\[\]]} $modulematch] + if {!$modulematch_is_glob} { + #if modulematch was specified without globs - only copy latest + #lsort won't sort version numbers properly e.g with -dictionary 0.1.1 comes before 0.1b3 - use helper func + set pkgmatches [lsort -command modfile_sort $pkgmatches] + set latestfile [lindex $pkgmatches end] + #set latestver [lindex [split [file rootname $latestfile] -] 1] + set copy_files $latestfile + } else { + #globs in modulematch - may be different packages matched by glob - copy all versions of matches + #review + set copy_files $pkgmatches } - set srcfile [file join $srclocation $latestfile] - set tgtfile [file join $targetroot $module_subpath $latestfile] - if {$boot_event ne ""} { - #---------- - $boot_event targetset_init INSTALL $tgtfile - $boot_event targetset_addsource $srcfile - #---------- - if {\ - [llength [dict get [$boot_event targetset_source_changes] changed]]\ - || [llength [$boot_event get_targets_exist]] < [llength [$boot_event get_targets]]\ - } { - file mkdir [file dirname $tgtfile] ;#ensure containing folder for target exists - $boot_event targetset_started - # -- --- --- --- --- --- - puts "BOOTSUPPORT module$which update: $srcfile -> $tgtfile" - if {[catch { - file copy -force $srcfile $tgtfile - } errM]} { - $boot_event targetset_end FAILED + foreach cfile $copy_files { + set srcfile [file join $srclocation $cfile] + set tgtfile [file join $targetroot $module_subpath $cfile] + if {$boot_event ne ""} { + #---------- + $boot_event targetset_init INSTALL $tgtfile + $boot_event targetset_addsource $srcfile + #---------- + if {\ + [llength [dict get [$boot_event targetset_source_changes] changed]]\ + || [llength [$boot_event get_targets_exist]] < [llength [$boot_event get_targets]]\ + } { + file mkdir [file dirname $tgtfile] ;#ensure containing folder for target exists + $boot_event targetset_started + # -- --- --- --- --- --- + puts "BOOTSUPPORT module$which update: $srcfile -> $tgtfile" + if {[catch { + file copy -force $srcfile $tgtfile + } errM]} { + $boot_event targetset_end FAILED + } else { + $boot_event targetset_end OK + } + # -- --- --- --- --- --- } else { - $boot_event targetset_end OK + puts -nonewline stderr "." + $boot_event targetset_end SKIPPED } - # -- --- --- --- --- --- + $boot_event end } else { - puts -nonewline stderr "." - $boot_event targetset_end SKIPPED + file copy -force $srcfile $tgtfile } - $boot_event end - } else { - file copy -force $srcfile $tgtfile } } if {$boot_event ne ""} { @@ -1597,13 +1622,14 @@ if {$::punkboot::command eq "bootsupport"} { if {[file exists $project_layout_base]} { set project_layouts [glob -nocomplain -dir $project_layout_base -type d -tail *] foreach layoutname $project_layouts { + puts stdout "Processing layout $project_layout_base/$layoutname" #don't auto-create src/bootsupport - just update it if it exists if {[file exists [file join $project_layout_base $layoutname/src/bootsupport]]} { set antipaths [list\ README.md\ ] - set boot_module_folders [glob -nocomplain -dir $projectroot/src/bootsupport/modules_tcl*] - lappend bootsupport_module_folders "modules" + #set boot_module_folders [list modules {*}[glob -nocomplain -dir $projectroot/src/bootsupport/modules_tcl*]] + set bootsupport_module_folders "modules" foreach bm $bootsupport_module_folders { if {[file exists $projectroot/src/bootsupport/$bm]} { lassign [split $bm _] _bm tclx @@ -1617,12 +1643,33 @@ if {$::punkboot::command eq "bootsupport"} { file mkdir $targetroot puts stdout "BOOTSUPPORT$which layouts/$layoutname: copying from $sourcemodules to $targetroot (if source file changed)" - set resultdict [punkcheck::install $sourcemodules $targetroot -overwrite installedsourcechanged-targets -antiglob_paths $antipaths] + + set resultdict [punkcheck::install $sourcemodules $targetroot\ + -overwrite installedsourcechanged-targets\ + -antiglob_paths $antipaths\ + -installer "punkboot-bootsupport" + ] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] flush stdout } } } + #make.tcl (to be boot.tcl?) is part of bootsupport + set source_bootscript [file join $projectroot src/make.tcl] + set targetroot_bootscript $project_layout_base/$layoutname/src + if {[file exists $source_bootscript]} { + puts stdout "BOOTSUPPORT layouts/$layoutname: copying from $source_bootscript to $targetroot_bootscript (if source file changed)" + set resultdict [punkcheck::install [file dirname $source_bootscript] $targetroot_bootscript\ + -glob make.tcl\ + -max_depth 1\ + -createempty 0\ + -overwrite installedsourcechanged-targets\ + -installer "punkboot-bootsupport" + ] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + flush stdout + } } } else { puts stderr "No layout base at $project_layout_base" diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/argparsingtest-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/argparsingtest-0.1.0.tm new file mode 100644 index 00000000..1ede846b --- /dev/null +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/argparsingtest-0.1.0.tm @@ -0,0 +1,568 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from -buildversion.txt +# module template: punkshell/src/decktemplates/vendor/punk/modules/template_module-0.0.2.tm +# +# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. +# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# (C) Julian Noble 2024 +# +# @@ Meta Begin +# Application argparsingtest 0.1.0 +# Meta platform tcl +# Meta license MIT +# @@ Meta End + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# doctools header +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[manpage_begin punkshell_module_argparsingtest 0 0.1.0] +#[copyright "2024"] +#[titledesc {Module API}] [comment {-- Name section and table of contents description --}] +#[moddesc {-}] [comment {-- Description at end of page heading --}] +#[require argparsingtest] +#[keywords module] +#[description] +#[para] - + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section Overview] +#[para] overview of argparsingtest +#[subsection Concepts] +#[para] - + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[subsection dependencies] +#[para] packages used by argparsingtest +#[list_begin itemized] + +package require Tcl 8.6- +package require punk::args +package require struct::set +#*** !doctools +#[item] [package {Tcl 8.6}] +#[item] [package {punk::args}] + +# #package require frobz +# #*** !doctools +# #[item] [package {frobz}] + +#*** !doctools +#[list_end] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section API] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# oo::class namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval argparsingtest::class { + #*** !doctools + #[subsection {Namespace argparsingtest::class}] + #[para] class definitions + if {[info commands [namespace current]::interface_sample1] eq ""} { + #*** !doctools + #[list_begin enumerated] + + # oo::class create interface_sample1 { + # #*** !doctools + # #[enum] CLASS [class interface_sample1] + # #[list_begin definitions] + + # method test {arg1} { + # #*** !doctools + # #[call class::interface_sample1 [method test] [arg arg1]] + # #[para] test method + # puts "test: $arg1" + # } + + # #*** !doctools + # #[list_end] [comment {-- end definitions interface_sample1}] + # } + + #*** !doctools + #[list_end] [comment {--- end class enumeration ---}] + } +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Base namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval argparsingtest { + namespace export {[a-z]*} ;# Convention: export all lowercase + #variable xyz + + #*** !doctools + #[subsection {Namespace argparsingtest}] + #[para] Core API functions for argparsingtest + #[list_begin definitions] + + proc test1_ni {args} { + set defaults [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_seps \uFFEF\ + -x ""\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + foreach {k v} $args { + if {$k ni [dict keys $defaults]} { + error "unrecognised option '$k'. Known options [dict keys $defaults]" + } + } + set opts [dict merge $defaults $args] + } + proc test1_switchmerge {args} { + set defaults [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_seps \uFFEF\ + -x ""\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + foreach {k v} $args { + switch -- $k { + -return - -show_edge - -show_seps - -frametype - -x - -y - -z - -1 - -2 - -3 {} + default { + error "unrecognised option '$k'. Known options [dict keys $defaults]" + } + } + } + set opts [dict merge $defaults $args] + } + #if we need to loop to test arg validity anyway - then dict set as we go is slightly faster than a dict merge at the end + proc test1_switch {args} { + set opts [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_seps \uFFEF\ + -x ""\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + foreach {k v} $args { + switch -- $k { + -return - -show_edge - -show_seps - -frametype - -x - -y - -z - -1 - -2 - -3 { + dict set opts $k $v + } + default { + error "unrecognised option '$k'. Known options [dict keys $opts]" + } + } + } + return $opts + } + variable switchopts + set switchopts [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_seps \uFFEF\ + -x ""\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + #slightly slower than just creating the dict within the proc + proc test1_switch_nsvar {args} { + variable switchopts + set opts $switchopts + foreach {k v} $args { + switch -- $k { + -return - -show_edge - -show_seps - -frametype - -x - -y - -z - -1 - -2 - -3 { + dict set opts $k $v + } + default { + error "unrecognised option '$k'. Known options [dict keys $opts]" + } + } + } + return $opts + } + proc test1_switch2 {args} { + set opts [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_seps \uFFEF\ + -x ""\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + set switches [lmap v [dict keys $opts] {list $v -}] + set switches [concat {*}$switches] + set switches [lrange $switches 0 end-1] + foreach {k v} $args { + switch -- $k\ + {*}$switches { + dict set opts $k $v + }\ + default { + error "unrecognised option '$k'. Known options [dict keys $opts]" + } + } + return $opts + } + proc test1_prefix {args} { + set opts [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_seps \uFFEF\ + -x ""\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + foreach {k v} $args { + dict set opts [tcl::prefix::match -message "test1_prefix option $k" {-return -frametype -show_edge -show_seps -x -y -z -1 -2 -3} $k] $v + } + return $opts + } + proc test1_prefix2 {args} { + set opts [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_seps \uFFEF\ + -x ""\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + if {[llength $args]} { + set knownflags [dict keys $opts] + } + foreach {k v} $args { + dict set opts [tcl::prefix::match -message "test1_prefix2 option $k" $knownflags $k] $v + } + return $opts + } + + #punk::args is slower than argp - but comparable, and argp doesn't support solo flags + proc test1_punkargs {args} { + set argd [punk::args::parse $args withdef { + @id -id ::argparsingtest::test1_punkargs + @cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" + @opts -anyopts 0 + -return -default string -type string + -frametype -default \uFFEF -type string + -show_edge -default \uFFEF -type string + -show_seps -default \uFFEF -type string + -join -type none -multiple 1 + -x -default "" -type string + -y -default b -type string + -z -default c -type string + -1 -default 1 -type boolean + -2 -default 2 -type integer + -3 -default 3 -type integer + @values + }] + return [tcl::dict::get $argd opts] + } + + punk::args::define { + @id -id ::test1_punkargs_by_id + @cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" + @opts -anyopts 0 + -return -default string -type string + -frametype -default \uFFEF -type string + -show_edge -default \uFFEF -type string + -show_seps -default \uFFEF -type string + -join -type none -multiple 1 + -x -default "" -type string + -y -default b -type string + -z -default c -type string + -1 -default 1 -type boolean + -2 -default 2 -type integer + -3 -default 3 -type integer + @values + } + proc test1_punkargs_by_id {args} { + set argd [punk::args::get_by_id ::test1_punkargs_by_id $args] + return [tcl::dict::get $argd opts] + } + + punk::args::define { + @id -id ::argparsingtest::test1_punkargs2 + @cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" + @opts -anyopts 0 + -return -default string -type string + -frametype -default \uFFEF -type string + -show_edge -default \uFFEF -type string + -show_seps -default \uFFEF -type string + -join -type none -multiple 1 + -x -default "" -type string + -y -default b -type string + -z -default c -type string + -1 -default 1 -type boolean + -2 -default 2 -type integer + -3 -default 3 -type integer + @values + } + proc test1_punkargs2 {args} { + set argd [punk::args::get_by_id ::argparsingtest::test1_punkargs2 $args] + return [tcl::dict::get $argd opts] + } + + + proc test1_punkargs_validate_ansistripped {args} { + set argd [punk::args::get_dict { + @id -id ::argparsingtest::test1_punkargs_validate_ansistripped + @cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" + @opts -anyopts 0 + -return -default string -type string -choices {string object} -help "return type" + -frametype -default \uFFEF -type string + -show_edge -default \uFFEF -type string + -show_seps -default \uFFEF -type string + -join -type none -multiple 1 + -x -default "" -type string + -y -default b -type string + -z -default c -type string + -1 -default 1 -type boolean -validate_ansistripped true + -2 -default 2 -type integer -validate_ansistripped true + -3 -default 3 -type integer -validate_ansistripped true + @values + } $args] + return [tcl::dict::get $argd opts] + } + + package require opt + variable optlist + tcl::OptProc test1_opt { + {-return string "return type"} + {-frametype \uFFEF "type of frame"} + {-show_edge \uFFEF "show table outer borders"} + {-show_seps \uFFEF "show separators"} + {-join "solo option"} + {-x "" "x val"} + {-y b "y val"} + {-z c "z val"} + {-1 1 "1val"} + {-2 -int 2 "2val"} + {-3 -int 3 "3val"} + } { + set opts [dict create] + foreach v [info locals] { + dict set opts $v [set $v] + } + return $opts + } + + package require cmdline + #cmdline::getoptions is much faster than typedGetoptions + proc test1_cmdline_untyped {args} { + set cmdlineopts_untyped { + {return.arg "string" "return val"} + {frametype.arg \uFFEF "frame type"} + {show_edge.arg \uFFEF "show table borders"} + {show_seps.arg \uFFEF "show table seps"} + {join "join the things"} + {x.arg "" "arg x"} + {y.arg b "arg y"} + {z.arg c "arg z"} + {1.arg 1 "arg 1"} + {2.arg 2 "arg 2"} + {3.arg 3 "arg 3"} + } + + set usage "usage etc" + return [::cmdline::getoptions args $cmdlineopts_untyped $usage] + } + proc test1_cmdline_typed {args} { + set cmdlineopts_typed { + {return.arg "string" "return val"} + {frametype.arg \uFFEF "frame type"} + {show_edge.arg \uFFEF "show table borders"} + {show_seps.arg \uFFEF "show table seps"} + {join "join the things"} + {x.arg "" "arg x"} + {y.arg b "arg y"} + {z.arg c "arg z"} + {1.boolean 1 "arg 1"} + {2.integer 2 "arg 2"} + {3.integer 3 "arg 3"} + } + + set usage "usage etc" + return [::cmdline::typedGetoptions args $cmdlineopts_typed $usage] + } + + catch { + package require argp + argp::registerArgs test1_argp { + { -return string "string" } + { -frametype string \uFFEF } + { -show_edge string \uFFEF } + { -show_seps string \uFFEF } + { -x string "" } + { -y string b } + { -z string c } + { -1 boolean 1 } + { -2 integer 2 } + { -3 integer 3 } + } + } + proc test1_argp {args} { + argp::parseArgs opts + return [array get opts] + } + + package require tepam + tepam::procedure {test1_tepam} { + -args { + {-return -type string -default string} + {-frametype -type string -default \uFFEF} + {-show_edge -type string -default \uFFEF} + {-show_seps -type string -default \uFFEF} + {-join -type none -multiple} + {-x -type string -default ""} + {-y -type string -default b} + {-z -type string -default c} + {-1 -type boolean -default 1} + {-2 -type integer -default 2} + {-3 -type integer -default 3} + } + } { + return [dict create return $return frametype $frametype show_edge $show_edge show_seps $show_seps x $x y $y z $z 1 $1 2 $2 3 $3 join $join] + } + + #multiline values use first line of each record to determine amount of indent to trim + proc test_multiline {args} { + set t3 [textblock::frame t3] + set argd [punk::args::get_dict [subst { + -template1 -default { + ****** + * t1 * + ****** + } + -template2 -default { ------ + ****** + * t2 * + ******} + -template3 -default {$t3} + #substituted or literal values with newlines - no autoindent applied - caller will have to pad appropriately + -template3b -default { + $t3 + ----------------- + $t3 + abc\ndef + } + -template4 -default "****** + * t4 * + ******" + -template5 -default " + + + " + -flag -default 0 -type boolean + }] $args] + return $argd + } + + #proc sample1 {p1 n args} { + # #*** !doctools + # #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] + # #[para]Description of sample1 + # #[para] Arguments: + # # [list_begin arguments] + # # [arg_def tring p1] A description of string argument p1. + # # [arg_def integer n] A description of integer argument n. + # # [list_end] + # return "ok" + #} + + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace argparsingtest ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Secondary API namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval argparsingtest::lib { + namespace export {[a-z]*} ;# Convention: export all lowercase + namespace path [namespace parent] + #*** !doctools + #[subsection {Namespace argparsingtest::lib}] + #[para] Secondary functions that are part of the API + #[list_begin definitions] + + #proc utility1 {p1 args} { + # #*** !doctools + # #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] + # #[para]Description of utility1 + # return 1 + #} + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace argparsingtest::lib ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[section Internal] +namespace eval argparsingtest::system { + #*** !doctools + #[subsection {Namespace argparsingtest::system}] + #[para] Internal functions that are not part of the API + + + +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide argparsingtest [namespace eval argparsingtest { + variable pkg argparsingtest + variable version + set version 0.1.0 +}] +return + +#*** !doctools +#[manpage_end] + diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/commandstack-0.3.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/commandstack-0.3.tm index ee486569..a45eaeaf 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/commandstack-0.3.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/commandstack-0.3.tm @@ -211,7 +211,7 @@ namespace eval commandstack { set new_code [string trim $procbody] if {$current_code eq $new_code} { puts stderr "(commandstack::rename_command) WARNING - renamer '$renamer' has already renamed the '$command' command with same procbody - Aborting rename." - puts stderr [show_stack $command] + puts stderr [::commandstack::show_stack $command] } else { puts stderr "(commandstack::rename_command) WARNING - renamer '$renamer' has already renamed the '$command' command - but appears to be with new code - proceeding." puts stdout "----------" @@ -236,8 +236,7 @@ namespace eval commandstack { set next_target ::commandstack::renamed_commands::${mungedcommand}_${munged_next_implementor}-$mungedrenamer-$tokenid set do_rename 1 } elseif {$next_implementor in {unspecified undetermined}} { - #review - probably don't need a warning anyway - puts stderr "(commandstack::rename_command) WARNING - Something may have renamed the '$command' command. Attempting to cooperate.(untested)" + #could be a standard tcl proc, or from application or package set next_target ::commandstack::renamed_commands::${mungedcommand}_${munged_next_implementor}-$mungedrenamer-$tokenid set do_rename 1 } else { @@ -380,7 +379,8 @@ namespace eval commandstack { #if caller is attempting exact match - use the calling context to resolve in case they didn't supply namespace set commandname_glob [uplevel 1 [list namespace which $commandname_glob]] } - if {[package provide punk::lib] ne ""} { + if {[package provide punk::lib] ne "" && [package provide punk] ne ""} { + #punk pipeline also needed for patterns return [punk::lib::pdict -channel none all_stacks $commandname_glob/@*/@*.@*] } else { set result "" diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/funcl-0.1.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/funcl-0.1.tm index 1d2fe64a..e8430fb0 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/funcl-0.1.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/funcl-0.1.tm @@ -9,7 +9,7 @@ package provide funcl [namespace eval funcl { namespace eval funcl { - #from punk + #from punk::pipe proc arg_is_script_shaped {arg} { if {[string first " " $arg] >= 0} { return 1 diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/include_modules.config b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/include_modules.config index 158166cf..816f3331 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/include_modules.config +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/include_modules.config @@ -18,7 +18,6 @@ set bootsupport_modules [list\ src/vendormodules md5\ src/vendormodules metaface\ src/vendormodules modpod\ - src/vendormodules oolib\ src/vendormodules overtype\ src/vendormodules pattern\ src/vendormodules patterncmd\ @@ -40,6 +39,7 @@ set bootsupport_modules [list\ modules funcl\ modules natsort\ modules punk\ + modules punk::pipe\ modules punkapp\ modules punkcheck\ modules punkcheck::cli\ diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/overtype-1.6.5.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/overtype-1.6.5.tm index fb044b3c..9363fb6d 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/overtype-1.6.5.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/overtype-1.6.5.tm @@ -216,7 +216,9 @@ tcl::namespace::eval overtype { } set optargs [lrange $args 0 end-2] if {[llength $optargs] % 2 == 0} { - lassign [lrange $args end-1 end] underblock overblock + set overblock [lindex $args end] + set underblock [lindex $args end-1] + #lassign [lrange $args end-1 end] underblock overblock set argsflags [lrange $args 0 end-2] } else { set optargs [lrange $args 0 end-1] @@ -1810,8 +1812,10 @@ tcl::namespace::eval overtype { if {[llength $args] < 2} { error {usage: ?-info 0|1? ?-startcolumn ? ?-cursor_column ? ?-cursor_row |""? ?-transparent [0|1|]? ?-expand_right [1|0]? undertext overtext} } - lassign [lrange $args end-1 end] under over - if {[string first \n $under] >= 0} { + set under [lindex $args end-1] + set over [lindex $args end] + #lassign [lrange $args end-1 end] under over + if {[string last \n $under] >= 0} { error "overtype::renderline not allowed to contain newlines in undertext" } #if {[string first \n $over] >=0 || [string first \n $under] >= 0} { @@ -2920,6 +2924,7 @@ tcl::namespace::eval overtype { set leadernorm [tcl::string::range [tcl::string::map [list\ \x1b\[< 1006\ \x1b\[ 7CSI\ + \x1bY 7MAP\ \x1bP 7DCS\ \x90 8DCS\ \x9b 8CSI\ @@ -2948,6 +2953,10 @@ tcl::namespace::eval overtype { #8-bit Device Control String set codenorm [tcl::string::cat $leadernorm [tcl::string::range $code 1 end]] } + 7MAP { + #map to another type of code to share implementation branch + set codenorm $leadernorm[tcl::string::range $code 1 end] + } 7ESC { #set codenorm [tcl::string::cat $leadernorm [tcl::string::range $code 1 end]] set codenorm $leadernorm[tcl::string::range $code 1 end] @@ -2964,6 +2973,30 @@ tcl::namespace::eval overtype { } } + switch -- $leadernorm { + 7MAP { + switch -- [lindex $codenorm 4] { + Y { + #vt52 movement. we expect 2 chars representing position (limited range) + set params [tcl::string::range $codenorm 5 end] + if {[tcl::string::length $params] != 2} { + #shouldn't really get here or need this branch if ansi splitting was done correctly + puts stderr "overtype::renderline ESC Y recognised as vt52 move, but incorrect parameters length ([string length $params] vs expected 2) [ansistring VIEW -lf 1 -vt 1 -nul 1 $code] not implemented codenorm:[ansistring VIEW -lf 1 -vt 1 -nul 1 $codenorm]" + } + set line [tcl::string::index $params 5] + set column [tcl::string::index $params 1] + set r [expr {[scan $line %c] -31}] + set c [expr {[scan $column %c] -31}] + + #MAP to: + #CSI n;m H - CUP - Cursor Position + set leadernorm 7CSI + set codenorm "$leadernorm${r}\;${c}H" + } + } + } + } + #we've mapped 7 and 8bit escapes to values we can handle as literals in switch statements to take advantange of jump tables. switch -- $leadernorm { 1006 { @@ -2982,7 +3015,8 @@ tcl::namespace::eval overtype { {7CSI} - {8CSI} { set param [tcl::string::range $codenorm 4 end-1] #puts stdout "--> CSI [tcl::string::index $leadernorm 0] bit param:$param" - set code_end [tcl::string::index $codenorm end] ;#used for e.g h|l set/unset mode + set code_end [tcl::string::index $codenorm end] ;#used for e.g h|l set/unset mode + switch -exact -- $code_end { A { #Row move - up @@ -3875,6 +3909,7 @@ tcl::namespace::eval overtype { 7ESC { # #re_other_single {\x1b(D|M|E)$} + #also vt52 Y.. #also PM \x1b^...(ST) switch -- [tcl::string::index $codenorm 4] { c { @@ -4586,6 +4621,8 @@ tcl::namespace::eval overtype::priv { set o [lreplace $o $i $i] set ustacks [lreplace $ustacks $i $i] set gxstacks [lreplace $gxstacks $i $i] + } elseif {$i == 0 || $i == $nxt} { + #nothing to do } else { puts stderr "render_delchar - attempt to delchar at index $i >= number of outcols $nxt - shouldn't happen" } diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk-0.1.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk-0.1.tm index 738d89c5..68a14411 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk-0.1.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk-0.1.tm @@ -20,6 +20,21 @@ namespace eval punk { variable cmdexedir set cmdexedir "" + proc sync_package_paths_script {} { + #the tcl::tm namespace doesn't exist until one of the tcl::tm commands + #is run. (they are loaded via ::auto_index triggering load of tm.tcl) + #we call tcl::tm::list to trigger the initial set of tm paths before + #we can override it, otherwise our changes will be lost + #REVIEW - won't work on safebase interp where paths are mapped to {$p(:x:)} etc + return "\ + apply {{ap tmlist} { + set ::auto_path \$ap + tcl::tm::list + set ::tcl::tm::paths \$tmlist + }} {$::auto_path} {[tcl::tm::list]} + " + } + proc rehash {{refresh 0}} { global auto_execs if {!$refresh} { @@ -217,7 +232,7 @@ namespace eval punk { [file exists [set testapp [file join $::env(LOCALAPPDATA) "Microsoft" "WindowsApps" "winget.exe"]]])} { #should be unlikely to get here - unless LOCALAPPDATA missing set windowsappdir [file dirname [lindex [::punk::auto_execok_windows winget.exe] 0]] - puts stderr "(resolved winget by search)" + catch {puts stderr "(resolved winget by search)"} } else { set windowsappdir [file dirname $testapp] } @@ -359,7 +374,7 @@ if {![llength [info commands ::ansistring]]} { } #require aliascore after punk::lib & punk::ansi are loaded package require punk::aliascore ;#mostly punk::lib aliases -punk::aliascore::init +punk::aliascore::init -force 1 package require punk::repl::codethread package require punk::config @@ -383,8 +398,10 @@ namespace eval punk { package require punk::assertion if {[catch {namespace import ::punk::assertion::assert} errM]} { - puts stderr "punk error importing punk::assertion::assert\n$errM" - puts stderr "punk::a* commands:[info commands ::punk::a*]" + catch { + puts stderr "punk error importing punk::assertion::assert\n$errM" + puts stderr "punk::a* commands:[info commands ::punk::a*]" + } } punk::assertion::active on # -- --- --- @@ -393,7 +410,7 @@ namespace eval punk { if {[catch { package require pattern } errpkg]} { - puts stderr "Failed to load package pattern error: $errpkg" + catch {puts stderr "Failed to load package pattern error: $errpkg"} } package require shellfilter package require punkapp @@ -524,7 +541,7 @@ namespace eval punk { set loader [zzzload::pkg_wait twapi] } errM]} { if {$loader in [list failed loading]} { - puts stderr "Unexpected problem during thread-load of pkg twapi - zzload::pkg_wait returned $loader" + catch {puts stderr "Unexpected problem during thread-load of pkg twapi - zzload::pkg_wait returned $loader"} } } else { package require twapi @@ -1061,7 +1078,7 @@ namespace eval punk { proc destructure {selector data} { # replaced by proc generating destructure_func - - puts stderr "punk::destructure .d. selector:'$selector'" + catch {puts stderr "punk::destructure .d. selector:'$selector'"} set selector [string trim $selector /] upvar v_dict_idx v_dict_idx ;#positional tracker for /@@ - dict position diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/aliascore-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/aliascore-0.1.0.tm index 296bb6df..3d1d87e9 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/aliascore-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/aliascore-0.1.0.tm @@ -105,6 +105,7 @@ tcl::namespace::eval punk::aliascore { #functions must be in export list of their source namespace set aliases [tcl::dict::create\ + val ::punk::pipe::val\ aliases ::punk::lib::aliases\ alias ::punk::lib::alias\ tstr ::punk::lib::tstr\ @@ -123,12 +124,12 @@ tcl::namespace::eval punk::aliascore { colour ::punk::console::colour\ ansi ::punk::console::ansi\ color ::punk::console::colour\ + a? ::punk::console::code_a?\ + A? {::punk::console::code_a? forcecolor}\ a+ ::punk::console::code_a+\ A+ {::punk::console::code_a+ forcecolour}\ a ::punk::console::code_a\ A {::punk::console::code_a forcecolour}\ - a? ::punk::console::code_a?\ - A? {::punk::console::code_a? forcecolor}\ smcup ::punk::console::enable_alt_screen\ rmcup ::punk::console::disable_alt_screen\ ] diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm index 422c524e..b367be2a 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm @@ -137,7 +137,7 @@ tcl::namespace::eval punk::ansi::class { @id -id "::punk::ansi::class::class_ansi render_to_input_line" @cmd -name "punk::ansi::class::class_ansi render_to_input_line" -help\ "render string from line 0 to line - (experimental/debug)" + (experimental/debug)" -dimensions -type string -help\ "WxH where W is integer width >= 1 and H is integer heigth >= 1" -minus -type integer -help\ @@ -584,25 +584,38 @@ tcl::namespace::eval punk::ansi { set base $CWD } } + if {[info commands file] eq ""} { + #probably a safe interp + return "UNAVAILABLE" + } return [file join $base src/testansi] } - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + @dynamic @id -id ::punk::ansi::example @cmd -name punk::ansi::example -help "Display .ans image files in a grid that will fit in console " - -colwidth -default 82 -help "Width of each column - default of 82 will fit a standard 80wide ansi image (when framed) - You can specify a narrower width to truncate images on the right side" - -folder -default "${[punk::ansi::Get_ansifolder]}" -help "Base folder for files if relative paths are used. - Defaults to /src/testansi - where projectbase is determined from current directory. + -colwidth -default 82 -help\ + "Width of each column - default of 82 will fit a standard 80wide ansi image + (when framed) + You can specify a narrower width to truncate images on the right side" + -folder -default "${[punk::ansi::Get_ansifolder]}" -help\ + "Base folder for files if relative paths are used. + Defaults to /src/testansi - where projectbase is determined + from the current directory. " @values -min 0 -max -1 - files -default {belinda.ans bot.ans flower.ans fish.ans} -multiple true -help "List of filenames - leave empty to display 4 defaults" + files -default {belinda.ans bot.ans flower.ans fish.ans} -multiple true -help\ + "List of filenames - leave empty to display 4 defaults" } ""] proc example {args} { set argd [punk::args::get_by_id ::punk::ansi::example $args] set colwidth [dict get $argd opts -colwidth] + if {[info commands file] eq ""} { + error "file command unavailable - punk::ansi::example cannot be shown" + } set ansifolder [file normalize [dict get $argd opts -folder]] set fnames [dict get $argd values files] @@ -617,6 +630,16 @@ tcl::namespace::eval punk::ansi { puts stderr "Ensure ansi test files exist: $fnames" #error "punk::ansi::example Cannot find example files" } + set termsize [punk::console:::get_size] + set termcols [dict get $termsize columns] + set margin 4 ;#review + set freewidth [expr {$termcols-$margin}] + if {$freewidth < $colwidth} { + puts stderr "[a+ red bold]punk::ansi::example freewidth: $freewidth < colwidth: $colwidth TRUNCATING IMAGES[a]" + set colwidth $freewidth + } + set per_row [expr {$freewidth / $colwidth}] + set missingbase [a+ yellow][textblock::block [expr {$colwidth-2}] 23 ?][a] ;#assuming standard frame - subtract 2 for left/right borders set pics [list] foreach f $fnames { @@ -636,10 +659,6 @@ tcl::namespace::eval punk::ansi { } } - set termsize [punk::console:::get_size] - set margin 4 - set freewidth [expr {[tcl::dict::get $termsize columns]-$margin}] - set per_row [expr {$freewidth / $colwidth}] set rowlist [list] ;# { { } { } } set heightlist [list] ;# { { } { } } @@ -737,22 +756,23 @@ tcl::namespace::eval punk::ansi { #review - can terminals handle SGR codes within a PM? #Wezterm will hide PM,SOS,APC - but not any part following an SGR code - i.e it seems to terminate hiding before the ST (apparently at the ) proc controlstring_PM {text} { - return "\x1b^${text}\033\\" + #dquotes with trailing \\ in string will confuse silly editors + return \x1b^${text}\033\\ } proc controlstring_PM8 {text} { - return "\x9e${text}\x9c" + return \x9e${text}\x9c } proc controlstring_SOS {text} { - return "\x1bX${text}\033\\" + return \x1bX${text}\033\\ } proc controlstring_SOS8 {text} { - return "\x98${text}\x9c" + return \x98${text}\x9c } proc controlstring_APC {text} { - return "\x1b_${text}\033\\" + return \x1b_${text}\033\\ } proc controlstring_APC8 {text} { - return "\x9f${text}\x9c" + return \x9f${text}\x9c } #there is also the SGR hide code (8) which has intermittent terminal support #This doesn't change the output length - so support is tricky to detec. (terminal checksum report?) @@ -843,10 +863,79 @@ tcl::namespace::eval punk::ansi { return $out } + + #Wrap text in ansi codes to switch to DEC alternate graphics character set. + #todo vt52 versions proc g0 {text} { return \x1b(0$text\x1b(B } + variable altg_map [dict create\ + hl q\ + vl x\ + tlc l\ + trc k\ + blc m\ + ltj t\ + rtj u\ + ttj w\ + btj v\ + rtj u\ + fwj n\ + ] + proc altg_map {names} { + variable altg_map + set result [list] + foreach nm $names { + if {[dict exists $altg_map $nm]} { + lappend result [dict get $altg_map $nm] + } else { + lappend "" + } + } + return $result + } + + # -------------------------------- + # Taken from term::ansi::code::ctrl + # -------------------------------- + #Note that SYN (\016) seems to put terminals in a state + #where alternate graphics are not processed. + #an ETB (\017) needs to be sent to get alt graphics working again. + #It isn't known what software utilises SYN/ETB within altg sequences + # (presumably to alternate between the charsets within a graphics-on/graphics-off section) + #but as modern emulators seem to react to it, we should handle it. + #REVIEW - this mapping not fully understood + #used by groptim + variable grforw + variable grback + variable _ + + foreach _ { + ! \" # $ % & ' ( ) * + , - . / + 0 1 2 3 4 5 6 7 8 9 : ; < = > + ? @ A B C D E F G H I J K L M + N O P Q R S T U V W X Y Z [ ^ + \\ ] + } { + lappend grforw \016$_ $_\016 + lappend grback $_\017 \017$_ + } + unset _ + # ------------------------------ + #REVIEW - see forward/backward map in term::ansi::code::macros::cd::groptim - what are they for?? + proc groptim {string} { + variable grforw + variable grback + set offon \x1b(B\x1b(0 ;#)) ;#editor highlighting comment + set onoff \x1b(0\x1b(B ;#)) ;#editor highlighting comment + while {![string equal $string [set new [string map [list $offon {} $onoff {}] [string map $grback [string map $grforw $string]]]]]} { + set string $new + } + return $string + } + # -------------------------------- + proc ansistrip_gx {text} { #e.g "\033(0" - select VT100 graphics for character set G0 #e.g "\033(B" - reset @@ -854,10 +943,10 @@ tcl::namespace::eval punk::ansi { #e.g "\033)X" - where X is any char other than 0 to reset ?? #return [convert_g0 $text] - return [tcl::string::map [list "\x1b(0" "" \x1b(B" "" "\x1b)0" "" "\x1b)X" ""] $text] + return [tcl::string::map [list \x1b(0 "" \x1b(B "" \x1b)0 "" \x1b)X ""] $text] } proc stripansi_gx {text} { - return [tcl::string::map [list "\x1b(0" "" \x1b(B" "" "\x1b)0" "" "\x1b)X" ""] $text] + return [tcl::string::map [list \x1b(0 "" \x1b(B "" \x1b)0 "" \x1b)X ""] $text] } @@ -1459,7 +1548,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu tcl::dict::set opts $k $v } default { - error "colourmap1 unrecognised option $k. Known-options: [tcl::dict::keys $opts] + error "colourmap1 unrecognised option $k. Known-options: [tcl::dict::keys $opts]" } } } @@ -2358,11 +2447,11 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu lappend PUNKARGS [list { @id -id ::punk::ansi::sgr_cache @cmd -name punk::ansi::sgr_cache -help\ - "Convenience function to view and optionally clear the ansi character attribute cache (ansi SGR codes) - " + "Convenience function to view and optionally clear the ansi character attribute cache + (ansi SGR codes)" -action -default "" -choices "clear" -help\ "-action clear will unset the keys in the punk::ansi::sgr_cache dict - This is called automatically when setting 'colour false' in the console" + This is called automatically when setting 'colour false' in the console" -pretty -default 1 -type boolean -help\ "use 'pdict punk::ansi::sgr_cache */%str,%ansiview' output" @@ -2882,7 +2971,8 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set SGR_samples [dict create] foreach k [dict keys $SGR_map] { - dict set SGR_samples $k "[punk::ansi::a+ $k]sample\x1b\[m" + #indent of 1 space is important for clarity in i -return string a+ output + dict set SGR_samples $k " [punk::ansi::a+ $k]sample\x1b\[m" } lappend PUNKARGS [list { @id -id ::punk::ansi::a+ @@ -2895,23 +2985,23 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu code -type string -optional 1 -multiple 1 -choices {}\ -choicelabels {}\ -choicecolumns 5 -choiceprefix 0 -choicerestricted 0 -help\ - "SGR code from the list below, or an integer corresponding to the code e.g 31 = red. - A leading capital letter indicates a codename applies to the background colour. - Other accepted codes are: - term- Term- foreground/background where int is 0-255 terminal color - term- Term- foreground/background - rgb--- Rgb--- foreground/background where are the - 0-255 int values for red, green and blue. - rgb# Rgb# where is a 6 char hex colour e.g rgb#C71585 - web- Web- + "SGR code from the list below, or an integer corresponding to the code e.g 31 = red. + A leading capital letter indicates a codename applies to the background colour. + Other accepted codes are: + term- Term- foreground/background where int is 0-255 terminal color + term- Term- foreground/background + rgb--- Rgb--- foreground/background where are the + 0-255 int values for red, green and blue. + rgb# Rgb# where is a 6 char hex colour e.g rgb#C71585 + web- Web- - The acceptable values for and can be queried using - punk::ansi::a? term - and - punk::ansi::a? web + The acceptable values for and can be queried using + punk::ansi::a? term + and + punk::ansi::a? web - Example to set foreground red and background cyan followed by a reset: - set str \"[a+ red Cyan]sample text[a]\" + Example to set foreground red and background cyan followed by a reset: + set str \"[a+ red Cyan]sample text[a]\" " }]] @@ -3264,7 +3354,55 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu return $result } - proc ansiwrap {codes text} { + lappend PUNKARGS [list { + @id -id ::punk::ansi::ansiwrap + @cmd -name punk::ansi::ansiwrap -help\ + "Wrap a string with ANSI codes from + supplied codelist(s) followed by trailing + ANSI reset. + + Codes are numbers or strings as indicated + in the output of the colour information + function: punk::ansi::a? + + No leading reset is applied - so when + placing resultant text, any existing + SGR codes that aren't overridden may + still take effect. + + For finer control use the a+ and a + functions eg + set x \"[a+ red]text [a+ bold]etc[a]\" + " + @leaders -min 0 -max -1 + codelist -multiple 1 -default {} -type list -help\ + "ANSI names/ints as understood by 'a?' + (Not actual ANSI as output by a+) + These can be supplied individually or + as a list or lists" + @values -min 1 -max 1 + text -type string -help\ + "String to wrap with ANSI (SGR)" + }] + #proc ansiwrap {codes text} { + # return [a {*}$codes]$text[a] + #} + proc ansiwrap2 {args} { + set argd [punk::args::parse $args withid ::punk::ansi::ansiwrap] + set codelists [dict get $argd leaders codelist] + set text [dict get $argd values text] + set codes [concat {*}$codelists] ;#flatten + return [a {*}$codes]$text[a] + } + proc ansiwrap {args} { + if {[llength $args] < 1} { + #minimal args parsing - unhappy path only + punk::args::parse $args withid ::punk::ansi::ansiwrap + return + } + set text [lindex $args end] + set codelists [lrange $args 0 end-1] + set codes [concat {*}$codelists] ;#flatten return [a {*}$codes]$text[a] } @@ -3300,6 +3438,14 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[call [fun reset_soft]] return \x1b\[!p } + proc SYN {} { + #syn seems to disable alternate graphics mode temporarily on modern terminals + return \016 + } + proc ETB {} { + #This is a form of soft reset for the state where a SYN was sent - re-enabling altg processing + return \017 + } proc reset_colour {} { #*** !doctools #[call [fun reset_colour]] @@ -3341,6 +3487,12 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[call [fun cursor_off]] return "\033\[?25l" } + proc cursor_on_vt52 {} { + return \x1be + } + proc cursor_off_vt52 {} { + return \x1bf + } # REVIEW - osc8 replays etc for split lines? - textblock #Hyperlinks (a.k.a. HTML-like anchors) in terminal emulators https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda @@ -3387,6 +3539,24 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } # -- --- --- --- --- + lappend PUNKARGS [list { + @id -id ::punk::ansi::move + @cmd -name punk::ansi::move -help\ + {Return an ANSI sequence to move cursor to row,col + (aka: cursor home) + + Sequence is of the form: + \x1b[;H + (CSI row ; col H) + This sequence will not be understood by old vt52 + terminals. see also vt52_move. + } + @values -min 2 -max 2 + row -type integer -help\ + "row number - starting at 1" + col -type integer -help\ + "column number - starting at 1" + }] proc move {row col} { #*** !doctools #[call [fun move] [arg row] [arg col]] @@ -3394,6 +3564,44 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[para]aka cursor home return \033\[${row}\;${col}H } + #NOTE vt52 uses ESC Y line column + # where line and column are ascii codes whose values are +31 + # vt52 can be entered/exited via escapes + # This means we probably need to to wrap enter/exit vt52 and keep this state - as we don't have a standard way to query for terminal type + # (vt52 supports ESC Z - but vt100 sometimes? doesn't - and querying at each output would be slow anyway, even if there was a common query :/ ) + + lappend PUNKARGS [list { + @id -id ::punk::ansi::vt52move + @cmd -name punk::ansi::vt52move -help\ + {Return a VT52 sequence to move cursor to row,col + (aka: cursor home) + + Sequence is of the form: + ESCY + This sequence will generally not be understood by terminals + that are not in vt52 mode (e.g DECANM unset). + } + @values -min 2 -max 2 + row -type integer -help\ + "row number - starting at 1" + col -type integer -help\ + "column number - starting at 1" + }] + proc vt52move {row col} { + #test + set r [format %c [expr {$row + 31}]] + set c [format %c [expr {$col + 31}]] + return \x1bY${r}${c} + } + proc vt52color {int} { + if {[string is integer -strict $int]} { + if {$int < 0 || $int > 15} { + error "vt52color unsupported - only 0 to 15 available" + } + } + set char [format %c [expr {$int + 31}]] + return \x1bb${char} + } proc move_emit {row col data args} { #*** !doctools #[call [fun move_emit] [arg row] [arg col] [arg data] [opt {row col data...}]] @@ -3424,6 +3632,27 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } return $out } + proc vt52move_emit {row col data args} { + #Todo - G code? + set out "" + if {$row eq "this"} { + #append out \033\[\;${col}G$data + append out [vt52move_column $col]$data + } else { + #append out \033\[${row}\;${col}H$data + append out [vt52move $row $col]$data + } + foreach {row col data} $args { + if {$row eq "this"} { + append out [vt52move_column $col]$data + #append out \033\[\;${col}G$data + } else { + #append out \033\[${row}\;${col}H$data + append out [vt52move $row $col]$data + } + } + return $out + } proc move_emitblock {row col textblock} { #*** !doctools #[call [fun move_emitblock] [arg row] [arg col] [arg textblock]] @@ -3434,31 +3663,63 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } return $commands } + proc vt52move_emitblock {row col textblock} { + #*** !doctools + #[call [fun move_emitblock] [arg row] [arg col] [arg textblock]] + set commands "" + foreach ln [split $textblock \n] { + append commands [punk::ansi::vt52move_emit $row $col $ln] + incr row + } + return $commands + } proc move_forward {{n 1}} { #*** !doctools #[call [fun move_forward] [arg n]] return \033\[${n}C } + proc vt52move_forward {{n 1}} { + return [string repeat \x1bC $n] + } proc move_back {{n 1}} { #*** !doctools #[call [fun move_back] [arg n]] return \033\[${n}D } + proc vt52move_back {{n 1}} { + return [string repeat \x1bD $n] + } proc move_up {{n 1}} { #*** !doctools #[call [fun move_up] [arg n]] return \033\[${n}A } + proc vt52move_up {{n 1}} { + return [string repeat \x1bA $n] + } proc move_down {{n 1}} { #*** !doctools #[call [fun move_down] [arg n]] return \033\[${n}B } + proc vt52move_down {{n 1}} { + return [string repeat \x1bB $n] + } proc move_column {col} { #*** !doctools #[call [fun move_column] [arg col]] return \x1b\[${col}G } + proc vt52move_column {col} { + #This is a bit of a fudge - as there is no command to move to a specific column. + #without tracking state - we settle for moving back enough times to ensure we're at column 1 - and then move forward. + #inefficient - but will have to do I guess. + #review - max term width vt52? env var LINES and env var COLUMNS ? + # also ESC R CR - set window size + set back [string repeat \x1bD 132] + set fwd [string repeat \x1bC [expr {$col - 1}]] + return $back$fwd + } proc move_row {row} { #*** !doctools #[call [fun move_row] [arg row]] @@ -3496,6 +3757,13 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[para] DECRC return \x1b8 } + proc cursor_save_vt52 {} { + return \x1bj + } + proc cursor_restore_vt52 {} { + return \x1bk + } + # -- --- --- --- --- #CRM Show Control Character Mode proc enable_crm {} { @@ -3550,18 +3818,131 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu # \x1b\[?7\;1\$y # \x1b\[?7\;2\$y #where 1 = set, 2 = unset. (0 = mode not recognised, 3 = permanently set, 4 = permanently unset) + + #https://wiki.tau.garden/dec-modes/ + #(DEC,xterm,contour,mintty,kitty etc) + #https://invisible-island.net/xterm/ctlseqs/ctlseqs.html#h2-Mouse-Tracking + + #names for other alt_screen mechanismk: 1047,1048 vs 1049? + #variable decmode_names [dict create\ + # DECANM 2\ + # origin 6\ + # DECCOLM 3\ + # line_wrap 7\ + # LNM 20\ + # alt_screen 1049\ + # grapheme_clusters 2027\ + # bracketed_paste 2004\ + # mouse_sgr 1006\ + # mouse_urxvt 1015\ + # mouse_sgr_pixel 1016\ + #] + variable decmode_data { + 1 { + {origin DEC description "DECCKM - Cursor Keys Mode" names {DECCKM cursor_keys}} + } + 2 { + {origin DEC description "DECANM - ANSI/VT52 Mode" names {DECANM} note { +Disable to turn on VT52 emulation. +In VT52 mode - use \x1b< to exit. + } + } + } + 3 { + {origin DEC description "DECCOLM - Column" names {DECCOLM}} + } + 4 { + {origin DEC description "DECSCLM - Scrolling" names {DECSCLM}} + } + 5 { + {origin DEC description "DECSCNM - Screen Mode (light or dark screen)" names {DECSNM lightmode}} + } + 7 { + {origin DEC description "DECAWM - Auto Wrap Mode" names {DECAWM line_wrap}} + } + 9 { + {origin "xterm" description "X10 compatibility mouse" names {SET_X10_MOUSE mouse_tracking} note { +Escape sequence on button press only. +CSI M CbCxCy (6 chars) +Coords limited to 223 (=255 - 32) + } + } + {origin DEC description "DECINLM - Interlace Mode (obsolete?)" names {DECINLM}} + } + 20 { + {origin DEC description "LNM - Line Feed/New Line Mode" names {LNM} note { +For terminals that support LNM, the default is off +meaning a lone CR respresents the character emitted +when enter is pushed. Turning LNM on would mean that +CR LF is sent when hitting enter. This feature is +not commonly supported, and the default will normally +be as if this was off - ie lone CR. + } + } + } + 25 { + {origin DEC description "DECTCEM - Text Cursor Enable Mode" names {DECTCEM cursor_enable}} + } + 47 { + {origin xterm description "xterm alternate buffer" names {xterm_altbuf}} + {origin DEC description "DECGRPM - Graphics Rotated Print Mode (obsolete?)" names {DECGRPM}} + } + 66 { + {origin DEC description "DECNKM - Numeric Keypad Mode" names {DECNKM}} + } + 1000 { + {origin "xterm" description "VT200 compatibility mouse" names {SET_VT200_MOUSE} note { +Escape sequence on both button press and release. +CSI M CbCxCy + } + } + } + 1004 { + {origin "xterm" description "Send FocusIn/FocusOut events" names {mouse_focus_event}} + } + 1005 { + {origin "xterm" description "Enable UTF-8 Mouse Mode" names {mouse_utf8 mouse_utf8_extended}} + } + 1006 { + {origin "xterm" description "Enable SGR Mouse Mode" names {mouse_sgr mouse_sgr_extended} note{ +SET_SGR_EXT_MODE_MOUSE - extended compared to x10 mouse protocol which limits x y coords +to 223 (=255 - 32) + } + } + } + 1015 { + {origin "urxvt" description "Enable urxvt Mouse Mode" names {mouse_urxvt}} + } + 1016 { + {origin "xterm" description "Enable SGR Pixel Mouse Mode" names {mouse_sgr_pixel}} + } + 1047 { + {origin "xterm" description "Alternate Buffer" names {alt_buffer_only}} + } + 1049 { + {origin "xterm" description "Alternate Buffer with save cursor" names {alt_buffer alt_screen}} + } + 2004 { + {origin "xterm" description "Set bracketed paste mode" names {bracketed_paste}} + } + 2027 { + {origin Contour description "Grapheme Cluster Processing" names {grapheme_clusters}} + } + } + set decmode_names [dict create] + dict for {code items} $decmode_data { + foreach itm $items { + set names [dict get $itm names] + foreach nm $names { + dict set decmode_names $nm $code + } + } + } + + + + - #names for other alt_screen mechanisms: 1047,1048 vs 1049? - variable decmode_names [dict create\ - line_wrap 7\ - LNM 20\ - alt_screen 1049\ - grapheme_clusters 2027\ - bracketed_paste 2004\ - mouse_sgr_extended 1006\ - mouse_urxvt 1015\ - mouse_sgr 1016\ - ] proc query_mode {num_or_name} { if {[string is integer -strict $num_or_name]} { set m $num_or_name @@ -3674,11 +4055,17 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[para]Erase to start of line, leaving cursor position alone. return \033\[1K } + proc vt52erase_sol {} { + return \x1bo + } proc erase_eol {} { #*** !doctools #[call [fun erase_eol]] return \033\[K } + proc vt52erase_eol {} { + return \x1bK + } #see also clear_above clear_below # -- --- --- --- --- @@ -3732,6 +4119,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu proc cursor_pos_extended {} { #includes page e.g ^[[47;3;1R + #(but not on all terminals - some (freebsd?) will report as per 6n e.g ^[[74;3R) return \033\[?6n } @@ -3789,6 +4177,9 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[para]This may not work on terminals which have multiple panes/windows return "\033\]2;$windowtitle\033\\" ;#works for xterm and most derivatives } + proc vt52titleset {windowtitle} { + return \x1bS$windowtitle\r + } #titleget - https://invisible-island.net/xterm/xterm.faq.html#how2_title #no cross-platform ansi-only mechanism ? @@ -4672,8 +5063,14 @@ tcl::namespace::eval punk::ansi::ta { variable re_osc_open {(?:\x1b\]|\u009d).*} - variable standalone_code_map [list \x1bc "" \x1b7 "" \x1b8 "" \x1bM "" \x1bE "" \x1bD "" \x1bH "" \x1b= "" \x1b> "" \x1b#3 "" \x1b#4 "" \x1b#5 "" \x1b#6 "" \x1b#8 ""] - variable re_standalones {(?:\x1bc|\x1b7|\x1b8|\x1bM|\x1bE|\x1bD|\x1bD|\x1bH|\x1b=|\x1b>|\x1b#3|\x1b#4|\x1b#5|\x1b#6|\x1b#8)} + #variable standalone_code_map [list \x1bc "" \x1b7 "" \x1b8 "" \x1bM "" \x1bE "" \x1bD "" \x1bH "" \x1b= "" \x1b> "" \x1b#3 "" \x1b#4 "" \x1b#5 "" \x1b#6 "" \x1b#8 ""] + variable re_standalones {(?:\x1bc|\x1b7|\x1b8|\x1bM|\x1bD|\x1bE|\x1bH|\x1b=|\x1b>|\x1b#3|\x1b#4|\x1b#5|\x1b#6|\x1b#8)} + variable re_standalones_vt52 {(?:\x1bZ)} + + #ESC Y move, ESC b foreground colour + #ESC F - gr-on ESC G - gr-off + variable re_vt52_open {(?:\x1bY|\x1bb|\x1bF)} + #\x1bc vt52 bgcolour conflict ?? #if we don't split on altgraphics too and separate them out - it's easy to get into a horrible mess variable re_g0_group {(?:\x1b\(0)(?:(?!\x1b\(B).)*\x1b\(B} @@ -4686,7 +5083,7 @@ tcl::namespace::eval punk::ansi::ta { #regex to capture the start of string/privacy message/application command block including the contents and string terminator (ST) #non-greedy by exclusion of ST terminators in body - #we need to match \x1b\\ not just \x1b There could be colour codes nested in a privacy msg/string + #we need to match \x1b\\ not just \x1b There could be colour codes nested in a privacy msg/string (not widely supported?) #even if terminals generally don't support that - it's quite possible for an ansi code to get nested this way - and we'd prefer it not to break our splits #Just checking for \x1b will terminate the match too early #we also need to track the start of ST terminated code and not add it for replay (in the ansistring functions) @@ -4705,17 +5102,44 @@ tcl::namespace::eval punk::ansi::ta { #handrafted TRIE version of above. Somewhat difficult to construct and maintain. TODO - find a regexp TRIE generator that works with Tcl regexes #This does make things quicker - but it's too early to finalise the detect/split regexes (e.g missing \U0090 ) - will need to be redone. #variable re_ansi_detect {(?:\x1b(?:\((?:0|B)|\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|c|7|8|M|E|D|H|=|>|(?:#(?:3|4|5|6|8))))|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]|(?:\u009d)(?:[^\u009c]*)?\u009c} - variable re_ansi_detect {(?:\x1b(?:\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|\((?:0|B)|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|c|7|8|M|E|D|H|=|>|(?:#(?:3|4|5|6|8))))|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]|(?:\u009d)(?:[^\u009c]*)?\u009c} + + #NOTE - the literal # char can cause problems in expanded syntax - even though it's within a bracketed section. \# seems to work though. + #vt52 specific |<|A|B|C|I|J|K|L|M|Z|(?:Y(?:..))|(?:b(?:.)| + #https://freemint.github.io/tos.hyp/en/VT_52_terminal.html + #what to with ESC c vs vt52 ESC c (background colour) ??? + #we probably need to use a separate re_ansi_detect for vt52 + + #although it's stated later terminals are backwards compatible with vt52 - that doesn't seem to mean for example a vt100 will process vt52 codes at the same time as ansi codes + #ie - when DECANM is on - VT52 codes are *not* processed + + #todo - ansi mode and cursor key mode set ? + # arrow keys -> ESC O A, ESC O B, ESC O C, ESC O D + # plus more for auxiliary keypad codes in keypad application mode (and some in numeric mode) + + variable re_ansi_detect {(?x) + (?:\x1b(?:\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|c|7|8|M|D|E|H|=|>|<|A|B|C|I|J|K|L|M|Z|(?:Y(?:..))|(?:b(?:.))|\((?:0|B)|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|(?:\#(?:3|4|5|6|8)))) + |(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c) + |(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e] + |(?:\u009d)(?:[^\u009c]*)?\u009c + } + #--- + # -- --- --- --- #variable re_csi_code {(?:\x1b\[|\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]} - variable re_ansi_detect_open "${re_csi_open}|${re_osc_open}|${re_standalones}|${re_ST_open}|${re_g0_open}" + variable re_ansi_detect_open "${re_csi_open}|${re_osc_open}|${re_standalones}|${re_standalones_vt52}|${re_ST_open}|${re_g0_open}|${re_vt52_open}" #may be same as detect - kept in case detect needs to diverge #variable re_ansi_split "${re_csi_code}|${re_esc_osc1}|${re_esc_osc2}|${re_esc_osc3}|${re_standalones}|${re_ST}|${re_g0_open}|${re_g0_close}" set re_ansi_split $re_ansi_detect + variable re_ansi_split_multi + if {[string first (?x) $re_ansi_split] == 0} { + set re_ansi_split_multi "(?x)(?:[string range ${re_ansi_split} 4 end])+" + } else { + set re_ansi_split_multi "(?:${re_ansi_split})+" + } lappend PUNKARGS [list -dynamic 0 { @id -id ::punk::ansi::ta::detect @@ -4922,81 +5346,46 @@ tcl::namespace::eval punk::ansi::ta { # -- --- --- --- --- --- #Split $text to a list containing alternating ANSI colour codes and text. #ANSI colour codes are always on the second element, fourth, and so on. - #(ie plaintext on odd list-indices ansi on even indices) + #(ie plaintext on even list-indices ansi on odd indices) + #result of split on non-empty string always has an odd length - with indices 0 and end always being plaintext (possibly empty string) # Example: - #ta_split_codes "" # => "" - #ta_split_codes "a" # => "a" - #ta_split_codes "a\e[31m" # => {"a" "\e[31m"} - #ta_split_codes "\e[31ma" # => {"" "\e[31m" "a"} - #ta_split_codes "\e[31ma\e[0m" # => {"" "\e[31m" "a" "\e[0m"} - #ta_split_codes "\e[31ma\e[0mb" # => {"" "\e[31m" "a" "\e[0m", "b"} - #ta_split_codes "\e[31m\e[0mb" # => {"" "\e[31m\e[0m" "b"} + #split_codes "" # => "" + #split_codes "a" # => "a" + #split_codes "a\e[31m" # => {"a" "\e[31m" ""} + #split_codes "\e[31ma" # => {"" "\e[31m" "a"} + #split_codes "\e[31ma\e[0m" # => {"" "\e[31m" "a" "\e[0m" ""} + #split_codes "\e[31ma\e[0mb" # => {"" "\e[31m" "a" "\e[0m", "b"} + #split_codes "\e[31m\e[0mb" # => {"" "\e[31m\e[0m" "b"} # proc split_codes {text} { - variable re_ansi_split - set re "(?:${re_ansi_split})+" - return [_perlish_split $re $text] + variable re_ansi_split_multi + return [_perlish_split $re_ansi_split_multi $text] } #micro optimisations on split_codes to avoid function calls and make re var local tend to yield very little benefit (sub uS diff on calls that commonly take 10s/100s of uSeconds) - #like split_codes - but each ansi-escape is split out separately (with empty string of plaintext between codes so odd/even plain ansi still holds) + #like split_codes - but each ansi-escape is split out separately (with empty string of plaintext between codes so even/odd indices for plain ansi still holds) #- the slightly simpler regex than split_codes means that it will be slightly faster than keeping the codes grouped. - proc split_codes_single2 {text} { - variable re_ansi_split - return [_perlish_split $re_ansi_split $text] - } - proc split_codes_single3 {text} { - #copy from re_ansi_split - _perlish_split {(?:\x1b(?:\((?:0|B)|\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|c|7|8|M|E|D|H|=|>|(?:#(?:3|4|5|6|8))))|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]|(?:\u009d)(?:[^\u009c]*)?\u009c} $text - } - proc split_codes_single4 {text} { - if {$text eq ""} { - return {} - } - variable re_ansi_split - set re $re_ansi_split - #variable re_ansi_detect1 - #set re $re_ansi_detect1 - set list [list] - set start 0 - - #set re {(?:\x1b(?:\((?:0|B)|\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|c|7|8|M|E|D|H|=|>|(?:#(?:3|4|5|6|8))))|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]|(?:\u009d)(?:[^\u009c]*)?\u009c} - #We can get $matchEnd < $matchStart; we need to ensure there is an exit condition for non-greedy empty results REVIEW - #while {[regexp -start $start -indices -- {(?:\x1b(?:\((?:0|B)|\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|c|7|8|M|E|D|H|=|>|(?:#(?:3|4|5|6|8))))|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]|(?:\u009d)(?:[^\u009c]*)?\u009c} $text match]} {} - while {[regexp -start $start -indices -- $re $text match]} { - lassign $match matchStart matchEnd - #puts "->start $start ->match $matchStart $matchEnd" - lappend list [tcl::string::range $text $start $matchStart-1] - if {$matchEnd < $matchStart} { - set e $matchStart - incr start - } else { - set e $matchEnd - set start [expr {$matchEnd+1}] - } - lappend list [tcl::string::range $text $matchStart $e] - if {$start >= [tcl::string::length $text]} { - break - } - } - return [lappend list [tcl::string::range $text $start end]] - } proc split_codes_single {text} { if {$text eq ""} { return {} } variable re_ansi_split set next 0 - set b -1 + #set b -1 set list [list] set coderanges [regexp -indices -all -inline -- $re_ansi_split $text] foreach cr $coderanges { lappend list [tcl::string::range $text $next [lindex $cr 0]-1] [tcl::string::range $text [lindex $cr 0] [lindex $cr 1]] set next [expr {[lindex $cr 1]+1}] + #set next [lindex $cr 1]+1 ;#text index-expression for string range } lappend list [tcl::string::range $text $next end] return $list } + proc split_codes_single2 {text} { + variable re_ansi_split + return [_perlish_split $re_ansi_split $text] + } proc get_codes_single {text} { variable re_ansi_split regexp -all -inline -- $re_ansi_split $text @@ -5008,7 +5397,7 @@ tcl::namespace::eval punk::ansi::ta { return {} } set next 0 - set b -1 + #set b -1 set list [list] set coderanges [regexp -indices -all -inline -- $re $text] foreach cr $coderanges { @@ -5103,29 +5492,6 @@ tcl::namespace::eval punk::ansi::ta { #return [lappend list [tcl::string::range $text $start end]] yield [tcl::string::range $text $start end] } - proc _perlish_split2 {re text} { - if {[tcl::string::length $text] == 0} { - return {} - } - set list [list] - set start 0 - #We can get $matchEnd < $matchStart; we need to ensure there is an exit condition for non-greedy empty results REVIEW - while {[regexp -start $start -indices -- $re $text match]} { - lassign $match matchStart matchEnd - #puts "->start $start ->match $matchStart $matchEnd" - if {$matchEnd < $matchStart} { - lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::index $text $matchStart] - incr start - } else { - lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::range $text $matchStart $matchEnd] - set start [expr {$matchEnd+1}] - } - if {$start >= [tcl::string::length $text]} { - break - } - } - return [lappend list [tcl::string::range $text $start end]] - } proc _ws_split {text} { regexp -all -inline {(?:\S+)|(?:\s+)} $text } @@ -7429,12 +7795,10 @@ tcl::namespace::eval punk::ansi::internal { #todo - document interp alias {} ansistring {} ::punk::ansi::ansistring -if {![info exists ::punk::args::register::NAMESPACES]} { - namespace eval ::punk::args::register { - set NAMESPACES [list] - } +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::ansi ::punk::ansi::class ::punk::ansi::ta } -lappend ::punk::args::register::NAMESPACES ::punk::ansi ::punk::ansi::class ::punk::ansi::ta # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.1.0.tm index 37f8b712..e940dada 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.1.0.tm @@ -226,15 +226,26 @@ tcl::namespace::eval punk::args::register { #[para] The punk::args package will then test for a public list variable ::PUNKARGS containing argument definitions when it needs to. #[list_begin definitions] + #Although the actual punk::args::define calls are not too sluggish, there could be *many*. + #in a multi-interp environment, we want to be lazy about loading argdefs until they're actually required, + #especially since a fair proportion may be for documentation purposes rather than parsing args. + # -- --- --- --- --- --- --- --- - #cooperative with packages that define some punk args but may need to do so lazily - #These could be loaded prior to punk::args being loaded - variable NAMESPACES + #cooperative with packages that define some punk args but do so lazily + #These could be loaded prior to punk::args being loaded - so check existence of NAMESPACES var first + variable NAMESPACES ;#just declaring it with variable doesn't yet mean it 'exists' from 'info exists' perspective if {![info exists ::punk::args::register::NAMESPACES]} { - set NAMESPACES [list] + set ::punk::args::register::NAMESPACES [list] } # -- --- --- --- --- --- --- --- + variable loaded_packages [list] ;#fully loaded + variable loaded_info [dict create] ;#time + variable scanned_packages [list] ;#packages scanned for ids used to update namespace_docpackages + variable scanned_info [dict create] ;#time and idcount + #some packages, e.g punk::args::tclcore document other namespaces. + #when punk::args::update_definitions gets a query for a namespace - we need to load argdefs from registered sources + variable namespace_docpackages [dict create] #*** !doctools #[list_end] [comment {--- end definitions namespace punk::args::register ---}] @@ -250,14 +261,15 @@ tcl::namespace::eval punk::args { variable PUNKARGS ;#list of our own punk::args function argument definitions - loaded with punk::args::define at the end. tcl::namespace::export {[a-z]*} - variable argdata_cache - variable argdefcache_by_id - variable argdefcache_unresolved ;#key = original template list supplied to 'define', value = 2-element list: (tstr-parsed split of template) & (unresolved params) - variable id_counter - set argdata_cache [tcl::dict::create] - set argdefcache_by_id [tcl::dict::create] - set argdefcache_unresolved [tcl::dict::create] - set id_counter 0 + variable rawdef_cache [tcl::dict::create] ;#key on rawdef list - return dict of {-id -dynamic 0|1} + variable id_cache_rawdef [tcl::dict::create] + variable id_cache_spec [tcl::dict::create] + + variable argdefcache_unresolved [tcl::dict::create] ;#key = original template list supplied to 'define', value = 2-element list: (tstr-parsed split of template) & (unresolved params) + + variable argdata_cache [tcl::dict::create] + + variable id_counter 0 #*** !doctools #[subsection {Namespace punk::args}] @@ -321,22 +333,22 @@ tcl::namespace::eval punk::args { %B%@id%N% ?opt val...? options: -id %B%@cmd%N% ?opt val...? - options -name -help + options: -name -help %B%@leaders%N% ?opt val...? - options -min -max + options: -min -max (used for leading args that come before switches/opts) %B%@opts%N% ?opt val...? - options -any + options: -any %B%@values%N% ?opt val...? - options -min -max + options: -min -max (used for trailing args that come after switches/opts) %B%@argdisplay%N% ?opt val...? - options -header (text for header row of table) + options: -header (text for header row of table) -body (text to replace autogenerated arg info) %B%@doc%N% ?opt val...? - options -name -url + options: -name -url %B%@seealso%N% ?opt val...? - options -name -url (for footer - unimplemented) + options: -name -url (for footer - unimplemented) Some other options normally present on custom arguments are available to use with the @leaders @opts @values directives to set defaults @@ -418,6 +430,15 @@ tcl::namespace::eval punk::args { streaming and checksumming. The -choices list is equivalent to a -choicegroups dict entry where the key (groupname) is the empty string. + -choicemultiple (default {1 1}) + is a pair representing min and max number of choices + that can be present in the value. + If is a single integer it is equivalent to a + specified with the same integer for both min and max. + Max of -1 represents no upper limit. + If allows more than one choice the value is a list + consisting of items in the choices made available through + entries in -choices/-choicegrups. -minsize (type dependant) -maxsize (type dependant) -range (type dependant) @@ -425,27 +446,27 @@ tcl::namespace::eval punk::args { " -dynamic -type boolean -default 0 -help\ - "If -dynamic is true, tstr interpolations of the form \$\{\$var\} - are re-evaluated on each call. - If the definition is being used not just as documentation, but is also - used within the function to parse args, e.g using punk::args::get_by_id, - then it should be noted that there is a slight performance penalty for the - dynamic case. - It is often not significant, perhaps depending on what vars/commands are - used but -dynamic true might be less desirable if the command is used in - inner loops in more performance-sensitive code. + "If -dynamic is true, tstr interpolations of the form \$\{\$var\} + are re-evaluated on each call. + If the definition is being used not just as documentation, but is also + used within the function to parse args, e.g using punk::args::get_by_id, + then it should be noted that there is a slight performance penalty for the + dynamic case. + It is often not significant, perhaps depending on what vars/commands are + used but -dynamic true might be less desirable if the command is used in + inner loops in more performance-sensitive code. " @values -min 1 -max -1 text -type string -multiple 1 -help\ - "Block(s) of text representing the argument definition for a command. - At least one must be supplied. If multiple, they are joined together with \\n. - Using multiple text arguments may be useful to mix curly-braced and double-quoted - strings to have finer control over interpolation when defining arguments. - (this can also be handy for sections that pull resolved definition lines - from existing definitions (by id) for re-use of argument specifications and help text) - - e.g the following definition passes 2 blocks as text arguments - definition { + "Block(s) of text representing the argument definition for a command. + At least one must be supplied. If multiple, they are joined together with \\n. + Using multiple text arguments may be useful to mix curly-braced and double-quoted + strings to have finer control over interpolation when defining arguments. + (this can also be handy for sections that pull resolved definition lines + from existing definitions (by id) for re-use of argument specifications and help text) + + e.g the following definition passes 2 blocks as text arguments + definition { @id -id ::myns::myfunc @cmd -name myns::myfunc -help\\ \"Description of command\" @@ -454,13 +475,18 @@ tcl::namespace::eval punk::args { -option1 -default blah -type string #The following option defines a flag style option (solo) -flag1 -default 0 -type none -help\\ - \"Info about flag1\" + \"Info about flag1 + subsequent help lines auto-dedented by whitespace to left + of corresponding record start (in this case -flag1) + + first 4 spaces if they are all present. + This line has no extra indent relative to first line 'Info about flag1' + This line indented a further 6 chars\" @values -min 1 -max -1 #Items that don't begin with * or - are value definitions v1 -type integer -default 0 thinglist -type string -multiple 1 - } \"*doc -name Manpage: -url \[myfunc_manpage_geturl myns::myfunc]\" + } \"*doc -name Manpage: -url \[myfunc_manpage_geturl myns::myfunc]\" " }]] @@ -475,6 +501,7 @@ tcl::namespace::eval punk::args { -nocase 0\ -choiceprefix 1\ -choicerestricted 1\ + -choicemultiple {1 1}\ -multiple 0\ -regexprepass {}\ -validationtransform {}\ @@ -488,6 +515,7 @@ tcl::namespace::eval punk::args { -nocase 0\ -choiceprefix 1\ -choicerestricted 1\ + -choicemultiple {1 1}\ -multiple 0\ -regexprepass {}\ -validationtransform {}\ @@ -501,6 +529,7 @@ tcl::namespace::eval punk::args { -nocase 0\ -choiceprefix 1\ -choicerestricted 1\ + -choicemultiple {1 1}\ -multiple 0\ -regexprepass {}\ -validationtransform {}\ @@ -569,8 +598,23 @@ tcl::namespace::eval punk::args { #] } proc define {args} { + dict get [resolve {*}$args] id + } + proc resolve {args} { + variable rawdef_cache + variable id_cache_rawdef + if {[dict exists $rawdef_cache $args]} { + set id [dict get $rawdef_cache $args -id] + set is_dynamic [dict get $rawdef_cache $args -dynamic] + } else { + set id [rawdef_id $args] + set is_dynamic [rawdef_is_dynamic $args] + dict set rawdef_cache $args [dict create -id $id -dynamic $is_dynamic] + dict set id_cache_rawdef $id $args + } + + variable argdata_cache - variable argdefcache_by_id variable argdefcache_unresolved @@ -592,7 +636,6 @@ tcl::namespace::eval punk::args { punk::args::get_by_id ::punk::args::define {} return } - set is_dynamic 0 if {[lindex $args 0] eq "-dynamic"} { set is_dynamic [lindex $args 1] set textargs [lrange $args 2 end] @@ -699,14 +742,18 @@ tcl::namespace::eval punk::args { if {![tcl::info::complete $test_complete]} { #append linebuild [string trimleft $rawline] \n if {$in_record} { - if {[tcl::string::length $lastindent]} { - #trim only the whitespace corresponding to last indent - not all whitespace on left - if {[tcl::string::first $lastindent $rawline] == 0} { - set trimmedline [tcl::string::range $rawline [tcl::string::length $lastindent] end] - append linebuild $trimmedline \n - } else { - append linebuild $rawline \n - } + #trim only the whitespace corresponding to last record indent or lastindent + 4 spaces - not all whitespace on left + #this allows alignment of multiline help strings to left margin whilst maintaining a visual indent in source form. + #Aligning subsequent lines with the record, or aligning 4 spaces in are equivalent. + #ie to indent lines further - whitespace should be added 4+ columns in from the record-line start position. + #(this leaves an oddity if indenting is only 1 2 or 3 spaces mixed with longer indents as we don't check for it.. REVIEW) + #(note string first "" $str is fast and returns -1) + if {[tcl::string::first "$lastindent " $rawline] == 0} { + set trimmedline [tcl::string::range $rawline [tcl::string::length "$lastindent "] end] + append linebuild $trimmedline \n + } elseif {[tcl::string::first $lastindent $rawline] == 0} { + set trimmedline [tcl::string::range $rawline [tcl::string::length $lastindent] end] + append linebuild $trimmedline \n } else { append linebuild $rawline \n } @@ -719,14 +766,13 @@ tcl::namespace::eval punk::args { } } else { set in_record 0 - if {[tcl::string::length $lastindent]} { - #trim only the whitespace corresponding to last indent - not all whitespace on left - if {[tcl::string::first $lastindent $rawline] == 0} { - set trimmedline [tcl::string::range $rawline [tcl::string::length $lastindent] end] - append linebuild $trimmedline - } else { - append linebuild $rawline - } + #trim only the whitespace corresponding to last record indent or lastindent + 4 spaces - not all whitespace on left + if {[tcl::string::first "$lastindent " $rawline] == 0} { + set trimmedline [tcl::string::range $rawline [tcl::string::length "$lastindent "] end] + append linebuild $trimmedline + } elseif {[tcl::string::first $lastindent $rawline] == 0} { + set trimmedline [tcl::string::range $rawline [tcl::string::length $lastindent] end] + append linebuild $trimmedline } else { append linebuild $rawline } @@ -734,10 +780,13 @@ tcl::namespace::eval punk::args { set linebuild "" } } - set cmd_info {} - set id_info {} ;#e.g -children ?? - set doc_info {} + set cmd_info {} + set package_info {} + set id_info {} ;#e.g -children ?? + set doc_info {} set argdisplay_info {} ;#optional override of autogenerated 'Arg Type Default Multi Help' table + set seealso_info {} + set keywords_info {} ###set leader_min 0 ###set leader_max 0 ;#default 0 but if leader_min is set switches to -1 for no limit #set leader_max "" @@ -745,7 +794,7 @@ tcl::namespace::eval punk::args { set opt_any 0 set val_min 0 set val_max -1 ;#-1 for no limit - set DEF_definition_id "" + set DEF_definition_id $id #form_defs set F [dict create _default [New_command_form _default]] @@ -840,20 +889,26 @@ tcl::namespace::eval punk::args { set at_specs $record_values switch -- [tcl::string::range $directive_name 1 end] { + dynamic { + set is_dynamic 1 + } id { + #disallow duplicate @id line ? + #review - nothing to stop multiple @id lines - or redefining as auto (which is ignored?) + #id An id will be allocated if no id line present or the -id value is "auto" - if {$DEF_definition_id ne ""} { - #disallow duplicate @id line - error "punk::args::define - @id already set. Existing value $DEF_definition_id\n[join $args \n]" - } + if {[dict exists $at_specs -id]} { - set DEF_definition_id [dict get $at_specs -id] - } else { - set DEF_definition_id auto + set thisid [dict get $at_specs -id] + if {$thisid ni [list $id auto]} { + error "punk::args::define @id mismatch existing: $id vs $thisid" + } } set id_info $at_specs } ref { + #a reference within the definition + #e.g see punk::args::tclcore ::after #global reference dict - independent of forms #ignore refs without an -id #store all keys except -id @@ -867,10 +922,10 @@ tcl::namespace::eval punk::args { #(if we were to take from a definition - we would have to check and maybe change this def to -dynamic.. ?) #perhaps we could allow -dynamic as a flag here - but IFF this define is already -dynamic (?) #That is possibly too complicated and/or unnecessary? - #however.. as it stands we have define -dynamic 1 making *immediate* resolutions .. is that really desirable? + #however.. as it stands we have define @dynamic making *immediate* resolutions .. is that really desirable? if {[dict exists $at_specs -id]} { - set copyfrom [get_def [dict get $at_specs -id]] + set copyfrom [get_spec [dict get $at_specs -id]] #we don't copy the @id info from the source #for now we only copy across if nothing set.. #todo - bring across defaults for empty keys at targets? @@ -942,6 +997,9 @@ tcl::namespace::eval punk::args { } #new form keys already created if they were needed (done for all records that have -form ) } + package { + set package_info [dict merge $package_info $at_specs] + } cmd { #allow arbitrary - review set cmd_info [dict merge $cmd_info $at_specs] @@ -968,7 +1026,7 @@ tcl::namespace::eval punk::args { -anyopts { set opt_any $v } - -minsize - -maxsize - -range - -choices - -choicegroups - -choicecolumns - -choicelabels - -choiceinfo - -choiceprefix - -choiceprefixdenylist - -choicerestricted { + -minsize - -maxsize - -range - -choices - -choicegroups - -choicemultiple - -choicecolumns - -choicelabels - -choiceinfo - -choiceprefix - -choiceprefixdenylist - -choicerestricted { #review - only apply to certain types? tcl::dict::set tmp_optspec_defaults $k $v } @@ -1014,7 +1072,7 @@ tcl::namespace::eval punk::args { tcl::dict::set tmp_optspec_defaults $k $v } default { - set known { -any -anyopts -minsize -maxsize -range -choices -choicegroups -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted -nocase\ + set known { -any -anyopts -minsize -maxsize -range -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted -nocase\ -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ -regexprepass -regexprefail -regexprefailmsg -validationtransform\ @@ -1052,10 +1110,16 @@ tcl::namespace::eval punk::args { } dict set F $fid LEADER_MAX $v } - -minsize - -maxsize - -range - -choices - -choicegroups - -choicecolumns - -choicelabels - -choiceinfo - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -nocase { + -minsize - -maxsize - -range - -choices - -choicegroups - -choicemultiple - -choicecolumns - -choicelabels - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -nocase { #review - only apply to certain types? tcl::dict::set tmp_leaderspec_defaults $k $v } + -choiceinfo { + if {[llength $v] %2 != 0} { + error "punk::args::define - key '-choiceinfo' requires a dictionary value as an argument. got $v id:$DEF_definition_id" + } + tcl::dict::set tmp_leaderspec_defaults $k $v + } -nominsize - -nomaxsize - -norange - -nochoices - -nochoicelabels { #-choicegroups? if {$v} { @@ -1100,7 +1164,7 @@ tcl::namespace::eval punk::args { default { set known { -min -minvalues -max -maxvalues\ -minsize -maxsize -range\ - -choices -choicegroups -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted\ + -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted\ -nocase -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ -regexprepass -regexprefail -regexprefailmsg -validationtransform\ @@ -1138,12 +1202,18 @@ tcl::namespace::eval punk::args { } set val_max $v } - -minsize - -maxsize - -range - -choices - -choicegroups - -choicecolumns - -choicelabels - -choiceinfo - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -nocase { + -minsize - -maxsize - -range - -choices - -choicemultiple - -choicecolumns - -choicelabels - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -nocase { #review - only apply to certain types? tcl::dict::set tmp_valspec_defaults $k $v } + -choiceinfo - -choicegroups { + if {[llength $v] % 2 != 0} { + error "punk::args::define - key '$k' requires a dictionary value as an argument. got $v id:$DEF_definition_id" + } + tcl::dict::set tmp_valspec_defaults $k $v + } -nominsize - -nomaxsize - -norange - -nochoices - -nochoicelabels { - # -choicegoups ?? + # -choicegroups ?? if {$v} { set k2 -[string range $k 3 end] ;#strip 'no' tcl::dict::unset tmp_valspec_defaults $k2 @@ -1186,7 +1256,7 @@ tcl::namespace::eval punk::args { default { set known { -min -minvalues -max -maxvalues\ -minsize -maxsize -range\ - -choices -choicegroups -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted\ + -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted\ -nocase\ -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ @@ -1203,6 +1273,11 @@ tcl::namespace::eval punk::args { seealso { #todo! #like @doc, except displays in footer, multiple - sub-table? + set seealso_info [dict merge $seealso_info $at_specs] + } + keywords { + #review - put as option on @cmd instead? @cmd -name xxx -keywords {blah etc hmm} ?? + set keywords_info [dict merge $keywords_info $at_specs] } default { error "punk::args::define - unrecognised @ line in '$rec'. Expected @id @cmd @form... @leaders @opts @values @doc @argdisplay - use @@name if paramname needs to be @name @id:$DEF_definition_id" @@ -1331,7 +1406,7 @@ tcl::namespace::eval punk::args { } } -default - -solo - -range - - -choices - -choicegroups - -choicecolumns - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -choicelabels - -choiceinfo - + -choices - -choicegroups - -choicemultiple - -choicecolumns - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -choicelabels - -choiceinfo - -minsize - -maxsize - -nocase - -optional - -multiple - -validate_ansistripped - -allow_ansi - -strip_ansi - -help - -ARGTYPE - -regexprepass - -regexprefail - -regexprefailmsg @@ -1376,7 +1451,7 @@ tcl::namespace::eval punk::args { } } } else { - set known_argopts [list -form -default -type -range -minsize -maxsize -choices -choicegroups -choicecolumns -choiceprefix -choiceprefixdenylist -choicerestricted\ + set known_argopts [list -form -default -type -range -minsize -maxsize -choices -choicegroups -choicemultiple -choicecolumns -choiceprefix -choiceprefixdenylist -choicerestricted\ -nocase -optional -multiple -validate_ansistripped -allow_ansi -strip_ansi -help\ -regexprepass -regexprefail -regexprefailmsg -validationtransform\ ] @@ -1426,10 +1501,10 @@ tcl::namespace::eval punk::args { } ;# end foreach rec $records - if {$DEF_definition_id eq "" || [tcl::string::tolower $DEF_definition_id] eq "auto"} { - variable id_counter - set DEF_definition_id "autoid_[incr id_counter]" - } + #if {$DEF_definition_id eq "" || [tcl::string::tolower $DEF_definition_id] eq "auto"} { + # variable id_counter + # set DEF_definition_id "autoid_[incr id_counter]" + #} #check ALL forms not just form_ids_active (record_form_ids) @@ -1521,9 +1596,11 @@ tcl::namespace::eval punk::args { VAL_CHECKS_DEFAULTS [dict get $F $firstformid VAL_CHECKS_DEFAULTS]\ cmd_info $cmd_info\ doc_info $doc_info\ + package_info $package_info\ argdisplay_info $argdisplay_info\ + seealso_info $seealso_info\ id_info $id_info\ - temp_F $F\ + FORMS $F\ form_names [dict keys $F]\ FORM_INFO $form_info\ ] @@ -1533,42 +1610,75 @@ tcl::namespace::eval punk::args { #also cache resolved version tcl::dict::set argdata_cache $optionspecs $argdata_dict } - #tcl::dict::set argdefcache_by_id $DEF_definition_id $optionspecs - tcl::dict::set argdefcache_by_id $DEF_definition_id $args + + #tcl::dict::set id_cache_rawdef $DEF_definition_id $args #puts "xxx:$result" return $argdata_dict } #return raw definition list as created with 'define' - proc rawdef {id} { - variable argdefcache_by_id + # - possibly with unresolved dynamic parts + proc raw_def {id} { + variable id_cache_rawdef set realid [real_id $id] - #return the raw definition - possibly with unresolved dynamic parts - if {![dict exists $argdefcache_by_id $realid]} { + if {![dict exists $id_cache_rawdef $realid]} { return "" } - return [tcl::dict::get $argdefcache_by_id $realid] + return [tcl::dict::get $id_cache_rawdef $realid] } namespace eval argdoc { - variable resolved_def_TYPE_CHOICES {* @id @cmd @leaders @opts @values @doc} + variable resolved_def_TYPE_CHOICES {* @id @package @cmd @ref @doc @argdisplay @seealso @leaders @opts @values leaders opts values} + variable resolved_def_TYPE_CHOICEGROUPS { + directives {@id @package @cmd @ref @doc @argdisplay @seealso} + argumenttypes {leaders opts values} + remaining_defaults {@leaders @opts @values} + } - lappend PUNKARGS [list -dynamic 0 [string map [list %TYPECHOICES% $resolved_def_TYPE_CHOICES] { + lappend PUNKARGS [list [string map [list %TYPECHOICES% $resolved_def_TYPE_CHOICES %TYPECHOICEGROUPS% $resolved_def_TYPE_CHOICEGROUPS] { @id -id ::punk::args::resolved_def @cmd -name punk::args::resolved_def -help\ - "" + "Resolves or retrieves the previously resolved definition and + uses the 'spec' form to build a response in definition format. + + Pulling argument definition data from another function is a form + of tight coupling to the other function that should be done with + care. + + Note that the directives @leaders @opts @values may appear multiple + times in a source definition - applying defaults for arguments that + follow. When retrieving these - there is only a single result for + each that represents the defaults after all have been applied. + When retrieving -types * each of these will be positioned before + the arguments of that type - but this doesn't mean there was a single + leading directive for this argument type in the source definition. + Each argument has already had its complete specification recorded in + its own result. + + When manually specifying -types, the order @leaders then @opts then + @values must be maintained - but if they are placed before their + corresponding arguments, they will not affect the retrieved arguments + as these arguments are already fully spec'd. The defaults from the + source can be removed by adding @leaders, @opts @values to the + -antiglobs list, but again - this won't affect the existing arguments. + Each argument can have members of its spec overridden using the + -override dictionary. + " @leaders -min 0 -max 0 @opts -form -default 0 -help\ - "UNIMPLEMENTED - Ordinal index or name of command form" - -type -default * -choices {%TYPECHOICES%} -choiceprefix 0 -multiple 1 + "Ordinal index or name of command form" + + #no restriction on number of types/repetitions? + -types -default * -choices {%TYPECHOICES%} -choicegroups {%TYPECHOICEGROUPS%} -choiceprefix 0 -choicemultiple {0 -1} + -antiglobs -default {} -type list -help\ + "Glob patterns for directive or argument/flags to + be suppressed" -override -type dict -optional 1 -default "" -help\ "dict of dicts. Key in outer dict is the name of a directive or an argument. Inner dict is a map of overrides/additions (- ...) for that line. - (unimplemented). " @values -min 1 -max -1 id -type string -help\ @@ -1597,23 +1707,24 @@ tcl::namespace::eval punk::args { proc resolved_def {args} { set opts [dict create\ - -type {}\ + -types {}\ -form 0\ + -antiglobs {}\ -override {}\ ] if {[llength $args] < 1} { #must have at least id - punk::args::get_by_id ::punk::args::resolved_def $args + punk::args::parse $args withid ::punk::args::resolved_def return } set patterns [list] - #a definition id must not begin with "-" + #a definition id must not begin with "-" ??? review for {set i 0} {$i < [llength $args]} {incr i} { set a [lindex $args $i] - if {$a eq "-type"} { + if {$a in {-type -types}} { incr i - dict lappend opts -type [lindex $args $i] + dict set opts -types [lindex $args $i] } elseif {[string match -* $a]} { incr i dict set opts $a [lindex $args $i] @@ -1623,7 +1734,7 @@ tcl::namespace::eval punk::args { break } if {$i == [llength $args]-1} { - punk::args::get_by_id ::punk::args::resolved_def $args + punk::args::parse $args withid ::punk::args::resolved_def return } } @@ -1632,47 +1743,121 @@ tcl::namespace::eval punk::args { } dict for {k v} $opts { switch -- $k { - -form - -type - -override {} + -form - -types - -antiglobs - -override {} default { - punk::args::get_by_id ::punk::args::resolved_def $args + punk::args::parse $args withid ::punk::args::resolved_def return } } } - set typelist [dict get $opts -type] + set typelist [dict get $opts -types] if {[llength $typelist] == 0} { set typelist {*} } foreach type $typelist { if {$type ni $::punk::args::argdoc::resolved_def_TYPE_CHOICES} { - punk::args::get_by_id ::punk::args::resolved_def $args + punk::args::parse $args withid ::punk::args::resolved_def return } } - variable argdefcache_by_id + + variable id_cache_rawdef set realid [real_id $id] if {$realid ne ""} { - set deflist [tcl::dict::get $argdefcache_by_id $realid] + set deflist [tcl::dict::get $id_cache_rawdef $realid] set result "" - set specdict [uplevel 1 [list ::punk::args::define {*}$deflist]] - set arg_info [dict get $specdict ARG_INFO] - set argtypes [dict create @opts option @leaders leader @values value] + set specdict [uplevel 1 [list ::punk::args::resolve {*}$deflist]] + + set opt_form [dict get $opts -form] + if {[string is integer -strict $opt_form]} { + set formname [lindex [dict get $specdict form_names] $opt_form] + } else { + set formname $opt_form + } + set opt_override [dict get $opts -override] + + #set arg_info [dict get $specdict ARG_INFO] + set arg_info [dict get $specdict FORMS $formname ARG_INFO] + set argtypes [dict create leaders leader opts option values value] + + set opt_antiglobs [dict get $opts -antiglobs] + set directives [lsearch -all -inline -exact -not $::punk::args::argdoc::resolved_def_TYPE_CHOICES *] + set suppressed_directives [list] + set suppressed_args [list] + foreach ag $opt_antiglobs { + foreach d $directives { + if {[string match $ag $d]} { + lappend suppressed_directives $d + } + } + foreach argname [dict keys $arg_info] { + if {[string match $ag $argname]} { + lappend suppressed_args $argname + } + } + } + set suppressed_directives [lsort -unique $suppressed_directives] + set suppressed_args [lsort -unique $suppressed_args] + + set included_directives [punk::args::system::punklib_ldiff $directives $suppressed_directives] + + set globbed [list] + foreach pat $patterns { + set matches [dict keys $arg_info $pat] + lappend globbed {*}$matches + } + set globbed [lsort -unique $globbed] + set included_args [punk::args::system::punklib_ldiff $globbed $suppressed_args] + foreach type $typelist { switch -exact -- $type { * { - append result \n "@id -id [dict get $specdict id]" - append result \n "@cmd [dict get $specdict cmd_info]" - append result \n "@doc [dict get $specdict doc_info]" - foreach tp {leader option value} { - foreach pat $patterns { - set matches [dict keys $arg_info $pat] - foreach m $matches { - set def [dict get $arg_info $m] - if {[dict get $def -ARGTYPE] eq $tp} { - set def [dict remove $def -ARGTYPE] - append result \n "$m $def" + if {"@id" in $included_directives} { + if {[dict exists $opt_override @id]} { + append result \n "@id [dict merge [dict create -id [dict get $specdict id]] [dict get $opt_override @id]]" + } else { + append result \n "@id -id [dict get $specdict id]" + } + } + foreach directive {@package @cmd @doc @seealso @argdisplay} { + set dshort [string range $directive 1 end] + if {"$directive" in $included_directives} { + if {[dict exists $opt_override $directive]} { + append result \n "$directive [dict merge [dict get $specdict ${dshort}_info] [dict get $opt_override $directive]]" + } else { + append result \n "$directive [dict get $specdict ${dshort}_info]" + } + } + } + #output ordered by leader, option, value + foreach pseudodirective {leaders opts values} tp {leader option value} { + set directive "@$pseudodirective" + switch -- $directive { + @leaders {set defaults_key leaderspec_defaults} + @opts {set defaults_key optspec_defaults} + @values {set defaults_key valspec_defaults} + } + + if {"$directive" in $included_directives} { + if {[dict exists $opt_override "$directive"]} { + append result \n "$directive [dict merge [dict get $specdict $defaults_key] [dict get $opt_override $directive]]" + } else { + append result \n "$directive [dict get $specdict $defaults_key]" + } + } + + if {$pseudodirective in $included_directives} { + foreach m $included_args { + set argspec [dict get $arg_info $m] + if {[dict get $argspec -ARGTYPE] eq $tp} { + set argspec [dict remove $argspec -ARGTYPE] + if {[dict exists $opt_override $m]} { + append result \n "$m [dict merge $argspec [dict get $opt_override $m]]" + } else { + append result \n "$m $argspec" + } } } } @@ -1680,27 +1865,52 @@ tcl::namespace::eval punk::args { } @id { - #only a single id record can exist - append result \n "@id -id [dict get $specdict id]" - } - @cmd { - #only a single @cmd record can exist - #merged if multiple in original def (?) - append result \n "@cmd [dict get $specdict cmd_info]" + if {"@id" in $included_directives} { + #only a single id record can exist + if {[dict exists $opt_override @id]} { + append result \n "@id [dict merge [dict create -id [dict get $specdict id]] [dict get $opt_override @id]]" + } else { + append result \n "@id -id [dict get $specdict id]" + } + } } - @doc { - #only a single @doc record can exist - append result \n "@doc [dict get $specdict doc_info]" + @package - @cmd - @doc - @seealso - @argdisplay { + if {"$type" in $included_directives} { + set tp [string range $type 1 end] ;# @package -> package + if {[dict exists $opt_override $type]} { + append result \n "$type [dict merge [dict get $specdict ${tp}_info] [dict get $opt_override $type]]" + } else { + append result \n "$type [dict get $specdict ${tp}_info]" + } + } } @leaders - @opts - @values { - #option, - foreach pat $patterns { - set matches [dict keys $arg_info $pat] - foreach m $matches { - set def [dict get $arg_info $m] - if {[dict get $def -ARGTYPE] eq [dict get $argtypes $type]} { - set def [dict remove $def -ARGTYPE] - append result \n "$m $def" + #these are the active defaults for further arguments + if {"$type" in $included_directives} { + switch -- $type { + @leaders {set defaults_key leaderspec_defaults} + @opts {set defaults_key optspec_defaults} + @values {set defaults_key valspec_defaults} + } + if {[dict exists $opt_override $type]} { + append result \n "$type [dict merge [dict get $specdict leaderspec_defaults] [dict get $opt_override $type]]" + } else { + append result \n "$type [dict get $specdict leaderspec_defaults]" + } + } + } + leaders - opts - values { + #pseudo-directives + if {$type in $included_directives} { + foreach m $included_args { + set argspec [dict get $arg_info $m] + if {[dict get $argspec -ARGTYPE] eq [dict get $argtypes $type]} { + set argspec [dict remove $argspec -ARGTYPE] + if {[dict exists $opt_override $m]} { + append result \n "$m [dict merge $argspec [dict get $opt_override $m]]" + } else { + append result \n "$m $argspec" + } } } } @@ -1714,12 +1924,12 @@ tcl::namespace::eval punk::args { } } - proc get_spec_values {id {patternlist *}} { - variable argdefcache_by_id + proc resolved_def_values {id {patternlist *}} { + variable id_cache_rawdef set realid [real_id $id] if {$realid ne ""} { - set speclist [tcl::dict::get $argdefcache_by_id $realid] - set specdict [define {*}$speclist] + set speclist [tcl::dict::get $id_cache_rawdef $realid] + set specdict [resolve {*}$speclist] set arg_info [dict get $specdict ARG_INFO] set valnames [dict get $specdict VAL_NAMES] set result "" @@ -1744,18 +1954,69 @@ tcl::namespace::eval punk::args { } } } - #proc get_spec_leaders ?? - #proc get_spec_opts ?? + #proc resolved_def_leaders ?? + #proc resolved_def_opts ?? - proc get_def {id} { - return [define {*}[rawdef $id]] + proc get_spec {id} { + set rdef [raw_def $id] + if {$rdef eq ""} {return} + return [resolve {*}$rdef] #if {[id_exists $id]} { - # return [define {*}[rawdef $id]] + # return [resolve {*}[raw_def $id]] #} } proc is_dynamic {id} { - set deflist [rawdef $id] - return [expr {[lindex $deflist 0] eq "-dynamic" && [lindex $deflist 1]} ] + variable id_cache_rawdef + variable rawdef_cache + set deflist [raw_def $id] + if {[dict exists $rawdef_cache $deflist -dynamic]} { + return [dict get $rawdef_cache $deflist -dynamic] + } + return [rawdef_is_dynamic $deflist] + #@dynamic only has meaning as 1st element of a def in the deflist + } + + #@id must be within first 4 lines of a block - or assign auto + #review - @dynamic block where -id not explicitly set? - disallow? + proc rawdef_id {rawdef} { + set id "" + foreach d $rawdef { + foreach ln [lrange [split $d \n] 0 4] { + if {[regexp {\s*(\S+)(.*)} $ln _match firstword rest]} { + if {$firstword eq "@id"} { + if {[llength $rest] %2 == 0 && [dict exists $rest -id]} { + set id [dict get $rest -id] + break + } + } + } + } + if {$id ne ""} { + break + } + } + if {$id eq "" || [string tolower $id] eq "auto"} { + variable id_counter + set id "autoid_[incr id_counter]" + } + #puts "==>id: $id" + return $id + } + #test the rawdef for @dynamic directive + proc rawdef_is_dynamic {rawdef} { + #temporary - old way + set flagged_dynamic [expr {[lindex $rawdef 0] eq "-dynamic" && [lindex $rawdef 1]} ] + if {$flagged_dynamic} { + return true + } + foreach d $rawdef { + if {[regexp {\s*(\S+)} $d _match firstword]} { + if {$firstword eq "@dynamic"} { + return true + } + } + } + return false } variable aliases @@ -1770,19 +2031,19 @@ tcl::namespace::eval punk::args { "exact id or glob pattern for ids" }] proc get_ids {{match *}} { - variable argdefcache_by_id + variable id_cache_rawdef variable aliases - return [list {*}[tcl::dict::keys $aliases $match] {*}[tcl::dict::keys $argdefcache_by_id $match]] + return [list {*}[tcl::dict::keys $aliases $match] {*}[tcl::dict::keys $id_cache_rawdef $match]] } #we don't automatically test for (autodef)$id - only direct ids and aliases proc id_exists {id} { - variable argdefcache_by_id variable aliases if {[tcl::dict::exists $aliases $id]} { return 1 } - tcl::dict::exists $argdefcache_by_id $id + variable id_cache_rawdef + tcl::dict::exists $id_cache_rawdef $id } proc set_alias {alias id} { variable aliases @@ -1800,16 +2061,18 @@ tcl::namespace::eval punk::args { } proc real_id {id} { - variable argdefcache_by_id + variable id_cache_rawdef variable aliases if {[tcl::dict::exists $aliases $id]} { set id [tcl::dict::get $aliases $id] } - if {[tcl::dict::exists $argdefcache_by_id $id]} { + if {[tcl::dict::exists $id_cache_rawdef $id]} { return $id } else { - if {![llength [update_definitions]]} { - if {[tcl::dict::exists $argdefcache_by_id (autodef)$id]} { + set check_updates [list [namespace qualifiers $id]] + if {![llength [update_definitions $check_updates]]} { + #nothing new loaded + if {[tcl::dict::exists $id_cache_rawdef (autodef)$id]} { return (autodef)$id } return "" @@ -1817,10 +2080,10 @@ tcl::namespace::eval punk::args { if {[tcl::dict::exists $aliases $id]} { set id [tcl::dict::get $aliases $id] } - if {[tcl::dict::exists $argdefcache_by_id $id]} { + if {[tcl::dict::exists $id_cache_rawdef $id]} { return $id } - if {[tcl::dict::exists $argdefcache_by_id (autodef)$id]} { + if {[tcl::dict::exists $id_cache_rawdef (autodef)$id]} { return (autodef)$id } return "" @@ -1828,42 +2091,188 @@ tcl::namespace::eval punk::args { } } - variable loaded_packages - set loaded_packages [list] + proc status {} { + upvar ::punk::args::register::NAMESPACES registered + upvar ::punk::args::register::loaded_packages loaded_packages + upvar ::punk::args::register::loaded_info loaded_info + upvar ::punk::args::register::scanned_packages scanned_packages + upvar ::punk::args::register::scanned_info scanned_info + set result "" + # [format %-${w0}s $idtail] + set widest [tcl::mathfunc::max {*}[lmap v [list {*}$registered "Registered"] {string length $v}]] + append result "[format %-${widest}s Registered] Scanned_ids Scantime_us Loaded_defs Loadtime_us" \n + set width_c2 [string length "Scanned_ids"] + set width_c3 [string length "Scantime_us"] + set width_c4 [string length "Loaded_defs"] + set width_c5 [string length "Loadtime_us"] + set count_unloaded 0 + set count_loaded 0 + foreach ns $registered { + if {$ns in $scanned_packages} { + set ids [dict get $scanned_info $ns idcount] + set scan_us [dict get $scanned_info $ns time] + } else { + set ids "" + set scan_us "" + } + if {$ns in $loaded_packages} { + incr count_loaded + set ldefs [dict get $loaded_info $ns defcount] + set load_us [dict get $loaded_info $ns time] + } else { + incr count_unloaded + set ldefs "" + set load_us "" + } + append result "[format %-${widest}s $ns] [format %${width_c2}s $ids] [format %${width_c3}s $scan_us] [format %${width_c4}s $ldefs] [format %${width_c5}s $load_us]" \n + } + append result "\nPackages - Registered: [llength $registered] Loaded: $count_loaded Unloaded: $count_unloaded" + return $result + } + + #scanned_packages (list) + #namespace_docpackages (dict) + proc update_definitions {{nslist *}} { + if {[set gposn [lsearch $nslist {}]] >= 0} { + lset nslist $gposn :: + } + upvar ::punk::args::register::NAMESPACES registered ;#list + upvar ::punk::args::register::loaded_packages loaded_packages ;#list + upvar ::punk::args::register::loaded_info loaded_info ;#dict + upvar ::punk::args::register::scanned_packages scanned_packages ;#list + upvar ::punk::args::register::scanned_info scanned_info ;#dict + upvar ::punk::args::register::namespace_docpackages namespace_docpackages ;#dict - proc update_definitions {} { + + #puts stderr "-->update_definitions '$nslist'" #needs to run quickly - especially when no package namespaces to be scanned for argdefs - #e.g - get's called for each subcommand of an ensemble (could be many) + #e.g - gets called for each subcommand of an ensemble (could be many) # It needs to get called in each arginfo call as we don't know what namespace origins or aliases may be involved in resolving a command. #we could possibly get away with not calling it for nested calls (such as with ensemble subcommands) but the code to avoid calls is probably more complex/slow than any gain avoiding the fast-path below. # -- --- --- --- --- --- # common-case fast-path - variable loaded_packages - upvar ::punk::args::register::NAMESPACES pkgs - if {[llength $loaded_packages] == [llength $pkgs]} { + + if {[llength $loaded_packages] == [llength $registered]} { #the only valid mechanism to add to 'loaded_packages' is with this function - so if lengths are equal, nothing to do. + #assert - if all are registered - then all have been scanned ( return {} } # -- --- --- --- --- --- - set unloaded [punklib_ldiff $pkgs $loaded_packages] + set unscanned [punklib_ldiff $registered $scanned_packages] + if {[llength $unscanned]} { + foreach pkgns $unscanned { + set idcount 0 + set ts_start [clock microseconds] + if {[info exists ${pkgns}::PUNKARGS]} { + set seen_documentedns [list] ;#seen per pkgns + foreach definitionlist [set ${pkgns}::PUNKARGS] { + #namespace eval $evalns [list punk::args::define {*}$definitionlist] + set id [rawdef_id $definitionlist] + if {[string match autoid_* $id]} { + puts stderr "update_definitions - unexpected autoid during scan of $pkgns - skipping" + puts stderr "definition:\n" + foreach d $definitionlist { + set out "" + foreach ln [split $d \n] { + append out " " $ln \n + } + puts $out + } + continue + } + #todo - detect duplicate ids (last will silently win.. should be reported somewhere) + incr idcount + set documentedns [namespace qualifiers $id] + if {$documentedns eq ""} {set documentedns ::} + if {$documentedns ni $seen_documentedns} { + #don't add own ns as a key in namespace_docpackages + if {$documentedns ne $pkgns} { + dict lappend namespace_docpackages $documentedns $pkgns + } + lappend seen_documentedns $documentedns + } + } + } + set ts_end [clock microseconds] + set diff [expr {$ts_end - $ts_start}] + dict set scanned_info $pkgns [dict create time $diff idcount $idcount] + #we count it as scanned even if PUNKARGS didn't exist + #(registered the namespace, variable PUNKARGS may or may not be declared, but didn't set PUNKARGS) + lappend scanned_packages $pkgns + } + } + + + + if {"*" in $nslist} { + set needed [punklib_ldiff $registered $loaded_packages] + } else { + set needed [list] + foreach pkgns $nslist { + if {$pkgns in $registered && $pkgns ni $loaded_packages} { + lappend needed $pkgns + } + #argdoc sub namespace is a standard place to put defs that match the namespace below + #(generally the PUNKARGS in a namespace should apply to own ns) + set docns ${pkgns}::argdoc + if {[namespace exists $docns]} { + if {($pkgns in $registered || $docns in $registered) && $docns ni $needed && $docns ni $loaded_packages} { + lappend needed $docns + } + } + if {[dict exists $namespace_docpackages $pkgns]} { + #this namespace has other argdef sources + foreach docns [dict get $namespace_docpackages $pkgns] { + if {$docns ni $loaded_packages} { + lappend needed $docns + } + } + } + } + } + + + set newloaded [list] - foreach pkgns $unloaded { - #puts -nonewline stderr . ;#debugging - see actual loads + foreach pkgns $needed { + #puts stderr "update_definitions Loading: $pkgns" + set ts_start [clock microseconds] + set def_count 0 if {![catch { if {[info exists ${pkgns}::PUNKARGS]} { + set docns ${pkgns}::argdoc + if {[namespace exists $docns]} { + namespace eval ${pkgns}::argdoc { + set epath [namespace path] + set pkgns [namespace parent] + if {$pkgns ni $epath} { + namespace path [list {*}$epath $pkgns] ;#add to tail + } + + } + set evalns $docns + } else { + set evalns $pkgns + } foreach definitionlist [set ${pkgns}::PUNKARGS] { - namespace eval $pkgns [list punk::args::define {*}$definitionlist] + namespace eval $evalns [list punk::args::define {*}$definitionlist] + incr def_count } } + + #process list of 2-element lists if {[info exists ${pkgns}::PUNKARGS_aliases]} { foreach adef [set ${pkgns}::PUNKARGS_aliases] { punk::args::set_alias {*}$adef } } } errMsg]} { + set ts_end [clock microseconds] + set diff [expr {$ts_end - $ts_start}] lappend loaded_packages $pkgns lappend newloaded $pkgns + dict set loaded_info $pkgns [dict create time $diff defcount $def_count] } else { puts stderr "punk::args::update_definitions error - failed to load PUNKARGS definitions for $pkgns\nerr:$errMsg" } @@ -1875,7 +2284,8 @@ tcl::namespace::eval punk::args { #This mechanism gets less-than-useful results for oo methods #e.g {$obj} proc Get_caller {} { - set call_level -3 + #set call_level -3 ;#for get_dict call + set call_level -4 set cmdinfo [tcl::dict::get [tcl::info::frame $call_level] cmd] #puts "-->$cmdinfo" #puts "-->[tcl::info::frame -3]" @@ -1918,7 +2328,7 @@ tcl::namespace::eval punk::args { @values -min 0 -max 0 }] proc test_get_dict {args} { - punk::args::get_dict {*}[punk::args::rawdef ::punk::args::test1] $args + punk::args::get_dict {*}[punk::args::raw_def ::punk::args::test1] $args } proc test_get_by_id {args} { punk::args::get_by_id ::punk::args::test1 $args @@ -1960,22 +2370,22 @@ tcl::namespace::eval punk::args { " @leaders -min 2 -max 2 msg -type string -help\ - "error message to display immediately prior to usage table. - May be empty string to just display usage. + "Error message to display immediately prior to usage table. + May be empty string to just display usage. " spec_dict -type dict -help\ - "Dictionary of argument specifications. - This is the internal format parsed from - the textual definition. It contains the data - organised/optimised to allow the final arg - parser/validator to make decisions. + "Dictionary of argument specifications. + This is the internal format parsed from + the textual definition. It contains the data + organised/optimised to allow the final arg + parser/validator to make decisions. " @opts -badarg -type string -help\ "name of an argument to highlight" -aserror -type boolean -help\ - "If true, the usage table is raised as an error message, - otherwise it is returned as a value." + "If true, the usage table is raised as an error message, + otherwise it is returned as a value." -return -choices {string table tableobject} -choicelabels { string "no table layout" tableobject "table object cmd" @@ -2133,6 +2543,8 @@ tcl::namespace::eval punk::args { } + #set RST [a] + set RST "\x1b\[m" set t "" ;#possible oo table object - may be tested for objectiness at the end so needs to exist. #REVIEW - risk of accidental indefinite recursion if functions used here also use punk::args::get_dict and there is an argument error @@ -2158,7 +2570,7 @@ tcl::namespace::eval punk::args { append errmsg \n } else { if {($returntype in {table tableobject}) && !$has_textblock} { - append errmsg \n "$CLR(errormsg)(layout package textblock is missing)[a]" \n + append errmsg \n "$CLR(errormsg)(layout package textblock is missing)$RST" \n } else { append errmsg \n } @@ -2181,7 +2593,7 @@ tcl::namespace::eval punk::args { set blank_header_col [list] if {$cmdname ne ""} { lappend blank_header_col "" - set cmdname_display $CLR(cmdname)$cmdname[a] + set cmdname_display $CLR(cmdname)$cmdname$RST } else { set cmdname_display "" } @@ -2194,7 +2606,7 @@ tcl::namespace::eval punk::args { } if {$docurl ne ""} { lappend blank_header_col "" - set docurl_display [a+ white]$docurl[a] + set docurl_display [a+ white]$docurl$RST } else { set docurl_display "" } @@ -2216,7 +2628,7 @@ tcl::namespace::eval punk::args { lappend blank_header_col "" } if {$use_table} { - set t [textblock::class::table new $CLR(title)Usage[a]] + set t [textblock::class::table new "$CLR(title)Usage$RST"] $t add_column -headers $blank_header_col -minwidth 3 $t add_column -headers $blank_header_col @@ -2295,19 +2707,18 @@ tcl::namespace::eval punk::args { #potentially require coordination with header colspans? $t add_row [list "" $argdisplay_body] } else { - if {$argdisplay_header ne "" + if {$argdisplay_header ne ""} { lappend errlines $argdisplay_header } lappend errlines {*}$argdisplay_body } } else { - set RST [a] #set A_DEFAULT [a+ brightwhite Brightgreen] set A_DEFAULT "" set A_BADARG $CLR(badarg) - set greencheck $CLR(check)\u2713[a] ;#green tick - set soloflag $CLR(solo)\u2690[a] ;#flag - may be replacement char in old dos prompt (?) + set greencheck $CLR(check)\u2713$RST ;#green tick + set soloflag $CLR(solo)\u2690$RST ;#flag - may be replacement char in old dos prompt (?) set A_PREFIX $CLR(choiceprefix) ;#use a+ so colour off can apply if {$A_PREFIX eq "" || $A_PREFIX eq [a+ underline]} { #A_PREFIX can resolve to empty string if colour off @@ -2380,6 +2791,11 @@ tcl::namespace::eval punk::args { set allchoices_originalcase [list] set choices [Dict_getdef $arginfo -choices {}] set choicegroups [Dict_getdef $arginfo -choicegroups {}] + set choicemultiple [dict get $arginfo -choicemultiple] + if {[string is integer -strict $choicemultiple]} { + set choicemultiple [list $choicemultiple $choicemultiple] + } + lassign $choicemultiple choicemultiple_min choicemultiple_max set choicecolumns [Dict_getdef $arginfo -choicecolumns 4] set choiceprefixdenylist [Dict_getdef $arginfo -choiceprefixdenylist {}] if {[Dict_getdef $arginfo -multiple 0]} { @@ -2416,6 +2832,17 @@ tcl::namespace::eval punk::args { set choicelabeldict [Dict_getdef $arginfo -choicelabels {}] set formattedchoices [dict create] ;#use dict rather than array to preserve order append help " Choices$prefixmsg$casemsg" + if {$choicemultiple_max > 1 || $choicemultiple_max == -1} { + if {$choicemultiple_max == -1} { + append help \n " The value can be a list of $choicemultiple_min or more of these choices" + } else { + if {$choicemultiple_min eq $choicemultiple_max} { + append help \n " The value must be a list of $choicemultiple_min of these choices" + } else { + append help \n " The value can be a list of $choicemultiple_min to $choicemultiple_max of these choices" + } + } + } if {![dict get $arginfo -choiceprefix] || [catch {package require punk::trie}]} { #append help "\n " [join [dict get $arginfo -choices] "\n "] if {[dict size $choicelabeldict]} { @@ -2513,7 +2940,7 @@ tcl::namespace::eval punk::args { #append help \n[textblock::join -- " " [$choicetableobj print]] } else { if {$groupname ne ""} { - append help \n \n "$CLR(groupname)Group: $groupname[a]" + append help \n \n "$CLR(groupname)Group: $groupname$RST" } else { append help \n } @@ -2527,15 +2954,15 @@ tcl::namespace::eval punk::args { if {$usetable} { #these will be displayed after all table entries if {$groupname eq ""} { - dict set choicetable_footers "" " $CLR(errormsg)(no choices defined for main group)[a]" + dict set choicetable_footers "" " $CLR(errormsg)(no choices defined for main group)$RST" } else { - dict set choicetable_footers $groupname " $CLR(errormsg)(no choices defined for group $groupname)[a]" + dict set choicetable_footers $groupname " $CLR(errormsg)(no choices defined for group $groupname)$RST" } } else { if {$groupname eq ""} { - append help \n " " $CLR(errormsg)(no choices defined)[a] + append help \n " " $CLR(errormsg)(no choices defined)$RST } else { - append help \n " " $CLR(errormsg)(no choices defined for group $groupname)[a] + append help \n " " $CLR(errormsg)(no choices defined for group $groupname)$RST } } } @@ -2561,7 +2988,7 @@ tcl::namespace::eval punk::args { $obj destroy } if {[dict size $choicetable_footers]} { - foreach groupname [dict keys $formattedchoices { + foreach groupname [dict keys $formattedchoices] { if {[dict exists $choicetable_footers $groupname]} { append help \n [dict get $choicetable_footers $groupname] } @@ -2570,6 +2997,7 @@ tcl::namespace::eval punk::args { #review. use -type to restrict additional choices - may be different to values in the -choices if {![dict get $arginfo -choicerestricted]} { + #when -choicemultiple - the -type refers to each selection if {[dict get $arginfo -type] eq "string"} { append help "\n (values not in defined choices are allowed)" } else { @@ -2609,7 +3037,7 @@ tcl::namespace::eval punk::args { } } else { #review - formatting will be all over the shop due to newlines in typesshow, help - set arghelp "[a+ bold]$argshow[a] TYPE:$typeshow DEFAULT:$default MULTI:$multiple\n" + set arghelp "[a+ bold]$argshow$RST TYPE:$typeshow DEFAULT:$default MULTI:$multiple\n" foreach ln [split $help \n] { append arghelp " $ln" \n } @@ -2666,35 +3094,40 @@ tcl::namespace::eval punk::args { } - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + @dynamic @id -id ::punk::args::usage @cmd -name punk::args::usage -help\ - "Return usage information for a command. + "Return usage information for a command identified by an id. + This will only work for commands where a punk::args definition exists - for the command and an id has been defined for it. + for the command and an id has been defined for it. The id for custom + help for a command should match the fully qualified name of the command. + Many commands (such as ensembles and oo objects) may have argument - documentation generated dynamically and not have an id. + documentation generated dynamically and may not yet have an id. + IDs for autogenenerated help are prefixed e.g (autodef)::myensemble. + Generally punk::ns::arginfo (aliased as i in the punk shell) should be used in preference - as it will search for a documentation - mechanism and call this as necessary. + mechanism and call punk::args::usage as necessary. " -return -default table -choices {string table tableobject} - } {${[punk::args::resolved_def -type @opts ::punk::args::arg_error -scheme]}} { + } {${[punk::args::resolved_def -types opts ::punk::args::arg_error -scheme]}} { @values -min 0 -max 1 id -help\ - "exact id. - Will usually match the command name" + "Exact id. + Will usually match the command name" }] proc usage {args} { lassign [dict values [punk::args::get_by_id ::punk::args::usage $args]] leaders opts values received set id [dict get $values id] - set definitionlist [rawdef $id] - if {[llength $definitionlist] == 0} { + set real_id [real_id $id] + if {$real_id eq ""} { error "punk::args::usage - no such id: $id" } - #by placing scheme before the supplied args - it can be overridden - arg_error "" [uplevel 1 [list punk::args::define {*}$definitionlist]] -scheme punk_info {*}$opts -aserror 0 + arg_error "" [punk::args::get_spec $real_id] -scheme punk_info {*}$opts -aserror 0 } lappend PUNKARGS [list { @@ -2704,13 +3137,13 @@ tcl::namespace::eval punk::args { id arglist -type list -help\ "list containing arguments to be parsed as per the - argument specification identified by the supplied id." + argument specification identified by the supplied id." }] #deprecate? proc get_by_id {id arglist} { - set definitionlist [punk::args::rawdef $id] + set definitionlist [punk::args::raw_def $id] if {[llength $definitionlist] == 0} { error "punk::args::get_by_id - no such id: $id" } @@ -2734,62 +3167,86 @@ tcl::namespace::eval punk::args { @cmd -name punk::args::parse -help\ "parse and validate command arguments based on a definition. - In the 'withid' form the definition is a pre-existing - record that has been created with ::punk::args::define. - In the 'withdef' form - the definition is created on the - first call and cached thereafter. + In the 'withid' form the definition is a pre-existing record that has been + created with ::punk::args::define, or indirectly by adding a definition to + the PUNKARGS variable in a namespace which is then registered in + punk::args::register::NAMESPACES, or by a previous call to punk::parse + using 'withdef' and a definition block containing an @id -id directive. + + In the 'withdef' form - the definition is created on the first call and + cached thereafter, if the id didn't already exist. - form1: parse ?-flag val?... -- $arglist withid $id - form2: parse ?-flag val?... -- $arglist withdef $def ?$def? + form1: parse $arglist ?-flag val?... withid $id + form2: parse $arglist ?-flag val?... withdef $def ?$def? see punk::args::define" + @form -form {withid withdef} + @leaders -min 1 -max 1 + arglist -type list -optional 0 -help\ + "Arguments to parse - supplied as a single list" + @opts - -form -type list -default * -help\ + -form -type list -default * -help\ "Restrict parsing to the set of forms listed. - Forms are the orthogonal sets of arguments a - command can take - usually described in 'synopsis' - entries. - " + Forms are the orthogonal sets of arguments a + command can take - usually described in 'synopsis' + entries." #default to enhanced errorstyle despite slow 'catch' (unhappy path) performance #todo - configurable per interp/namespace - -errorstyle -type string -default enhanced -choices {enhanced standard minimal} - @values -min 3 - sep -optional 0 -choices "--" + -errorstyle -type string -default enhanced -choices {enhanced standard minimal} + @values -min 2 - @form -form withid -synopsis "parse ?-form {int|...}? ?-errorstyle ? -- withid $id" + @form -form withid -synopsis "parse arglist ?-form {int|...}? ?-errorstyle ? withid $id" withid -type literal -help\ "The literal value 'withid'" id -type string -help\ "id of punk::args definition for a command" - @form -form withdef -synopsis "parse ?-form {int|...}? ?-errorstyle ? -- withdef $def ?$def?" + @form -form withdef -synopsis "parse arglist ?-form {int|...}? ?-errorstyle ? withdef $def ?$def?" withdef -type literal -help\ "The literal value 'withdef'" + + #todo - make -dynamic obsolete - use @dynamic directive instead def -type string -multiple 1 -optional 0 -help\ "Each remaining argument is a block of text - defining argument definitions. - As a special case, -dynamic may be - specified as the 1st 2 arguments. These are - not treated as an indicator to punk::args - about how to process the definition." + defining argument definitions. + As a special case, -dynamic may be + specified as the 1st 2 arguments. These are + treated as an indicator to punk::args about + how to process the definition." }] proc parse {args} { set tailtype "" ;#withid|withdef - set split [lsearch -exact $args --] ;#first -- + if {[llength $args] < 3} { + error "punk::args::parse - invalid call. < 3 args" + } + set parseargs [lindex $args 0] + set tailargs [lrange $args 1 end] + + set split [lsearch -exact $tailargs withid] if {$split < 0} { - #punk::args::usage arg_error? - error "punk::args::parse - invalid call. End of opts marker -- is required even if no options are present." + set split [lsearch -exact $tailargs withdef] + if {$split < 0} { + #punk::args::usage arg_error? + error "punk::args::parse - invalid call. keyword withid|withdef required" + } else { + set tailtype withdef + } + } else { + set tailtype withid + } + + set opts [lrange $tailargs 0 $split-1] ;#repeated flags will override earlier. That's ok here. + if {[llength $opts] % 2} { + error "punk::args::parse Even number of -flag val pairs required after arglist" } - set opts [lrange $args 0 $split-1] ;#repeated flags will override earlier. That's ok here. - set arglist [lindex $args $split+1] - set tailtype [lindex $args $split+2] set defaultopts [dict create\ -form {*}\ -errorstyle enhanced\ ] - + set opts [dict merge $opts $defaultopts] dict for {k v} $opts { switch -- $k { -form - -errorstyle { @@ -2802,24 +3259,43 @@ tcl::namespace::eval punk::args { } switch -- $tailtype { withid { - if {[llength [lrange $args $split+3 end]] != 1} { + if {[llength [lrange $tailargs $split+1 end]] != 1} { error "punk::args::parse - invalid call. Expected exactly one argument after 'withid'" } - set id [lindex $args $split+3] - return "parse [llength $arglist] args withid $id, options:$opts" + set id [lindex $tailargs $split+1] + #puts stdout "punk::args::parse [llength $parseargs] args withid $id, options: $opts" + set deflist [raw_def $id] + if {[llength $deflist] == 0} { + error "punk::args::parse - no such id: $id" + } } withdef { - set deflist [lrange $args $split+3 end] + set deflist [lrange $tailargs $split+1 end] if {[llength $deflist] < 1} { error "punk::args::parse - invalid call. Expected at least one argument after 'withdef'" } - return "parse [llength $arglist] with [llength $deflist] definition blocks, options:$opts" + #puts stdout "punk::args::parse [llength $parseargs] args with [llength $deflist] definition blocks, options: $opts" } default { error "punk::args::parse - invalid call. Argument following arglist must be 'withid' or 'withdef'" } } - + try { + set result [punk::args::get_dict {*}$deflist $parseargs] + } trap {PUNKARGS} {msg opts} { + #trap punk::args argument validation/parsing errors and decide here + #whether to display basic error - or full usage if configured. + puts stderr "PUNKARGS: $msg\n$opts" + return + } trap {} {msg opts} { + #review + #puts stderr "$msg\n$opts" + #quote from DKF: The reason for using return -code error vs error or throw depends on where the error is. If the problem is in your code, use error or throw. + #If the problem is in your caller (e.g., because they gave you bad arguments) then use return -code error. Simple. + throw [dict get $opts -errorcode] [dict get $opts -errorinfo] + return + } + return $result } proc parseXXX {args} { #no solo flags allowed for parse function itself. (ok for arglist being parsed) @@ -2920,19 +3396,14 @@ tcl::namespace::eval punk::args { # @values -multiple 1 #} $args - set is_dynamic 0 - if {[lindex $args 0] eq "-dynamic"} { - set is_dynamic [lindex $args 1] - } set rawargs [lindex $args end] ;# args values to be parsed - #we take a definition list rather than argspecs - because the definition could be dynamic set definition_args [lrange $args 0 end-1] #if definition has been seen before, #define will either return a permanently cached argspecs (-dynamic 0) - or # use a cached pre-split definition with parameters to dynamically generate a new (or limitedly cached?) argspecs. - set argspecs [uplevel 1 [list ::punk::args::define {*}$definition_args]] + set argspecs [uplevel 1 [list ::punk::args::resolve {*}$definition_args]] # ----------------------------------------------- # Warning - be aware of all vars thrown into this space (from tail end of 'definition' proc) @@ -3397,22 +3868,22 @@ tcl::namespace::eval punk::args { #puts "---opts_and_values:$opts_and_values" #puts "---argstate:$argstate" tcl::dict::for {argname v} $opts_and_values { - set thisarg [tcl::dict::get $argstate $argname] - #set thisarg_keys [tcl::dict::keys $thisarg] - set thisarg_checks [tcl::dict::get $arg_checks $argname] - set is_multiple [tcl::dict::get $thisarg -multiple] - set is_allow_ansi [tcl::dict::get $thisarg -allow_ansi] - set is_validate_ansistripped [tcl::dict::get $thisarg -validate_ansistripped] - set is_strip_ansi [tcl::dict::get $thisarg -strip_ansi] - set has_default [tcl::dict::exists $thisarg -default] + set thisarg [tcl::dict::get $argstate $argname] + #set thisarg_keys [tcl::dict::keys $thisarg] + set thisarg_checks [tcl::dict::get $arg_checks $argname] + set is_multiple [tcl::dict::get $thisarg -multiple] + set is_allow_ansi [tcl::dict::get $thisarg -allow_ansi] + set is_validate_ansistripped [tcl::dict::get $thisarg -validate_ansistripped] + set is_strip_ansi [tcl::dict::get $thisarg -strip_ansi] + set has_default [tcl::dict::exists $thisarg -default] if {$has_default} { set defaultval [tcl::dict::get $thisarg -default] } - set type [tcl::dict::get $thisarg -type] - set has_choices [expr {[tcl::dict::exists $thisarg -choices] || [tcl::dict::exists $thisarg -choicegroups]}] - set regexprepass [tcl::dict::get $thisarg -regexprepass] - set regexprefail [Dict_getdef $thisarg -regexprefail ""] ;#aliased to dict getdef in tcl9 - set validationtransform [tcl::dict::get $thisarg -validationtransform] + set type [tcl::dict::get $thisarg -type] + set has_choices [expr {[tcl::dict::exists $thisarg -choices] || [tcl::dict::exists $thisarg -choicegroups]}] + set regexprepass [tcl::dict::get $thisarg -regexprepass] + set regexprefail [Dict_getdef $thisarg -regexprefail ""] ;#aliased to dict getdef in tcl9 + set validationtransform [tcl::dict::get $thisarg -validationtransform] if {$is_multiple} { @@ -3443,13 +3914,18 @@ tcl::namespace::eval punk::args { set choiceprefix [tcl::dict::get $thisarg -choiceprefix] set choiceprefixdenylist [Dict_getdef $thisarg -choiceprefixdenylist {}] set choicerestricted [tcl::dict::get $thisarg -choicerestricted] + set choicemultiple [tcl::dict::get $thisarg -choicemultiple] + if {[string is integer -strict $choicemultiple]} { + set choicemultiple [list $choicemultiple $choicemultiple] + } + lassign $choicemultiple choicemultiple_min choicemultiple_max set nocase [tcl::dict::get $thisarg -nocase] set choices [Dict_getdef $thisarg -choices {}] set choicegroups [Dict_getdef $thisarg -choicegroups {}] set allchoices $choices if {[dict size $choicegroups]} { - dict for {groupname clist} $choicegroups { - lappend allchoices {*}$clist + dict for {groupname groupmembers} $choicegroups { + lappend allchoices {*}$groupmembers } } #note we can legitimately have dups in allchoices - if a choice should be documented to display in multiple groups @@ -3468,115 +3944,159 @@ tcl::namespace::eval punk::args { } } set idx 0 ;# - #opts/values_dict $argname member has been populated with the actual entered choices - which might be prefixes + #leaders_dict/opts/values_dict $argname member has been populated with the actual entered choices - which might be prefixes #assert llength $vlist == llength [dict get $dname $argname] # (unless there was a default and the option wasn't specified) set vlist_validate [list] set vlist_check_validate [list] foreach e $vlist e_check $vlist_check { - if {$nocase} { - set casemsg " (case insensitive)" - set choices_test [tcl::string::tolower $allchoices] - #Don't lcase the denylist - even in nocase mode! - #set choiceprefixdenylist [tcl::string::tolower $choiceprefixdenylist] - set v_test [tcl::string::tolower $e_check] + set allchoices_in_list 0 + if {$choicemultiple_max > 1 || $choicemultiple_max == -1} { + #vlist and vlist_check can be list of lists if -multiple and -choicemultiple + #each e represents 0 or more choice selections + set c_list $e + set c_check_list $e_check + #todo? check if entire list matches default? } else { - set casemsg " (case sensitive)" - set v_test $e_check - set choices_test $allchoices + #only one choice at a time - ensure single entry in c_list c_check_list + set c_list [list $e] + set c_check_list [list $e_check] } - set choice_in_list 0 - set matches_default [expr {$has_default && $e eq $defaultval}] - if {!$matches_default} { - if {$choiceprefix} { - #can we handle empty string as a choice? It should just work - REVIEW/test - set choice_exact_match 0 - if {$e_check in $allchoices} { - #for case when there are case-differenced duplicates - allow exact match to avoid selecting earlier match of another casing - set chosen $e_check - set choice_in_list 1 - set choice_exact_match 1 - } elseif {$v_test in $choices_test} { - set chosen $v_test - set choice_in_list 1 - } else { - #PREFIX check required - any 'chosen' here is not an exact match or it would have matched above. - #assert - if empty string was a provided choice and empty string was a provided arg - we would have matched above. - #in this block we can treat empty result from prefix match as a non-match - if {$nocase} { - #nocase implies that our entered value doesn't have to match case of choices - - #but we would still like to select the best match if there are case-dups. - #e.g arg -choices {delete Delete} -nocase 1 -choiceprefixdenylist delete - # selecting Del will find Delete, del will match delete (and raise error) - # but DEL will also match delete rather than Delete - so again an error is raised. - #This is counterintuitive with -nocase - #This is probably such an edge case that best served with documentation as a feature-not-bug - #Rationale being that in a nocase situation it's arbitrary/counterintuitive to consider DEL, or DeL a better match for Delete than delete? - #The choice of the user to use -choiceprefixdenylist along with case-dups is the issue. - - set bestmatch [tcl::prefix::match -error "" [lsort -unique $allchoices] $e_check] - if {$bestmatch eq ""} { - set chosen [tcl::prefix::match -error "" [lsort -unique $choices_test] $v_test] - set choice_in_list [expr {$chosen ne ""}] - #we + + + #----------------------------------- + #fast fail on the wrong number of choices + if {[llength $c_list] < $choicemultiple_min} { + set msg "Option $argname for [Get_caller] requires at least $choicemultiple_min choices. Received [llength $c_list] choices." + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list choicecount [llength $c_list] minchoices $choicemultiple_min maxchoices $choicemultiple_max] -badarg $argname]] $msg + } + if {$choicemultiple_max != -1 && [llength $c_list] > $choicemultiple_max} { + set msg "Option $argname for [Get_caller] requires at most $choicemultiple_max choices. Received [llength $c_list] choices." + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list choicecount [llength $c_list] minchoices $choicemultiple_min maxchoices $choicemultiple_max] -badarg $argname]] $msg + } + #----------------------------------- + + set choice_idx 0 ;#we need to overwrite raw-choice (which may be prefix) with a value from the choice list + foreach c $c_list c_check $c_check_list { + if {$nocase} { + set casemsg " (case insensitive)" + set choices_test [tcl::string::tolower $allchoices] + #Don't lcase the denylist - even in nocase mode! + #set choiceprefixdenylist [tcl::string::tolower $choiceprefixdenylist] + set v_test [tcl::string::tolower $c_check] + } else { + set casemsg " (case sensitive)" + set v_test $c_check + set choices_test $allchoices + } + set choice_in_list 0 + set matches_default [expr {$has_default && $c eq $defaultval}] ;# defaultval when -choicemultiple could be a list? + if {!$matches_default} { + if {$choiceprefix} { + #can we handle empty string as a choice? It should just work - REVIEW/test + set choice_exact_match 0 + if {$c_check in $allchoices} { + #for case when there are case-differenced duplicates - allow exact match to avoid selecting earlier match of another casing + set chosen $c_check + set choice_in_list 1 + set choice_exact_match 1 + } elseif {$v_test in $choices_test} { + set chosen $v_test + set choice_in_list 1 + } else { + #PREFIX check required - any 'chosen' here is not an exact match or it would have matched above. + #assert - if empty string was a provided choice and empty string was a provided arg - we would have matched above. + #in this block we can treat empty result from prefix match as a non-match + if {$nocase} { + #nocase implies that our entered value doesn't have to match case of choices - + #but we would still like to select the best match if there are case-dups. + #e.g arg -choices {delete Delete} -nocase 1 -choiceprefixdenylist delete + # selecting Del will find Delete, del will match delete (and raise error) + # but DEL will also match delete rather than Delete - so again an error is raised. + #This is counterintuitive with -nocase + #This is probably such an edge case that best served with documentation as a feature-not-bug + #Rationale being that in a nocase situation it's arbitrary/counterintuitive to consider DEL, or DeL a better match for Delete than delete? + #The choice of the user to use -choiceprefixdenylist along with case-dups is the issue. + + set bestmatch [tcl::prefix::match -error "" [lsort -unique $allchoices] $c_check] + if {$bestmatch eq ""} { + set chosen [tcl::prefix::match -error "" [lsort -unique $choices_test] $v_test] + #now pick the earliest match in the actually defined list so that case of chosen always matches a defined entry with casing + set chosen [lsearch -inline -nocase $allchoices $chosen] + set choice_in_list [expr {$chosen ne ""}] + } else { + set chosen $bestmatch + set choice_in_list 1 + } } else { - set chosen $bestmatch - set choice_in_list 1 + set chosen [tcl::prefix::match -error "" [lsort -unique $allchoices] $c_check] + if {$chosen eq ""} { + set choice_in_list 0 + } else { + set choice_in_list 1 + } } - } else { - set chosen [tcl::prefix::match -error "" [lsort -unique $allchoices] $e_check] - if {$chosen eq ""} { + #override choice_in_list if in deny list + #don't allow prefixing for elements from -choiceprefixdenylist + #we still use all elements to calculate the prefixes though + #review - case difference edge cases in choiceprefixdenylist !todo + if {$chosen in $choiceprefixdenylist} { set choice_in_list 0 - } else { - set choice_in_list 1 + set chosen "" } } - #override choice_in_list if in deny list - #don't allow prefixing for elements from -choiceprefixdenylist - #we still use all elements to calculate the prefixes though - #review - case difference edge cases in choiceprefixdenylist !todo - if {$chosen in $choiceprefixdenylist} { - set choice_in_list 0 - set chosen "" - } - } - if {$choice_in_list && !$choice_exact_match} { - if {$is_multiple} { - set existing [tcl::dict::get [set $dname] $argname] - lset existing $idx $chosen - tcl::dict::set $dname $argname $existing - } else { - tcl::dict::set $dname $argname $chosen + if {$choice_in_list && !$choice_exact_match} { + if {$choicemultiple_max != -1 && $choicemultiple_max < 2} { + if {$is_multiple} { + set existing [tcl::dict::get [set $dname] $argname] + lset existing $idx $chosen + tcl::dict::set $dname $argname $existing + } else { + tcl::dict::set $dname $argname $chosen + } + } else { + if {$is_multiple} { + set existing_all [tcl::dict::get [set $dname] $argname] + lset existing_all $idx $choice_idx $chosen + tcl::dict::set $dname $argname $existing_all + } else { + set existing [tcl::dict::get [set $dname] $argname] + lset existing $choice_idx $chosen + tcl::dict::set $dname $argname $existing + } + } } + } else { + #value as stored in $dname is ok + set choice_in_list [expr {$v_test in $choices_test}] } - } else { - #value as stored in $dname is ok - set choice_in_list [expr {$v_test in $choices_test}] } - } - if {!$choice_in_list && !$matches_default} { - if {!$choicerestricted} { - #if {$is_multiple} { - # set existing [tcl::dict::get [set $dname] $argname] - # lset existing $idx $v_test - # tcl::dict::set $dname $argname $existing - #} else { - # tcl::dict::set $dname $argname $v_test - #} - lappend vlist_validate $e - lappend vlist_check_validate $e_check - } else { - #unhappy path - if {$choiceprefix} { - set prefixmsg " (or a unique prefix of a value)" + if {!$choice_in_list && !$matches_default} { + if {!$choicerestricted} { + #if {$is_multiple} { + # set existing [tcl::dict::get [set $dname] $argname] + # lset existing $idx $v_test + # tcl::dict::set $dname $argname $existing + #} else { + # tcl::dict::set $dname $argname $v_test + #} + lappend vlist_validate $c + lappend vlist_check_validate $c_check } else { - set prefixmsg "" + #unhappy path + if {$choiceprefix} { + set prefixmsg " (or a unique prefix of a value)" + } else { + set prefixmsg "" + } + arg_error "Option $argname for [Get_caller] must be one of the listed values:\n [join $allchoices "\n "]\n$casemsg$prefixmsg. Received: '$c'" $argspecs -badarg $argname } - arg_error "Option $argname for [Get_caller] must be one of the listed values:\n [join $allchoices "\n "]\n$casemsg$prefixmsg. Received: '$e'" $argspecs -badarg $argname } + incr choice_idx } + incr idx } #reduce our vlist and vlist_check lists by removing choice matches as they need to be passed through without validation @@ -3588,10 +4108,11 @@ tcl::namespace::eval punk::args { if {[llength $vlist] && $has_default} { set vlist_validate [list] set vlist_check_validate [list] - foreach e $vlist e_check $vlist_check { - if {$e_check ne $defaultval} { - lappend vlist_validate $e - lappend vlist_check_validate $e + foreach c $vlist c_check $vlist_check { + #for -choicemultiple with default that could be a list use 'ni' ?? review + if {$c_check ne $defaultval} { + lappend vlist_validate $c + lappend vlist_check_validate $c } } set vlist $vlist_validate @@ -3854,7 +4375,12 @@ tcl::namespace::eval punk::args { xdigit { foreach e $vlist e_check $vlist_check { if {![tcl::string::is $type $e_check]} { - arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e'" $argspecs -badarg $argname + set msg "Option $argname for [Get_caller] requires type '$type'. Received: '$e'" + #try trap? + #return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type]]] $result + #throw ? + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname]] $msg + arg_error $msg $argspecs -badarg $argname } } } @@ -4012,59 +4538,104 @@ tcl::namespace::eval punk::args::lib { lappend PUNKARGS [list { @id -id ::punk::args::lib::tstr @cmd -name punk::args::lib::tstr -help\ - "A rough equivalent of js template literals" + "A rough equivalent of js template literals + + Substitutions: + \$\{$varName\} + \$\{[myCommand]\} + (when -allowcommands flag is given)" -allowcommands -default 0 -type none -help\ - "if -allowcommands is present, placeholder can contain commands - e.g {\$\{plaintext0 [lindex $var 0] plaintext2\}}" - -return -default list -choices {dict list string args}\ + "If -allowcommands is present, placeholder can contain commands + e.g {\$\{plaintext0 [lindex $var 0] plaintext2\}}" + -undent -default 1 -type boolean -help\ + "undent/dedent the template lines. + The longest common prefix of whitespace is removed" + -indent -default "" -type string -help\ + "String with which to indent the template + prior to substitution. + If -undent is enabled, that is performed + first, then the indent is applied." + -paramindents -default line -choices {none line position} -choicelabels { + line\ + " Use leading whitespace in + the line in which the + placeholder occurs." + position\ + " Use the position in + the line in which the + placeholder occurs." + none\ + " No indents applied to + subsequent placeholder value + lines. This will usually + result in text awkwardly + ragged unless the source code + has also been aligned with the + left margin or the value has + been manually padded." + } -help\ + "How indenting is done for subsequent lines in a + multi-line placeholder substitution value. + The 1st line or a single line value is always + placed at the placeholder. + paramindents are performed after the main + template has been indented/undented. + (indenting by position does not calculate + unicode double-wide or grapheme cluster widths) + " + #choicelabels indented by 1 char is clearer for -return string - and reasonable in table + -return -default string -choices {dict list string args}\ -choicelabels { dict\ - "Return a dict with keys - 'template', 'params' and - 'errors'" - string\ - "Return a single result - being the string with - placeholders substituted." - list\ - "Return a 2 element list. - The first is itself a list - of plaintext portions of the - template, split at each point - at which placeholders were - present. The second element - of the outer list is a list - of placeholder values if -eval - is 1, or a list of the raw - placeholder strings if -eval - is 0." - args\ - "Return a list where the first - element is a list of template - plaintext sections as per the - 'list' return mechanism, but the - placeholder items are individual - items in the returned list. - This can be useful when passing - the expanded result of a tstr - command to another function - which expects the placeholders - as individual arguments" + " Return a dict with keys + 'template', 'params' and + 'errors'" + string\ + " Return a single result + being the string with + placeholders substituted." + list\ + " Return a 2 element list. + The first is itself a list + of plaintext portions of the + template, split at each point + at which placeholders were + present. The second element + of the outer list is a list + of placeholder values if -eval + is 1, or a list of the raw + placeholder strings if -eval + is 0." + args\ + " Return a list where the first + element is a list of template + plaintext sections as per the + 'list' return mechanism, but the + placeholder items are individual + items in the returned list. + This can be useful when passing + the expanded result of a tstr + command to another function + which expects the placeholders + as individual arguments" } -eval -default 1 -type boolean -help\ "Whether to evaluate the \$\{\} placeholders. - When -return is string, -eval should generally be set to 1. - For a string return, -eval 0 will result in the raw contents of \$\{\} being substituted. - contained variables in that case should be braced, or the variable name is likely to collide - with surrounding text. - e.g tstr -return string -eval 0 {plaintext\$\{\$\{var\}\}plaintext} -> plaintext\$\{var\}plaintext" + When -return is string, -eval should generally be set to 1. + For a string return, -eval 0 will result in the raw contents of \$\{\} being substituted. + contained variables in that case should be braced or whitespace separated, or the variable + name is likely to collide with surrounding text. + e.g tstr -return string -eval 0 {plaintext\$\{\$\{var\}\}plaintext} -> plaintext\$\{var\}plaintext" @values -min 0 -max 1 templatestring -help\ "This argument should be a braced string containing placeholders such as \$\{$var\} e.g {The value is \$\{$var\}.} - where $var will be substituted from the calling context - The placeholder itself can contain plaintext portions as well as variables. - It can contain commands in square brackets if -allowcommands is true - e.g tstr -return string -allowcommands {Tcl Version:\$\{[info patch]\} etc}" + where $var will be substituted from the calling context + The placeholder itself can contain plaintext portions as well as variables. + It can contain commands in square brackets if -allowcommands is true + e.g tstr -return string -allowcommands {Tcl Version:\$\{[info patch]\} etc} + + Escape sequences such as \\n and unicode escapes are processed within placeholders. + " }] proc tstr {args} { @@ -4080,8 +4651,11 @@ tcl::namespace::eval punk::args::lib { set arglist [lrange $args 0 end-1] set opts [dict create\ -allowcommands 0\ + -undent 1\ + -indent ""\ + -paramindents line\ -eval 1\ - -return list\ + -return string\ ] if {"-allowcommands" in $arglist} { set arglist [::punk::args::system::punklib_ldiff $arglist -allowcommands] @@ -4089,21 +4663,21 @@ tcl::namespace::eval punk::args::lib { } if {[llength $arglist] % 2 != 0} { if {[info commands ::punk::args::get_by_id] ne ""} { - punk::args::get_by_id ::punk::args::tstr $args + punk::args::get_by_id ::punk::args::lib::tstr $args return } else { error "punk::args::lib::tstr expected option/value pairs prior to last argument" } } dict for {k v} $arglist { - set fullk [tcl::prefix::match -error "" {-allowcommands -return -eval} $k] + set fullk [tcl::prefix::match -error "" {-allowcommands -indent -undent -paramindents -return -eval} $k] switch -- $fullk { - -return - -eval { + -indent - -undent - -paramindents - -return - -eval { dict set opts $fullk $v } default { if {[info commands ::punk::args::get_by_id] ne ""} { - punk::args::get_by_id ::punk::args::tstr $args + punk::args::get_by_id ::punk::args::lib::tstr $args return } else { error "punk::args::lib::tstr unknown option $k. Known options: [dict keys $opts]" @@ -4112,6 +4686,12 @@ tcl::namespace::eval punk::args::lib { } } set opt_allowcommands [dict get $opts -allowcommands] + set opt_paramindents [dict get $opts -paramindents] + set test_paramindents [tcl::prefix::match -error "" {none line position} $opt_paramindents] + if {$test_paramindents ni {none line position}} { + error "punk::args::lib::tstr option -paramindents invalid value '$opt_paramindents'. Must be one of none, line, position or an unambiguous abbreviation thereof." + } + set opt_paramindents $test_paramindents set opt_return [dict get $opts -return] set opt_return [tcl::prefix::match -error "" {args dict list string} $opt_return] if {$opt_return eq ""} { @@ -4124,6 +4704,15 @@ tcl::namespace::eval punk::args::lib { set nocommands "" } + set opt_undent [dict get $opts -undent] + if {$opt_undent} { + set templatestring [punk::args::lib::undent $templatestring] + } + set opt_indent [dict get $opts -indent] + if {$opt_indent ne ""} { + set templatestring [punk::args::lib::indent $templatestring $opt_indent] + } + #set parts [_tstr_split $templatestring] if {[string first \$\{ $templatestring] < 0} { set parts [list $templatestring] @@ -4135,6 +4724,14 @@ tcl::namespace::eval punk::args::lib { set params [list] set idx 0 set errors [dict create] + set lastline "" ;#todo - first line has placeholder? + set pt1 [lindex $parts 0] + set lastline_posn [string last \n $pt1] + if {$lastline_posn >= 0} { + set lastline [string range $pt1 $lastline_posn+1 end] + } else { + set lastline $pt1 + } foreach {pt expression} $parts { lappend textchunks $pt incr idx ;#pt incr @@ -4143,18 +4740,39 @@ tcl::namespace::eval punk::args::lib { if {$idx == [llength $parts]} { break } + set lastline_posn [string last \n $pt] + if {$lastline_posn >= 0} { + set lastline [string range $pt $lastline_posn+1 end] + } #lappend expressions $expression + #---------------------- + #REVIEW - JMN + #TODO - debug punk::args loading of @dynamic defs + #puts "-- $expression" + #---------------------- + #brk1 - literal newline not {\n} + set leader "" + if {[set brk1 [string first \n $expression]] >= 0} { + #undent left of paramstart only for lines of expression that arent on opening ${..} line + set tail [string range $expression $brk1+1 end] + set leader [string repeat " " [string length $lastline]] + set undentedtail [punk::args::lib::undentleader $tail $leader] + #set undentedtail [punk::lib::undent [string range $expression $brk1+1 end]] + set expression "[string range $expression 0 $brk1]$undentedtail" + } if {$opt_eval} { if {[catch [list uplevel 1 [list ::subst {*}$nocommands $expression]] result]} { lappend params [string cat \$\{ $expression \}] dict set errors [expr {[llength $params]-1}] $result } else { + set result [string map [list \n "\n$leader"] $result] lappend params $result } #lappend params [uplevel 1 [list ::subst {*}$nocommands $expression]] } else { - lappend params $expression + lappend params [subst -nocommands -novariables $expression] } + append lastline [lindex $params end] ;#for current expression's position calc incr idx ;#expression incr } @@ -4167,7 +4785,9 @@ tcl::namespace::eval punk::args::lib { dict for {i e} $errors { append einfo "parameter $i error: $e" \n } - puts stderr "tstr errors:\n$einfo\n]" + #REVIEW!!! + #TODO - fix + #puts stderr "tstr errors:\n$einfo\n" } switch -- $opt_return { @@ -4179,9 +4799,46 @@ tcl::namespace::eval punk::args::lib { return [list $textchunks {*}$params] } string { + #todo - flag to disable indent-matching behaviour for multiline param? set out "" + set pt1 [lindex $parts 0] + set lastline_posn [string last \n $pt1] + if {$lastline_posn >= 0} { + set lastline [string range $pt1 $lastline_posn+1 end] + } else { + set lastline $pt1 + } foreach pt $textchunks param $params { - append out $pt $param + if {$opt_paramindents eq "none"} { + append out $pt $param + } else { + set lastline_posn [string last \n $pt] + if {$lastline_posn >= 0} { + set lastline [string range $pt $lastline_posn+1 end] + } + if {$opt_paramindents eq "line"} { + regexp {(\s*).*} $lastline _all lastindent + } else { + #position + #TODO - detect if there are grapheme clusters + #This regsub doesn't properly space unicode double-wide chars or clusters + set lastindent "[regsub -all {\S} $lastline " "] " + } + if {$lastindent ne ""} { + set paramlines [split $param \n] + if {[llength $paramlines] == 1} { + append out $pt $param + } else { + append out $pt [lindex $paramlines 0] + foreach nextline [lrange $paramlines 1 end] { + append out \n $lastindent $nextline + } + } + } else { + append out $pt $param + } + append lastline $param + } } return $out } @@ -4239,7 +4896,7 @@ tcl::namespace::eval punk::args::lib { } } else { if {$in_placeholder == 2} { - #skip opening bracket + #skip opening bracket dollar sign set in_placeholder 1 } else { append echars $ch @@ -4294,11 +4951,248 @@ tcl::namespace::eval punk::args::lib { return [lappend list [tcl::string::range $text $start end]] } + #like textutil::adjust::indent - but doesn't strip trailing lines, and doesn't implement skip parameter. + proc indent {text {prefix " "}} { + set result [list] + foreach line [split $text \n] { + if {[string trim $line] eq ""} { + lappend result "" + } else { + lappend result $prefix[string trimright $line] + } + } + return [join $result \n] + } + #dedent? + proc undent {text} { + if {$text eq ""} { + return "" + } + set lines [split $text \n] + set nonblank [list] + foreach ln $lines { + if {[string trim $ln] eq ""} { + continue + } + lappend nonblank $ln + } + set lcp [longestCommonPrefix $nonblank] + if {$lcp eq ""} { + return $text + } + regexp {^([\t ]*)} $lcp _m lcp + if {$lcp eq ""} { + return $text + } + set len [string length $lcp] + set result [list] + foreach ln $lines { + if {[string trim $ln] eq ""} { + lappend result "" + } else { + lappend result [string range $ln $len end] + } + } + return [join $result \n] + } + + #hacky + proc undentleader {text leader} { + #leader usually whitespace - but doesn't have to be + if {$text eq ""} { + return "" + } + set lines [split $text \n] + set nonblank [list] + foreach ln $lines { + if {[string trim $ln] eq ""} { + continue + } + lappend nonblank $ln + } + lappend nonblank "${leader}!!" + set lcp [longestCommonPrefix $nonblank] + if {$lcp eq ""} { + return $text + } + #regexp {^([\t ]*)} $lcp _m lcp + #lcp can be shorter than leader + set lcp [string range $lcp 0 [string length $leader]-1] + + if {$lcp eq ""} { + return $text + } + set len [string length $lcp] + set result [list] + foreach ln $lines { + if {[string trim $ln] eq ""} { + lappend result "" + } else { + lappend result [string range $ln $len end] + } + } + return [join $result \n] + } + #A version of textutil::string::longestCommonPrefixList + proc longestCommonPrefix {items} { + if {[llength $items] <= 1} { + return [lindex $items 0] + } + set items [lsort $items[unset items]] + set min [lindex $items 0] + set max [lindex $items end] + #if first and last of sorted list share a prefix - then all do (first and last of sorted list are the most different in the list) + #(sort order nothing to do with length - e.g min may be longer than max) + if {[string length $min] > [string length $max]} { + set temp $min + set min $max + set max $temp + } + set n [string length $min] + set prefix "" + set i -1 + while {[incr i] < $n && ([set c [string index $min $i]] eq [string index $max $i])} { + append prefix $c + } + return $prefix + } + #*** !doctools #[list_end] [comment {--- end definitions namespace punk::args::lib ---}] } + +tcl::namespace::eval punk::args::argdocbase { + namespace export * + #use a? to test and create literal ansi here rather than relying on punk::ansi package presence + #e.g + #% a? bold + #- bold │SGR 1│sample│â›[1msample + #- ──────┼─────┼──────┼────────── + #- RESULT│ │sample│â›[1msample + proc B {} {return \x1b\[1m} ;#a+ bold + proc N {} {return \x1b\[22m} ;#a+ normal + proc I {} {return \x1b\[3m} ;#a+ italic + proc NI {} {return \x1b\[23m} ;#a+ noitalic + +} # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +tcl::namespace::eval punk::args::package { + variable PUNKARGS + lappend PUNKARGS [list { + @dynamic + @id -id "::punk::args::package::standard_about" + @cmd -name "%pkg%::about" -help\ + "About %pkg% + ... + " + -package_about_namespace -type string -optional 0 -help\ + "Namespace containing the package about procedures + Must contain " + -return\ + -type string\ + -default table\ + -choices {string table tableobject}\ + -choicelabels { + string\ + "A basic text layout" + table\ + "layout in table borders + (requires package: textblock)" + tableobject\ + "textblock::class::table object instance" + }\ + -help\ + "Choose the return type of the 'about' information" + topic -optional 1\ + -nocase 1\ + -default {*}\ + -choices {Description License Version Contact *}\ + -choicerestricted 0\ + -choicelabels { + + }\ + -multiple 1\ + -help\ + "Topic to display. Omit or specify as * to see all. + If * is included with explicit topics, * represents + the remaining unmentioned topics." + }] + proc standard_about {args} { + set argd [punk::args::parse $args withid ::punk::args::package::standard_about] + lassign [dict values $argd] leaders OPTS values received + + set pkgns [dict get $OPTS -package_about_namespace] + if {[info commands ${pkgns}::package_name] eq ""} { + error "punk::args::package::standard_about unable to find function ${pkgns}::package_name" + } + set pkgname [${pkgns}::package_name] + + set opt_return [dict get $OPTS -return] + set all_topics [${pkgns}::about_topics] + if {![dict exists $received topic]} { + set topics $all_topics + } else { + # * represents all remaining topics not explicitly mentioned. + set val_topics [dict get $values topic] ;#if -multiple is true, this is a list + set explicit_topics [lsearch -all -inline -exact -not $val_topics "*"] + set topics [list] + foreach t $val_topics { + if {$t eq "*"} { + foreach a $all_topics { + if {$a ni $explicit_topics} { + lappend topics $a + } + } + } else { + lappend topics $t + } + } + } + if {$opt_return ne "string"} { + package require textblock ;#table support + set is_table 1 + set title [string cat {[} $pkgname {]} ] + set t [textblock::class::table new -title $title] + $t configure -frametype double -minwidth [expr {[string length $title]+2}] + + } else { + set topiclens [lmap t $topics {string length $t}] + set widest_topic [tcl::mathfunc::max {*}$topiclens] + set is_table 0 + set about "$pkgname\n" + append about [string repeat - $widest_topic] \n + } + foreach topic $topics { + if {[llength [info commands ::${pkgns}::get_topic_$topic]] == 1} { + set topic_contents [::${pkgns}::get_topic_$topic] + } else { + set topic_contents "" + } + if {!$is_table} { + set content_lines [split $topic_contents \n] + append about [format %-${widest_topic}s $topic] " " [lindex $content_lines 0] \n + foreach ln [lrange $content_lines 1 end] { + append about [format %-${widest_topic}s ""] " " $ln \n + } + } else { + $t add_row [list $topic $topic_contents] + } + } + + if {!$is_table} { + return $about + } else { + if {$opt_return eq "tableobject"} { + return $t + } + set result [$t print] + $t destroy + return $result + } + } + +} #usually we would directly call arg definitions near the defining proc, # so that the proc could directly use the definition in its parsing. @@ -4314,7 +5208,7 @@ tcl::namespace::eval punk::args::lib { # set PUNKARGS "" #} -lappend ::punk::args::register::NAMESPACES ::punk::args::argdoc ::punk::args ::punk::args::lib +lappend ::punk::args::register::NAMESPACES ::punk::args::argdoc ::punk::args ::punk::args::lib ::punk::args::package # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools @@ -4326,8 +5220,6 @@ tcl::namespace::eval punk::args::system { #dict get value with default wrapper for tcl 8.6 if {[info commands ::tcl::dict::getdef] eq ""} { - #package require punk::lib - #interp alias "" ::punk::args::Dict_getdef "" ::punk::lib::dict_getdef proc Dict_getdef {dictValue args} { set keys [lrange $args 0 end-1] if {[tcl::dict::exists $dictValue {*}$keys]} { @@ -4354,6 +5246,8 @@ tcl::namespace::eval punk::args::system { } } + + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::args [tcl::namespace::eval punk::args { diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/char-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/char-0.1.0.tm index 8cb06b1f..43dcd6b5 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/char-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/char-0.1.0.tm @@ -2015,7 +2015,7 @@ tcl::namespace::eval punk::char { # ------------------------------------------------------------------------------------------------------ proc grapheme_split_tk {string} { if {![regexp "\[\uFF-\U10FFFF\]" $string]} { - #only ascii - no joiners or unicode + #only ascii (7 or 8 bit) - no joiners or unicode return [split $string {}] } package require tk @@ -2068,14 +2068,14 @@ tcl::namespace::eval punk::char { return $width } proc wcswidth_single {char} { - scan $c %c dec - if {$c <= 255 && !($c < 31 || $c == 127)} { + scan $char %c dec + if {$dec <= 255 && !($dec < 31 || $dec == 127)} { #review - non-printing ascii? why does textutil::wcswidth report 1 ?? #todo - compare with python or other lang wcwidth return 1 - } elseif {$c < 917504 || $c > 917631} { + } elseif {$dec < 917504 || $dec > 917631} { #TODO - various other joiners and non-printing chars - return [textutil::wcswidth_char $c] + return [textutil::wcswidth_char $dec] ;#note textutil::wcswidth_char takes a decimal codepoint! #may return -1 - REVIEW } return 0 @@ -2084,13 +2084,13 @@ tcl::namespace::eval punk::char { set width 0 foreach c [split $string {}] { scan $c %c dec - if {$c <= 255 && !($c < 31 || $c == 127)} { + if {$dec <= 255 && !($dec < 31 || $dec == 127)} { #review - non-printing ascii? why does textutil::wcswidth report 1 ?? #todo - compare with python or other lang wcwidth incr width - } elseif {$c < 917504 || $c > 917631} { + } elseif {$dec < 917504 || $dec > 917631} { #TODO - various other joiners and non-printing chars - set w [textutil::wcswidth_char $c] + set w [textutil::wcswidth_char $dec] ;#takes decimal codepoint if {$w < 0} { return -1 } else { @@ -2117,14 +2117,14 @@ tcl::namespace::eval punk::char { set chunk [tcl::string::range $string $startidx $endidx] set codes [scan $chunk [tcl::string::repeat %c [tcl::string::length $chunk]]] - foreach c $codes { - if {$c <= 255 && !($c < 31 || $c == 127)} { + foreach dec $codes { + if {$dec <= 255 && !($dec < 31 || $dec == 127)} { #review - non-printing ascii? why does textutil::wcswidth report 1 ?? #todo - compare with python or other lang wcwidth incr width - } elseif {$c < 917504 || $c > 917631} { + } elseif {$dec < 917504 || $dec > 917631} { #TODO - various other joiners and non-printing chars - set w [textutil::wcswidth_char $c] + set w [textutil::wcswidth_char $dec] if {$w < 0} { return -1 } else { @@ -2145,18 +2145,18 @@ tcl::namespace::eval punk::char { #TODO set codes [scan $string [tcl::string::repeat %c [tcl::string::length $string]]] set width 0 - foreach c $codes { + foreach dec $codes { #unicode Tags block zero width - if {$c < 917504 || $c > 917631} { - if {$c <= 255} { + if {$dec < 917504 || $dec > 917631} { + if {$dec <= 255} { #review - non-printing ascii? why does textutil::wcswidth report 1 ?? #todo - compare with python or other lang wcwidth - if {!($c < 31 || $c == 127)} { + if {!($dec < 31 || $dec == 127)} { incr width } } else { #TODO - various other joiners and non-printing chars - set w [textutil::wcswidth_char $c] + set w [textutil::wcswidth_char $dec] ;#takes decimal codepoint if {$w < 0} { return -1 } else { @@ -2169,7 +2169,7 @@ tcl::namespace::eval punk::char { } proc wcswidth2 {string} { set codes [scan $string [tcl::string::repeat %c [tcl::string::length $string]]] - set widths [lmap c $codes {textutil::wcswidth_char $c}] + set widths [lmap dec $codes {textutil::wcswidth_char $dec}] if {-1 in $widths} { return -1 } diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.1.1.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.1.1.tm index 74365afa..2e10e75b 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.1.1.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.1.1.tm @@ -102,7 +102,8 @@ namespace eval punk::console { } variable ansi_response_chunk ;#array keyed on callid variable ansi_response_wait ;#array keyed on callid - variable ansi_response_queue ;#list of callids + array set ansi_response_wait {} + variable ansi_response_queue [list];#list of callids variable ansi_response_queuedata ;#dict keyed on callid - with function params # -- @@ -123,10 +124,6 @@ namespace eval punk::console { #ansi escape sequences are possibly preferable esp if terminal is remote to process running punk::console # punk::local commands may be more performant in some circumstances where console is directly attached, but it shouldn't be assumed. e.g ansi::titleset outperforms local::titleset on windows with twapi. - namespace eval ansi { - #ansi escape sequence based terminal/console control functions - namespace export * - } namespace eval local { #non-ansi terminal/console control functions #e.g external utils system API's. @@ -578,12 +575,73 @@ namespace eval punk::console { } - #capturingendregex should capture ANY prefix, whole escape match - and a subcapture of the data we're interested in and match at end of string. - #ie {(.*)(ESC(info)end)$} - #e.g {(.*)(\x1bP44!~([:alnum:])\x1b\\)$} - #we expect 4 results from regexp -indices -inline (overallmatch, prefix, wholeescape,info) + lappend PUNKARGS [list { + @id -id ::punk::console::internal::get_ansi_response_payload + @cmd -name punk::console::internal::get_ansi_response_payload -help\ + "Terminal query helper. + Captures the significant portion (payload as defined by + supplied capturingendregex capture groups) of the input + channel's response to a query placed on the output channel. + Usually this means a write to stdout with a response on + stdin. + This function uses a 'chan event' read handler function + ::punk::console::internal::ansi_response_handler_regex to + read the input channel character by character to ensure it + doesn't overconsume input. + + It can run cooperatively with the punk::repl stdin reader + or other readers if done carefully. + The mechanism to run while other readers are active involves + disabling and re-enabling installed 'chan event' handlers + and possibly using a shared namespace variable + (::punk::console::input_chunks_waiting) to ensure all data + gets to the right handler. (unread data on input prior to this + function being called) + Not fully documented. (source diving required -see punk::repl) + " + @opts + -ignoreok -type boolean -default 0 -help\ + "Experimental/debug + ignore the regex match 'ok' response + and keep going." + -return -type string -default payload -choices {payload dict} -choicelabels { + dict\ + "dict with keys prefix,response,payload,all" + } -help\ + "Return format" + + -terminal -default {stdin stdout} -type list -help\ + "terminal (currently list of in/out channels) (todo - object?)" + -expected_ms -default 100 -type integer -help\ + "Expected number of ms for response from terminal. + 100ms is usually plenty for a local terminal and a + basic query such as cursor position." + @values -min 2 -max 2 + query -type string -help\ + "ANSI sequence such as \x1b\[?6n which + should elicit a response by the terminal + on stdin" + capturingendregex -type string -help\ + "capturingendregex should capture ANY prefix, whole escape match - and a subcapture + of the data we're interested in; and match at end of string. + ie {(.*)(ESC(info)end)$} + e.g {(.*)(\x1bP44!~([:alnum:])\x1b\\)$} + we expect 4 results from regexp -indices -inline (overallmatch, prefix, wholeescape,info)" + }] #todo - check capturingendregex value supplied has appropriate captures and tail-anchor - proc get_ansi_response_payload {query capturingendregex {inoutchannels {stdin stdout}}} { + proc get_ansi_response_payload {args} { + #we pay a few 10s of microseconds to use punk::args::parse (on the happy path) + #seems reasonable for the flexibility in this case. + set argd [punk::args::parse $args withid ::punk::console::internal::get_ansi_response_payload] + lassign [dict values $argd] leaders opts values received + + set inoutchannels [dict get $opts -terminal] + set expected [dict get $opts -expected_ms] + set ignoreok [dict get $opts -ignoreok] + set returntype [dict get $opts -return] + set query [dict get $values query] + set capturingendregex [dict get $values capturingendregex] + lassign $inoutchannels input output #chunks from input that need to be handled by readers @@ -595,10 +653,12 @@ namespace eval punk::console { #In other contexts there may not even be another input reader #REVIEW - what if there is existing data in input_chunks_waiting - is it for us? - #temp - let's keep alert to it until we decide if it's legit/required.. - if {[info exists input_chunks_waiting($input)] && [llength $input_chunks_waiting($input)]} { - #puts stderr "[punk::ansi::a+ cyan bold]get_ansi_response_payload called while input_chunks_waiting($input) contained data: $input_chunks_waiting($input)[punk::ansi::a]" - } + #This occurs for example with key held down on autorepeat and is normal + #enable it here for debug/testing only + #if {[info exists input_chunks_waiting($input)] && [llength $input_chunks_waiting($input)]} { + # puts stderr "[punk::ansi::a+ cyan bold]get_ansi_response_payload called while input_chunks_waiting($input) contained data: [punk::ansi::a][ansistring VIEW $input_chunks_waiting($input)]" + #} + if {!$::punk::console::ansi_available} { return "" } @@ -615,17 +675,33 @@ namespace eval punk::console { upvar ::punk::console::ansi_response_wait waitvar upvar ::punk::console::ansi_response_queue queue upvar ::punk::console::ansi_response_queuedata queuedata - upvar ::punk::console::ansi_response_clock clock + upvar ::punk::console::ansi_response_tslaunch tslaunch + upvar ::punk::console::ansi_response_tsclock tsclock upvar ::punk::console::ansi_response_timeoutid timeoutid - set accumulator($callid) "" - set waitvar($callid) "" - lappend queue $callid + set accumulator($callid) "" + set waitvar($callid) "" + + lappend queue $callid + if {[llength $queue] > 1} { + #while {[lindex $queue 0] ne $callid} {} + set queuedata($callid) $args + set runningid [lindex $queue 0] + while {$runningid ne $callid} { + vwait ::punk::console::ansi_response_wait + set runningid [lindex $queue 0] + if {$runningid ne $callid} { + set ::punk::console::ansi_response_wait($runningid) $::punk::console::ansi_response_wait($runningid) + update ;#REVIEW - probably a bad idea + after 10 + } + } + } #todo - use a linked array and an accumulatorid and waitvar id? When can there be more than one terminal query in-flight? - set existing_handler [fileevent $input readable] ;#review! + set existing_handler [chan event $input readable] ;#review! set this_handler ::punk::console::internal::ansi_response_handler_regex if {[lindex $existing_handler 0] eq $this_handler} { puts stderr "[punk::ansi::a+ red]Warning for callid $callid get_ansi_response_payload called while existing ansi response handler in place[a]: $this_handler" @@ -633,109 +709,145 @@ namespace eval punk::console { flush stderr if {[lindex $queue 0] ne $callid} { + error "get_ansi_response_payload - re-entrancy unrecoverable" } - error "get_ansi_response_payload - re-entrancy unrecoverable" } + chan event $input readable {} - fileevent $input readable {} - - set input_state [fconfigure $input] - #todo - make timeout configurable? - set waitvarname "::punk::console::ansi_response_wait($callid)" - #500ms is generally plenty for a terminal to respond.. but not in some cases. e.g event loop busy with stdin keypress?? review - set timeoutid($callid) [after 1000 [list set $waitvarname timedout]] - - #JMN # - stderr vs stdout #It has to be same channel as used by functions such as test_char_width or erroneous results returned for those functions #(presumably race conditions as to when data hits console?) #review - experiment changing this and calling functions to stderr and see if it works #review - Are there disadvantages to using stdout vs stderr? - #puts stdout "sending console request [ansistring VIEW $query]" - puts -nonewline $output $query;flush $output + + set previous_input_state [chan configure $input] + #chan configure $input -blocking 0 + + #todo - make timeout configurable? + set waitvarname "::punk::console::ansi_response_wait($callid)" + #todo - test and save rawstate so we don't disableRaw if console was already raw if {![tsv::get console is_raw]} { set was_raw 0 punk::console::enableRaw + #after 0 [list chan event $input readable [list $this_handler $input $callid $capturingendregex]] + incr expected 50 ;#review + set timeoutid($callid) [after $expected [list set $waitvarname timedout]] + #puts stdout "sending console request [ansistring VIEW $query]" } else { set was_raw 1 + set timeoutid($callid) [after $expected [list set $waitvarname timedout]] } - fconfigure $input -blocking 0 - # - #in handler - its used for a boolean match (capturing aspect not used) - set clock($callid) [clock millis] ;#time of launch - may be delay before first event depending on what's going on + chan configure $input -blocking 0 - #first shot without using filevent, call the stdin reader directly - maybe it's there already - #This can be significantly faster than setting up a fileevent (2024 e.g 1.5ms vs 65ms) + set tslaunch($callid) [clock millis] ;#time of launch - may be delay before first event depending on what's going on + set tsclock($callid) $tslaunch($callid) + #write before console enableRaw vs after?? + #There seem to be problems (e.g on WSL) if we write too early - the output ends up on screen but we don't read it + puts -nonewline $output $query;flush $output $this_handler $input $callid $capturingendregex - if {$waitvar($callid) ne "ok"} { - fileevent $input readable [list $this_handler $input $callid $capturingendregex] + + if {$ignoreok || $waitvar($callid) ne "ok"} { + chan event $input readable [list $this_handler $input $callid $capturingendregex] } - #JMN #response from terminal #e.g for cursor position \033\[46;1R - - if {[set waitvar($callid)] eq ""} { - vwait ::punk::console::ansi_response_wait($callid) + #after 0 [list $this_handler $input $callid $capturingendregex] + set remaining $expected + if {$waitvar($callid) eq ""} { + set lastvwait [clock millis] + vwait ::punk::console::ansi_response_wait($callid) #puts stderr ">>>> end vwait1 $waitvar($callid)<<<<" - while {[string match extend-* $waitvar($callid)]} { - set extension [lindex [split $waitvar($callid) -] 1] - #puts stderr "get_ansi_response_payload Extending timeout by $extension" - #after cancel $timeoutid($callid) - set timeoutid($callid) [after $extension [list set $waitvarname timedout]] - vwait ::punk::console::ansi_response_wait($callid) + while {[string match extend-* $waitvar($callid)] || ($ignoreok && $waitvar($callid) eq "ok")} { + if {[string match extend-* $waitvar($callid)]} { + set extension [lindex [split $waitvar($callid) -] 1] + if {$extension eq ""} { + puts "blank extension $waitvar($callid)" + puts "->[set $waitvar($callid]<-" + } + puts stderr "get_ansi_response_payload Extending timeout by $extension" + after cancel $timeoutid($callid) + set total_elapsed [expr {[clock millis] - $tslaunch($callid)}] + set last_elapsed [expr {[clock millis] - $lastvwait}] + set remaining [expr {$remaining - $last_elapsed}] + if {$remaining < 0} {set remaining 0} + set newtime [expr {$remaining + $extension}] + set timeoutid($callid) [after $newtime [list set $waitvarname timedout]] + set lastvwait [clock millis] + vwait ::punk::console::ansi_response_wait($callid) + } else { + #ignoreok - reapply the handler that disabled itself due to 'ok' + chan event $input readable [list $this_handler $input $callid $capturingendregex] + set lastvwait [clock millis] + vwait ::punk::console::ansi_response_wait($callid) + } } } - #response handler automatically removes it's own fileevent - fileevent $input readable {} ;#explicit remove anyway - review + #response handler automatically removes it's own chan event + chan event $input readable {} ;#explicit remove anyway - review if {$waitvar($callid) ne "timedout"} { after cancel $timeoutid($callid) } else { - puts stderr "timeout in get_ansi_response_payload. callid $callid Ansi request was:[ansistring VIEW -lf 1 -vt 1 $query]" + puts stderr "timeout (timediff [expr {[clock millis] - $tslaunch($callid)}]ms) in get_ansi_response_payload. callid $callid Ansi request was:[ansistring VIEW -lf 1 -vt 1 $query]" } if {$was_raw == 0} { punk::console::disableRaw } + #restore $input state - fconfigure $input -blocking [dict get $input_state -blocking] + #it *might* be ok to restore entire state on an input channel + #(it's not always on all channels - e.g stdout has -winsize which is read-only) + #Safest to only restore what we think we've modified. + fconfigure $input -blocking [dict get $previous_input_state -blocking] - set response [set accumulator($callid)] + set input_read [set accumulator($callid)] - if {$response ne ""} { - set got_match [regexp -indices $capturingendregex $response _match_indices prefix_indices response_indices payload_indices] + if {$input_read ne ""} { + set got_match [regexp -indices $capturingendregex $input_read _match_indices prefix_indices response_indices payload_indices] if {$got_match} { - set responsedata [string range $response {*}$response_indices] - set payload [string range $response {*}$payload_indices] - set prefixdata [string range $response {*}$prefix_indices] - if {$prefixdata ne ""} { - #puts stderr "Warning - get_ansi_response_payload read extra data at start - '[ansistring VIEW -lf 1 $prefixdata]' (response=[ansistring VIEW -lf 1 $responsedata])" + set responsedata [string range $input_read {*}$response_indices] + set payload [string range $input_read {*}$payload_indices] + set prefixdata [string range $input_read {*}$prefix_indices] + if {!$ignoreok && $prefixdata ne ""} { + #puts stderr "Warning - get_ansi_response_payload read extra data at start - '[ansistring VIEW -lf 1 $prefixdata]' (responsedata=[ansistring VIEW -lf 1 $responsedata])" lappend input_chunks_waiting($input) $prefixdata } } else { #timedout - or eof? - puts stderr "get_ansi_response_payload callid:$callid regex match '$capturingendregex' to data '[ansistring VIEW -lf 1 -vt 1 $response]' not found" - lappend input_chunks_waiting($input) $response - set payload "" + if {!$ignoreok} { + puts stderr "get_ansi_response_payload callid:$callid regex match '$capturingendregex' to input_read '[ansistring VIEW -lf 1 -vt 1 $input_read]' not found" + lappend input_chunks_waiting($input) $input_read + set payload "" + } else { + set responsedata "" + set payload "" + set prefixdata "" + } } } else { #timedout or eof? and nothing read - set payload "" + set responsedata "" + set prefixdata "" + set payload "" } + # ------------------------------------------------------------------------------------- + # Other input readers + # ------------------------------------------------------------------------------------- #is there a way to know if existing_handler is input_chunks_waiting aware? if {[string length $existing_handler] && [lindex $existing_handler 0] ne $this_handler} { #puts "get_ansi_response_payload reinstalling ------>$existing_handler<------" - fileevent $input readable $existing_handler - #we may have consumed all pending input on $input - so there may be no trigger for the readable fileevent + chan event $input readable $existing_handler + #this_handler may have consumed all pending input on $input - so there may be no trigger for the readable chan event for existing_handler if {[llength $input_chunks_waiting($input)]} { #This is experimental If a handler is aware of input_chunks_waiting - there should be no need to schedule a trigger #If it isn't, but the handler can accept an existing chunk of data as a 'waiting' argument - we could trigger and pass it the waiting chunks - but there's no way to know its API. @@ -772,33 +884,49 @@ namespace eval punk::console { #The input_chunks_waiting may really belong to the existing_handler we found - but if it doesn't consume them they will end up being read by the repl_handler when it eventually re-enables. #todo - some better structure than just a list of waiting chunks indexed by input channel, so repl/other handlers can determine the context in which these waiting chunks were generated? } elseif {[package provide punk::repl::codethread] ne "" && [punk::repl::codethread::is_running]} { - if {[llength $input_chunks_waiting($input)]} { + #if {[llength $input_chunks_waiting($input)]} { #don't trigger the repl handler manually - we will inevitably get things out of order - as it knows when to enable/disable itself based on whether chunks are waiting. #triggering it by putting it on the eventloop will potentially result in re-entrancy #The cooperating reader must be designed to consume waiting chunks and only reschedule it's channel read handler once all waiting chunks have been consumed. #puts stderr "[punk::ansi::a+ green bold]--> repl_handler has chunks to consume [ansistring VIEW $input_chunks_waiting($input)][punk::ansi::a]" - } + #} if {[eof $input]} { #test - puts stdout "restarting repl" + puts stdout "get_ansi_response_payload experimental - restarting repl" repl::reopen stdin } } + # ------------------------------------------------------------------------------------- - catch { - unset accumulator($callid) - unset waitvar($callid) - dict unset queuedata $callid - } - if {[llength $queue] > 1} { - set next_callid [lindex $queue 1] + + + unset -nocomplain accumulator($callid) + unset -nocomplain waitvar($callid) + unset -nocomplain timeoutid($callid) + unset -nocomplain tsclock($callid) + unset -nocomplain tslaunch($callid) + dict unset queuedata $callid + + lpop queue 0 + if {[llength $queue] > 0} { + set next_callid [lindex $queue 0] set waitvar($callid) go_ahead + #set nextdata [set queuedata($next_callid)] } - lpop queue 0 + #set punk::console::chunk "" - return $payload + if {$returntype eq "dict"} { + return [dict create\ + prefix $prefixdata\ + payload $payload\ + response $responsedata\ + all $input_read\ + ] + } else { + return $payload + } } @@ -811,43 +939,66 @@ namespace eval punk::console { proc ansi_response_handler_regex {chan callid endregex} { upvar ::punk::console::ansi_response_chunk chunks upvar ::punk::console::ansi_response_wait waits - upvar ::punk::console::ansi_response_clock clock ;#initial time in millis was set when fileevent was created + upvar ::punk::console::ansi_response_tslaunch tslaunch ;#initial time in millis was set when chan event was created + upvar ::punk::console::ansi_response_tsclock tsclock #endregex should explicitly have a trailing $ set status [catch {read $chan 1} bytes] if { $status != 0 } { # Error on the channel - fileevent $chan readable {} + chan event $chan readable {} puts "ansi_response_handler_regex error reading $chan: $bytes" - set waits($callid) [list error_read status $status bytes $bytes] + set waits($callid) [list error error_read status $status bytes $bytes] } elseif {$bytes ne ""} { + #puts stderr . ;flush stderr # Successfully read the channel #puts "got: [string length $bytes]bytes" - append chunks($callid) $bytes + set sofar [append chunks($callid) $bytes] #puts stderr [ansistring VIEW $chunks($callid)] - if {[regexp $endregex $chunks($callid)]} { - fileevent $chan readable {} + #review - what is min length of any ansiresponse? + #endregex is capturing - but as we are only testing the match here + #it should perform the same as if it were non-capturing + if {[string length $sofar] > 3 && [regexp $endregex $sofar]} { #puts stderr "matched - setting ansi_response_wait($callid) ok" + chan event $chan readable {} set waits($callid) ok } else { - if {[string length $chunks($callid)] % 10 == 0 || $clock($callid) - [clock millis] > 50} { - after cancel $::punk::console::ansi_response_timeoutid($callid) - set waits($callid) extend-1000 + # 30ms 16ms? + set tsnow [clock millis] + set total_elapsed [expr {[set tslaunch($callid)] - $tsnow}] + set last_elapsed [expr {[set tsclock($callid)] - $tsnow}] + if {[string length $chunks($callid)] % 10 == 0 || $last_elapsed > 16} { + if {$total_elapsed > 3000} { + #REVIEW + #too long since initial read handler launched.. + #is other data being pumped into stdin? Eventloop starvation? Did we miss our codes? + #For now we'll stop extending the timeout. + after cancel $::punk::console::ansi_response_timeoutid($callid) + set waits($callid) [list error error_ansi_response_handler_regex_too_long_reading] + } else { + if {$last_elapsed > 0} { + after cancel $::punk::console::ansi_response_timeoutid($callid) + set waits($callid) extend-[expr {min(16,$last_elapsed)}] + } + } } + set tsclock(callid) [clock millis] } } elseif {[catch {eof $chan}] || [eof $chan]} { - catch {fileevent $chan readable {}} + catch {chan event $chan readable {}} # End of file on the channel #review puts stderr "ansi_response_handler_regex end of file on channel $chan" set waits($callid) eof - } elseif {![catch {fblocked $chan}] && [fblocked $chan]} { - # Read blocked. Just return + } elseif {![catch {chan blocked $chan}] && [chan blocked $chan]} { + # Read blocked is normal. (chan -blocking = 0 but reading only 1 char) # Caller should be using timeout on the wait variable + #set waits($callid) continue + set tsclock($callid) [clock millis] } else { - fileevent $chan readable {} + chan event $chan readable {} # Something else - puts stderr "ansi_response_handler_regex Situation shouldn't be possible. No error and no bytes read on channel $chan but chan is not fblocked or EOF" + puts stderr "ansi_response_handler_regex Situation shouldn't be possible. No error and no bytes read on channel $chan but not chan blocked or EOF" set waits($callid) error_unknown_zerobytes_while_not_blocked_or_eof } } @@ -865,17 +1016,9 @@ namespace eval punk::console { #a and a+ functions are not very useful when emitting directly to console #e.g puts [punk::console::a red]test[punk::console::a cyan] would produce a cyan coloured test as the commands are evaluated first - proc a? {args} { - #stdout - variable ansi_wanted - if {$ansi_wanted <= 0} { - puts -nonewline [punk::ansi::ansistripraw [::punk::ansi::a?]] - } else { - tailcall ansi::a? {*}$args - } - } - punk::args::set_alias ::punk::console::code_a+ ::punk::ansi::a+ + #punk::args::set_alias ::punk::console::code_a+ ::punk::ansi::a+ + lappend PUNKARGS_aliases {::punk::console::code_a+ ::punk::ansi::a+} proc code_a+ {args} { variable ansi_wanted if {$ansi_wanted <= 0} { @@ -885,6 +1028,7 @@ namespace eval punk::console { #tailcall punk::ansi::a+ {*}$args ::punk::ansi::a+ {*}$args } + lappend PUNKARGS_aliases {::punk::console::code_a ::punk::ansi::a} proc code_a {args} { variable ansi_wanted if {$ansi_wanted <= 0} { @@ -893,6 +1037,7 @@ namespace eval punk::console { #tailcall punk::ansi::a {*}$args ::punk::ansi::a {*}$args } + lappend PUNKARGS_aliases {::punk::console::code_a? ::punk::ansi::a?} proc code_a? {args} { variable ansi_wanted if {$ansi_wanted <= 0} { @@ -901,6 +1046,15 @@ namespace eval punk::console { tailcall ::punk::ansi::a? {*}$args } } + #proc a? {args} { + # #stdout + # variable ansi_wanted + # if {$ansi_wanted <= 0} { + # puts -nonewline [punk::ansi::ansistripraw [::punk::ansi::a?]] + # } else { + # tailcall ansi::a? {*}$args + # } + #} #REVIEW! this needs reworking. #It needs to be clarified as to what ansi off is supposed to do. @@ -968,38 +1122,36 @@ namespace eval punk::console { return [expr {!$colour_disabled}] } - - namespace eval ansi { - proc a {args} { - puts -nonewline [::punk::ansi::a {*}$args] - } - proc a? {args} { - puts -nonewline stdout [::punk::ansi::a? {*}$args] - } - proc a+ {args} { - puts -nonewline [::punk::ansi::a+ {*}$args] - } - proc clear {} { - puts -nonewline stdout [punk::ansi::clear] - } - proc clear_above {} { - puts -nonewline stdout [punk::ansi::clear_above] + #test - find a better place to set terminal type + variable is_vt52 0 + proc vt52 {{onoff {}}} { + #todo - return to colour state beforehand?. support 0-15 vt52 colours? + #we shouldn't have to trun off colour to enter vt52 - we should make punk::console emit correct codes + variable is_vt52 + if {$onoff eq ""} { + return $is_vt52 } - proc clear_below {} { - puts -nonewline stdout [punk::ansi::clear_below] + if {![string is boolean -strict $onoff]} { + error "vt52 setting must be a boolean - or empty to query" } - proc clear_all {} { - puts -nonewline stdout [punk::ansi::clear_all] - } - proc reset {} { - puts -nonewline stdout [punk::ansi::reset] + if {$is_vt52} { + if {!$onoff} { + puts -nonewline "\x1b<" + set is_vt52 0 + colour on + } + } else { + if {$onoff} { + unset_mode DECANM + set is_vt52 1 + colour off + } else { + puts -nonewline "\x1b<" + #emit even though our is_vt52 flag thinks it's on. Should be harmless if underlying terminal already vt100+ + } } + return $is_vt52 } - namespace import ansi::clear - namespace import ansi::clear_above - namespace import ansi::clear_below - namespace import ansi::clear_all - namespace import ansi::reset namespace eval local { proc set_codepage_output {cpname} { @@ -1018,22 +1170,117 @@ namespace eval punk::console { error "set_codepage_input unimplemented on $::tcl_platform(platform)" } } + lappend PUNKARGS [list { + @id -id ::punk::console::local::echo + @cmd -name punk::console::local::echo -help\ + "Use stty on unix, or twapi on windows to set terminal + local input echo on/off - experimental" + @values -min 0 -max 1 + onoff -type boolean -default "" -help\ + "Omit or pass empty string to query current echo state." + }] + proc echo {args} { + set argd [punk::args::parse $args withid ::punk::console::local::echo] + set onoff [dict get $argd values onoff] + + set is_windows [string equal "windows" $::tcl_platform(platform)] + if {$onoff eq ""} { + #query + if {$is_windows} { + package require twapi + set inputstate [twapi::get_console_input_mode] + return [dict get $inputstate -echoinput] + } else { + #counterintuitively - the human format (-a) seems more consistent across platforms than the machine readable (-g) formats + #for now, quick and dirty look for echo in the list seems to work on wsl & freebsd at least. + set tstate [exec stty -a] + if {[lsearch $tstate echo] > 0} { + return 1 + } else { + return 0 + } + } + } else { + if {![string is boolean -strict $onoff]} { + error "::punk::console::local::echo requires boolean argument to set on or off" + } + if {$is_windows} { + set onoff [expr {true && $onoff}] ;#ensure true,yes etc are converted to 1|0 + set conh [twapi::get_console_handle stdin] + twapi::modify_console_input_mode $conh -echoinput $onoff + + return $onoff + } else { + if {$onoff} { + {*}[auto_execok stty] echo + return 1 + } else { + {*}[auto_execok stty] -echo + return 0 + } + } + } + } } namespace import local::set_codepage_output namespace import local::set_codepage_input + + lappend PUNKARGS [list { + @id -id ::punk::console::show_input_response + @cmd -name punk::console::show_input_response -help\ + "" + @opts + -terminal -default {stdin stdout} -type list -help\ + "terminal (currently list of in/out channels) (todo - object?)" + -expected_ms -type integer -default 500 -help\ + "Number of ms to wait for response" + @values -min 1 -max 1 + request -type string -help\ + "ANSI sequence such as \x1b\[?6n which + should elicit a response by the terminal + on stdin" + }] + proc show_input_response {args} { + set argd [punk::args::parse $args withid ::punk::console::show_input_response] + lassign [dict values $argd] leaders opts values received + set request [dict get $values request] + set inoutchannels [dict get $opts -terminal] + set expected [dict get $opts -expected_ms] + + set capturingregex {(((.*)))$} ;#capture entire response same as response-payload + set ts_start [clock millis] + set response [punk::console::internal::get_ansi_response_payload -ignoreok 1 -return dict -expected_ms $expected -terminal $inoutchannels $request $capturingregex] + set ts_end [clock millis] + puts stderr $response + set out "" + dict for {k v} $response { + append out "$k [ansistring VIEW $v]" \n + } + append out "totalms [expr {$ts_end - $ts_start}]" + return $out + } + # -- --- --- --- --- --- --- #get_ansi_response functions #review - can these functions sensibly be used on channels not attached to the local console? #ie can we default to {stdin stdout} but allow other channel pairs? # -- --- --- --- --- --- --- proc get_cursor_pos {{inoutchannels {stdin stdout}}} { + if {$::punk::console::is_vt52} { + error "vt52 can't perform get_cursor_pos" + } #response from terminal #e.g \033\[46;1R set capturingregex {(.*)(\x1b\[([0-9]+;[0-9]+)R)$} ;#must capture prefix,entire-response,response-payload set request "\033\[6n" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] + #some terminals fail to respond properly to \x1b\[6n but do respond to \x1b\[?6n and vice-versa :/ + #todo - what? + #often terminals that fail will just put the raw request code on stdin - we could detect that and then + #try the other? + return $payload } proc get_checksum_rect {id page t l b r {inoutchannels {stdin stdout}}} { @@ -1041,13 +1288,13 @@ namespace eval punk::console { #re e.g {(.*)(\x1b\[P44!~([[:alnum:]])\x1b\[\\)$} set capturingregex [string map [list %id% $id] {(.*)(\x1bP%id%!~([[:alnum:]]+)\x1b\\)$}] set request "\x1b\[${id}\;${page}\;$t\;$l\;$b\;$r*y" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } proc get_device_status {{inoutchannels {stdin stdout}}} { set capturingregex {(.*)(\x1b\[([0-9]+)n)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[5n" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } @@ -1083,7 +1330,7 @@ namespace eval punk::console { #set capturingregex {(.*)(\x1b\[\?6[0-9][;]*([;0-9]+)c)$} ;#must capture prefix,entire-response,response-payload set capturingregex {(.*)(\x1b\[\?([0-9]*[;0-9]+)c)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[c" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] set last_da1_result $payload return $payload } @@ -1093,14 +1340,14 @@ namespace eval punk::console { set capturingregex {(.*)(\x1b\[\>([0-9]*[;][0-9]*[;][0-1]c))$} ;#must capture prefix,entire-response,response-payload #expect CSI > X;10|20;0|1c - docs suggest X should be something like 61. In practice we see 0 or 1 (windows) REVIEW set request "\x1b\[>c" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } proc get_device_attributes_tertiary {{inoutchannels {stdin stdout}}} { #DA3 set capturingregex {(.*)(\x1bP!\|([0-9]{8})\x1b\\)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[=c" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } proc get_terminal_id {{inoutchannels {stdin stdout}}} { @@ -1115,7 +1362,7 @@ namespace eval punk::console { #set capturingregex {(.*)(\x1bP2$u((?:[0-9]+)*(?:\/[0-9]+)*)\x1b\\)$} set capturingregex {(.*)(\x1bP2\$u(.*)\x1b\\)$} set request "\x1b\[2\$w" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] set tabstops [split $payload "/"] return $tabstops } @@ -1263,18 +1510,29 @@ namespace eval punk::console { } #keep out of catch - no point in even trying a restore move if we can't get start position - just fail here. + #no vt52 equiv? may as well strip all vt52 from here? lassign [get_cursor_pos_list $inoutchannels] start_row start_col - + variable is_vt52 + if {!$is_vt52} { + set movefunc "punk::ansi::move" + set func_coff "punk::ansi::cursor_off" + set func_con "punk::ansi::cursor_on" + } else { + set movefunc "punk::ansi::vt52move" + set func_coff "punk::ansi::cursor_off_vt52" + set func_con "punk::ansi::cursor_on_vt52" + } if {[catch { #some terminals (conemu on windows) scroll the viewport when we make a big move down like this - a move to 1 1 immediately after cursor_save doesn't seem to fix that. #This issue also occurs when switching back from the alternate screen buffer - so perhaps that needs to be addressed elsewhere. - puts -nonewline $out [punk::ansi::cursor_off][punk::ansi::move 2000 2000] + + puts -nonewline $out [$func_coff][$movefunc 2000 2000] lassign [get_cursor_pos_list $inoutchannels] lines cols - puts -nonewline $out [punk::ansi::move $start_row $start_col][punk::console::cursor_on];flush stdout + puts -nonewline $out [$movefunc $start_row $start_col][$func_con];flush stdout set result [list columns $cols rows $lines] } errM]} { - puts -nonewline $out [punk::ansi::move $start_row $start_col] - puts -nonewline $out [punk::ansi::cursor_on] + puts -nonewline $out [$movefunc $start_row $start_col] + puts -nonewline $out [$func_con] error "$errM" } else { return $result @@ -1316,21 +1574,24 @@ namespace eval punk::console { proc get_xterm_size {{inoutchannels {stdin stdout}}} { set capturingregex {(.*)(\x1b\[8;([0-9]+;[0-9]+)t)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[18t" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] lassign [split $payload {;}] rows cols return [list columns $cols rows $rows] } proc get_xterm_pixels {{inoutchannels {stdin stdout}}} { set capturingregex {(.*)(\x1b\[4;([0-9]+;[0-9]+)t)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[14t" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] lassign [split $payload {;}] height width return [list width $width height $height] } + + + proc get_mode_line_wrap {{inoutchannels {stdin stdout}}} { set capturingregex {(.*)(\x1b\[\?7;([0-9]+)\$y)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[?7\$p" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } #Terminals generally default to LNM being reset (off) ie enter key sends a lone @@ -1339,7 +1600,7 @@ namespace eval punk::console { proc get_mode_LNM {{inoutchannels {stdin stdout}}} { set capturingregex {(.*)(\x1b\[\?20;([0-9]+)\$y)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[?20\$p" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } #DECRPM responses e.g: @@ -1359,7 +1620,7 @@ namespace eval punk::console { } set capturingregex [string map [list %MODE% $m] {(.*)(\x1b\[\?%MODE%;([0-9]+)\$y)$}] ;#must capture prefix,entire-response,response-payload set request "\x1b\[?$m\$p" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } proc set_mode {num_or_name {inoutchannels {stdin stdout}}} { @@ -1373,7 +1634,7 @@ namespace eval punk::console { error "punk::console::set_mode unrecognised mode '$num_or_name'. Known mode names: [dict keys $decmode_names]" } } - return "\x1b\[?${m}h" + puts -nonewline "\x1b\[?${m}h" } proc unset_mode {num_or_name {inoutchannels {stdin stdout}}} { if {[string is integer -strict $num_or_name]} { @@ -1386,7 +1647,7 @@ namespace eval punk::console { error "punk::console::unset_mode unrecognised mode '$num_or_name'. Known mode names: [dict keys $decmode_names]" } } - return "\x1b\[?${m}l" + puts -nonewline "\x1b\[?${m}l" } @@ -1584,16 +1845,6 @@ namespace eval punk::console { return [dict create available $is_available mode $m] } - namespace eval ansi { - proc cursor_on {} { - puts -nonewline stdout [punk::ansi::cursor_on] - } - proc cursor_off {} { - puts -nonewline stdout [punk::ansi::cursor_off] - } - } - namespace import ansi::cursor_on - namespace import ansi::cursor_off #review - the concept of using local mechanisms at all (ie apis) vs ansi is not necessarily something we want/need to support. #For the system to be really useful if needs to operate in conditions where the terminal is remote @@ -1625,24 +1876,6 @@ namespace eval punk::console { } } - namespace eval ansi { - proc titleset {windowtitle} { - puts -nonewline stdout [punk::ansi::titleset $windowtitle] - } - } - #namespace import ansi::titleset - proc titleset {windowtitle} { - variable ansi_wanted - if { $ansi_wanted <= 0} { - punk::console::local::titleset $windowtitle - } else { - ansi::titleset $windowtitle - } - } - #no known pure-ansi solution - proc titleget {} { - return [local::titleget] - } proc infocmp {} { set cmd1 [auto_execok infocmp] @@ -1685,16 +1918,113 @@ namespace eval punk::console { return [split $data ";"] } + #channel? namespace eval ansi { + variable PUNKARGS + #ansi escape sequence based terminal/console control functions + namespace export * + + #proc a {args} { + # puts -nonewline [::punk::ansi::a {*}$args] + #} + #proc a+ {args} { + # puts -nonewline [::punk::ansi::a+ {*}$args] + #} + #proc a? {args} { + # puts -nonewline stdout [::punk::ansi::a? {*}$args] + #} + proc clear {} { + puts -nonewline stdout [punk::ansi::clear] + } + proc clear_above {} { + puts -nonewline stdout [punk::ansi::clear_above] + } + proc clear_below {} { + puts -nonewline stdout [punk::ansi::clear_below] + } + proc clear_all {} { + puts -nonewline stdout [punk::ansi::clear_all] + } + proc reset {} { + puts -nonewline stdout [punk::ansi::reset] + } + proc cursor_on {} { + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::cursor_on] + } else { + puts -nonewline stdout [punk::ansi::cursor_on_vt52] + } + } + proc cursor_off {} { + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::cursor_off] + } else { + puts -nonewline stdout [punk::ansi::cursor_off_vt52] + } + } + + lappend PUNKARGS [list { + @id -id ::punk::console::ansi::move + @cmd -name punk::console::move -help\ + {Return an ANSI or vt52 sequence to move cursor to row,col + (aka: cursor home) + + The sequence emitted will depend on the mode of the + terminal as stored in the consolehandle. + Directly setting the mode via raw escape sequences: + e.g unset_mode DECANM for vt52 + or puts \x1b< to return to ANSI + will not necessarily update the application of + the change in terminal state. Major state changes + such as this should be done via provided functions + that keep the REPL state in sync with the underlying + terminal state. + + For ANSI the sequence is of the form: + ESC[;H + (CSI row ; col H) + This sequence will generally not be understood by + terminals that are in vt52 mode. + + For VT52 the sequence is of the form: + ESCY + This sequence will generally not be understood by + terminals that are not in vt52 mode even if higher + modes are supported. + + } + @values -min 2 -max 2 + row -type integer -help\ + "row number - starting at 1" + col -type integer -help\ + "column number - starting at 1" + }] proc move {row col} { - puts -nonewline stdout [punk::ansi::move $row $col] + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + return [punk::ansi::move $row $col] + } else { + return [punk::ansi::vt52move $row $col] + } } proc move_forward {n} { - puts -nonewline stdout [punk::ansi::move_forward $n] + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::move_forward $n] + } else { + puts -nonewline stdout [punk::ansi::vt52move_forward $n] + } } proc move_back {n} { - puts -nonewline stdout [punk::ansi::move_back $n] + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::move_back $n] + } else { + puts -nonewline stdout [punk::ansi::vt52move_back $n] + } } proc move_up {n} { puts -nonewline stdout [punk::ansi::move_up $n] @@ -1703,21 +2033,101 @@ namespace eval punk::console { puts -nonewline stdout [punk::ansi::move_down $n] } proc move_column {col} { - puts -nonewline stdout [punk::ansi::move_column $col] + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::move_column $col] + } else { + puts -nonewline stdout [punk::ansi::vt52move_column $col] + } } proc move_row {row} { puts -nonewline stdout [punk::ansi::move_row $row] } proc move_emit {row col data args} { - puts -nonewline stdout [punk::ansi::move_emit $row $col $data {*}$args] + upvar ::punk::console::is_v52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::move_emit $row $col $data {*}$args] + } else { + puts -nonewline stdout [punk::ansi::v52move_emit $row $col $data {*}$args] + } } proc move_emit_return {row col data args} { + #todo detect if in raw mode or not? + set is_in_raw 0 lassign [punk::console::get_cursor_pos_list] orig_row orig_col - set out "" - append out [punk::ansi::move_emit $row $col $data {*}$args] + + set commands "" + append commands [punk::ansi::move_emit $row $col $data {*}$args] + foreach {row col data} $args { + append commands [punk::ansi::move_emit $row $col $data {*}$args] + } if {!$is_in_raw} { incr orig_row -1 } + append commands [punk::ansi::move $orig_row $orig_col] + puts -nonewline stdout $commands + return "" + } + proc move_emitblock_return {row col textblock} { + lassign [punk::console::get_cursor_pos_list] orig_row orig_col + + set commands "" + foreach ln [split $textblock \n] { + append commands [punk::ansi::move_emit $row $col $ln] + incr row + } + append commands [punk::ansi::move $orig_row $orig_col] + puts -nonewline $commands + return + } + #we can be (slightly?) faster and more efficient if we use the consoles cursor_save_dec command - but each savecursor overrides any previous one. + #leave cursor_off/cursor_on to caller who can wrap more efficiently.. + proc cursorsave_move_emit_return {row col data args} { + upvar ::punk::console::is_vt52 is_vt52 + #JMN + set commands "" + if {!$is_vt52} { + append commands [punk::ansi::cursor_save_dec] + append commands [punk::ansi::move_emit $row $col $data] + foreach {row col data} $args { + append commands [punk::ansi::move_emit $row $col $data] + } + append commands [punk::ansi::cursor_restore_dec] + } else { + append commands [punk::ansi::cursor_save_vt52] + append commands [punk::ansi::vt52move_emit $row $col $data] + foreach {row col data} $args { + append commands [punk::ansi::vt52move_emit $row $col $data] + } + append commands [punk::ansi::cursor_restore_vt52] + } + puts -nonewline stdout $commands; flush stdout + } + proc cursorsave_move_emitblock_return {row col textblock} { + set commands "" + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + append commands [punk::ansi::cursor_save_dec] + foreach ln [split $textblock \n] { + append commands [punk::ansi::move_emit $row $col $ln] + incr row + } + append commands [punk::ansi::cursor_restore_dec] + } else { + append commands [punk::ansi::cursor_save_vt52] + foreach ln [split $textblock \n] { + append commands [punk::ansi::vt52move_emit $row $col $ln] + incr row + } + append commands [punk::ansi::cursor_restore_vt52] + } + puts -nonewline stdout $commands;flush stdout + return + } + proc move_call_return {row col script} { + lassign [punk::console::get_cursor_pos_list] orig_row orig_col + move $row $col + uplevel 1 $script move $orig_row $orig_col } proc scroll_up {n} { @@ -1772,28 +2182,49 @@ namespace eval punk::console { proc delete_lines {count} { puts -nonewline \x1b\[${count}M } + proc titleset {windowtitle} { + puts -nonewline stdout [punk::ansi::titleset $windowtitle] + } + proc test_decaln {} { + puts -nonewline stdout [punk::ansi::test_decaln] + } + } + namespace import ::punk::console::ansi::* + catch {rename titleset ""} + #namespace import ansi::titleset + proc titleset {windowtitle} { + variable ansi_wanted + if { $ansi_wanted <= 0} { + punk::console::local::titleset $windowtitle + } else { + ansi::titleset $windowtitle + } + } + #no known pure-ansi solution + proc titleget {} { + return [local::titleget] + } + + foreach ansicmd [list ::punk::console::ansi::move] { + set ctail [namespace tail $ansicmd] + set arglist [info args $ansicmd] + set argcall "" + if {[llength $arglist]} { + foreach a [lrange $arglist 0 end-1] { + append argcall "\$$a " + } + if {[lindex $arglist end] eq "args"} { + append argcall {{*}$args} + } else { + append argcall "\$[lindex $arglist end]" + } + } + catch {rename $ctail ""} + proc $ctail $arglist [string map [list %ansicmd% $ansicmd %argcall% $argcall] { + puts -nonewline [%ansicmd% %argcall%] + }] } - namespace import ansi::move - namespace import ansi::move_emit - namespace import ansi::move_forward - namespace import ansi::move_back - namespace import ansi::move_up - namespace import ansi::move_down - namespace import ansi::move_column - namespace import ansi::move_row - namespace import ansi::cursor_save - namespace import ansi::cursor_restore - namespace import ansi::cursor_save_dec - namespace import ansi::cursor_restore_dec - namespace import ansi::scroll_up - namespace import ansi::scroll_down - namespace import ansi::enable_alt_screen - namespace import ansi::disable_alt_screen - namespace import ansi::insert_spaces - namespace import ansi::delete_characters - namespace import ansi::erase_characters - namespace import ansi::insert_lines - namespace import ansi::delete_lines + #experimental @@ -1812,90 +2243,25 @@ namespace eval punk::console { puts -nonewline [punk::ansi::erase_eol][punk::ansi::move_column $col]$text cursor_restore } - proc move_emit_return {row col data args} { - #todo detect if in raw mode or not? - set is_in_raw 0 - lassign [punk::console::get_cursor_pos_list] orig_row orig_col - set commands "" - append commands [punk::ansi::move_emit $row $col $data] - foreach {row col data} $args { - append commands [punk::ansi::move_emit $row $col $data] - } - if {!$is_in_raw} { - incr orig_row -1 - } - append commands [punk::ansi::move $orig_row $orig_col] - puts -nonewline stdout $commands - return "" - } - #we can be (slightly?) faster and more efficient if we use the consoles cursor_save_dec command - but each savecursor overrides any previous one. - #leave cursor_off/cursor_on to caller who can wrap more efficiently.. - proc cursorsave_move_emit_return {row col data args} { - set commands "" - append commands [punk::ansi::cursor_save_dec] - append commands [punk::ansi::move_emit $row $col $data] - foreach {row col data} $args { - append commands [punk::ansi::move_emit $row $col $data] - } - append commands [punk::ansi::cursor_restore_dec] - puts -nonewline stdout $commands; flush stdout - } - proc move_emitblock_return {row col textblock} { + #this doesn't work - we would need an internal virtual screen structure to pick up cursor attributes from arbitrary locations? + # ncurses and its ilk may have something like that - but we specifically want to avoid curses libraries + proc pick {row col} { lassign [punk::console::get_cursor_pos_list] orig_row orig_col - - set commands "" - foreach ln [split $textblock \n] { - append commands [punk::ansi::move_emit $row $col $ln] - incr row - } - append commands [punk::ansi::move $orig_row $orig_col] - puts -nonewline $commands - return - } - proc cursorsave_move_emitblock_return {row col textblock} { - set commands "" - append commands [punk::ansi::cursor_save_dec] - foreach ln [split $textblock \n] { - append commands [punk::ansi::move_emit $row $col $ln] - incr row - } - append commands [punk::ansi::cursor_restore_dec] - puts -nonewline stdout $commands;flush stdout - return - } - proc move_call_return {row col script} { + set test "" + #set test [a green Yellow] + move_emit $row $col $test\0337 + puts -nonewline \0338\033\[${orig_row}\;${orig_col}H + } + proc pick_emit {row col data} { + set test "" + #set test [a green Purple] lassign [punk::console::get_cursor_pos_list] orig_row orig_col - move $row $col - uplevel 1 $script - move $orig_row $orig_col + move_emit $row $col $test\0337 + puts -nonewline \0338\033\[${orig_row}\;${orig_col}H$data } - #this doesn't work - we would need an internal virtual screen structure to pick up cursor attributes from arbitrary locations? - # ncurses and its ilk may have something like that - but we specifically want to avoid curses libraries - proc pick {row col} { - lassign [punk::console::get_cursor_pos_list] orig_row orig_col - set test "" - #set test [a green Yellow] - move_emit $row $col $test\0337 - puts -nonewline \0338\033\[${orig_row}\;${orig_col}H - } - proc pick_emit {row col data} { - set test "" - #set test [a green Purple] - lassign [punk::console::get_cursor_pos_list] orig_row orig_col - move_emit $row $col $test\0337 - puts -nonewline \0338\033\[${orig_row}\;${orig_col}H$data - } - # -- --- --- --- --- --- - namespace eval ansi { - proc test_decaln {} { - puts -nonewline stdout [punk::ansi::test_decaln] - } - } - namespace import ansi::test_decaln - namespace eval clock { #map chars of chars "0" to "?"" ie 0x30 to x3f @@ -2152,7 +2518,7 @@ namespace eval punk::console { puts stderr "punk::console WARNING: no modern unicode support in this Tcl version. High unicode values not properly supported. (string length \\U00010000 : $high_unicode_length should be 1)" } else { set can_high_unicode 1 - set can_regex_high_unicode [string match [regexp -all -inline {[\U80-\U0010FFFF]} \U0001F525] \U0001F525] + set can_regex_high_unicode [string equal [regexp -all -inline {[\U80-\U0010FFFF]} \U0001F525] \U0001F525] if {!$can_regex_high_unicode} { puts stderr "punk::console warning: TCL version cannot perform braced regex of high unicode" } @@ -2235,6 +2601,10 @@ namespace eval punk::console::check { +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::console ::punk::console::internal ::punk::console::local ::punk::console::ansi +} diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.1.1.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.1.1.tm index 1381af87..09a73385 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.1.1.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.1.1.tm @@ -246,6 +246,58 @@ tcl::namespace::eval punk::lib::compat { #outside of lmap - don't know of any particularly nice ways to flatten to subindex 1 of each element.. #flattening then lsearch with -stride and * would be nice - but it's not avail in 8.6 + if {![info exists ::auto_index(readFile)]} { + if {[info commands ::readFile] eq ""} { + proc ::readFile {filename {mode text}} { + #readFile not seen in auto_index or as command: installed by punk::lib + # Parse the arguments + set MODES {binary text} + set ERR [list -level 1 -errorcode [list TCL LOOKUP MODE $mode]] + set mode [tcl::prefix match -message "mode" -error $ERR $MODES $mode] + + # Read the file + set f [open $filename [dict get {text r binary rb} $mode]] + try { + return [read $f] + } finally { + close $f + } + } + } + } + if {![info exists ::auto_index(writeFile)]} { + if {[info commands ::writeFile] eq ""} { + proc ::writeFile {args} { + #writeFile not seen in auto_index or as command: installed by punk::lib + # Parse the arguments + switch [llength $args] { + 2 { + lassign $args filename data + set mode text + } + 3 { + lassign $args filename mode data + set MODES {binary text} + set ERR [list -level 1 -errorcode [list TCL LOOKUP MODE $mode]] + set mode [tcl::prefix match -message "mode" -error $ERR $MODES $mode] + } + default { + set COMMAND [lindex [info level 0] 0] + return -code error -errorcode {TCL WRONGARGS} "wrong # args: should be \"$COMMAND filename ?mode? data\"" + } + } + + # Write the File + set f [open $filename [dict get {text w binary wb} $mode]] + try { + puts -nonewline $f $data + } finally { + close $f + } + } + } + } + if {"::lpop" ne [info commands ::lpop]} { #puts stderr "Warning - no built-in lpop" interp alias {} lpop {} ::punk::lib::compat::lpop @@ -1021,35 +1073,35 @@ namespace eval punk::lib { -separator -default "%sep%" -roottype -default "dict" -substructure -default {} - -channel -default stdout -help "existing channel - or 'none' to return as string" + -channel -default stdout -help\ + "existing channel - or 'none' to return as string" @values -min 1 -max -1 dictvar -type string -help "name of variable. Can be a dict, list or array" patterns -type string -default "*" -multiple 1 -help {Multiple patterns can be specified as separate arguments. - Each pattern consists of 1 or more segments separated by the hierarchy separator (forward slash) - The system uses similar patterns to the punk pipeline pattern-matching system. - The default assumed type is dict - but an array will automatically be extracted into key value pairs so will also work. - Segments are classified into list,dict and string operations. - Leading % indicates a string operation - e.g %# gives string length - A segment with a single @ is a list operation e.g @0 gives first list element, @1-3 gives the lrange from 1 to 3 - A segment containing 2 @ symbols is a dict operation. e.g @@k1 retrieves the value for dict key 'k1' - The operation type indicator is not always necessary if lower segments in the hierarchy are of the same type as the previous one. - e.g1 pdict env */%# - the pattern starts with default type dict, so * retrieves all keys & values, - the next hierarchy switches to a string operation to get the length of each value. - e.g2 pdict env W* S* - Here we supply 2 patterns, each in default dict mode - to display keys and values where the keys match the glob patterns - e.g3 pdict punk_testd */* - This displays 2 levels of the dict hierarchy. - Note that if the sublevel can't actually be interpreted as a dictionary (odd number of elements or not a list at all) - - then the normal = separator will be replaced with a coloured (or underlined if colour off) 'mismatch' indicator. - e.g4 set list {{k1 v1 k2 v2} {k1 vv1 k2 vv2}}; pdict list @0-end/@@k2 @*/@@k1 - Here we supply 2 separate pattern hierarchies, where @0-end and @* are list operations and are equivalent - The second level segement in each pattern switches to a dict operation to retrieve the value by key. - When a list operation such as @* is used - integer list indexes are displayed on the left side of the = for that hierarchy level. - + Each pattern consists of 1 or more segments separated by the hierarchy separator (forward slash) + The system uses similar patterns to the punk pipeline pattern-matching system. + The default assumed type is dict - but an array will automatically be extracted into key value pairs so will also work. + Segments are classified into list,dict and string operations. + Leading % indicates a string operation - e.g %# gives string length + A segment with a single @ is a list operation e.g @0 gives first list element, @1-3 gives the lrange from 1 to 3 + A segment containing 2 @ symbols is a dict operation. e.g @@k1 retrieves the value for dict key 'k1' + The operation type indicator is not always necessary if lower segments in the hierarchy are of the same type as the previous one. + e.g1 pdict env */%# + the pattern starts with default type dict, so * retrieves all keys & values, + the next hierarchy switches to a string operation to get the length of each value. + e.g2 pdict env W* S* + Here we supply 2 patterns, each in default dict mode - to display keys and values where the keys match the glob patterns + e.g3 pdict punk_testd */* + This displays 2 levels of the dict hierarchy. + Note that if the sublevel can't actually be interpreted as a dictionary (odd number of elements or not a list at all) + - then the normal = separator will be replaced with a coloured (or underlined if colour off) 'mismatch' indicator. + e.g4 set list {{k1 v1 k2 v2} {k1 vv1 k2 vv2}}; pdict list @0-end/@@k2 @*/@@k1 + Here we supply 2 separate pattern hierarchies, where @0-end and @* are list operations and are equivalent + The second level segement in each pattern switches to a dict operation to retrieve the value by key. + When a list operation such as @* is used - integer list indexes are displayed on the left side of the = for that hierarchy level. } }] #puts stderr "$argspec" @@ -1091,7 +1143,8 @@ namespace eval punk::lib { set sep " [punk::ansi::a+ Green]=$RST " ;#stick to basic default colours for wider terminal support set sep_mismatch " [punk::ansi::a+ Brightred undercurly underline undt-white]mismatch$RST " } - package require punk ;#we need pipeline pattern matching features + package require punk::pipe + #package require punk ;#we need pipeline pattern matching features package require textblock set argd [punk::args::get_dict [string map [list %sep% $sep %sep_mismatch% $sep_mismatch] { @@ -1102,23 +1155,29 @@ namespace eval punk::lib { -channel -default none -trimright -default 1 -type boolean -help\ "Trim whitespace off rhs of each line. - This can help prevent a single long line that wraps in terminal from making - every line wrap due to long rhs padding. - " - -separator -default {%sep%} -help "Separator column between keys and values" - -separator_mismatch -default {%sep_mismatch%} -help "Separator to use when patterns mismatch" - -roottype -default "dict" -help "list,dict,string" - -ansibase_keys -default "" -help "ansi list for each level in -substructure. e.g \[list \[a+ red\] \[a+ web-green\]\]" + This can help prevent a single long line that wraps in terminal from making + every line wrap due to long rhs padding." + -separator -default {%sep%} -help\ + "Separator column between keys and values" + -separator_mismatch -default {%sep_mismatch%} -help\ + "Separator to use when patterns mismatch" + -roottype -default "dict" -help\ + "list,dict,string" + -ansibase_keys -default "" -help\ + "ansi list for each level in -substructure. e.g \[list \[a+ red\] \[a+ web-green\]\]" -substructure -default {} -ansibase_values -default "" - -keytemplates -default {\$\{$key\}} -type list -help "list of templates for keys at each level" + -keytemplates -default {\$\{$key\}} -type list -help\ + "list of templates for keys at each level" -keysorttype -default "none" -choices {none dictionary ascii integer real} -keysortdirection -default increasing -choices {increasing decreasing} -debug -default 0 -type boolean -help\ "When enabled, produces some rudimentary debug output on stderr" @values -min 1 -max -1 - dictvalue -type list -help "dict or list value" - patterns -default "*" -type string -multiple 1 -help "key or key glob pattern" + dictvalue -type list -help\ + "dict or list value" + patterns -default "*" -type string -multiple 1 -help\ + "key or key glob pattern" }] $args] #for punk::lib - we want to reduce pkg dependencies. @@ -1201,7 +1260,7 @@ namespace eval punk::lib { set segments [split $pattern_nest /] set levelpatterns [lindex $segments 0] ;#possibly comma separated patterns #we need to use _split_patterns to separate (e.g to protect commas that appear within quotes) - set patterninfo [punk::_split_patterns $levelpatterns] + set patterninfo [punk::pipe::lib::_split_patterns $levelpatterns] #puts stderr "showdict-->_split_patterns: $patterninfo" foreach v_idx $patterninfo { lassign $v_idx v idx @@ -1479,7 +1538,7 @@ namespace eval punk::lib { # -- --- --- --- set substructure "" set pnext [lindex $segments 1] - set patterninfo [punk::_split_patterns $levelpatterns] + set patterninfo [punk::pipe::lib::_split_patterns $levelpatterns] if {[llength $patterninfo] == 0} { # // ? -review - what does this mean? for xpath this would mean at any level set substructure [lindex $pattern_this_structure end] @@ -2043,18 +2102,32 @@ namespace eval punk::lib { concat {*}[uplevel 1 lmap {*}$args] } - proc dict_getdef {dictValue args} { - if {[llength $args] < 1} { - error {wrong # args: should be "dict_getdef dictValue ?key ...? key default"} - } - set keys [lrange $args -1 end-1] - if {[tcl::dict::exists $dictValue {*}$keys]} { - return [tcl::dict::get $dictValue {*}$keys] - } else { - return [lindex $args end] + #proc dict_getdef {dictValue args} { + # if {[llength $args] < 1} { + # error {wrong # args: should be "dict_getdef dictValue ?key ...? key default"} + # } + # set keys [lrange $args -1 end-1] + # if {[tcl::dict::exists $dictValue {*}$keys]} { + # return [tcl::dict::get $dictValue {*}$keys] + # } else { + # return [lindex $args end] + # } + #} + if {[info commands ::tcl::dict::getdef] eq ""} { + proc dict_getdef {dictValue args} { + set keys [lrange $args 0 end-1] + if {[tcl::dict::exists $dictValue {*}$keys]} { + return [tcl::dict::get $dictValue {*}$keys] + } else { + return [lindex $args end] + } } + } else { + #we pay a minor perf penalty for the wrap + interp alias "" ::punk::lib::dict_getdef "" ::tcl::dict::getdef } + #proc sample1 {p1 n args} { # #*** !doctools # #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] @@ -2722,6 +2795,7 @@ namespace eval punk::lib { } return [join $result \n] } + #dedent? proc undent {text} { if {$text eq ""} { return "" @@ -3795,7 +3869,7 @@ namespace eval punk::lib { } } - + #*** !doctools #[list_end] [comment {--- end definitions namespace punk::lib ---}] @@ -4142,12 +4216,10 @@ tcl::namespace::eval punk::lib::debug { proc showdict {args} {} } -if {![info exists ::punk::args::register::NAMESPACES]} { - namespace eval ::punk::args::register { - set ::punk::args::register::NAMESPACES [list] ;#use fully qualified so 8.6 doesn't find existing var in global namespace - } +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::lib } -lappend ::punk::args::register::NAMESPACES ::punk::lib # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::lib [tcl::namespace::eval punk::lib { diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/cli-0.3.1.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/cli-0.3.1.tm index 9e463eff..5d38fad8 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/cli-0.3.1.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/cli-0.3.1.tm @@ -177,7 +177,8 @@ namespace eval punk::mix::cli { } } } - cd $sourcefolder + #cd $sourcefolder + #use run so that stdout visible as it goes if {![catch {run --timeout=55000 -debug [info nameofexecutable] $sourcefolder/make.tcl {*}$args} exitinfo]} { #todo - notify if exit because of timeout! @@ -185,11 +186,11 @@ namespace eval punk::mix::cli { set exitcode [dict get $exitinfo exitcode] } else { puts stderr "Error unable to determine exitcode. err: $exitinfo" - cd $startdir + #cd $startdir return false } - cd $startdir + #cd $startdir if {$exitcode != 0} { puts stderr "FAILED with exitcode $exitcode" return false @@ -364,10 +365,10 @@ namespace eval punk::mix::cli { #ignore trailing .tm .TM if present #if version doesn't pass validation - treat it as part of the modulename and return empty version string without error #Up to caller to validate. - proc split_modulename_version {modulename} { - set lastpart [namespace tail $modulename] + proc split_modulename_version {fullmodulename} { + set lastpart [namespace tail $fullmodulename] set lastpart [file tail $lastpart] ;# should be ok to use file tail now that we've ensured no namespace components - if {[string equal -nocase [file extension $modulename] ".tm"]} { + if {[string equal -nocase [file extension $fullmodulename] ".tm"]} { set fileparts [split [file rootname $lastpart] -] } else { set fileparts [split $lastpart -] @@ -380,7 +381,13 @@ namespace eval punk::mix::cli { set namesegment [join $fileparts -] set versionsegment "" } - return [list $namesegment $versionsegment] + set base [namespace qualifiers $fullmodulename] + if {$base ne ""} { + set modulename "${base}::$namesegment" + } else { + set modulename $namesegment + } + return [list $modulename $versionsegment] } proc get_status {{workingdir ""} args} { diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm index 47c75d33..05e94a25 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm @@ -31,16 +31,42 @@ namespace eval punk::mix::commandset::layout { namespace export * + namespace eval argdoc { + proc layout_names {} { + if {[catch {punk::mix::commandset::layout::lib::layouts_dict *} ldict]} { + #REVIEW + return "punk.project" + } else { + return [dict keys $ldict] + } + } + } #per layout functions - proc files {{layout ""}} { - set argd [punk::args::get_dict { - @id -id ::punk::mix::commandset::layout::files - @values -min 1 -max 1 - layout -type string -minsize 1 - } [list $layout]] + punk::args::define { + @dynamic + @id -id ::punk::mix::commandset::layout::files + -datetime -default "%Y-%m-%dT%H:%M:%S" -help\ + "Datetime format for mtime. Use empty string for no datetime output" + @values -min 1 -max 1 + layout -type string -choices {${[punk::mix::commandset::layout::argdoc::layout_names]}} + } + proc files {args} { + set argd [punk::args::get_by_id ::punk::mix::commandset::layout::files $args] + set layout [dict get $argd values layout] + set dtformat [dict get $argd opts -datetime] set allfiles [lib::layout_all_files $layout] - return [join $allfiles \n] + if {$dtformat eq ""} { + return [join $allfiles \n] + } else { + set out "" + foreach f $allfiles { + set mtime [dict get [file stat $f] mtime] + append out "$f [clock format $mtime -format $dtformat]" \n + } + set out [string range $out 0 end-1] + return $out + } } proc templatefiles {layout} { set templatefiles_and_tags [lib::layout_scan_for_template_files $layout] @@ -166,7 +192,7 @@ namespace eval punk::mix::commandset::layout { } proc as_dict {args} { - tailcall punk::mix::commandset::layout::lib::layouts_dict {*}$args + punk::mix::commandset::layout::lib::layouts_dict {*}$args } proc references_as_dict {args} { package require punk::cap diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm index b5539021..b964d228 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm @@ -1,5 +1,5 @@ # -*- tcl -*- -# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from -buildversion.txt +# Maintenance Instruction: leave the 999999.xxx.x as is and use 'deck make' or src/make.tcl to update from -buildversion.txt # # Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. # Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. @@ -304,11 +304,12 @@ namespace eval punk::mix::commandset::loadedlib { } set versions [package versions [lindex $libfound 0]] - if {$has_natsort} { - set versions [natsort::sort $versions] - } else { - set versions [lsort $versions] - } + set versions [lsort -command {package vcompare} $versions] + #if {$has_natsort} { + # set versions [natsort::sort $versions] + #} else { + # set versions [lsort $versions] + #} if {![llength $versions]} { error "No version numbers found for library/module $libfound - sorry, you will need to copy it across manually" } diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm index 41206d0c..ae21d348 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm @@ -120,17 +120,20 @@ namespace eval punk::mix::commandset::module { return $table } - #return all module templates with repeated ones suffixed with .2 .3 etc + + #return all module templates with repeated ones suffixed with #2 #3 etc + punk::args::define { + @id -id ::punk::mix::commandset::module::templates_dict + @cmd -name templates_dict -help\ + "Templates from module and project paths" + -startdir -default "" -help\ + "Project folder used in addition to module paths" + -not -default "" -multiple 1 + @values + globsearches -default * -multiple 1 + } proc templates_dict {args} { - set argspec { - @id -id ::punk::mix::commandset::module::templates_dict - @cmd -name templates_dict -help "Templates from module and project paths" - -startdir -default "" -help "Project folder used in addition to module paths" - -not -default "" -multiple 1 - @values - globsearches -default * -multiple 1 - } - set argd [punk::args::get_dict $argspec $args] + set argd [punk::args::get_by_id ::punk::mix::commandset::module::templates_dict $args] package require punk::cap if {[punk::cap::capability_has_handler punk.templates]} { set template_folder_dict [punk::cap::call_handler punk.templates get_itemdict_moduletemplates {*}$args] @@ -154,10 +157,11 @@ namespace eval punk::mix::commandset::module { the higher version number will be used. " -license -default + -author -default -multiple 1 -template -default punk.module -type -default "[lindex $moduletypes 0]" -choices {$moduletypes} -force -default 0 -type boolean -help\ - "If set true, will overwrite an existing .tm file if there is one. + "If set true, will OVERWRITE an existing .tm file if there is one. If false (default) an error will be raised if there is a conflict." -quiet -default 0 -type boolean -help\ "Suppress information messages on stdout" @@ -262,6 +266,7 @@ namespace eval punk::mix::commandset::module { } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_license [dict get $opts -license] + set opt_authors [dict get $opts -author] ;#-multiple true # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_template [dict get $opts -template] if {[regexp {.*[?*].*} $opt_template]} { @@ -403,7 +408,7 @@ namespace eval punk::mix::commandset::module { #for now the user has the option to override any templates and remove %moduletemplate% if it is a security/privacy concern #Don't put literal %x% in the code for the commandset::module itself - to stop them being seen by layout scanner as replacable tokens - set tagnames [list moduletemplate $moduletemplate project $projectname pkg $modulename year $year license $opt_license version $infile_version] + set tagnames [list moduletemplate $moduletemplate project $projectname pkg $modulename year $year license $opt_license authors $opt_authors version $infile_version] set strmap [list] foreach {tag val} $tagnames { lappend strmap %$tag% $val diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/project-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/project-0.1.0.tm index 27ec8503..2ff8ac06 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/project-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/project-0.1.0.tm @@ -109,7 +109,26 @@ namespace eval punk::mix::commandset::project { } - + namespace eval argdoc { + set layout_dict [punk::cap::call_handler punk.templates get_itemdict_projectlayouts] + variable LAYOUTNAMES [dict keys $layout_dict] + } + punk::args::define { + @id -id ::punk::mix::commandset::project::new + @cmd -name "punk::mix::commandset::project::new" -help\ + "" + @leaders -min 1 -max 1 + project -type string -help\ + "Project name or path. + If just a name is given ... (todo)" + @opts + -type -default plain + -empty -default 0 -type boolean + -force -default 0 -type boolean + -update -default 0 -type boolean + -confirm -default 1 -type boolean + -layout -default "punk.project" -choices {${$::punk::mix::commandset::project::argdoc::LAYOUTNAMES}} + } proc new {newprojectpath_or_name args} { #*** !doctools @@ -300,7 +319,17 @@ namespace eval punk::mix::commandset::project { } } } elseif {$project_dir_exists && $opt_update} { - puts stderr "mix new WARNING: -update 1 was supplied. Will copy layout $layout_path using -update option to add missing items" + set warnmsg "mix new WARNING: -update 1 was supplied. Will copy layout $layout_path using -update option to add missing items" + if {$opt_confirm} { + puts stderr $warnmsg + set msg "Do you want to proceed to possibly overwrite some existing files in $projectdir? Y|N" + set answer [util::askuser $msg] + if {[string tolower $answer] ne "y"} { + puts stderr "mix new aborting due to user response '$answer' (required Y|y to proceed) use -confirm 0 to avoid prompt." + return + } + } + puts stderr $warnmsg } set fossil_repo_file "" @@ -366,28 +395,40 @@ namespace eval punk::mix::commandset::project { #default antiglob_dir_core will stop .fossil* from being updated - which is generally desirable as these are likely to be customized if {$opt_force} { puts stdout "copying layout files - with force applied - overwrite all-targets" - set resultdict [punkcheck::install $layout_path $projectdir -installer project.new -overwrite ALL-TARGETS -antiglob_paths $antipaths -antiglob_dir $antiglob_dir] + set resultdict [punkcheck::install $layout_path $projectdir -installer project.new -createempty 1 -overwrite ALL-TARGETS -antiglob_paths $antipaths -antiglob_dir $antiglob_dir] } else { puts stdout "copying layout files - (if source file changed)" - set resultdict [punkcheck::install $layout_path $projectdir -installer project.new -overwrite installedsourcechanged-targets -antiglob_paths $antipaths -antiglob_dir $antiglob_dir] + set resultdict [punkcheck::install $layout_path $projectdir -installer project.new -createempty 1 -overwrite installedsourcechanged-targets -antiglob_paths $antipaths -antiglob_dir $antiglob_dir] } puts stdout [punkcheck::summarize_install_resultdict $resultdict] - puts stdout "copying layout src/doc files (if target missing)" - set resultdict [punkcheck::install $layout_path/src/doc $projectdir/src/doc -punkcheck_folder $projectdir -installer project.new -overwrite SYNCED-TARGETS] - puts stdout [punkcheck::summarize_install_resultdict $resultdict] + if {[file exists $layout_path/src/doc]} { + puts stdout "copying layout src/doc files (if target missing)" + set resultdict [punkcheck::install $layout_path/src/doc $projectdir/src/doc -createdir 1 -punkcheck_folder $projectdir -installer project.new -overwrite SYNCED-TARGETS] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + } else { + puts stdout "no src/doc in source template - update not required" + } #target folders .fossil-custom and .fossil-settings may not exist. use -createdir 1 to ensure existence. #In this case we need to override the default dir antiglob - as .fossil-xxx folders need to be installed from template if missing, or if target is uncustomized. ## default_antiglob_dir_core [list "#*" "_aside" ".git" ".fossil*"] set override_antiglob_dir_core [list #* _aside .git] - puts stdout "copying layout src/.fossil-custom files (if target missing or uncustomised)" - set resultdict [punkcheck::install $layout_path/.fossil-custom $projectdir/.fossil-custom -createdir 1 -punkcheck_folder $projectdir -installer project.new -antiglob_dir_core $override_antiglob_dir_core -overwrite SYNCED-TARGETS] - puts stdout [punkcheck::summarize_install_resultdict $resultdict] + if {[file exists $layout_path/.fossil-custom]} { + puts stdout "copying layout src/.fossil-custom files (if target missing or uncustomised)" + set resultdict [punkcheck::install $layout_path/.fossil-custom $projectdir/.fossil-custom -createdir 1 -createempty 1 -punkcheck_folder $projectdir -installer project.new -antiglob_dir_core $override_antiglob_dir_core -overwrite SYNCED-TARGETS] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + } else { + puts stdout "no .fossil-custom in source template - update not required" + } - puts stdout "copying layout src/.fossil-settings files (if target missing or uncustomised)" - set resultdict [punkcheck::install $layout_path/.fossil-settings $projectdir/.fossil-settings -createdir 1 -punkcheck_folder $projectdir -installer project.new -antiglob_dir_core $override_antiglob_dir_core -overwrite SYNCED-TARGETS] - puts stdout [punkcheck::summarize_install_resultdict $resultdict] + if {[file exists $layout_path/.fossil-settings]} { + puts stdout "copying layout src/.fossil-settings files (if target missing or uncustomised)" + set resultdict [punkcheck::install $layout_path/.fossil-settings $projectdir/.fossil-settings -createdir 1 -createempty 1 -punkcheck_folder $projectdir -installer project.new -antiglob_dir_core $override_antiglob_dir_core -overwrite SYNCED-TARGETS] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + } else { + puts stdout "no .fossil-settings in source template - update not required" + } #scan all files in template # @@ -395,30 +436,19 @@ namespace eval punk::mix::commandset::project { set templatefiles [punk::mix::commandset::layout::lib::layout_scan_for_template_files $opt_layout] set stripprefix [file normalize $layout_path] - #set tagmap [list [lib::template_tag project] $projectname] - #todo - get from somewhere - set alltag_substitutions [list project $projectname] - + set tagmap [list [lib::template_tag project] $projectname] if {[llength $templatefiles]} { puts stdout "Filling template file placeholders with the following tag map:" - foreach {placeholder value} $alltag_substitutions { + foreach {placeholder value} $tagmap { puts stdout " $placeholder -> $value" } } - foreach templatefullpath_and_tags $templatefiles { - lassign $templatefullpath_and_tags templatefullpath tags_present - + foreach templatefullpath $templatefiles { set templatetail [punk::repo::path_strip_alreadynormalized_prefixdepth $templatefullpath $stripprefix] set fpath [file join $projectdir $templatetail] if {[file exists $fpath]} { set fd [open $fpath r]; fconfigure $fd -translation binary; set data [read $fd]; close $fd - set tagmap [list] - dict for {t v} $alltag_substitutions { - if {$t in $tags_present} { - lappend tagmap [lib::template_tag $t] $v - } - } set data2 [string map $tagmap $data] if {$data2 ne $data} { puts stdout "updated template file: $fpath" diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm index 5d601b3a..140f2678 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm @@ -281,7 +281,8 @@ tcl::namespace::eval punk::nav::fs { } } - if {[file pathtype $a1] ne "relative"} { + if {![regexp {[*?]} $a1] && [file pathtype $a1] ne "relative"} { + #non-relative non-glob if { ![string match //zipfs:/* $a1]} { if {[file type $a1] eq "directory"} { cd $a1 diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm index 8fa9ce89..4eb6526d 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm @@ -26,9 +26,16 @@ tcl::namespace::eval ::punk::ns::evaluator { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::ns { - variable ns_current "::" + variable ns_current + #allow presetting + if {![info exists ::punk::ns::ns_current]} { + set ns_current :: + } + variable ns_re_cache [dict create] ;#cache regular expressions used in globmatchns namespace export nsjoin nsprefix nstail nsparts nseval nschildren nsimport_noclobber corp + namespace path {::punk::lib ::punk::ansi} ;#list_as_lines etc + catch { package require debug debug define punk.ns.compile @@ -1259,7 +1266,7 @@ tcl::namespace::eval punk::ns { } else { set report_namespaces $matched_namespaces } - punk::args::update_definitions + punk::args::update_definitions $report_namespaces set nsdict_list [list] foreach ch $report_namespaces { @@ -1371,9 +1378,9 @@ tcl::namespace::eval punk::ns { #use aliases glob - because aliases can be present with or without leading :: #NOTE: alias may not have matching command in the relevant namespce (renamed alias) so we can't just start with commands and check if it's an alias if we want to show all aliases if {$weird_ns} { - set raw_aliases [nseval_ifexists $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. + set raw_aliases [nseval_ifexists $location [list ::punk::lib::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. } else { - set raw_aliases [tcl::namespace::eval $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. + set raw_aliases [tcl::namespace::eval $location [list ::punk::lib::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. } #set raw_aliases [nseval $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. set aliases [list] @@ -1620,6 +1627,7 @@ tcl::namespace::eval punk::ns { if {$has_punkargs} { #set id [string trimleft $fq :] set id $fq + punk::args::update_definitions [list [namespace qualifiers $id]] if {[::punk::args::id_exists $id]} { lappend usageinfo $c } else { @@ -1969,7 +1977,8 @@ tcl::namespace::eval punk::ns { #todo - -cache or -refresh to configure whether we introspect ensembles/objects each time? # - as this is interactive generally introspection should be ok at the top level # but if we need to go down multiple levels of subcommands generating/testing prefixes - could be an issue ?? - punk::args::define -dynamic 0 { + punk::args::define { + @dynamic @id -id ::punk::ns::arginfo @cmd -name punk::ns::arginfo -help\ "Show usage info for a command. @@ -1995,20 +2004,20 @@ tcl::namespace::eval punk::ns { -return -type string -default table -choices {string table tableobject} - } {${[punk::args::resolved_def -type @opts ::punk::args::arg_error -scheme]}} { + } {${[punk::args::resolved_def -types opts ::punk::args::arg_error -scheme]}} { -- -type none -help\ "End of options marker - Use this if the command to view begins with a -" + Use this if the command to view begins with a -" @values -min 1 commandpath -help\ "command (may be alias, ensemble, tcl::oo object, tepam proc etc)" subcommand -optional 1 -multiple 1 -default {} -help\ "subcommand if commandpath is an ensemble. - Multiple subcommands can be supplied if ensembles are further nested" + Multiple subcommands can be supplied if ensembles are further nested" } proc arginfo {args} { - lassign [dict values [punk::args::get_by_id ::punk::ns::arginfo $args]] leaders opts values received + lassign [dict values [punk::args::parse $args withid ::punk::ns::arginfo]] leaders opts values received #review - setting this afterwards is an architecture smell - we should be able to override the default in the dynamic part #todo - enable retrieving by id just the record_opts part - so we can treat as a dict directly, as well as easily apply it as a different flag name. @@ -2018,7 +2027,6 @@ tcl::namespace::eval punk::ns { set querycommand [dict get $values commandpath] set queryargs [dict get $values subcommand] - punk::args::update_definitions ;#ensure any packages that register PUNKARGS have been loaded #todo - similar to corp? review corp resolution process @@ -2087,6 +2095,16 @@ tcl::namespace::eval punk::ns { } } + #check for a direct match first + if {[info commands ::punk::args::id_exists] ne ""} { + if {![llength $queryargs]} { + punk::args::update_definitions [list [namespace qualifiers $origin]] + if {[punk::args::id_exists $origin]} { + return [uplevel 1 [list punk::args::usage {*}$opts $origin]] + } + } + } + #ns::cmdtype only detects alias type on 8.7+? set initial_cmdtype [punk::ns::cmdtype $origin] switch -- $initial_cmdtype { @@ -2137,31 +2155,40 @@ tcl::namespace::eval punk::ns { set id $origin if {[info commands ::punk::args::id_exists] ne ""} { - #cycle through longest first checking for id matching ::cmd ?subcmd..? - #REVIEW - this doesn't cater for prefix callable subcommands! + + + #check longest first checking for id matching ::cmd ?subcmd..? + #REVIEW - this doesn't cater for prefix callable subcommands set argcopy $queryargs - while {[llength $argcopy]} { - if {[punk::args::id_exists [list $id {*}$argcopy]]} { - return [uplevel 1 [list punk::args::usage {*}$opts [list $id {*}$argcopy]]] + if {[llength $queryargs]} { + punk::args::update_definitions [list [namespace qualifiers $id]] + if {[punk::args::id_exists [list $id {*}$queryargs]]} { + return [uplevel 1 [list punk::args::usage {*}$opts [list $id {*}$queryargs]]] } - lpop argcopy } + #while {[llength $argcopy]} { + # if {[punk::args::id_exists [list $id {*}$argcopy]]} { + # return [uplevel 1 [list punk::args::usage {*}$opts [list $id {*}$argcopy]]] + # } + # lpop argcopy + #} #didn't find any exact matches #traverse from other direction taking prefixes into account + punk::args::update_definitions [list [namespace qualifiers $id]] if {[punk::args::id_exists $id]} { #cycle forward through leading values - set def [punk::args::get_def $id] + set spec [punk::args::get_spec $id] if {[llength $queryargs]} { set nextqueryargs [list] ;#build a list of prefix-resolved queryargs set queryargs_untested $queryargs foreach q $queryargs { - if {[llength [dict get $def LEADER_NAMES]]} { - set subitems [dict get $def LEADER_NAMES] + if {[llength [dict get $spec LEADER_NAMES]]} { + set subitems [dict get $spec LEADER_NAMES] if {[llength $subitems]} { set next [lindex $subitems 0] - set arginfo [dict get $def ARG_INFO $next] + set arginfo [dict get $spec ARG_INFO $next] set allchoices [list] set choices [punk::args::system::Dict_getdef $arginfo -choices {}] @@ -2184,16 +2211,22 @@ tcl::namespace::eval punk::ns { #we have our first difference - recurse with new query args #set numvals [expr {[llength $queryargs]+1}] #return [ punk::ns::arginfo {*}[lrange $args 0 end-$numvals] $querycommand {*}$nextqueryargs {*}$queryargs_untested] - + #puts "===> testing arginfo {*}$opts $querycommand {*}$nextqueryargs {*}$queryargs_untested" return [ punk::ns::arginfo {*}$opts $querycommand {*}$nextqueryargs {*}$queryargs_untested] } #check if subcommands so far have a custom args def - set currentid [list $querycommand {*}$nextqueryargs] + #set currentid [list $querycommand {*}$nextqueryargs] + set currentid [list $id {*}$nextqueryargs] if {[punk::args::id_exists $currentid]} { - set def [punk::args::get_def $currentid + set spec [punk::args::get_spec $currentid] } else { #We can get no further with custom defs + #It is possible we have a documented lower level subcommand but missing the intermediate + #e.g if ::trace remove command was specified and is documented - it will be found above + #but if ::trace remove is not documented and the query is "::trace remove com" + #There is no way to determine com is a prefix as we don't have the intermediate documented -choice info available. + #that's probably ok. break } } @@ -2307,7 +2340,7 @@ tcl::namespace::eval punk::ns { set implementations [::info object call $origin $c1] #result documented as list of 4 element lists #set callinfo [lindex $implementations 0] - set def "" + set oodef "" foreach impl $implementations { lassign $impl generaltype mname location methodtype switch -- $generaltype { @@ -2323,7 +2356,7 @@ tcl::namespace::eval punk::ns { return [uplevel 1 [list punk::args::usage {*}$opts $idcustom]] } } - set def [::info object definition $origin $c1] + set oodef [::info object definition $origin $c1] } else { #set id "[string trimleft $location :] $c1" ;# " " set idcustom "$location $c1" @@ -2332,7 +2365,7 @@ tcl::namespace::eval punk::ns { return [uplevel 1 [list punk::args::usage {*}$opts $idcustom]] } } - set def [::info class definition $location $c1] + set oodef [::info class definition $location $c1] } break } @@ -2342,10 +2375,9 @@ tcl::namespace::eval punk::ns { } } } - if {$def ne ""} { - #assert - if we pre + if {$oodef ne ""} { set autoid "(autodef)$location $c1" - set arglist [lindex $def 0] + set arglist [lindex $oodef 0] set argdef [punk::lib::tstr -return string { @id -id "${$autoid}" @cmd -name "${$location} ${$c1}" -help\ @@ -2368,7 +2400,7 @@ tcl::namespace::eval punk::ns { append argdef \n "[lindex $a 0] -default {[lindex $a 1]} -optional 1" } default { - error "punk::ns::arginfo unexpected argument signature '$arglist'\ndef:$def\nimplementaions:$implementations" + error "punk::ns::arginfo unexpected oo argument signature '$arglist'\noodef:$oodef\nimplementations:$implementations" } } incr i @@ -2427,7 +2459,7 @@ tcl::namespace::eval punk::ns { @id -id ${$idauto} @cmd -name "Object: ${$origin}" -help\ "Instance of class: ${$class} (info autogenerated)" - @values -min 1 + @leaders -min 1 }] append argdef \n $vline punk::args::define $argdef @@ -2542,7 +2574,7 @@ tcl::namespace::eval punk::ns { @cmd -help\ "(autogenerated) ensemble: ${$origin}" - @values -min 1 + @leaders -min 1 }] append argdef \n $vline punk::args::define $argdef @@ -2977,84 +3009,100 @@ tcl::namespace::eval punk::ns { If not supplied, caller's namespace is used." -prefix -optional 1 -help\ "string prefix for command names in target namespace" - @values -min 1 -max 1 - sourcepattern -type string -optional 0 -help\ - "Glob pattern for source namespace. + @values -min 1 -max -1 + sourcepattern -type string -optional 0 -multiple 1 -help\ + "Glob pattern(s) for exported commands in source namespace(s). Globbing only active in the tail segment. - e.g ::mynamespace::*" + e.g ::mynamespace::a* ::mynamespace::j*" } proc nsimport_noclobber {args} { lassign [dict values [punk::args::get_by_id ::punk::ns::nsimport_noclobber $args]] leaders opts values received - set sourcepattern [dict get $values sourcepattern] + set sourcepatterns [dict get $values sourcepattern] - set source_ns [tcl::namespace::qualifiers $sourcepattern] - if {![tcl::namespace::exists $source_ns]} { - error "nsimport_noclobber error namespace $source_ns not found" - } set nscaller [uplevel 1 {namespace current}] if {![dict exists $received -targetnamespace]} { set target_ns $nscaller } else { set target_ns [dict get $opts -targetnamespace] if {![string match ::* $target_ns]} { - set target_ns [punk::nsjoin $nscaller $target_ns] + set target_ns [punk::ns::nsjoin $nscaller $target_ns] } } + set all_imported [list] + set nstemp ::punk::ns::temp_import - set a_export_patterns [tcl::namespace::eval $source_ns {namespace export}] - set a_commands [info commands $sourcepattern] - set a_tails [lmap v $a_commands {tcl::namespace::tail $v}] - set a_exported_tails [list] - foreach epattern $a_export_patterns { - set matches [lsearch -all -inline $a_tails $epattern] - foreach m $matches { - if {$m ni $a_exported_tails} { - lappend a_exported_tails $m + foreach pat $sourcepatterns { + set source_ns [tcl::namespace::qualifiers $pat] + if {![tcl::namespace::exists $source_ns]} { + error "nsimport_noclobber error namespace $source_ns not found" + } + + set a_export_patterns [tcl::namespace::eval $source_ns {namespace export}] + set a_commands [info commands $pat] + #puts "-->commands:'$a_commands'" + set a_tails [lmap v $a_commands {tcl::namespace::tail $v}] + set a_exported_tails [list] + foreach epattern $a_export_patterns { + set matches [lsearch -all -inline $a_tails $epattern] + foreach m $matches { + #we will be using namespace import one by one on commands. + #we must protect glob chars that may exist in the actual command names. + #e.g nsimport_noclobber ::punk::ansi::a? + # will import a+ and a? + #but nsimport_noclobber {::punk::ansi::a\?} + # must import only a? + set m [string map {\\ \\\\ ? \\? * \\* \[ \\[ \] \\]} $m] + if {$m ni $a_exported_tails} { + lappend a_exported_tails $m + } } } - } - set nstemp ::punk::ns::temp_import - if {[tcl::dict:::exists $received -prefix]} { - set pfx [dict get $opts -prefix] - set imported_commands [list] - if {[namespace exists $nstemp]} { - namespace delete $nstemp - } - namespace eval $nstemp {} - foreach e $a_exported_tails { - set imported [tcl::namespace::eval $nstemp [string map [list $e $source_ns $pfx $target_ns] { - set cmd "" - if {![catch {namespace import ::}]} { - #renaming will fail if target already exists - #renaming a command into another namespace still results in a command with 'info cmdtype' = 'import' - if {![catch {rename [punk::ns::nsjoin ]}]} { - set cmd + + + if {[tcl::dict:::exists $received -prefix]} { + #import via temporary/intermediate namespace + set pfx [dict get $opts -prefix] + set imported_commands [list] + if {[namespace exists $nstemp]} { + namespace delete $nstemp + } + namespace eval $nstemp {} + foreach e $a_exported_tails { + set imported [apply {{tgtns func srcns pfx tmpns} { + set cmd "" + if {![catch {::tcl::namespace::eval $tmpns [list ::namespace import ${srcns}::$func]}]} { + #renaming will fail if target already exists + #renaming a command into another namespace still results in a command with 'info cmdtype' = 'import' + if {![catch {::tcl::namespace::eval $tmpns [list ::rename $func [::punk::ns::nsjoin $tgtns $pfx$func]]}]} { + set cmd $pfx$func + } } + set cmd + } } $target_ns $e $source_ns $pfx $nstemp] + if {$imported ne ""} { + lappend imported_commands $imported } - set cmd - }]] - if {$imported ne ""} { - lappend imported_commands $imported } - } - namespace delete $nstemp - return $imported_commands - } - - set imported_commands [list] - foreach e $a_exported_tails { - set imported [tcl::namespace::eval $target_ns [string map [list $e $source_ns] { - set cmd "" - if {![catch {namespace import ::}]} { - set cmd + namespace delete $nstemp + } else { + #no prefix - direct import + set imported_commands [list] + foreach e $a_exported_tails { + set imported [apply {{tgtns func srcns} { + set cmd "" + if {![catch {tcl::namespace::eval $tgtns [list namespace import ${srcns}::$func]}]} { + set cmd $func + } + set cmd + } } $target_ns $e $source_ns] + if {$imported ne ""} { + lappend imported_commands $imported + } } - set cmd - }]] - if {[string length $imported]} { - lappend imported_commands $imported } + lappend all_imported {*}$imported_commands } - return $imported_commands + return $all_imported } #todo - use ns::nsimport_noclobber instead ? @@ -3092,7 +3140,23 @@ tcl::namespace::eval punk::ns { interp alias {} corp {} punk::ns::corp interp alias {} i {} punk::ns::arginfo - + #An example of using punk::args in a pipeline + punk::args::define { + @id -id ::i+ + @cmd -name "i+" -help\ + "Display command help side by side" + @values + cmds -multiple 1 -help\ + "Command names for which to show help info" + } + interp alias {} i+ {}\ + .=args> punk::args::get_by_id ::i+ |argd>\ + .=>2 dict get values cmds |cmds>\ + .=cmds>2 lmap c {i -return tableobject {*}$c} |objs>\ + .=objs>2 lmap t {$t configure -show_vseps 0 -show_edge 1} |>\ + .=objs>2 lmap t {$t print} |tables>\ + .=objs>2 lmap t {$t destroy} |>\ + .=tables>* textblock::join -- 1} { + # --------------------------------------------------------------- + #An attempt to detect dll/so loaded and try to load same version + #dll/so files are often named with version numbers that don't contain dots or a version number at all + #e.g sqlite3400.dll Thread288.dll + set pkgloadedinfo [lsearch -nocase -inline -index 1 [info loaded] $pkg] + + if {[llength $pkgloadedinfo]} { + puts stderr "--> pkg not already 'provided' but shared object seems to be loaded: $pkgloadedinfo - and multiple versions available" + lassign $pkgloadedinfo path name + set lcpath [string tolower $path] + #first attempt to find a match for our loaded sharedlib path in a *simple* package ifneeded statement. + set lcpath_to_version [dict create] + foreach av $available_versions { + set scr [package ifneeded $pkg $av] + #ifneeded script not always a valid tcl list + if {![catch {llength $scr} scrlen]} { + if {$scrlen == 3 && [lindex $scr 0] eq "load" && [string match -nocase [lindex $scr 2] $pkg]} { + dict set lcpath_to_version [string tolower [lindex $scr 1]] $av + } + } } - } - } - if {[llength $pkgloadedinfo]} { - puts stderr "--> pkg not present but shared object seems to be loaded: $pkgloadedinfo" - lassign $pkgloadedinfo path name - set lcpath [string tolower $path] - set obj [file tail $lcpath] - if {[string match tcl9* $obj]} { - set obj [string range $obj 4 end] - } elseif {[string match lib* $obj]} { - set obj [string range $obj 3 end] - } - set pkginfo [file rootname $obj] - #e.g Thread2.8.8 - if {[regexp {^([a-zA-Z\-]+)(.*)} $pkginfo _match lname lversion]} { - if {[string tolower $lname] eq [string tolower $pkg]} { + if {[dict exists $lcpath_to_version $lcpath]} { + set lversion [dict get $lcpath_to_version $lcpath] + } else { + #fallback to a best effort guess based on the path + set lversion [::punk::packagepreference::system::slibpath_guess_pkgversion $path $pkg] + } + if {$lversion ne ""} { #name matches pkg #hack for known dll version mismatch if {[string tolower $pkg] eq "thread" && $lversion eq "30b3"} { @@ -240,9 +259,11 @@ tcl::namespace::eval punk::packagepreference { }] if {[dict get $stackrecord implementation] ne ""} { set impl [dict get $stackrecord implementation] ;#use hardcoded name rather than slower (but more flexible) commandstack::get_next_command - puts stdout "punk::packagepreference renamed ::package to $impl" + #puts stdout "punk::packagepreference renamed ::package to $impl" + return 1 } else { puts stderr "punk::packagepreference failed to rename ::package" + return 0 } #puts stdout [info body ::package] } @@ -297,14 +318,94 @@ tcl::namespace::eval punk::packagepreference::lib { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[section Internal] -#tcl::namespace::eval punk::packagepreference::system { +tcl::namespace::eval punk::packagepreference::system { #*** !doctools #[subsection {Namespace punk::packagepreference::system}] #[para] Internal functions that are not part of the API + variable PUNKARGS + + lappend PUNKARGS [list { + @id -id ::punk::packagepreference::system::slibpath_guess_pkgversion + @cmd -name punk::packagepreference::system::slibpath_guess_pkgversion -help\ + "Assistance function to determine pkg version from the information + obtained from [info loaded]. This is used to try to avoid loading a different + version of a binary package in another thread/interp when the package isn't + present in the interp, but [info loaded] indicates the binary is already loaded. + The more general/robust way to avoid this is to ensure ::auto_path and + tcl::tm::list are the same in each interp/thread. + + This call should only be used as a fallback in case a binary package has a more + complex ifneeded script. If the ifneeded script for a binary package is a + straightforward 'load ' - then that information + should be used to determine the version by matching + rather than this one. + + Takes a path to a shared lib (.so/.dll), and the name of its providing + package, and return the version of the package if possible to determine + from the path. + The filename portion of the lib is often missing a version number or has + a version number that has been shortened (e.g dots removed). + The filename itself is first checked for a version number - but the number + is ignored if it doesn't contain any dots. + (prefix is checked to match with $pkgname, with a possible additional prefix + of lib or tcl) + Often (even usually) the parent or grandparent folder will be named as + per the package name with a proper version. If so we can return it, + otherwise return empty string. + The parent/grandparent matching will be done by looking for a case + insensitive match of the prefix to $pkgname. + " + @values -min 1 + libpath -help "Full path to shared library (.so,.dll etc)" + pkgname -help "" + }] + proc slibpath_guess_pkgversion {libpath pkgname} { + set root [file rootname [file tail $libpath]] + set namelen [string length $pkgname] + regexp {^(tcl(?:[0-9])+){0,1}(.*)} $root _match tclxx root ;#regexp will match anything - but only truncate leading tclXX.. + set testv "" + if {[string match -nocase $pkgname* $root]} { + set testv [string range $root $namelen end] + } elseif {[string match -nocase lib$pkgname* $root]} { + set testv [string range $root $namelen+3 end] + } + if {[string first . $testv] > 0} { + if {![catch [list package vcompare $testv $testv]]} { + #testv has an inner dot and is understood by tcl as a valid version number + return $testv + } + } + #no valid dotted version found directly on dll or so filename + set parent [file dirname $libpath] ;#parent folder is often some differentiator for platform or featureset (e.g win-x64) + set grandparent [file dirname $parent] + foreach path [list $parent $grandparent] { + set segment [file tail $path] + if {$segment eq "bin"} { + continue + } + set testv "" + if {[string match -nocase $pkgname* $segment]} { + set testv [string range $segment $namelen end] + } elseif {[string match -nocase critcl_$pkgname* $segment]} { + set testv [string range $segment $namelen+7 end] + } + #we don't look for dot in parent/grandparent version - a bare integer here after the will be taken to be the version + if {![catch [list package vcompare $testv $testv]]} { + return $testv + } + } + #review - sometimes path and lib are named only for major.minor but package provides major.minor.subversion + #using returned val to attempt to package require -exact major.minor will fail to load major.minor.subversion + return "" + } +} +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::packagepreference ::punk::packagepreference::system +} -#} # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::packagepreference [tcl::namespace::eval punk::packagepreference { diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/path-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/path-0.1.0.tm index ede3e18b..51e74719 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/path-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/path-0.1.0.tm @@ -651,11 +651,16 @@ namespace eval punk::path { -call-depth-internal -default 0 -type integer -antiglob_paths -default {} -help\ "list of path patterns to exclude - may include * and ** path segments e.g /usr/**" + may include * and ** path segments e.g + /usr/** (exlude subfolders based at /usr but not + files within /usr itself) + **/_aside (exlude files where _aside is last segment) + **/_aside/* (exclude folders one below an _aside folder) + **/_aside/** (exclude all folders with _aside as a segment)" @values -min 0 -max -1 -optional 1 -type string - tailglobs -multiple 1 -help\ + tailglobs -default * -multiple 1 -help\ "Patterns to match against filename portion (last segment) of each file path - within the directory tree being searched." + within the directory tree being searched." } #todo - implement treefiles which acts like dirfiles but allows path globbing in the same way as punk::ns::ns/ @@ -671,29 +676,29 @@ namespace eval punk::path { #[para] list of path patterns to exclude - may include * and ** path segments e.g /usr/** #[para]no natsorting - so order is dependent on filesystem - set argd [punk::args::get_by_id ::punk::path::treefilenames $args] + set argd [punk::args::parse $args withid ::punk::path::treefilenames] lassign [dict values $argd] leaders opts values received - set tailglobs [dict values $values] + set tailglobs [dict get $values tailglobs] # -- --- --- --- --- --- --- set opt_antiglob_paths [dict get $opts -antiglob_paths] set CALLDEPTH [dict get $opts -call-depth-internal] # -- --- --- --- --- --- --- - if {![dict exists $received -directory]} { - set opt_dir [pwd] - } else { - set opt_dir [dict get $opts -directory] - } # -- --- --- --- --- --- --- set files [list] if {$CALLDEPTH == 0} { + #set opts [dict merge $opts [list -directory $opt_dir]] + if {![dict exists $received -directory]} { + set opt_dir [pwd] + } else { + set opt_dir [dict get $opts -directory] + } if {![file isdirectory $opt_dir]} { return [list] } - set opts [dict merge $opts [list -directory $opt_dir]] - if {![llength $tailglobs]} { - lappend tailglobs * - } + } else { + #assume/require to exist in any recursive call + set opt_dir [dict get $opts -directory] } set skip 0 diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/pipe-1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/pipe-1.0.tm new file mode 100644 index 00000000..0b5501ac --- /dev/null +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/pipe-1.0.tm @@ -0,0 +1,853 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from -buildversion.txt +# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.3.tm +# +# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. +# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# (C) 2025 +# +# @@ Meta Begin +# Application punk::pipe 1.0 +# Meta platform tcl +# Meta license MIT +# @@ Meta End + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# doctools header +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[manpage_begin shellspy_module_punk::pipe 0 1.0] +#[copyright "2025"] +#[titledesc {Module API}] [comment {-- Name section and table of contents description --}] +#[moddesc {-}] [comment {-- Description at end of page heading --}] +#[require punk::pipe] +#[keywords module] +#[description] +#[para] - + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section Overview] +#[para] overview of punk::pipe +#[subsection Concepts] +#[para] - + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[subsection dependencies] +#[para] packages used by punk::pipe +#[list_begin itemized] + +package require Tcl 8.6- +#*** !doctools +#[item] [package {Tcl 8.6}] + +# #package require frobz +# #*** !doctools +# #[item] [package {frobz}] + +#*** !doctools +#[list_end] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section API] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# oo::class namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#tcl::namespace::eval punk::pipe::class { + #*** !doctools + #[subsection {Namespace punk::pipe::class}] + #[para] class definitions + #if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} { + #*** !doctools + #[list_begin enumerated] + + # oo::class create interface_sample1 { + # #*** !doctools + # #[enum] CLASS [class interface_sample1] + # #[list_begin definitions] + + # method test {arg1} { + # #*** !doctools + # #[call class::interface_sample1 [method test] [arg arg1]] + # #[para] test method + # puts "test: $arg1" + # } + + # #*** !doctools + # #[list_end] [comment {-- end definitions interface_sample1}] + # } + + #*** !doctools + #[list_end] [comment {--- end class enumeration ---}] + #} +#} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +tcl::namespace::eval punk::pipe { + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + # Base namespace + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + #*** !doctools + #[subsection {Namespace punk::pipe}] + #[para] Core API functions for punk::pipe + #[list_begin definitions] + + + + #proc sample1 {p1 n args} { + # #*** !doctools + # #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] + # #[para]Description of sample1 + # #[para] Arguments: + # # [list_begin arguments] + # # [arg_def tring p1] A description of string argument p1. + # # [arg_def integer n] A description of integer argument n. + # # [list_end] + # return "ok" + #} + + #https://randomascii.wordpress.com/2012/02/25/comparing-floating-point-numbers-2012-edition/ + # + #we can't provide a float comparison suitable for every situation, + #but we should pick something reasonable, keep it stable, and document it. + proc float_almost_equal {a b} { + package require math::constants + set diff [expr {abs($a - $b)}] + if {$diff <= $::math::constants::eps} { + return 1 + } + set A [expr {abs($a)}] + set B [expr {abs($b)}] + set largest [expr {($B > $A) ? $B : $A}] + return [expr {$diff <= $largest * $::math::constants::eps}] + } + + #debatable whether boolean_almost_equal is more surprising than helpful. + #values from a calculation that are extremely close to zero but aren't false could also be surprising - especially if they compare equal numerically + #perhaps a fuzzy-boolean is a step too far for a default - but it's inline with float-comparison for pattern-matching. + #alternatively - use an even more complex classifier? (^&~) ? + proc boolean_almost_equal {a b} { + if {[string is double -strict $a]} { + if {[float_almost_equal $a 0]} { + set a 0 + } + } + if {[string is double -strict $b]} { + if {[float_almost_equal $b 0]} { + set b 0 + } + } + #must handle true,no etc. + expr {($a && 1) == ($b && 1)} + } + + #boolean could be tr, true, y, ye, yes,Yes, 1 , 0 etc. + proc boolean_equal {a b} { + #equivalenttly xnor: expr {!(($a && 1) ^ ($b && 1))} ;# less clear and no discernable timing benefit. + expr {($a && 1) == ($b && 1)} + } + + + proc val [list [list v [lreplace x 0 0]]] {return $v} + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::pipe ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Secondary API namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +tcl::namespace::eval punk::pipe::lib { + tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase + tcl::namespace::path [tcl::namespace::parent] + #*** !doctools + #[subsection {Namespace punk::pipe::lib}] + #[para] Secondary functions that are part of the API + #[list_begin definitions] + + #proc utility1 {p1 args} { + # #*** !doctools + # #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] + # #[para]Description of utility1 + # return 1 + #} + + #map rhs to names suitable to use in pipemcd proc name (whitespace mapping) + # (for .= and = pipecmds) + proc pipecmd_namemapping {rhs} { + #used to build a command from a pattern which could contain :: - we need to map it to keep it a single command in the desired namespace. + #glob chars will prevent us using simple test {[info commands $cmd] eq ""} to test existence + #we could use the test {$cmd in [info commands]} - but mapping away globchars is more robust, allowing the simpler test + #set rhs [string trim $rhs];#ignore all leading & trailing whitespace + set rhs [string trimleft $rhs] + #--- + #REVIEW! + #set rhs [regsub -all {\s{1,}} $rhs {}] ;#collapse all internal whitespace to a single token + #This stops us matching {/@**@x x} vs {/@**@x x} + #--- + + set rhs [tcl::string::map {: ? * [ ] \\ {"} " " } $rhs] + #review - we don't expect other command-incompatible chars such as colon? + return $rhs + } + + # relatively slow on even small sized scripts + #proc arg_is_script_shaped2 {arg} { + # set re {^(\s|;|\n)$} + # set chars [split $arg ""] + # if {[lsearch -regex $chars $re] >=0} { + # return 1 + # } else { + # return 0 + # } + #} + + #exclude quoted whitespace + proc arg_is_script_shaped {arg} { + if {[tcl::string::first \n $arg] >= 0} { + return 1 + } elseif {[tcl::string::first ";" $arg] >= 0} { + return 1 + } elseif {[tcl::string::first " " $arg] >= 0 || [tcl::string::first \t $arg] >= 0} { + lassign [_rhs_tail_split $arg] _ part2 ;#will have part2 if unquoted whitespace found + return [expr {$part2 ne ""}] + } else { + return 0 + } + } + + #split top level of patterns only. + proc _split_patterns_memoized {varspecs} { + set name_mapped [pipecmd_namemapping $varspecs] + set cmdname ::punk::pipecmds::split_patterns::_$name_mapped + if {[info commands $cmdname] ne ""} { + return [$cmdname] + } + set result [_split_patterns $varspecs] + proc $cmdname {} [list return $result] + #debug.punk.pipe.compile {proc $cmdname} 4 + return $result + } + + + #note - empty data after trailing , is ignored. (comma as very last character) + # - fix by documentation only. double up trailing comma e.g ,, if desired to return pattern match plus all at end! + #todo - move to punk::pipe + proc _split_patterns {varspecs} { + + set varlist [list] + # @ @@ - list and dict functions + # / level separator + # # list count, ## dict size + # % string functions + # ! not + set var_terminals [list "@" "/" "#" "%" "!" ">" "<"] ;# (> required for insertionspecs at rhs of = & .= ) + #right bracket ) also ends a var - but is different depending on whether var is array or basic. For array - it forms part of the varname + + #except when prefixed directly by pin classifier ^ + set protect_terminals [list "^"] ;# e.g sequence ^# + #also - an atom usually doesn't need the / as a terminal - because it can't match a missing element unless it's empty string + #ie the one usecase is '/n to match either empty string or missing item at position n. For this one usecase - we miss the capability to atom match paths/urls .. '/usr/local/et' + set in_brackets 0 ;#count depth + set in_atom 0 + set token "" + set end_var_posn -1 ;#first var_terminal encountered within each comma delimited section + set token_index 0 ;#index of terminal char within each token + set indq 0 + set inbraces 0 + set inesc 0 ;#whether last char was backslash (see also punk::escv) + set prevc "" + set char_index 0 + #if {[string index $varspecs end] eq ","} { + # set varspecs [string range $varspecs 0 end-1] + #} + set charcount 0 + foreach c [split $varspecs ""] { + incr charcount + if {$indq} { + if {$inesc} { + #puts stderr "inesc adding '$c'" + append token \\$c + } else { + if {$c eq {"}} { + set indq 0 + } else { + append token $c + } + } + } elseif {$inbraces} { + if {$inesc} { + append token \\$c + } else { + if {$c eq "\}"} { + incr inbraces -1 + if {$inbraces} { + append token $c + } + } elseif {$c eq "\{"} { + incr inbraces + if {$inbraces} { + append token $c + } + } else { + append token $c + } + } + } elseif {$in_atom} { + #ignore dquotes/brackets in atoms - pass through + append token $c + #set nextc [lindex $chars $char_index+1] + if {$c eq "'"} { + set in_atom 0 + } + } elseif {$in_brackets > 0} { + append token $c + if {$c eq ")"} { + incr in_brackets -1 + } + } else { + if {$c eq {"}} { + if {!$inesc} { + set indq 1 + } else { + append token $c + } + } elseif {$c eq "\{"} { + if {!$inesc} { + set inbraces 1 + } else { + append token $c + } + } elseif {$c eq ","} { + #set var $token + #set spec "" + #if {$end_var_posn > 0} { + # #tcl scan with %s will not handle whitespace as desired. Be explicit using string range instead. + # #lassign [scan $token %${end_var_posn}s%s] var spec + # set var [string range $token 0 $end_var_posn-1] + # set spec [string range $token $end_var_posn end] ;#key section includes the terminal char which ended the var and starts the spec + #} else { + # if {$end_var_posn == 0} { + # set var "" + # set spec $token + # } + #} + #lappend varlist [list [string trim $var] [string trim $spec]] + #set token "" + #set token_index -1 ;#reduce by 1 because , not included in next token + #set end_var_posn -1 + } else { + append token $c + switch -exact -- $c { + ' { + set in_atom 1 + } + ( { + incr in_brackets + } + default { + if {$end_var_posn == -1 && (($c in $var_terminals) && ($prevc ni $protect_terminals))} { + set end_var_posn $token_index + } + } + } + } + if {$c eq ","} { + set var $token + set spec "" + if {$end_var_posn > 0} { + #tcl scan with %s will not handle whitespace as desired. Be explicit using string range instead. + #lassign [scan $token %${end_var_posn}s%s] var spec + set var [string range $token 0 $end_var_posn-1] + set spec [string range $token $end_var_posn end] ;#key section includes the terminal char which ended the var and starts the spec + } else { + if {$end_var_posn == 0} { + set var "" + set spec $token + } + } + lappend varlist [list [string trim $var] $spec] + set token "" + set token_index -1 + set end_var_posn -1 + + } + } + + if {$charcount == [string length $varspecs]} { + if {!($indq || $inbraces || $in_atom || $in_brackets)} { + if {$c ne ","} { + set var $token + set spec "" + if {$end_var_posn > 0} { + #tcl scan with %s will not handle whitespace as desired. Be explicit using string range instead. + #lassign [scan $token %${end_var_posn}s%s] var spec + set var [string range $token 0 $end_var_posn-1] + set spec [string range $token $end_var_posn end] ;#key section includes the terminal char which ended the var and starts the spec + } else { + if {$end_var_posn == 0} { + set var "" + set spec $token + } + } + lappend varlist [list [string trim $var] $spec] + set token "" + set token_index -1 + set end_var_posn -1 + } + } + } + + set prevc $c + if {$c eq "\\"} { + #review + if {$inesc} { + set inesc 0 + } else { + set token [string range $token 0 end-1] + set inesc 1 + } + } else { + set inesc 0 + } + incr token_index + incr char_index + } + + #if {[string length $token]} { + # #lappend varlist [splitstrposn $token $end_var_posn] + # set var $token + # set spec "" + # if {$end_var_posn > 0} { + # #lassign [scan $token %${end_var_posn}s%s] var spec + # set var [string range $token 0 $end_var_posn-1] + # set spec [string range $token $end_var_posn end] ;#key section includes the terminal char which ended the var and starts the spec + # } else { + # if {$end_var_posn == 0} { + # set var "" + # set spec $token + # } + # } + # #lappend varlist [list [string trim $var] [string trim $spec]] + # #spec needs to be able to match whitespace too + # lappend varlist [list [string trim $var] $spec] + #} + + return $varlist + } + + #todo - consider whether we can use < for insertion/iteration combinations + # =a<,b< iterate once through + # =a><,b>< cartesian product + # =a<>,b<> ??? zip ? + # + # ie = {a b c} |> .=< inspect + # would call inspect 3 times, once for each argument + # .= list {a b c} {x y z} |a/0,b/1> .=a><,b>< list + # would produce list of cartesian pairs? + # + proc _split_equalsrhs {insertionpattern} { + #map the insertionpattern so we can use faster globless info command search + set name_mapped [pipecmd_namemapping $insertionpattern] + set cmdname ::punk::pipecmds::split_rhs::_$name_mapped + if {[info commands $cmdname] ne ""} { + return [$cmdname] + } + + set lst_var_indexposition [_split_patterns_memoized $insertionpattern] + set i 0 + set return_triples [list] + foreach v_pos $lst_var_indexposition { + lassign $v_pos v index_and_position + #e.g varname@@data/ok>0 varname/1/0>end + #ensure only one ">" is detected + if {![string length $index_and_position]} { + set indexspec "" + set positionspec "" + } else { + set chars [split $index_and_position ""] + set posns [lsearch -all $chars ">"] + if {[llength $posns] > 1} { + error "pipesyntax error in segment insertion pattern '$insertionpattern' -v '$v' multiple '>' characters. Pattern not understood." "_split_equalsrhs $insertionpattern" [list pipesyntax insertionpattern_invalid] + } + if {![llength $posns]} { + set indexspec $index_and_position + set positionspec "" + } else { + set splitposn [lindex $posns 0] + set indexspec [string range $index_and_position 0 $splitposn-1] + set positionspec [string range $index_and_position $splitposn+1 end] + } + } + + #review - + if {($positionspec in [list "*" "/*" "@*" "/" "@"]) || ($v eq "*" && $positionspec eq "")} { + set star "" + if {$v eq "*"} { + set v "" + set star "*" + } + if {[string index $positionspec end] eq "*"} { + set star "*" + } + #it is always possible to insert at end of list regardless of current length - so /end* and @end* are equivalent + #as are /end and @end + #lset lst_var_indexposition $i [list $v "/end$star"] + set triple [list $v $indexspec "/end$star"] + } else { + if {$positionspec eq ""} { + #e.g just =varname + #lset lst_var_indexposition $i [list $v "/end"] + set triple [list $v $indexspec "/end"] + #error "pipesyntax error in segment insertionpattern '$insertionpattern' - v '$v' missing position spec e.g /0" + } else { + if {[string index $indexspec 0] ni [list "" "/" "@"]} { + error "pipesyntax error in segment insertionpattern '$insertionpattern' - v '$v' bad index spec '$indexspec'" "_split_equalsrhs $insertionpattern" [list pipesyntax insertionpattern_invalid] + } + set triple [list $v $indexspec $positionspec] + } + } + lappend return_triples $triple + incr i + } + proc $cmdname {} [list return $return_triples] + return $return_triples + } + + proc _rhs_tail_split {fullrhs} { + set inq 0; set indq 0 + set equalsrhs "" + set i 0 + foreach ch [split $fullrhs ""] { + if {$inq} { + append equalsrhs $ch + if {$ch eq {'}} { + set inq 0 + } + } elseif {$indq} { + append equalsrhs $ch + if {$ch eq {"}} { + set indq 0 + } + } else { + switch -- $ch { + {'} { + set inq 1 + } + {"} { + set indq 1 + } + " " { + #whitespace outside of quoting + break + } + 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - a - b - c - d - e - f - g - h - i - j - k - l - m - n - o - p - q - r - s - t - u - v - w - x - y - z {} + default { + #\t not a literal for switch jumpTable bytecompile - review - can we do it without for example string mapping to (and without a literal binary tab in source file)? + #we can't (reliably?) put \t as one of our switch keys + # + if {$ch eq "\t"} { + break + } + } + } + append equalsrhs $ch + } + incr i + } + set tail [tcl::string::range $fullrhs $i end] + return [list $equalsrhs $tail] + } + + #todo - recurse into bracketed sub parts + #JMN3 + #e.g @*/(x@0,y@2) + proc _var_classify {multivar} { + set cmdname ::punk::pipecmds::var_classify::_[pipecmd_namemapping $multivar] + if {[info commands $cmdname] ne ""} { + return [$cmdname] + } + + + #comma seems a natural choice to split varspecs, + #but also for list and dict subelement access + #/ normally indicates some sort of hierarchical separation - (e.g in filesytems) + #so / will indicate subelements e.g @0/1 for lindex $list 0 1 + #set valsource_key_list [_split_var_key_at_unbracketed_comma $multivar] + set valsource_key_list [_split_patterns_memoized $multivar] + + + + #mutually exclusive - atom/pin + #set map [list "" ' ^ &] ;#0 = default/var/not-yet-determined 1 = atom 2 = pin + #set var_class [lmap var $valsource_key_list {expr {([set m [lsearch $map [string index [lindex $var 0] 0]]] >= 0) ? [list $var $m] : [list $var 0]}}] + #0 - novar + #1 - atom ' + #2 - pin ^ + #3 - boolean & + #4 - integer + #5 - double + #6 - var + #7 - glob (no classifier and contains * or ?) + #8 - numeric + #9 - > (+) + #10 - < (-) + + set var_names [list] + set var_class [list] + set varspecs_trimmed [list] ;#raw varspecs without pin/atom modifiers - or empty string for glob + + + set leading_classifiers [list "'" "&" "^" ] + set trailing_classifiers [list + -] + set possible_number_start [list - + . 0 1 2 3 4 5 6 7 8 9 > <] + + foreach v_key $valsource_key_list { + lassign $v_key v key + set vname $v ;#default + set classes [list] + if {$v eq ""} { + lappend var_class [list $v_key 0] + lappend varspecs_trimmed $v_key + } else { + set lastchar [string index $v end] + switch -- $lastchar { + + { + lappend classes 9 + set vname [string range $v 0 end-1] + } + - { + lappend classes 10 + set vname [string range $v 0 end-1] + } + } + set firstchar [string index $v 0] + switch -- $firstchar { + ' { + lappend var_class [list $v_key 1] + #set vname [string range $v 1 end] + lappend varspecs_trimmed [list $vname $key] + } + ^ { + lappend classes [list 2] + #use vname - may already have trailing +/- stripped + set vname [string range $vname 1 end] + set secondclassifier [string index $v 1] + switch -- $secondclassifier { + "&" { + #pinned boolean + lappend classes 3 + set vname [string range $v 2 end] + } + "#" { + #pinned numeric comparison instead of string comparison + #e.g set x 2 + # this should match: ^#x.= list 2.0 + lappend classes 8 + set vname [string range $vname 1 end] + } + "*" { + #pinned glob + lappend classes 7 + set vname [string range $v 2 end] + } + } + #todo - check for second tag - & for pinned boolean? + #consider requiring ^# for numeric comparisons. currently no way to do a strictly string comparison on pinned variables.... default ^var really shouldn't be doing any magic. + #while we're at it.. pinned glob would be nice. ^* + #maybe even pinned scan ^% ? regex? ^/ or ^? these would be hard to have corresponding literals in the pattern mini-lang. + #These all limit the range of varnames permissible - which is no big deal. + lappend var_class [list $v_key $classes] + lappend varspecs_trimmed [list $vname $key] + } + & { + #we require boolean literals to be single-quoted so we can use cross-binding on boolean vars. + #ie &true is the variable true whereas &'true' or &'1' &'t' etc are literal booleans + #allow exception of &1 &0 to be literal booleans - because we disallow 0 & 1 as varnames in other contexts anyway - so it would be more consistent not to treat as varnames here. + lappend var_class [list $v_key 3] + set vname [string range $v 1 end] + lappend varspecs_trimmed [list $vname $key] + } + default { + if {([string first ? $v]) >=0 || ([string first * $v] >=0)} { + lappend var_class [list $v_key 7] ;#glob + #leave vname as the full glob + lappend varspecs_trimmed [list "" $key] + } else { + #scan vname not v - will either be same as v - or possibly stripped of trailing +/- + set numtestv [join [scan $vname %lld%s] ""] ;# handles octals (leading zeros), ok for use with bignums, decimal points and sci notation - fails to handle leading dot e.g .5 + #leading . still need to test directly for double + if {[string is double -strict $vname] || [string is double -strict $numtestv]} { + if {[string is integer -strict $numtestv]} { + #this will pick up boolean 1 or 0 - but that's ok - they require "&" marker if boolean comparison desired + #integer test before double.. + #note there is also string is wide (string is wideinteger) for larger ints.. + lappend classes 4 + lappend var_class [list $v_key $classes] + lappend varspecs_trimmed $v_key + } else { + #double + #sci notation 1e123 etc + #also large numbers like 1000000000 - even without decimal point - (tcl bignum) + lappend classes 5 + lappend var_class [list $v_key $classes] + lappend varspecs_trimmed $v_key + } + } else { + lappend var_class [list $v_key 6] ;#var + lappend varspecs_trimmed $v_key + } + } + } + } + } + lappend var_names $vname + } + + set result [list var_names $var_names var_class $var_class varspecs_trimmed $varspecs_trimmed] + + proc $cmdname {} [list return $result] + #JMN + #debug.punk.pipe.compile {proc $cmdname} + return $result + } + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::pipe::lib ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[section Internal] +#tcl::namespace::eval punk::pipe::system { + #*** !doctools + #[subsection {Namespace punk::pipe::system}] + #[para] Internal functions that are not part of the API + + + +#} + + +# == === === === === === === === === === === === === === === +# Sample 'about' function with punk::args documentation +# == === === === === === === === === === === === === === === +tcl::namespace::eval punk::pipe { + tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase + variable PUNKARGS + variable PUNKARGS_aliases + + lappend PUNKARGS [list { + @id -id "(package)punk::pipe" + @package -name "punk::pipe" -help\ + "Package + Description" + }] + + namespace eval argdoc { + #namespace for custom argument documentation + proc package_name {} { + return punk::pipe + } + proc about_topics {} { + #info commands results are returned in an arbitrary order (like array keys) + set topic_funs [info commands [namespace current]::get_topic_*] + set about_topics [list] + foreach f $topic_funs { + set tail [namespace tail $f] + lappend about_topics [string range $tail [string length get_topic_] end] + } + return $about_topics + } + proc default_topics {} {return [list Description outline *]} + + # ------------------------------------------------------------- + # get_topic_ functions add more to auto-include in about topics + # ------------------------------------------------------------- + proc get_topic_Description {} { + punk::args::lib::tstr [string trim { + punk pipeline features + } \n] + } + proc get_topic_License {} { + return "MIT" + } + proc get_topic_Version {} { + return $::punk::pipe::version + } + proc get_topic_Contributors {} { + set authors {{Julian Noble }} + set contributors "" + foreach a $authors { + append contributors $a \n + } + if {[string index $contributors end] eq "\n"} { + set contributors [string range $contributors 0 end-1] + } + return $contributors + } + proc get_topic_outline {} { + punk::args::lib::tstr -return string { + todo.. + } + } + # ------------------------------------------------------------- + } + + # we re-use the argument definition from punk::args::standard_about and override some items + set overrides [dict create] + dict set overrides @id -id "::punk::pipe::about" + dict set overrides @cmd -name "punk::pipe::about" + dict set overrides @cmd -help [string trim [punk::args::lib::tstr { + About punk::pipe + }] \n] + dict set overrides topic -choices [list {*}[punk::pipe::argdoc::about_topics] *] + dict set overrides topic -choicerestricted 1 + dict set overrides topic -default [punk::pipe::argdoc::default_topics] ;#if -default is present 'topic' will always appear in parsed 'values' dict + set newdef [punk::args::resolved_def -antiglobs -package_about_namespace -override $overrides ::punk::args::package::standard_about *] + lappend PUNKARGS [list $newdef] + proc about {args} { + package require punk::args + #standard_about accepts additional choices for topic - but we need to normalize any abbreviations to full topic name before passing on + set argd [punk::args::parse $args withid ::punk::pipe::about] + lassign [dict values $argd] _leaders opts values _received + punk::args::package::standard_about -package_about_namespace ::punk::pipe::argdoc {*}$opts {*}[dict get $values topic] + } +} +# end of sample 'about' function +# == === === === === === === === === === === === === === === + +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::pipe +} + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide punk::pipe [tcl::namespace::eval punk::pipe { + variable pkg punk::pipe + variable version + set version 1.0 +}] +return + +#*** !doctools +#[manpage_end] + diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl/codethread-0.1.1.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl/codethread-0.1.1.tm index 6158fdce..feee9d87 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl/codethread-0.1.1.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl/codethread-0.1.1.tm @@ -114,6 +114,10 @@ tcl::namespace::eval punk::repl::codethread { variable output_stdout "" variable output_stderr "" + #review/test + catch {package require punk::ns} + catch {package rquire punk::repl} + #variable xyz #*** !doctools @@ -191,9 +195,14 @@ tcl::namespace::eval punk::repl::codethread { #shennanigans to keep compiled script around after call. #otherwise when $script goes out of scope - internal rep of vars set in script changes. #The shimmering may be no big deal(?) - but debug/analysis using tcl::unsupported::representation becomes impossible. - interp eval code [list ::punk::lib::set_clone ::codeinterp::clonescript $script] ;#like objclone + + #interp eval code [list ::punk::lib::set_clone ::codeinterp::clonescript $script] ;#like objclone + interp eval code [list ::codeinterp::set_clone ::codeinterp::clonescript $script] ;#like objclone + + interp eval code {lappend ::codeinterp::run_command_cache $::codeinterp::clonescript} + interp eval code { - lappend ::codeinterp::run_command_cache $::codeinterp::clonescript + #lappend ::codeinterp::run_command_cache $::codeinterp::clonescript if {[llength $::codeinterp::run_command_cache] > 2000} { set ::codeinterp::run_command_cache [lrange $::codeinterp::run_command_cache 1750 end][unset ::codeinterp::run_command_cache] } @@ -205,10 +214,19 @@ tcl::namespace::eval punk::repl::codethread { package require punk::ns punk::ns::nseval_ifexists $::punk::ns::ns_current $::codeinterp::clonescript } else { + if {![namespace exists $::punk::ns::ns_current]} { + namespace eval $::punk::ns::ns_current { + puts stderr "Created namespace: $::punk::ns::ns_current" + } + } tcl::namespace::inscope $::punk::ns::ns_current $::codeinterp::clonescript } } } result] + #temp test for subshell experimentation + #if {$status == 1} { + # puts stderr "--codethread::runscript error--------\n$::errorInfo" + #} flush stdout diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repo-0.1.1.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repo-0.1.1.tm index 063a13c0..f53a06fd 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repo-0.1.1.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repo-0.1.1.tm @@ -107,14 +107,16 @@ namespace eval punk::repo { } - #lappend PUNKARGS [list -dynamic 1 { + #lappend PUNKARGS [list { + # @dynamic # @id -id ::punk::repo::fossil_proxy # @cmd -name fossil -help "fossil executable # " # @argdisplay -header "fossil help" -body {${[runout -n fossil help]}} # } ""] - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + @dynamic @id -id ::punk::repo::fossil_proxy @cmd -name fossil -help "fossil executable" ${[punk::repo::get_fossil_usage]} @@ -123,20 +125,24 @@ namespace eval punk::repo { #experiment - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + @dynamic @id -id "::punk::repo::fossil_proxy diff" @cmd -name "fossil diff" -help "fossil diff " @argdisplay -header "fossil help diff" -body {${[runout -n fossil help diff]}} } ""] - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + #todo - remove this comment - testing dynamic directive + @dynamic @id -id "::punk::repo::fossil_proxy add" @cmd -name "fossil add" -help "fossil add " @argdisplay -header "fossil help add" -body {${[runout -n fossil help add]}} } ""] #TODO - #lappend PUNKARGS [list -dynamic 1 { + #lappend PUNKARGS [list { + # @dynamic # @id -glob 1 -id "::punk::repo::fossil_proxy *" -aliases {fs} # @cmd -name "fossil add" -help "fossil add # " @@ -1699,12 +1705,10 @@ namespace eval punk::repo::lib { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -if {![info exists ::punk::args::register::NAMESPACES]} { - namespace eval ::punk::args::register { - set ::punk::args::register::NAMESPACES [list] ;#use fully qualified so 8.6 doesn't find existing var in global namespace - } +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::repo } -lappend ::punk::args::register::NAMESPACES ::punk::repo # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/zip-0.1.1.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/zip-0.1.1.tm index 2895b024..99bc359d 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/zip-0.1.1.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/zip-0.1.1.tm @@ -194,6 +194,12 @@ tcl::namespace::eval punk::zip { Defaults to the value of base. If empty string is given to -resultrelative the paths returned are effectively absolute paths." + -emptydirs -default 0 -type boolean -help\ + "Whether to include directory trees in the result which had no + matches for the given fileglobs. + Intermediate dirs are always returned if there is a match with + fileglobs further down even if -emptdirs is 0. + " -excludes -default "" -help "list of glob expressions to match against files and exclude" -subpath -default "" -help\ "May contain glob chars for folder elements" @@ -205,6 +211,7 @@ tcl::namespace::eval punk::zip { set fileglobs [dict get $argd values fileglobs] set subpath [dict get $argd opts -subpath] set excludes [dict get $argd opts -excludes] + set emptydirs [dict get $argd opts -emptydirs] set received [dict get $argd received] @@ -242,13 +249,32 @@ tcl::namespace::eval punk::zip { if {!$excluded} {lappend result [file join $prefix $file]} } foreach dir [glob -nocomplain -tails -types d -directory $base -- [file join $subpath *]] { - set subdir_entries [walk -subpath $dir -excludes $excludes $base {*}$fileglobs] - if {[llength $subdir_entries]>0} { - #NOTE: trailing slash required for entries to be recognised as 'file type' = "directory" - #This is true for 2024 Tcl9 mounted zipfs at least. zip utilities such as 7zip seem(icon correct) to recognize dirs with or without trailing slash - #Although there are attributes on some systems to specify if entry is a directory - it appears trailing slash should always be used for folder names. - set result [list {*}$result "[file join $prefix $dir]/" {*}$subdir_entries] + set submatches [walk -subpath $dir -emptydirs $emptydirs -excludes $excludes $base {*}$fileglobs] + set subdir_entries [list] + set thisdir_match [list] + set has_file 0 + foreach sd $submatches { + set fullpath [file join $prefix $sd] ;#file join destroys trailing slash + if {[string index $sd end] eq "/"} { + lappend subdir_entries $fullpath/ + } else { + set has_file 1 + lappend subdir_entries $fullpath + } + } + if {$emptydirs} { + set thisdir_match [list "[file join $prefix $dir]/"] + } else { + if {$has_file} { + set thisdir_match [list "[file join $prefix $dir]/"] + } else { + set subdir_entries [list] + } } + #NOTE: trailing slash required for entries to be recognised as 'file type' = "directory" + #This is true for 2024 Tcl9 mounted zipfs at least. zip utilities such as 7zip seem(icon correct) to recognize dirs with or without trailing slash + #Although there are attributes on some systems to specify if entry is a directory - it appears trailing slash should always be used for folder names. + set result [list {*}$result {*}$thisdir_match {*}$subdir_entries] } return $result } diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punkcheck-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punkcheck-0.1.0.tm index 3b4217df..db8a3db5 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punkcheck-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punkcheck-0.1.0.tm @@ -1170,6 +1170,7 @@ namespace eval punkcheck { } #skip writing punkcheck during checksum/timestamp checks + #todo - punk::args - fetch from punkcheck::install (with overrides) proc install_tm_files {srcdir basedir args} { set defaults [list\ -glob *.tm\ @@ -1209,13 +1210,71 @@ namespace eval punkcheck { return [lindex $args end] } } + lappend PUNKARGS [list { + @id -id ::punkcheck::install + @cmd -name ::punkcheck::install -help\ + "Unidirectional file transfer to possibly non-empty target folder." + @leaders -min 2 -max 2 + srcdir -type directory + tgtdir -type directory + -call-depth-internal -type integer -default 0 -help "(internal recursion tracker)" + -subdirlist -type list -default "" -help "(primarily internal - length generally matching -call-depth-internal)" + -max_depth -type integer -default 1000 -help\ + "Deepest subdirectory - use -1 for no limit." + -createdir -type boolean -default 0 -help\ + "Whether to create the folder at tgtdir. + Any required subdirectories are created regardless of this setting." + -createempty -type boolean -default 0 -help\ + "Whether to create folders at target that had no matches for our glob" + -glob -type string -default "*" -help\ + "Pattern matching for source file(s) to copy. Can be glob based or exact match." + -antiglob_file_core -default {${[::punkcheck::default_antiglob_file_core]}} + -antiglob_file -default "" + -antiglob_dir_core -default {${[::punkcheck::default_antiglob_dir_core]}} + -antiglob_dir -default "" + -antiglob_paths -default {} + -overwrite -default no-targets\ + -choices {no-targets newer-targets older-targets all-targets installedsourcechanged-targets synced-targets}\ + -choicecolumns 1\ + -choicelabels { + no-targets "only copy files that are missing at the target" + newer-targets "copy files with older source timestamp over newer + target timestamp and those missing at the target + (a form of 'restore' operation)" + older-targets "copy files with newer source timestamp over older + target timestamp and those missing at the target" + all-targets "copy regardless of timestamp at target" + installedsourcechanged-targets "copy if the target doesn't exist or the source changed" + synced-targets "copy if the target doesn't exist or the source changed + and the target cksum is the same as the last INSTALL-RECORD -targets_cksums entry" + } + -source_checksum -default comparestore -choicecolumns 3 -choices {compare store comparestore false true}\ + -choicelabels { + true "same as comparestore" + } + -punkcheck_folder -default target -choices {target source project} -choicerestricted 0 -help\ + "The location of the .punkcheck file to track installations and checksums. + The default value 'target' is generally recommended. + Can also be an absolute path to a folder." + -punkcheck_records -default "" -help\ + "Empty string or a parsed TDL records structure. + e.g + {tag FILEINFO - ... body { + {tag INSTALL-RECORD - ... body {}} + ... + }... + }" + -installer -default "punkcheck::install" -help\ + "A user nominated string that is stored in the .punkcheck file + This might be the name of a script or installation process." + }] ## unidirectional file transfer to possibly non empty folder #default of -overwrite no-targets will only copy files that are missing at the target # -overwrite newer-targets will copy files with older source timestamp over newer target timestamp and those missing at the target (a form of 'restore' operation) # -overwrite older-targets will copy files with newer source timestamp over older target timestamp and those missing at the target # -overwrite all-targets will copy regardless of timestamp at target # -overwrite installedsourcechanged-targets will copy if the target doesn't exist or the source changed - # -overwrite synced-targets will copy if the target doesn't exist or the source changed and the target cksum is the same as the last INSTALL-RECORD targets_cksums entry + # -overwrite synced-targets will copy if the target doesn't exist or the source changed and the target cksum is the same as the last INSTALL-RECORD -targets_cksums entry # review - timestamps unreliable # - what about slightly mismatched system clocks and mounted filesystems? caller responsibility to verify first? # if timestamp exactly equal - should we check content-hash? This is presumably only likely to occur deliberately(maliciously?) @@ -1243,6 +1302,7 @@ namespace eval punkcheck { -max_depth 1000\ -subdirlist {}\ -createdir 0\ + -createempty 0\ -glob *\ -antiglob_file_core "\uFFFF"\ -antiglob_file "" \ @@ -1271,13 +1331,14 @@ namespace eval punkcheck { #(as opposed to a more 'standard' mechanism of adjusting srcdir & tgtdir as we move down the tree) #It comes from build_modules_from_source_to_base where we need to keep track of position relative to our targetdir starting point to handle submodules e.g pkg::something::mypkg-0.1.tm #It could have been handled with some other parameter such as -depth, but this -subdirlist mechanism, whilst perhaps not beautiful, is straightforward enough - #and may be less error prone than doing slightly more opaue path manipulations at each recursion level to determine where we started + #and may be less error prone than doing slightly more opaque path manipulations at each recursion level to determine where we started #For consistency - we'll use the same mechanism in various recursive directory walking procedures such as this one. - set CALLDEPTH [dict get $opts -call-depth-internal] ;#added for extra debug/sanity checking - clearer test for initial function call ie CALLDPEPTH = 0 + set CALLDEPTH [dict get $opts -call-depth-internal] ;#added for extra debug/sanity checking - clearer test for initial function call ie CALLDEPTH = 0 set max_depth [dict get $opts -max_depth] ;# -1 for no limit set subdirlist [dict get $opts -subdirlist] ;# generally should be same length as CALLDEPTH - but user could prefill set fileglob [dict get $opts -glob] set createdir [dict get $opts -createdir] ;#defaults to zero to help avoid mistakes with initial target dir - required target subdirs are created regardless of this setting + set opt_createempty [dict get $opts -createempty] if {$CALLDEPTH == 0} { #expensive to normalize but we need to do it at least once @@ -1285,6 +1346,13 @@ namespace eval punkcheck { set tgtdir [file normalize $tgtdir] if {$createdir} { file mkdir $tgtdir + } else { + if {![file exists $tgtdir]} { + error "punkcheck::install base target dir:'$tgtdir' doesn't exist (srcdir:$srcdir tgtdir:$tgtdir args:'$args')" + } + } + if {([file type $srcdir] ni [list directory]) || ([file type $tgtdir] ni [list directory])} { + error "punkcheck::install requires source and target dirs to be of type 'directory' type current source: [file type $srcdir] type current target: [file type $tgtdir]" } #now the values we build from these will be properly cased } @@ -1450,13 +1518,7 @@ namespace eval punkcheck { if {![file exists $current_source_dir]} { - error "copy_files_from_source_to_target current source dir:'$current_source_dir' doesn't exist (srcdir:$srcdir tgtdir:$tgtdir args:'$args')" - } - if {![file exists $current_target_dir]} { - error "copy_files_from_source_to_target current target dir:'$current_target_dir' doesn't exist (srcdir:$srcdir tgtdir:$tgtdir args:'$args')" - } - if {([file type $current_source_dir] ni [list directory]) || ([file type $current_target_dir] ni [list directory])} { - error "copy_files_from_source_to_target requires source and target dirs to be of type 'directory' type current source: [file type $current_source_dir] type current target: [file type $current_target_dir]" + error "punkcheck::install current source dir:'$current_source_dir' doesn't exist (srcdir:$srcdir tgtdir:$tgtdir args:'$args')" } set files_copied [list] @@ -1500,7 +1562,13 @@ namespace eval punkcheck { # SOURCE -type file -path ../src/modules/jjjetc-999999.0a1.0.tm -cksum b646fc2ee88cbd068d2e946fe929b7aea96bd39d -cksum_all_opts {-cksum_content 1 -cksum_meta 0 -cksum_acls 0 -cksum_usetar 0 -cksum_algorithm sha1} -changed 0 -metadata_us 3338 # } #} - + + if {[llength $match_list]} { + #example - target dir has a file where there is a directory at the source + if {[file exists $current_target_dir] && ([file type $current_target_dir] ni [list directory])} { + error "punkcheck::install target subfolder $current_target_dir exists but is not of type 'directory'. Type current target folder: [file type $current_target_dir]" + } + } #proc get_relativecksum_from_base_and_fullpath {base fullpath args} @@ -1579,10 +1647,12 @@ namespace eval punkcheck { set is_skip 0 if {$overwrite_what eq "all-targets"} { + file mkdir $current_target_dir file copy -force $current_source_dir/$m $current_target_dir lappend files_copied $current_source_dir/$m } else { if {![file exists $current_target_dir/$m]} { + file mkdir $current_target_dir file copy $current_source_dir/$m $current_target_dir set new_tgt_cksum_info [punk::mix::base::lib::cksum_path $current_target_dir/$m] lappend files_copied $current_source_dir/$m @@ -1592,6 +1662,7 @@ namespace eval punkcheck { installedsourcechanged-targets { if {[llength $changed]} { #An unrecorded installation is considered a source change (from unknown/unrecorded source to recorded) + file mkdir $current_target_dir file copy -force $current_source_dir/$m $current_target_dir set new_tgt_cksum_info [punk::mix::base::lib::cksum_path $current_target_dir/$m] lappend files_copied $current_source_dir/$m @@ -1619,6 +1690,7 @@ namespace eval punkcheck { set target_cksum_compare "norecord" } if {$is_target_unmodified_since_install} { + file mkdir $current_target_dir file copy -force $current_source_dir/$m $current_target_dir set new_tgt_cksum_info [punk::mix::base::lib::cksum_path $current_target_dir/$m] lappend files_copied $current_source_dir/$m @@ -1642,6 +1714,12 @@ namespace eval punkcheck { } } } + #target dir was created as necessary if files matched above + #now ensure target dir exists if -createempty true + if {$opt_createempty && ![file exists $current_target_dir]} { + file mkdir $current_target_dir + } + set ts_now [clock microseconds] @@ -1724,10 +1802,9 @@ namespace eval punkcheck { continue } - - if {![file exists $current_target_dir/$d]} { - file mkdir $current_target_dir/$d - } + #if {![file exists $current_target_dir/$d]} { + # file mkdir $current_target_dir/$d + #} set sub_opts_1 [list\ @@ -2096,8 +2173,10 @@ namespace eval punkcheck { - - +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punkcheck +} diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punkcheck/cli-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punkcheck/cli-0.1.0.tm index 609df5c3..bbf882a0 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punkcheck/cli-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punkcheck/cli-0.1.0.tm @@ -64,6 +64,8 @@ namespace eval punkcheck::cli { #vfs can mask mounted files - so we can't just use 'file type' or glob with -type f ##set files [glob -nocomplain -dir $fullpath -type f *] package require punk::nav::fs + + #TODO - get all files in tree!!! set folderinfo [punk::nav::fs::dirfiles_dict $fullpath] set files [concat [dict get $folderinfo files] [dict get $folderinfo underlayfiles]] } diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/shellfilter-0.1.9.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/shellfilter-0.1.9.tm index 25ba28b1..d70d657c 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/shellfilter-0.1.9.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/shellfilter-0.1.9.tm @@ -751,6 +751,12 @@ namespace eval shellfilter::chan { } else { + #REVIEW - this holding a buffer without emitting as we go is ugly. + # - we may do better to detect and retain the opener, then use that opener to avoid false splits within the sequence. + # - we'd then need to detect the appropriate close to restart splitting and codestacking + # - we may still need to retain and append the data to the opener (in some cases?) - which is a slight memory issue - but at least we would emit everything immediately. + + #puts "-->esc but no detect" #no complete ansi codes - but at least one esc is present if {[string last \x1b $buf] == [llength $buf]-1} { @@ -1118,8 +1124,8 @@ namespace eval shellfilter::stack { proc status {{pipename *} args} { variable pipelines set pipecount [dict size $pipelines] - set tableprefix "$pipecount pipelines active\n" - set t [textblock::class::table new $tableprefix] + set tabletitle "$pipecount pipelines active" + set t [textblock::class::table new $tabletitle] $t add_column -headers [list channel-ident] $t add_column -headers [list device-info localchan] $t configure_column 1 -header_colspans {3} @@ -1402,7 +1408,8 @@ namespace eval shellfilter::stack { } dict set pipelines $pipename stack $stack } - show_pipeline $pipename -note "after_remove $remove_id" + #JMNJMN 2025 review! + #show_pipeline $pipename -note "after_remove $remove_id" return 1 } @@ -1607,7 +1614,9 @@ namespace eval shellfilter::stack { #puts stdout "==" #puts stdout "==>stack: $stack" #puts stdout "==" - show_pipeline $pipename -note "after_add $transformname $args" + + #JMNJMN + #show_pipeline $pipename -note "after_add $transformname $args" return $id } proc show_pipeline {pipename args} { diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/textblock-0.1.3.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/textblock-0.1.3.tm index 56651d21..8d66978f 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/textblock-0.1.3.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/textblock-0.1.3.tm @@ -62,14 +62,16 @@ catch {package require patternpunk} package require overtype #safebase interps as at 2024-08 can't access deeper paths - even though they are below the supposed safe list. -if {[catch { - package require term::ansi::code::macros ;#required for frame if old ansi g0 used - review - make package optional? -} errM]} { - #catch this too in case stderr not available - catch { - puts stderr "textblock package failed to load term::ansi::code::macros with error: $errM" - } -} +#2025 - required term::ansi features for altg now built in to textblock +#the deeper paths issue is still a potential issue for some packages - review +#if {[catch { +# package require term::ansi::code::macros ;#required for frame if old ansi g0 used - review - make package optional? +#} errM]} { +# #catch this too in case stderr not available +# catch { +# puts stderr "textblock package failed to load term::ansi::code::macros with error: $errM" +# } +#} package require textutil @@ -139,7 +141,8 @@ tcl::namespace::eval textblock { # hash_algorithm -optional 1 -choices {${[::textblock::argdoc::hash_algorithm_choices]}} -help\ # "algorithm choice" - punk::args::define -dynamic 1 { + punk::args::define { + @dynamic @id -id ::textblock::use_hash @cmd -name "textblock::use_hash" -help\ "Hashing algorithm to use for framecache lookup. @@ -4068,12 +4071,12 @@ tcl::namespace::eval textblock { return $frametypes } - tcl::namespace::eval cd { - #todo - save and restore existing tcl::namespace::export in case macros::cd has default exports in future - tcl::namespace::eval ::term::ansi::code::macros::cd {tcl::namespace::export *} - tcl::namespace::import ::term::ansi::code::macros::cd::* - tcl::namespace::eval ::term::ansi::code::macros::cd {tcl::namespace::export -clear} - } + #tcl::namespace::eval cd { + # #todo - save and restore existing tcl::namespace::export in case macros::cd has default exports in future + # tcl::namespace::eval ::term::ansi::code::macros::cd {tcl::namespace::export *} + # tcl::namespace::import ::term::ansi::code::macros::cd::* + # tcl::namespace::eval ::term::ansi::code::macros::cd {tcl::namespace::export -clear} + #} proc spantest {} { set t [list_as_table -columns 5 -return tableobject {a b c d e aa bb cc dd ee X Y}] $t configure_column 0 -headers [list span3 "1-span4\n2-span4 second line" span5/5 "span-all etc blah 123 hmmmmm" span2] @@ -5071,7 +5074,7 @@ tcl::namespace::eval textblock { #only call width functions if known_samewidth - otherwise let the pad algorithm below determine it as we go if {$known_samewidth ne "" && $known_samewidth} { if {$known_blockwidth eq ""} { - set datawidth [textblock::widthtopline $block + set datawidth [textblock::widthtopline $block] } else { set datawidth $known_blockwidth } @@ -6214,16 +6217,22 @@ tcl::namespace::eval textblock { switch -- $f { "altg" { #old style ansi escape sequences with alternate graphics page G0 - set hl [cd::hl] + #set hl [cd::hl] + set hl [punk::ansi::g0 q] set hlt $hl set hlb $hl - set vl [cd::vl] + #set vl [cd::vl] + set vl [punk::ansi::g0 x] set vll $vl set vlr $vl - set tlc [cd::tlc] - set trc [cd::trc] - set blc [cd::blc] - set brc [cd::brc] + #set tlc [cd::tlc] + set tlc [punk::ansi::g0 l] + #set trc [cd::trc] + set trc [punk::ansi::g0 k] + #set blc [cd::blc] + set blc [punk::ansi::g0 m] + #set brc [cd::brc] + set brc [punk::ansi::g0 j] #horizontal and vertical bar joins set hltj $hlt @@ -7417,13 +7426,15 @@ tcl::namespace::eval textblock { set blc \U1fb7c ;#legacy block set brc \U1fb7f ;#legacy block - if {[punk::console::check::has_bug_legacysymbolwidth]} { - #rather than totally fail on some mixed layout that happens to use block2 - just degrade it - but prevent alignment problems - set sp \u00a0 ;#non breaking space (plain space may act transparent in some use cases) - set tlc $sp - set trc $sp - set blc $sp - set brc $sp + if {(![interp issafe])} { + if {![catch {punk::console::check::has_bug_legacysymbolwidth} symbug] && $symbug} { + #rather than totally fail on some mixed layout that happens to use block2 - just degrade it - but prevent alignment problems + set sp \u00a0 ;#non breaking space (plain space may act transparent in some use cases) + set tlc $sp + set trc $sp + set blc $sp + set brc $sp + } } #horizontal and vertical bar joins @@ -7555,12 +7566,12 @@ tcl::namespace::eval textblock { @cmd -name textblock::frame_cache -help\ "Display or clear the frame cache." -pretty -default 1 -help\ - "Uses 'pdict textblock::frame_cache */*' for prettier output - Either way this is set, output requires long lines and may - still wrap in an ugly manner. Try 'textblock::use_cache md5' - to shorten the argument display and reduce wrapping. + "Uses 'pdict textblock::frame_cache */*' for prettier output + Either way this is set, output requires long lines and may + still wrap in an ugly manner. Try 'textblock::use_cache md5' + to shorten the argument display and reduce wrapping. " - @values -min 0 -max 1 + @values -min 0 -max -1 action -default {display} -choices {clear size info display} -choicelabels { clear "Clear the textblock::frame_cache dictionary." } -help "Perform an action on the frame cache." @@ -7569,6 +7580,8 @@ tcl::namespace::eval textblock { set argd [punk::args::get_by_id ::textblock::frame_cache $args] set action [dict get $argd values action] variable frame_cache + set all_values_dict [dict get $argd values] + set action_values [lrange [dict values $all_values_dict] 1 end] switch -- $action { clear { set size [dict size $frame_cache] @@ -7589,8 +7602,65 @@ tcl::namespace::eval textblock { error "frame_cache -action '$action' not understood. Valid actions: clear size info display" } } + if {[llength $action_values]} { + return [frame_cache_display -pretty [dict get $argd opts -pretty] {*}$action_values] + } else { + return [frame_cache_display -pretty [dict get $argd opts -pretty]] + } + } + punk::args::define { + @dynamic + @id -id ::textblock::frame_cache_display + @opts + ${[::punk::args::resolved_def -types opts ::textblock::frame_cache -pretty]} + @values -min 0 -max 2 + startindex -default "" -type indexexpression -help\ + "If both startindex and endindex are missing/empty, it is treated as + startindex 0 endindex end. (ie displays all records) + If only startindex has a value - the frame_cache record at that + index will be displayed" + endindex -default "" -type indexexpression + } + proc frame_cache_display {args} { + set argd [punk::args::get_by_id ::textblock::frame_cache_display $args] + variable frame_cache + lassign [dict values [dict get $argd values]] startidx endidx + set limit "" + if {$startidx ne ""} { + if {$endidx ne ""} { + if {$startidx eq $endidx} { + set limit "index" + } else { + set limit "range" + } + } else { + set limit "index" + } + } else { + set limit "all" + } + + set display_dict {} + switch -- $limit { + all { + set display_dict $frame_cache + } + index { + set k [lindex [dict keys $frame_cache] $startidx] + if {$k ne ""} { + set display_dict [dict create $k [dict get $frame_cache $k]] + } + } + range { + set keys [lrange [dict keys $frame_cache] $startidx $endidx] + foreach k $keys { + dict set display_dict $k [dict get $frame_cache $k] + } + } + } + if {[dict get $argd opts -pretty]} { - set out [pdict -chan none frame_cache */*] + set out [pdict -chan none display_dict */*] } else { set out "" if {[catch { @@ -7599,7 +7669,7 @@ tcl::namespace::eval textblock { set termwidth 80 } - tcl::dict::for {k v} $frame_cache { + tcl::dict::for {k v} $display_dict { lassign $v _f frame _used used set fwidth [textblock::widthtopline $frame] #review - are cached frames uniform width lines? @@ -7651,7 +7721,8 @@ tcl::namespace::eval textblock { # ${[textblock::frame_samples]} #todo punk::args alias for centre center etc? - punk::args::define -dynamic 1 { + punk::args::define { + @dynamic @id -id ::textblock::frame @cmd -name "textblock::frame"\ -help "Frame a block of text with a border." @@ -8208,9 +8279,11 @@ tcl::namespace::eval textblock { } altg { set tbar [tcl::string::repeat $hlt $frame_inner_width] - set tbar [cd::groptim $tbar] + #set tbar [cd::groptim $tbar] + set tbar [punk::ansi::groptim $tbar] set bbar [tcl::string::repeat $hlb $frame_inner_width] - set bbar [cd::groptim $bbar] + #set bbar [cd::groptim $bbar] + set bbar [punk::ansi::groptim $bbar] } default { set tbar [tcl::string::repeat $hlt $frame_inner_width] diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/tomlish-1.1.1.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/tomlish-1.1.1.tm index 3e13e75d..0c8d0b1a 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/tomlish-1.1.1.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/tomlish-1.1.1.tm @@ -716,6 +716,7 @@ namespace eval tomlish { set toml [::tomlish::to_toml $tomlish] } + #TODO use huddle? proc from_json {json} { set jstruct [::tomlish::json_struct $json] return [::tomlish::from_json_struct $jstruct] @@ -1080,11 +1081,13 @@ namespace eval tomlish::decode { # For this reason, we also do absolutely no line-ending transformations based on platform. # All line-endings are maintained as is, and even a file with mixed cr crlf line-endings will be correctly interpreted and can be 'roundtripped' - proc toml {s} { + proc toml {args} { #*** !doctools - #[call [fun toml] [arg s]] + #[call [fun toml] [arg arg...]] #[para] return a Tcl list of tomlish tokens + set s [join $args \n] + namespace upvar ::tomlish::parse is_parsing is_parsing set is_parsing 1 @@ -2380,7 +2383,7 @@ namespace eval tomlish::parse { squotedkey {PUSHSPACE "itable-keyval-space" state "itable-keyval-syntax"}\ endinlinetable "POPSPACE"\ startquote "quoted-key"\ - startsquote {TOSTATE "squoted-key" comment "jn-ok"}\ + startsquote {TOSTATE "squoted-key" comment "jn-testing"}\ comma "itable-space"\ comment "err-state"\ eof "err-state"\ diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/make.tcl b/src/project_layouts/custom/_project/punk.shell-0.1/src/make.tcl index de7e055a..6776eb79 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/make.tcl +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/make.tcl @@ -18,7 +18,7 @@ namespace eval ::punkboot { variable foldername [file tail $scriptfolder] variable pkg_requirements [list]; variable pkg_missing [list];variable pkg_loaded [list] variable non_help_flags [list -k] - variable help_flags [list -help --help /?] + variable help_flags [list -help --help /? -h] variable known_commands [list project modules vfs info check shell vendorupdate bootsupport vfscommonupdate] } @@ -180,10 +180,14 @@ set bootsupport_module_paths [list] set bootsupport_library_paths [list] if {[file exists [file join $startdir src bootsupport]]} { lappend bootsupport_module_paths [file join $startdir src bootsupport modules] + lappend bootsupport_module_paths [file join $startdir src bootsupport modules_tcl$::tclmajorv] lappend bootsupport_library_paths [file join $startdir src bootsupport lib] + lappend bootsupport_library_paths [file join $startdir src bootsupport lib_tcl$::tclmajorv] } else { lappend bootsupport_module_paths [file join $startdir bootsupport modules] + lappend bootsupport_module_paths [file join $startdir bootsupport modules_tcl$::tclmajorv] lappend bootsupport_library_paths [file join $startdir bootsupport lib] + lappend bootsupport_library_paths [file join $startdir bootsupport lib_tcl$::tclmajorv] } set bootsupport_paths_exist 0 foreach p [list {*}$bootsupport_module_paths {*}$bootsupport_library_paths] { @@ -203,13 +207,13 @@ set sourcesupport_paths_exist 0 #(most?) Modules in src/modules etc should still be runnable directly in certain cases like this where we point to them. if {[file tail $startdir] eq "src"} { #todo - other src 'module' dirs.. - foreach p [list $startdir/modules $startdir/modules_tcl$::tclmajorv] { + foreach p [list $startdir/modules $startdir/modules_tcl$::tclmajorv $startdir/vendormodules $startdir/vendormodules_tcl$::tclmajorv] { if {[file exists $p]} { lappend sourcesupport_module_paths $p } } # -- -- -- - foreach p [list $startdir/vendorlib $startdir/vendorlib_tcl${::tclmajorv}] { + foreach p [list $startdir/lib $startdir/lib_tcl$::tclmajorv $startdir/vendorlib $startdir/vendorlib_tcl$::tclmajorv] { if {[file exists $p]} { lappend sourcesupport_library_paths $p } @@ -266,9 +270,12 @@ if {$bootsupport_paths_exist || $sourcesupport_paths_exist} { package forget $pkg } } - tcl::tm::add {*}$bootsupport_module_paths {*}$sourcesupport_module_paths - set ::auto_path [list {*}$bootsupport_library_paths {*}$sourcesupport_library_paths] + #tcl::tm::add {*}$original_tm_list {*}$bootsupport_module_paths {*}$sourcesupport_module_paths + #set ::auto_path [list {*}$original_auto_path {*}$bootsupport_library_paths {*}$sourcesupport_library_paths] + tcl::tm::add {*}$bootsupport_module_paths {*}$sourcesupport_module_paths + set ::auto_path [list {*}$bootsupport_library_paths {*}$sourcesupport_library_paths] } + puts "----> auto_path $::auto_path" @@ -1046,7 +1053,9 @@ proc ::punkboot::punkboot_gethelp {args} { append h " - before calling this (followed by make project) - you can test using '(.exe) dev'" \n append h " this will load modules from your /module /lib paths instead of from the kit/zipkit" \n \n append h " $scriptname info" \n - append h " - show the name and base folder of the project to be built" \n + append h " - show the name and base folder of the project to be built" \n \n + append h " $scriptname check" \n + append h " - show module/library paths and any potentially problematic packages for running this script" \n append h "" \n if {[llength [dict get $pkg_availability missing]] || [llength [dict get $pkg_availability broken]]} { set has_recommended 0 @@ -1116,6 +1125,7 @@ if {[llength $commands_found] != 1 } { set do_help 1 } if {$do_help} { + puts stdout "Checking package availability..." set ::punkboot::pkg_availability [::punkboot::check_package_availability -quiet 1 $::punkboot::bootsupport_requirements] foreach pkg_request [dict get $::punkboot::pkg_availability loaded] { #puts stderr "---> $pkg_request" @@ -1407,6 +1417,7 @@ if {$::punkboot::command eq "vendorupdate"} { puts stderr "Unable to use punkcheck for vendormodules$which update. Error: $errM" set installation_event "" } + #todo - sync alg with bootsupport_localupdate! foreach {relpath requested_module} $local_modules { set requested_module [string trim $requested_module :] set module_subpath [string map {:: /} [namespace qualifiers $requested_module]] @@ -1488,6 +1499,11 @@ if {$::punkboot::command eq "bootsupport"} { #puts "-- [tcl::tm::list] --" puts stdout "Updating bootsupport from local files" + proc modfile_sort {p1 p2} { + lassign [split [file rootname $p1] -] _ v1 + lassign [split [file rootname $p1] -] _ v2 + package vcompare $v1 $v2 + } proc bootsupport_localupdate {projectroot} { set bootsupport_modules [list] ;#variable populated by include_modules.config file - review set sourcefolder $projectroot/src @@ -1521,57 +1537,66 @@ if {$::punkboot::command eq "bootsupport"} { set boot_event "" } - foreach {relpath module} $bootsupport_modules { - set module [string trim $module :] - set module_subpath [string map [list :: /] [namespace qualifiers $module]] + foreach {relpath modulematch} $bootsupport_modules { + set modulematch [string trim $modulematch :] + set module_subpath [string map [list :: /] [namespace qualifiers $modulematch]] set srclocation [file join $projectroot $relpath $module_subpath] - #puts stdout "$relpath $module $module_subpath $srclocation" - set pkgmatches [glob -nocomplain -dir $srclocation -tail [namespace tail $module]-*] - #lsort won't sort version numbers properly e.g with -dictionary 0.1.1 comes before 0.1 + #puts stdout "$relpath $modulematch $module_subpath $srclocation" + if {[string first - $modulematch]} { + set pkgmatches [glob -nocomplain -dir $srclocation -tail -type f [namespace tail $modulematch]*.tm] + } else { + set pkgmatches [glob -nocomplain -dir $srclocation -tail -type f [namespace tail $modulematch]-*.tm] + } if {![llength $pkgmatches]} { - puts stderr "Missing source for bootsupport module $module - not found in $srclocation" + puts stderr "Missing source for bootsupport module $modulematch - no matches in $srclocation" continue } - set latestfile [lindex $pkgmatches 0] - set latestver [lindex [split [file rootname $latestfile] -] 1] - foreach m $pkgmatches { - lassign [split [file rootname $m] -] _pkg ver - #puts "comparing $ver vs $latestver" - if {[package vcompare $ver $latestver] == 1} { - set latestver $ver - set latestfile $m - } + + set modulematch_is_glob [regexp {[*?\[\]]} $modulematch] + if {!$modulematch_is_glob} { + #if modulematch was specified without globs - only copy latest + #lsort won't sort version numbers properly e.g with -dictionary 0.1.1 comes before 0.1b3 - use helper func + set pkgmatches [lsort -command modfile_sort $pkgmatches] + set latestfile [lindex $pkgmatches end] + #set latestver [lindex [split [file rootname $latestfile] -] 1] + set copy_files $latestfile + } else { + #globs in modulematch - may be different packages matched by glob - copy all versions of matches + #review + set copy_files $pkgmatches } - set srcfile [file join $srclocation $latestfile] - set tgtfile [file join $targetroot $module_subpath $latestfile] - if {$boot_event ne ""} { - #---------- - $boot_event targetset_init INSTALL $tgtfile - $boot_event targetset_addsource $srcfile - #---------- - if {\ - [llength [dict get [$boot_event targetset_source_changes] changed]]\ - || [llength [$boot_event get_targets_exist]] < [llength [$boot_event get_targets]]\ - } { - file mkdir [file dirname $tgtfile] ;#ensure containing folder for target exists - $boot_event targetset_started - # -- --- --- --- --- --- - puts "BOOTSUPPORT module$which update: $srcfile -> $tgtfile" - if {[catch { - file copy -force $srcfile $tgtfile - } errM]} { - $boot_event targetset_end FAILED + foreach cfile $copy_files { + set srcfile [file join $srclocation $cfile] + set tgtfile [file join $targetroot $module_subpath $cfile] + if {$boot_event ne ""} { + #---------- + $boot_event targetset_init INSTALL $tgtfile + $boot_event targetset_addsource $srcfile + #---------- + if {\ + [llength [dict get [$boot_event targetset_source_changes] changed]]\ + || [llength [$boot_event get_targets_exist]] < [llength [$boot_event get_targets]]\ + } { + file mkdir [file dirname $tgtfile] ;#ensure containing folder for target exists + $boot_event targetset_started + # -- --- --- --- --- --- + puts "BOOTSUPPORT module$which update: $srcfile -> $tgtfile" + if {[catch { + file copy -force $srcfile $tgtfile + } errM]} { + $boot_event targetset_end FAILED + } else { + $boot_event targetset_end OK + } + # -- --- --- --- --- --- } else { - $boot_event targetset_end OK + puts -nonewline stderr "." + $boot_event targetset_end SKIPPED } - # -- --- --- --- --- --- + $boot_event end } else { - puts -nonewline stderr "." - $boot_event targetset_end SKIPPED + file copy -force $srcfile $tgtfile } - $boot_event end - } else { - file copy -force $srcfile $tgtfile } } if {$boot_event ne ""} { @@ -1597,13 +1622,14 @@ if {$::punkboot::command eq "bootsupport"} { if {[file exists $project_layout_base]} { set project_layouts [glob -nocomplain -dir $project_layout_base -type d -tail *] foreach layoutname $project_layouts { + puts stdout "Processing layout $project_layout_base/$layoutname" #don't auto-create src/bootsupport - just update it if it exists if {[file exists [file join $project_layout_base $layoutname/src/bootsupport]]} { set antipaths [list\ README.md\ ] - set boot_module_folders [glob -nocomplain -dir $projectroot/src/bootsupport/modules_tcl*] - lappend bootsupport_module_folders "modules" + #set boot_module_folders [list modules {*}[glob -nocomplain -dir $projectroot/src/bootsupport/modules_tcl*]] + set bootsupport_module_folders "modules" foreach bm $bootsupport_module_folders { if {[file exists $projectroot/src/bootsupport/$bm]} { lassign [split $bm _] _bm tclx @@ -1617,12 +1643,33 @@ if {$::punkboot::command eq "bootsupport"} { file mkdir $targetroot puts stdout "BOOTSUPPORT$which layouts/$layoutname: copying from $sourcemodules to $targetroot (if source file changed)" - set resultdict [punkcheck::install $sourcemodules $targetroot -overwrite installedsourcechanged-targets -antiglob_paths $antipaths] + + set resultdict [punkcheck::install $sourcemodules $targetroot\ + -overwrite installedsourcechanged-targets\ + -antiglob_paths $antipaths\ + -installer "punkboot-bootsupport" + ] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] flush stdout } } } + #make.tcl (to be boot.tcl?) is part of bootsupport + set source_bootscript [file join $projectroot src/make.tcl] + set targetroot_bootscript $project_layout_base/$layoutname/src + if {[file exists $source_bootscript]} { + puts stdout "BOOTSUPPORT layouts/$layoutname: copying from $source_bootscript to $targetroot_bootscript (if source file changed)" + set resultdict [punkcheck::install [file dirname $source_bootscript] $targetroot_bootscript\ + -glob make.tcl\ + -max_depth 1\ + -createempty 0\ + -overwrite installedsourcechanged-targets\ + -installer "punkboot-bootsupport" + ] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + flush stdout + } } } else { puts stderr "No layout base at $project_layout_base" diff --git a/src/vfs/_vfscommon.vfs/modules/argparsingtest-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/argparsingtest-0.1.0.tm index 16387b0a..1ede846b 100644 --- a/src/vfs/_vfscommon.vfs/modules/argparsingtest-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/argparsingtest-0.1.0.tm @@ -276,7 +276,7 @@ namespace eval argparsingtest { #punk::args is slower than argp - but comparable, and argp doesn't support solo flags proc test1_punkargs {args} { - set argd [punk::args::get_dict { + set argd [punk::args::parse $args withdef { @id -id ::argparsingtest::test1_punkargs @cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" @opts -anyopts 0 @@ -292,7 +292,7 @@ namespace eval argparsingtest { -2 -default 2 -type integer -3 -default 3 -type integer @values - } $args] + }] return [tcl::dict::get $argd opts] } diff --git a/src/vfs/_vfscommon.vfs/modules/commandstack-0.3.tm b/src/vfs/_vfscommon.vfs/modules/commandstack-0.3.tm index ee486569..a45eaeaf 100644 --- a/src/vfs/_vfscommon.vfs/modules/commandstack-0.3.tm +++ b/src/vfs/_vfscommon.vfs/modules/commandstack-0.3.tm @@ -211,7 +211,7 @@ namespace eval commandstack { set new_code [string trim $procbody] if {$current_code eq $new_code} { puts stderr "(commandstack::rename_command) WARNING - renamer '$renamer' has already renamed the '$command' command with same procbody - Aborting rename." - puts stderr [show_stack $command] + puts stderr [::commandstack::show_stack $command] } else { puts stderr "(commandstack::rename_command) WARNING - renamer '$renamer' has already renamed the '$command' command - but appears to be with new code - proceeding." puts stdout "----------" @@ -236,8 +236,7 @@ namespace eval commandstack { set next_target ::commandstack::renamed_commands::${mungedcommand}_${munged_next_implementor}-$mungedrenamer-$tokenid set do_rename 1 } elseif {$next_implementor in {unspecified undetermined}} { - #review - probably don't need a warning anyway - puts stderr "(commandstack::rename_command) WARNING - Something may have renamed the '$command' command. Attempting to cooperate.(untested)" + #could be a standard tcl proc, or from application or package set next_target ::commandstack::renamed_commands::${mungedcommand}_${munged_next_implementor}-$mungedrenamer-$tokenid set do_rename 1 } else { @@ -380,7 +379,8 @@ namespace eval commandstack { #if caller is attempting exact match - use the calling context to resolve in case they didn't supply namespace set commandname_glob [uplevel 1 [list namespace which $commandname_glob]] } - if {[package provide punk::lib] ne ""} { + if {[package provide punk::lib] ne "" && [package provide punk] ne ""} { + #punk pipeline also needed for patterns return [punk::lib::pdict -channel none all_stacks $commandname_glob/@*/@*.@*] } else { set result "" diff --git a/src/vfs/_vfscommon.vfs/modules/funcl-0.1.tm b/src/vfs/_vfscommon.vfs/modules/funcl-0.1.tm index 1d2fe64a..e8430fb0 100644 --- a/src/vfs/_vfscommon.vfs/modules/funcl-0.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/funcl-0.1.tm @@ -9,7 +9,7 @@ package provide funcl [namespace eval funcl { namespace eval funcl { - #from punk + #from punk::pipe proc arg_is_script_shaped {arg} { if {[string first " " $arg] >= 0} { return 1 diff --git a/src/vfs/_vfscommon.vfs/modules/overtype-1.6.5.tm b/src/vfs/_vfscommon.vfs/modules/overtype-1.6.5.tm index fb044b3c..9363fb6d 100644 --- a/src/vfs/_vfscommon.vfs/modules/overtype-1.6.5.tm +++ b/src/vfs/_vfscommon.vfs/modules/overtype-1.6.5.tm @@ -216,7 +216,9 @@ tcl::namespace::eval overtype { } set optargs [lrange $args 0 end-2] if {[llength $optargs] % 2 == 0} { - lassign [lrange $args end-1 end] underblock overblock + set overblock [lindex $args end] + set underblock [lindex $args end-1] + #lassign [lrange $args end-1 end] underblock overblock set argsflags [lrange $args 0 end-2] } else { set optargs [lrange $args 0 end-1] @@ -1810,8 +1812,10 @@ tcl::namespace::eval overtype { if {[llength $args] < 2} { error {usage: ?-info 0|1? ?-startcolumn ? ?-cursor_column ? ?-cursor_row |""? ?-transparent [0|1|]? ?-expand_right [1|0]? undertext overtext} } - lassign [lrange $args end-1 end] under over - if {[string first \n $under] >= 0} { + set under [lindex $args end-1] + set over [lindex $args end] + #lassign [lrange $args end-1 end] under over + if {[string last \n $under] >= 0} { error "overtype::renderline not allowed to contain newlines in undertext" } #if {[string first \n $over] >=0 || [string first \n $under] >= 0} { @@ -2920,6 +2924,7 @@ tcl::namespace::eval overtype { set leadernorm [tcl::string::range [tcl::string::map [list\ \x1b\[< 1006\ \x1b\[ 7CSI\ + \x1bY 7MAP\ \x1bP 7DCS\ \x90 8DCS\ \x9b 8CSI\ @@ -2948,6 +2953,10 @@ tcl::namespace::eval overtype { #8-bit Device Control String set codenorm [tcl::string::cat $leadernorm [tcl::string::range $code 1 end]] } + 7MAP { + #map to another type of code to share implementation branch + set codenorm $leadernorm[tcl::string::range $code 1 end] + } 7ESC { #set codenorm [tcl::string::cat $leadernorm [tcl::string::range $code 1 end]] set codenorm $leadernorm[tcl::string::range $code 1 end] @@ -2964,6 +2973,30 @@ tcl::namespace::eval overtype { } } + switch -- $leadernorm { + 7MAP { + switch -- [lindex $codenorm 4] { + Y { + #vt52 movement. we expect 2 chars representing position (limited range) + set params [tcl::string::range $codenorm 5 end] + if {[tcl::string::length $params] != 2} { + #shouldn't really get here or need this branch if ansi splitting was done correctly + puts stderr "overtype::renderline ESC Y recognised as vt52 move, but incorrect parameters length ([string length $params] vs expected 2) [ansistring VIEW -lf 1 -vt 1 -nul 1 $code] not implemented codenorm:[ansistring VIEW -lf 1 -vt 1 -nul 1 $codenorm]" + } + set line [tcl::string::index $params 5] + set column [tcl::string::index $params 1] + set r [expr {[scan $line %c] -31}] + set c [expr {[scan $column %c] -31}] + + #MAP to: + #CSI n;m H - CUP - Cursor Position + set leadernorm 7CSI + set codenorm "$leadernorm${r}\;${c}H" + } + } + } + } + #we've mapped 7 and 8bit escapes to values we can handle as literals in switch statements to take advantange of jump tables. switch -- $leadernorm { 1006 { @@ -2982,7 +3015,8 @@ tcl::namespace::eval overtype { {7CSI} - {8CSI} { set param [tcl::string::range $codenorm 4 end-1] #puts stdout "--> CSI [tcl::string::index $leadernorm 0] bit param:$param" - set code_end [tcl::string::index $codenorm end] ;#used for e.g h|l set/unset mode + set code_end [tcl::string::index $codenorm end] ;#used for e.g h|l set/unset mode + switch -exact -- $code_end { A { #Row move - up @@ -3875,6 +3909,7 @@ tcl::namespace::eval overtype { 7ESC { # #re_other_single {\x1b(D|M|E)$} + #also vt52 Y.. #also PM \x1b^...(ST) switch -- [tcl::string::index $codenorm 4] { c { @@ -4586,6 +4621,8 @@ tcl::namespace::eval overtype::priv { set o [lreplace $o $i $i] set ustacks [lreplace $ustacks $i $i] set gxstacks [lreplace $gxstacks $i $i] + } elseif {$i == 0 || $i == $nxt} { + #nothing to do } else { puts stderr "render_delchar - attempt to delchar at index $i >= number of outcols $nxt - shouldn't happen" } diff --git a/src/vfs/_vfscommon.vfs/modules/patternpunk-1.1.tm b/src/vfs/_vfscommon.vfs/modules/patternpunk-1.1.tm index 6611eee5..42bd91e6 100644 --- a/src/vfs/_vfscommon.vfs/modules/patternpunk-1.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/patternpunk-1.1.tm @@ -113,7 +113,7 @@ proc TCL {args} { punk::args::define { #Review - @id -id ">punk . poses" + @id -id "::>punk . poses" @cmd -name ">punk . poses" -help "Show or list the poses for the Punk mascot" -censored -default 1 -type boolean -help "Set true to include mild toilet humour poses" -return -default table -choices {list table} @@ -323,15 +323,16 @@ _+ +_ +_+_ } \n] ->punk .. Property fossil [string trim { - .. - > < - \ / v -v \\_/ - \/\\ v . -v_ /|\/ / - \__/ -} \n] +>punk .. Property fossil [punk::args::lib::tstr [string trim { + .. + > < + \ / v + v \\_/ + \/\\ v . + v_ /|\/ / + \__/ +} \n]] + >punk .. Method deck {args} { #todo - themes? set this @this@ @@ -344,7 +345,7 @@ v_ /|\/ / set punk $punk_colour[$this . lhs_air]$RST package require punk::args set standard_frame_types [textblock::frametypes] - set argd [punk::args::get_dict [tstr -return string { + set argd [punk::args::parse $args withdef [tstr -return string { @id -id ">punk . deck" @cmd -name "deck" -help "Punk Deck mascot" -frame -default arc -choices "${$standard_frame_types}" -choicerestricted 0 -choiceprefix 1 @@ -356,7 +357,7 @@ v_ /|\/ / -title -default "PATTERN" -type string -subtitle -default "PUNK" -type string @values -max 0 - }] $args] + }]] set frame_type [dict get $argd opts -frame] set box_map [dict get $argd opts -boxmap] set box_limits [dict get $argd opts -boxlimits] diff --git a/src/vfs/_vfscommon.vfs/modules/pipe-1.0.tm b/src/vfs/_vfscommon.vfs/modules/pipe-1.0.tm new file mode 100644 index 00000000..19222a85 --- /dev/null +++ b/src/vfs/_vfscommon.vfs/modules/pipe-1.0.tm @@ -0,0 +1,305 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from -buildversion.txt +# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.3.tm +# +# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. +# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# (C) 2025 +# +# @@ Meta Begin +# Application pipe 1.0 +# Meta platform tcl +# Meta license MIT +# @@ Meta End + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# doctools header +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[manpage_begin shellspy_module_pipe 0 1.0] +#[copyright "2025"] +#[titledesc {Module API}] [comment {-- Name section and table of contents description --}] +#[moddesc {-}] [comment {-- Description at end of page heading --}] +#[require pipe] +#[keywords module] +#[description] +#[para] - + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section Overview] +#[para] overview of pipe +#[subsection Concepts] +#[para] - + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[subsection dependencies] +#[para] packages used by pipe +#[list_begin itemized] + +package require Tcl 8.6- +#*** !doctools +#[item] [package {Tcl 8.6}] + +# #package require frobz +# #*** !doctools +# #[item] [package {frobz}] + +#*** !doctools +#[list_end] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section API] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# oo::class namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#tcl::namespace::eval pipe::class { + #*** !doctools + #[subsection {Namespace pipe::class}] + #[para] class definitions + #if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} { + #*** !doctools + #[list_begin enumerated] + + # oo::class create interface_sample1 { + # #*** !doctools + # #[enum] CLASS [class interface_sample1] + # #[list_begin definitions] + + # method test {arg1} { + # #*** !doctools + # #[call class::interface_sample1 [method test] [arg arg1]] + # #[para] test method + # puts "test: $arg1" + # } + + # #*** !doctools + # #[list_end] [comment {-- end definitions interface_sample1}] + # } + + #*** !doctools + #[list_end] [comment {--- end class enumeration ---}] + #} +#} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +tcl::namespace::eval pipe { + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + # Base namespace + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + #*** !doctools + #[subsection {Namespace pipe}] + #[para] Core API functions for pipe + #[list_begin definitions] + + + + #proc sample1 {p1 n args} { + # #*** !doctools + # #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] + # #[para]Description of sample1 + # #[para] Arguments: + # # [list_begin arguments] + # # [arg_def tring p1] A description of string argument p1. + # # [arg_def integer n] A description of integer argument n. + # # [list_end] + # return "ok" + #} + + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace pipe ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Secondary API namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +tcl::namespace::eval pipe::lib { + tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase + tcl::namespace::path [tcl::namespace::parent] + #*** !doctools + #[subsection {Namespace pipe::lib}] + #[para] Secondary functions that are part of the API + #[list_begin definitions] + + #proc utility1 {p1 args} { + # #*** !doctools + # #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] + # #[para]Description of utility1 + # return 1 + #} + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace pipe::lib ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[section Internal] +#tcl::namespace::eval pipe::system { + #*** !doctools + #[subsection {Namespace pipe::system}] + #[para] Internal functions that are not part of the API + + + +#} + + +# == === === === === === === === === === === === === === === +# Sample 'about' function with punk::args documentation +# == === === === === === === === === === === === === === === +tcl::namespace::eval pipe { + tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase + variable PUNKARGS + + lappend PUNKARGS [list { + @id -id "(package)pipe" + @package -name "pipe" -help\ + "Package + Description" + }] + + namespace eval pipe::argdoc { + #namespace for custom argument documentation + variable about_topics [list\ + license\ + version\ + contact\ + ] + proc about_topics {} { + variable about_topics + return $about_topics + } + proc get_topic_license {} { + return "%ver%" + } + proc get_topic_version {} { + return "%ver%" + } + proc get_topic_contact {} { + set authors {{Julian Noble } {test " + } + if {!$is_table} { + append about [format %-${widest_topic}s $topic] " " $topic_contents \n + } else { + $t add_row [list $topic $topic_contents] + } + } + + if {!$is_table} { + return $about + } else { + if {$opt_return eq "tableobject"} { + return $t + } + set result [$t print] + $t destroy + return $result + } + } +} +# end of sample 'about' function +# == === === === === === === === === === === === === === === + +if {![info exists ::punk::args::register::NAMESPACES]} { + namespace eval ::punk::args::register { + set ::punk::args::register::NAMESPACES [list] ;#use fully qualified so 8.6 doesn't find existing var in global namespace + } +} +lappend ::punk::args::register::NAMESPACES pipe + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide pipe [tcl::namespace::eval pipe { + variable pkg pipe + variable version + set version 1.0 +}] +return + +#*** !doctools +#[manpage_end] + diff --git a/src/vfs/_vfscommon.vfs/modules/punk-0.1.tm b/src/vfs/_vfscommon.vfs/modules/punk-0.1.tm index 738d89c5..a53ea000 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk-0.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk-0.1.tm @@ -20,6 +20,21 @@ namespace eval punk { variable cmdexedir set cmdexedir "" + proc sync_package_paths_script {} { + #the tcl::tm namespace doesn't exist until one of the tcl::tm commands + #is run. (they are loaded via ::auto_index triggering load of tm.tcl) + #we call tcl::tm::list to trigger the initial set of tm paths before + #we can override it, otherwise our changes will be lost + #REVIEW - won't work on safebase interp where paths are mapped to {$p(:x:)} etc + return "\ + apply {{ap tmlist} { + set ::auto_path \$ap + tcl::tm::list + set ::tcl::tm::paths \$tmlist + }} {$::auto_path} {[tcl::tm::list]} + " + } + proc rehash {{refresh 0}} { global auto_execs if {!$refresh} { @@ -217,7 +232,7 @@ namespace eval punk { [file exists [set testapp [file join $::env(LOCALAPPDATA) "Microsoft" "WindowsApps" "winget.exe"]]])} { #should be unlikely to get here - unless LOCALAPPDATA missing set windowsappdir [file dirname [lindex [::punk::auto_execok_windows winget.exe] 0]] - puts stderr "(resolved winget by search)" + catch {puts stderr "(resolved winget by search)"} } else { set windowsappdir [file dirname $testapp] } @@ -359,7 +374,7 @@ if {![llength [info commands ::ansistring]]} { } #require aliascore after punk::lib & punk::ansi are loaded package require punk::aliascore ;#mostly punk::lib aliases -punk::aliascore::init +punk::aliascore::init -force 1 package require punk::repl::codethread package require punk::config @@ -370,6 +385,9 @@ package require punk::winpath ;# for windows paths - but has functions that can package require punk::repo package require punk::du package require punk::mix::base +package require base64 + +package require punk::pipe namespace eval punk { # -- --- --- @@ -383,8 +401,10 @@ namespace eval punk { package require punk::assertion if {[catch {namespace import ::punk::assertion::assert} errM]} { - puts stderr "punk error importing punk::assertion::assert\n$errM" - puts stderr "punk::a* commands:[info commands ::punk::a*]" + catch { + puts stderr "punk error importing punk::assertion::assert\n$errM" + puts stderr "punk::a* commands:[info commands ::punk::a*]" + } } punk::assertion::active on # -- --- --- @@ -393,7 +413,7 @@ namespace eval punk { if {[catch { package require pattern } errpkg]} { - puts stderr "Failed to load package pattern error: $errpkg" + catch {puts stderr "Failed to load package pattern error: $errpkg"} } package require shellfilter package require punkapp @@ -524,7 +544,7 @@ namespace eval punk { set loader [zzzload::pkg_wait twapi] } errM]} { if {$loader in [list failed loading]} { - puts stderr "Unexpected problem during thread-load of pkg twapi - zzload::pkg_wait returned $loader" + catch {puts stderr "Unexpected problem during thread-load of pkg twapi - zzload::pkg_wait returned $loader"} } } else { package require twapi @@ -546,13 +566,15 @@ namespace eval punk { #get last command result that was run through the repl proc ::punk::get_runchunk {args} { - set argd [punk::args::get_dict { + set argd [punk::args::parse $args withdef { @id -id ::punk::get_runchunk + @cmd -name "punk::get_runchunk" -help\ + "experimental" @opts -1 -optional 1 -type none -2 -optional 1 -type none @values -min 0 -max 0 - } $args] + }] #todo - make this command run without truncating previous runchunks set runchunks [tsv::array names repl runchunks-*] @@ -637,44 +659,8 @@ namespace eval punk { set ::argc $argc return -code $code $return } - #https://randomascii.wordpress.com/2012/02/25/comparing-floating-point-numbers-2012-edition/ - # - #we can't provide a float comparison suitable for every situation, - #but we pick something reasonable, keep it stable, and document it. - proc float_almost_equal {a b} { - package require math::constants - set diff [expr {abs($a - $b)}] - if {$diff <= $math::constants::eps} { - return 1 - } - set A [expr {abs($a)}] - set B [expr {abs($b)}] - set largest [expr {($B > $A) ? $B : $A}] - return [expr {$diff <= $largest * $math::constants::eps}] - } + - #boolean could be tr, true, y, ye, yes,Yes, 1 , 0 etc. - proc boolean_equal {a b} { - #equivalenttly xnor: expr {!(($a && 1) ^ ($b && 1))} ;# less clear and no discernable timing benefit. - expr {($a && 1) == ($b && 1)} - } - #debatable whether boolean_almost_equal is likely to be surprising or helpful. - #values from a calculation that are extremely close to zero but aren't false could also be surprising - especially if they compare equal numerically - #perhaps a fuzzy-boolean is a step too far for a default - but it's inline with float-comparison for pattern-matching. use an even more complex classifier? (^&~) ? - proc boolean_almost_equal {a b} { - if {[string is double -strict $a]} { - if {[float_almost_equal $a 0]} { - set a 0 - } - } - if {[string is double -strict $b]} { - if {[float_almost_equal $b 0]} { - set b 0 - } - } - #must handle true,no etc. - expr {($a && 1) == ($b && 1)} - } proc varinfo {vname {flag ""}} { @@ -789,142 +775,6 @@ namespace eval punk { scan $s %${p}s%s } - #split top level of patterns only. - proc _split_patterns_memoized {varspecs} { - set name_mapped [pipecmd_namemapping $varspecs] - set cmdname ::punk::pipecmds::split_patterns::_$name_mapped - if {[info commands $cmdname] ne ""} { - return [$cmdname] - } - set result [_split_patterns $varspecs] - proc $cmdname {} [list return $result] - #debug.punk.pipe.compile {proc $cmdname} 4 - return $result - } - proc _split_patterns {varspecs} { - - set varlist [list] - # @ @@ - list and dict functions - # / level separator - # # list count, ## dict size - # % string functions - # ! not - set var_terminals [list "@" "/" "#" "%" "!" ">" "<"] ;# (> required for insertionspecs at rhs of = & .= ) - #right bracket ) also ends a var - but is different depending on whether var is array or basic. For array - it forms part of the varname - - #except when prefixed directly by pin classifier ^ - set protect_terminals [list "^"] ;# e.g sequence ^# - #also - an atom usually doesn't need the / as a terminal - because it can't match a missing element unless it's empty string - #ie the one usecase is '/n to match either empty string or missing item at position n. For this one usecase - we miss the capability to atom match paths/urls .. '/usr/local/et' - set in_brackets 0 ;#count depth - set in_atom 0 - #set varspecs [string trimleft $varspecs ,] - set token "" - #if {[string first "," $varspecs] <0} { - # return $varspecs - #} - set first_term -1 - set token_index 0 ;#index of terminal char within each token - set indq 0 - set inesc 0 ;#whether last char was backslash (see also punk::escv) - set prevc "" - set char_index 0 - foreach c [split $varspecs ""] { - if {$indq} { - if {$inesc} { - #puts stderr "inesc adding '$c'" - append token $c - } else { - if {$c eq {"}} { - set indq 0 - } else { - append token $c - } - } - } elseif {$in_atom} { - #ignore dquotes/brackets in atoms - pass through - append token $c - #set nextc [lindex $chars $char_index+1] - if {$c eq "'"} { - set in_atom 0 - } - } elseif {$in_brackets > 0} { - append token $c - if {$c eq ")"} { - incr in_brackets -1 - } - } else { - if {$c eq {"} && !$inesc} { - set indq 1 - } elseif {$c eq ","} { - #lappend varlist [splitstrposn $token $first_term] - set var $token - set spec "" - if {$first_term > 0} { - #tcl scan with %s will not handle whitespace as desired. Be explicit using string range instead. - #lassign [scan $token %${first_term}s%s] var spec - set var [string range $token 0 $first_term-1] - set spec [string range $token $first_term end] ;#key section includes the terminal char which ended the var and starts the spec - } else { - if {$first_term == 0} { - set var "" - set spec $token - } - } - lappend varlist [list [string trim $var] [string trim $spec]] - set token "" - set token_index -1 ;#reduce by 1 because , not included in next token - set first_term -1 - } else { - append token $c - switch -exact -- $c { - ' { - set in_atom 1 - } - ( { - incr in_brackets - } - default { - if {$first_term == -1 && (($c in $var_terminals) && ($prevc ni $protect_terminals))} { - set first_term $token_index - } - } - } - } - } - set prevc $c - if {$c eq "\\"} { - #review - if {$inesc} { - set inesc 0 - } else { - set token [string range $token 0 end-1] - set inesc 1 - } - } else { - set inesc 0 - } - incr token_index - incr char_index - } - if {[string length $token]} { - #lappend varlist [splitstrposn $token $first_term] - set var $token - set spec "" - if {$first_term > 0} { - #lassign [scan $token %${first_term}s%s] var spec - set var [string range $token 0 $first_term-1] - set spec [string range $token $first_term end] ;#key section includes the terminal char which ended the var and starts the spec - } else { - if {$first_term == 0} { - set var "" - set spec $token - } - } - lappend varlist [list [string trim $var] [string trim $spec]] - } - return $varlist - } proc _split_var_key_at_unbracketed_comma {varspecs} { set varlist [list] set var_terminals [list "@" "/" "#" "!"] @@ -1061,7 +911,7 @@ namespace eval punk { proc destructure {selector data} { # replaced by proc generating destructure_func - - puts stderr "punk::destructure .d. selector:'$selector'" + catch {puts stderr "punk::destructure .d. selector:'$selector'"} set selector [string trim $selector /] upvar v_dict_idx v_dict_idx ;#positional tracker for /@@ - dict position @@ -1506,7 +1356,24 @@ namespace eval punk { #map some problematic things out of the way in a manner that maintains some transparency #e.g glob chars ? * in a command name can make testing using {[info commands $cmd] ne ""} produce spurious results - requiring a stricter (and slower) test such as {$cmd in [info commands $cmd]} #The selector forms part of the proc name - set selector_safe [string map [list ? * {$} "" "\x1b\[" "\x1b\]" {[} {]} :: {;} " " \t \n \r ] $selector] + #review - compare with pipecmd_namemapping + set selector_safe [string map [list\ + ? \ + * \ + \\ \ + {"} \ + {$} \ + "\x1b\[" \ + "\x1b\]" \ + {[} \ + {]} \ + :: \ + {;} \ + " " \ + \t \ + \n \ + \r \ + ] $selector] set cmdname ::punk::pipecmds::destructure::_$selector_safe if {[info commands $cmdname] ne ""} { @@ -1645,7 +1512,7 @@ namespace eval punk { set SUBPATH [join [lrange $subindices 0 $i_keyindex] /] append script \n "# ------- START index:$index subpath:$SUBPATH ------" set lhs $index - append script \n "set lhs $index" + append script \n "set lhs {$index}" set assigned "" append script \n {set assigned ""} @@ -2219,6 +2086,7 @@ namespace eval punk { #vV set keyglob [string range $index 4 end] } + #if $keyglob eq "" - needs to query for dict key that is empty string. if {$get_not} { lappend INDEX_OPERATIONS globkey-get-values-not append script \n [tstr -return string -allowcommands { @@ -2226,7 +2094,7 @@ namespace eval punk { ${[tstr -ret string $tpl_return_mismatch_not_a_dict]} } # set active_key_type "dict" index_operation: globkey-get-values-not - set matched [dict keys $leveldata ${$keyglob}] + set matched [dict keys $leveldata {${$keyglob}}] set assigned [dict values [dict remove $leveldata {*}$matched]] }] @@ -2237,7 +2105,7 @@ namespace eval punk { if {[catch {dict size $leveldata}]} { ${[tstr -ret string $tpl_return_mismatch_not_a_dict]} } - set matched [dict keys $leveldata ${$keyglob}] + set matched [dict keys $leveldata {${$keyglob}}] set assigned [list] foreach m $matched { lappend assigned [dict get $leveldata $m] @@ -2260,7 +2128,7 @@ namespace eval punk { lappend INDEX_OPERATIONS globkey-get-pairs-not append script \n [string map [list $keyglob] { # set active_key_type "dict" index_operation: globkey-get-pairs-not - set matched [dict keys $leveldata ] + set matched [dict keys $leveldata {}] set assigned [dict remove $leveldata {*}$matched] }] @@ -2268,7 +2136,7 @@ namespace eval punk { lappend INDEX_OPERATIONS globkey-get-pairs append script \n [string map [list $keyglob] { # set active_key_type "dict" index_operations: globkey-get-pairs - set matched [dict keys $leveldata ] + set matched [dict keys $leveldata {}] set assigned [dict create] foreach m $matched { dict set assigned $m [dict get $leveldata $m] @@ -2290,7 +2158,7 @@ namespace eval punk { lappend INDEX_OPERATIONS globkey-get-keys-not append script \n [string map [list $keyglob] { # set active_key_type "dict" index_operation: globkey-get-keys-not - set matched [dict keys $leveldata ] + set matched [dict keys $leveldata {}] set assigned [dict keys [dict remove $leveldata {*}$matched]] }] @@ -2298,7 +2166,7 @@ namespace eval punk { lappend INDEX_OPERATIONS globkey-get-keys append script \n [string map [list $keyglob] { # set active_key_type "dict" index_operation: globkey-get-keys - set assigned [dict keys $leveldata ] + set assigned [dict keys $leveldata {}] }] } set level_script_complete 1 @@ -2306,7 +2174,7 @@ namespace eval punk { {@k\*@*} - {@K\*@*} { #dict value glob - return keys set active_key_type "dict" - set keyglob [string range $index 4 end] + set valglob [string range $index 4 end] append script [tstr -return string -allowcommands { if {[catch {dict size $leveldata}]} { ${[tstr -ret string $tpl_return_mismatch_not_a_dict]} @@ -2314,22 +2182,22 @@ namespace eval punk { }] if {$get_not} { lappend INDEX_OPERATIONS globvalue-get-keys-not - append script \n [string map [list $keyglob] { + append script \n [string map [list $valglob] { # set active_key_type "dict" index_operation: globvalue-get-keys-not set assigned [list] tcl::dict::for {k v} $leveldata { - if {![string match "" $v]} { + if {![string match {} $v]} { lappend assigned $k } } }] } else { lappend INDEX_OPERATIONS globvalue-get-keys - append script \n [string map [list $keyglob] { + append script \n [string map [list $valglob] { # set active_key_type "dict" index_operation: globvalue-get-keys set assigned [list] tcl::dict::for {k v} $leveldata { - if {[string match "" $v]} { + if {[string match {} $v]} { lappend assigned $k } } @@ -2340,7 +2208,7 @@ namespace eval punk { {@.\*@*} { #dict value glob - return pairs set active_key_type "dict" - set keyglob [string range $index 4 end] + set valglob [string range $index 4 end] append script [tstr -return string -allowcommands { if {[catch {dict size $leveldata}]} { ${[tstr -ret string $tpl_return_mismatch_not_a_dict]} @@ -2348,22 +2216,22 @@ namespace eval punk { }] if {$get_not} { lappend INDEX_OPERATIONS globvalue-get-pairs-not - append script \n [string map [list $keyglob] { + append script \n [string map [list $valglob] { # set active_key_type "dict" index_operation: globvalue-get-pairs-not set assigned [dict create] tcl::dict::for {k v} $leveldata { - if {![string match $v]} { + if {![string match {} $v]} { dict set assigned $k $v } } }] } else { lappend INDEX_OPERATIONS globvalue-get-pairs - append script \n [string map [list $keyglob] { + append script \n [string map [list $valglob] { # set active_key_type "dict" index_operation: globvalue-get-pairs set assigned [dict create] tcl::dict::for {k v} $leveldata { - if {[string match $v]} { + if {[string match {} $v]} { dict set assigned $k $v } } @@ -2374,7 +2242,7 @@ namespace eval punk { {@V\*@*} - {@v\*@*} { #dict value glob - return values set active_key_type dict - set keyglob [string range $index 4 end] + set valglob [string range $index 4 end] append script [tstr -return string -allowcommands { if {[catch {dict size $leveldata}]} { ${[tstr -ret string $tpl_return_mismatch_not_a_dict]} @@ -2382,11 +2250,11 @@ namespace eval punk { }] if {$get_not} { lappend INDEX_OPERATIONS globvalue-get-values-not - append script \n [string map [list $keyglob] { + append script \n [string map [list $valglob] { # set active_key_type "dict" ;# index_operation: globvalue-get-values-not set assigned [list] tcl::dict::for {k v} $leveldata { - if {![string match $v]} { + if {![string match {} $v]} { lappend assigned $v } } @@ -2394,9 +2262,9 @@ namespace eval punk { } else { lappend INDEX_OPERATIONS globvalue-get-values - append script \n [string map [list $keyglob] { + append script \n [string map [list $valglob] { # set active_key_type "dict" ;#index_operation: globvalue-get-value - set assigned [dict values $leveldata ] + set assigned [dict values $leveldata ] }] } set level_script_complete 1 @@ -2420,14 +2288,14 @@ namespace eval punk { # set active_key_type "dict" ;# index_operation: globkeyvalue-get-pairs-not set assigned [dict create] tcl::dict::for {k v} $leveldata { - if {[string match $k] || [string match $v]} { + if {[string match {} $k] || [string match {} $v]} { dict set assigned $k $v } } }] } - - error "globkeyvalue-get-pairs todo" + set level_script_complete 1 + puts stderr "globkeyvalue-get-pairs review" } @* { set active_key_type "list" @@ -3092,157 +2960,6 @@ namespace eval punk { return $script } - #todo - recurse into bracketed sub parts - #JMN3 - #e.g @*/(x@0,y@2) - proc _var_classify {multivar} { - set cmdname ::punk::pipecmds::var_classify::_[pipecmd_namemapping $multivar] - if {[info commands $cmdname] ne ""} { - return [$cmdname] - } - - - #comma seems a natural choice to split varspecs, - #but also for list and dict subelement access - #/ normally indicates some sort of hierarchical separation - (e.g in filesytems) - #so / will indicate subelements e.g @0/1 for lindex $list 0 1 - #set valsource_key_list [_split_var_key_at_unbracketed_comma $multivar] - set valsource_key_list [_split_patterns_memoized $multivar] - - - - #mutually exclusive - atom/pin - #set map [list "" ' ^ &] ;#0 = default/var/not-yet-determined 1 = atom 2 = pin - #set var_class [lmap var $valsource_key_list {expr {([set m [lsearch $map [string index [lindex $var 0] 0]]] >= 0) ? [list $var $m] : [list $var 0]}}] - #0 - novar - #1 - atom ' - #2 - pin ^ - #3 - boolean & - #4 - integer - #5 - double - #6 - var - #7 - glob (no classifier and contains * or ?) - #8 - numeric - #9 - > (+) - #10 - < (-) - - set var_names [list] - set var_class [list] - set varspecs_trimmed [list] ;#raw varspecs without pin/atom modifiers - or empty string for glob - - - set leading_classifiers [list "'" "&" "^" ] - set trailing_classifiers [list + -] - set possible_number_start [list - + . 0 1 2 3 4 5 6 7 8 9 > <] - - foreach v_key $valsource_key_list { - lassign $v_key v key - set vname $v ;#default - set classes [list] - if {$v eq ""} { - lappend var_class [list $v_key 0] - lappend varspecs_trimmed $v_key - } else { - set lastchar [string index $v end] - switch -- $lastchar { - + { - lappend classes 9 - set vname [string range $v 0 end-1] - } - - { - lappend classes 10 - set vname [string range $v 0 end-1] - } - } - set firstchar [string index $v 0] - switch -- $firstchar { - ' { - lappend var_class [list $v_key 1] - #set vname [string range $v 1 end] - lappend varspecs_trimmed [list $vname $key] - } - ^ { - lappend classes [list 2] - #use vname - may already have trailing +/- stripped - set vname [string range $vname 1 end] - set secondclassifier [string index $v 1] - switch -- $secondclassifier { - "&" { - #pinned boolean - lappend classes 3 - set vname [string range $v 2 end] - } - "#" { - #pinned numeric comparison instead of string comparison - #e.g set x 2 - # this should match: ^#x.= list 2.0 - lappend classes 8 - set vname [string range $vname 1 end] - } - "*" { - #pinned glob - lappend classes 7 - set vname [string range $v 2 end] - } - } - #todo - check for second tag - & for pinned boolean? - #consider requiring ^# for numeric comparisons. currently no way to do a strictly string comparison on pinned variables.... default ^var really shouldn't be doing any magic. - #while we're at it.. pinned glob would be nice. ^* - #maybe even pinned scan ^% ? regex? ^/ or ^? these would be hard to have corresponding literals in the pattern mini-lang. - #These all limit the range of varnames permissible - which is no big deal. - lappend var_class [list $v_key $classes] - lappend varspecs_trimmed [list $vname $key] - } - & { - #we require boolean literals to be single-quoted so we can use cross-binding on boolean vars. - #ie &true is the variable true whereas &'true' or &'1' &'t' etc are literal booleans - #allow exception of &1 &0 to be literal booleans - because we disallow 0 & 1 as varnames in other contexts anyway - so it would be more consistent not to treat as varnames here. - lappend var_class [list $v_key 3] - set vname [string range $v 1 end] - lappend varspecs_trimmed [list $vname $key] - } - default { - if {([string first ? $v]) >=0 || ([string first * $v] >=0)} { - lappend var_class [list $v_key 7] ;#glob - #leave vname as the full glob - lappend varspecs_trimmed [list "" $key] - } else { - #scan vname not v - will either be same as v - or possibly stripped of trailing +/- - set numtestv [join [scan $vname %lld%s] ""] ;# handles octals (leading zeros), ok for use with bignums, decimal points and sci notation - fails to handle leading dot e.g .5 - #leading . still need to test directly for double - if {[string is double -strict $vname] || [string is double -strict $numtestv]} { - if {[string is integer -strict $numtestv]} { - #this will pick up boolean 1 or 0 - but that's ok - they require "&" marker if boolean comparison desired - #integer test before double.. - #note there is also string is wide (string is wideinteger) for larger ints.. - lappend classes 4 - lappend var_class [list $v_key $classes] - lappend varspecs_trimmed $v_key - } else { - #double - #sci notation 1e123 etc - #also large numbers like 1000000000 - even without decimal point - (tcl bignum) - lappend classes 5 - lappend var_class [list $v_key $classes] - lappend varspecs_trimmed $v_key - } - } else { - lappend var_class [list $v_key 6] ;#var - lappend varspecs_trimmed $v_key - } - } - } - } - } - lappend var_names $vname - } - - set result [list var_names $var_names var_class $var_class varspecs_trimmed $varspecs_trimmed] - - proc $cmdname {} [list return $result] - debug.punk.pipe.compile {proc $cmdname} - return $result - } @@ -3263,24 +2980,24 @@ namespace eval punk { return [dict create ismatch 1 result $data setvars {} script {}] #return [dict create ismatch 1 result [list $data] setvars {} script {}] } - set returndict [dict create ismatch 0 result "" setvars {}] - set script "" + set returndict [dict create ismatch 0 result "" setvars {}] + set script "" - set defaults [list -unset 0 -levelup 2 -mismatchinfo 1 -script 0] - set opts [dict merge $defaults $args] - set unset [dict get $opts -unset] - set lvlup [dict get $opts -levelup] - set get_mismatchinfo [dict get $opts -mismatchinfo] + set defaults [list -unset 0 -levelup 2 -mismatchinfo 1 -script 0] + set opts [dict merge $defaults $args] + set unset [dict get $opts -unset] + set lvlup [dict get $opts -levelup] + set get_mismatchinfo [dict get $opts -mismatchinfo] #first classify into var_returntype of either "pipeline" or "segment" #segment returntype is indicated by leading % - set varinfo [_var_classify $multivar] - set var_names [dict get $varinfo var_names] - set var_class [dict get $varinfo var_class] - set varspecs_trimmed [dict get $varinfo varspecs_trimmed] + set varinfo [punk::pipe::lib::_var_classify $multivar] + set var_names [dict get $varinfo var_names] + set var_class [dict get $varinfo var_class] + set varspecs_trimmed [dict get $varinfo varspecs_trimmed] set var_actions [list] set expected_values [list] @@ -3665,7 +3382,7 @@ namespace eval punk { } } } else { - if {[punk::float_almost_equal $testlhs $testval]} { + if {[punk::pipe::float_almost_equal $testlhs $testval]} { lset match_state $i 1 } else { if {$isgreaterthan} { @@ -3744,7 +3461,7 @@ namespace eval punk { } } else { #float_almost_equal will disagree with expr based on scale.. just enough to allow for example [expr 0.2 + 0.1] to equal 0.3 - whereas expr will declare a mismatch - if {[punk::float_almost_equal $lhs $testval]} { + if {[punk::pipe::float_almost_equal $lhs $testval]} { lset match_state $i 1 lset expected_values $i [list var $varname spec $lhsspec info match-float-almost-equal lhs $lhs rhs $val] } else { @@ -3760,7 +3477,7 @@ namespace eval punk { # Also - the setting of the variable x is normalized to 1 or 0 only. (true & false would perhaps be nicer - but 1 & 0 are theoretically more efficient for later comparisons as they can have a pure int rep?.) # todo - consider the booleanString rep. Can/should we return true & false instead and maintain efficiency w.r.t shimmering? # - #punk::boolean_equal $a $b + #punk::pipe::boolean_equal $a $b set extra_match_info "" ;# possible crossbind indication set is_literal_boolean 0 if {$ispin} { @@ -3829,7 +3546,7 @@ namespace eval punk { #may have already matched above..(for variable) if {[lindex $match_state $i] != 1} { - if {![catch {punk::boolean_almost_equal $lhs $val} ismatch]} { + if {![catch {punk::pipe::boolean_almost_equal $lhs $val} ismatch]} { if {$ismatch} { lset match_state $i 1 lset expected_values $i [list var $varname spec $lhsspec info match-boolean-almost-equal$extra_match_info lhs $lhs rhs $val] @@ -4124,18 +3841,6 @@ namespace eval punk { tailcall interp alias {} $targetcmd {} apply [list args [concat "\[concat" [list $cmdcopy] "\$args]"] $nscaller] } - #map rhs to names suitable to use in pipemcd proc name (whitespace mapping) - # (for .= and = pipecmds) - proc pipecmd_namemapping {rhs} { - #used to build a command from a pattern which could contain :: - we need to map it to keep it a single command in the desired namespace. - #glob chars will prevent us using simple test {[info commands $cmd] eq ""} to test existence - #we could use the test {$cmd in [info commands]} - but mapping away globchars is more robust, allowing the simpler test - set rhs [string trim $rhs];#ignore all leading & trailing whitespace - set rhs [regsub -all {\s{1,}} $rhs {}] ;#collapse all internal whitespace to a single token - set rhs [tcl::string::map {: ? * } $rhs] - #review - we don't expect other command-incompatible chars such as colon? - return $rhs - } #same as used in unknown func for initial launch #variable re_assign {^([^\r\n=\{]*)=(.*)} @@ -4151,7 +3856,7 @@ namespace eval punk { #puts stderr ">> match_assign '$scopepattern=$equalsrhs' $args" set fulltail $args set cmdns ::punk::pipecmds - set namemapping [pipecmd_namemapping $equalsrhs] + set namemapping [punk::pipe::lib::pipecmd_namemapping $equalsrhs] #we deliberately don't call pipecmd_namemapping on the scopepattern even though it may contain globs. REVIEW #(we need for example x*= to be available as is via namespace path mechanism (from punk::pipecmds namespace)) @@ -4222,7 +3927,7 @@ namespace eval punk { # as we aren't in a pipleine - there is no data to insert - we proably still need to run _split_equalsrhs to verify the syntax. # review - consider way to turn it off as optimisation for non-pipelined assignment - but generally standard Tcl set could be used for that purpose. # We are probably only here if testing in the repl - in which case the error messages are important. - set var_index_position_list [_split_equalsrhs $equalsrhs] + set var_index_position_list [punk::pipe::lib::_split_equalsrhs $equalsrhs] #we may have an insertion-spec that inserts a literal atom e.g to wrap in "ok" # x='ok'>0/0 data # => {ok data} @@ -4448,84 +4153,6 @@ namespace eval punk { - #todo - consider whether we can use < for insertion/iteration combinations - # =a<,b< iterate once through - # =a><,b>< cartesian product - # =a<>,b<> ??? zip ? - # - # ie = {a b c} |> .=< inspect - # would call inspect 3 times, once for each argument - # .= list {a b c} {x y z} |a/0,b/1> .=a><,b>< list - # would produce list of cartesian pairs? - # - proc _split_equalsrhs {insertionpattern} { - #map the insertionpattern so we can use faster globless info command search - set name_mapped [pipecmd_namemapping $insertionpattern] - set cmdname ::punk::pipecmds::split_rhs::_$name_mapped - if {[info commands $cmdname] ne ""} { - return [$cmdname] - } - - set lst_var_indexposition [punk::_split_patterns_memoized $insertionpattern] - set i 0 - set return_triples [list] - foreach v_pos $lst_var_indexposition { - lassign $v_pos v index_and_position - #e.g varname@@data/ok>0 varname/1/0>end - #ensure only one ">" is detected - if {![string length $index_and_position]} { - set indexspec "" - set positionspec "" - } else { - set chars [split $index_and_position ""] - set posns [lsearch -all $chars ">"] - if {[llength $posns] > 1} { - error "pipesyntax error in segment insertion pattern '$insertionpattern' -v '$v' multiple '>' characters. Pattern not understood." "_split_equalsrhs $insertionpattern" [list pipesyntax insertionpattern_invalid] - } - if {![llength $posns]} { - set indexspec $index_and_position - set positionspec "" - } else { - set splitposn [lindex $posns 0] - set indexspec [string range $index_and_position 0 $splitposn-1] - set positionspec [string range $index_and_position $splitposn+1 end] - } - } - - #review - - if {($positionspec in [list "*" "/*" "@*" "/" "@"]) || ($v eq "*" && $positionspec eq "")} { - set star "" - if {$v eq "*"} { - set v "" - set star "*" - } - if {[string index $positionspec end] eq "*"} { - set star "*" - } - #it is always possible to insert at end of list regardless of current length - so /end* and @end* are equivalent - #as are /end and @end - #lset lst_var_indexposition $i [list $v "/end$star"] - set triple [list $v $indexspec "/end$star"] - } else { - if {$positionspec eq ""} { - #e.g just =varname - #lset lst_var_indexposition $i [list $v "/end"] - set triple [list $v $indexspec "/end"] - #error "pipesyntax error in segment insertionpattern '$insertionpattern' - v '$v' missing position spec e.g /0" - } else { - if {[string index $indexspec 0] ni [list "" "/" "@"]} { - error "pipesyntax error in segment insertionpattern '$insertionpattern' - v '$v' bad index spec '$indexspec'" "_split_equalsrhs $insertionpattern" [list pipesyntax insertionpattern_invalid] - } - set triple [list $v $indexspec $positionspec] - } - } - lappend return_triples $triple - incr i - } - proc $cmdname {} [list return $return_triples] - return $return_triples - } - proc _is_math_func_prefix {e1} { #also catch starting brackets.. e.g "(min(4,$x) " if {[regexp {^[^[:alnum:]]*([[:alnum:]]*).*} $e1 _ word]} { @@ -4632,76 +4259,6 @@ namespace eval punk { return $output } - # - # - # relatively slow on even small sized scripts - proc arg_is_script_shaped2 {arg} { - set re {^(\s|;|\n)$} - set chars [split $arg ""] - if {[lsearch -regex $chars $re] >=0} { - return 1 - } else { - return 0 - } - } - - #exclude quoted whitespace - proc arg_is_script_shaped {arg} { - if {[tcl::string::first \n $arg] >= 0} { - return 1 - } elseif {[tcl::string::first ";" $arg] >= 0} { - return 1 - } elseif {[tcl::string::first " " $arg] >= 0 || [tcl::string::first \t $arg] >= 0} { - lassign [_rhs_tail_split $arg] _ part2 ;#will have part2 if unquoted whitespace found - return [expr {$part2 ne ""}] - } else { - return 0 - } - } - proc _rhs_tail_split {fullrhs} { - set inq 0; set indq 0 - set equalsrhs "" - set i 0 - foreach ch [split $fullrhs ""] { - if {$inq} { - append equalsrhs $ch - if {$ch eq {'}} { - set inq 0 - } - } elseif {$indq} { - append equalsrhs $ch - if {$ch eq {"}} { - set indq 0 - } - } else { - switch -- $ch { - {'} { - set inq 1 - } - {"} { - set indq 1 - } - " " { - #whitespace outside of quoting - break - } - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - a - b - c - d - e - f - g - h - i - j - k - l - m - n - o - p - q - r - s - t - u - v - w - x - y - z {} - default { - #\t not a literal for switch jumpTable bytecompile - review - can we do it without for example string mapping to (and without a literal binary tab in source file)? - #we can't (reliably?) put \t as one of our switch keys - # - if {$ch eq "\t"} { - break - } - } - } - append equalsrhs $ch - } - incr i - } - set tail [tcl::string::range $fullrhs $i end] - return [list $equalsrhs $tail] - } # -- #consider possible tilde templating version ~= vs .= @@ -4724,10 +4281,12 @@ namespace eval punk { # test if we have an initial x.=y.= or x.= y.= #nextail is tail for possible recursion based on first argument in the segment - set nexttail [lassign $fulltail next1] ;#tail head + #set nexttail [lassign $fulltail next1] ;#tail head + set next1 [lindex $args 0] switch -- $next1 { pipematch { + set nexttail [lrange $args 1 end] set results [uplevel 1 [list pipematch {*}$nexttail]] debug.punk.pipe {>>> pipematch results: $results} 1 @@ -4767,7 +4326,8 @@ namespace eval punk { #var1 will contain ETC (from entire pipeline), var2 will contain etc (from associated segment) # - if {([set nexteposn [string first = $next1]] >= 0) && (![arg_is_script_shaped $next1]) } { + if {([set nexteposn [string last = $next1]] >= 0) && (![punk::pipe::lib::arg_is_script_shaped $next1]) } { + set nexttail [lrange $args 1 end] #*SUB* pipeline recursion. #puts "======> recurse based on next1:$next1 " if {[string index $next1 $nexteposn-1] eq {.}} { @@ -4824,14 +4384,14 @@ namespace eval punk { set firstargpipe_posn [lsearch $fulltail "<*|"] if {$firstargpipe_posn >=0} { - set tailremaining [lrange $fulltail 0 $firstargpipe_posn-1] - set argslist [lrange $fulltail $firstargpipe_posn+1 end] ;#Note that this could be a whole other pipeline with |> and/or <| elements. - set argpipe [lindex $fulltail $firstargpipe_posn] - set argpipespec [string range $argpipe 1 end-1] ;# strip off < & | from " and/or <| elements. + set argpipe [lindex $fulltail $firstargpipe_posn] + set argpipespec [string range $argpipe 1 end-1] ;# strip off < & | from ">> $segment_members insertion_patterns $insertion_patterns" @@ -5003,7 +4563,7 @@ namespace eval punk { set segment_members_filled [list] set segmenttail $segment_members ;# todo - change to segment_members here to match punk::match_assign - set rhsmapped [pipecmd_namemapping $rhs] + set rhsmapped [punk::pipe::lib::pipecmd_namemapping $rhs] set cmdname "::punk::pipecmds::insertion::_$rhsmapped" #glob chars have been mapped - so we can test by comparing info commands result to empty string if {[info commands $cmdname] eq ""} { @@ -5047,6 +4607,7 @@ namespace eval punk { #review - skip error if varname is 'data' ? #e.g we shouldn't really fail for: #.=>* list a b c <| + #??? Technically #we need to be careful not to insert empty-list as an argument by default error "pipevariable - varname $v not present in pipeline context. pipecontext_vars: [dict keys $dict_tagval] (2)" " pipecontext_vars: [dict keys $dict_tagval]" [list pipevariable variable_not_in_pipeline_scope] } @@ -5294,7 +4855,7 @@ namespace eval punk { set rhs "" set segment_first_is_script 0 if {[llength $next_all_members]} { - if {[arg_is_script_shaped [lindex $next_all_members 0]]} { + if {[punk::pipe::lib::arg_is_script_shaped [lindex $next_all_members 0]]} { set segment_first_word [lindex $next_all_members 0] set segment_first_is_script 1 set segment_op "" @@ -5305,7 +4866,7 @@ namespace eval punk { if {[regexp {^([^ \t\r\n=\{]*)\.=(.*)} $possible_assignment _ returnvarspec rhs]} { set segment_op ".=" set segment_first_word [lindex $next_all_members 1] - set script_like_first_word [arg_is_script_shaped $segment_first_word] + set script_like_first_word [punk::pipe::lib::arg_is_script_shaped $segment_first_word] if {$script_like_first_word} { set segment_first_is_script 1 ;#relative to segment_members which no longer includes the .= } @@ -5741,7 +5302,6 @@ namespace eval punk { #assuming we can't test on cond being present in existing unknown script - because it may be fairly simple and prone to false positives (?) ##This means we can't have 2 different conds with same body if we test for body in unknown. ##if {$body ni $existing} { - package require base64 set scr [base64::encode -maxlen 0 $cond] ;#will only be decoded if the debug is triggered #tcllib has some double-substitution going on.. base64 seems easiest and will not impact the speed of normal execution when debug off. proc ::unknown {args} [string map [list @c@ $cond @b@ $body @scr@ $scr] { @@ -5762,7 +5322,6 @@ namespace eval punk { } proc decodescript {b64} { if {[ catch { - package require base64 base64::decode $b64 } scr]} { return "" @@ -5805,21 +5364,20 @@ namespace eval punk { } # --------------------------- + #---------------- + #for var="val {a b c}" + #proc ::punk::val {{v {}}} {tailcall lindex $v} + #proc ::punk::val {{v {}}} {return $v} ;#2023 - approx 2x faster than the tailcall lindex version + proc ::punk::val [list [list v [purelist]]] {return $v} + #---------------- proc configure_unknown {} { #----------------------------- #these are critical e.g core behaviour or important for repl displaying output correctly - #---------------- - #for var="val {a b c}" - #proc ::punk::val {{v {}}} {tailcall lindex $v} - #proc ::punk::val {{v {}}} {return $v} ;#2023 - approx 2x faster than the tailcall lindex version - proc ::punk::val [list [list v [purelist]]] {return $v} - #---------------- #can't use know - because we don't want to return before original unknown body is called. proc ::unknown {args} [string cat { - package require base64 #set ::punk::last_run_display [list] #set ::repl::last_unknown [lindex $args 0] ;#jn #tsv::set repl last_unknown [lindex $args 0] ;#REVIEW @@ -5865,7 +5423,7 @@ namespace eval punk { #we assume the whole pipeline has been provided as the head #regexp {^([^\t\r\n=]*)\=([^ \t\r\n]*)(.*)} $hd _ pattern equalsrhs tail regexp {^([^\t\r\n=]*)\=([^\r\n]*)} $hd _ pattern fullrhs - lassign [_rhs_tail_split $fullrhs] equalsrhs tail + lassign [punk::pipe::lib::_rhs_tail_split $fullrhs] equalsrhs tail } #NOTE: - it doesn't make sense to call 'namespace' qualifiers or 'namespace tail' on a compound hd such as v,::etc= blah # we only look at leftmost namespace-like thing and need to take account of the pattern syntax @@ -5873,7 +5431,7 @@ namespace eval punk { # the ns is :: and the tail is etc,'::x'= # (Tcl's namespace qualifiers/tail won't help here) if {[string match ::* $hd]} { - set patterns [punk::_split_patterns_memoized $hd] + set patterns [punk::pipe::lib::_split_patterns_memoized $hd] #get a pair-list something like: {::x /0} {etc {}} set ns [namespace qualifiers [lindex $patterns 0 0]] set nslen [string length $ns] @@ -5887,7 +5445,7 @@ namespace eval punk { } else { set nscaller [uplevel 1 [list ::namespace current]] #jmn - set rhsmapped [pipecmd_namemapping $equalsrhs] + set rhsmapped [punk::pipe::lib::pipecmd_namemapping $equalsrhs] set commands [uplevel 1 [list ::info commands $pattern=$rhsmapped]] ;#uplevel - or else we are checking from perspective of this namespace ::punk #we must check for exact match of the command in the list - because command could have glob chars. if {"$pattern=$rhsmapped" in $commands} { @@ -5980,7 +5538,7 @@ namespace eval punk { #regexp {^([^ \t\r\n=\{]*)\.=([^ \t\r\n]*)(.*)} $hd _ pattern equalsrhs argstail regexp {^([^ \t\r\n=\{]*)\.=([^\r\n]*)} $hd _ pattern fullrhs - lassign [_rhs_tail_split $fullrhs] equalsrhs argstail + lassign [punk::pipe::lib::_rhs_tail_split $fullrhs] equalsrhs argstail } #tailcall ::punk::match_assign $pattern $equalsrhs {*}$argstail @@ -6051,7 +5609,7 @@ namespace eval punk { tailcall {*}[list ::punk::pipeline = "" "" {*}$arglist] } - set is_script [punk::arg_is_script_shaped $assign] + set is_script [punk::pipe::lib::arg_is_script_shaped $assign] if {!$is_script && [string index $assign end] eq "="} { #set re_dotequals {^([^ \t\r\n=\{]*)\.=$} @@ -6111,7 +5669,7 @@ namespace eval punk { set cmdlist [list ::punk::pipeline .= "" "" {*}$arglist] } elseif {$assign eq "="} { set cmdlist [list ::punk::pipeline = "" "" {*}$arglist] - } elseif {![punk::arg_is_script_shaped $assign] && [string index $assign end] eq "="} { + } elseif {![punk::pipe::lib::arg_is_script_shaped $assign] && [string index $assign end] eq "="} { #set re_dotequals {^([^ \t\r\n=\{]*)\.=$} # set dumbeditor {\}} #set re_equals {^([^ \t\r\n=\{]*)=$} @@ -6228,7 +5786,7 @@ namespace eval punk { } elseif {$assign eq "="} { #set cmdlist [list ::punk::pipeline = "" "" {*}$arglist] set cmdlist [list ::= {*}$arglist] - } elseif {![punk::arg_is_script_shaped $assign] && [string first "=" $assign] >= 0} { + } elseif {![punk::pipe::lib::arg_is_script_shaped $assign] && [string first "=" $assign] >= 0} { #set re_dotequals {^([^ \t\r\n=\{]*)\.=$} #set dumbeditor {\}} #set re_equals {^([^ \t\r\n=\{]*)=$} @@ -7214,14 +6772,25 @@ namespace eval punk { #An implementation of a notoriously controversial metric. proc LOC {args} { set argspecs [subst { + @dynamic + @id -id ::punk::LOC + @cmd -name punk::LOC -help\ + "LOC - lines of code. + An implementation of a notoriously controversial metric" -dir -default "\uFFFF" -exclude_dupfiles -default 1 -type boolean + ${[punk::args::resolved_def ::punk::path::treefilenames -antiglob_paths]} -exclude_punctlines -default 1 -type boolean + -show_largest -default 0 -type integer -help\ + "Report the top largest linecount files. + The value represents the number of files + to report on." + #we could map away whitespace and use string is punct - but not as flexible? review -punctchars -default { [list \{ \} \" \\ - _ + = . > , < ' : \; ` ~ ! @ # \$ % ^ & * \[ \] ( ) | / ?] } }] set argd [punk::args::get_dict $argspecs $args] - lassign [dict values $argd] leaders opts vals - set searchspecs [dict values $vals] + lassign [dict values $argd] leaders opts values received + set searchspecs [dict values $values] # -- --- --- --- --- --- set opt_dir [dict get $opts -dir] @@ -7229,19 +6798,36 @@ namespace eval punk { set opt_dir [pwd] ;#pwd can take over a ms on windows in a not terribly deep path even with SSDs - so as a general rule we don't use it in the original defaults list } # -- --- --- --- --- --- - set opt_exclude_dupfiles [dict get $opts -exclude_dupfiles] - set opt_exclude_punctlines [dict get $opts -exclude_punctlines] ;#exclude lines that consist purely of whitespace and the chars in -punctchars - set opt_punctchars [dict get $opts -punctchars] + set opt_exclude_dupfiles [dict get $opts -exclude_dupfiles] + set opt_exclude_punctlines [dict get $opts -exclude_punctlines] ;#exclude lines that consist purely of whitespace and the chars in -punctchars + set opt_punctchars [dict get $opts -punctchars] + set opt_largest [dict get $opts -show_largest] # -- --- --- --- --- --- set filepaths [punk::path::treefilenames -dir $opt_dir {*}$searchspecs] set loc 0 set dupfileloc 0 - set seentails [list] + set seentails [dict create] + set seencksums [dict create] ;#key is cksum value is list of paths + set largestloc [dict create] set dupfilecount 0 - set extensions [list] + set extensions [list] set purepunctlines 0 + set dupinfo [dict create] + set has_hashfunc [expr {![catch {package require sha1}]}] + set notes "" + if {$has_hashfunc} { + set dupfilemech sha1 + if {$opt_exclude_punctlines} { + append notes "checksums are on content stripped of whitespace lines,trailing whitespace, and pure punct lines. Does not indicate file contents equal.\n" + } else { + append notes "checksums are on content stripped of whitespace lines and trailing whitespace. Does not indicate file contents equal.\n" + } + } else { + set dupfilemech filetail + append notes "dupfilemech filetail because sha1 not loadable\n" + } foreach fpath $filepaths { set isdupfile 0 set floc 0 @@ -7250,38 +6836,106 @@ namespace eval punk { if {$ext ni $extensions} { lappend extensions $ext } + if {[catch {fcat $fpath} contents]} { + puts stderr "Error processing $fpath\n $contents" + continue + } + set lines [linelist -line {trimright} -block {trimall} $contents] if {!$opt_exclude_punctlines} { - set floc [llength [linelist -line {trimright} -block {trimall} [fcat $fpath]]] + set floc [llength $lines] + set comparedlines $lines } else { - set lines [linelist -line {trimright} -block {trimall} [fcat $fpath]] set mapawaypunctuation [list] foreach p $opt_punctchars empty {} { lappend mapawaypunctuation $p $empty } + set comparedlines [list] foreach ln $lines { if {[string length [string trim [string map $mapawaypunctuation $ln]]] > 0} { incr floc + lappend comparedlines $ln } else { incr fpurepunctlines } } } - if {[file tail $fpath] in $seentails} { - set isdupfile 1 - incr dupfilecount - incr dupfileloc $floc + if {$opt_largest > 0} { + dict set largestloc $fpath $floc + } + if {$has_hashfunc} { + set cksum [sha1::sha1 [encoding convertto utf-8 [join $comparedlines \n]]] + if {[dict exists $seencksums $cksum]} { + set isdupfile 1 + incr dupfilecount + incr dupfileloc $floc + dict lappend seencksums $cksum $fpath + } else { + dict set seencksums $cksum [list $fpath] + } + } else { + if {[dict exists $seentails [file tail $fpath]]} { + set isdupfile 1 + incr dupfilecount + incr dupfileloc $floc + } } if {!$isdupfile || ($isdupfile && !$opt_exclude_dupfiles)} { incr loc $floc incr purepunctlines $fpurepunctlines } - lappend seentails [file tail $fpath] + dict lappend seentails [file tail $fpath] $fpath + #lappend seentails [file tail $fpath] } + if {$has_hashfunc} { + dict for {cksum paths} $seencksums { + if {[llength $paths] > 1} { + dict set dupinfo checksums $cksum $paths + } + } + } + dict for {tail paths} $seentails { + if {[llength $paths] > 1} { + dict set dupinfo sametail $tail $paths + } + } + if {$opt_exclude_punctlines} { - return [list loc $loc filecount [llength $filepaths] dupfiles $dupfilecount dupfileloc $dupfileloc extensions $extensions purepunctuationlines $purepunctlines] + set result [dict create\ + loc $loc\ + filecount [llength $filepaths]\ + dupfiles $dupfilecount\ + dupfilemech $dupfilemech\ + dupfileloc $dupfileloc\ + dupinfo $dupinfo\ + extensions $extensions\ + purepunctuationlines $purepunctlines\ + notes $notes\ + ] + } else { + set result [dict create\ + loc $loc\ + filecount [llength $filepaths]\ + dupfiles $dupfilecount\ + dupfilemech $dupfilemech\ + dupfileloc $dupfileloc\ + dupinfo $dupinfo\ + extensions $extensions\ + notes $notes\ + ] + } + if {$opt_largest > 0} { + set largest_n [dict create] + set sorted [lsort -stride 2 -index 1 -decreasing -integer $largestloc] + set kidx 0 + for {set i 0} {$i < $opt_largest} {incr i} { + if {$kidx+1 > [llength $sorted]} {break} + dict set largest_n [lindex $sorted $kidx] [lindex $sorted $kidx+1] + incr kidx 2 + } + dict set result largest $largest_n } - return [list loc $loc filecount [llength $filepaths] dupfiles $dupfilecount dupfileloc $dupfileloc extensions $extensions] + return $result } @@ -7397,79 +7051,79 @@ namespace eval punk { @id -id ::punk::inspect @cmd -name punk::inspect -help\ "Function to display values - used pimarily in a punk pipeline. - The raw value arguments (not options) are always returned to pass - forward in the pipeline. - (pipeline data inserted at end of each |...> segment is passed as single item unless - inserted with an expanding insertion specifier such as .=>* ) - e.g1: - .= list a b c |v1,/1-end,/0>\\ - .=>* inspect -label i1 -- |>\\ - .=v1> inspect -label i2 -- |>\\ - string toupper - (3) i1: {a b c} {b c} a - (1) i2: a b c - - - A B C - " + The raw value arguments (not options) are always returned to pass + forward in the pipeline. + (pipeline data inserted at end of each |...> segment is passed as single item unless + inserted with an expanding insertion specifier such as .=>* ) + e.g1: + .= list a b c |v1,/1-end,/0>\\ + .=>* inspect -label i1 -- |>\\ + .=v1> inspect -label i2 -- |>\\ + string toupper + (3) i1: {a b c} {b c} a + (1) i2: a b c + + - A B C + " -label -type string -default "" -help\ "An optional label to help distinguish output when multiple - inspect statements are in a pipeline. This appears after the - bracketed count indicating number of values supplied. - e.g (2) MYLABEL: val1 val2 - The label can include ANSI codes. - e.g - inspect -label [a+ red]mylabel -- val1 val2 val3 - " + inspect statements are in a pipeline. This appears after the + bracketed count indicating number of values supplied. + e.g (2) MYLABEL: val1 val2 + The label can include ANSI codes. + e.g + inspect -label [a+ red]mylabel -- val1 val2 val3 + " -limit -type int -default 20 -help\ "When multiple values are passed to inspect - limit the number - of elements displayed in -channel output. - When truncation has occured an elipsis indication (...) will be appended. - e.g - .= lseq 20 to 50 by 3 |> .=>* inspect -limit 4 -- |> .=>* tcl::mathop::+ - (11) 20 23 26 29... + of elements displayed in -channel output. + When truncation has occured an elipsis indication (...) will be appended. + e.g + .= lseq 20 to 50 by 3 |> .=>* inspect -limit 4 -- |> .=>* tcl::mathop::+ + (11) 20 23 26 29... - - 385 + - 385 - For no limit - use -limit -1 - " + For no limit - use -limit -1 + " -channel -type string -default stderr -help\ "An existing open channel to write to. If value is any of nul, null, /dev/nul - the channel output is disabled. This effectively disables inspect as the args - are simply passed through in the return to continue the pipeline. - " + the channel output is disabled. This effectively disables inspect as the args + are simply passed through in the return to continue the pipeline. + " -showcount -type boolean -default 1 -help\ "Display a leading indicator in brackets showing the number of arg values present." -ansi -type integer -default 1 -nocase 1 -choices {0 1 2 VIEW 3 VIEWCODES 4 VIEWSTYLES} -choicelabels { 0 "Strip ANSI codes from display - of values. The disply output will - still be colourised if -ansibase has - not been set to empty string or - [a+ normal]. The stderr or stdout - channels may also have an ansi colour. - (see 'colour off' or punk::config)" + of values. The disply output will + still be colourised if -ansibase has + not been set to empty string or + [a+ normal]. The stderr or stdout + channels may also have an ansi colour. + (see 'colour off' or punk::config)" 1 "Leave value as is" 2 "Display the ANSI codes and - other control characters inline - with replacement indicators. - e.g esc, newline, space, tab" + other control characters inline + with replacement indicators. + e.g esc, newline, space, tab" VIEW "Alias for 2" 3 "Display as per 2 but with - colourised ANSI replacement codes." + colourised ANSI replacement codes." VIEWCODES "Alias for 3" 4 "Display ANSI and control - chars in default colour, but - apply the contained ansi to - the text portions so they display - as they would for -ansi 1" - VIEWSTYLE "Alias for 4" - } + chars in default colour, but + apply the contained ansi to + the text portions so they display + as they would for -ansi 1" + VIEWSTYLE "Alias for 4" + } -ansibase -type ansistring -default {${[a+ brightgreen]}} -help\ "Base ansi code(s) that will apply to output written to the chosen -channel. - If there are ansi resets in the displayed values - output will revert to this base. - Does not affect return value." + If there are ansi resets in the displayed values - output will revert to this base. + Does not affect return value." -- -type none -help\ "End of options marker. - It is advisable to use this, as data in a pipeline may often begin with -" + It is advisable to use this, as data in a pipeline may often begin with -" @values -min 0 -max -1 arg -type string -optional 1 -multiple 1 -help\ @@ -7946,8 +7600,7 @@ namespace eval punk { interp alias {} know {} punk::know interp alias {} know? {} punk::know? - #interp alias {} arg {} punk::val - interp alias {} val {} punk::val + #interp alias {} val {} punk::val interp alias {} exitcode {} punk::exitcode interp alias {} hide {} punkapp::hide_console ;#will only work if controllable toplevels exist diff --git a/src/vfs/_vfscommon.vfs/modules/punk/aliascore-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/aliascore-0.1.0.tm index 296bb6df..3d1d87e9 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/aliascore-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/aliascore-0.1.0.tm @@ -105,6 +105,7 @@ tcl::namespace::eval punk::aliascore { #functions must be in export list of their source namespace set aliases [tcl::dict::create\ + val ::punk::pipe::val\ aliases ::punk::lib::aliases\ alias ::punk::lib::alias\ tstr ::punk::lib::tstr\ @@ -123,12 +124,12 @@ tcl::namespace::eval punk::aliascore { colour ::punk::console::colour\ ansi ::punk::console::ansi\ color ::punk::console::colour\ + a? ::punk::console::code_a?\ + A? {::punk::console::code_a? forcecolor}\ a+ ::punk::console::code_a+\ A+ {::punk::console::code_a+ forcecolour}\ a ::punk::console::code_a\ A {::punk::console::code_a forcecolour}\ - a? ::punk::console::code_a?\ - A? {::punk::console::code_a? forcecolor}\ smcup ::punk::console::enable_alt_screen\ rmcup ::punk::console::disable_alt_screen\ ] diff --git a/src/vfs/_vfscommon.vfs/modules/punk/ansi-0.1.1.tm b/src/vfs/_vfscommon.vfs/modules/punk/ansi-0.1.1.tm index 422c524e..b367be2a 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/ansi-0.1.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/ansi-0.1.1.tm @@ -137,7 +137,7 @@ tcl::namespace::eval punk::ansi::class { @id -id "::punk::ansi::class::class_ansi render_to_input_line" @cmd -name "punk::ansi::class::class_ansi render_to_input_line" -help\ "render string from line 0 to line - (experimental/debug)" + (experimental/debug)" -dimensions -type string -help\ "WxH where W is integer width >= 1 and H is integer heigth >= 1" -minus -type integer -help\ @@ -584,25 +584,38 @@ tcl::namespace::eval punk::ansi { set base $CWD } } + if {[info commands file] eq ""} { + #probably a safe interp + return "UNAVAILABLE" + } return [file join $base src/testansi] } - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + @dynamic @id -id ::punk::ansi::example @cmd -name punk::ansi::example -help "Display .ans image files in a grid that will fit in console " - -colwidth -default 82 -help "Width of each column - default of 82 will fit a standard 80wide ansi image (when framed) - You can specify a narrower width to truncate images on the right side" - -folder -default "${[punk::ansi::Get_ansifolder]}" -help "Base folder for files if relative paths are used. - Defaults to /src/testansi - where projectbase is determined from current directory. + -colwidth -default 82 -help\ + "Width of each column - default of 82 will fit a standard 80wide ansi image + (when framed) + You can specify a narrower width to truncate images on the right side" + -folder -default "${[punk::ansi::Get_ansifolder]}" -help\ + "Base folder for files if relative paths are used. + Defaults to /src/testansi - where projectbase is determined + from the current directory. " @values -min 0 -max -1 - files -default {belinda.ans bot.ans flower.ans fish.ans} -multiple true -help "List of filenames - leave empty to display 4 defaults" + files -default {belinda.ans bot.ans flower.ans fish.ans} -multiple true -help\ + "List of filenames - leave empty to display 4 defaults" } ""] proc example {args} { set argd [punk::args::get_by_id ::punk::ansi::example $args] set colwidth [dict get $argd opts -colwidth] + if {[info commands file] eq ""} { + error "file command unavailable - punk::ansi::example cannot be shown" + } set ansifolder [file normalize [dict get $argd opts -folder]] set fnames [dict get $argd values files] @@ -617,6 +630,16 @@ tcl::namespace::eval punk::ansi { puts stderr "Ensure ansi test files exist: $fnames" #error "punk::ansi::example Cannot find example files" } + set termsize [punk::console:::get_size] + set termcols [dict get $termsize columns] + set margin 4 ;#review + set freewidth [expr {$termcols-$margin}] + if {$freewidth < $colwidth} { + puts stderr "[a+ red bold]punk::ansi::example freewidth: $freewidth < colwidth: $colwidth TRUNCATING IMAGES[a]" + set colwidth $freewidth + } + set per_row [expr {$freewidth / $colwidth}] + set missingbase [a+ yellow][textblock::block [expr {$colwidth-2}] 23 ?][a] ;#assuming standard frame - subtract 2 for left/right borders set pics [list] foreach f $fnames { @@ -636,10 +659,6 @@ tcl::namespace::eval punk::ansi { } } - set termsize [punk::console:::get_size] - set margin 4 - set freewidth [expr {[tcl::dict::get $termsize columns]-$margin}] - set per_row [expr {$freewidth / $colwidth}] set rowlist [list] ;# { { } { } } set heightlist [list] ;# { { } { } } @@ -737,22 +756,23 @@ tcl::namespace::eval punk::ansi { #review - can terminals handle SGR codes within a PM? #Wezterm will hide PM,SOS,APC - but not any part following an SGR code - i.e it seems to terminate hiding before the ST (apparently at the ) proc controlstring_PM {text} { - return "\x1b^${text}\033\\" + #dquotes with trailing \\ in string will confuse silly editors + return \x1b^${text}\033\\ } proc controlstring_PM8 {text} { - return "\x9e${text}\x9c" + return \x9e${text}\x9c } proc controlstring_SOS {text} { - return "\x1bX${text}\033\\" + return \x1bX${text}\033\\ } proc controlstring_SOS8 {text} { - return "\x98${text}\x9c" + return \x98${text}\x9c } proc controlstring_APC {text} { - return "\x1b_${text}\033\\" + return \x1b_${text}\033\\ } proc controlstring_APC8 {text} { - return "\x9f${text}\x9c" + return \x9f${text}\x9c } #there is also the SGR hide code (8) which has intermittent terminal support #This doesn't change the output length - so support is tricky to detec. (terminal checksum report?) @@ -843,10 +863,79 @@ tcl::namespace::eval punk::ansi { return $out } + + #Wrap text in ansi codes to switch to DEC alternate graphics character set. + #todo vt52 versions proc g0 {text} { return \x1b(0$text\x1b(B } + variable altg_map [dict create\ + hl q\ + vl x\ + tlc l\ + trc k\ + blc m\ + ltj t\ + rtj u\ + ttj w\ + btj v\ + rtj u\ + fwj n\ + ] + proc altg_map {names} { + variable altg_map + set result [list] + foreach nm $names { + if {[dict exists $altg_map $nm]} { + lappend result [dict get $altg_map $nm] + } else { + lappend "" + } + } + return $result + } + + # -------------------------------- + # Taken from term::ansi::code::ctrl + # -------------------------------- + #Note that SYN (\016) seems to put terminals in a state + #where alternate graphics are not processed. + #an ETB (\017) needs to be sent to get alt graphics working again. + #It isn't known what software utilises SYN/ETB within altg sequences + # (presumably to alternate between the charsets within a graphics-on/graphics-off section) + #but as modern emulators seem to react to it, we should handle it. + #REVIEW - this mapping not fully understood + #used by groptim + variable grforw + variable grback + variable _ + + foreach _ { + ! \" # $ % & ' ( ) * + , - . / + 0 1 2 3 4 5 6 7 8 9 : ; < = > + ? @ A B C D E F G H I J K L M + N O P Q R S T U V W X Y Z [ ^ + \\ ] + } { + lappend grforw \016$_ $_\016 + lappend grback $_\017 \017$_ + } + unset _ + # ------------------------------ + #REVIEW - see forward/backward map in term::ansi::code::macros::cd::groptim - what are they for?? + proc groptim {string} { + variable grforw + variable grback + set offon \x1b(B\x1b(0 ;#)) ;#editor highlighting comment + set onoff \x1b(0\x1b(B ;#)) ;#editor highlighting comment + while {![string equal $string [set new [string map [list $offon {} $onoff {}] [string map $grback [string map $grforw $string]]]]]} { + set string $new + } + return $string + } + # -------------------------------- + proc ansistrip_gx {text} { #e.g "\033(0" - select VT100 graphics for character set G0 #e.g "\033(B" - reset @@ -854,10 +943,10 @@ tcl::namespace::eval punk::ansi { #e.g "\033)X" - where X is any char other than 0 to reset ?? #return [convert_g0 $text] - return [tcl::string::map [list "\x1b(0" "" \x1b(B" "" "\x1b)0" "" "\x1b)X" ""] $text] + return [tcl::string::map [list \x1b(0 "" \x1b(B "" \x1b)0 "" \x1b)X ""] $text] } proc stripansi_gx {text} { - return [tcl::string::map [list "\x1b(0" "" \x1b(B" "" "\x1b)0" "" "\x1b)X" ""] $text] + return [tcl::string::map [list \x1b(0 "" \x1b(B "" \x1b)0 "" \x1b)X ""] $text] } @@ -1459,7 +1548,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu tcl::dict::set opts $k $v } default { - error "colourmap1 unrecognised option $k. Known-options: [tcl::dict::keys $opts] + error "colourmap1 unrecognised option $k. Known-options: [tcl::dict::keys $opts]" } } } @@ -2358,11 +2447,11 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu lappend PUNKARGS [list { @id -id ::punk::ansi::sgr_cache @cmd -name punk::ansi::sgr_cache -help\ - "Convenience function to view and optionally clear the ansi character attribute cache (ansi SGR codes) - " + "Convenience function to view and optionally clear the ansi character attribute cache + (ansi SGR codes)" -action -default "" -choices "clear" -help\ "-action clear will unset the keys in the punk::ansi::sgr_cache dict - This is called automatically when setting 'colour false' in the console" + This is called automatically when setting 'colour false' in the console" -pretty -default 1 -type boolean -help\ "use 'pdict punk::ansi::sgr_cache */%str,%ansiview' output" @@ -2882,7 +2971,8 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set SGR_samples [dict create] foreach k [dict keys $SGR_map] { - dict set SGR_samples $k "[punk::ansi::a+ $k]sample\x1b\[m" + #indent of 1 space is important for clarity in i -return string a+ output + dict set SGR_samples $k " [punk::ansi::a+ $k]sample\x1b\[m" } lappend PUNKARGS [list { @id -id ::punk::ansi::a+ @@ -2895,23 +2985,23 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu code -type string -optional 1 -multiple 1 -choices {}\ -choicelabels {}\ -choicecolumns 5 -choiceprefix 0 -choicerestricted 0 -help\ - "SGR code from the list below, or an integer corresponding to the code e.g 31 = red. - A leading capital letter indicates a codename applies to the background colour. - Other accepted codes are: - term- Term- foreground/background where int is 0-255 terminal color - term- Term- foreground/background - rgb--- Rgb--- foreground/background where are the - 0-255 int values for red, green and blue. - rgb# Rgb# where is a 6 char hex colour e.g rgb#C71585 - web- Web- + "SGR code from the list below, or an integer corresponding to the code e.g 31 = red. + A leading capital letter indicates a codename applies to the background colour. + Other accepted codes are: + term- Term- foreground/background where int is 0-255 terminal color + term- Term- foreground/background + rgb--- Rgb--- foreground/background where are the + 0-255 int values for red, green and blue. + rgb# Rgb# where is a 6 char hex colour e.g rgb#C71585 + web- Web- - The acceptable values for and can be queried using - punk::ansi::a? term - and - punk::ansi::a? web + The acceptable values for and can be queried using + punk::ansi::a? term + and + punk::ansi::a? web - Example to set foreground red and background cyan followed by a reset: - set str \"[a+ red Cyan]sample text[a]\" + Example to set foreground red and background cyan followed by a reset: + set str \"[a+ red Cyan]sample text[a]\" " }]] @@ -3264,7 +3354,55 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu return $result } - proc ansiwrap {codes text} { + lappend PUNKARGS [list { + @id -id ::punk::ansi::ansiwrap + @cmd -name punk::ansi::ansiwrap -help\ + "Wrap a string with ANSI codes from + supplied codelist(s) followed by trailing + ANSI reset. + + Codes are numbers or strings as indicated + in the output of the colour information + function: punk::ansi::a? + + No leading reset is applied - so when + placing resultant text, any existing + SGR codes that aren't overridden may + still take effect. + + For finer control use the a+ and a + functions eg + set x \"[a+ red]text [a+ bold]etc[a]\" + " + @leaders -min 0 -max -1 + codelist -multiple 1 -default {} -type list -help\ + "ANSI names/ints as understood by 'a?' + (Not actual ANSI as output by a+) + These can be supplied individually or + as a list or lists" + @values -min 1 -max 1 + text -type string -help\ + "String to wrap with ANSI (SGR)" + }] + #proc ansiwrap {codes text} { + # return [a {*}$codes]$text[a] + #} + proc ansiwrap2 {args} { + set argd [punk::args::parse $args withid ::punk::ansi::ansiwrap] + set codelists [dict get $argd leaders codelist] + set text [dict get $argd values text] + set codes [concat {*}$codelists] ;#flatten + return [a {*}$codes]$text[a] + } + proc ansiwrap {args} { + if {[llength $args] < 1} { + #minimal args parsing - unhappy path only + punk::args::parse $args withid ::punk::ansi::ansiwrap + return + } + set text [lindex $args end] + set codelists [lrange $args 0 end-1] + set codes [concat {*}$codelists] ;#flatten return [a {*}$codes]$text[a] } @@ -3300,6 +3438,14 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[call [fun reset_soft]] return \x1b\[!p } + proc SYN {} { + #syn seems to disable alternate graphics mode temporarily on modern terminals + return \016 + } + proc ETB {} { + #This is a form of soft reset for the state where a SYN was sent - re-enabling altg processing + return \017 + } proc reset_colour {} { #*** !doctools #[call [fun reset_colour]] @@ -3341,6 +3487,12 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[call [fun cursor_off]] return "\033\[?25l" } + proc cursor_on_vt52 {} { + return \x1be + } + proc cursor_off_vt52 {} { + return \x1bf + } # REVIEW - osc8 replays etc for split lines? - textblock #Hyperlinks (a.k.a. HTML-like anchors) in terminal emulators https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda @@ -3387,6 +3539,24 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } # -- --- --- --- --- + lappend PUNKARGS [list { + @id -id ::punk::ansi::move + @cmd -name punk::ansi::move -help\ + {Return an ANSI sequence to move cursor to row,col + (aka: cursor home) + + Sequence is of the form: + \x1b[;H + (CSI row ; col H) + This sequence will not be understood by old vt52 + terminals. see also vt52_move. + } + @values -min 2 -max 2 + row -type integer -help\ + "row number - starting at 1" + col -type integer -help\ + "column number - starting at 1" + }] proc move {row col} { #*** !doctools #[call [fun move] [arg row] [arg col]] @@ -3394,6 +3564,44 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[para]aka cursor home return \033\[${row}\;${col}H } + #NOTE vt52 uses ESC Y line column + # where line and column are ascii codes whose values are +31 + # vt52 can be entered/exited via escapes + # This means we probably need to to wrap enter/exit vt52 and keep this state - as we don't have a standard way to query for terminal type + # (vt52 supports ESC Z - but vt100 sometimes? doesn't - and querying at each output would be slow anyway, even if there was a common query :/ ) + + lappend PUNKARGS [list { + @id -id ::punk::ansi::vt52move + @cmd -name punk::ansi::vt52move -help\ + {Return a VT52 sequence to move cursor to row,col + (aka: cursor home) + + Sequence is of the form: + ESCY + This sequence will generally not be understood by terminals + that are not in vt52 mode (e.g DECANM unset). + } + @values -min 2 -max 2 + row -type integer -help\ + "row number - starting at 1" + col -type integer -help\ + "column number - starting at 1" + }] + proc vt52move {row col} { + #test + set r [format %c [expr {$row + 31}]] + set c [format %c [expr {$col + 31}]] + return \x1bY${r}${c} + } + proc vt52color {int} { + if {[string is integer -strict $int]} { + if {$int < 0 || $int > 15} { + error "vt52color unsupported - only 0 to 15 available" + } + } + set char [format %c [expr {$int + 31}]] + return \x1bb${char} + } proc move_emit {row col data args} { #*** !doctools #[call [fun move_emit] [arg row] [arg col] [arg data] [opt {row col data...}]] @@ -3424,6 +3632,27 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } return $out } + proc vt52move_emit {row col data args} { + #Todo - G code? + set out "" + if {$row eq "this"} { + #append out \033\[\;${col}G$data + append out [vt52move_column $col]$data + } else { + #append out \033\[${row}\;${col}H$data + append out [vt52move $row $col]$data + } + foreach {row col data} $args { + if {$row eq "this"} { + append out [vt52move_column $col]$data + #append out \033\[\;${col}G$data + } else { + #append out \033\[${row}\;${col}H$data + append out [vt52move $row $col]$data + } + } + return $out + } proc move_emitblock {row col textblock} { #*** !doctools #[call [fun move_emitblock] [arg row] [arg col] [arg textblock]] @@ -3434,31 +3663,63 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } return $commands } + proc vt52move_emitblock {row col textblock} { + #*** !doctools + #[call [fun move_emitblock] [arg row] [arg col] [arg textblock]] + set commands "" + foreach ln [split $textblock \n] { + append commands [punk::ansi::vt52move_emit $row $col $ln] + incr row + } + return $commands + } proc move_forward {{n 1}} { #*** !doctools #[call [fun move_forward] [arg n]] return \033\[${n}C } + proc vt52move_forward {{n 1}} { + return [string repeat \x1bC $n] + } proc move_back {{n 1}} { #*** !doctools #[call [fun move_back] [arg n]] return \033\[${n}D } + proc vt52move_back {{n 1}} { + return [string repeat \x1bD $n] + } proc move_up {{n 1}} { #*** !doctools #[call [fun move_up] [arg n]] return \033\[${n}A } + proc vt52move_up {{n 1}} { + return [string repeat \x1bA $n] + } proc move_down {{n 1}} { #*** !doctools #[call [fun move_down] [arg n]] return \033\[${n}B } + proc vt52move_down {{n 1}} { + return [string repeat \x1bB $n] + } proc move_column {col} { #*** !doctools #[call [fun move_column] [arg col]] return \x1b\[${col}G } + proc vt52move_column {col} { + #This is a bit of a fudge - as there is no command to move to a specific column. + #without tracking state - we settle for moving back enough times to ensure we're at column 1 - and then move forward. + #inefficient - but will have to do I guess. + #review - max term width vt52? env var LINES and env var COLUMNS ? + # also ESC R CR - set window size + set back [string repeat \x1bD 132] + set fwd [string repeat \x1bC [expr {$col - 1}]] + return $back$fwd + } proc move_row {row} { #*** !doctools #[call [fun move_row] [arg row]] @@ -3496,6 +3757,13 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[para] DECRC return \x1b8 } + proc cursor_save_vt52 {} { + return \x1bj + } + proc cursor_restore_vt52 {} { + return \x1bk + } + # -- --- --- --- --- #CRM Show Control Character Mode proc enable_crm {} { @@ -3550,18 +3818,131 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu # \x1b\[?7\;1\$y # \x1b\[?7\;2\$y #where 1 = set, 2 = unset. (0 = mode not recognised, 3 = permanently set, 4 = permanently unset) + + #https://wiki.tau.garden/dec-modes/ + #(DEC,xterm,contour,mintty,kitty etc) + #https://invisible-island.net/xterm/ctlseqs/ctlseqs.html#h2-Mouse-Tracking + + #names for other alt_screen mechanismk: 1047,1048 vs 1049? + #variable decmode_names [dict create\ + # DECANM 2\ + # origin 6\ + # DECCOLM 3\ + # line_wrap 7\ + # LNM 20\ + # alt_screen 1049\ + # grapheme_clusters 2027\ + # bracketed_paste 2004\ + # mouse_sgr 1006\ + # mouse_urxvt 1015\ + # mouse_sgr_pixel 1016\ + #] + variable decmode_data { + 1 { + {origin DEC description "DECCKM - Cursor Keys Mode" names {DECCKM cursor_keys}} + } + 2 { + {origin DEC description "DECANM - ANSI/VT52 Mode" names {DECANM} note { +Disable to turn on VT52 emulation. +In VT52 mode - use \x1b< to exit. + } + } + } + 3 { + {origin DEC description "DECCOLM - Column" names {DECCOLM}} + } + 4 { + {origin DEC description "DECSCLM - Scrolling" names {DECSCLM}} + } + 5 { + {origin DEC description "DECSCNM - Screen Mode (light or dark screen)" names {DECSNM lightmode}} + } + 7 { + {origin DEC description "DECAWM - Auto Wrap Mode" names {DECAWM line_wrap}} + } + 9 { + {origin "xterm" description "X10 compatibility mouse" names {SET_X10_MOUSE mouse_tracking} note { +Escape sequence on button press only. +CSI M CbCxCy (6 chars) +Coords limited to 223 (=255 - 32) + } + } + {origin DEC description "DECINLM - Interlace Mode (obsolete?)" names {DECINLM}} + } + 20 { + {origin DEC description "LNM - Line Feed/New Line Mode" names {LNM} note { +For terminals that support LNM, the default is off +meaning a lone CR respresents the character emitted +when enter is pushed. Turning LNM on would mean that +CR LF is sent when hitting enter. This feature is +not commonly supported, and the default will normally +be as if this was off - ie lone CR. + } + } + } + 25 { + {origin DEC description "DECTCEM - Text Cursor Enable Mode" names {DECTCEM cursor_enable}} + } + 47 { + {origin xterm description "xterm alternate buffer" names {xterm_altbuf}} + {origin DEC description "DECGRPM - Graphics Rotated Print Mode (obsolete?)" names {DECGRPM}} + } + 66 { + {origin DEC description "DECNKM - Numeric Keypad Mode" names {DECNKM}} + } + 1000 { + {origin "xterm" description "VT200 compatibility mouse" names {SET_VT200_MOUSE} note { +Escape sequence on both button press and release. +CSI M CbCxCy + } + } + } + 1004 { + {origin "xterm" description "Send FocusIn/FocusOut events" names {mouse_focus_event}} + } + 1005 { + {origin "xterm" description "Enable UTF-8 Mouse Mode" names {mouse_utf8 mouse_utf8_extended}} + } + 1006 { + {origin "xterm" description "Enable SGR Mouse Mode" names {mouse_sgr mouse_sgr_extended} note{ +SET_SGR_EXT_MODE_MOUSE - extended compared to x10 mouse protocol which limits x y coords +to 223 (=255 - 32) + } + } + } + 1015 { + {origin "urxvt" description "Enable urxvt Mouse Mode" names {mouse_urxvt}} + } + 1016 { + {origin "xterm" description "Enable SGR Pixel Mouse Mode" names {mouse_sgr_pixel}} + } + 1047 { + {origin "xterm" description "Alternate Buffer" names {alt_buffer_only}} + } + 1049 { + {origin "xterm" description "Alternate Buffer with save cursor" names {alt_buffer alt_screen}} + } + 2004 { + {origin "xterm" description "Set bracketed paste mode" names {bracketed_paste}} + } + 2027 { + {origin Contour description "Grapheme Cluster Processing" names {grapheme_clusters}} + } + } + set decmode_names [dict create] + dict for {code items} $decmode_data { + foreach itm $items { + set names [dict get $itm names] + foreach nm $names { + dict set decmode_names $nm $code + } + } + } + + + + - #names for other alt_screen mechanisms: 1047,1048 vs 1049? - variable decmode_names [dict create\ - line_wrap 7\ - LNM 20\ - alt_screen 1049\ - grapheme_clusters 2027\ - bracketed_paste 2004\ - mouse_sgr_extended 1006\ - mouse_urxvt 1015\ - mouse_sgr 1016\ - ] proc query_mode {num_or_name} { if {[string is integer -strict $num_or_name]} { set m $num_or_name @@ -3674,11 +4055,17 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[para]Erase to start of line, leaving cursor position alone. return \033\[1K } + proc vt52erase_sol {} { + return \x1bo + } proc erase_eol {} { #*** !doctools #[call [fun erase_eol]] return \033\[K } + proc vt52erase_eol {} { + return \x1bK + } #see also clear_above clear_below # -- --- --- --- --- @@ -3732,6 +4119,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu proc cursor_pos_extended {} { #includes page e.g ^[[47;3;1R + #(but not on all terminals - some (freebsd?) will report as per 6n e.g ^[[74;3R) return \033\[?6n } @@ -3789,6 +4177,9 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[para]This may not work on terminals which have multiple panes/windows return "\033\]2;$windowtitle\033\\" ;#works for xterm and most derivatives } + proc vt52titleset {windowtitle} { + return \x1bS$windowtitle\r + } #titleget - https://invisible-island.net/xterm/xterm.faq.html#how2_title #no cross-platform ansi-only mechanism ? @@ -4672,8 +5063,14 @@ tcl::namespace::eval punk::ansi::ta { variable re_osc_open {(?:\x1b\]|\u009d).*} - variable standalone_code_map [list \x1bc "" \x1b7 "" \x1b8 "" \x1bM "" \x1bE "" \x1bD "" \x1bH "" \x1b= "" \x1b> "" \x1b#3 "" \x1b#4 "" \x1b#5 "" \x1b#6 "" \x1b#8 ""] - variable re_standalones {(?:\x1bc|\x1b7|\x1b8|\x1bM|\x1bE|\x1bD|\x1bD|\x1bH|\x1b=|\x1b>|\x1b#3|\x1b#4|\x1b#5|\x1b#6|\x1b#8)} + #variable standalone_code_map [list \x1bc "" \x1b7 "" \x1b8 "" \x1bM "" \x1bE "" \x1bD "" \x1bH "" \x1b= "" \x1b> "" \x1b#3 "" \x1b#4 "" \x1b#5 "" \x1b#6 "" \x1b#8 ""] + variable re_standalones {(?:\x1bc|\x1b7|\x1b8|\x1bM|\x1bD|\x1bE|\x1bH|\x1b=|\x1b>|\x1b#3|\x1b#4|\x1b#5|\x1b#6|\x1b#8)} + variable re_standalones_vt52 {(?:\x1bZ)} + + #ESC Y move, ESC b foreground colour + #ESC F - gr-on ESC G - gr-off + variable re_vt52_open {(?:\x1bY|\x1bb|\x1bF)} + #\x1bc vt52 bgcolour conflict ?? #if we don't split on altgraphics too and separate them out - it's easy to get into a horrible mess variable re_g0_group {(?:\x1b\(0)(?:(?!\x1b\(B).)*\x1b\(B} @@ -4686,7 +5083,7 @@ tcl::namespace::eval punk::ansi::ta { #regex to capture the start of string/privacy message/application command block including the contents and string terminator (ST) #non-greedy by exclusion of ST terminators in body - #we need to match \x1b\\ not just \x1b There could be colour codes nested in a privacy msg/string + #we need to match \x1b\\ not just \x1b There could be colour codes nested in a privacy msg/string (not widely supported?) #even if terminals generally don't support that - it's quite possible for an ansi code to get nested this way - and we'd prefer it not to break our splits #Just checking for \x1b will terminate the match too early #we also need to track the start of ST terminated code and not add it for replay (in the ansistring functions) @@ -4705,17 +5102,44 @@ tcl::namespace::eval punk::ansi::ta { #handrafted TRIE version of above. Somewhat difficult to construct and maintain. TODO - find a regexp TRIE generator that works with Tcl regexes #This does make things quicker - but it's too early to finalise the detect/split regexes (e.g missing \U0090 ) - will need to be redone. #variable re_ansi_detect {(?:\x1b(?:\((?:0|B)|\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|c|7|8|M|E|D|H|=|>|(?:#(?:3|4|5|6|8))))|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]|(?:\u009d)(?:[^\u009c]*)?\u009c} - variable re_ansi_detect {(?:\x1b(?:\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|\((?:0|B)|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|c|7|8|M|E|D|H|=|>|(?:#(?:3|4|5|6|8))))|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]|(?:\u009d)(?:[^\u009c]*)?\u009c} + + #NOTE - the literal # char can cause problems in expanded syntax - even though it's within a bracketed section. \# seems to work though. + #vt52 specific |<|A|B|C|I|J|K|L|M|Z|(?:Y(?:..))|(?:b(?:.)| + #https://freemint.github.io/tos.hyp/en/VT_52_terminal.html + #what to with ESC c vs vt52 ESC c (background colour) ??? + #we probably need to use a separate re_ansi_detect for vt52 + + #although it's stated later terminals are backwards compatible with vt52 - that doesn't seem to mean for example a vt100 will process vt52 codes at the same time as ansi codes + #ie - when DECANM is on - VT52 codes are *not* processed + + #todo - ansi mode and cursor key mode set ? + # arrow keys -> ESC O A, ESC O B, ESC O C, ESC O D + # plus more for auxiliary keypad codes in keypad application mode (and some in numeric mode) + + variable re_ansi_detect {(?x) + (?:\x1b(?:\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|c|7|8|M|D|E|H|=|>|<|A|B|C|I|J|K|L|M|Z|(?:Y(?:..))|(?:b(?:.))|\((?:0|B)|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|(?:\#(?:3|4|5|6|8)))) + |(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c) + |(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e] + |(?:\u009d)(?:[^\u009c]*)?\u009c + } + #--- + # -- --- --- --- #variable re_csi_code {(?:\x1b\[|\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]} - variable re_ansi_detect_open "${re_csi_open}|${re_osc_open}|${re_standalones}|${re_ST_open}|${re_g0_open}" + variable re_ansi_detect_open "${re_csi_open}|${re_osc_open}|${re_standalones}|${re_standalones_vt52}|${re_ST_open}|${re_g0_open}|${re_vt52_open}" #may be same as detect - kept in case detect needs to diverge #variable re_ansi_split "${re_csi_code}|${re_esc_osc1}|${re_esc_osc2}|${re_esc_osc3}|${re_standalones}|${re_ST}|${re_g0_open}|${re_g0_close}" set re_ansi_split $re_ansi_detect + variable re_ansi_split_multi + if {[string first (?x) $re_ansi_split] == 0} { + set re_ansi_split_multi "(?x)(?:[string range ${re_ansi_split} 4 end])+" + } else { + set re_ansi_split_multi "(?:${re_ansi_split})+" + } lappend PUNKARGS [list -dynamic 0 { @id -id ::punk::ansi::ta::detect @@ -4922,81 +5346,46 @@ tcl::namespace::eval punk::ansi::ta { # -- --- --- --- --- --- #Split $text to a list containing alternating ANSI colour codes and text. #ANSI colour codes are always on the second element, fourth, and so on. - #(ie plaintext on odd list-indices ansi on even indices) + #(ie plaintext on even list-indices ansi on odd indices) + #result of split on non-empty string always has an odd length - with indices 0 and end always being plaintext (possibly empty string) # Example: - #ta_split_codes "" # => "" - #ta_split_codes "a" # => "a" - #ta_split_codes "a\e[31m" # => {"a" "\e[31m"} - #ta_split_codes "\e[31ma" # => {"" "\e[31m" "a"} - #ta_split_codes "\e[31ma\e[0m" # => {"" "\e[31m" "a" "\e[0m"} - #ta_split_codes "\e[31ma\e[0mb" # => {"" "\e[31m" "a" "\e[0m", "b"} - #ta_split_codes "\e[31m\e[0mb" # => {"" "\e[31m\e[0m" "b"} + #split_codes "" # => "" + #split_codes "a" # => "a" + #split_codes "a\e[31m" # => {"a" "\e[31m" ""} + #split_codes "\e[31ma" # => {"" "\e[31m" "a"} + #split_codes "\e[31ma\e[0m" # => {"" "\e[31m" "a" "\e[0m" ""} + #split_codes "\e[31ma\e[0mb" # => {"" "\e[31m" "a" "\e[0m", "b"} + #split_codes "\e[31m\e[0mb" # => {"" "\e[31m\e[0m" "b"} # proc split_codes {text} { - variable re_ansi_split - set re "(?:${re_ansi_split})+" - return [_perlish_split $re $text] + variable re_ansi_split_multi + return [_perlish_split $re_ansi_split_multi $text] } #micro optimisations on split_codes to avoid function calls and make re var local tend to yield very little benefit (sub uS diff on calls that commonly take 10s/100s of uSeconds) - #like split_codes - but each ansi-escape is split out separately (with empty string of plaintext between codes so odd/even plain ansi still holds) + #like split_codes - but each ansi-escape is split out separately (with empty string of plaintext between codes so even/odd indices for plain ansi still holds) #- the slightly simpler regex than split_codes means that it will be slightly faster than keeping the codes grouped. - proc split_codes_single2 {text} { - variable re_ansi_split - return [_perlish_split $re_ansi_split $text] - } - proc split_codes_single3 {text} { - #copy from re_ansi_split - _perlish_split {(?:\x1b(?:\((?:0|B)|\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|c|7|8|M|E|D|H|=|>|(?:#(?:3|4|5|6|8))))|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]|(?:\u009d)(?:[^\u009c]*)?\u009c} $text - } - proc split_codes_single4 {text} { - if {$text eq ""} { - return {} - } - variable re_ansi_split - set re $re_ansi_split - #variable re_ansi_detect1 - #set re $re_ansi_detect1 - set list [list] - set start 0 - - #set re {(?:\x1b(?:\((?:0|B)|\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|c|7|8|M|E|D|H|=|>|(?:#(?:3|4|5|6|8))))|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]|(?:\u009d)(?:[^\u009c]*)?\u009c} - #We can get $matchEnd < $matchStart; we need to ensure there is an exit condition for non-greedy empty results REVIEW - #while {[regexp -start $start -indices -- {(?:\x1b(?:\((?:0|B)|\[(?:[\x20-\x2f\x30-\x3f]*[\x40-\x7e])|\](?:(?:[^\007]*)\007|(?:(?!\x1b\\).)*\x1b\\)|(?:P|X|\^|_)(?:(?:(?!\x1b\\|\007).)*(?:\x1b\\|\007))|c|7|8|M|E|D|H|=|>|(?:#(?:3|4|5|6|8))))|(?:\u0090|\u0098|\u009E|\u009F)(?:(?!\u009c).)*(?:\u009c)|(?:\u009b)[\x20-\x2f\x30-\x3f]*[\x40-\x7e]|(?:\u009d)(?:[^\u009c]*)?\u009c} $text match]} {} - while {[regexp -start $start -indices -- $re $text match]} { - lassign $match matchStart matchEnd - #puts "->start $start ->match $matchStart $matchEnd" - lappend list [tcl::string::range $text $start $matchStart-1] - if {$matchEnd < $matchStart} { - set e $matchStart - incr start - } else { - set e $matchEnd - set start [expr {$matchEnd+1}] - } - lappend list [tcl::string::range $text $matchStart $e] - if {$start >= [tcl::string::length $text]} { - break - } - } - return [lappend list [tcl::string::range $text $start end]] - } proc split_codes_single {text} { if {$text eq ""} { return {} } variable re_ansi_split set next 0 - set b -1 + #set b -1 set list [list] set coderanges [regexp -indices -all -inline -- $re_ansi_split $text] foreach cr $coderanges { lappend list [tcl::string::range $text $next [lindex $cr 0]-1] [tcl::string::range $text [lindex $cr 0] [lindex $cr 1]] set next [expr {[lindex $cr 1]+1}] + #set next [lindex $cr 1]+1 ;#text index-expression for string range } lappend list [tcl::string::range $text $next end] return $list } + proc split_codes_single2 {text} { + variable re_ansi_split + return [_perlish_split $re_ansi_split $text] + } proc get_codes_single {text} { variable re_ansi_split regexp -all -inline -- $re_ansi_split $text @@ -5008,7 +5397,7 @@ tcl::namespace::eval punk::ansi::ta { return {} } set next 0 - set b -1 + #set b -1 set list [list] set coderanges [regexp -indices -all -inline -- $re $text] foreach cr $coderanges { @@ -5103,29 +5492,6 @@ tcl::namespace::eval punk::ansi::ta { #return [lappend list [tcl::string::range $text $start end]] yield [tcl::string::range $text $start end] } - proc _perlish_split2 {re text} { - if {[tcl::string::length $text] == 0} { - return {} - } - set list [list] - set start 0 - #We can get $matchEnd < $matchStart; we need to ensure there is an exit condition for non-greedy empty results REVIEW - while {[regexp -start $start -indices -- $re $text match]} { - lassign $match matchStart matchEnd - #puts "->start $start ->match $matchStart $matchEnd" - if {$matchEnd < $matchStart} { - lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::index $text $matchStart] - incr start - } else { - lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::range $text $matchStart $matchEnd] - set start [expr {$matchEnd+1}] - } - if {$start >= [tcl::string::length $text]} { - break - } - } - return [lappend list [tcl::string::range $text $start end]] - } proc _ws_split {text} { regexp -all -inline {(?:\S+)|(?:\s+)} $text } @@ -7429,12 +7795,10 @@ tcl::namespace::eval punk::ansi::internal { #todo - document interp alias {} ansistring {} ::punk::ansi::ansistring -if {![info exists ::punk::args::register::NAMESPACES]} { - namespace eval ::punk::args::register { - set NAMESPACES [list] - } +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::ansi ::punk::ansi::class ::punk::ansi::ta } -lappend ::punk::args::register::NAMESPACES ::punk::ansi ::punk::ansi::class ::punk::ansi::ta # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready diff --git a/src/vfs/_vfscommon.vfs/modules/punk/args-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/args-0.1.0.tm index 37f8b712..e940dada 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/args-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/args-0.1.0.tm @@ -226,15 +226,26 @@ tcl::namespace::eval punk::args::register { #[para] The punk::args package will then test for a public list variable ::PUNKARGS containing argument definitions when it needs to. #[list_begin definitions] + #Although the actual punk::args::define calls are not too sluggish, there could be *many*. + #in a multi-interp environment, we want to be lazy about loading argdefs until they're actually required, + #especially since a fair proportion may be for documentation purposes rather than parsing args. + # -- --- --- --- --- --- --- --- - #cooperative with packages that define some punk args but may need to do so lazily - #These could be loaded prior to punk::args being loaded - variable NAMESPACES + #cooperative with packages that define some punk args but do so lazily + #These could be loaded prior to punk::args being loaded - so check existence of NAMESPACES var first + variable NAMESPACES ;#just declaring it with variable doesn't yet mean it 'exists' from 'info exists' perspective if {![info exists ::punk::args::register::NAMESPACES]} { - set NAMESPACES [list] + set ::punk::args::register::NAMESPACES [list] } # -- --- --- --- --- --- --- --- + variable loaded_packages [list] ;#fully loaded + variable loaded_info [dict create] ;#time + variable scanned_packages [list] ;#packages scanned for ids used to update namespace_docpackages + variable scanned_info [dict create] ;#time and idcount + #some packages, e.g punk::args::tclcore document other namespaces. + #when punk::args::update_definitions gets a query for a namespace - we need to load argdefs from registered sources + variable namespace_docpackages [dict create] #*** !doctools #[list_end] [comment {--- end definitions namespace punk::args::register ---}] @@ -250,14 +261,15 @@ tcl::namespace::eval punk::args { variable PUNKARGS ;#list of our own punk::args function argument definitions - loaded with punk::args::define at the end. tcl::namespace::export {[a-z]*} - variable argdata_cache - variable argdefcache_by_id - variable argdefcache_unresolved ;#key = original template list supplied to 'define', value = 2-element list: (tstr-parsed split of template) & (unresolved params) - variable id_counter - set argdata_cache [tcl::dict::create] - set argdefcache_by_id [tcl::dict::create] - set argdefcache_unresolved [tcl::dict::create] - set id_counter 0 + variable rawdef_cache [tcl::dict::create] ;#key on rawdef list - return dict of {-id -dynamic 0|1} + variable id_cache_rawdef [tcl::dict::create] + variable id_cache_spec [tcl::dict::create] + + variable argdefcache_unresolved [tcl::dict::create] ;#key = original template list supplied to 'define', value = 2-element list: (tstr-parsed split of template) & (unresolved params) + + variable argdata_cache [tcl::dict::create] + + variable id_counter 0 #*** !doctools #[subsection {Namespace punk::args}] @@ -321,22 +333,22 @@ tcl::namespace::eval punk::args { %B%@id%N% ?opt val...? options: -id %B%@cmd%N% ?opt val...? - options -name -help + options: -name -help %B%@leaders%N% ?opt val...? - options -min -max + options: -min -max (used for leading args that come before switches/opts) %B%@opts%N% ?opt val...? - options -any + options: -any %B%@values%N% ?opt val...? - options -min -max + options: -min -max (used for trailing args that come after switches/opts) %B%@argdisplay%N% ?opt val...? - options -header (text for header row of table) + options: -header (text for header row of table) -body (text to replace autogenerated arg info) %B%@doc%N% ?opt val...? - options -name -url + options: -name -url %B%@seealso%N% ?opt val...? - options -name -url (for footer - unimplemented) + options: -name -url (for footer - unimplemented) Some other options normally present on custom arguments are available to use with the @leaders @opts @values directives to set defaults @@ -418,6 +430,15 @@ tcl::namespace::eval punk::args { streaming and checksumming. The -choices list is equivalent to a -choicegroups dict entry where the key (groupname) is the empty string. + -choicemultiple (default {1 1}) + is a pair representing min and max number of choices + that can be present in the value. + If is a single integer it is equivalent to a + specified with the same integer for both min and max. + Max of -1 represents no upper limit. + If allows more than one choice the value is a list + consisting of items in the choices made available through + entries in -choices/-choicegrups. -minsize (type dependant) -maxsize (type dependant) -range (type dependant) @@ -425,27 +446,27 @@ tcl::namespace::eval punk::args { " -dynamic -type boolean -default 0 -help\ - "If -dynamic is true, tstr interpolations of the form \$\{\$var\} - are re-evaluated on each call. - If the definition is being used not just as documentation, but is also - used within the function to parse args, e.g using punk::args::get_by_id, - then it should be noted that there is a slight performance penalty for the - dynamic case. - It is often not significant, perhaps depending on what vars/commands are - used but -dynamic true might be less desirable if the command is used in - inner loops in more performance-sensitive code. + "If -dynamic is true, tstr interpolations of the form \$\{\$var\} + are re-evaluated on each call. + If the definition is being used not just as documentation, but is also + used within the function to parse args, e.g using punk::args::get_by_id, + then it should be noted that there is a slight performance penalty for the + dynamic case. + It is often not significant, perhaps depending on what vars/commands are + used but -dynamic true might be less desirable if the command is used in + inner loops in more performance-sensitive code. " @values -min 1 -max -1 text -type string -multiple 1 -help\ - "Block(s) of text representing the argument definition for a command. - At least one must be supplied. If multiple, they are joined together with \\n. - Using multiple text arguments may be useful to mix curly-braced and double-quoted - strings to have finer control over interpolation when defining arguments. - (this can also be handy for sections that pull resolved definition lines - from existing definitions (by id) for re-use of argument specifications and help text) - - e.g the following definition passes 2 blocks as text arguments - definition { + "Block(s) of text representing the argument definition for a command. + At least one must be supplied. If multiple, they are joined together with \\n. + Using multiple text arguments may be useful to mix curly-braced and double-quoted + strings to have finer control over interpolation when defining arguments. + (this can also be handy for sections that pull resolved definition lines + from existing definitions (by id) for re-use of argument specifications and help text) + + e.g the following definition passes 2 blocks as text arguments + definition { @id -id ::myns::myfunc @cmd -name myns::myfunc -help\\ \"Description of command\" @@ -454,13 +475,18 @@ tcl::namespace::eval punk::args { -option1 -default blah -type string #The following option defines a flag style option (solo) -flag1 -default 0 -type none -help\\ - \"Info about flag1\" + \"Info about flag1 + subsequent help lines auto-dedented by whitespace to left + of corresponding record start (in this case -flag1) + + first 4 spaces if they are all present. + This line has no extra indent relative to first line 'Info about flag1' + This line indented a further 6 chars\" @values -min 1 -max -1 #Items that don't begin with * or - are value definitions v1 -type integer -default 0 thinglist -type string -multiple 1 - } \"*doc -name Manpage: -url \[myfunc_manpage_geturl myns::myfunc]\" + } \"*doc -name Manpage: -url \[myfunc_manpage_geturl myns::myfunc]\" " }]] @@ -475,6 +501,7 @@ tcl::namespace::eval punk::args { -nocase 0\ -choiceprefix 1\ -choicerestricted 1\ + -choicemultiple {1 1}\ -multiple 0\ -regexprepass {}\ -validationtransform {}\ @@ -488,6 +515,7 @@ tcl::namespace::eval punk::args { -nocase 0\ -choiceprefix 1\ -choicerestricted 1\ + -choicemultiple {1 1}\ -multiple 0\ -regexprepass {}\ -validationtransform {}\ @@ -501,6 +529,7 @@ tcl::namespace::eval punk::args { -nocase 0\ -choiceprefix 1\ -choicerestricted 1\ + -choicemultiple {1 1}\ -multiple 0\ -regexprepass {}\ -validationtransform {}\ @@ -569,8 +598,23 @@ tcl::namespace::eval punk::args { #] } proc define {args} { + dict get [resolve {*}$args] id + } + proc resolve {args} { + variable rawdef_cache + variable id_cache_rawdef + if {[dict exists $rawdef_cache $args]} { + set id [dict get $rawdef_cache $args -id] + set is_dynamic [dict get $rawdef_cache $args -dynamic] + } else { + set id [rawdef_id $args] + set is_dynamic [rawdef_is_dynamic $args] + dict set rawdef_cache $args [dict create -id $id -dynamic $is_dynamic] + dict set id_cache_rawdef $id $args + } + + variable argdata_cache - variable argdefcache_by_id variable argdefcache_unresolved @@ -592,7 +636,6 @@ tcl::namespace::eval punk::args { punk::args::get_by_id ::punk::args::define {} return } - set is_dynamic 0 if {[lindex $args 0] eq "-dynamic"} { set is_dynamic [lindex $args 1] set textargs [lrange $args 2 end] @@ -699,14 +742,18 @@ tcl::namespace::eval punk::args { if {![tcl::info::complete $test_complete]} { #append linebuild [string trimleft $rawline] \n if {$in_record} { - if {[tcl::string::length $lastindent]} { - #trim only the whitespace corresponding to last indent - not all whitespace on left - if {[tcl::string::first $lastindent $rawline] == 0} { - set trimmedline [tcl::string::range $rawline [tcl::string::length $lastindent] end] - append linebuild $trimmedline \n - } else { - append linebuild $rawline \n - } + #trim only the whitespace corresponding to last record indent or lastindent + 4 spaces - not all whitespace on left + #this allows alignment of multiline help strings to left margin whilst maintaining a visual indent in source form. + #Aligning subsequent lines with the record, or aligning 4 spaces in are equivalent. + #ie to indent lines further - whitespace should be added 4+ columns in from the record-line start position. + #(this leaves an oddity if indenting is only 1 2 or 3 spaces mixed with longer indents as we don't check for it.. REVIEW) + #(note string first "" $str is fast and returns -1) + if {[tcl::string::first "$lastindent " $rawline] == 0} { + set trimmedline [tcl::string::range $rawline [tcl::string::length "$lastindent "] end] + append linebuild $trimmedline \n + } elseif {[tcl::string::first $lastindent $rawline] == 0} { + set trimmedline [tcl::string::range $rawline [tcl::string::length $lastindent] end] + append linebuild $trimmedline \n } else { append linebuild $rawline \n } @@ -719,14 +766,13 @@ tcl::namespace::eval punk::args { } } else { set in_record 0 - if {[tcl::string::length $lastindent]} { - #trim only the whitespace corresponding to last indent - not all whitespace on left - if {[tcl::string::first $lastindent $rawline] == 0} { - set trimmedline [tcl::string::range $rawline [tcl::string::length $lastindent] end] - append linebuild $trimmedline - } else { - append linebuild $rawline - } + #trim only the whitespace corresponding to last record indent or lastindent + 4 spaces - not all whitespace on left + if {[tcl::string::first "$lastindent " $rawline] == 0} { + set trimmedline [tcl::string::range $rawline [tcl::string::length "$lastindent "] end] + append linebuild $trimmedline + } elseif {[tcl::string::first $lastindent $rawline] == 0} { + set trimmedline [tcl::string::range $rawline [tcl::string::length $lastindent] end] + append linebuild $trimmedline } else { append linebuild $rawline } @@ -734,10 +780,13 @@ tcl::namespace::eval punk::args { set linebuild "" } } - set cmd_info {} - set id_info {} ;#e.g -children ?? - set doc_info {} + set cmd_info {} + set package_info {} + set id_info {} ;#e.g -children ?? + set doc_info {} set argdisplay_info {} ;#optional override of autogenerated 'Arg Type Default Multi Help' table + set seealso_info {} + set keywords_info {} ###set leader_min 0 ###set leader_max 0 ;#default 0 but if leader_min is set switches to -1 for no limit #set leader_max "" @@ -745,7 +794,7 @@ tcl::namespace::eval punk::args { set opt_any 0 set val_min 0 set val_max -1 ;#-1 for no limit - set DEF_definition_id "" + set DEF_definition_id $id #form_defs set F [dict create _default [New_command_form _default]] @@ -840,20 +889,26 @@ tcl::namespace::eval punk::args { set at_specs $record_values switch -- [tcl::string::range $directive_name 1 end] { + dynamic { + set is_dynamic 1 + } id { + #disallow duplicate @id line ? + #review - nothing to stop multiple @id lines - or redefining as auto (which is ignored?) + #id An id will be allocated if no id line present or the -id value is "auto" - if {$DEF_definition_id ne ""} { - #disallow duplicate @id line - error "punk::args::define - @id already set. Existing value $DEF_definition_id\n[join $args \n]" - } + if {[dict exists $at_specs -id]} { - set DEF_definition_id [dict get $at_specs -id] - } else { - set DEF_definition_id auto + set thisid [dict get $at_specs -id] + if {$thisid ni [list $id auto]} { + error "punk::args::define @id mismatch existing: $id vs $thisid" + } } set id_info $at_specs } ref { + #a reference within the definition + #e.g see punk::args::tclcore ::after #global reference dict - independent of forms #ignore refs without an -id #store all keys except -id @@ -867,10 +922,10 @@ tcl::namespace::eval punk::args { #(if we were to take from a definition - we would have to check and maybe change this def to -dynamic.. ?) #perhaps we could allow -dynamic as a flag here - but IFF this define is already -dynamic (?) #That is possibly too complicated and/or unnecessary? - #however.. as it stands we have define -dynamic 1 making *immediate* resolutions .. is that really desirable? + #however.. as it stands we have define @dynamic making *immediate* resolutions .. is that really desirable? if {[dict exists $at_specs -id]} { - set copyfrom [get_def [dict get $at_specs -id]] + set copyfrom [get_spec [dict get $at_specs -id]] #we don't copy the @id info from the source #for now we only copy across if nothing set.. #todo - bring across defaults for empty keys at targets? @@ -942,6 +997,9 @@ tcl::namespace::eval punk::args { } #new form keys already created if they were needed (done for all records that have -form ) } + package { + set package_info [dict merge $package_info $at_specs] + } cmd { #allow arbitrary - review set cmd_info [dict merge $cmd_info $at_specs] @@ -968,7 +1026,7 @@ tcl::namespace::eval punk::args { -anyopts { set opt_any $v } - -minsize - -maxsize - -range - -choices - -choicegroups - -choicecolumns - -choicelabels - -choiceinfo - -choiceprefix - -choiceprefixdenylist - -choicerestricted { + -minsize - -maxsize - -range - -choices - -choicegroups - -choicemultiple - -choicecolumns - -choicelabels - -choiceinfo - -choiceprefix - -choiceprefixdenylist - -choicerestricted { #review - only apply to certain types? tcl::dict::set tmp_optspec_defaults $k $v } @@ -1014,7 +1072,7 @@ tcl::namespace::eval punk::args { tcl::dict::set tmp_optspec_defaults $k $v } default { - set known { -any -anyopts -minsize -maxsize -range -choices -choicegroups -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted -nocase\ + set known { -any -anyopts -minsize -maxsize -range -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted -nocase\ -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ -regexprepass -regexprefail -regexprefailmsg -validationtransform\ @@ -1052,10 +1110,16 @@ tcl::namespace::eval punk::args { } dict set F $fid LEADER_MAX $v } - -minsize - -maxsize - -range - -choices - -choicegroups - -choicecolumns - -choicelabels - -choiceinfo - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -nocase { + -minsize - -maxsize - -range - -choices - -choicegroups - -choicemultiple - -choicecolumns - -choicelabels - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -nocase { #review - only apply to certain types? tcl::dict::set tmp_leaderspec_defaults $k $v } + -choiceinfo { + if {[llength $v] %2 != 0} { + error "punk::args::define - key '-choiceinfo' requires a dictionary value as an argument. got $v id:$DEF_definition_id" + } + tcl::dict::set tmp_leaderspec_defaults $k $v + } -nominsize - -nomaxsize - -norange - -nochoices - -nochoicelabels { #-choicegroups? if {$v} { @@ -1100,7 +1164,7 @@ tcl::namespace::eval punk::args { default { set known { -min -minvalues -max -maxvalues\ -minsize -maxsize -range\ - -choices -choicegroups -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted\ + -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted\ -nocase -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ -regexprepass -regexprefail -regexprefailmsg -validationtransform\ @@ -1138,12 +1202,18 @@ tcl::namespace::eval punk::args { } set val_max $v } - -minsize - -maxsize - -range - -choices - -choicegroups - -choicecolumns - -choicelabels - -choiceinfo - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -nocase { + -minsize - -maxsize - -range - -choices - -choicemultiple - -choicecolumns - -choicelabels - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -nocase { #review - only apply to certain types? tcl::dict::set tmp_valspec_defaults $k $v } + -choiceinfo - -choicegroups { + if {[llength $v] % 2 != 0} { + error "punk::args::define - key '$k' requires a dictionary value as an argument. got $v id:$DEF_definition_id" + } + tcl::dict::set tmp_valspec_defaults $k $v + } -nominsize - -nomaxsize - -norange - -nochoices - -nochoicelabels { - # -choicegoups ?? + # -choicegroups ?? if {$v} { set k2 -[string range $k 3 end] ;#strip 'no' tcl::dict::unset tmp_valspec_defaults $k2 @@ -1186,7 +1256,7 @@ tcl::namespace::eval punk::args { default { set known { -min -minvalues -max -maxvalues\ -minsize -maxsize -range\ - -choices -choicegroups -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted\ + -choices -choicegroups -choicemultiple -choicecolumns -choicelabels -choiceinfo -choiceprefix -choiceprefixdenylist -choicerestricted\ -nocase\ -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ @@ -1203,6 +1273,11 @@ tcl::namespace::eval punk::args { seealso { #todo! #like @doc, except displays in footer, multiple - sub-table? + set seealso_info [dict merge $seealso_info $at_specs] + } + keywords { + #review - put as option on @cmd instead? @cmd -name xxx -keywords {blah etc hmm} ?? + set keywords_info [dict merge $keywords_info $at_specs] } default { error "punk::args::define - unrecognised @ line in '$rec'. Expected @id @cmd @form... @leaders @opts @values @doc @argdisplay - use @@name if paramname needs to be @name @id:$DEF_definition_id" @@ -1331,7 +1406,7 @@ tcl::namespace::eval punk::args { } } -default - -solo - -range - - -choices - -choicegroups - -choicecolumns - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -choicelabels - -choiceinfo - + -choices - -choicegroups - -choicemultiple - -choicecolumns - -choiceprefix - -choiceprefixdenylist - -choicerestricted - -choicelabels - -choiceinfo - -minsize - -maxsize - -nocase - -optional - -multiple - -validate_ansistripped - -allow_ansi - -strip_ansi - -help - -ARGTYPE - -regexprepass - -regexprefail - -regexprefailmsg @@ -1376,7 +1451,7 @@ tcl::namespace::eval punk::args { } } } else { - set known_argopts [list -form -default -type -range -minsize -maxsize -choices -choicegroups -choicecolumns -choiceprefix -choiceprefixdenylist -choicerestricted\ + set known_argopts [list -form -default -type -range -minsize -maxsize -choices -choicegroups -choicemultiple -choicecolumns -choiceprefix -choiceprefixdenylist -choicerestricted\ -nocase -optional -multiple -validate_ansistripped -allow_ansi -strip_ansi -help\ -regexprepass -regexprefail -regexprefailmsg -validationtransform\ ] @@ -1426,10 +1501,10 @@ tcl::namespace::eval punk::args { } ;# end foreach rec $records - if {$DEF_definition_id eq "" || [tcl::string::tolower $DEF_definition_id] eq "auto"} { - variable id_counter - set DEF_definition_id "autoid_[incr id_counter]" - } + #if {$DEF_definition_id eq "" || [tcl::string::tolower $DEF_definition_id] eq "auto"} { + # variable id_counter + # set DEF_definition_id "autoid_[incr id_counter]" + #} #check ALL forms not just form_ids_active (record_form_ids) @@ -1521,9 +1596,11 @@ tcl::namespace::eval punk::args { VAL_CHECKS_DEFAULTS [dict get $F $firstformid VAL_CHECKS_DEFAULTS]\ cmd_info $cmd_info\ doc_info $doc_info\ + package_info $package_info\ argdisplay_info $argdisplay_info\ + seealso_info $seealso_info\ id_info $id_info\ - temp_F $F\ + FORMS $F\ form_names [dict keys $F]\ FORM_INFO $form_info\ ] @@ -1533,42 +1610,75 @@ tcl::namespace::eval punk::args { #also cache resolved version tcl::dict::set argdata_cache $optionspecs $argdata_dict } - #tcl::dict::set argdefcache_by_id $DEF_definition_id $optionspecs - tcl::dict::set argdefcache_by_id $DEF_definition_id $args + + #tcl::dict::set id_cache_rawdef $DEF_definition_id $args #puts "xxx:$result" return $argdata_dict } #return raw definition list as created with 'define' - proc rawdef {id} { - variable argdefcache_by_id + # - possibly with unresolved dynamic parts + proc raw_def {id} { + variable id_cache_rawdef set realid [real_id $id] - #return the raw definition - possibly with unresolved dynamic parts - if {![dict exists $argdefcache_by_id $realid]} { + if {![dict exists $id_cache_rawdef $realid]} { return "" } - return [tcl::dict::get $argdefcache_by_id $realid] + return [tcl::dict::get $id_cache_rawdef $realid] } namespace eval argdoc { - variable resolved_def_TYPE_CHOICES {* @id @cmd @leaders @opts @values @doc} + variable resolved_def_TYPE_CHOICES {* @id @package @cmd @ref @doc @argdisplay @seealso @leaders @opts @values leaders opts values} + variable resolved_def_TYPE_CHOICEGROUPS { + directives {@id @package @cmd @ref @doc @argdisplay @seealso} + argumenttypes {leaders opts values} + remaining_defaults {@leaders @opts @values} + } - lappend PUNKARGS [list -dynamic 0 [string map [list %TYPECHOICES% $resolved_def_TYPE_CHOICES] { + lappend PUNKARGS [list [string map [list %TYPECHOICES% $resolved_def_TYPE_CHOICES %TYPECHOICEGROUPS% $resolved_def_TYPE_CHOICEGROUPS] { @id -id ::punk::args::resolved_def @cmd -name punk::args::resolved_def -help\ - "" + "Resolves or retrieves the previously resolved definition and + uses the 'spec' form to build a response in definition format. + + Pulling argument definition data from another function is a form + of tight coupling to the other function that should be done with + care. + + Note that the directives @leaders @opts @values may appear multiple + times in a source definition - applying defaults for arguments that + follow. When retrieving these - there is only a single result for + each that represents the defaults after all have been applied. + When retrieving -types * each of these will be positioned before + the arguments of that type - but this doesn't mean there was a single + leading directive for this argument type in the source definition. + Each argument has already had its complete specification recorded in + its own result. + + When manually specifying -types, the order @leaders then @opts then + @values must be maintained - but if they are placed before their + corresponding arguments, they will not affect the retrieved arguments + as these arguments are already fully spec'd. The defaults from the + source can be removed by adding @leaders, @opts @values to the + -antiglobs list, but again - this won't affect the existing arguments. + Each argument can have members of its spec overridden using the + -override dictionary. + " @leaders -min 0 -max 0 @opts -form -default 0 -help\ - "UNIMPLEMENTED - Ordinal index or name of command form" - -type -default * -choices {%TYPECHOICES%} -choiceprefix 0 -multiple 1 + "Ordinal index or name of command form" + + #no restriction on number of types/repetitions? + -types -default * -choices {%TYPECHOICES%} -choicegroups {%TYPECHOICEGROUPS%} -choiceprefix 0 -choicemultiple {0 -1} + -antiglobs -default {} -type list -help\ + "Glob patterns for directive or argument/flags to + be suppressed" -override -type dict -optional 1 -default "" -help\ "dict of dicts. Key in outer dict is the name of a directive or an argument. Inner dict is a map of overrides/additions (- ...) for that line. - (unimplemented). " @values -min 1 -max -1 id -type string -help\ @@ -1597,23 +1707,24 @@ tcl::namespace::eval punk::args { proc resolved_def {args} { set opts [dict create\ - -type {}\ + -types {}\ -form 0\ + -antiglobs {}\ -override {}\ ] if {[llength $args] < 1} { #must have at least id - punk::args::get_by_id ::punk::args::resolved_def $args + punk::args::parse $args withid ::punk::args::resolved_def return } set patterns [list] - #a definition id must not begin with "-" + #a definition id must not begin with "-" ??? review for {set i 0} {$i < [llength $args]} {incr i} { set a [lindex $args $i] - if {$a eq "-type"} { + if {$a in {-type -types}} { incr i - dict lappend opts -type [lindex $args $i] + dict set opts -types [lindex $args $i] } elseif {[string match -* $a]} { incr i dict set opts $a [lindex $args $i] @@ -1623,7 +1734,7 @@ tcl::namespace::eval punk::args { break } if {$i == [llength $args]-1} { - punk::args::get_by_id ::punk::args::resolved_def $args + punk::args::parse $args withid ::punk::args::resolved_def return } } @@ -1632,47 +1743,121 @@ tcl::namespace::eval punk::args { } dict for {k v} $opts { switch -- $k { - -form - -type - -override {} + -form - -types - -antiglobs - -override {} default { - punk::args::get_by_id ::punk::args::resolved_def $args + punk::args::parse $args withid ::punk::args::resolved_def return } } } - set typelist [dict get $opts -type] + set typelist [dict get $opts -types] if {[llength $typelist] == 0} { set typelist {*} } foreach type $typelist { if {$type ni $::punk::args::argdoc::resolved_def_TYPE_CHOICES} { - punk::args::get_by_id ::punk::args::resolved_def $args + punk::args::parse $args withid ::punk::args::resolved_def return } } - variable argdefcache_by_id + + variable id_cache_rawdef set realid [real_id $id] if {$realid ne ""} { - set deflist [tcl::dict::get $argdefcache_by_id $realid] + set deflist [tcl::dict::get $id_cache_rawdef $realid] set result "" - set specdict [uplevel 1 [list ::punk::args::define {*}$deflist]] - set arg_info [dict get $specdict ARG_INFO] - set argtypes [dict create @opts option @leaders leader @values value] + set specdict [uplevel 1 [list ::punk::args::resolve {*}$deflist]] + + set opt_form [dict get $opts -form] + if {[string is integer -strict $opt_form]} { + set formname [lindex [dict get $specdict form_names] $opt_form] + } else { + set formname $opt_form + } + set opt_override [dict get $opts -override] + + #set arg_info [dict get $specdict ARG_INFO] + set arg_info [dict get $specdict FORMS $formname ARG_INFO] + set argtypes [dict create leaders leader opts option values value] + + set opt_antiglobs [dict get $opts -antiglobs] + set directives [lsearch -all -inline -exact -not $::punk::args::argdoc::resolved_def_TYPE_CHOICES *] + set suppressed_directives [list] + set suppressed_args [list] + foreach ag $opt_antiglobs { + foreach d $directives { + if {[string match $ag $d]} { + lappend suppressed_directives $d + } + } + foreach argname [dict keys $arg_info] { + if {[string match $ag $argname]} { + lappend suppressed_args $argname + } + } + } + set suppressed_directives [lsort -unique $suppressed_directives] + set suppressed_args [lsort -unique $suppressed_args] + + set included_directives [punk::args::system::punklib_ldiff $directives $suppressed_directives] + + set globbed [list] + foreach pat $patterns { + set matches [dict keys $arg_info $pat] + lappend globbed {*}$matches + } + set globbed [lsort -unique $globbed] + set included_args [punk::args::system::punklib_ldiff $globbed $suppressed_args] + foreach type $typelist { switch -exact -- $type { * { - append result \n "@id -id [dict get $specdict id]" - append result \n "@cmd [dict get $specdict cmd_info]" - append result \n "@doc [dict get $specdict doc_info]" - foreach tp {leader option value} { - foreach pat $patterns { - set matches [dict keys $arg_info $pat] - foreach m $matches { - set def [dict get $arg_info $m] - if {[dict get $def -ARGTYPE] eq $tp} { - set def [dict remove $def -ARGTYPE] - append result \n "$m $def" + if {"@id" in $included_directives} { + if {[dict exists $opt_override @id]} { + append result \n "@id [dict merge [dict create -id [dict get $specdict id]] [dict get $opt_override @id]]" + } else { + append result \n "@id -id [dict get $specdict id]" + } + } + foreach directive {@package @cmd @doc @seealso @argdisplay} { + set dshort [string range $directive 1 end] + if {"$directive" in $included_directives} { + if {[dict exists $opt_override $directive]} { + append result \n "$directive [dict merge [dict get $specdict ${dshort}_info] [dict get $opt_override $directive]]" + } else { + append result \n "$directive [dict get $specdict ${dshort}_info]" + } + } + } + #output ordered by leader, option, value + foreach pseudodirective {leaders opts values} tp {leader option value} { + set directive "@$pseudodirective" + switch -- $directive { + @leaders {set defaults_key leaderspec_defaults} + @opts {set defaults_key optspec_defaults} + @values {set defaults_key valspec_defaults} + } + + if {"$directive" in $included_directives} { + if {[dict exists $opt_override "$directive"]} { + append result \n "$directive [dict merge [dict get $specdict $defaults_key] [dict get $opt_override $directive]]" + } else { + append result \n "$directive [dict get $specdict $defaults_key]" + } + } + + if {$pseudodirective in $included_directives} { + foreach m $included_args { + set argspec [dict get $arg_info $m] + if {[dict get $argspec -ARGTYPE] eq $tp} { + set argspec [dict remove $argspec -ARGTYPE] + if {[dict exists $opt_override $m]} { + append result \n "$m [dict merge $argspec [dict get $opt_override $m]]" + } else { + append result \n "$m $argspec" + } } } } @@ -1680,27 +1865,52 @@ tcl::namespace::eval punk::args { } @id { - #only a single id record can exist - append result \n "@id -id [dict get $specdict id]" - } - @cmd { - #only a single @cmd record can exist - #merged if multiple in original def (?) - append result \n "@cmd [dict get $specdict cmd_info]" + if {"@id" in $included_directives} { + #only a single id record can exist + if {[dict exists $opt_override @id]} { + append result \n "@id [dict merge [dict create -id [dict get $specdict id]] [dict get $opt_override @id]]" + } else { + append result \n "@id -id [dict get $specdict id]" + } + } } - @doc { - #only a single @doc record can exist - append result \n "@doc [dict get $specdict doc_info]" + @package - @cmd - @doc - @seealso - @argdisplay { + if {"$type" in $included_directives} { + set tp [string range $type 1 end] ;# @package -> package + if {[dict exists $opt_override $type]} { + append result \n "$type [dict merge [dict get $specdict ${tp}_info] [dict get $opt_override $type]]" + } else { + append result \n "$type [dict get $specdict ${tp}_info]" + } + } } @leaders - @opts - @values { - #option, - foreach pat $patterns { - set matches [dict keys $arg_info $pat] - foreach m $matches { - set def [dict get $arg_info $m] - if {[dict get $def -ARGTYPE] eq [dict get $argtypes $type]} { - set def [dict remove $def -ARGTYPE] - append result \n "$m $def" + #these are the active defaults for further arguments + if {"$type" in $included_directives} { + switch -- $type { + @leaders {set defaults_key leaderspec_defaults} + @opts {set defaults_key optspec_defaults} + @values {set defaults_key valspec_defaults} + } + if {[dict exists $opt_override $type]} { + append result \n "$type [dict merge [dict get $specdict leaderspec_defaults] [dict get $opt_override $type]]" + } else { + append result \n "$type [dict get $specdict leaderspec_defaults]" + } + } + } + leaders - opts - values { + #pseudo-directives + if {$type in $included_directives} { + foreach m $included_args { + set argspec [dict get $arg_info $m] + if {[dict get $argspec -ARGTYPE] eq [dict get $argtypes $type]} { + set argspec [dict remove $argspec -ARGTYPE] + if {[dict exists $opt_override $m]} { + append result \n "$m [dict merge $argspec [dict get $opt_override $m]]" + } else { + append result \n "$m $argspec" + } } } } @@ -1714,12 +1924,12 @@ tcl::namespace::eval punk::args { } } - proc get_spec_values {id {patternlist *}} { - variable argdefcache_by_id + proc resolved_def_values {id {patternlist *}} { + variable id_cache_rawdef set realid [real_id $id] if {$realid ne ""} { - set speclist [tcl::dict::get $argdefcache_by_id $realid] - set specdict [define {*}$speclist] + set speclist [tcl::dict::get $id_cache_rawdef $realid] + set specdict [resolve {*}$speclist] set arg_info [dict get $specdict ARG_INFO] set valnames [dict get $specdict VAL_NAMES] set result "" @@ -1744,18 +1954,69 @@ tcl::namespace::eval punk::args { } } } - #proc get_spec_leaders ?? - #proc get_spec_opts ?? + #proc resolved_def_leaders ?? + #proc resolved_def_opts ?? - proc get_def {id} { - return [define {*}[rawdef $id]] + proc get_spec {id} { + set rdef [raw_def $id] + if {$rdef eq ""} {return} + return [resolve {*}$rdef] #if {[id_exists $id]} { - # return [define {*}[rawdef $id]] + # return [resolve {*}[raw_def $id]] #} } proc is_dynamic {id} { - set deflist [rawdef $id] - return [expr {[lindex $deflist 0] eq "-dynamic" && [lindex $deflist 1]} ] + variable id_cache_rawdef + variable rawdef_cache + set deflist [raw_def $id] + if {[dict exists $rawdef_cache $deflist -dynamic]} { + return [dict get $rawdef_cache $deflist -dynamic] + } + return [rawdef_is_dynamic $deflist] + #@dynamic only has meaning as 1st element of a def in the deflist + } + + #@id must be within first 4 lines of a block - or assign auto + #review - @dynamic block where -id not explicitly set? - disallow? + proc rawdef_id {rawdef} { + set id "" + foreach d $rawdef { + foreach ln [lrange [split $d \n] 0 4] { + if {[regexp {\s*(\S+)(.*)} $ln _match firstword rest]} { + if {$firstword eq "@id"} { + if {[llength $rest] %2 == 0 && [dict exists $rest -id]} { + set id [dict get $rest -id] + break + } + } + } + } + if {$id ne ""} { + break + } + } + if {$id eq "" || [string tolower $id] eq "auto"} { + variable id_counter + set id "autoid_[incr id_counter]" + } + #puts "==>id: $id" + return $id + } + #test the rawdef for @dynamic directive + proc rawdef_is_dynamic {rawdef} { + #temporary - old way + set flagged_dynamic [expr {[lindex $rawdef 0] eq "-dynamic" && [lindex $rawdef 1]} ] + if {$flagged_dynamic} { + return true + } + foreach d $rawdef { + if {[regexp {\s*(\S+)} $d _match firstword]} { + if {$firstword eq "@dynamic"} { + return true + } + } + } + return false } variable aliases @@ -1770,19 +2031,19 @@ tcl::namespace::eval punk::args { "exact id or glob pattern for ids" }] proc get_ids {{match *}} { - variable argdefcache_by_id + variable id_cache_rawdef variable aliases - return [list {*}[tcl::dict::keys $aliases $match] {*}[tcl::dict::keys $argdefcache_by_id $match]] + return [list {*}[tcl::dict::keys $aliases $match] {*}[tcl::dict::keys $id_cache_rawdef $match]] } #we don't automatically test for (autodef)$id - only direct ids and aliases proc id_exists {id} { - variable argdefcache_by_id variable aliases if {[tcl::dict::exists $aliases $id]} { return 1 } - tcl::dict::exists $argdefcache_by_id $id + variable id_cache_rawdef + tcl::dict::exists $id_cache_rawdef $id } proc set_alias {alias id} { variable aliases @@ -1800,16 +2061,18 @@ tcl::namespace::eval punk::args { } proc real_id {id} { - variable argdefcache_by_id + variable id_cache_rawdef variable aliases if {[tcl::dict::exists $aliases $id]} { set id [tcl::dict::get $aliases $id] } - if {[tcl::dict::exists $argdefcache_by_id $id]} { + if {[tcl::dict::exists $id_cache_rawdef $id]} { return $id } else { - if {![llength [update_definitions]]} { - if {[tcl::dict::exists $argdefcache_by_id (autodef)$id]} { + set check_updates [list [namespace qualifiers $id]] + if {![llength [update_definitions $check_updates]]} { + #nothing new loaded + if {[tcl::dict::exists $id_cache_rawdef (autodef)$id]} { return (autodef)$id } return "" @@ -1817,10 +2080,10 @@ tcl::namespace::eval punk::args { if {[tcl::dict::exists $aliases $id]} { set id [tcl::dict::get $aliases $id] } - if {[tcl::dict::exists $argdefcache_by_id $id]} { + if {[tcl::dict::exists $id_cache_rawdef $id]} { return $id } - if {[tcl::dict::exists $argdefcache_by_id (autodef)$id]} { + if {[tcl::dict::exists $id_cache_rawdef (autodef)$id]} { return (autodef)$id } return "" @@ -1828,42 +2091,188 @@ tcl::namespace::eval punk::args { } } - variable loaded_packages - set loaded_packages [list] + proc status {} { + upvar ::punk::args::register::NAMESPACES registered + upvar ::punk::args::register::loaded_packages loaded_packages + upvar ::punk::args::register::loaded_info loaded_info + upvar ::punk::args::register::scanned_packages scanned_packages + upvar ::punk::args::register::scanned_info scanned_info + set result "" + # [format %-${w0}s $idtail] + set widest [tcl::mathfunc::max {*}[lmap v [list {*}$registered "Registered"] {string length $v}]] + append result "[format %-${widest}s Registered] Scanned_ids Scantime_us Loaded_defs Loadtime_us" \n + set width_c2 [string length "Scanned_ids"] + set width_c3 [string length "Scantime_us"] + set width_c4 [string length "Loaded_defs"] + set width_c5 [string length "Loadtime_us"] + set count_unloaded 0 + set count_loaded 0 + foreach ns $registered { + if {$ns in $scanned_packages} { + set ids [dict get $scanned_info $ns idcount] + set scan_us [dict get $scanned_info $ns time] + } else { + set ids "" + set scan_us "" + } + if {$ns in $loaded_packages} { + incr count_loaded + set ldefs [dict get $loaded_info $ns defcount] + set load_us [dict get $loaded_info $ns time] + } else { + incr count_unloaded + set ldefs "" + set load_us "" + } + append result "[format %-${widest}s $ns] [format %${width_c2}s $ids] [format %${width_c3}s $scan_us] [format %${width_c4}s $ldefs] [format %${width_c5}s $load_us]" \n + } + append result "\nPackages - Registered: [llength $registered] Loaded: $count_loaded Unloaded: $count_unloaded" + return $result + } + + #scanned_packages (list) + #namespace_docpackages (dict) + proc update_definitions {{nslist *}} { + if {[set gposn [lsearch $nslist {}]] >= 0} { + lset nslist $gposn :: + } + upvar ::punk::args::register::NAMESPACES registered ;#list + upvar ::punk::args::register::loaded_packages loaded_packages ;#list + upvar ::punk::args::register::loaded_info loaded_info ;#dict + upvar ::punk::args::register::scanned_packages scanned_packages ;#list + upvar ::punk::args::register::scanned_info scanned_info ;#dict + upvar ::punk::args::register::namespace_docpackages namespace_docpackages ;#dict - proc update_definitions {} { + + #puts stderr "-->update_definitions '$nslist'" #needs to run quickly - especially when no package namespaces to be scanned for argdefs - #e.g - get's called for each subcommand of an ensemble (could be many) + #e.g - gets called for each subcommand of an ensemble (could be many) # It needs to get called in each arginfo call as we don't know what namespace origins or aliases may be involved in resolving a command. #we could possibly get away with not calling it for nested calls (such as with ensemble subcommands) but the code to avoid calls is probably more complex/slow than any gain avoiding the fast-path below. # -- --- --- --- --- --- # common-case fast-path - variable loaded_packages - upvar ::punk::args::register::NAMESPACES pkgs - if {[llength $loaded_packages] == [llength $pkgs]} { + + if {[llength $loaded_packages] == [llength $registered]} { #the only valid mechanism to add to 'loaded_packages' is with this function - so if lengths are equal, nothing to do. + #assert - if all are registered - then all have been scanned ( return {} } # -- --- --- --- --- --- - set unloaded [punklib_ldiff $pkgs $loaded_packages] + set unscanned [punklib_ldiff $registered $scanned_packages] + if {[llength $unscanned]} { + foreach pkgns $unscanned { + set idcount 0 + set ts_start [clock microseconds] + if {[info exists ${pkgns}::PUNKARGS]} { + set seen_documentedns [list] ;#seen per pkgns + foreach definitionlist [set ${pkgns}::PUNKARGS] { + #namespace eval $evalns [list punk::args::define {*}$definitionlist] + set id [rawdef_id $definitionlist] + if {[string match autoid_* $id]} { + puts stderr "update_definitions - unexpected autoid during scan of $pkgns - skipping" + puts stderr "definition:\n" + foreach d $definitionlist { + set out "" + foreach ln [split $d \n] { + append out " " $ln \n + } + puts $out + } + continue + } + #todo - detect duplicate ids (last will silently win.. should be reported somewhere) + incr idcount + set documentedns [namespace qualifiers $id] + if {$documentedns eq ""} {set documentedns ::} + if {$documentedns ni $seen_documentedns} { + #don't add own ns as a key in namespace_docpackages + if {$documentedns ne $pkgns} { + dict lappend namespace_docpackages $documentedns $pkgns + } + lappend seen_documentedns $documentedns + } + } + } + set ts_end [clock microseconds] + set diff [expr {$ts_end - $ts_start}] + dict set scanned_info $pkgns [dict create time $diff idcount $idcount] + #we count it as scanned even if PUNKARGS didn't exist + #(registered the namespace, variable PUNKARGS may or may not be declared, but didn't set PUNKARGS) + lappend scanned_packages $pkgns + } + } + + + + if {"*" in $nslist} { + set needed [punklib_ldiff $registered $loaded_packages] + } else { + set needed [list] + foreach pkgns $nslist { + if {$pkgns in $registered && $pkgns ni $loaded_packages} { + lappend needed $pkgns + } + #argdoc sub namespace is a standard place to put defs that match the namespace below + #(generally the PUNKARGS in a namespace should apply to own ns) + set docns ${pkgns}::argdoc + if {[namespace exists $docns]} { + if {($pkgns in $registered || $docns in $registered) && $docns ni $needed && $docns ni $loaded_packages} { + lappend needed $docns + } + } + if {[dict exists $namespace_docpackages $pkgns]} { + #this namespace has other argdef sources + foreach docns [dict get $namespace_docpackages $pkgns] { + if {$docns ni $loaded_packages} { + lappend needed $docns + } + } + } + } + } + + + set newloaded [list] - foreach pkgns $unloaded { - #puts -nonewline stderr . ;#debugging - see actual loads + foreach pkgns $needed { + #puts stderr "update_definitions Loading: $pkgns" + set ts_start [clock microseconds] + set def_count 0 if {![catch { if {[info exists ${pkgns}::PUNKARGS]} { + set docns ${pkgns}::argdoc + if {[namespace exists $docns]} { + namespace eval ${pkgns}::argdoc { + set epath [namespace path] + set pkgns [namespace parent] + if {$pkgns ni $epath} { + namespace path [list {*}$epath $pkgns] ;#add to tail + } + + } + set evalns $docns + } else { + set evalns $pkgns + } foreach definitionlist [set ${pkgns}::PUNKARGS] { - namespace eval $pkgns [list punk::args::define {*}$definitionlist] + namespace eval $evalns [list punk::args::define {*}$definitionlist] + incr def_count } } + + #process list of 2-element lists if {[info exists ${pkgns}::PUNKARGS_aliases]} { foreach adef [set ${pkgns}::PUNKARGS_aliases] { punk::args::set_alias {*}$adef } } } errMsg]} { + set ts_end [clock microseconds] + set diff [expr {$ts_end - $ts_start}] lappend loaded_packages $pkgns lappend newloaded $pkgns + dict set loaded_info $pkgns [dict create time $diff defcount $def_count] } else { puts stderr "punk::args::update_definitions error - failed to load PUNKARGS definitions for $pkgns\nerr:$errMsg" } @@ -1875,7 +2284,8 @@ tcl::namespace::eval punk::args { #This mechanism gets less-than-useful results for oo methods #e.g {$obj} proc Get_caller {} { - set call_level -3 + #set call_level -3 ;#for get_dict call + set call_level -4 set cmdinfo [tcl::dict::get [tcl::info::frame $call_level] cmd] #puts "-->$cmdinfo" #puts "-->[tcl::info::frame -3]" @@ -1918,7 +2328,7 @@ tcl::namespace::eval punk::args { @values -min 0 -max 0 }] proc test_get_dict {args} { - punk::args::get_dict {*}[punk::args::rawdef ::punk::args::test1] $args + punk::args::get_dict {*}[punk::args::raw_def ::punk::args::test1] $args } proc test_get_by_id {args} { punk::args::get_by_id ::punk::args::test1 $args @@ -1960,22 +2370,22 @@ tcl::namespace::eval punk::args { " @leaders -min 2 -max 2 msg -type string -help\ - "error message to display immediately prior to usage table. - May be empty string to just display usage. + "Error message to display immediately prior to usage table. + May be empty string to just display usage. " spec_dict -type dict -help\ - "Dictionary of argument specifications. - This is the internal format parsed from - the textual definition. It contains the data - organised/optimised to allow the final arg - parser/validator to make decisions. + "Dictionary of argument specifications. + This is the internal format parsed from + the textual definition. It contains the data + organised/optimised to allow the final arg + parser/validator to make decisions. " @opts -badarg -type string -help\ "name of an argument to highlight" -aserror -type boolean -help\ - "If true, the usage table is raised as an error message, - otherwise it is returned as a value." + "If true, the usage table is raised as an error message, + otherwise it is returned as a value." -return -choices {string table tableobject} -choicelabels { string "no table layout" tableobject "table object cmd" @@ -2133,6 +2543,8 @@ tcl::namespace::eval punk::args { } + #set RST [a] + set RST "\x1b\[m" set t "" ;#possible oo table object - may be tested for objectiness at the end so needs to exist. #REVIEW - risk of accidental indefinite recursion if functions used here also use punk::args::get_dict and there is an argument error @@ -2158,7 +2570,7 @@ tcl::namespace::eval punk::args { append errmsg \n } else { if {($returntype in {table tableobject}) && !$has_textblock} { - append errmsg \n "$CLR(errormsg)(layout package textblock is missing)[a]" \n + append errmsg \n "$CLR(errormsg)(layout package textblock is missing)$RST" \n } else { append errmsg \n } @@ -2181,7 +2593,7 @@ tcl::namespace::eval punk::args { set blank_header_col [list] if {$cmdname ne ""} { lappend blank_header_col "" - set cmdname_display $CLR(cmdname)$cmdname[a] + set cmdname_display $CLR(cmdname)$cmdname$RST } else { set cmdname_display "" } @@ -2194,7 +2606,7 @@ tcl::namespace::eval punk::args { } if {$docurl ne ""} { lappend blank_header_col "" - set docurl_display [a+ white]$docurl[a] + set docurl_display [a+ white]$docurl$RST } else { set docurl_display "" } @@ -2216,7 +2628,7 @@ tcl::namespace::eval punk::args { lappend blank_header_col "" } if {$use_table} { - set t [textblock::class::table new $CLR(title)Usage[a]] + set t [textblock::class::table new "$CLR(title)Usage$RST"] $t add_column -headers $blank_header_col -minwidth 3 $t add_column -headers $blank_header_col @@ -2295,19 +2707,18 @@ tcl::namespace::eval punk::args { #potentially require coordination with header colspans? $t add_row [list "" $argdisplay_body] } else { - if {$argdisplay_header ne "" + if {$argdisplay_header ne ""} { lappend errlines $argdisplay_header } lappend errlines {*}$argdisplay_body } } else { - set RST [a] #set A_DEFAULT [a+ brightwhite Brightgreen] set A_DEFAULT "" set A_BADARG $CLR(badarg) - set greencheck $CLR(check)\u2713[a] ;#green tick - set soloflag $CLR(solo)\u2690[a] ;#flag - may be replacement char in old dos prompt (?) + set greencheck $CLR(check)\u2713$RST ;#green tick + set soloflag $CLR(solo)\u2690$RST ;#flag - may be replacement char in old dos prompt (?) set A_PREFIX $CLR(choiceprefix) ;#use a+ so colour off can apply if {$A_PREFIX eq "" || $A_PREFIX eq [a+ underline]} { #A_PREFIX can resolve to empty string if colour off @@ -2380,6 +2791,11 @@ tcl::namespace::eval punk::args { set allchoices_originalcase [list] set choices [Dict_getdef $arginfo -choices {}] set choicegroups [Dict_getdef $arginfo -choicegroups {}] + set choicemultiple [dict get $arginfo -choicemultiple] + if {[string is integer -strict $choicemultiple]} { + set choicemultiple [list $choicemultiple $choicemultiple] + } + lassign $choicemultiple choicemultiple_min choicemultiple_max set choicecolumns [Dict_getdef $arginfo -choicecolumns 4] set choiceprefixdenylist [Dict_getdef $arginfo -choiceprefixdenylist {}] if {[Dict_getdef $arginfo -multiple 0]} { @@ -2416,6 +2832,17 @@ tcl::namespace::eval punk::args { set choicelabeldict [Dict_getdef $arginfo -choicelabels {}] set formattedchoices [dict create] ;#use dict rather than array to preserve order append help " Choices$prefixmsg$casemsg" + if {$choicemultiple_max > 1 || $choicemultiple_max == -1} { + if {$choicemultiple_max == -1} { + append help \n " The value can be a list of $choicemultiple_min or more of these choices" + } else { + if {$choicemultiple_min eq $choicemultiple_max} { + append help \n " The value must be a list of $choicemultiple_min of these choices" + } else { + append help \n " The value can be a list of $choicemultiple_min to $choicemultiple_max of these choices" + } + } + } if {![dict get $arginfo -choiceprefix] || [catch {package require punk::trie}]} { #append help "\n " [join [dict get $arginfo -choices] "\n "] if {[dict size $choicelabeldict]} { @@ -2513,7 +2940,7 @@ tcl::namespace::eval punk::args { #append help \n[textblock::join -- " " [$choicetableobj print]] } else { if {$groupname ne ""} { - append help \n \n "$CLR(groupname)Group: $groupname[a]" + append help \n \n "$CLR(groupname)Group: $groupname$RST" } else { append help \n } @@ -2527,15 +2954,15 @@ tcl::namespace::eval punk::args { if {$usetable} { #these will be displayed after all table entries if {$groupname eq ""} { - dict set choicetable_footers "" " $CLR(errormsg)(no choices defined for main group)[a]" + dict set choicetable_footers "" " $CLR(errormsg)(no choices defined for main group)$RST" } else { - dict set choicetable_footers $groupname " $CLR(errormsg)(no choices defined for group $groupname)[a]" + dict set choicetable_footers $groupname " $CLR(errormsg)(no choices defined for group $groupname)$RST" } } else { if {$groupname eq ""} { - append help \n " " $CLR(errormsg)(no choices defined)[a] + append help \n " " $CLR(errormsg)(no choices defined)$RST } else { - append help \n " " $CLR(errormsg)(no choices defined for group $groupname)[a] + append help \n " " $CLR(errormsg)(no choices defined for group $groupname)$RST } } } @@ -2561,7 +2988,7 @@ tcl::namespace::eval punk::args { $obj destroy } if {[dict size $choicetable_footers]} { - foreach groupname [dict keys $formattedchoices { + foreach groupname [dict keys $formattedchoices] { if {[dict exists $choicetable_footers $groupname]} { append help \n [dict get $choicetable_footers $groupname] } @@ -2570,6 +2997,7 @@ tcl::namespace::eval punk::args { #review. use -type to restrict additional choices - may be different to values in the -choices if {![dict get $arginfo -choicerestricted]} { + #when -choicemultiple - the -type refers to each selection if {[dict get $arginfo -type] eq "string"} { append help "\n (values not in defined choices are allowed)" } else { @@ -2609,7 +3037,7 @@ tcl::namespace::eval punk::args { } } else { #review - formatting will be all over the shop due to newlines in typesshow, help - set arghelp "[a+ bold]$argshow[a] TYPE:$typeshow DEFAULT:$default MULTI:$multiple\n" + set arghelp "[a+ bold]$argshow$RST TYPE:$typeshow DEFAULT:$default MULTI:$multiple\n" foreach ln [split $help \n] { append arghelp " $ln" \n } @@ -2666,35 +3094,40 @@ tcl::namespace::eval punk::args { } - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + @dynamic @id -id ::punk::args::usage @cmd -name punk::args::usage -help\ - "Return usage information for a command. + "Return usage information for a command identified by an id. + This will only work for commands where a punk::args definition exists - for the command and an id has been defined for it. + for the command and an id has been defined for it. The id for custom + help for a command should match the fully qualified name of the command. + Many commands (such as ensembles and oo objects) may have argument - documentation generated dynamically and not have an id. + documentation generated dynamically and may not yet have an id. + IDs for autogenenerated help are prefixed e.g (autodef)::myensemble. + Generally punk::ns::arginfo (aliased as i in the punk shell) should be used in preference - as it will search for a documentation - mechanism and call this as necessary. + mechanism and call punk::args::usage as necessary. " -return -default table -choices {string table tableobject} - } {${[punk::args::resolved_def -type @opts ::punk::args::arg_error -scheme]}} { + } {${[punk::args::resolved_def -types opts ::punk::args::arg_error -scheme]}} { @values -min 0 -max 1 id -help\ - "exact id. - Will usually match the command name" + "Exact id. + Will usually match the command name" }] proc usage {args} { lassign [dict values [punk::args::get_by_id ::punk::args::usage $args]] leaders opts values received set id [dict get $values id] - set definitionlist [rawdef $id] - if {[llength $definitionlist] == 0} { + set real_id [real_id $id] + if {$real_id eq ""} { error "punk::args::usage - no such id: $id" } - #by placing scheme before the supplied args - it can be overridden - arg_error "" [uplevel 1 [list punk::args::define {*}$definitionlist]] -scheme punk_info {*}$opts -aserror 0 + arg_error "" [punk::args::get_spec $real_id] -scheme punk_info {*}$opts -aserror 0 } lappend PUNKARGS [list { @@ -2704,13 +3137,13 @@ tcl::namespace::eval punk::args { id arglist -type list -help\ "list containing arguments to be parsed as per the - argument specification identified by the supplied id." + argument specification identified by the supplied id." }] #deprecate? proc get_by_id {id arglist} { - set definitionlist [punk::args::rawdef $id] + set definitionlist [punk::args::raw_def $id] if {[llength $definitionlist] == 0} { error "punk::args::get_by_id - no such id: $id" } @@ -2734,62 +3167,86 @@ tcl::namespace::eval punk::args { @cmd -name punk::args::parse -help\ "parse and validate command arguments based on a definition. - In the 'withid' form the definition is a pre-existing - record that has been created with ::punk::args::define. - In the 'withdef' form - the definition is created on the - first call and cached thereafter. + In the 'withid' form the definition is a pre-existing record that has been + created with ::punk::args::define, or indirectly by adding a definition to + the PUNKARGS variable in a namespace which is then registered in + punk::args::register::NAMESPACES, or by a previous call to punk::parse + using 'withdef' and a definition block containing an @id -id directive. + + In the 'withdef' form - the definition is created on the first call and + cached thereafter, if the id didn't already exist. - form1: parse ?-flag val?... -- $arglist withid $id - form2: parse ?-flag val?... -- $arglist withdef $def ?$def? + form1: parse $arglist ?-flag val?... withid $id + form2: parse $arglist ?-flag val?... withdef $def ?$def? see punk::args::define" + @form -form {withid withdef} + @leaders -min 1 -max 1 + arglist -type list -optional 0 -help\ + "Arguments to parse - supplied as a single list" + @opts - -form -type list -default * -help\ + -form -type list -default * -help\ "Restrict parsing to the set of forms listed. - Forms are the orthogonal sets of arguments a - command can take - usually described in 'synopsis' - entries. - " + Forms are the orthogonal sets of arguments a + command can take - usually described in 'synopsis' + entries." #default to enhanced errorstyle despite slow 'catch' (unhappy path) performance #todo - configurable per interp/namespace - -errorstyle -type string -default enhanced -choices {enhanced standard minimal} - @values -min 3 - sep -optional 0 -choices "--" + -errorstyle -type string -default enhanced -choices {enhanced standard minimal} + @values -min 2 - @form -form withid -synopsis "parse ?-form {int|...}? ?-errorstyle ? -- withid $id" + @form -form withid -synopsis "parse arglist ?-form {int|...}? ?-errorstyle ? withid $id" withid -type literal -help\ "The literal value 'withid'" id -type string -help\ "id of punk::args definition for a command" - @form -form withdef -synopsis "parse ?-form {int|...}? ?-errorstyle ? -- withdef $def ?$def?" + @form -form withdef -synopsis "parse arglist ?-form {int|...}? ?-errorstyle ? withdef $def ?$def?" withdef -type literal -help\ "The literal value 'withdef'" + + #todo - make -dynamic obsolete - use @dynamic directive instead def -type string -multiple 1 -optional 0 -help\ "Each remaining argument is a block of text - defining argument definitions. - As a special case, -dynamic may be - specified as the 1st 2 arguments. These are - not treated as an indicator to punk::args - about how to process the definition." + defining argument definitions. + As a special case, -dynamic may be + specified as the 1st 2 arguments. These are + treated as an indicator to punk::args about + how to process the definition." }] proc parse {args} { set tailtype "" ;#withid|withdef - set split [lsearch -exact $args --] ;#first -- + if {[llength $args] < 3} { + error "punk::args::parse - invalid call. < 3 args" + } + set parseargs [lindex $args 0] + set tailargs [lrange $args 1 end] + + set split [lsearch -exact $tailargs withid] if {$split < 0} { - #punk::args::usage arg_error? - error "punk::args::parse - invalid call. End of opts marker -- is required even if no options are present." + set split [lsearch -exact $tailargs withdef] + if {$split < 0} { + #punk::args::usage arg_error? + error "punk::args::parse - invalid call. keyword withid|withdef required" + } else { + set tailtype withdef + } + } else { + set tailtype withid + } + + set opts [lrange $tailargs 0 $split-1] ;#repeated flags will override earlier. That's ok here. + if {[llength $opts] % 2} { + error "punk::args::parse Even number of -flag val pairs required after arglist" } - set opts [lrange $args 0 $split-1] ;#repeated flags will override earlier. That's ok here. - set arglist [lindex $args $split+1] - set tailtype [lindex $args $split+2] set defaultopts [dict create\ -form {*}\ -errorstyle enhanced\ ] - + set opts [dict merge $opts $defaultopts] dict for {k v} $opts { switch -- $k { -form - -errorstyle { @@ -2802,24 +3259,43 @@ tcl::namespace::eval punk::args { } switch -- $tailtype { withid { - if {[llength [lrange $args $split+3 end]] != 1} { + if {[llength [lrange $tailargs $split+1 end]] != 1} { error "punk::args::parse - invalid call. Expected exactly one argument after 'withid'" } - set id [lindex $args $split+3] - return "parse [llength $arglist] args withid $id, options:$opts" + set id [lindex $tailargs $split+1] + #puts stdout "punk::args::parse [llength $parseargs] args withid $id, options: $opts" + set deflist [raw_def $id] + if {[llength $deflist] == 0} { + error "punk::args::parse - no such id: $id" + } } withdef { - set deflist [lrange $args $split+3 end] + set deflist [lrange $tailargs $split+1 end] if {[llength $deflist] < 1} { error "punk::args::parse - invalid call. Expected at least one argument after 'withdef'" } - return "parse [llength $arglist] with [llength $deflist] definition blocks, options:$opts" + #puts stdout "punk::args::parse [llength $parseargs] args with [llength $deflist] definition blocks, options: $opts" } default { error "punk::args::parse - invalid call. Argument following arglist must be 'withid' or 'withdef'" } } - + try { + set result [punk::args::get_dict {*}$deflist $parseargs] + } trap {PUNKARGS} {msg opts} { + #trap punk::args argument validation/parsing errors and decide here + #whether to display basic error - or full usage if configured. + puts stderr "PUNKARGS: $msg\n$opts" + return + } trap {} {msg opts} { + #review + #puts stderr "$msg\n$opts" + #quote from DKF: The reason for using return -code error vs error or throw depends on where the error is. If the problem is in your code, use error or throw. + #If the problem is in your caller (e.g., because they gave you bad arguments) then use return -code error. Simple. + throw [dict get $opts -errorcode] [dict get $opts -errorinfo] + return + } + return $result } proc parseXXX {args} { #no solo flags allowed for parse function itself. (ok for arglist being parsed) @@ -2920,19 +3396,14 @@ tcl::namespace::eval punk::args { # @values -multiple 1 #} $args - set is_dynamic 0 - if {[lindex $args 0] eq "-dynamic"} { - set is_dynamic [lindex $args 1] - } set rawargs [lindex $args end] ;# args values to be parsed - #we take a definition list rather than argspecs - because the definition could be dynamic set definition_args [lrange $args 0 end-1] #if definition has been seen before, #define will either return a permanently cached argspecs (-dynamic 0) - or # use a cached pre-split definition with parameters to dynamically generate a new (or limitedly cached?) argspecs. - set argspecs [uplevel 1 [list ::punk::args::define {*}$definition_args]] + set argspecs [uplevel 1 [list ::punk::args::resolve {*}$definition_args]] # ----------------------------------------------- # Warning - be aware of all vars thrown into this space (from tail end of 'definition' proc) @@ -3397,22 +3868,22 @@ tcl::namespace::eval punk::args { #puts "---opts_and_values:$opts_and_values" #puts "---argstate:$argstate" tcl::dict::for {argname v} $opts_and_values { - set thisarg [tcl::dict::get $argstate $argname] - #set thisarg_keys [tcl::dict::keys $thisarg] - set thisarg_checks [tcl::dict::get $arg_checks $argname] - set is_multiple [tcl::dict::get $thisarg -multiple] - set is_allow_ansi [tcl::dict::get $thisarg -allow_ansi] - set is_validate_ansistripped [tcl::dict::get $thisarg -validate_ansistripped] - set is_strip_ansi [tcl::dict::get $thisarg -strip_ansi] - set has_default [tcl::dict::exists $thisarg -default] + set thisarg [tcl::dict::get $argstate $argname] + #set thisarg_keys [tcl::dict::keys $thisarg] + set thisarg_checks [tcl::dict::get $arg_checks $argname] + set is_multiple [tcl::dict::get $thisarg -multiple] + set is_allow_ansi [tcl::dict::get $thisarg -allow_ansi] + set is_validate_ansistripped [tcl::dict::get $thisarg -validate_ansistripped] + set is_strip_ansi [tcl::dict::get $thisarg -strip_ansi] + set has_default [tcl::dict::exists $thisarg -default] if {$has_default} { set defaultval [tcl::dict::get $thisarg -default] } - set type [tcl::dict::get $thisarg -type] - set has_choices [expr {[tcl::dict::exists $thisarg -choices] || [tcl::dict::exists $thisarg -choicegroups]}] - set regexprepass [tcl::dict::get $thisarg -regexprepass] - set regexprefail [Dict_getdef $thisarg -regexprefail ""] ;#aliased to dict getdef in tcl9 - set validationtransform [tcl::dict::get $thisarg -validationtransform] + set type [tcl::dict::get $thisarg -type] + set has_choices [expr {[tcl::dict::exists $thisarg -choices] || [tcl::dict::exists $thisarg -choicegroups]}] + set regexprepass [tcl::dict::get $thisarg -regexprepass] + set regexprefail [Dict_getdef $thisarg -regexprefail ""] ;#aliased to dict getdef in tcl9 + set validationtransform [tcl::dict::get $thisarg -validationtransform] if {$is_multiple} { @@ -3443,13 +3914,18 @@ tcl::namespace::eval punk::args { set choiceprefix [tcl::dict::get $thisarg -choiceprefix] set choiceprefixdenylist [Dict_getdef $thisarg -choiceprefixdenylist {}] set choicerestricted [tcl::dict::get $thisarg -choicerestricted] + set choicemultiple [tcl::dict::get $thisarg -choicemultiple] + if {[string is integer -strict $choicemultiple]} { + set choicemultiple [list $choicemultiple $choicemultiple] + } + lassign $choicemultiple choicemultiple_min choicemultiple_max set nocase [tcl::dict::get $thisarg -nocase] set choices [Dict_getdef $thisarg -choices {}] set choicegroups [Dict_getdef $thisarg -choicegroups {}] set allchoices $choices if {[dict size $choicegroups]} { - dict for {groupname clist} $choicegroups { - lappend allchoices {*}$clist + dict for {groupname groupmembers} $choicegroups { + lappend allchoices {*}$groupmembers } } #note we can legitimately have dups in allchoices - if a choice should be documented to display in multiple groups @@ -3468,115 +3944,159 @@ tcl::namespace::eval punk::args { } } set idx 0 ;# - #opts/values_dict $argname member has been populated with the actual entered choices - which might be prefixes + #leaders_dict/opts/values_dict $argname member has been populated with the actual entered choices - which might be prefixes #assert llength $vlist == llength [dict get $dname $argname] # (unless there was a default and the option wasn't specified) set vlist_validate [list] set vlist_check_validate [list] foreach e $vlist e_check $vlist_check { - if {$nocase} { - set casemsg " (case insensitive)" - set choices_test [tcl::string::tolower $allchoices] - #Don't lcase the denylist - even in nocase mode! - #set choiceprefixdenylist [tcl::string::tolower $choiceprefixdenylist] - set v_test [tcl::string::tolower $e_check] + set allchoices_in_list 0 + if {$choicemultiple_max > 1 || $choicemultiple_max == -1} { + #vlist and vlist_check can be list of lists if -multiple and -choicemultiple + #each e represents 0 or more choice selections + set c_list $e + set c_check_list $e_check + #todo? check if entire list matches default? } else { - set casemsg " (case sensitive)" - set v_test $e_check - set choices_test $allchoices + #only one choice at a time - ensure single entry in c_list c_check_list + set c_list [list $e] + set c_check_list [list $e_check] } - set choice_in_list 0 - set matches_default [expr {$has_default && $e eq $defaultval}] - if {!$matches_default} { - if {$choiceprefix} { - #can we handle empty string as a choice? It should just work - REVIEW/test - set choice_exact_match 0 - if {$e_check in $allchoices} { - #for case when there are case-differenced duplicates - allow exact match to avoid selecting earlier match of another casing - set chosen $e_check - set choice_in_list 1 - set choice_exact_match 1 - } elseif {$v_test in $choices_test} { - set chosen $v_test - set choice_in_list 1 - } else { - #PREFIX check required - any 'chosen' here is not an exact match or it would have matched above. - #assert - if empty string was a provided choice and empty string was a provided arg - we would have matched above. - #in this block we can treat empty result from prefix match as a non-match - if {$nocase} { - #nocase implies that our entered value doesn't have to match case of choices - - #but we would still like to select the best match if there are case-dups. - #e.g arg -choices {delete Delete} -nocase 1 -choiceprefixdenylist delete - # selecting Del will find Delete, del will match delete (and raise error) - # but DEL will also match delete rather than Delete - so again an error is raised. - #This is counterintuitive with -nocase - #This is probably such an edge case that best served with documentation as a feature-not-bug - #Rationale being that in a nocase situation it's arbitrary/counterintuitive to consider DEL, or DeL a better match for Delete than delete? - #The choice of the user to use -choiceprefixdenylist along with case-dups is the issue. - - set bestmatch [tcl::prefix::match -error "" [lsort -unique $allchoices] $e_check] - if {$bestmatch eq ""} { - set chosen [tcl::prefix::match -error "" [lsort -unique $choices_test] $v_test] - set choice_in_list [expr {$chosen ne ""}] - #we + + + #----------------------------------- + #fast fail on the wrong number of choices + if {[llength $c_list] < $choicemultiple_min} { + set msg "Option $argname for [Get_caller] requires at least $choicemultiple_min choices. Received [llength $c_list] choices." + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list choicecount [llength $c_list] minchoices $choicemultiple_min maxchoices $choicemultiple_max] -badarg $argname]] $msg + } + if {$choicemultiple_max != -1 && [llength $c_list] > $choicemultiple_max} { + set msg "Option $argname for [Get_caller] requires at most $choicemultiple_max choices. Received [llength $c_list] choices." + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list choicecount [llength $c_list] minchoices $choicemultiple_min maxchoices $choicemultiple_max] -badarg $argname]] $msg + } + #----------------------------------- + + set choice_idx 0 ;#we need to overwrite raw-choice (which may be prefix) with a value from the choice list + foreach c $c_list c_check $c_check_list { + if {$nocase} { + set casemsg " (case insensitive)" + set choices_test [tcl::string::tolower $allchoices] + #Don't lcase the denylist - even in nocase mode! + #set choiceprefixdenylist [tcl::string::tolower $choiceprefixdenylist] + set v_test [tcl::string::tolower $c_check] + } else { + set casemsg " (case sensitive)" + set v_test $c_check + set choices_test $allchoices + } + set choice_in_list 0 + set matches_default [expr {$has_default && $c eq $defaultval}] ;# defaultval when -choicemultiple could be a list? + if {!$matches_default} { + if {$choiceprefix} { + #can we handle empty string as a choice? It should just work - REVIEW/test + set choice_exact_match 0 + if {$c_check in $allchoices} { + #for case when there are case-differenced duplicates - allow exact match to avoid selecting earlier match of another casing + set chosen $c_check + set choice_in_list 1 + set choice_exact_match 1 + } elseif {$v_test in $choices_test} { + set chosen $v_test + set choice_in_list 1 + } else { + #PREFIX check required - any 'chosen' here is not an exact match or it would have matched above. + #assert - if empty string was a provided choice and empty string was a provided arg - we would have matched above. + #in this block we can treat empty result from prefix match as a non-match + if {$nocase} { + #nocase implies that our entered value doesn't have to match case of choices - + #but we would still like to select the best match if there are case-dups. + #e.g arg -choices {delete Delete} -nocase 1 -choiceprefixdenylist delete + # selecting Del will find Delete, del will match delete (and raise error) + # but DEL will also match delete rather than Delete - so again an error is raised. + #This is counterintuitive with -nocase + #This is probably such an edge case that best served with documentation as a feature-not-bug + #Rationale being that in a nocase situation it's arbitrary/counterintuitive to consider DEL, or DeL a better match for Delete than delete? + #The choice of the user to use -choiceprefixdenylist along with case-dups is the issue. + + set bestmatch [tcl::prefix::match -error "" [lsort -unique $allchoices] $c_check] + if {$bestmatch eq ""} { + set chosen [tcl::prefix::match -error "" [lsort -unique $choices_test] $v_test] + #now pick the earliest match in the actually defined list so that case of chosen always matches a defined entry with casing + set chosen [lsearch -inline -nocase $allchoices $chosen] + set choice_in_list [expr {$chosen ne ""}] + } else { + set chosen $bestmatch + set choice_in_list 1 + } } else { - set chosen $bestmatch - set choice_in_list 1 + set chosen [tcl::prefix::match -error "" [lsort -unique $allchoices] $c_check] + if {$chosen eq ""} { + set choice_in_list 0 + } else { + set choice_in_list 1 + } } - } else { - set chosen [tcl::prefix::match -error "" [lsort -unique $allchoices] $e_check] - if {$chosen eq ""} { + #override choice_in_list if in deny list + #don't allow prefixing for elements from -choiceprefixdenylist + #we still use all elements to calculate the prefixes though + #review - case difference edge cases in choiceprefixdenylist !todo + if {$chosen in $choiceprefixdenylist} { set choice_in_list 0 - } else { - set choice_in_list 1 + set chosen "" } } - #override choice_in_list if in deny list - #don't allow prefixing for elements from -choiceprefixdenylist - #we still use all elements to calculate the prefixes though - #review - case difference edge cases in choiceprefixdenylist !todo - if {$chosen in $choiceprefixdenylist} { - set choice_in_list 0 - set chosen "" - } - } - if {$choice_in_list && !$choice_exact_match} { - if {$is_multiple} { - set existing [tcl::dict::get [set $dname] $argname] - lset existing $idx $chosen - tcl::dict::set $dname $argname $existing - } else { - tcl::dict::set $dname $argname $chosen + if {$choice_in_list && !$choice_exact_match} { + if {$choicemultiple_max != -1 && $choicemultiple_max < 2} { + if {$is_multiple} { + set existing [tcl::dict::get [set $dname] $argname] + lset existing $idx $chosen + tcl::dict::set $dname $argname $existing + } else { + tcl::dict::set $dname $argname $chosen + } + } else { + if {$is_multiple} { + set existing_all [tcl::dict::get [set $dname] $argname] + lset existing_all $idx $choice_idx $chosen + tcl::dict::set $dname $argname $existing_all + } else { + set existing [tcl::dict::get [set $dname] $argname] + lset existing $choice_idx $chosen + tcl::dict::set $dname $argname $existing + } + } } + } else { + #value as stored in $dname is ok + set choice_in_list [expr {$v_test in $choices_test}] } - } else { - #value as stored in $dname is ok - set choice_in_list [expr {$v_test in $choices_test}] } - } - if {!$choice_in_list && !$matches_default} { - if {!$choicerestricted} { - #if {$is_multiple} { - # set existing [tcl::dict::get [set $dname] $argname] - # lset existing $idx $v_test - # tcl::dict::set $dname $argname $existing - #} else { - # tcl::dict::set $dname $argname $v_test - #} - lappend vlist_validate $e - lappend vlist_check_validate $e_check - } else { - #unhappy path - if {$choiceprefix} { - set prefixmsg " (or a unique prefix of a value)" + if {!$choice_in_list && !$matches_default} { + if {!$choicerestricted} { + #if {$is_multiple} { + # set existing [tcl::dict::get [set $dname] $argname] + # lset existing $idx $v_test + # tcl::dict::set $dname $argname $existing + #} else { + # tcl::dict::set $dname $argname $v_test + #} + lappend vlist_validate $c + lappend vlist_check_validate $c_check } else { - set prefixmsg "" + #unhappy path + if {$choiceprefix} { + set prefixmsg " (or a unique prefix of a value)" + } else { + set prefixmsg "" + } + arg_error "Option $argname for [Get_caller] must be one of the listed values:\n [join $allchoices "\n "]\n$casemsg$prefixmsg. Received: '$c'" $argspecs -badarg $argname } - arg_error "Option $argname for [Get_caller] must be one of the listed values:\n [join $allchoices "\n "]\n$casemsg$prefixmsg. Received: '$e'" $argspecs -badarg $argname } + incr choice_idx } + incr idx } #reduce our vlist and vlist_check lists by removing choice matches as they need to be passed through without validation @@ -3588,10 +4108,11 @@ tcl::namespace::eval punk::args { if {[llength $vlist] && $has_default} { set vlist_validate [list] set vlist_check_validate [list] - foreach e $vlist e_check $vlist_check { - if {$e_check ne $defaultval} { - lappend vlist_validate $e - lappend vlist_check_validate $e + foreach c $vlist c_check $vlist_check { + #for -choicemultiple with default that could be a list use 'ni' ?? review + if {$c_check ne $defaultval} { + lappend vlist_validate $c + lappend vlist_check_validate $c } } set vlist $vlist_validate @@ -3854,7 +4375,12 @@ tcl::namespace::eval punk::args { xdigit { foreach e $vlist e_check $vlist_check { if {![tcl::string::is $type $e_check]} { - arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e'" $argspecs -badarg $argname + set msg "Option $argname for [Get_caller] requires type '$type'. Received: '$e'" + #try trap? + #return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type]]] $result + #throw ? + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list typemismatch $type] -badarg $argname]] $msg + arg_error $msg $argspecs -badarg $argname } } } @@ -4012,59 +4538,104 @@ tcl::namespace::eval punk::args::lib { lappend PUNKARGS [list { @id -id ::punk::args::lib::tstr @cmd -name punk::args::lib::tstr -help\ - "A rough equivalent of js template literals" + "A rough equivalent of js template literals + + Substitutions: + \$\{$varName\} + \$\{[myCommand]\} + (when -allowcommands flag is given)" -allowcommands -default 0 -type none -help\ - "if -allowcommands is present, placeholder can contain commands - e.g {\$\{plaintext0 [lindex $var 0] plaintext2\}}" - -return -default list -choices {dict list string args}\ + "If -allowcommands is present, placeholder can contain commands + e.g {\$\{plaintext0 [lindex $var 0] plaintext2\}}" + -undent -default 1 -type boolean -help\ + "undent/dedent the template lines. + The longest common prefix of whitespace is removed" + -indent -default "" -type string -help\ + "String with which to indent the template + prior to substitution. + If -undent is enabled, that is performed + first, then the indent is applied." + -paramindents -default line -choices {none line position} -choicelabels { + line\ + " Use leading whitespace in + the line in which the + placeholder occurs." + position\ + " Use the position in + the line in which the + placeholder occurs." + none\ + " No indents applied to + subsequent placeholder value + lines. This will usually + result in text awkwardly + ragged unless the source code + has also been aligned with the + left margin or the value has + been manually padded." + } -help\ + "How indenting is done for subsequent lines in a + multi-line placeholder substitution value. + The 1st line or a single line value is always + placed at the placeholder. + paramindents are performed after the main + template has been indented/undented. + (indenting by position does not calculate + unicode double-wide or grapheme cluster widths) + " + #choicelabels indented by 1 char is clearer for -return string - and reasonable in table + -return -default string -choices {dict list string args}\ -choicelabels { dict\ - "Return a dict with keys - 'template', 'params' and - 'errors'" - string\ - "Return a single result - being the string with - placeholders substituted." - list\ - "Return a 2 element list. - The first is itself a list - of plaintext portions of the - template, split at each point - at which placeholders were - present. The second element - of the outer list is a list - of placeholder values if -eval - is 1, or a list of the raw - placeholder strings if -eval - is 0." - args\ - "Return a list where the first - element is a list of template - plaintext sections as per the - 'list' return mechanism, but the - placeholder items are individual - items in the returned list. - This can be useful when passing - the expanded result of a tstr - command to another function - which expects the placeholders - as individual arguments" + " Return a dict with keys + 'template', 'params' and + 'errors'" + string\ + " Return a single result + being the string with + placeholders substituted." + list\ + " Return a 2 element list. + The first is itself a list + of plaintext portions of the + template, split at each point + at which placeholders were + present. The second element + of the outer list is a list + of placeholder values if -eval + is 1, or a list of the raw + placeholder strings if -eval + is 0." + args\ + " Return a list where the first + element is a list of template + plaintext sections as per the + 'list' return mechanism, but the + placeholder items are individual + items in the returned list. + This can be useful when passing + the expanded result of a tstr + command to another function + which expects the placeholders + as individual arguments" } -eval -default 1 -type boolean -help\ "Whether to evaluate the \$\{\} placeholders. - When -return is string, -eval should generally be set to 1. - For a string return, -eval 0 will result in the raw contents of \$\{\} being substituted. - contained variables in that case should be braced, or the variable name is likely to collide - with surrounding text. - e.g tstr -return string -eval 0 {plaintext\$\{\$\{var\}\}plaintext} -> plaintext\$\{var\}plaintext" + When -return is string, -eval should generally be set to 1. + For a string return, -eval 0 will result in the raw contents of \$\{\} being substituted. + contained variables in that case should be braced or whitespace separated, or the variable + name is likely to collide with surrounding text. + e.g tstr -return string -eval 0 {plaintext\$\{\$\{var\}\}plaintext} -> plaintext\$\{var\}plaintext" @values -min 0 -max 1 templatestring -help\ "This argument should be a braced string containing placeholders such as \$\{$var\} e.g {The value is \$\{$var\}.} - where $var will be substituted from the calling context - The placeholder itself can contain plaintext portions as well as variables. - It can contain commands in square brackets if -allowcommands is true - e.g tstr -return string -allowcommands {Tcl Version:\$\{[info patch]\} etc}" + where $var will be substituted from the calling context + The placeholder itself can contain plaintext portions as well as variables. + It can contain commands in square brackets if -allowcommands is true + e.g tstr -return string -allowcommands {Tcl Version:\$\{[info patch]\} etc} + + Escape sequences such as \\n and unicode escapes are processed within placeholders. + " }] proc tstr {args} { @@ -4080,8 +4651,11 @@ tcl::namespace::eval punk::args::lib { set arglist [lrange $args 0 end-1] set opts [dict create\ -allowcommands 0\ + -undent 1\ + -indent ""\ + -paramindents line\ -eval 1\ - -return list\ + -return string\ ] if {"-allowcommands" in $arglist} { set arglist [::punk::args::system::punklib_ldiff $arglist -allowcommands] @@ -4089,21 +4663,21 @@ tcl::namespace::eval punk::args::lib { } if {[llength $arglist] % 2 != 0} { if {[info commands ::punk::args::get_by_id] ne ""} { - punk::args::get_by_id ::punk::args::tstr $args + punk::args::get_by_id ::punk::args::lib::tstr $args return } else { error "punk::args::lib::tstr expected option/value pairs prior to last argument" } } dict for {k v} $arglist { - set fullk [tcl::prefix::match -error "" {-allowcommands -return -eval} $k] + set fullk [tcl::prefix::match -error "" {-allowcommands -indent -undent -paramindents -return -eval} $k] switch -- $fullk { - -return - -eval { + -indent - -undent - -paramindents - -return - -eval { dict set opts $fullk $v } default { if {[info commands ::punk::args::get_by_id] ne ""} { - punk::args::get_by_id ::punk::args::tstr $args + punk::args::get_by_id ::punk::args::lib::tstr $args return } else { error "punk::args::lib::tstr unknown option $k. Known options: [dict keys $opts]" @@ -4112,6 +4686,12 @@ tcl::namespace::eval punk::args::lib { } } set opt_allowcommands [dict get $opts -allowcommands] + set opt_paramindents [dict get $opts -paramindents] + set test_paramindents [tcl::prefix::match -error "" {none line position} $opt_paramindents] + if {$test_paramindents ni {none line position}} { + error "punk::args::lib::tstr option -paramindents invalid value '$opt_paramindents'. Must be one of none, line, position or an unambiguous abbreviation thereof." + } + set opt_paramindents $test_paramindents set opt_return [dict get $opts -return] set opt_return [tcl::prefix::match -error "" {args dict list string} $opt_return] if {$opt_return eq ""} { @@ -4124,6 +4704,15 @@ tcl::namespace::eval punk::args::lib { set nocommands "" } + set opt_undent [dict get $opts -undent] + if {$opt_undent} { + set templatestring [punk::args::lib::undent $templatestring] + } + set opt_indent [dict get $opts -indent] + if {$opt_indent ne ""} { + set templatestring [punk::args::lib::indent $templatestring $opt_indent] + } + #set parts [_tstr_split $templatestring] if {[string first \$\{ $templatestring] < 0} { set parts [list $templatestring] @@ -4135,6 +4724,14 @@ tcl::namespace::eval punk::args::lib { set params [list] set idx 0 set errors [dict create] + set lastline "" ;#todo - first line has placeholder? + set pt1 [lindex $parts 0] + set lastline_posn [string last \n $pt1] + if {$lastline_posn >= 0} { + set lastline [string range $pt1 $lastline_posn+1 end] + } else { + set lastline $pt1 + } foreach {pt expression} $parts { lappend textchunks $pt incr idx ;#pt incr @@ -4143,18 +4740,39 @@ tcl::namespace::eval punk::args::lib { if {$idx == [llength $parts]} { break } + set lastline_posn [string last \n $pt] + if {$lastline_posn >= 0} { + set lastline [string range $pt $lastline_posn+1 end] + } #lappend expressions $expression + #---------------------- + #REVIEW - JMN + #TODO - debug punk::args loading of @dynamic defs + #puts "-- $expression" + #---------------------- + #brk1 - literal newline not {\n} + set leader "" + if {[set brk1 [string first \n $expression]] >= 0} { + #undent left of paramstart only for lines of expression that arent on opening ${..} line + set tail [string range $expression $brk1+1 end] + set leader [string repeat " " [string length $lastline]] + set undentedtail [punk::args::lib::undentleader $tail $leader] + #set undentedtail [punk::lib::undent [string range $expression $brk1+1 end]] + set expression "[string range $expression 0 $brk1]$undentedtail" + } if {$opt_eval} { if {[catch [list uplevel 1 [list ::subst {*}$nocommands $expression]] result]} { lappend params [string cat \$\{ $expression \}] dict set errors [expr {[llength $params]-1}] $result } else { + set result [string map [list \n "\n$leader"] $result] lappend params $result } #lappend params [uplevel 1 [list ::subst {*}$nocommands $expression]] } else { - lappend params $expression + lappend params [subst -nocommands -novariables $expression] } + append lastline [lindex $params end] ;#for current expression's position calc incr idx ;#expression incr } @@ -4167,7 +4785,9 @@ tcl::namespace::eval punk::args::lib { dict for {i e} $errors { append einfo "parameter $i error: $e" \n } - puts stderr "tstr errors:\n$einfo\n]" + #REVIEW!!! + #TODO - fix + #puts stderr "tstr errors:\n$einfo\n" } switch -- $opt_return { @@ -4179,9 +4799,46 @@ tcl::namespace::eval punk::args::lib { return [list $textchunks {*}$params] } string { + #todo - flag to disable indent-matching behaviour for multiline param? set out "" + set pt1 [lindex $parts 0] + set lastline_posn [string last \n $pt1] + if {$lastline_posn >= 0} { + set lastline [string range $pt1 $lastline_posn+1 end] + } else { + set lastline $pt1 + } foreach pt $textchunks param $params { - append out $pt $param + if {$opt_paramindents eq "none"} { + append out $pt $param + } else { + set lastline_posn [string last \n $pt] + if {$lastline_posn >= 0} { + set lastline [string range $pt $lastline_posn+1 end] + } + if {$opt_paramindents eq "line"} { + regexp {(\s*).*} $lastline _all lastindent + } else { + #position + #TODO - detect if there are grapheme clusters + #This regsub doesn't properly space unicode double-wide chars or clusters + set lastindent "[regsub -all {\S} $lastline " "] " + } + if {$lastindent ne ""} { + set paramlines [split $param \n] + if {[llength $paramlines] == 1} { + append out $pt $param + } else { + append out $pt [lindex $paramlines 0] + foreach nextline [lrange $paramlines 1 end] { + append out \n $lastindent $nextline + } + } + } else { + append out $pt $param + } + append lastline $param + } } return $out } @@ -4239,7 +4896,7 @@ tcl::namespace::eval punk::args::lib { } } else { if {$in_placeholder == 2} { - #skip opening bracket + #skip opening bracket dollar sign set in_placeholder 1 } else { append echars $ch @@ -4294,11 +4951,248 @@ tcl::namespace::eval punk::args::lib { return [lappend list [tcl::string::range $text $start end]] } + #like textutil::adjust::indent - but doesn't strip trailing lines, and doesn't implement skip parameter. + proc indent {text {prefix " "}} { + set result [list] + foreach line [split $text \n] { + if {[string trim $line] eq ""} { + lappend result "" + } else { + lappend result $prefix[string trimright $line] + } + } + return [join $result \n] + } + #dedent? + proc undent {text} { + if {$text eq ""} { + return "" + } + set lines [split $text \n] + set nonblank [list] + foreach ln $lines { + if {[string trim $ln] eq ""} { + continue + } + lappend nonblank $ln + } + set lcp [longestCommonPrefix $nonblank] + if {$lcp eq ""} { + return $text + } + regexp {^([\t ]*)} $lcp _m lcp + if {$lcp eq ""} { + return $text + } + set len [string length $lcp] + set result [list] + foreach ln $lines { + if {[string trim $ln] eq ""} { + lappend result "" + } else { + lappend result [string range $ln $len end] + } + } + return [join $result \n] + } + + #hacky + proc undentleader {text leader} { + #leader usually whitespace - but doesn't have to be + if {$text eq ""} { + return "" + } + set lines [split $text \n] + set nonblank [list] + foreach ln $lines { + if {[string trim $ln] eq ""} { + continue + } + lappend nonblank $ln + } + lappend nonblank "${leader}!!" + set lcp [longestCommonPrefix $nonblank] + if {$lcp eq ""} { + return $text + } + #regexp {^([\t ]*)} $lcp _m lcp + #lcp can be shorter than leader + set lcp [string range $lcp 0 [string length $leader]-1] + + if {$lcp eq ""} { + return $text + } + set len [string length $lcp] + set result [list] + foreach ln $lines { + if {[string trim $ln] eq ""} { + lappend result "" + } else { + lappend result [string range $ln $len end] + } + } + return [join $result \n] + } + #A version of textutil::string::longestCommonPrefixList + proc longestCommonPrefix {items} { + if {[llength $items] <= 1} { + return [lindex $items 0] + } + set items [lsort $items[unset items]] + set min [lindex $items 0] + set max [lindex $items end] + #if first and last of sorted list share a prefix - then all do (first and last of sorted list are the most different in the list) + #(sort order nothing to do with length - e.g min may be longer than max) + if {[string length $min] > [string length $max]} { + set temp $min + set min $max + set max $temp + } + set n [string length $min] + set prefix "" + set i -1 + while {[incr i] < $n && ([set c [string index $min $i]] eq [string index $max $i])} { + append prefix $c + } + return $prefix + } + #*** !doctools #[list_end] [comment {--- end definitions namespace punk::args::lib ---}] } + +tcl::namespace::eval punk::args::argdocbase { + namespace export * + #use a? to test and create literal ansi here rather than relying on punk::ansi package presence + #e.g + #% a? bold + #- bold │SGR 1│sample│â›[1msample + #- ──────┼─────┼──────┼────────── + #- RESULT│ │sample│â›[1msample + proc B {} {return \x1b\[1m} ;#a+ bold + proc N {} {return \x1b\[22m} ;#a+ normal + proc I {} {return \x1b\[3m} ;#a+ italic + proc NI {} {return \x1b\[23m} ;#a+ noitalic + +} # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +tcl::namespace::eval punk::args::package { + variable PUNKARGS + lappend PUNKARGS [list { + @dynamic + @id -id "::punk::args::package::standard_about" + @cmd -name "%pkg%::about" -help\ + "About %pkg% + ... + " + -package_about_namespace -type string -optional 0 -help\ + "Namespace containing the package about procedures + Must contain " + -return\ + -type string\ + -default table\ + -choices {string table tableobject}\ + -choicelabels { + string\ + "A basic text layout" + table\ + "layout in table borders + (requires package: textblock)" + tableobject\ + "textblock::class::table object instance" + }\ + -help\ + "Choose the return type of the 'about' information" + topic -optional 1\ + -nocase 1\ + -default {*}\ + -choices {Description License Version Contact *}\ + -choicerestricted 0\ + -choicelabels { + + }\ + -multiple 1\ + -help\ + "Topic to display. Omit or specify as * to see all. + If * is included with explicit topics, * represents + the remaining unmentioned topics." + }] + proc standard_about {args} { + set argd [punk::args::parse $args withid ::punk::args::package::standard_about] + lassign [dict values $argd] leaders OPTS values received + + set pkgns [dict get $OPTS -package_about_namespace] + if {[info commands ${pkgns}::package_name] eq ""} { + error "punk::args::package::standard_about unable to find function ${pkgns}::package_name" + } + set pkgname [${pkgns}::package_name] + + set opt_return [dict get $OPTS -return] + set all_topics [${pkgns}::about_topics] + if {![dict exists $received topic]} { + set topics $all_topics + } else { + # * represents all remaining topics not explicitly mentioned. + set val_topics [dict get $values topic] ;#if -multiple is true, this is a list + set explicit_topics [lsearch -all -inline -exact -not $val_topics "*"] + set topics [list] + foreach t $val_topics { + if {$t eq "*"} { + foreach a $all_topics { + if {$a ni $explicit_topics} { + lappend topics $a + } + } + } else { + lappend topics $t + } + } + } + if {$opt_return ne "string"} { + package require textblock ;#table support + set is_table 1 + set title [string cat {[} $pkgname {]} ] + set t [textblock::class::table new -title $title] + $t configure -frametype double -minwidth [expr {[string length $title]+2}] + + } else { + set topiclens [lmap t $topics {string length $t}] + set widest_topic [tcl::mathfunc::max {*}$topiclens] + set is_table 0 + set about "$pkgname\n" + append about [string repeat - $widest_topic] \n + } + foreach topic $topics { + if {[llength [info commands ::${pkgns}::get_topic_$topic]] == 1} { + set topic_contents [::${pkgns}::get_topic_$topic] + } else { + set topic_contents "" + } + if {!$is_table} { + set content_lines [split $topic_contents \n] + append about [format %-${widest_topic}s $topic] " " [lindex $content_lines 0] \n + foreach ln [lrange $content_lines 1 end] { + append about [format %-${widest_topic}s ""] " " $ln \n + } + } else { + $t add_row [list $topic $topic_contents] + } + } + + if {!$is_table} { + return $about + } else { + if {$opt_return eq "tableobject"} { + return $t + } + set result [$t print] + $t destroy + return $result + } + } + +} #usually we would directly call arg definitions near the defining proc, # so that the proc could directly use the definition in its parsing. @@ -4314,7 +5208,7 @@ tcl::namespace::eval punk::args::lib { # set PUNKARGS "" #} -lappend ::punk::args::register::NAMESPACES ::punk::args::argdoc ::punk::args ::punk::args::lib +lappend ::punk::args::register::NAMESPACES ::punk::args::argdoc ::punk::args ::punk::args::lib ::punk::args::package # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools @@ -4326,8 +5220,6 @@ tcl::namespace::eval punk::args::system { #dict get value with default wrapper for tcl 8.6 if {[info commands ::tcl::dict::getdef] eq ""} { - #package require punk::lib - #interp alias "" ::punk::args::Dict_getdef "" ::punk::lib::dict_getdef proc Dict_getdef {dictValue args} { set keys [lrange $args 0 end-1] if {[tcl::dict::exists $dictValue {*}$keys]} { @@ -4354,6 +5246,8 @@ tcl::namespace::eval punk::args::system { } } + + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::args [tcl::namespace::eval punk::args { diff --git a/src/vfs/_vfscommon.vfs/modules/punk/args/tclcore-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/args/tclcore-0.1.0.tm index 2331245c..7a4a899e 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/args/tclcore-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/args/tclcore-0.1.0.tm @@ -141,9 +141,11 @@ tcl::namespace::eval punk::args::tclcore { variable PUNKARGS + package require punk::ansi + tcl::namespace::import ::punk::ansi::a+ # -- --- --- --- --- #non colour SGR codes - # we can use these directly via ${$I} etc without marking a definition with -dynamic + # we can use these directly via ${$I} etc without marking a definition with @dynamic #This is because they don't need to change when colour switched on and off. set I [a+ italic] set NI [a+ noitalic] @@ -151,6 +153,132 @@ tcl::namespace::eval punk::args::tclcore { set N [a+ normal] # -- --- --- --- --- + + namespace eval argdoc { + variable PUNKARGS + + lappend PUNKARGS [list { + @id -id ::punk::args::tclcore::argdoc::ensemble_subcommands_definition + @cmd -name ::punk::args::tclcore::argdoc::ensemble_subcommands_definition -help\ + "Helper function to return a punk::args definition snippet for subcommands" + @leaders -max 0 -min 0 + -groupdict -default {} -type dict -help\ + "Dictionary keyed on arbitrary groupname, where value + is a list of known subcommands that should be displayed + by groupname. Each groupname forms the title of a subtable + in the choices list. + Subcommands not assigned to a groupname will appear first + in an untitled subtable." + -columns -default 4 -type integer -help\ + "Max number of columns for all subtables in the choices + display area" + @values -min 1 -max 1 + ensemble -optional 0 -help\ + "Name of ensemble command" + + }] + proc ensemble_subcommands_definition {args} { + #args manually parsed - with use of argdef for unhappy-path only + if {![llength $args]} { + punk::args::get_by_id ::punk::args::tclcore::argdoc::ensemble_subcommands_definition $args + return + } + set ensemble [lindex $args end] + set optlist [lrange $args 0 end-1] + if {[llength $optlist] % 2} { + punk::args::get_by_id ::punk::args::tclcore::argdoc::ensemble_subcommands_definition $args + return + } + set defaults [dict create\ + -groupdict {}\ + -columns 4\ + ] + set optlist [dict merge $defaults $optlist] + dict for {k v} $optlist { + switch -- $k { + -groupdict - -columns {} + default { + punk::args::get_by_id ::punk::args::tclcore::argdoc::ensemble_subcommands_definition $args + return + } + } + } + set opt_groupdict [dict get $optlist -groupdict] + set opt_columns [dict get $optlist -columns] + + package require punk::ns + set subdict [punk::ns::ensemble_subcommands -return dict $ensemble] + set allsubs [dict keys $subdict] + # ---------------------------------------------- + # manually defined group members may have subcommands that are obsoleted/missing + # we choose to make the situation obvious by re-classifying into a corresponding group with the " - MISSING" suffix + set checked_groupdict [dict create] + dict for {g members} $opt_groupdict { + set validmembers {} + set invalidmembers {} + foreach m $members { + if {$m in $allsubs} { + lappend validmembers $m + } else { + lappend invalidmembers $m + } + } + dict set checked_groupdict $g $validmembers + if {[llength $invalidmembers]} { + dict set checked_groupdict "${g}_MISSING" $invalidmembers + } + } + if {[dict exists $checked_groupdict ""]} { + set others [dict get $checked_groupdict ""] + dict unset checked_groupdict "" + } else { + set others [list] + } + + #REVIEW + set debug 0 + if {$debug} { + puts "punk::args::tclcore::argdoc::ensemble_subcommands_definition" + if {[catch { + ::punk::lib::pdict checked_groupdict + } msg]} { + puts stderr "punk::args::tclcore::ensemble_subcommands_definition Cannot call pdict\n$msg" + } + puts -------------------- + puts "$checked_groupdict" + puts -------------------- + } + + set opt_groupdict $checked_groupdict + # ---------------------------------------------- + set allgrouped [list] + dict for {g members} $opt_groupdict { + lappend allgrouped {*}$members + } + foreach sc $allsubs { + if {$sc ni $allgrouped} { + if {$sc ni $others} { + lappend others $sc + } + } + } + + set argdef "" + append argdef "subcommand -choicegroups \{" \n + append argdef " \"\" \{$others\}" \n + dict for {g members} $opt_groupdict { + append argdef " \"$g\" \{$members\}" \n + } + append argdef " \} -choicecolumns $opt_columns" \n + + #todo -choicelabels + #detect subcommand further info available e.g if oo or ensemble or punk::args id exists.. + #consider a different mechanism to add a label on rhs of same line as choice (for (i) marker) + + return $argdef + } + } + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- # library commands loaded via auto_index # -- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -171,44 +299,7 @@ tcl::namespace::eval punk::args::tclcore { } "@doc -name Manpage: -url [manpage_tcl library]" ] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- - #todo - make generic - take command and known_groups_dict - proc info_subcommands {} { - package require punk::ns - set subdict [punk::ns::ensemble_subcommands -return dict info] - set allsubs [dict keys $subdict] - dict set groups "system" {hostname library nameofexecutable patchlevel script sharedlibextension tclversion} - dict set groups "{proc introspection}" {args body default} - dict set groups "variables" {constant consts exists globals locals vars} - dict set groups "{oo object introspection}" {class object} - - set allgrouped [list] - dict for {g members} $groups { - lappend allgrouped {*}$members - } - set others [list] - foreach sc $allsubs { - if {$sc ni $allgrouped} { - lappend others $sc - } - } - - set argdef "" - append argdef "subcommand -choicegroups \{" \n - append argdef " \"\" \{$others\}" \n - dict for {g members} $groups { - append argdef " $g \{$members\}" \n - } - append argdef " \}" \n - - #todo -choicelabels - #detect subcommand further info available e.g if oo or ensemble or punk::args id exists.. - #consider a different mechanism to add a label on rhs of same line as choice (for (i) marker) - - return $argdef - } - - - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { #test of @form @id -id ::AFTER @cmd -name "Builtin: after" -help\ @@ -223,7 +314,8 @@ tcl::namespace::eval punk::args::tclcore { @form -form {schedule_ms} -synopsis "after ms ?script...?" #@values -form {*} #note "classify next argument as a value not a leader" - ms -form {*} -type int + ms -form {*} -type int -help\ + "milliseconds" @values -form {delay} -min 1 -max 1 @values -form {schedule_ms} -min 2 script -form {schedule_ms} -multiple 1 -optional 1 ref-help common_script_help @@ -252,12 +344,28 @@ tcl::namespace::eval punk::args::tclcore { } "@doc -name Manpage: -url [manpage_tcl after]" ] - lappend PUNKARGS [list -dynamic 1 { + namespace eval argdoc { + #todo - make generic - take command and known_groups_dict + proc info_subcommands {} { + #package require punk::ns + #set subdict [punk::ns::ensemble_subcommands -return dict info] + #set allsubs [dict keys $subdict] + dict set groups "system" {hostname library nameofexecutable patchlevel script sharedlibextension tclversion} + dict set groups "proc introspection" {args body default} + dict set groups "variables" {constant consts exists globals locals vars} + dict set groups "oo object introspection" {class object} + + return [ensemble_subcommands_definition -groupdict $groups -columns 4 info] + } + } + lappend PUNKARGS [list { + @dynamic @id -id ::info @cmd -name "Builtin: info" -help\ "Information about the state of the Tcl interpreter" - @values - ${[punk::args::tclcore::info_subcommands]} + @leaders -min 1 -max 1 + ${[punk::args::tclcore::argdoc::info_subcommands]} + @values -min 0 } "@doc -name Manpage: -url [manpage_tcl array]" ] @@ -279,10 +387,10 @@ tcl::namespace::eval punk::args::tclcore { @cmd -name "binary encode base64" -maxlen -type integer -help\ "Indicates that the output should be split into lines of no more than length - characters. By default, lines are not split." + characters. By default, lines are not split." -wrapchar -type character -default \n -help\ "Indicates that, when lines are split because of the -maxlen option, character - should be used to separate lines. By default, this is a newline character, \"\\n\"." + should be used to separate lines. By default, this is a newline character, \"\\n\"." @values -min 1 -max 1 data -type string } ] @@ -291,8 +399,8 @@ tcl::namespace::eval punk::args::tclcore { @cmd -name "binary decode base64" -strict -type none -help\ "Instructs the decoder to throw an error if it encounters any characters that - are not strictly part of the encoding itself. Otherwise it ignores them. - RFC 2045 calls for base64 decoders to be non-strict." + are not strictly part of the encoding itself. Otherwise it ignores them. + RFC 2045 calls for base64 decoders to be non-strict." @values -min 1 -max 1 data -type string } ] @@ -318,7 +426,7 @@ tcl::namespace::eval punk::args::tclcore { @cmd -name "binary encode hex" -strict -type none -help\ "Instructs the decoder to throw an error if it encounters whitespace - characters. Otherwise it ignores them." + characters. Otherwise it ignores them." @values -min 1 -max 1 data -type string } "@doc -name Manpage: -url [manpage_tcl binary]" ] @@ -340,16 +448,16 @@ tcl::namespace::eval punk::args::tclcore { @cmd -name "binary encode uuencode" -maxlen -type integer -default 61 -range {5 85} -help\ "Indicates the maximum number of characters to produce for each encoded line. - The valid range is 5 to 85. Line lengths outside that range cannot be - accommodated by the encoding format." + The valid range is 5 to 85. Line lengths outside that range cannot be + accommodated by the encoding format." -wrapchar -type string -default \n -help\ "Indicates the character(s) to use to mark the end of each encoded line. - Acceptable values are a sequence of zero or more character from the set - { \\x09 (TAB), \\x0B (VT), \\x0C (FF), \\x0D (CR) } followed by zero or - one newline \\x0A (LF). Any other values are rejected because they would - generate encoded text that could not be decoded. The default value is a - single newline. - " + Acceptable values are a sequence of zero or more character from the set + { \\x09 (TAB), \\x0B (VT), \\x0C (FF), \\x0D (CR) } followed by zero or + one newline \\x0A (LF). Any other values are rejected because they would + generate encoded text that could not be decoded. The default value is a + single newline. + " @values -min 1 -max 1 data -type string } ] @@ -359,9 +467,9 @@ tcl::namespace::eval punk::args::tclcore { @cmd -name "binary decode uuencode" -strict -type none -help\ "Instructs the decoder to throw an error if it encounters anything outside - of the standard encoding format. Without this option, the decoder tolerates - some deviations, mostly to forgive reflows of lines between the encoder and - decoder." + of the standard encoding format. Without this option, the decoder tolerates + some deviations, mostly to forgive reflows of lines between the encoder and + decoder." @values -min 1 -max 1 data -type string } ] @@ -389,7 +497,7 @@ tcl::namespace::eval punk::args::tclcore { @cmd -name "Builtin: tcl::chan::tell" -help\ "Returns a number giving the current access position within the underlying data stream for the channel named channel. This value returned is a byte - offset that can be passed to ${[a+ bold]}chan seek${[a normal]} in order + offset that can be passed to ${[a+ bold]}chan seek${[a+ normal]} in order to set the channel to a particular position. Note that this value is in terms of bytes, not characters like ${[a+ bold]}chan read${[a+ normal]}. The value returned is -1 for channels that do not support seeking." @@ -398,7 +506,25 @@ tcl::namespace::eval punk::args::tclcore { "" } "@doc -name Manpage: -url [manpage_tcl chan]" ] + lappend PUNKARGS [list { + @id -id ::tcl::chan::truncate + @cmd -name "Builtin: tcl::chan::truncate" -help\ + "Sets the byte length of the underlying data stream for the channel to be + length (or to the current byte offset within the underlying data stream if + length is omitted). The channel is flushed before truncation." + #todo - auto synopsis? + @form -synopsis\ + "chan truncate channel ?length?" + @values + channel -help \ + "" + length -optional 1 -type integer + } "@doc -name Manpage: -url [manpage_tcl chan]" ] + + + #TODO - autocreate argdef namespace and import B N etc + # ${[B]import[N]} lappend PUNKARGS [list { @id -id ::tcl::info::cmdtype @cmd -name "Builtin: tcl::info::cmdtype" -help\ @@ -498,13 +624,13 @@ tcl::namespace::eval punk::args::tclcore { name } "@doc -name Manpage: -url [manpage_tcl namespace]" ] + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- lappend PUNKARGS [list { @id -id ::tcl::process::status @cmd -name "Builtin: tcl::process::status" -help\ "Returns a dictionary mapping subprocess PIDs to their respective status. - if ${$I}pids${$NI} is specified as a list of PIDs then the command - only returns the status of the matching subprocesses if they exist, and - raises an error otherwise. + If ${$I}pids${$NI} is specified as a list of PIDs then the command + only returns the status of the matching subprocesses if they exist. For active processes, the status is an empty value. For terminated processes, the status is a list with the following format: {code ?msg errorCode?} @@ -525,17 +651,31 @@ tcl::namespace::eval punk::args::tclcore { " -wait -type none -optional 1 -help\ "By default the command returns immediately (the underlying Tcl_WaitPid - is called with the WNOHANG flag set) unless this switch is set. if pids - is specified as a list of PIDS then the command waits until the status - of the matching subprocesses are avaliable. If pids was not specified, - this command will wait for all known subprocesses." + is called with the WNOHANG flag set) unless this switch is set. if pids + is specified as a list of PIDS then the command waits until the status + of the matching subprocesses are avaliable. If pids was not specified, + this command will wait for all known subprocesses." -- -type none -optional 1 -help\ "Marks the end of switches. The argument following this one will be - treated as the first arg even if it starts with a -." + treated as the first arg even if it starts with a -." + @values -min 0 -max 1 + pids -type list -optional 1 -help\ + "A list of PIDs" + } "@doc -name Manpage: -url [manpage_tcl namespace]" ] + + lappend PUNKARGS [list { + @id -id ::tcl::process::purge + @cmd -name "Builtin: tcl::process::purge" -help\ + "Cleans up all data associated with terminated subprocesses. If pids is + specified as a list of PIDs then the command only cleans up data for + the matching subprocesses if they exist. If a process listed is still + active, this command does nothing to that process. + Any PID that does not correspond to a subprocess is ignored." @values -min 0 -max 1 pids -type list -optional 1 -help\ "A list of PIDs" } "@doc -name Manpage: -url [manpage_tcl namespace]" ] + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ############################################################################################################################################################ # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -549,30 +689,19 @@ tcl::namespace::eval punk::args::tclcore { #categorise array subcommands based on currently known groupings. #we do this dynamically because Tcl ensembles (even some core ones) can have subcommands added at runtime. proc array_subcommands {} { - package require punk::ns - set subdict [punk::ns::ensemble_subcommands array] - set expected_searchcmds {startsearch anymore nextelement donesearch} - set searchcmds [list] - foreach sc $expected_searchcmds { - if {$sc in [dict keys $subdict]} { - lappend searchcmds $sc - } - } - set argdef "" - append argdef "subcommand -choicegroups \{" \n - append argdef " \"\" \{" \n - append argdef " [dict keys [dict remove $subdict {*}$searchcmds]]" \n - append argdef " \}" \n - append argdef " \"search\" \{" \n - append argdef " $searchcmds" \n - append argdef " \}" \n - append argdef " \} -choicecolumns 4 " \n - - return $argdef + #puts "--array_subcommands frames:" + #for {set i 0} {$i <= [info frame]} {incr i} { + # puts "$i [info frame $i]" + #} + + #dict set groups "" {bogus names} ;#test adding both existant and nonexistant to the default group + dict set groups "search" {startsearch anymore nextelement donesearch} + return [ensemble_subcommands_definition -groupdict $groups -columns 4 array] } } - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + @dynamic @id -id ::array @cmd -name "Builtin: array" -help\ "Manipulate array variables" @@ -584,7 +713,7 @@ tcl::namespace::eval punk::args::tclcore { # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { @id -id ::const @cmd -name "Builtin: const" -help\ "Create and initialise a constant. @@ -671,6 +800,28 @@ tcl::namespace::eval punk::args::tclcore { } "@doc -name Manpage: -url [manpage_tcl ledit]" # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + punk::args::define { + @id -id ::lremove + @cmd -name "builtin: lremove" -help\ + "Remove elements from a list by index + lremove returns a new list formed by simultaneously removing zero or + more elements of list at each of the indices given by an arbitrary + number of index arguments. The indices may be in any order and may be + repeated; the element at index will only be removed once. The index + values are interpreted the same as index values for the command + 'string index', supporting simple index arithmetic and indices relative + to the end of the list. 0 refers to the first element of the list, and + end refers to the last element of the list." + @values -min 1 -max -1 + list -type list -help\ + "tcl list as a value" + index -type indexexpression -multiple 1 -optional 1 + + @seealso -commands {list lappend lassign ledit lindex linsert llength lmap lpop lrange lrepeat lreplace lreverse lsearch lseq lset lsort} + } "@doc -name Manpage: -url [manpage_tcl lremove]" + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @id -id ::lpop @@ -681,15 +832,15 @@ tcl::namespace::eval punk::args::tclcore { varName -type string -help\ "Existing list variable name" index -type indexexpression -default end -optional 1 -multiple 1 -help\ - "When presented with a single index, the lpop command addresses - the index'th element in it, removes it from the list and returns - the element. - If index is negative or greater or equal than the number of - elements in the list in the variable called varName, an error occurs. - If addition index arguments are supplied, then each argument is used - in turn to address an element within a sublist designated by the - previous indexing operation, allowing the script to remove elements - in sublists, similar to lindex and lset." + "When presented with a single index, the lpop command addresses + the index'th element in it, removes it from the list and returns + the element. + If index is negative or greater or equal than the number of + elements in the list in the variable called varName, an error occurs. + If addition index arguments are supplied, then each argument is used + in turn to address an element within a sublist designated by the + previous indexing operation, allowing the script to remove elements + in sublists, similar to lindex and lset." } "@doc -name Manpage: -url [manpage_tcl lpop]" # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @@ -700,8 +851,7 @@ tcl::namespace::eval punk::args::tclcore { The index values first and last are interpreted the same as index values for the command 'string index', supporting simple index arithmetic and indices relative to the end of the list. - e.g lrange {a b c} 0 end-1 - " + e.g lrange {a b c} 0 end-1" @values -min 3 -max 3 list -type list -help\ "tcl list as a value" @@ -749,18 +899,17 @@ tcl::namespace::eval punk::args::tclcore { " @values -min 1 -max 2 varName -type string -help\ - "name of scalar or array variable + "name of scalar or array variable scalar variable e.g myvar array element e.g myarray(identifier.x) namespaced scalar variable e.g ::ns1::myvar namespaced array element e.g ::ns1::myarray(subelement) - Nested datastructures may be simulated with an array by using - some programmer chosen convention to seperate levels. - e.g set myarray(config,0) \"val1\" - set myarray(config,1) \"etc\" - set myarray(data,0) {a b c} - see the dict command for an alternative datastructure. - " + Nested datastructures may be simulated with an array by using + some programmer chosen convention to seperate levels. + e.g set myarray(config,0) \"val1\" + set myarray(config,1) \"etc\" + set myarray(data,0) {a b c} + see the dict command for an alternative datastructure." value -type any -optional 1 } "@doc -name Manpage: -url [manpage_tcl set]" # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -790,16 +939,16 @@ tcl::namespace::eval punk::args::tclcore { @id -id ::tcl::string::compare @cmd -name "builtin: tcl::string::compare" -help\ - "Perform a character-by-character comparison of strings string1 and string2. + "Perform a character-by-character comparison of strings string1 and string2. Returns -1, 0, or 1, dpending on whether string1 is lexicographically lessthan, equal to, or greater than string2" -nocase -type none -help\ - "If -nocase is specified, then the strings are compared in a case insensitive manner." + "If -nocase is specified, then the strings are compared in a case insensitive manner." -length -type integer -help\ - "If -length is specified, then only the first length characters are used in the comparison. - If -length is negative, it is ignored." + "If -length is specified, then only the first length characters are used in the comparison. + If -length is negative, it is ignored." @values -min 2 -max 2 string1 -type string @@ -810,15 +959,15 @@ tcl::namespace::eval punk::args::tclcore { @id -id ::tcl::string::equal @cmd -name "builtin: tcl::string::equal" -help\ - "Perform a character-by-character comparison of strings string1 and string2. + "Perform a character-by-character comparison of strings string1 and string2. Returns 1 if string1 and string2 are identical, or 0 when not." -nocase -type none -help\ - "If -nocase is specified, then the strings are compared in a case insensitive manner." + "If -nocase is specified, then the strings are compared in a case insensitive manner." -length -type integer -help\ - "If -length is specified, then only the first length characters are used in the comparison. - If -length is negative, it is ignored." + "If -length is specified, then only the first length characters are used in the comparison. + If -length is negative, it is ignored." @values -min 2 -max 2 string1 -type string @@ -892,14 +1041,14 @@ tcl::namespace::eval punk::args::tclcore { @id -id ::tcl::string::replace @cmd -name "builtin: tcl::string::replace" -help\ "Removes a range of consecutive characters from string, starting with the character whose - index is first and ending with the character whose index is last - (Using the forms described in STRING_INDICES). An index of 0 refers to the first - character of the string. First and last may be specified as for the index method. - If first is less than zero then it is treated as if it were zero, and if last is - greater than or equal to the length of the string then it is treated as if it were - end. The initial string is returned untouched, if first is greater than last, or if - first is equal to or greater than the length of the inital string, or last is less - than 0." + index is first and ending with the character whose index is last + (Using the forms described in STRING_INDICES). An index of 0 refers to the first + character of the string. First and last may be specified as for the index method. + If first is less than zero then it is treated as if it were zero, and if last is + greater than or equal to the length of the string then it is treated as if it were + end. The initial string is returned untouched, if first is greater than last, or if + first is equal to or greater than the length of the inital string, or last is less + than 0." @values -min 3 -max 3 string -type string first -type indexexpression @@ -912,7 +1061,7 @@ tcl::namespace::eval punk::args::tclcore { @id -id ::tcl::string::totitle @cmd -name "builtin: tcl::string::totitle" -help\ "Returns a value equal to string except that the first character in string is converted to - it's Unicode title case variant (or upper case if there is no title case variant) and the + its Unicode title case variant (or upper case if there is no title case variant) and the rest of the string is converted to lower case." @values -min 1 -max 1 @@ -934,9 +1083,9 @@ tcl::namespace::eval punk::args::tclcore { string -type string charIndex -type indexexpression -help\ "integer or simple expresssion. - e.g end - e.g end-1 - e.g M+N" + e.g end + e.g end-1 + e.g M+N" } "@doc -name Manpage: -url [manpage_tcl string]" punk::args::define { @@ -951,12 +1100,12 @@ tcl::namespace::eval punk::args::tclcore { string -type string charIndex -type indexexpression -help\ "integer or simple expresssion. - e.g end - e.g end-1 - e.g M+N" + e.g end + e.g end-1 + e.g M+N" } "@doc -name Manpage: -url [manpage_tcl string]" - punk::args::define [punk::lib::tstr -return string { + punk::args::define [punk::args::lib::tstr -return string { @id -id ::tcl::string::is @cmd -name "builtin: tcl::string::is" -help\ "Returns 1 if string is a valid member of the specified character class, otherwise returns 0. @@ -989,132 +1138,344 @@ tcl::namespace::eval punk::args::tclcore { }\ -choicelabels { alnum\ - " Any Unicode alphabet - or digit character" + " Any Unicode alphabet + or digit character" alpha\ - " Any Unicode alphabet - character" + " Any Unicode alphabet + character" ascii\ - " Any character with - a value less than \\u0080 - (those that are in the - 7-bit ascii range)" + " Any character with + a value less than \\u0080 + (those that are in the + 7-bit ascii range)" boolean\ - " Any of the forms allowed - to Tcl_GetBoolean" + " Any of the forms allowed + to Tcl_GetBoolean" control\ - " Any Unicode control char" + " Any Unicode control char" dict\ - " Any proper dict structure, - with optional surrounding - whitespace. In case of - improper dict structure, 0 - is returned and the varname - will contain the index of - the \"element\" where the - dict parsing fails or -1 if - this cannot be determined." + " Any proper dict structure, + with optional surrounding + whitespace. In case of + improper dict structure, 0 + is returned and the varname + will contain the index of + the \"element\" where the + dict parsing fails or -1 if + this cannot be determined." digit\ - " Any Unicode digit char. - Note that this includes - chars outside of the \[0-9\] - range." + " Any Unicode digit char. + Note that this includes + chars outside of the \[0-9\] + range." double\ - " Any of the forms allowed - to Tcl_GetDoubleFromObj. - ${$A_WARN}With optional surrounding${$A_RST} - ${$A_WARN}whitespace.${$A_RST}" + " Any of the forms allowed + to Tcl_GetDoubleFromObj. + ${$A_WARN}With optional surrounding${$A_RST} + ${$A_WARN}whitespace.${$A_RST}" entier\ - " Synonym for integer" + " Synonym for integer" false\ - " Any of the forms allowed - to Tcl_GetBoolean where the - value is false" + " Any of the forms allowed + to Tcl_GetBoolean where the + value is false" graph\ - " Any Unicode printing char - except space." + " Any Unicode printing char + except space." integer\ - " Any of the valid string - formats for an integer value - of arbitrary size in Tcl, - ${$A_WARN}with optional surrounding${$A_RST} - ${$A_WARN}whitespace${$A_RST}. The formats - accepted are exactly those - accepted by the C routine - Tcl_GetBignumFromObj." + " Any of the valid string + formats for an integer value + of arbitrary size in Tcl, + ${$A_WARN}with optional surrounding${$A_RST} + ${$A_WARN}whitespace${$A_RST}. The formats + accepted are exactly those + accepted by the C routine + Tcl_GetBignumFromObj." list\ - " Any proper list structure, - with optional surrounding - whitespace. In case of - improper list structure, 0 - is returned and the varname - will contain the index of - the \"element\" where list - parsing fails, or -1 if - this cannot be determined" + " Any proper list structure, + with optional surrounding + whitespace. In case of + improper list structure, 0 + is returned and the varname + will contain the index of + the \"element\" where list + parsing fails, or -1 if + this cannot be determined" lower\ - " Any Unicode lower case - alphabet character" + " Any Unicode lower case + alphabet character" print\ - " Any Unicode printing - character, including space" + " Any Unicode printing + character, including space" punct\ - " Any Unicode punctuation - character." + " Any Unicode punctuation + character." space\ - " Any Unicode whitespace - character, mongolian vowel - separator (U+180e), - zero width space (U+200b), - word joiner (U+2060) or - zero width no-break space - (U+feff) (=BOM)" + " Any Unicode whitespace + character, mongolian vowel + separator (U+180e), + zero width space (U+200b), + word joiner (U+2060) or + zero width no-break space + (U+feff) (=BOM)" true\ - " Any of the forms allowed - to Tcl_GetBoolean where the - value is true" + " Any of the forms allowed + to Tcl_GetBoolean where the + value is true" upper\ - " Any upper case alphabet - character in the Unicode - character set" + " Any upper case alphabet + character in the Unicode + character set" wideinteger\ - " Any of the valid forms - for a wide integer in Tcl, - ${$A_WARN}with optional surrounding${$A_RST} - ${$A_WARN}whitespace${$A_RST}. In case of - overflow in the value, 0 is - returned and the varname - will contain -1." + " Any of the valid forms + for a wide integer in Tcl, + ${$A_WARN}with optional surrounding${$A_RST} + ${$A_WARN}whitespace${$A_RST}. In case of + overflow in the value, 0 is + returned and the varname + will contain -1." wordchar\ - " Any Unicode word char. - That is any alphanumeric - character, and any - Unicode connector - punctuation characters - (e.g. underscore)" + " Any Unicode word char. + That is any alphanumeric + character, and any + Unicode connector + punctuation characters + (e.g. underscore)" xdigit\ - " Any hexadecimal digit - character, and any Unicode - connector punctuation - characters (e.g. underscore)" - + " Any hexadecimal digit + character ([0-9A-Fa-f])." }\ -help\ - "character class - In the case of boolean, true and false, if the function will return 0, then the - varname will always be set to 0, due to the varied nature of a valid boolean value" + "character class + In the case of boolean, true and false, if the function will return 0, then the + varname will always be set to 0, due to the varied nature of a valid boolean value" -strict -type none -help\ "If -strict is specified, then an empty string returns 0, - otherwise an empty string will return 1 on any class" + otherwise an empty string will return 1 on any class" -failindex -type variablename -help\ "If -failindex is specified, then if the function returns 0, - the index in the string where the class was no longer valid will be stored - in the variable named." + the index in the string where the class was no longer valid will be stored + in the variable named." @values -min 1 -max 1 string -type string -optional 0 }] "@doc -name Manpage: -url [manpage_tcl string]" + + #a test of going deeper - we should be able to define these by reference to above text + #e.g dict get [lrange [punk::args::resolved_def -types leaders ::tcl::string::is class] 1 end] -choicelabels xdigit + #set string_class_choices [dict get [lrange [punk::args::resolved_def -types leaders ::tcl::string::is class] 1 end] -choices] + set string_class_choicelabels [dict get [lrange [punk::args::resolved_def -types leaders ::tcl::string::is class] 1 end] -choicelabels] + dict for {sclass slabel} $string_class_choicelabels { + punk::args::define [string map [list %sc% $sclass %slabel% $slabel] { + @id -id "::tcl::string::is %sc%" + @cmd -name "builtin: string is %sc%" -help\ + {%slabel%} + ${[punk::args::resolved_def -types opts ::tcl::string::is -*]} + @values -min 1 -max 1 + string -type string -optional 0 + }] "@doc -name Manpage: -url [manpage_tcl string]" + } + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + + punk::args::define { + @id -id ::trace + @cmd -name "builtin: trace" -help\ + "Monitor variable accesses, command usages and command executions + " + @form -synopsis "trace option ?arg arg...?" + option -choicegroups { + "" {add remove info} + obsolete {variable vdelete vinfo} + }\ + -choiceinfo { + add {subhelp "::trace add"} + } + + } "@doc -name Manpage: -url [manpage_tcl trace]" + + punk::args::define { + @id -id "::trace add" + @cmd -name "builtin: trace add" -help\ + "" + @form -synopsis "trace add type name ops ?args?" + @leaders + type -choicegroups { + "" {command execution variable} + }\ + -choiceinfo { + command {subhelp "::trace add command"} + } + + } "@doc -name Manpage: -url [manpage_tcl trace]" + + punk::args::define { + @id -id "::trace add command" + @cmd -name "builtin: trace add command" -help\ + "Arrange for commandPrefix to be executed (with additional arguments) + whenever command name is modified in one of the ways given by the list + ops. Name will be resolved using the usual namespace resolution rules + used by commands. If the command does not exist, an error will be thrown." + name -type string -help\ + "Name of command" + ops -type list -choices {rename delete} -choiceprefix 0 -choicemultiple {1 2}\ + -choicelabels { + rename\ + " Invoke commandPrefix whenever the traced command + is renamed. Note that renaming to the empty string + is considered deletion, and will not be traced with + 'rename'" + delete\ + " Invoke commandPrefix when the traced command is deleted. + Commands can be deleted explicitly using the rename command to + rename the command to an empty string. Commands are also deleted + when the interpreter is deleted, but traces will not be invoked + because there is no interpreter in which to execute them." + }\ + -help\ + "Indicates which operations are of interest." + commandPrefix -type string -help\ + "When the trace triggers, depending on the operations being traced, a + number of arguments are appended to commandPrefix so that the actual + command is as follows: + -------------------------------- + commandPrefix oldName newName op + -------------------------------- + OldName and newName give the traced command's current (old) name, + and the name to which it is being renamed (the empty string if this + is a \"delete\" operation). Op indicates what operation is being + performed on the command, and is one of rename or delete as defined + above. The trace operation cannot be used to stop a command from being + deleted. Tcl will always remove the command once the trace is complete. + Recursive renaming or deleting will not cause further traces of the + same type to be evaluated, so a delete trace which itself deletes a + command, or a rename trace which itself renames the command will not + cause further trace evaluations to occur. Both oldName and newName are + fully qualified with any namespace(s) in which they appear. + " + } "@doc -name Manpage: -url [manpage_tcl trace]" + + + punk::args::define { + @id -id "::trace add execution" + @cmd -name "builtin: trace add execution" -help\ + "Arrange for commandPrefix to be executed (with additional arguments) + whenever command name is executed, with traces occurring at the points + indicated by the list ops. Name will be resolved using the usual namespace + resolution ruls used by commands. If the command does not exist, and error + will be thrown" + name -type string -help\ + "Name of command" + # --------------------------------------------------------------- + ops -type list -choices {enter leave enterstep leavestep} -choiceprefix 0\ + -choicemultiple {1 4}\ + -choicecolumns 2\ + -choicelabels { + enter\ + " Invoke commandPrefix whenever the command name is executed, + just before the actual execution takes place." + leave\ + " Invoke commandPrefix whenever the command name is executed, + just after the actual execution takes place." + enterstep\ + " Invoke commandPrefix for every Tcl command which is executed + from the start of the execution of the procedure name until + that procedure finishes. CommandPrefix is invoked just before + the actual execution of the Tcl command being reported takes + place. For example if we have + \"proc foo {} { puts \"hello\" }\", then an enterstep trace + would be invoked just before \"puts \"hello\"\" is executed. + Setting an enterstep trace on a command name that does not + refer to a procedure will not result in an error and is + simply ignored." + leavestep\ + " Invoke commandPrefix for every Tcl command which is executed + from the start of the execution of the procedure name until + that procedure finishes. CommandPrefix is invoked just after + the actual execution of the Tcl command being reported takes + place. Setting a leavestep trace on a command name that does + not refer to a procedure will not result in an error and is + simply ignored." + }\ + -help\ + "Indicates which operations are of interest." + commandPrefix -type string -help\ + "When the trace triggers, depending on the operation being traced, a + number of arguments are appended to commandPrefix so that the actual + command is as follows: + For enter and enterstep operations: + ------------------------------- + commandPrefix command-string op + ------------------------------- + Command-string give the complete current command being executed + (the traced command for a enter operation, an arbitrary command + for an enterstep operation), including all arguments in their + fully expanded form. Op indicates what operation is being performed + on the command execution, and is on of enter or enterstep as + defined above. The trace operation can be used to stop the command + from executing, by deleting the command in question. Of course when + the command is subsequently executed, an \"invalid command\" error + will occur. + For leave and leavestep operations: + ------------------------------------------- + commandPrefix command-string code result op + ------------------------------------------- + Command-string gives the complete current command being executed + (the traced command for a leave operation, an arbitrary command + for a leavestep operation), including all arguments in their + fully expanded form. Code give the result code of that execution, + and result the result string. Op indicates what operation is being + performed on the command execution and is one of leave or leavestep + as defined above. + + Note that the creation of many enterstep or leavestep traces can + lead to unintuitive results, since the invoked commands from one + trace can themselves lead to further command invocations for other + traces. + + CommandPrefix executes in the same context as the code that invoked + the traced operation: thus the commandPrefix, if invoked from a + procedure, will have access to the same local variables as code in the + procedure. This context may be different thatn the context in which + the trace was created. If commandPrefix invokes a procedure (which + it normally does) then the procedure will have to use upvar or uplevel + commands if it wishes to access the local variables of the code which + invoked the trace operation. + + While commandPrefix is executing during an execution trace, traces on + name are temporarily disabled. This allows the commandPrefix to execute + name in its body without invoking any other traces again. If an error + occurs while executing the commandPrefix, then the command name as a + whole will return that same error. + + When multiple traces are set on name, then for enter and enterstep + operations, the traced commands are invoked in the reverse order of how + the traces were originally created; and for leave and leavestep operations, + the traced commands are invoked in the original order of creation. + + The behaviour of execution traces is currently undefined for a command name + imported into another namespace. + " + } "@doc -name Manpage: -url [manpage_tcl trace]" + + punk::args::define { + @id -id "::trace remove command" + @cmd -name "builtin: trace remove command" -help\ + "If there is a trace set on command name with the operations and command + given by opList and commandPrefix, then the trace is removed, so that + commandPrefix will never again be invoked. Returns an empty string. If + name does not exist, the command will throw an error" + @values + name -type string -help\ + "Name of command" + opList -type list -help\ + "A list of one or more of the following items: + rename + delete" + commandPrefix + } "@doc -name Manpage: -url [manpage_tcl trace]" + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @id -id ::variable @@ -1147,11 +1508,16 @@ tcl::namespace::eval punk::args::tclcore { # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + namespace eval argdoc { + if {[catch {zlib::pkgconfig get zlibVersion} ZLIBVERSION]} { + set ZLIBVERSION "(unknown)" + } + } punk::args::define { @id -id ::zlib @cmd -name "builtin: ::zlib" -help\ - "zlib - compression and decompression operations - " + "zlib - compression and decompression operations + zlib version: ${$::punk::args::tclcore::argdoc::ZLIBVERSION}" @leaders -min 1 -max 1 subcommand -type string\ -choicecolumns 2\ @@ -1261,12 +1627,10 @@ tcl::namespace::eval punk::args::tclcore::lib { #} # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -if {![info exists ::punk::args::register::NAMESPACES]} { - namespace eval ::punk::args::register { - set ::punk::args::register::NAMESPACES [list] ;#use fully qualified so 8.6 doesn't find existing var in global namespace - } +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::args::tclcore ::punk::args::tclcore::argdoc } -lappend ::punk::args::register::NAMESPACES ::punk::args::tclcore ## Ready package provide punk::args::tclcore [tcl::namespace::eval punk::args::tclcore { diff --git a/src/vfs/_vfscommon.vfs/modules/punk/basictelnet-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/basictelnet-0.1.0.tm index 16debc6a..fc72e607 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/basictelnet-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/basictelnet-0.1.0.tm @@ -46,12 +46,11 @@ #[list_begin itemized] package require Tcl 8.6- +package require punk::args #*** !doctools #[item] [package {Tcl 8.6}] +#[item] [package {punk::args}] -# #package require frobz -# #*** !doctools -# #[item] [package {frobz}] #*** !doctools #[list_end] @@ -457,16 +456,72 @@ namespace eval punk::basictelnet { } } - proc telnet {{server localhost} {port telnet}} { + punk::args::define { + @id -id ::punk::basictelnet::telnet + @cmd -name punk::basictelnet::telnet -help\ + "Connect to a telnet server or other TCP based service. + The terminal can then be used to interact with the service. + " + -mode -choices {line raw} -default line + -mouse -type boolean -default 0 -help\ + "Whether to enable mouse events" + @values -min 1 -max 2 + server -type string -help\ + "Hostname or IP address" + port -type integer -range {1 65535} -default 23 -help\ + "TCP port" + } + proc telnet {args} { + set argd [punk::args::get_by_id ::punk::basictelnet::telnet $args] + set server [dict get $argd values server] + set port [dict get $argd values port] + set tmode [dict get $argd opts -mode] + set mouse [dict get $argd opts -mouse] + + #todo - check for vt52 and don't try DEC queries + if {[info commands ::mode] eq ""} { + puts stderr "::mode command for terminal is unavailable - please set line/raw mode manually on the terminal" + } else { + set priormode [mode] + if {$tmode ne $priormode} { + ::mode $tmode + } + } + if {[catch {set priormouse [punk::console::get_mode mouse_sgr]}]} { + set priormouse -1 + if {$mouse} { + puts stderr "Cannot determine mouse_sgr mode - assuming terminal doesn't support mouse" + } + } + + #decmode 1006 (SET_SGR_EXT_MODE_MOUSE) + #decmode 1016 (SET_PIXEL_POSITION_MOUSE) + #mouse_sgr 1 - mouse on + #mouse_sgr 2 - mouse off + if {$mouse} { + if {$priormouse eq "2"} { + punk::console::enable_mouse + } + } else { + if {$priormouse eq "1"} { + punk::console::disable_mouse + } + } + variable debug - variable consolewidth ;#note - this is not terminal width for the telnet output - which needs to be about 80cols narrower if debug is to be displayed on same screen - set consolewidth [dict get [punk::console::get_size] columns] + variable consolewidth 80 ;#note - this is not terminal width for the telnet output - which needs to be about 80cols narrower if debug is to be displayed on same screen + catch {set consolewidth [dict get [punk::console::get_size] columns]} + if {$consolewidth eq ""} { + #vt52? + set consolewidth 80 + } + if {$debug && $consolewidth-$::punk::basictelnet::window_cols < 80} { - puts stderr "Terminal width not wide enough for debug_window width: 80 + telnet window_cols:$::punk::basictelnet::window_cols" + puts stderr "Terminal width '$consolewidth' not wide enough for debug_window width: 80 + telnet window_cols:$::punk::basictelnet::window_cols" puts stderr "Turn off debug, or make terminal window wider" return } elseif {$consolewidth < $::punk::basictelnet::window_cols} { - puts stderr "Terminal width is less than telnet window_cols:$::punk::basictelnet::window_cols" + puts stderr "Terminal width '$consolewidth' is less than telnet window_cols:$::punk::basictelnet::window_cols" puts stderr "Ensure terminal is greater than or equal to punk::basictelnet::window_cols" return } @@ -485,6 +540,16 @@ namespace eval punk::basictelnet { vwait ::punk::basictelnet::closed($sock) unset closed($sock) chan conf stdin -blocking 1 + if {[info commands ::mode] ne ""} { + ::mode $priormode + } + + if {$priormouse eq "2"} { + #mouse was off + punk::console::disable_mouse + } elseif {$priormouse eq "1"} { + punk::console::enable_mouse + } } diff --git a/src/vfs/_vfscommon.vfs/modules/punk/blockletter-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/blockletter-0.1.0.tm index aaf3bf3c..99d43075 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/blockletter-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/blockletter-0.1.0.tm @@ -281,9 +281,9 @@ tcl::namespace::eval punk::blockletter::lib { #use tstr when resolving params as a one-off at definition time - #versus slower -dynamic 1 if defaults/choices etc need to reflect the current state of the system. + #versus slower @dynamic if defaults/choices etc need to reflect the current state of the system. punk::args::define [tstr -return string { - @id -id ::punk::blockletter::block + @id -id ::punk::blockletter::lib::block -height -default 2 -width -default 4 -frametype -default {${$::punk::blockletter::default_frametype}} @@ -293,7 +293,7 @@ tcl::namespace::eval punk::blockletter::lib { }] proc block {args} { upvar ::punk::blockletter::default_frametype ft - set argd [punk::args::get_by_id ::punk::blockletter::block $args] + set argd [punk::args::get_by_id ::punk::blockletter::lib::block $args] set bg [dict get $argd opts -bgcolour] set bd [dict get $argd opts -bordercolour] set h [dict get $argd opts -height] diff --git a/src/vfs/_vfscommon.vfs/modules/punk/char-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/char-0.1.0.tm index 8cb06b1f..43dcd6b5 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/char-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/char-0.1.0.tm @@ -2015,7 +2015,7 @@ tcl::namespace::eval punk::char { # ------------------------------------------------------------------------------------------------------ proc grapheme_split_tk {string} { if {![regexp "\[\uFF-\U10FFFF\]" $string]} { - #only ascii - no joiners or unicode + #only ascii (7 or 8 bit) - no joiners or unicode return [split $string {}] } package require tk @@ -2068,14 +2068,14 @@ tcl::namespace::eval punk::char { return $width } proc wcswidth_single {char} { - scan $c %c dec - if {$c <= 255 && !($c < 31 || $c == 127)} { + scan $char %c dec + if {$dec <= 255 && !($dec < 31 || $dec == 127)} { #review - non-printing ascii? why does textutil::wcswidth report 1 ?? #todo - compare with python or other lang wcwidth return 1 - } elseif {$c < 917504 || $c > 917631} { + } elseif {$dec < 917504 || $dec > 917631} { #TODO - various other joiners and non-printing chars - return [textutil::wcswidth_char $c] + return [textutil::wcswidth_char $dec] ;#note textutil::wcswidth_char takes a decimal codepoint! #may return -1 - REVIEW } return 0 @@ -2084,13 +2084,13 @@ tcl::namespace::eval punk::char { set width 0 foreach c [split $string {}] { scan $c %c dec - if {$c <= 255 && !($c < 31 || $c == 127)} { + if {$dec <= 255 && !($dec < 31 || $dec == 127)} { #review - non-printing ascii? why does textutil::wcswidth report 1 ?? #todo - compare with python or other lang wcwidth incr width - } elseif {$c < 917504 || $c > 917631} { + } elseif {$dec < 917504 || $dec > 917631} { #TODO - various other joiners and non-printing chars - set w [textutil::wcswidth_char $c] + set w [textutil::wcswidth_char $dec] ;#takes decimal codepoint if {$w < 0} { return -1 } else { @@ -2117,14 +2117,14 @@ tcl::namespace::eval punk::char { set chunk [tcl::string::range $string $startidx $endidx] set codes [scan $chunk [tcl::string::repeat %c [tcl::string::length $chunk]]] - foreach c $codes { - if {$c <= 255 && !($c < 31 || $c == 127)} { + foreach dec $codes { + if {$dec <= 255 && !($dec < 31 || $dec == 127)} { #review - non-printing ascii? why does textutil::wcswidth report 1 ?? #todo - compare with python or other lang wcwidth incr width - } elseif {$c < 917504 || $c > 917631} { + } elseif {$dec < 917504 || $dec > 917631} { #TODO - various other joiners and non-printing chars - set w [textutil::wcswidth_char $c] + set w [textutil::wcswidth_char $dec] if {$w < 0} { return -1 } else { @@ -2145,18 +2145,18 @@ tcl::namespace::eval punk::char { #TODO set codes [scan $string [tcl::string::repeat %c [tcl::string::length $string]]] set width 0 - foreach c $codes { + foreach dec $codes { #unicode Tags block zero width - if {$c < 917504 || $c > 917631} { - if {$c <= 255} { + if {$dec < 917504 || $dec > 917631} { + if {$dec <= 255} { #review - non-printing ascii? why does textutil::wcswidth report 1 ?? #todo - compare with python or other lang wcwidth - if {!($c < 31 || $c == 127)} { + if {!($dec < 31 || $dec == 127)} { incr width } } else { #TODO - various other joiners and non-printing chars - set w [textutil::wcswidth_char $c] + set w [textutil::wcswidth_char $dec] ;#takes decimal codepoint if {$w < 0} { return -1 } else { @@ -2169,7 +2169,7 @@ tcl::namespace::eval punk::char { } proc wcswidth2 {string} { set codes [scan $string [tcl::string::repeat %c [tcl::string::length $string]]] - set widths [lmap c $codes {textutil::wcswidth_char $c}] + set widths [lmap dec $codes {textutil::wcswidth_char $dec}] if {-1 in $widths} { return -1 } diff --git a/src/vfs/_vfscommon.vfs/modules/punk/console-0.1.1.tm b/src/vfs/_vfscommon.vfs/modules/punk/console-0.1.1.tm index 74365afa..2e10e75b 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/console-0.1.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/console-0.1.1.tm @@ -102,7 +102,8 @@ namespace eval punk::console { } variable ansi_response_chunk ;#array keyed on callid variable ansi_response_wait ;#array keyed on callid - variable ansi_response_queue ;#list of callids + array set ansi_response_wait {} + variable ansi_response_queue [list];#list of callids variable ansi_response_queuedata ;#dict keyed on callid - with function params # -- @@ -123,10 +124,6 @@ namespace eval punk::console { #ansi escape sequences are possibly preferable esp if terminal is remote to process running punk::console # punk::local commands may be more performant in some circumstances where console is directly attached, but it shouldn't be assumed. e.g ansi::titleset outperforms local::titleset on windows with twapi. - namespace eval ansi { - #ansi escape sequence based terminal/console control functions - namespace export * - } namespace eval local { #non-ansi terminal/console control functions #e.g external utils system API's. @@ -578,12 +575,73 @@ namespace eval punk::console { } - #capturingendregex should capture ANY prefix, whole escape match - and a subcapture of the data we're interested in and match at end of string. - #ie {(.*)(ESC(info)end)$} - #e.g {(.*)(\x1bP44!~([:alnum:])\x1b\\)$} - #we expect 4 results from regexp -indices -inline (overallmatch, prefix, wholeescape,info) + lappend PUNKARGS [list { + @id -id ::punk::console::internal::get_ansi_response_payload + @cmd -name punk::console::internal::get_ansi_response_payload -help\ + "Terminal query helper. + Captures the significant portion (payload as defined by + supplied capturingendregex capture groups) of the input + channel's response to a query placed on the output channel. + Usually this means a write to stdout with a response on + stdin. + This function uses a 'chan event' read handler function + ::punk::console::internal::ansi_response_handler_regex to + read the input channel character by character to ensure it + doesn't overconsume input. + + It can run cooperatively with the punk::repl stdin reader + or other readers if done carefully. + The mechanism to run while other readers are active involves + disabling and re-enabling installed 'chan event' handlers + and possibly using a shared namespace variable + (::punk::console::input_chunks_waiting) to ensure all data + gets to the right handler. (unread data on input prior to this + function being called) + Not fully documented. (source diving required -see punk::repl) + " + @opts + -ignoreok -type boolean -default 0 -help\ + "Experimental/debug + ignore the regex match 'ok' response + and keep going." + -return -type string -default payload -choices {payload dict} -choicelabels { + dict\ + "dict with keys prefix,response,payload,all" + } -help\ + "Return format" + + -terminal -default {stdin stdout} -type list -help\ + "terminal (currently list of in/out channels) (todo - object?)" + -expected_ms -default 100 -type integer -help\ + "Expected number of ms for response from terminal. + 100ms is usually plenty for a local terminal and a + basic query such as cursor position." + @values -min 2 -max 2 + query -type string -help\ + "ANSI sequence such as \x1b\[?6n which + should elicit a response by the terminal + on stdin" + capturingendregex -type string -help\ + "capturingendregex should capture ANY prefix, whole escape match - and a subcapture + of the data we're interested in; and match at end of string. + ie {(.*)(ESC(info)end)$} + e.g {(.*)(\x1bP44!~([:alnum:])\x1b\\)$} + we expect 4 results from regexp -indices -inline (overallmatch, prefix, wholeescape,info)" + }] #todo - check capturingendregex value supplied has appropriate captures and tail-anchor - proc get_ansi_response_payload {query capturingendregex {inoutchannels {stdin stdout}}} { + proc get_ansi_response_payload {args} { + #we pay a few 10s of microseconds to use punk::args::parse (on the happy path) + #seems reasonable for the flexibility in this case. + set argd [punk::args::parse $args withid ::punk::console::internal::get_ansi_response_payload] + lassign [dict values $argd] leaders opts values received + + set inoutchannels [dict get $opts -terminal] + set expected [dict get $opts -expected_ms] + set ignoreok [dict get $opts -ignoreok] + set returntype [dict get $opts -return] + set query [dict get $values query] + set capturingendregex [dict get $values capturingendregex] + lassign $inoutchannels input output #chunks from input that need to be handled by readers @@ -595,10 +653,12 @@ namespace eval punk::console { #In other contexts there may not even be another input reader #REVIEW - what if there is existing data in input_chunks_waiting - is it for us? - #temp - let's keep alert to it until we decide if it's legit/required.. - if {[info exists input_chunks_waiting($input)] && [llength $input_chunks_waiting($input)]} { - #puts stderr "[punk::ansi::a+ cyan bold]get_ansi_response_payload called while input_chunks_waiting($input) contained data: $input_chunks_waiting($input)[punk::ansi::a]" - } + #This occurs for example with key held down on autorepeat and is normal + #enable it here for debug/testing only + #if {[info exists input_chunks_waiting($input)] && [llength $input_chunks_waiting($input)]} { + # puts stderr "[punk::ansi::a+ cyan bold]get_ansi_response_payload called while input_chunks_waiting($input) contained data: [punk::ansi::a][ansistring VIEW $input_chunks_waiting($input)]" + #} + if {!$::punk::console::ansi_available} { return "" } @@ -615,17 +675,33 @@ namespace eval punk::console { upvar ::punk::console::ansi_response_wait waitvar upvar ::punk::console::ansi_response_queue queue upvar ::punk::console::ansi_response_queuedata queuedata - upvar ::punk::console::ansi_response_clock clock + upvar ::punk::console::ansi_response_tslaunch tslaunch + upvar ::punk::console::ansi_response_tsclock tsclock upvar ::punk::console::ansi_response_timeoutid timeoutid - set accumulator($callid) "" - set waitvar($callid) "" - lappend queue $callid + set accumulator($callid) "" + set waitvar($callid) "" + + lappend queue $callid + if {[llength $queue] > 1} { + #while {[lindex $queue 0] ne $callid} {} + set queuedata($callid) $args + set runningid [lindex $queue 0] + while {$runningid ne $callid} { + vwait ::punk::console::ansi_response_wait + set runningid [lindex $queue 0] + if {$runningid ne $callid} { + set ::punk::console::ansi_response_wait($runningid) $::punk::console::ansi_response_wait($runningid) + update ;#REVIEW - probably a bad idea + after 10 + } + } + } #todo - use a linked array and an accumulatorid and waitvar id? When can there be more than one terminal query in-flight? - set existing_handler [fileevent $input readable] ;#review! + set existing_handler [chan event $input readable] ;#review! set this_handler ::punk::console::internal::ansi_response_handler_regex if {[lindex $existing_handler 0] eq $this_handler} { puts stderr "[punk::ansi::a+ red]Warning for callid $callid get_ansi_response_payload called while existing ansi response handler in place[a]: $this_handler" @@ -633,109 +709,145 @@ namespace eval punk::console { flush stderr if {[lindex $queue 0] ne $callid} { + error "get_ansi_response_payload - re-entrancy unrecoverable" } - error "get_ansi_response_payload - re-entrancy unrecoverable" } + chan event $input readable {} - fileevent $input readable {} - - set input_state [fconfigure $input] - #todo - make timeout configurable? - set waitvarname "::punk::console::ansi_response_wait($callid)" - #500ms is generally plenty for a terminal to respond.. but not in some cases. e.g event loop busy with stdin keypress?? review - set timeoutid($callid) [after 1000 [list set $waitvarname timedout]] - - #JMN # - stderr vs stdout #It has to be same channel as used by functions such as test_char_width or erroneous results returned for those functions #(presumably race conditions as to when data hits console?) #review - experiment changing this and calling functions to stderr and see if it works #review - Are there disadvantages to using stdout vs stderr? - #puts stdout "sending console request [ansistring VIEW $query]" - puts -nonewline $output $query;flush $output + + set previous_input_state [chan configure $input] + #chan configure $input -blocking 0 + + #todo - make timeout configurable? + set waitvarname "::punk::console::ansi_response_wait($callid)" + #todo - test and save rawstate so we don't disableRaw if console was already raw if {![tsv::get console is_raw]} { set was_raw 0 punk::console::enableRaw + #after 0 [list chan event $input readable [list $this_handler $input $callid $capturingendregex]] + incr expected 50 ;#review + set timeoutid($callid) [after $expected [list set $waitvarname timedout]] + #puts stdout "sending console request [ansistring VIEW $query]" } else { set was_raw 1 + set timeoutid($callid) [after $expected [list set $waitvarname timedout]] } - fconfigure $input -blocking 0 - # - #in handler - its used for a boolean match (capturing aspect not used) - set clock($callid) [clock millis] ;#time of launch - may be delay before first event depending on what's going on + chan configure $input -blocking 0 - #first shot without using filevent, call the stdin reader directly - maybe it's there already - #This can be significantly faster than setting up a fileevent (2024 e.g 1.5ms vs 65ms) + set tslaunch($callid) [clock millis] ;#time of launch - may be delay before first event depending on what's going on + set tsclock($callid) $tslaunch($callid) + #write before console enableRaw vs after?? + #There seem to be problems (e.g on WSL) if we write too early - the output ends up on screen but we don't read it + puts -nonewline $output $query;flush $output $this_handler $input $callid $capturingendregex - if {$waitvar($callid) ne "ok"} { - fileevent $input readable [list $this_handler $input $callid $capturingendregex] + + if {$ignoreok || $waitvar($callid) ne "ok"} { + chan event $input readable [list $this_handler $input $callid $capturingendregex] } - #JMN #response from terminal #e.g for cursor position \033\[46;1R - - if {[set waitvar($callid)] eq ""} { - vwait ::punk::console::ansi_response_wait($callid) + #after 0 [list $this_handler $input $callid $capturingendregex] + set remaining $expected + if {$waitvar($callid) eq ""} { + set lastvwait [clock millis] + vwait ::punk::console::ansi_response_wait($callid) #puts stderr ">>>> end vwait1 $waitvar($callid)<<<<" - while {[string match extend-* $waitvar($callid)]} { - set extension [lindex [split $waitvar($callid) -] 1] - #puts stderr "get_ansi_response_payload Extending timeout by $extension" - #after cancel $timeoutid($callid) - set timeoutid($callid) [after $extension [list set $waitvarname timedout]] - vwait ::punk::console::ansi_response_wait($callid) + while {[string match extend-* $waitvar($callid)] || ($ignoreok && $waitvar($callid) eq "ok")} { + if {[string match extend-* $waitvar($callid)]} { + set extension [lindex [split $waitvar($callid) -] 1] + if {$extension eq ""} { + puts "blank extension $waitvar($callid)" + puts "->[set $waitvar($callid]<-" + } + puts stderr "get_ansi_response_payload Extending timeout by $extension" + after cancel $timeoutid($callid) + set total_elapsed [expr {[clock millis] - $tslaunch($callid)}] + set last_elapsed [expr {[clock millis] - $lastvwait}] + set remaining [expr {$remaining - $last_elapsed}] + if {$remaining < 0} {set remaining 0} + set newtime [expr {$remaining + $extension}] + set timeoutid($callid) [after $newtime [list set $waitvarname timedout]] + set lastvwait [clock millis] + vwait ::punk::console::ansi_response_wait($callid) + } else { + #ignoreok - reapply the handler that disabled itself due to 'ok' + chan event $input readable [list $this_handler $input $callid $capturingendregex] + set lastvwait [clock millis] + vwait ::punk::console::ansi_response_wait($callid) + } } } - #response handler automatically removes it's own fileevent - fileevent $input readable {} ;#explicit remove anyway - review + #response handler automatically removes it's own chan event + chan event $input readable {} ;#explicit remove anyway - review if {$waitvar($callid) ne "timedout"} { after cancel $timeoutid($callid) } else { - puts stderr "timeout in get_ansi_response_payload. callid $callid Ansi request was:[ansistring VIEW -lf 1 -vt 1 $query]" + puts stderr "timeout (timediff [expr {[clock millis] - $tslaunch($callid)}]ms) in get_ansi_response_payload. callid $callid Ansi request was:[ansistring VIEW -lf 1 -vt 1 $query]" } if {$was_raw == 0} { punk::console::disableRaw } + #restore $input state - fconfigure $input -blocking [dict get $input_state -blocking] + #it *might* be ok to restore entire state on an input channel + #(it's not always on all channels - e.g stdout has -winsize which is read-only) + #Safest to only restore what we think we've modified. + fconfigure $input -blocking [dict get $previous_input_state -blocking] - set response [set accumulator($callid)] + set input_read [set accumulator($callid)] - if {$response ne ""} { - set got_match [regexp -indices $capturingendregex $response _match_indices prefix_indices response_indices payload_indices] + if {$input_read ne ""} { + set got_match [regexp -indices $capturingendregex $input_read _match_indices prefix_indices response_indices payload_indices] if {$got_match} { - set responsedata [string range $response {*}$response_indices] - set payload [string range $response {*}$payload_indices] - set prefixdata [string range $response {*}$prefix_indices] - if {$prefixdata ne ""} { - #puts stderr "Warning - get_ansi_response_payload read extra data at start - '[ansistring VIEW -lf 1 $prefixdata]' (response=[ansistring VIEW -lf 1 $responsedata])" + set responsedata [string range $input_read {*}$response_indices] + set payload [string range $input_read {*}$payload_indices] + set prefixdata [string range $input_read {*}$prefix_indices] + if {!$ignoreok && $prefixdata ne ""} { + #puts stderr "Warning - get_ansi_response_payload read extra data at start - '[ansistring VIEW -lf 1 $prefixdata]' (responsedata=[ansistring VIEW -lf 1 $responsedata])" lappend input_chunks_waiting($input) $prefixdata } } else { #timedout - or eof? - puts stderr "get_ansi_response_payload callid:$callid regex match '$capturingendregex' to data '[ansistring VIEW -lf 1 -vt 1 $response]' not found" - lappend input_chunks_waiting($input) $response - set payload "" + if {!$ignoreok} { + puts stderr "get_ansi_response_payload callid:$callid regex match '$capturingendregex' to input_read '[ansistring VIEW -lf 1 -vt 1 $input_read]' not found" + lappend input_chunks_waiting($input) $input_read + set payload "" + } else { + set responsedata "" + set payload "" + set prefixdata "" + } } } else { #timedout or eof? and nothing read - set payload "" + set responsedata "" + set prefixdata "" + set payload "" } + # ------------------------------------------------------------------------------------- + # Other input readers + # ------------------------------------------------------------------------------------- #is there a way to know if existing_handler is input_chunks_waiting aware? if {[string length $existing_handler] && [lindex $existing_handler 0] ne $this_handler} { #puts "get_ansi_response_payload reinstalling ------>$existing_handler<------" - fileevent $input readable $existing_handler - #we may have consumed all pending input on $input - so there may be no trigger for the readable fileevent + chan event $input readable $existing_handler + #this_handler may have consumed all pending input on $input - so there may be no trigger for the readable chan event for existing_handler if {[llength $input_chunks_waiting($input)]} { #This is experimental If a handler is aware of input_chunks_waiting - there should be no need to schedule a trigger #If it isn't, but the handler can accept an existing chunk of data as a 'waiting' argument - we could trigger and pass it the waiting chunks - but there's no way to know its API. @@ -772,33 +884,49 @@ namespace eval punk::console { #The input_chunks_waiting may really belong to the existing_handler we found - but if it doesn't consume them they will end up being read by the repl_handler when it eventually re-enables. #todo - some better structure than just a list of waiting chunks indexed by input channel, so repl/other handlers can determine the context in which these waiting chunks were generated? } elseif {[package provide punk::repl::codethread] ne "" && [punk::repl::codethread::is_running]} { - if {[llength $input_chunks_waiting($input)]} { + #if {[llength $input_chunks_waiting($input)]} { #don't trigger the repl handler manually - we will inevitably get things out of order - as it knows when to enable/disable itself based on whether chunks are waiting. #triggering it by putting it on the eventloop will potentially result in re-entrancy #The cooperating reader must be designed to consume waiting chunks and only reschedule it's channel read handler once all waiting chunks have been consumed. #puts stderr "[punk::ansi::a+ green bold]--> repl_handler has chunks to consume [ansistring VIEW $input_chunks_waiting($input)][punk::ansi::a]" - } + #} if {[eof $input]} { #test - puts stdout "restarting repl" + puts stdout "get_ansi_response_payload experimental - restarting repl" repl::reopen stdin } } + # ------------------------------------------------------------------------------------- - catch { - unset accumulator($callid) - unset waitvar($callid) - dict unset queuedata $callid - } - if {[llength $queue] > 1} { - set next_callid [lindex $queue 1] + + + unset -nocomplain accumulator($callid) + unset -nocomplain waitvar($callid) + unset -nocomplain timeoutid($callid) + unset -nocomplain tsclock($callid) + unset -nocomplain tslaunch($callid) + dict unset queuedata $callid + + lpop queue 0 + if {[llength $queue] > 0} { + set next_callid [lindex $queue 0] set waitvar($callid) go_ahead + #set nextdata [set queuedata($next_callid)] } - lpop queue 0 + #set punk::console::chunk "" - return $payload + if {$returntype eq "dict"} { + return [dict create\ + prefix $prefixdata\ + payload $payload\ + response $responsedata\ + all $input_read\ + ] + } else { + return $payload + } } @@ -811,43 +939,66 @@ namespace eval punk::console { proc ansi_response_handler_regex {chan callid endregex} { upvar ::punk::console::ansi_response_chunk chunks upvar ::punk::console::ansi_response_wait waits - upvar ::punk::console::ansi_response_clock clock ;#initial time in millis was set when fileevent was created + upvar ::punk::console::ansi_response_tslaunch tslaunch ;#initial time in millis was set when chan event was created + upvar ::punk::console::ansi_response_tsclock tsclock #endregex should explicitly have a trailing $ set status [catch {read $chan 1} bytes] if { $status != 0 } { # Error on the channel - fileevent $chan readable {} + chan event $chan readable {} puts "ansi_response_handler_regex error reading $chan: $bytes" - set waits($callid) [list error_read status $status bytes $bytes] + set waits($callid) [list error error_read status $status bytes $bytes] } elseif {$bytes ne ""} { + #puts stderr . ;flush stderr # Successfully read the channel #puts "got: [string length $bytes]bytes" - append chunks($callid) $bytes + set sofar [append chunks($callid) $bytes] #puts stderr [ansistring VIEW $chunks($callid)] - if {[regexp $endregex $chunks($callid)]} { - fileevent $chan readable {} + #review - what is min length of any ansiresponse? + #endregex is capturing - but as we are only testing the match here + #it should perform the same as if it were non-capturing + if {[string length $sofar] > 3 && [regexp $endregex $sofar]} { #puts stderr "matched - setting ansi_response_wait($callid) ok" + chan event $chan readable {} set waits($callid) ok } else { - if {[string length $chunks($callid)] % 10 == 0 || $clock($callid) - [clock millis] > 50} { - after cancel $::punk::console::ansi_response_timeoutid($callid) - set waits($callid) extend-1000 + # 30ms 16ms? + set tsnow [clock millis] + set total_elapsed [expr {[set tslaunch($callid)] - $tsnow}] + set last_elapsed [expr {[set tsclock($callid)] - $tsnow}] + if {[string length $chunks($callid)] % 10 == 0 || $last_elapsed > 16} { + if {$total_elapsed > 3000} { + #REVIEW + #too long since initial read handler launched.. + #is other data being pumped into stdin? Eventloop starvation? Did we miss our codes? + #For now we'll stop extending the timeout. + after cancel $::punk::console::ansi_response_timeoutid($callid) + set waits($callid) [list error error_ansi_response_handler_regex_too_long_reading] + } else { + if {$last_elapsed > 0} { + after cancel $::punk::console::ansi_response_timeoutid($callid) + set waits($callid) extend-[expr {min(16,$last_elapsed)}] + } + } } + set tsclock(callid) [clock millis] } } elseif {[catch {eof $chan}] || [eof $chan]} { - catch {fileevent $chan readable {}} + catch {chan event $chan readable {}} # End of file on the channel #review puts stderr "ansi_response_handler_regex end of file on channel $chan" set waits($callid) eof - } elseif {![catch {fblocked $chan}] && [fblocked $chan]} { - # Read blocked. Just return + } elseif {![catch {chan blocked $chan}] && [chan blocked $chan]} { + # Read blocked is normal. (chan -blocking = 0 but reading only 1 char) # Caller should be using timeout on the wait variable + #set waits($callid) continue + set tsclock($callid) [clock millis] } else { - fileevent $chan readable {} + chan event $chan readable {} # Something else - puts stderr "ansi_response_handler_regex Situation shouldn't be possible. No error and no bytes read on channel $chan but chan is not fblocked or EOF" + puts stderr "ansi_response_handler_regex Situation shouldn't be possible. No error and no bytes read on channel $chan but not chan blocked or EOF" set waits($callid) error_unknown_zerobytes_while_not_blocked_or_eof } } @@ -865,17 +1016,9 @@ namespace eval punk::console { #a and a+ functions are not very useful when emitting directly to console #e.g puts [punk::console::a red]test[punk::console::a cyan] would produce a cyan coloured test as the commands are evaluated first - proc a? {args} { - #stdout - variable ansi_wanted - if {$ansi_wanted <= 0} { - puts -nonewline [punk::ansi::ansistripraw [::punk::ansi::a?]] - } else { - tailcall ansi::a? {*}$args - } - } - punk::args::set_alias ::punk::console::code_a+ ::punk::ansi::a+ + #punk::args::set_alias ::punk::console::code_a+ ::punk::ansi::a+ + lappend PUNKARGS_aliases {::punk::console::code_a+ ::punk::ansi::a+} proc code_a+ {args} { variable ansi_wanted if {$ansi_wanted <= 0} { @@ -885,6 +1028,7 @@ namespace eval punk::console { #tailcall punk::ansi::a+ {*}$args ::punk::ansi::a+ {*}$args } + lappend PUNKARGS_aliases {::punk::console::code_a ::punk::ansi::a} proc code_a {args} { variable ansi_wanted if {$ansi_wanted <= 0} { @@ -893,6 +1037,7 @@ namespace eval punk::console { #tailcall punk::ansi::a {*}$args ::punk::ansi::a {*}$args } + lappend PUNKARGS_aliases {::punk::console::code_a? ::punk::ansi::a?} proc code_a? {args} { variable ansi_wanted if {$ansi_wanted <= 0} { @@ -901,6 +1046,15 @@ namespace eval punk::console { tailcall ::punk::ansi::a? {*}$args } } + #proc a? {args} { + # #stdout + # variable ansi_wanted + # if {$ansi_wanted <= 0} { + # puts -nonewline [punk::ansi::ansistripraw [::punk::ansi::a?]] + # } else { + # tailcall ansi::a? {*}$args + # } + #} #REVIEW! this needs reworking. #It needs to be clarified as to what ansi off is supposed to do. @@ -968,38 +1122,36 @@ namespace eval punk::console { return [expr {!$colour_disabled}] } - - namespace eval ansi { - proc a {args} { - puts -nonewline [::punk::ansi::a {*}$args] - } - proc a? {args} { - puts -nonewline stdout [::punk::ansi::a? {*}$args] - } - proc a+ {args} { - puts -nonewline [::punk::ansi::a+ {*}$args] - } - proc clear {} { - puts -nonewline stdout [punk::ansi::clear] - } - proc clear_above {} { - puts -nonewline stdout [punk::ansi::clear_above] + #test - find a better place to set terminal type + variable is_vt52 0 + proc vt52 {{onoff {}}} { + #todo - return to colour state beforehand?. support 0-15 vt52 colours? + #we shouldn't have to trun off colour to enter vt52 - we should make punk::console emit correct codes + variable is_vt52 + if {$onoff eq ""} { + return $is_vt52 } - proc clear_below {} { - puts -nonewline stdout [punk::ansi::clear_below] + if {![string is boolean -strict $onoff]} { + error "vt52 setting must be a boolean - or empty to query" } - proc clear_all {} { - puts -nonewline stdout [punk::ansi::clear_all] - } - proc reset {} { - puts -nonewline stdout [punk::ansi::reset] + if {$is_vt52} { + if {!$onoff} { + puts -nonewline "\x1b<" + set is_vt52 0 + colour on + } + } else { + if {$onoff} { + unset_mode DECANM + set is_vt52 1 + colour off + } else { + puts -nonewline "\x1b<" + #emit even though our is_vt52 flag thinks it's on. Should be harmless if underlying terminal already vt100+ + } } + return $is_vt52 } - namespace import ansi::clear - namespace import ansi::clear_above - namespace import ansi::clear_below - namespace import ansi::clear_all - namespace import ansi::reset namespace eval local { proc set_codepage_output {cpname} { @@ -1018,22 +1170,117 @@ namespace eval punk::console { error "set_codepage_input unimplemented on $::tcl_platform(platform)" } } + lappend PUNKARGS [list { + @id -id ::punk::console::local::echo + @cmd -name punk::console::local::echo -help\ + "Use stty on unix, or twapi on windows to set terminal + local input echo on/off - experimental" + @values -min 0 -max 1 + onoff -type boolean -default "" -help\ + "Omit or pass empty string to query current echo state." + }] + proc echo {args} { + set argd [punk::args::parse $args withid ::punk::console::local::echo] + set onoff [dict get $argd values onoff] + + set is_windows [string equal "windows" $::tcl_platform(platform)] + if {$onoff eq ""} { + #query + if {$is_windows} { + package require twapi + set inputstate [twapi::get_console_input_mode] + return [dict get $inputstate -echoinput] + } else { + #counterintuitively - the human format (-a) seems more consistent across platforms than the machine readable (-g) formats + #for now, quick and dirty look for echo in the list seems to work on wsl & freebsd at least. + set tstate [exec stty -a] + if {[lsearch $tstate echo] > 0} { + return 1 + } else { + return 0 + } + } + } else { + if {![string is boolean -strict $onoff]} { + error "::punk::console::local::echo requires boolean argument to set on or off" + } + if {$is_windows} { + set onoff [expr {true && $onoff}] ;#ensure true,yes etc are converted to 1|0 + set conh [twapi::get_console_handle stdin] + twapi::modify_console_input_mode $conh -echoinput $onoff + + return $onoff + } else { + if {$onoff} { + {*}[auto_execok stty] echo + return 1 + } else { + {*}[auto_execok stty] -echo + return 0 + } + } + } + } } namespace import local::set_codepage_output namespace import local::set_codepage_input + + lappend PUNKARGS [list { + @id -id ::punk::console::show_input_response + @cmd -name punk::console::show_input_response -help\ + "" + @opts + -terminal -default {stdin stdout} -type list -help\ + "terminal (currently list of in/out channels) (todo - object?)" + -expected_ms -type integer -default 500 -help\ + "Number of ms to wait for response" + @values -min 1 -max 1 + request -type string -help\ + "ANSI sequence such as \x1b\[?6n which + should elicit a response by the terminal + on stdin" + }] + proc show_input_response {args} { + set argd [punk::args::parse $args withid ::punk::console::show_input_response] + lassign [dict values $argd] leaders opts values received + set request [dict get $values request] + set inoutchannels [dict get $opts -terminal] + set expected [dict get $opts -expected_ms] + + set capturingregex {(((.*)))$} ;#capture entire response same as response-payload + set ts_start [clock millis] + set response [punk::console::internal::get_ansi_response_payload -ignoreok 1 -return dict -expected_ms $expected -terminal $inoutchannels $request $capturingregex] + set ts_end [clock millis] + puts stderr $response + set out "" + dict for {k v} $response { + append out "$k [ansistring VIEW $v]" \n + } + append out "totalms [expr {$ts_end - $ts_start}]" + return $out + } + # -- --- --- --- --- --- --- #get_ansi_response functions #review - can these functions sensibly be used on channels not attached to the local console? #ie can we default to {stdin stdout} but allow other channel pairs? # -- --- --- --- --- --- --- proc get_cursor_pos {{inoutchannels {stdin stdout}}} { + if {$::punk::console::is_vt52} { + error "vt52 can't perform get_cursor_pos" + } #response from terminal #e.g \033\[46;1R set capturingregex {(.*)(\x1b\[([0-9]+;[0-9]+)R)$} ;#must capture prefix,entire-response,response-payload set request "\033\[6n" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] + #some terminals fail to respond properly to \x1b\[6n but do respond to \x1b\[?6n and vice-versa :/ + #todo - what? + #often terminals that fail will just put the raw request code on stdin - we could detect that and then + #try the other? + return $payload } proc get_checksum_rect {id page t l b r {inoutchannels {stdin stdout}}} { @@ -1041,13 +1288,13 @@ namespace eval punk::console { #re e.g {(.*)(\x1b\[P44!~([[:alnum:]])\x1b\[\\)$} set capturingregex [string map [list %id% $id] {(.*)(\x1bP%id%!~([[:alnum:]]+)\x1b\\)$}] set request "\x1b\[${id}\;${page}\;$t\;$l\;$b\;$r*y" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } proc get_device_status {{inoutchannels {stdin stdout}}} { set capturingregex {(.*)(\x1b\[([0-9]+)n)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[5n" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } @@ -1083,7 +1330,7 @@ namespace eval punk::console { #set capturingregex {(.*)(\x1b\[\?6[0-9][;]*([;0-9]+)c)$} ;#must capture prefix,entire-response,response-payload set capturingregex {(.*)(\x1b\[\?([0-9]*[;0-9]+)c)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[c" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] set last_da1_result $payload return $payload } @@ -1093,14 +1340,14 @@ namespace eval punk::console { set capturingregex {(.*)(\x1b\[\>([0-9]*[;][0-9]*[;][0-1]c))$} ;#must capture prefix,entire-response,response-payload #expect CSI > X;10|20;0|1c - docs suggest X should be something like 61. In practice we see 0 or 1 (windows) REVIEW set request "\x1b\[>c" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } proc get_device_attributes_tertiary {{inoutchannels {stdin stdout}}} { #DA3 set capturingregex {(.*)(\x1bP!\|([0-9]{8})\x1b\\)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[=c" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } proc get_terminal_id {{inoutchannels {stdin stdout}}} { @@ -1115,7 +1362,7 @@ namespace eval punk::console { #set capturingregex {(.*)(\x1bP2$u((?:[0-9]+)*(?:\/[0-9]+)*)\x1b\\)$} set capturingregex {(.*)(\x1bP2\$u(.*)\x1b\\)$} set request "\x1b\[2\$w" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] set tabstops [split $payload "/"] return $tabstops } @@ -1263,18 +1510,29 @@ namespace eval punk::console { } #keep out of catch - no point in even trying a restore move if we can't get start position - just fail here. + #no vt52 equiv? may as well strip all vt52 from here? lassign [get_cursor_pos_list $inoutchannels] start_row start_col - + variable is_vt52 + if {!$is_vt52} { + set movefunc "punk::ansi::move" + set func_coff "punk::ansi::cursor_off" + set func_con "punk::ansi::cursor_on" + } else { + set movefunc "punk::ansi::vt52move" + set func_coff "punk::ansi::cursor_off_vt52" + set func_con "punk::ansi::cursor_on_vt52" + } if {[catch { #some terminals (conemu on windows) scroll the viewport when we make a big move down like this - a move to 1 1 immediately after cursor_save doesn't seem to fix that. #This issue also occurs when switching back from the alternate screen buffer - so perhaps that needs to be addressed elsewhere. - puts -nonewline $out [punk::ansi::cursor_off][punk::ansi::move 2000 2000] + + puts -nonewline $out [$func_coff][$movefunc 2000 2000] lassign [get_cursor_pos_list $inoutchannels] lines cols - puts -nonewline $out [punk::ansi::move $start_row $start_col][punk::console::cursor_on];flush stdout + puts -nonewline $out [$movefunc $start_row $start_col][$func_con];flush stdout set result [list columns $cols rows $lines] } errM]} { - puts -nonewline $out [punk::ansi::move $start_row $start_col] - puts -nonewline $out [punk::ansi::cursor_on] + puts -nonewline $out [$movefunc $start_row $start_col] + puts -nonewline $out [$func_con] error "$errM" } else { return $result @@ -1316,21 +1574,24 @@ namespace eval punk::console { proc get_xterm_size {{inoutchannels {stdin stdout}}} { set capturingregex {(.*)(\x1b\[8;([0-9]+;[0-9]+)t)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[18t" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] lassign [split $payload {;}] rows cols return [list columns $cols rows $rows] } proc get_xterm_pixels {{inoutchannels {stdin stdout}}} { set capturingregex {(.*)(\x1b\[4;([0-9]+;[0-9]+)t)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[14t" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] lassign [split $payload {;}] height width return [list width $width height $height] } + + + proc get_mode_line_wrap {{inoutchannels {stdin stdout}}} { set capturingregex {(.*)(\x1b\[\?7;([0-9]+)\$y)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[?7\$p" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } #Terminals generally default to LNM being reset (off) ie enter key sends a lone @@ -1339,7 +1600,7 @@ namespace eval punk::console { proc get_mode_LNM {{inoutchannels {stdin stdout}}} { set capturingregex {(.*)(\x1b\[\?20;([0-9]+)\$y)$} ;#must capture prefix,entire-response,response-payload set request "\x1b\[?20\$p" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } #DECRPM responses e.g: @@ -1359,7 +1620,7 @@ namespace eval punk::console { } set capturingregex [string map [list %MODE% $m] {(.*)(\x1b\[\?%MODE%;([0-9]+)\$y)$}] ;#must capture prefix,entire-response,response-payload set request "\x1b\[?$m\$p" - set payload [punk::console::internal::get_ansi_response_payload $request $capturingregex $inoutchannels] + set payload [punk::console::internal::get_ansi_response_payload -terminal $inoutchannels $request $capturingregex] return $payload } proc set_mode {num_or_name {inoutchannels {stdin stdout}}} { @@ -1373,7 +1634,7 @@ namespace eval punk::console { error "punk::console::set_mode unrecognised mode '$num_or_name'. Known mode names: [dict keys $decmode_names]" } } - return "\x1b\[?${m}h" + puts -nonewline "\x1b\[?${m}h" } proc unset_mode {num_or_name {inoutchannels {stdin stdout}}} { if {[string is integer -strict $num_or_name]} { @@ -1386,7 +1647,7 @@ namespace eval punk::console { error "punk::console::unset_mode unrecognised mode '$num_or_name'. Known mode names: [dict keys $decmode_names]" } } - return "\x1b\[?${m}l" + puts -nonewline "\x1b\[?${m}l" } @@ -1584,16 +1845,6 @@ namespace eval punk::console { return [dict create available $is_available mode $m] } - namespace eval ansi { - proc cursor_on {} { - puts -nonewline stdout [punk::ansi::cursor_on] - } - proc cursor_off {} { - puts -nonewline stdout [punk::ansi::cursor_off] - } - } - namespace import ansi::cursor_on - namespace import ansi::cursor_off #review - the concept of using local mechanisms at all (ie apis) vs ansi is not necessarily something we want/need to support. #For the system to be really useful if needs to operate in conditions where the terminal is remote @@ -1625,24 +1876,6 @@ namespace eval punk::console { } } - namespace eval ansi { - proc titleset {windowtitle} { - puts -nonewline stdout [punk::ansi::titleset $windowtitle] - } - } - #namespace import ansi::titleset - proc titleset {windowtitle} { - variable ansi_wanted - if { $ansi_wanted <= 0} { - punk::console::local::titleset $windowtitle - } else { - ansi::titleset $windowtitle - } - } - #no known pure-ansi solution - proc titleget {} { - return [local::titleget] - } proc infocmp {} { set cmd1 [auto_execok infocmp] @@ -1685,16 +1918,113 @@ namespace eval punk::console { return [split $data ";"] } + #channel? namespace eval ansi { + variable PUNKARGS + #ansi escape sequence based terminal/console control functions + namespace export * + + #proc a {args} { + # puts -nonewline [::punk::ansi::a {*}$args] + #} + #proc a+ {args} { + # puts -nonewline [::punk::ansi::a+ {*}$args] + #} + #proc a? {args} { + # puts -nonewline stdout [::punk::ansi::a? {*}$args] + #} + proc clear {} { + puts -nonewline stdout [punk::ansi::clear] + } + proc clear_above {} { + puts -nonewline stdout [punk::ansi::clear_above] + } + proc clear_below {} { + puts -nonewline stdout [punk::ansi::clear_below] + } + proc clear_all {} { + puts -nonewline stdout [punk::ansi::clear_all] + } + proc reset {} { + puts -nonewline stdout [punk::ansi::reset] + } + proc cursor_on {} { + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::cursor_on] + } else { + puts -nonewline stdout [punk::ansi::cursor_on_vt52] + } + } + proc cursor_off {} { + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::cursor_off] + } else { + puts -nonewline stdout [punk::ansi::cursor_off_vt52] + } + } + + lappend PUNKARGS [list { + @id -id ::punk::console::ansi::move + @cmd -name punk::console::move -help\ + {Return an ANSI or vt52 sequence to move cursor to row,col + (aka: cursor home) + + The sequence emitted will depend on the mode of the + terminal as stored in the consolehandle. + Directly setting the mode via raw escape sequences: + e.g unset_mode DECANM for vt52 + or puts \x1b< to return to ANSI + will not necessarily update the application of + the change in terminal state. Major state changes + such as this should be done via provided functions + that keep the REPL state in sync with the underlying + terminal state. + + For ANSI the sequence is of the form: + ESC[;H + (CSI row ; col H) + This sequence will generally not be understood by + terminals that are in vt52 mode. + + For VT52 the sequence is of the form: + ESCY + This sequence will generally not be understood by + terminals that are not in vt52 mode even if higher + modes are supported. + + } + @values -min 2 -max 2 + row -type integer -help\ + "row number - starting at 1" + col -type integer -help\ + "column number - starting at 1" + }] proc move {row col} { - puts -nonewline stdout [punk::ansi::move $row $col] + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + return [punk::ansi::move $row $col] + } else { + return [punk::ansi::vt52move $row $col] + } } proc move_forward {n} { - puts -nonewline stdout [punk::ansi::move_forward $n] + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::move_forward $n] + } else { + puts -nonewline stdout [punk::ansi::vt52move_forward $n] + } } proc move_back {n} { - puts -nonewline stdout [punk::ansi::move_back $n] + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::move_back $n] + } else { + puts -nonewline stdout [punk::ansi::vt52move_back $n] + } } proc move_up {n} { puts -nonewline stdout [punk::ansi::move_up $n] @@ -1703,21 +2033,101 @@ namespace eval punk::console { puts -nonewline stdout [punk::ansi::move_down $n] } proc move_column {col} { - puts -nonewline stdout [punk::ansi::move_column $col] + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::move_column $col] + } else { + puts -nonewline stdout [punk::ansi::vt52move_column $col] + } } proc move_row {row} { puts -nonewline stdout [punk::ansi::move_row $row] } proc move_emit {row col data args} { - puts -nonewline stdout [punk::ansi::move_emit $row $col $data {*}$args] + upvar ::punk::console::is_v52 is_vt52 + if {!$is_vt52} { + puts -nonewline stdout [punk::ansi::move_emit $row $col $data {*}$args] + } else { + puts -nonewline stdout [punk::ansi::v52move_emit $row $col $data {*}$args] + } } proc move_emit_return {row col data args} { + #todo detect if in raw mode or not? + set is_in_raw 0 lassign [punk::console::get_cursor_pos_list] orig_row orig_col - set out "" - append out [punk::ansi::move_emit $row $col $data {*}$args] + + set commands "" + append commands [punk::ansi::move_emit $row $col $data {*}$args] + foreach {row col data} $args { + append commands [punk::ansi::move_emit $row $col $data {*}$args] + } if {!$is_in_raw} { incr orig_row -1 } + append commands [punk::ansi::move $orig_row $orig_col] + puts -nonewline stdout $commands + return "" + } + proc move_emitblock_return {row col textblock} { + lassign [punk::console::get_cursor_pos_list] orig_row orig_col + + set commands "" + foreach ln [split $textblock \n] { + append commands [punk::ansi::move_emit $row $col $ln] + incr row + } + append commands [punk::ansi::move $orig_row $orig_col] + puts -nonewline $commands + return + } + #we can be (slightly?) faster and more efficient if we use the consoles cursor_save_dec command - but each savecursor overrides any previous one. + #leave cursor_off/cursor_on to caller who can wrap more efficiently.. + proc cursorsave_move_emit_return {row col data args} { + upvar ::punk::console::is_vt52 is_vt52 + #JMN + set commands "" + if {!$is_vt52} { + append commands [punk::ansi::cursor_save_dec] + append commands [punk::ansi::move_emit $row $col $data] + foreach {row col data} $args { + append commands [punk::ansi::move_emit $row $col $data] + } + append commands [punk::ansi::cursor_restore_dec] + } else { + append commands [punk::ansi::cursor_save_vt52] + append commands [punk::ansi::vt52move_emit $row $col $data] + foreach {row col data} $args { + append commands [punk::ansi::vt52move_emit $row $col $data] + } + append commands [punk::ansi::cursor_restore_vt52] + } + puts -nonewline stdout $commands; flush stdout + } + proc cursorsave_move_emitblock_return {row col textblock} { + set commands "" + upvar ::punk::console::is_vt52 is_vt52 + if {!$is_vt52} { + append commands [punk::ansi::cursor_save_dec] + foreach ln [split $textblock \n] { + append commands [punk::ansi::move_emit $row $col $ln] + incr row + } + append commands [punk::ansi::cursor_restore_dec] + } else { + append commands [punk::ansi::cursor_save_vt52] + foreach ln [split $textblock \n] { + append commands [punk::ansi::vt52move_emit $row $col $ln] + incr row + } + append commands [punk::ansi::cursor_restore_vt52] + } + puts -nonewline stdout $commands;flush stdout + return + } + proc move_call_return {row col script} { + lassign [punk::console::get_cursor_pos_list] orig_row orig_col + move $row $col + uplevel 1 $script move $orig_row $orig_col } proc scroll_up {n} { @@ -1772,28 +2182,49 @@ namespace eval punk::console { proc delete_lines {count} { puts -nonewline \x1b\[${count}M } + proc titleset {windowtitle} { + puts -nonewline stdout [punk::ansi::titleset $windowtitle] + } + proc test_decaln {} { + puts -nonewline stdout [punk::ansi::test_decaln] + } + } + namespace import ::punk::console::ansi::* + catch {rename titleset ""} + #namespace import ansi::titleset + proc titleset {windowtitle} { + variable ansi_wanted + if { $ansi_wanted <= 0} { + punk::console::local::titleset $windowtitle + } else { + ansi::titleset $windowtitle + } + } + #no known pure-ansi solution + proc titleget {} { + return [local::titleget] + } + + foreach ansicmd [list ::punk::console::ansi::move] { + set ctail [namespace tail $ansicmd] + set arglist [info args $ansicmd] + set argcall "" + if {[llength $arglist]} { + foreach a [lrange $arglist 0 end-1] { + append argcall "\$$a " + } + if {[lindex $arglist end] eq "args"} { + append argcall {{*}$args} + } else { + append argcall "\$[lindex $arglist end]" + } + } + catch {rename $ctail ""} + proc $ctail $arglist [string map [list %ansicmd% $ansicmd %argcall% $argcall] { + puts -nonewline [%ansicmd% %argcall%] + }] } - namespace import ansi::move - namespace import ansi::move_emit - namespace import ansi::move_forward - namespace import ansi::move_back - namespace import ansi::move_up - namespace import ansi::move_down - namespace import ansi::move_column - namespace import ansi::move_row - namespace import ansi::cursor_save - namespace import ansi::cursor_restore - namespace import ansi::cursor_save_dec - namespace import ansi::cursor_restore_dec - namespace import ansi::scroll_up - namespace import ansi::scroll_down - namespace import ansi::enable_alt_screen - namespace import ansi::disable_alt_screen - namespace import ansi::insert_spaces - namespace import ansi::delete_characters - namespace import ansi::erase_characters - namespace import ansi::insert_lines - namespace import ansi::delete_lines + #experimental @@ -1812,90 +2243,25 @@ namespace eval punk::console { puts -nonewline [punk::ansi::erase_eol][punk::ansi::move_column $col]$text cursor_restore } - proc move_emit_return {row col data args} { - #todo detect if in raw mode or not? - set is_in_raw 0 - lassign [punk::console::get_cursor_pos_list] orig_row orig_col - set commands "" - append commands [punk::ansi::move_emit $row $col $data] - foreach {row col data} $args { - append commands [punk::ansi::move_emit $row $col $data] - } - if {!$is_in_raw} { - incr orig_row -1 - } - append commands [punk::ansi::move $orig_row $orig_col] - puts -nonewline stdout $commands - return "" - } - #we can be (slightly?) faster and more efficient if we use the consoles cursor_save_dec command - but each savecursor overrides any previous one. - #leave cursor_off/cursor_on to caller who can wrap more efficiently.. - proc cursorsave_move_emit_return {row col data args} { - set commands "" - append commands [punk::ansi::cursor_save_dec] - append commands [punk::ansi::move_emit $row $col $data] - foreach {row col data} $args { - append commands [punk::ansi::move_emit $row $col $data] - } - append commands [punk::ansi::cursor_restore_dec] - puts -nonewline stdout $commands; flush stdout - } - proc move_emitblock_return {row col textblock} { + #this doesn't work - we would need an internal virtual screen structure to pick up cursor attributes from arbitrary locations? + # ncurses and its ilk may have something like that - but we specifically want to avoid curses libraries + proc pick {row col} { lassign [punk::console::get_cursor_pos_list] orig_row orig_col - - set commands "" - foreach ln [split $textblock \n] { - append commands [punk::ansi::move_emit $row $col $ln] - incr row - } - append commands [punk::ansi::move $orig_row $orig_col] - puts -nonewline $commands - return - } - proc cursorsave_move_emitblock_return {row col textblock} { - set commands "" - append commands [punk::ansi::cursor_save_dec] - foreach ln [split $textblock \n] { - append commands [punk::ansi::move_emit $row $col $ln] - incr row - } - append commands [punk::ansi::cursor_restore_dec] - puts -nonewline stdout $commands;flush stdout - return - } - proc move_call_return {row col script} { + set test "" + #set test [a green Yellow] + move_emit $row $col $test\0337 + puts -nonewline \0338\033\[${orig_row}\;${orig_col}H + } + proc pick_emit {row col data} { + set test "" + #set test [a green Purple] lassign [punk::console::get_cursor_pos_list] orig_row orig_col - move $row $col - uplevel 1 $script - move $orig_row $orig_col + move_emit $row $col $test\0337 + puts -nonewline \0338\033\[${orig_row}\;${orig_col}H$data } - #this doesn't work - we would need an internal virtual screen structure to pick up cursor attributes from arbitrary locations? - # ncurses and its ilk may have something like that - but we specifically want to avoid curses libraries - proc pick {row col} { - lassign [punk::console::get_cursor_pos_list] orig_row orig_col - set test "" - #set test [a green Yellow] - move_emit $row $col $test\0337 - puts -nonewline \0338\033\[${orig_row}\;${orig_col}H - } - proc pick_emit {row col data} { - set test "" - #set test [a green Purple] - lassign [punk::console::get_cursor_pos_list] orig_row orig_col - move_emit $row $col $test\0337 - puts -nonewline \0338\033\[${orig_row}\;${orig_col}H$data - } - # -- --- --- --- --- --- - namespace eval ansi { - proc test_decaln {} { - puts -nonewline stdout [punk::ansi::test_decaln] - } - } - namespace import ansi::test_decaln - namespace eval clock { #map chars of chars "0" to "?"" ie 0x30 to x3f @@ -2152,7 +2518,7 @@ namespace eval punk::console { puts stderr "punk::console WARNING: no modern unicode support in this Tcl version. High unicode values not properly supported. (string length \\U00010000 : $high_unicode_length should be 1)" } else { set can_high_unicode 1 - set can_regex_high_unicode [string match [regexp -all -inline {[\U80-\U0010FFFF]} \U0001F525] \U0001F525] + set can_regex_high_unicode [string equal [regexp -all -inline {[\U80-\U0010FFFF]} \U0001F525] \U0001F525] if {!$can_regex_high_unicode} { puts stderr "punk::console warning: TCL version cannot perform braced regex of high unicode" } @@ -2235,6 +2601,10 @@ namespace eval punk::console::check { +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::console ::punk::console::internal ::punk::console::local ::punk::console::ansi +} diff --git a/src/vfs/_vfscommon.vfs/modules/punk/lib-0.1.1.tm b/src/vfs/_vfscommon.vfs/modules/punk/lib-0.1.1.tm index 1381af87..09a73385 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/lib-0.1.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/lib-0.1.1.tm @@ -246,6 +246,58 @@ tcl::namespace::eval punk::lib::compat { #outside of lmap - don't know of any particularly nice ways to flatten to subindex 1 of each element.. #flattening then lsearch with -stride and * would be nice - but it's not avail in 8.6 + if {![info exists ::auto_index(readFile)]} { + if {[info commands ::readFile] eq ""} { + proc ::readFile {filename {mode text}} { + #readFile not seen in auto_index or as command: installed by punk::lib + # Parse the arguments + set MODES {binary text} + set ERR [list -level 1 -errorcode [list TCL LOOKUP MODE $mode]] + set mode [tcl::prefix match -message "mode" -error $ERR $MODES $mode] + + # Read the file + set f [open $filename [dict get {text r binary rb} $mode]] + try { + return [read $f] + } finally { + close $f + } + } + } + } + if {![info exists ::auto_index(writeFile)]} { + if {[info commands ::writeFile] eq ""} { + proc ::writeFile {args} { + #writeFile not seen in auto_index or as command: installed by punk::lib + # Parse the arguments + switch [llength $args] { + 2 { + lassign $args filename data + set mode text + } + 3 { + lassign $args filename mode data + set MODES {binary text} + set ERR [list -level 1 -errorcode [list TCL LOOKUP MODE $mode]] + set mode [tcl::prefix match -message "mode" -error $ERR $MODES $mode] + } + default { + set COMMAND [lindex [info level 0] 0] + return -code error -errorcode {TCL WRONGARGS} "wrong # args: should be \"$COMMAND filename ?mode? data\"" + } + } + + # Write the File + set f [open $filename [dict get {text w binary wb} $mode]] + try { + puts -nonewline $f $data + } finally { + close $f + } + } + } + } + if {"::lpop" ne [info commands ::lpop]} { #puts stderr "Warning - no built-in lpop" interp alias {} lpop {} ::punk::lib::compat::lpop @@ -1021,35 +1073,35 @@ namespace eval punk::lib { -separator -default "%sep%" -roottype -default "dict" -substructure -default {} - -channel -default stdout -help "existing channel - or 'none' to return as string" + -channel -default stdout -help\ + "existing channel - or 'none' to return as string" @values -min 1 -max -1 dictvar -type string -help "name of variable. Can be a dict, list or array" patterns -type string -default "*" -multiple 1 -help {Multiple patterns can be specified as separate arguments. - Each pattern consists of 1 or more segments separated by the hierarchy separator (forward slash) - The system uses similar patterns to the punk pipeline pattern-matching system. - The default assumed type is dict - but an array will automatically be extracted into key value pairs so will also work. - Segments are classified into list,dict and string operations. - Leading % indicates a string operation - e.g %# gives string length - A segment with a single @ is a list operation e.g @0 gives first list element, @1-3 gives the lrange from 1 to 3 - A segment containing 2 @ symbols is a dict operation. e.g @@k1 retrieves the value for dict key 'k1' - The operation type indicator is not always necessary if lower segments in the hierarchy are of the same type as the previous one. - e.g1 pdict env */%# - the pattern starts with default type dict, so * retrieves all keys & values, - the next hierarchy switches to a string operation to get the length of each value. - e.g2 pdict env W* S* - Here we supply 2 patterns, each in default dict mode - to display keys and values where the keys match the glob patterns - e.g3 pdict punk_testd */* - This displays 2 levels of the dict hierarchy. - Note that if the sublevel can't actually be interpreted as a dictionary (odd number of elements or not a list at all) - - then the normal = separator will be replaced with a coloured (or underlined if colour off) 'mismatch' indicator. - e.g4 set list {{k1 v1 k2 v2} {k1 vv1 k2 vv2}}; pdict list @0-end/@@k2 @*/@@k1 - Here we supply 2 separate pattern hierarchies, where @0-end and @* are list operations and are equivalent - The second level segement in each pattern switches to a dict operation to retrieve the value by key. - When a list operation such as @* is used - integer list indexes are displayed on the left side of the = for that hierarchy level. - + Each pattern consists of 1 or more segments separated by the hierarchy separator (forward slash) + The system uses similar patterns to the punk pipeline pattern-matching system. + The default assumed type is dict - but an array will automatically be extracted into key value pairs so will also work. + Segments are classified into list,dict and string operations. + Leading % indicates a string operation - e.g %# gives string length + A segment with a single @ is a list operation e.g @0 gives first list element, @1-3 gives the lrange from 1 to 3 + A segment containing 2 @ symbols is a dict operation. e.g @@k1 retrieves the value for dict key 'k1' + The operation type indicator is not always necessary if lower segments in the hierarchy are of the same type as the previous one. + e.g1 pdict env */%# + the pattern starts with default type dict, so * retrieves all keys & values, + the next hierarchy switches to a string operation to get the length of each value. + e.g2 pdict env W* S* + Here we supply 2 patterns, each in default dict mode - to display keys and values where the keys match the glob patterns + e.g3 pdict punk_testd */* + This displays 2 levels of the dict hierarchy. + Note that if the sublevel can't actually be interpreted as a dictionary (odd number of elements or not a list at all) + - then the normal = separator will be replaced with a coloured (or underlined if colour off) 'mismatch' indicator. + e.g4 set list {{k1 v1 k2 v2} {k1 vv1 k2 vv2}}; pdict list @0-end/@@k2 @*/@@k1 + Here we supply 2 separate pattern hierarchies, where @0-end and @* are list operations and are equivalent + The second level segement in each pattern switches to a dict operation to retrieve the value by key. + When a list operation such as @* is used - integer list indexes are displayed on the left side of the = for that hierarchy level. } }] #puts stderr "$argspec" @@ -1091,7 +1143,8 @@ namespace eval punk::lib { set sep " [punk::ansi::a+ Green]=$RST " ;#stick to basic default colours for wider terminal support set sep_mismatch " [punk::ansi::a+ Brightred undercurly underline undt-white]mismatch$RST " } - package require punk ;#we need pipeline pattern matching features + package require punk::pipe + #package require punk ;#we need pipeline pattern matching features package require textblock set argd [punk::args::get_dict [string map [list %sep% $sep %sep_mismatch% $sep_mismatch] { @@ -1102,23 +1155,29 @@ namespace eval punk::lib { -channel -default none -trimright -default 1 -type boolean -help\ "Trim whitespace off rhs of each line. - This can help prevent a single long line that wraps in terminal from making - every line wrap due to long rhs padding. - " - -separator -default {%sep%} -help "Separator column between keys and values" - -separator_mismatch -default {%sep_mismatch%} -help "Separator to use when patterns mismatch" - -roottype -default "dict" -help "list,dict,string" - -ansibase_keys -default "" -help "ansi list for each level in -substructure. e.g \[list \[a+ red\] \[a+ web-green\]\]" + This can help prevent a single long line that wraps in terminal from making + every line wrap due to long rhs padding." + -separator -default {%sep%} -help\ + "Separator column between keys and values" + -separator_mismatch -default {%sep_mismatch%} -help\ + "Separator to use when patterns mismatch" + -roottype -default "dict" -help\ + "list,dict,string" + -ansibase_keys -default "" -help\ + "ansi list for each level in -substructure. e.g \[list \[a+ red\] \[a+ web-green\]\]" -substructure -default {} -ansibase_values -default "" - -keytemplates -default {\$\{$key\}} -type list -help "list of templates for keys at each level" + -keytemplates -default {\$\{$key\}} -type list -help\ + "list of templates for keys at each level" -keysorttype -default "none" -choices {none dictionary ascii integer real} -keysortdirection -default increasing -choices {increasing decreasing} -debug -default 0 -type boolean -help\ "When enabled, produces some rudimentary debug output on stderr" @values -min 1 -max -1 - dictvalue -type list -help "dict or list value" - patterns -default "*" -type string -multiple 1 -help "key or key glob pattern" + dictvalue -type list -help\ + "dict or list value" + patterns -default "*" -type string -multiple 1 -help\ + "key or key glob pattern" }] $args] #for punk::lib - we want to reduce pkg dependencies. @@ -1201,7 +1260,7 @@ namespace eval punk::lib { set segments [split $pattern_nest /] set levelpatterns [lindex $segments 0] ;#possibly comma separated patterns #we need to use _split_patterns to separate (e.g to protect commas that appear within quotes) - set patterninfo [punk::_split_patterns $levelpatterns] + set patterninfo [punk::pipe::lib::_split_patterns $levelpatterns] #puts stderr "showdict-->_split_patterns: $patterninfo" foreach v_idx $patterninfo { lassign $v_idx v idx @@ -1479,7 +1538,7 @@ namespace eval punk::lib { # -- --- --- --- set substructure "" set pnext [lindex $segments 1] - set patterninfo [punk::_split_patterns $levelpatterns] + set patterninfo [punk::pipe::lib::_split_patterns $levelpatterns] if {[llength $patterninfo] == 0} { # // ? -review - what does this mean? for xpath this would mean at any level set substructure [lindex $pattern_this_structure end] @@ -2043,18 +2102,32 @@ namespace eval punk::lib { concat {*}[uplevel 1 lmap {*}$args] } - proc dict_getdef {dictValue args} { - if {[llength $args] < 1} { - error {wrong # args: should be "dict_getdef dictValue ?key ...? key default"} - } - set keys [lrange $args -1 end-1] - if {[tcl::dict::exists $dictValue {*}$keys]} { - return [tcl::dict::get $dictValue {*}$keys] - } else { - return [lindex $args end] + #proc dict_getdef {dictValue args} { + # if {[llength $args] < 1} { + # error {wrong # args: should be "dict_getdef dictValue ?key ...? key default"} + # } + # set keys [lrange $args -1 end-1] + # if {[tcl::dict::exists $dictValue {*}$keys]} { + # return [tcl::dict::get $dictValue {*}$keys] + # } else { + # return [lindex $args end] + # } + #} + if {[info commands ::tcl::dict::getdef] eq ""} { + proc dict_getdef {dictValue args} { + set keys [lrange $args 0 end-1] + if {[tcl::dict::exists $dictValue {*}$keys]} { + return [tcl::dict::get $dictValue {*}$keys] + } else { + return [lindex $args end] + } } + } else { + #we pay a minor perf penalty for the wrap + interp alias "" ::punk::lib::dict_getdef "" ::tcl::dict::getdef } + #proc sample1 {p1 n args} { # #*** !doctools # #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] @@ -2722,6 +2795,7 @@ namespace eval punk::lib { } return [join $result \n] } + #dedent? proc undent {text} { if {$text eq ""} { return "" @@ -3795,7 +3869,7 @@ namespace eval punk::lib { } } - + #*** !doctools #[list_end] [comment {--- end definitions namespace punk::lib ---}] @@ -4142,12 +4216,10 @@ tcl::namespace::eval punk::lib::debug { proc showdict {args} {} } -if {![info exists ::punk::args::register::NAMESPACES]} { - namespace eval ::punk::args::register { - set ::punk::args::register::NAMESPACES [list] ;#use fully qualified so 8.6 doesn't find existing var in global namespace - } +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::lib } -lappend ::punk::args::register::NAMESPACES ::punk::lib # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::lib [tcl::namespace::eval punk::lib { diff --git a/src/vfs/_vfscommon.vfs/modules/punk/mix/cli-0.3.1.tm b/src/vfs/_vfscommon.vfs/modules/punk/mix/cli-0.3.1.tm index 9e463eff..5d38fad8 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/mix/cli-0.3.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/mix/cli-0.3.1.tm @@ -177,7 +177,8 @@ namespace eval punk::mix::cli { } } } - cd $sourcefolder + #cd $sourcefolder + #use run so that stdout visible as it goes if {![catch {run --timeout=55000 -debug [info nameofexecutable] $sourcefolder/make.tcl {*}$args} exitinfo]} { #todo - notify if exit because of timeout! @@ -185,11 +186,11 @@ namespace eval punk::mix::cli { set exitcode [dict get $exitinfo exitcode] } else { puts stderr "Error unable to determine exitcode. err: $exitinfo" - cd $startdir + #cd $startdir return false } - cd $startdir + #cd $startdir if {$exitcode != 0} { puts stderr "FAILED with exitcode $exitcode" return false @@ -364,10 +365,10 @@ namespace eval punk::mix::cli { #ignore trailing .tm .TM if present #if version doesn't pass validation - treat it as part of the modulename and return empty version string without error #Up to caller to validate. - proc split_modulename_version {modulename} { - set lastpart [namespace tail $modulename] + proc split_modulename_version {fullmodulename} { + set lastpart [namespace tail $fullmodulename] set lastpart [file tail $lastpart] ;# should be ok to use file tail now that we've ensured no namespace components - if {[string equal -nocase [file extension $modulename] ".tm"]} { + if {[string equal -nocase [file extension $fullmodulename] ".tm"]} { set fileparts [split [file rootname $lastpart] -] } else { set fileparts [split $lastpart -] @@ -380,7 +381,13 @@ namespace eval punk::mix::cli { set namesegment [join $fileparts -] set versionsegment "" } - return [list $namesegment $versionsegment] + set base [namespace qualifiers $fullmodulename] + if {$base ne ""} { + set modulename "${base}::$namesegment" + } else { + set modulename $namesegment + } + return [list $modulename $versionsegment] } proc get_status {{workingdir ""} args} { diff --git a/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/layout-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/layout-0.1.0.tm index 47c75d33..05e94a25 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/layout-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/layout-0.1.0.tm @@ -31,16 +31,42 @@ namespace eval punk::mix::commandset::layout { namespace export * + namespace eval argdoc { + proc layout_names {} { + if {[catch {punk::mix::commandset::layout::lib::layouts_dict *} ldict]} { + #REVIEW + return "punk.project" + } else { + return [dict keys $ldict] + } + } + } #per layout functions - proc files {{layout ""}} { - set argd [punk::args::get_dict { - @id -id ::punk::mix::commandset::layout::files - @values -min 1 -max 1 - layout -type string -minsize 1 - } [list $layout]] + punk::args::define { + @dynamic + @id -id ::punk::mix::commandset::layout::files + -datetime -default "%Y-%m-%dT%H:%M:%S" -help\ + "Datetime format for mtime. Use empty string for no datetime output" + @values -min 1 -max 1 + layout -type string -choices {${[punk::mix::commandset::layout::argdoc::layout_names]}} + } + proc files {args} { + set argd [punk::args::get_by_id ::punk::mix::commandset::layout::files $args] + set layout [dict get $argd values layout] + set dtformat [dict get $argd opts -datetime] set allfiles [lib::layout_all_files $layout] - return [join $allfiles \n] + if {$dtformat eq ""} { + return [join $allfiles \n] + } else { + set out "" + foreach f $allfiles { + set mtime [dict get [file stat $f] mtime] + append out "$f [clock format $mtime -format $dtformat]" \n + } + set out [string range $out 0 end-1] + return $out + } } proc templatefiles {layout} { set templatefiles_and_tags [lib::layout_scan_for_template_files $layout] @@ -166,7 +192,7 @@ namespace eval punk::mix::commandset::layout { } proc as_dict {args} { - tailcall punk::mix::commandset::layout::lib::layouts_dict {*}$args + punk::mix::commandset::layout::lib::layouts_dict {*}$args } proc references_as_dict {args} { package require punk::cap diff --git a/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/loadedlib-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/loadedlib-0.1.0.tm index b5539021..b964d228 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/loadedlib-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/loadedlib-0.1.0.tm @@ -1,5 +1,5 @@ # -*- tcl -*- -# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from -buildversion.txt +# Maintenance Instruction: leave the 999999.xxx.x as is and use 'deck make' or src/make.tcl to update from -buildversion.txt # # Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. # Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. @@ -304,11 +304,12 @@ namespace eval punk::mix::commandset::loadedlib { } set versions [package versions [lindex $libfound 0]] - if {$has_natsort} { - set versions [natsort::sort $versions] - } else { - set versions [lsort $versions] - } + set versions [lsort -command {package vcompare} $versions] + #if {$has_natsort} { + # set versions [natsort::sort $versions] + #} else { + # set versions [lsort $versions] + #} if {![llength $versions]} { error "No version numbers found for library/module $libfound - sorry, you will need to copy it across manually" } diff --git a/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/module-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/module-0.1.0.tm index 41206d0c..ae21d348 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/module-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/module-0.1.0.tm @@ -120,17 +120,20 @@ namespace eval punk::mix::commandset::module { return $table } - #return all module templates with repeated ones suffixed with .2 .3 etc + + #return all module templates with repeated ones suffixed with #2 #3 etc + punk::args::define { + @id -id ::punk::mix::commandset::module::templates_dict + @cmd -name templates_dict -help\ + "Templates from module and project paths" + -startdir -default "" -help\ + "Project folder used in addition to module paths" + -not -default "" -multiple 1 + @values + globsearches -default * -multiple 1 + } proc templates_dict {args} { - set argspec { - @id -id ::punk::mix::commandset::module::templates_dict - @cmd -name templates_dict -help "Templates from module and project paths" - -startdir -default "" -help "Project folder used in addition to module paths" - -not -default "" -multiple 1 - @values - globsearches -default * -multiple 1 - } - set argd [punk::args::get_dict $argspec $args] + set argd [punk::args::get_by_id ::punk::mix::commandset::module::templates_dict $args] package require punk::cap if {[punk::cap::capability_has_handler punk.templates]} { set template_folder_dict [punk::cap::call_handler punk.templates get_itemdict_moduletemplates {*}$args] @@ -154,10 +157,11 @@ namespace eval punk::mix::commandset::module { the higher version number will be used. " -license -default + -author -default -multiple 1 -template -default punk.module -type -default "[lindex $moduletypes 0]" -choices {$moduletypes} -force -default 0 -type boolean -help\ - "If set true, will overwrite an existing .tm file if there is one. + "If set true, will OVERWRITE an existing .tm file if there is one. If false (default) an error will be raised if there is a conflict." -quiet -default 0 -type boolean -help\ "Suppress information messages on stdout" @@ -262,6 +266,7 @@ namespace eval punk::mix::commandset::module { } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_license [dict get $opts -license] + set opt_authors [dict get $opts -author] ;#-multiple true # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_template [dict get $opts -template] if {[regexp {.*[?*].*} $opt_template]} { @@ -403,7 +408,7 @@ namespace eval punk::mix::commandset::module { #for now the user has the option to override any templates and remove %moduletemplate% if it is a security/privacy concern #Don't put literal %x% in the code for the commandset::module itself - to stop them being seen by layout scanner as replacable tokens - set tagnames [list moduletemplate $moduletemplate project $projectname pkg $modulename year $year license $opt_license version $infile_version] + set tagnames [list moduletemplate $moduletemplate project $projectname pkg $modulename year $year license $opt_license authors $opt_authors version $infile_version] set strmap [list] foreach {tag val} $tagnames { lappend strmap %$tag% $val diff --git a/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/project-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/project-0.1.0.tm index 80cab2a7..2ff8ac06 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/project-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/project-0.1.0.tm @@ -109,7 +109,26 @@ namespace eval punk::mix::commandset::project { } - + namespace eval argdoc { + set layout_dict [punk::cap::call_handler punk.templates get_itemdict_projectlayouts] + variable LAYOUTNAMES [dict keys $layout_dict] + } + punk::args::define { + @id -id ::punk::mix::commandset::project::new + @cmd -name "punk::mix::commandset::project::new" -help\ + "" + @leaders -min 1 -max 1 + project -type string -help\ + "Project name or path. + If just a name is given ... (todo)" + @opts + -type -default plain + -empty -default 0 -type boolean + -force -default 0 -type boolean + -update -default 0 -type boolean + -confirm -default 1 -type boolean + -layout -default "punk.project" -choices {${$::punk::mix::commandset::project::argdoc::LAYOUTNAMES}} + } proc new {newprojectpath_or_name args} { #*** !doctools @@ -300,7 +319,17 @@ namespace eval punk::mix::commandset::project { } } } elseif {$project_dir_exists && $opt_update} { - puts stderr "mix new WARNING: -update 1 was supplied. Will copy layout $layout_path using -update option to add missing items" + set warnmsg "mix new WARNING: -update 1 was supplied. Will copy layout $layout_path using -update option to add missing items" + if {$opt_confirm} { + puts stderr $warnmsg + set msg "Do you want to proceed to possibly overwrite some existing files in $projectdir? Y|N" + set answer [util::askuser $msg] + if {[string tolower $answer] ne "y"} { + puts stderr "mix new aborting due to user response '$answer' (required Y|y to proceed) use -confirm 0 to avoid prompt." + return + } + } + puts stderr $warnmsg } set fossil_repo_file "" @@ -366,28 +395,40 @@ namespace eval punk::mix::commandset::project { #default antiglob_dir_core will stop .fossil* from being updated - which is generally desirable as these are likely to be customized if {$opt_force} { puts stdout "copying layout files - with force applied - overwrite all-targets" - set resultdict [punkcheck::install $layout_path $projectdir -installer project.new -overwrite ALL-TARGETS -antiglob_paths $antipaths -antiglob_dir $antiglob_dir] + set resultdict [punkcheck::install $layout_path $projectdir -installer project.new -createempty 1 -overwrite ALL-TARGETS -antiglob_paths $antipaths -antiglob_dir $antiglob_dir] } else { puts stdout "copying layout files - (if source file changed)" - set resultdict [punkcheck::install $layout_path $projectdir -installer project.new -overwrite installedsourcechanged-targets -antiglob_paths $antipaths -antiglob_dir $antiglob_dir] + set resultdict [punkcheck::install $layout_path $projectdir -installer project.new -createempty 1 -overwrite installedsourcechanged-targets -antiglob_paths $antipaths -antiglob_dir $antiglob_dir] } puts stdout [punkcheck::summarize_install_resultdict $resultdict] - puts stdout "copying layout src/doc files (if target missing)" - set resultdict [punkcheck::install $layout_path/src/doc $projectdir/src/doc -punkcheck_folder $projectdir -installer project.new -overwrite SYNCED-TARGETS] - puts stdout [punkcheck::summarize_install_resultdict $resultdict] + if {[file exists $layout_path/src/doc]} { + puts stdout "copying layout src/doc files (if target missing)" + set resultdict [punkcheck::install $layout_path/src/doc $projectdir/src/doc -createdir 1 -punkcheck_folder $projectdir -installer project.new -overwrite SYNCED-TARGETS] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + } else { + puts stdout "no src/doc in source template - update not required" + } #target folders .fossil-custom and .fossil-settings may not exist. use -createdir 1 to ensure existence. #In this case we need to override the default dir antiglob - as .fossil-xxx folders need to be installed from template if missing, or if target is uncustomized. ## default_antiglob_dir_core [list "#*" "_aside" ".git" ".fossil*"] set override_antiglob_dir_core [list #* _aside .git] - puts stdout "copying layout src/.fossil-custom files (if target missing or uncustomised)" - set resultdict [punkcheck::install $layout_path/.fossil-custom $projectdir/.fossil-custom -createdir 1 -punkcheck_folder $projectdir -installer project.new -antiglob_dir_core $override_antiglob_dir_core -overwrite SYNCED-TARGETS] - puts stdout [punkcheck::summarize_install_resultdict $resultdict] + if {[file exists $layout_path/.fossil-custom]} { + puts stdout "copying layout src/.fossil-custom files (if target missing or uncustomised)" + set resultdict [punkcheck::install $layout_path/.fossil-custom $projectdir/.fossil-custom -createdir 1 -createempty 1 -punkcheck_folder $projectdir -installer project.new -antiglob_dir_core $override_antiglob_dir_core -overwrite SYNCED-TARGETS] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + } else { + puts stdout "no .fossil-custom in source template - update not required" + } - puts stdout "copying layout src/.fossil-settings files (if target missing or uncustomised)" - set resultdict [punkcheck::install $layout_path/.fossil-settings $projectdir/.fossil-settings -createdir 1 -punkcheck_folder $projectdir -installer project.new -antiglob_dir_core $override_antiglob_dir_core -overwrite SYNCED-TARGETS] - puts stdout [punkcheck::summarize_install_resultdict $resultdict] + if {[file exists $layout_path/.fossil-settings]} { + puts stdout "copying layout src/.fossil-settings files (if target missing or uncustomised)" + set resultdict [punkcheck::install $layout_path/.fossil-settings $projectdir/.fossil-settings -createdir 1 -createempty 1 -punkcheck_folder $projectdir -installer project.new -antiglob_dir_core $override_antiglob_dir_core -overwrite SYNCED-TARGETS] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + } else { + puts stdout "no .fossil-settings in source template - update not required" + } #scan all files in template # diff --git a/src/vfs/_vfscommon.vfs/modules/punk/nav/fs-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/nav/fs-0.1.0.tm index 5d601b3a..140f2678 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/nav/fs-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/nav/fs-0.1.0.tm @@ -281,7 +281,8 @@ tcl::namespace::eval punk::nav::fs { } } - if {[file pathtype $a1] ne "relative"} { + if {![regexp {[*?]} $a1] && [file pathtype $a1] ne "relative"} { + #non-relative non-glob if { ![string match //zipfs:/* $a1]} { if {[file type $a1] eq "directory"} { cd $a1 diff --git a/src/vfs/_vfscommon.vfs/modules/punk/ns-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/ns-0.1.0.tm index 8fa9ce89..4eb6526d 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/ns-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/ns-0.1.0.tm @@ -26,9 +26,16 @@ tcl::namespace::eval ::punk::ns::evaluator { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::ns { - variable ns_current "::" + variable ns_current + #allow presetting + if {![info exists ::punk::ns::ns_current]} { + set ns_current :: + } + variable ns_re_cache [dict create] ;#cache regular expressions used in globmatchns namespace export nsjoin nsprefix nstail nsparts nseval nschildren nsimport_noclobber corp + namespace path {::punk::lib ::punk::ansi} ;#list_as_lines etc + catch { package require debug debug define punk.ns.compile @@ -1259,7 +1266,7 @@ tcl::namespace::eval punk::ns { } else { set report_namespaces $matched_namespaces } - punk::args::update_definitions + punk::args::update_definitions $report_namespaces set nsdict_list [list] foreach ch $report_namespaces { @@ -1371,9 +1378,9 @@ tcl::namespace::eval punk::ns { #use aliases glob - because aliases can be present with or without leading :: #NOTE: alias may not have matching command in the relevant namespce (renamed alias) so we can't just start with commands and check if it's an alias if we want to show all aliases if {$weird_ns} { - set raw_aliases [nseval_ifexists $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. + set raw_aliases [nseval_ifexists $location [list ::punk::lib::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. } else { - set raw_aliases [tcl::namespace::eval $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. + set raw_aliases [tcl::namespace::eval $location [list ::punk::lib::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. } #set raw_aliases [nseval $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. set aliases [list] @@ -1620,6 +1627,7 @@ tcl::namespace::eval punk::ns { if {$has_punkargs} { #set id [string trimleft $fq :] set id $fq + punk::args::update_definitions [list [namespace qualifiers $id]] if {[::punk::args::id_exists $id]} { lappend usageinfo $c } else { @@ -1969,7 +1977,8 @@ tcl::namespace::eval punk::ns { #todo - -cache or -refresh to configure whether we introspect ensembles/objects each time? # - as this is interactive generally introspection should be ok at the top level # but if we need to go down multiple levels of subcommands generating/testing prefixes - could be an issue ?? - punk::args::define -dynamic 0 { + punk::args::define { + @dynamic @id -id ::punk::ns::arginfo @cmd -name punk::ns::arginfo -help\ "Show usage info for a command. @@ -1995,20 +2004,20 @@ tcl::namespace::eval punk::ns { -return -type string -default table -choices {string table tableobject} - } {${[punk::args::resolved_def -type @opts ::punk::args::arg_error -scheme]}} { + } {${[punk::args::resolved_def -types opts ::punk::args::arg_error -scheme]}} { -- -type none -help\ "End of options marker - Use this if the command to view begins with a -" + Use this if the command to view begins with a -" @values -min 1 commandpath -help\ "command (may be alias, ensemble, tcl::oo object, tepam proc etc)" subcommand -optional 1 -multiple 1 -default {} -help\ "subcommand if commandpath is an ensemble. - Multiple subcommands can be supplied if ensembles are further nested" + Multiple subcommands can be supplied if ensembles are further nested" } proc arginfo {args} { - lassign [dict values [punk::args::get_by_id ::punk::ns::arginfo $args]] leaders opts values received + lassign [dict values [punk::args::parse $args withid ::punk::ns::arginfo]] leaders opts values received #review - setting this afterwards is an architecture smell - we should be able to override the default in the dynamic part #todo - enable retrieving by id just the record_opts part - so we can treat as a dict directly, as well as easily apply it as a different flag name. @@ -2018,7 +2027,6 @@ tcl::namespace::eval punk::ns { set querycommand [dict get $values commandpath] set queryargs [dict get $values subcommand] - punk::args::update_definitions ;#ensure any packages that register PUNKARGS have been loaded #todo - similar to corp? review corp resolution process @@ -2087,6 +2095,16 @@ tcl::namespace::eval punk::ns { } } + #check for a direct match first + if {[info commands ::punk::args::id_exists] ne ""} { + if {![llength $queryargs]} { + punk::args::update_definitions [list [namespace qualifiers $origin]] + if {[punk::args::id_exists $origin]} { + return [uplevel 1 [list punk::args::usage {*}$opts $origin]] + } + } + } + #ns::cmdtype only detects alias type on 8.7+? set initial_cmdtype [punk::ns::cmdtype $origin] switch -- $initial_cmdtype { @@ -2137,31 +2155,40 @@ tcl::namespace::eval punk::ns { set id $origin if {[info commands ::punk::args::id_exists] ne ""} { - #cycle through longest first checking for id matching ::cmd ?subcmd..? - #REVIEW - this doesn't cater for prefix callable subcommands! + + + #check longest first checking for id matching ::cmd ?subcmd..? + #REVIEW - this doesn't cater for prefix callable subcommands set argcopy $queryargs - while {[llength $argcopy]} { - if {[punk::args::id_exists [list $id {*}$argcopy]]} { - return [uplevel 1 [list punk::args::usage {*}$opts [list $id {*}$argcopy]]] + if {[llength $queryargs]} { + punk::args::update_definitions [list [namespace qualifiers $id]] + if {[punk::args::id_exists [list $id {*}$queryargs]]} { + return [uplevel 1 [list punk::args::usage {*}$opts [list $id {*}$queryargs]]] } - lpop argcopy } + #while {[llength $argcopy]} { + # if {[punk::args::id_exists [list $id {*}$argcopy]]} { + # return [uplevel 1 [list punk::args::usage {*}$opts [list $id {*}$argcopy]]] + # } + # lpop argcopy + #} #didn't find any exact matches #traverse from other direction taking prefixes into account + punk::args::update_definitions [list [namespace qualifiers $id]] if {[punk::args::id_exists $id]} { #cycle forward through leading values - set def [punk::args::get_def $id] + set spec [punk::args::get_spec $id] if {[llength $queryargs]} { set nextqueryargs [list] ;#build a list of prefix-resolved queryargs set queryargs_untested $queryargs foreach q $queryargs { - if {[llength [dict get $def LEADER_NAMES]]} { - set subitems [dict get $def LEADER_NAMES] + if {[llength [dict get $spec LEADER_NAMES]]} { + set subitems [dict get $spec LEADER_NAMES] if {[llength $subitems]} { set next [lindex $subitems 0] - set arginfo [dict get $def ARG_INFO $next] + set arginfo [dict get $spec ARG_INFO $next] set allchoices [list] set choices [punk::args::system::Dict_getdef $arginfo -choices {}] @@ -2184,16 +2211,22 @@ tcl::namespace::eval punk::ns { #we have our first difference - recurse with new query args #set numvals [expr {[llength $queryargs]+1}] #return [ punk::ns::arginfo {*}[lrange $args 0 end-$numvals] $querycommand {*}$nextqueryargs {*}$queryargs_untested] - + #puts "===> testing arginfo {*}$opts $querycommand {*}$nextqueryargs {*}$queryargs_untested" return [ punk::ns::arginfo {*}$opts $querycommand {*}$nextqueryargs {*}$queryargs_untested] } #check if subcommands so far have a custom args def - set currentid [list $querycommand {*}$nextqueryargs] + #set currentid [list $querycommand {*}$nextqueryargs] + set currentid [list $id {*}$nextqueryargs] if {[punk::args::id_exists $currentid]} { - set def [punk::args::get_def $currentid + set spec [punk::args::get_spec $currentid] } else { #We can get no further with custom defs + #It is possible we have a documented lower level subcommand but missing the intermediate + #e.g if ::trace remove command was specified and is documented - it will be found above + #but if ::trace remove is not documented and the query is "::trace remove com" + #There is no way to determine com is a prefix as we don't have the intermediate documented -choice info available. + #that's probably ok. break } } @@ -2307,7 +2340,7 @@ tcl::namespace::eval punk::ns { set implementations [::info object call $origin $c1] #result documented as list of 4 element lists #set callinfo [lindex $implementations 0] - set def "" + set oodef "" foreach impl $implementations { lassign $impl generaltype mname location methodtype switch -- $generaltype { @@ -2323,7 +2356,7 @@ tcl::namespace::eval punk::ns { return [uplevel 1 [list punk::args::usage {*}$opts $idcustom]] } } - set def [::info object definition $origin $c1] + set oodef [::info object definition $origin $c1] } else { #set id "[string trimleft $location :] $c1" ;# " " set idcustom "$location $c1" @@ -2332,7 +2365,7 @@ tcl::namespace::eval punk::ns { return [uplevel 1 [list punk::args::usage {*}$opts $idcustom]] } } - set def [::info class definition $location $c1] + set oodef [::info class definition $location $c1] } break } @@ -2342,10 +2375,9 @@ tcl::namespace::eval punk::ns { } } } - if {$def ne ""} { - #assert - if we pre + if {$oodef ne ""} { set autoid "(autodef)$location $c1" - set arglist [lindex $def 0] + set arglist [lindex $oodef 0] set argdef [punk::lib::tstr -return string { @id -id "${$autoid}" @cmd -name "${$location} ${$c1}" -help\ @@ -2368,7 +2400,7 @@ tcl::namespace::eval punk::ns { append argdef \n "[lindex $a 0] -default {[lindex $a 1]} -optional 1" } default { - error "punk::ns::arginfo unexpected argument signature '$arglist'\ndef:$def\nimplementaions:$implementations" + error "punk::ns::arginfo unexpected oo argument signature '$arglist'\noodef:$oodef\nimplementations:$implementations" } } incr i @@ -2427,7 +2459,7 @@ tcl::namespace::eval punk::ns { @id -id ${$idauto} @cmd -name "Object: ${$origin}" -help\ "Instance of class: ${$class} (info autogenerated)" - @values -min 1 + @leaders -min 1 }] append argdef \n $vline punk::args::define $argdef @@ -2542,7 +2574,7 @@ tcl::namespace::eval punk::ns { @cmd -help\ "(autogenerated) ensemble: ${$origin}" - @values -min 1 + @leaders -min 1 }] append argdef \n $vline punk::args::define $argdef @@ -2977,84 +3009,100 @@ tcl::namespace::eval punk::ns { If not supplied, caller's namespace is used." -prefix -optional 1 -help\ "string prefix for command names in target namespace" - @values -min 1 -max 1 - sourcepattern -type string -optional 0 -help\ - "Glob pattern for source namespace. + @values -min 1 -max -1 + sourcepattern -type string -optional 0 -multiple 1 -help\ + "Glob pattern(s) for exported commands in source namespace(s). Globbing only active in the tail segment. - e.g ::mynamespace::*" + e.g ::mynamespace::a* ::mynamespace::j*" } proc nsimport_noclobber {args} { lassign [dict values [punk::args::get_by_id ::punk::ns::nsimport_noclobber $args]] leaders opts values received - set sourcepattern [dict get $values sourcepattern] + set sourcepatterns [dict get $values sourcepattern] - set source_ns [tcl::namespace::qualifiers $sourcepattern] - if {![tcl::namespace::exists $source_ns]} { - error "nsimport_noclobber error namespace $source_ns not found" - } set nscaller [uplevel 1 {namespace current}] if {![dict exists $received -targetnamespace]} { set target_ns $nscaller } else { set target_ns [dict get $opts -targetnamespace] if {![string match ::* $target_ns]} { - set target_ns [punk::nsjoin $nscaller $target_ns] + set target_ns [punk::ns::nsjoin $nscaller $target_ns] } } + set all_imported [list] + set nstemp ::punk::ns::temp_import - set a_export_patterns [tcl::namespace::eval $source_ns {namespace export}] - set a_commands [info commands $sourcepattern] - set a_tails [lmap v $a_commands {tcl::namespace::tail $v}] - set a_exported_tails [list] - foreach epattern $a_export_patterns { - set matches [lsearch -all -inline $a_tails $epattern] - foreach m $matches { - if {$m ni $a_exported_tails} { - lappend a_exported_tails $m + foreach pat $sourcepatterns { + set source_ns [tcl::namespace::qualifiers $pat] + if {![tcl::namespace::exists $source_ns]} { + error "nsimport_noclobber error namespace $source_ns not found" + } + + set a_export_patterns [tcl::namespace::eval $source_ns {namespace export}] + set a_commands [info commands $pat] + #puts "-->commands:'$a_commands'" + set a_tails [lmap v $a_commands {tcl::namespace::tail $v}] + set a_exported_tails [list] + foreach epattern $a_export_patterns { + set matches [lsearch -all -inline $a_tails $epattern] + foreach m $matches { + #we will be using namespace import one by one on commands. + #we must protect glob chars that may exist in the actual command names. + #e.g nsimport_noclobber ::punk::ansi::a? + # will import a+ and a? + #but nsimport_noclobber {::punk::ansi::a\?} + # must import only a? + set m [string map {\\ \\\\ ? \\? * \\* \[ \\[ \] \\]} $m] + if {$m ni $a_exported_tails} { + lappend a_exported_tails $m + } } } - } - set nstemp ::punk::ns::temp_import - if {[tcl::dict:::exists $received -prefix]} { - set pfx [dict get $opts -prefix] - set imported_commands [list] - if {[namespace exists $nstemp]} { - namespace delete $nstemp - } - namespace eval $nstemp {} - foreach e $a_exported_tails { - set imported [tcl::namespace::eval $nstemp [string map [list $e $source_ns $pfx $target_ns] { - set cmd "" - if {![catch {namespace import ::}]} { - #renaming will fail if target already exists - #renaming a command into another namespace still results in a command with 'info cmdtype' = 'import' - if {![catch {rename [punk::ns::nsjoin ]}]} { - set cmd + + + if {[tcl::dict:::exists $received -prefix]} { + #import via temporary/intermediate namespace + set pfx [dict get $opts -prefix] + set imported_commands [list] + if {[namespace exists $nstemp]} { + namespace delete $nstemp + } + namespace eval $nstemp {} + foreach e $a_exported_tails { + set imported [apply {{tgtns func srcns pfx tmpns} { + set cmd "" + if {![catch {::tcl::namespace::eval $tmpns [list ::namespace import ${srcns}::$func]}]} { + #renaming will fail if target already exists + #renaming a command into another namespace still results in a command with 'info cmdtype' = 'import' + if {![catch {::tcl::namespace::eval $tmpns [list ::rename $func [::punk::ns::nsjoin $tgtns $pfx$func]]}]} { + set cmd $pfx$func + } } + set cmd + } } $target_ns $e $source_ns $pfx $nstemp] + if {$imported ne ""} { + lappend imported_commands $imported } - set cmd - }]] - if {$imported ne ""} { - lappend imported_commands $imported } - } - namespace delete $nstemp - return $imported_commands - } - - set imported_commands [list] - foreach e $a_exported_tails { - set imported [tcl::namespace::eval $target_ns [string map [list $e $source_ns] { - set cmd "" - if {![catch {namespace import ::}]} { - set cmd + namespace delete $nstemp + } else { + #no prefix - direct import + set imported_commands [list] + foreach e $a_exported_tails { + set imported [apply {{tgtns func srcns} { + set cmd "" + if {![catch {tcl::namespace::eval $tgtns [list namespace import ${srcns}::$func]}]} { + set cmd $func + } + set cmd + } } $target_ns $e $source_ns] + if {$imported ne ""} { + lappend imported_commands $imported + } } - set cmd - }]] - if {[string length $imported]} { - lappend imported_commands $imported } + lappend all_imported {*}$imported_commands } - return $imported_commands + return $all_imported } #todo - use ns::nsimport_noclobber instead ? @@ -3092,7 +3140,23 @@ tcl::namespace::eval punk::ns { interp alias {} corp {} punk::ns::corp interp alias {} i {} punk::ns::arginfo - + #An example of using punk::args in a pipeline + punk::args::define { + @id -id ::i+ + @cmd -name "i+" -help\ + "Display command help side by side" + @values + cmds -multiple 1 -help\ + "Command names for which to show help info" + } + interp alias {} i+ {}\ + .=args> punk::args::get_by_id ::i+ |argd>\ + .=>2 dict get values cmds |cmds>\ + .=cmds>2 lmap c {i -return tableobject {*}$c} |objs>\ + .=objs>2 lmap t {$t configure -show_vseps 0 -show_edge 1} |>\ + .=objs>2 lmap t {$t print} |tables>\ + .=objs>2 lmap t {$t destroy} |>\ + .=tables>* textblock::join -- 1} { + # --------------------------------------------------------------- + #An attempt to detect dll/so loaded and try to load same version + #dll/so files are often named with version numbers that don't contain dots or a version number at all + #e.g sqlite3400.dll Thread288.dll + set pkgloadedinfo [lsearch -nocase -inline -index 1 [info loaded] $pkg] + + if {[llength $pkgloadedinfo]} { + puts stderr "--> pkg not already 'provided' but shared object seems to be loaded: $pkgloadedinfo - and multiple versions available" + lassign $pkgloadedinfo path name + set lcpath [string tolower $path] + #first attempt to find a match for our loaded sharedlib path in a *simple* package ifneeded statement. + set lcpath_to_version [dict create] + foreach av $available_versions { + set scr [package ifneeded $pkg $av] + #ifneeded script not always a valid tcl list + if {![catch {llength $scr} scrlen]} { + if {$scrlen == 3 && [lindex $scr 0] eq "load" && [string match -nocase [lindex $scr 2] $pkg]} { + dict set lcpath_to_version [string tolower [lindex $scr 1]] $av + } + } } - } - } - if {[llength $pkgloadedinfo]} { - puts stderr "--> pkg not present but shared object seems to be loaded: $pkgloadedinfo" - lassign $pkgloadedinfo path name - set lcpath [string tolower $path] - set obj [file tail $lcpath] - if {[string match tcl9* $obj]} { - set obj [string range $obj 4 end] - } elseif {[string match lib* $obj]} { - set obj [string range $obj 3 end] - } - set pkginfo [file rootname $obj] - #e.g Thread2.8.8 - if {[regexp {^([a-zA-Z\-]+)(.*)} $pkginfo _match lname lversion]} { - if {[string tolower $lname] eq [string tolower $pkg]} { + if {[dict exists $lcpath_to_version $lcpath]} { + set lversion [dict get $lcpath_to_version $lcpath] + } else { + #fallback to a best effort guess based on the path + set lversion [::punk::packagepreference::system::slibpath_guess_pkgversion $path $pkg] + } + if {$lversion ne ""} { #name matches pkg #hack for known dll version mismatch if {[string tolower $pkg] eq "thread" && $lversion eq "30b3"} { @@ -240,9 +259,11 @@ tcl::namespace::eval punk::packagepreference { }] if {[dict get $stackrecord implementation] ne ""} { set impl [dict get $stackrecord implementation] ;#use hardcoded name rather than slower (but more flexible) commandstack::get_next_command - puts stdout "punk::packagepreference renamed ::package to $impl" + #puts stdout "punk::packagepreference renamed ::package to $impl" + return 1 } else { puts stderr "punk::packagepreference failed to rename ::package" + return 0 } #puts stdout [info body ::package] } @@ -297,14 +318,94 @@ tcl::namespace::eval punk::packagepreference::lib { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[section Internal] -#tcl::namespace::eval punk::packagepreference::system { +tcl::namespace::eval punk::packagepreference::system { #*** !doctools #[subsection {Namespace punk::packagepreference::system}] #[para] Internal functions that are not part of the API + variable PUNKARGS + + lappend PUNKARGS [list { + @id -id ::punk::packagepreference::system::slibpath_guess_pkgversion + @cmd -name punk::packagepreference::system::slibpath_guess_pkgversion -help\ + "Assistance function to determine pkg version from the information + obtained from [info loaded]. This is used to try to avoid loading a different + version of a binary package in another thread/interp when the package isn't + present in the interp, but [info loaded] indicates the binary is already loaded. + The more general/robust way to avoid this is to ensure ::auto_path and + tcl::tm::list are the same in each interp/thread. + + This call should only be used as a fallback in case a binary package has a more + complex ifneeded script. If the ifneeded script for a binary package is a + straightforward 'load ' - then that information + should be used to determine the version by matching + rather than this one. + + Takes a path to a shared lib (.so/.dll), and the name of its providing + package, and return the version of the package if possible to determine + from the path. + The filename portion of the lib is often missing a version number or has + a version number that has been shortened (e.g dots removed). + The filename itself is first checked for a version number - but the number + is ignored if it doesn't contain any dots. + (prefix is checked to match with $pkgname, with a possible additional prefix + of lib or tcl) + Often (even usually) the parent or grandparent folder will be named as + per the package name with a proper version. If so we can return it, + otherwise return empty string. + The parent/grandparent matching will be done by looking for a case + insensitive match of the prefix to $pkgname. + " + @values -min 1 + libpath -help "Full path to shared library (.so,.dll etc)" + pkgname -help "" + }] + proc slibpath_guess_pkgversion {libpath pkgname} { + set root [file rootname [file tail $libpath]] + set namelen [string length $pkgname] + regexp {^(tcl(?:[0-9])+){0,1}(.*)} $root _match tclxx root ;#regexp will match anything - but only truncate leading tclXX.. + set testv "" + if {[string match -nocase $pkgname* $root]} { + set testv [string range $root $namelen end] + } elseif {[string match -nocase lib$pkgname* $root]} { + set testv [string range $root $namelen+3 end] + } + if {[string first . $testv] > 0} { + if {![catch [list package vcompare $testv $testv]]} { + #testv has an inner dot and is understood by tcl as a valid version number + return $testv + } + } + #no valid dotted version found directly on dll or so filename + set parent [file dirname $libpath] ;#parent folder is often some differentiator for platform or featureset (e.g win-x64) + set grandparent [file dirname $parent] + foreach path [list $parent $grandparent] { + set segment [file tail $path] + if {$segment eq "bin"} { + continue + } + set testv "" + if {[string match -nocase $pkgname* $segment]} { + set testv [string range $segment $namelen end] + } elseif {[string match -nocase critcl_$pkgname* $segment]} { + set testv [string range $segment $namelen+7 end] + } + #we don't look for dot in parent/grandparent version - a bare integer here after the will be taken to be the version + if {![catch [list package vcompare $testv $testv]]} { + return $testv + } + } + #review - sometimes path and lib are named only for major.minor but package provides major.minor.subversion + #using returned val to attempt to package require -exact major.minor will fail to load major.minor.subversion + return "" + } +} +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::packagepreference ::punk::packagepreference::system +} -#} # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::packagepreference [tcl::namespace::eval punk::packagepreference { diff --git a/src/vfs/_vfscommon.vfs/modules/punk/path-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/path-0.1.0.tm index ede3e18b..51e74719 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/path-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/path-0.1.0.tm @@ -651,11 +651,16 @@ namespace eval punk::path { -call-depth-internal -default 0 -type integer -antiglob_paths -default {} -help\ "list of path patterns to exclude - may include * and ** path segments e.g /usr/**" + may include * and ** path segments e.g + /usr/** (exlude subfolders based at /usr but not + files within /usr itself) + **/_aside (exlude files where _aside is last segment) + **/_aside/* (exclude folders one below an _aside folder) + **/_aside/** (exclude all folders with _aside as a segment)" @values -min 0 -max -1 -optional 1 -type string - tailglobs -multiple 1 -help\ + tailglobs -default * -multiple 1 -help\ "Patterns to match against filename portion (last segment) of each file path - within the directory tree being searched." + within the directory tree being searched." } #todo - implement treefiles which acts like dirfiles but allows path globbing in the same way as punk::ns::ns/ @@ -671,29 +676,29 @@ namespace eval punk::path { #[para] list of path patterns to exclude - may include * and ** path segments e.g /usr/** #[para]no natsorting - so order is dependent on filesystem - set argd [punk::args::get_by_id ::punk::path::treefilenames $args] + set argd [punk::args::parse $args withid ::punk::path::treefilenames] lassign [dict values $argd] leaders opts values received - set tailglobs [dict values $values] + set tailglobs [dict get $values tailglobs] # -- --- --- --- --- --- --- set opt_antiglob_paths [dict get $opts -antiglob_paths] set CALLDEPTH [dict get $opts -call-depth-internal] # -- --- --- --- --- --- --- - if {![dict exists $received -directory]} { - set opt_dir [pwd] - } else { - set opt_dir [dict get $opts -directory] - } # -- --- --- --- --- --- --- set files [list] if {$CALLDEPTH == 0} { + #set opts [dict merge $opts [list -directory $opt_dir]] + if {![dict exists $received -directory]} { + set opt_dir [pwd] + } else { + set opt_dir [dict get $opts -directory] + } if {![file isdirectory $opt_dir]} { return [list] } - set opts [dict merge $opts [list -directory $opt_dir]] - if {![llength $tailglobs]} { - lappend tailglobs * - } + } else { + #assume/require to exist in any recursive call + set opt_dir [dict get $opts -directory] } set skip 0 diff --git a/src/vfs/_vfscommon.vfs/modules/punk/pcon-1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/pcon-1.0.tm new file mode 100644 index 00000000..7e9455cd --- /dev/null +++ b/src/vfs/_vfscommon.vfs/modules/punk/pcon-1.0.tm @@ -0,0 +1,279 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from -buildversion.txt +# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.3.tm +# +# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. +# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# (C) 2025 +# +# @@ Meta Begin +# Application punk::pcon 1.0 +# Meta platform tcl +# Meta license MIT +# @@ Meta End + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# doctools header +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[manpage_begin shellspy_module_punk::pcon 0 1.0] +#[copyright "2025"] +#[titledesc {Module API}] [comment {-- Name section and table of contents description --}] +#[moddesc {-}] [comment {-- Description at end of page heading --}] +#[require punk::pcon] +#[keywords module] +#[description] +#[para] - + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section Overview] +#[para] overview of punk::pcon +#[subsection Concepts] +#[para] - + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[subsection dependencies] +#[para] packages used by punk::pcon +#[list_begin itemized] + +package require Tcl 8.6- +#*** !doctools +#[item] [package {Tcl 8.6}] + +# #package require frobz +# #*** !doctools +# #[item] [package {frobz}] + +#*** !doctools +#[list_end] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section API] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# oo::class namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#tcl::namespace::eval punk::pcon::class { + #*** !doctools + #[subsection {Namespace punk::pcon::class}] + #[para] class definitions + #if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} { + #*** !doctools + #[list_begin enumerated] + + # oo::class create interface_sample1 { + # #*** !doctools + # #[enum] CLASS [class interface_sample1] + # #[list_begin definitions] + + # method test {arg1} { + # #*** !doctools + # #[call class::interface_sample1 [method test] [arg arg1]] + # #[para] test method + # puts "test: $arg1" + # } + + # #*** !doctools + # #[list_end] [comment {-- end definitions interface_sample1}] + # } + + #*** !doctools + #[list_end] [comment {--- end class enumeration ---}] + #} +#} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +tcl::namespace::eval punk::pcon { + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + # Base namespace + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + #*** !doctools + #[subsection {Namespace punk::pcon}] + #[para] Core API functions for punk::pcon + #[list_begin definitions] + + + + #proc sample1 {p1 n args} { + # #*** !doctools + # #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] + # #[para]Description of sample1 + # #[para] Arguments: + # # [list_begin arguments] + # # [arg_def tring p1] A description of string argument p1. + # # [arg_def integer n] A description of integer argument n. + # # [list_end] + # return "ok" + #} + + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::pcon ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Secondary API namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +tcl::namespace::eval punk::pcon::lib { + tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase + tcl::namespace::path [tcl::namespace::parent] + #*** !doctools + #[subsection {Namespace punk::pcon::lib}] + #[para] Secondary functions that are part of the API + #[list_begin definitions] + + #proc utility1 {p1 args} { + # #*** !doctools + # #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] + # #[para]Description of utility1 + # return 1 + #} + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::pcon::lib ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[section Internal] +#tcl::namespace::eval punk::pcon::system { + #*** !doctools + #[subsection {Namespace punk::pcon::system}] + #[para] Internal functions that are not part of the API + + + +#} + + +# == === === === === === === === === === === === === === === +# Sample 'about' function with punk::args documentation +# == === === === === === === === === === === === === === === +tcl::namespace::eval punk::pcon { + tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase + variable PUNKARGS + variable PUNKARGS_aliases + + lappend PUNKARGS [list { + @id -id "(package)punk::pcon" + @package -name "punk::pcon" -help\ + "Package + Description" + }] + + namespace eval argdoc { + #namespace for custom argument documentation + proc package_name {} { + return punk::pcon + } + proc about_topics {} { + #info commands results are returned in an arbitrary order (like array keys) + set topic_funs [info commands [namespace current]::get_topic_*] + set about_topics [list] + foreach f $topic_funs { + set tail [namespace tail $f] + lappend about_topics [string range $tail [string length get_topic_] end] + } + #Adjust this function or 'default_topics' if a different order is required + return [lsort $about_topics] + } + proc default_topics {} {return [list Description *]} + + # ------------------------------------------------------------- + # get_topic_ functions add more to auto-include in about topics + # ------------------------------------------------------------- + proc get_topic_Description {} { + punk::args::lib::tstr [string trim { + package punk::pcon + description to come.. + } \n] + } + proc get_topic_License {} { + return "MIT" + } + proc get_topic_Version {} { + return "$::punk::pcon::version" + } + proc get_topic_Contributors {} { + set authors {{Julian Noble }} + set contributors "" + foreach a $authors { + append contributors $a \n + } + if {[string index $contributors end] eq "\n"} { + set contributors [string range $contributors 0 end-1] + } + return $contributors + } + proc get_topic_custom-topic {} { + punk::args::lib::tstr -return string { + A custom + topic + etc + } + } + # ------------------------------------------------------------- + } + + # we re-use the argument definition from punk::args::standard_about and override some items + set overrides [dict create] + dict set overrides @id -id "::punk::pcon::about" + dict set overrides @cmd -name "punk::pcon::about" + dict set overrides @cmd -help [string trim [punk::args::lib::tstr { + About punk::pcon + }] \n] + dict set overrides topic -choices [list {*}[punk::pcon::argdoc::about_topics] *] + dict set overrides topic -choicerestricted 1 + dict set overrides topic -default [punk::pcon::argdoc::default_topics] ;#if -default is present 'topic' will always appear in parsed 'values' dict + set newdef [punk::args::resolved_def -antiglobs -package_about_namespace -override $overrides ::punk::args::package::standard_about *] + lappend PUNKARGS [list $newdef] + proc about {args} { + package require punk::args + #standard_about accepts additional choices for topic - but we need to normalize any abbreviations to full topic name before passing on + set argd [punk::args::parse $args withid ::punk::pcon::about] + lassign [dict values $argd] _leaders opts values _received + punk::args::package::standard_about -package_about_namespace ::punk::pcon::argdoc {*}$opts {*}[dict get $values topic] + } +} +# end of sample 'about' function +# == === === === === === === === === === === === === === === + +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::pcon +} + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide punk::pcon [tcl::namespace::eval punk::pcon { + variable pkg punk::pcon + variable version + set version 1.0 +}] +return + +#*** !doctools +#[manpage_end] + diff --git a/src/vfs/_vfscommon.vfs/modules/punk/pipe-1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/pipe-1.0.tm new file mode 100644 index 00000000..0b5501ac --- /dev/null +++ b/src/vfs/_vfscommon.vfs/modules/punk/pipe-1.0.tm @@ -0,0 +1,853 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from -buildversion.txt +# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.3.tm +# +# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. +# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# (C) 2025 +# +# @@ Meta Begin +# Application punk::pipe 1.0 +# Meta platform tcl +# Meta license MIT +# @@ Meta End + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# doctools header +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[manpage_begin shellspy_module_punk::pipe 0 1.0] +#[copyright "2025"] +#[titledesc {Module API}] [comment {-- Name section and table of contents description --}] +#[moddesc {-}] [comment {-- Description at end of page heading --}] +#[require punk::pipe] +#[keywords module] +#[description] +#[para] - + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section Overview] +#[para] overview of punk::pipe +#[subsection Concepts] +#[para] - + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[subsection dependencies] +#[para] packages used by punk::pipe +#[list_begin itemized] + +package require Tcl 8.6- +#*** !doctools +#[item] [package {Tcl 8.6}] + +# #package require frobz +# #*** !doctools +# #[item] [package {frobz}] + +#*** !doctools +#[list_end] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section API] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# oo::class namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#tcl::namespace::eval punk::pipe::class { + #*** !doctools + #[subsection {Namespace punk::pipe::class}] + #[para] class definitions + #if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} { + #*** !doctools + #[list_begin enumerated] + + # oo::class create interface_sample1 { + # #*** !doctools + # #[enum] CLASS [class interface_sample1] + # #[list_begin definitions] + + # method test {arg1} { + # #*** !doctools + # #[call class::interface_sample1 [method test] [arg arg1]] + # #[para] test method + # puts "test: $arg1" + # } + + # #*** !doctools + # #[list_end] [comment {-- end definitions interface_sample1}] + # } + + #*** !doctools + #[list_end] [comment {--- end class enumeration ---}] + #} +#} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +tcl::namespace::eval punk::pipe { + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + # Base namespace + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + #*** !doctools + #[subsection {Namespace punk::pipe}] + #[para] Core API functions for punk::pipe + #[list_begin definitions] + + + + #proc sample1 {p1 n args} { + # #*** !doctools + # #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] + # #[para]Description of sample1 + # #[para] Arguments: + # # [list_begin arguments] + # # [arg_def tring p1] A description of string argument p1. + # # [arg_def integer n] A description of integer argument n. + # # [list_end] + # return "ok" + #} + + #https://randomascii.wordpress.com/2012/02/25/comparing-floating-point-numbers-2012-edition/ + # + #we can't provide a float comparison suitable for every situation, + #but we should pick something reasonable, keep it stable, and document it. + proc float_almost_equal {a b} { + package require math::constants + set diff [expr {abs($a - $b)}] + if {$diff <= $::math::constants::eps} { + return 1 + } + set A [expr {abs($a)}] + set B [expr {abs($b)}] + set largest [expr {($B > $A) ? $B : $A}] + return [expr {$diff <= $largest * $::math::constants::eps}] + } + + #debatable whether boolean_almost_equal is more surprising than helpful. + #values from a calculation that are extremely close to zero but aren't false could also be surprising - especially if they compare equal numerically + #perhaps a fuzzy-boolean is a step too far for a default - but it's inline with float-comparison for pattern-matching. + #alternatively - use an even more complex classifier? (^&~) ? + proc boolean_almost_equal {a b} { + if {[string is double -strict $a]} { + if {[float_almost_equal $a 0]} { + set a 0 + } + } + if {[string is double -strict $b]} { + if {[float_almost_equal $b 0]} { + set b 0 + } + } + #must handle true,no etc. + expr {($a && 1) == ($b && 1)} + } + + #boolean could be tr, true, y, ye, yes,Yes, 1 , 0 etc. + proc boolean_equal {a b} { + #equivalenttly xnor: expr {!(($a && 1) ^ ($b && 1))} ;# less clear and no discernable timing benefit. + expr {($a && 1) == ($b && 1)} + } + + + proc val [list [list v [lreplace x 0 0]]] {return $v} + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::pipe ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Secondary API namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +tcl::namespace::eval punk::pipe::lib { + tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase + tcl::namespace::path [tcl::namespace::parent] + #*** !doctools + #[subsection {Namespace punk::pipe::lib}] + #[para] Secondary functions that are part of the API + #[list_begin definitions] + + #proc utility1 {p1 args} { + # #*** !doctools + # #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] + # #[para]Description of utility1 + # return 1 + #} + + #map rhs to names suitable to use in pipemcd proc name (whitespace mapping) + # (for .= and = pipecmds) + proc pipecmd_namemapping {rhs} { + #used to build a command from a pattern which could contain :: - we need to map it to keep it a single command in the desired namespace. + #glob chars will prevent us using simple test {[info commands $cmd] eq ""} to test existence + #we could use the test {$cmd in [info commands]} - but mapping away globchars is more robust, allowing the simpler test + #set rhs [string trim $rhs];#ignore all leading & trailing whitespace + set rhs [string trimleft $rhs] + #--- + #REVIEW! + #set rhs [regsub -all {\s{1,}} $rhs {}] ;#collapse all internal whitespace to a single token + #This stops us matching {/@**@x x} vs {/@**@x x} + #--- + + set rhs [tcl::string::map {: ? * [ ] \\ {"} " " } $rhs] + #review - we don't expect other command-incompatible chars such as colon? + return $rhs + } + + # relatively slow on even small sized scripts + #proc arg_is_script_shaped2 {arg} { + # set re {^(\s|;|\n)$} + # set chars [split $arg ""] + # if {[lsearch -regex $chars $re] >=0} { + # return 1 + # } else { + # return 0 + # } + #} + + #exclude quoted whitespace + proc arg_is_script_shaped {arg} { + if {[tcl::string::first \n $arg] >= 0} { + return 1 + } elseif {[tcl::string::first ";" $arg] >= 0} { + return 1 + } elseif {[tcl::string::first " " $arg] >= 0 || [tcl::string::first \t $arg] >= 0} { + lassign [_rhs_tail_split $arg] _ part2 ;#will have part2 if unquoted whitespace found + return [expr {$part2 ne ""}] + } else { + return 0 + } + } + + #split top level of patterns only. + proc _split_patterns_memoized {varspecs} { + set name_mapped [pipecmd_namemapping $varspecs] + set cmdname ::punk::pipecmds::split_patterns::_$name_mapped + if {[info commands $cmdname] ne ""} { + return [$cmdname] + } + set result [_split_patterns $varspecs] + proc $cmdname {} [list return $result] + #debug.punk.pipe.compile {proc $cmdname} 4 + return $result + } + + + #note - empty data after trailing , is ignored. (comma as very last character) + # - fix by documentation only. double up trailing comma e.g ,, if desired to return pattern match plus all at end! + #todo - move to punk::pipe + proc _split_patterns {varspecs} { + + set varlist [list] + # @ @@ - list and dict functions + # / level separator + # # list count, ## dict size + # % string functions + # ! not + set var_terminals [list "@" "/" "#" "%" "!" ">" "<"] ;# (> required for insertionspecs at rhs of = & .= ) + #right bracket ) also ends a var - but is different depending on whether var is array or basic. For array - it forms part of the varname + + #except when prefixed directly by pin classifier ^ + set protect_terminals [list "^"] ;# e.g sequence ^# + #also - an atom usually doesn't need the / as a terminal - because it can't match a missing element unless it's empty string + #ie the one usecase is '/n to match either empty string or missing item at position n. For this one usecase - we miss the capability to atom match paths/urls .. '/usr/local/et' + set in_brackets 0 ;#count depth + set in_atom 0 + set token "" + set end_var_posn -1 ;#first var_terminal encountered within each comma delimited section + set token_index 0 ;#index of terminal char within each token + set indq 0 + set inbraces 0 + set inesc 0 ;#whether last char was backslash (see also punk::escv) + set prevc "" + set char_index 0 + #if {[string index $varspecs end] eq ","} { + # set varspecs [string range $varspecs 0 end-1] + #} + set charcount 0 + foreach c [split $varspecs ""] { + incr charcount + if {$indq} { + if {$inesc} { + #puts stderr "inesc adding '$c'" + append token \\$c + } else { + if {$c eq {"}} { + set indq 0 + } else { + append token $c + } + } + } elseif {$inbraces} { + if {$inesc} { + append token \\$c + } else { + if {$c eq "\}"} { + incr inbraces -1 + if {$inbraces} { + append token $c + } + } elseif {$c eq "\{"} { + incr inbraces + if {$inbraces} { + append token $c + } + } else { + append token $c + } + } + } elseif {$in_atom} { + #ignore dquotes/brackets in atoms - pass through + append token $c + #set nextc [lindex $chars $char_index+1] + if {$c eq "'"} { + set in_atom 0 + } + } elseif {$in_brackets > 0} { + append token $c + if {$c eq ")"} { + incr in_brackets -1 + } + } else { + if {$c eq {"}} { + if {!$inesc} { + set indq 1 + } else { + append token $c + } + } elseif {$c eq "\{"} { + if {!$inesc} { + set inbraces 1 + } else { + append token $c + } + } elseif {$c eq ","} { + #set var $token + #set spec "" + #if {$end_var_posn > 0} { + # #tcl scan with %s will not handle whitespace as desired. Be explicit using string range instead. + # #lassign [scan $token %${end_var_posn}s%s] var spec + # set var [string range $token 0 $end_var_posn-1] + # set spec [string range $token $end_var_posn end] ;#key section includes the terminal char which ended the var and starts the spec + #} else { + # if {$end_var_posn == 0} { + # set var "" + # set spec $token + # } + #} + #lappend varlist [list [string trim $var] [string trim $spec]] + #set token "" + #set token_index -1 ;#reduce by 1 because , not included in next token + #set end_var_posn -1 + } else { + append token $c + switch -exact -- $c { + ' { + set in_atom 1 + } + ( { + incr in_brackets + } + default { + if {$end_var_posn == -1 && (($c in $var_terminals) && ($prevc ni $protect_terminals))} { + set end_var_posn $token_index + } + } + } + } + if {$c eq ","} { + set var $token + set spec "" + if {$end_var_posn > 0} { + #tcl scan with %s will not handle whitespace as desired. Be explicit using string range instead. + #lassign [scan $token %${end_var_posn}s%s] var spec + set var [string range $token 0 $end_var_posn-1] + set spec [string range $token $end_var_posn end] ;#key section includes the terminal char which ended the var and starts the spec + } else { + if {$end_var_posn == 0} { + set var "" + set spec $token + } + } + lappend varlist [list [string trim $var] $spec] + set token "" + set token_index -1 + set end_var_posn -1 + + } + } + + if {$charcount == [string length $varspecs]} { + if {!($indq || $inbraces || $in_atom || $in_brackets)} { + if {$c ne ","} { + set var $token + set spec "" + if {$end_var_posn > 0} { + #tcl scan with %s will not handle whitespace as desired. Be explicit using string range instead. + #lassign [scan $token %${end_var_posn}s%s] var spec + set var [string range $token 0 $end_var_posn-1] + set spec [string range $token $end_var_posn end] ;#key section includes the terminal char which ended the var and starts the spec + } else { + if {$end_var_posn == 0} { + set var "" + set spec $token + } + } + lappend varlist [list [string trim $var] $spec] + set token "" + set token_index -1 + set end_var_posn -1 + } + } + } + + set prevc $c + if {$c eq "\\"} { + #review + if {$inesc} { + set inesc 0 + } else { + set token [string range $token 0 end-1] + set inesc 1 + } + } else { + set inesc 0 + } + incr token_index + incr char_index + } + + #if {[string length $token]} { + # #lappend varlist [splitstrposn $token $end_var_posn] + # set var $token + # set spec "" + # if {$end_var_posn > 0} { + # #lassign [scan $token %${end_var_posn}s%s] var spec + # set var [string range $token 0 $end_var_posn-1] + # set spec [string range $token $end_var_posn end] ;#key section includes the terminal char which ended the var and starts the spec + # } else { + # if {$end_var_posn == 0} { + # set var "" + # set spec $token + # } + # } + # #lappend varlist [list [string trim $var] [string trim $spec]] + # #spec needs to be able to match whitespace too + # lappend varlist [list [string trim $var] $spec] + #} + + return $varlist + } + + #todo - consider whether we can use < for insertion/iteration combinations + # =a<,b< iterate once through + # =a><,b>< cartesian product + # =a<>,b<> ??? zip ? + # + # ie = {a b c} |> .=< inspect + # would call inspect 3 times, once for each argument + # .= list {a b c} {x y z} |a/0,b/1> .=a><,b>< list + # would produce list of cartesian pairs? + # + proc _split_equalsrhs {insertionpattern} { + #map the insertionpattern so we can use faster globless info command search + set name_mapped [pipecmd_namemapping $insertionpattern] + set cmdname ::punk::pipecmds::split_rhs::_$name_mapped + if {[info commands $cmdname] ne ""} { + return [$cmdname] + } + + set lst_var_indexposition [_split_patterns_memoized $insertionpattern] + set i 0 + set return_triples [list] + foreach v_pos $lst_var_indexposition { + lassign $v_pos v index_and_position + #e.g varname@@data/ok>0 varname/1/0>end + #ensure only one ">" is detected + if {![string length $index_and_position]} { + set indexspec "" + set positionspec "" + } else { + set chars [split $index_and_position ""] + set posns [lsearch -all $chars ">"] + if {[llength $posns] > 1} { + error "pipesyntax error in segment insertion pattern '$insertionpattern' -v '$v' multiple '>' characters. Pattern not understood." "_split_equalsrhs $insertionpattern" [list pipesyntax insertionpattern_invalid] + } + if {![llength $posns]} { + set indexspec $index_and_position + set positionspec "" + } else { + set splitposn [lindex $posns 0] + set indexspec [string range $index_and_position 0 $splitposn-1] + set positionspec [string range $index_and_position $splitposn+1 end] + } + } + + #review - + if {($positionspec in [list "*" "/*" "@*" "/" "@"]) || ($v eq "*" && $positionspec eq "")} { + set star "" + if {$v eq "*"} { + set v "" + set star "*" + } + if {[string index $positionspec end] eq "*"} { + set star "*" + } + #it is always possible to insert at end of list regardless of current length - so /end* and @end* are equivalent + #as are /end and @end + #lset lst_var_indexposition $i [list $v "/end$star"] + set triple [list $v $indexspec "/end$star"] + } else { + if {$positionspec eq ""} { + #e.g just =varname + #lset lst_var_indexposition $i [list $v "/end"] + set triple [list $v $indexspec "/end"] + #error "pipesyntax error in segment insertionpattern '$insertionpattern' - v '$v' missing position spec e.g /0" + } else { + if {[string index $indexspec 0] ni [list "" "/" "@"]} { + error "pipesyntax error in segment insertionpattern '$insertionpattern' - v '$v' bad index spec '$indexspec'" "_split_equalsrhs $insertionpattern" [list pipesyntax insertionpattern_invalid] + } + set triple [list $v $indexspec $positionspec] + } + } + lappend return_triples $triple + incr i + } + proc $cmdname {} [list return $return_triples] + return $return_triples + } + + proc _rhs_tail_split {fullrhs} { + set inq 0; set indq 0 + set equalsrhs "" + set i 0 + foreach ch [split $fullrhs ""] { + if {$inq} { + append equalsrhs $ch + if {$ch eq {'}} { + set inq 0 + } + } elseif {$indq} { + append equalsrhs $ch + if {$ch eq {"}} { + set indq 0 + } + } else { + switch -- $ch { + {'} { + set inq 1 + } + {"} { + set indq 1 + } + " " { + #whitespace outside of quoting + break + } + 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - a - b - c - d - e - f - g - h - i - j - k - l - m - n - o - p - q - r - s - t - u - v - w - x - y - z {} + default { + #\t not a literal for switch jumpTable bytecompile - review - can we do it without for example string mapping to (and without a literal binary tab in source file)? + #we can't (reliably?) put \t as one of our switch keys + # + if {$ch eq "\t"} { + break + } + } + } + append equalsrhs $ch + } + incr i + } + set tail [tcl::string::range $fullrhs $i end] + return [list $equalsrhs $tail] + } + + #todo - recurse into bracketed sub parts + #JMN3 + #e.g @*/(x@0,y@2) + proc _var_classify {multivar} { + set cmdname ::punk::pipecmds::var_classify::_[pipecmd_namemapping $multivar] + if {[info commands $cmdname] ne ""} { + return [$cmdname] + } + + + #comma seems a natural choice to split varspecs, + #but also for list and dict subelement access + #/ normally indicates some sort of hierarchical separation - (e.g in filesytems) + #so / will indicate subelements e.g @0/1 for lindex $list 0 1 + #set valsource_key_list [_split_var_key_at_unbracketed_comma $multivar] + set valsource_key_list [_split_patterns_memoized $multivar] + + + + #mutually exclusive - atom/pin + #set map [list "" ' ^ &] ;#0 = default/var/not-yet-determined 1 = atom 2 = pin + #set var_class [lmap var $valsource_key_list {expr {([set m [lsearch $map [string index [lindex $var 0] 0]]] >= 0) ? [list $var $m] : [list $var 0]}}] + #0 - novar + #1 - atom ' + #2 - pin ^ + #3 - boolean & + #4 - integer + #5 - double + #6 - var + #7 - glob (no classifier and contains * or ?) + #8 - numeric + #9 - > (+) + #10 - < (-) + + set var_names [list] + set var_class [list] + set varspecs_trimmed [list] ;#raw varspecs without pin/atom modifiers - or empty string for glob + + + set leading_classifiers [list "'" "&" "^" ] + set trailing_classifiers [list + -] + set possible_number_start [list - + . 0 1 2 3 4 5 6 7 8 9 > <] + + foreach v_key $valsource_key_list { + lassign $v_key v key + set vname $v ;#default + set classes [list] + if {$v eq ""} { + lappend var_class [list $v_key 0] + lappend varspecs_trimmed $v_key + } else { + set lastchar [string index $v end] + switch -- $lastchar { + + { + lappend classes 9 + set vname [string range $v 0 end-1] + } + - { + lappend classes 10 + set vname [string range $v 0 end-1] + } + } + set firstchar [string index $v 0] + switch -- $firstchar { + ' { + lappend var_class [list $v_key 1] + #set vname [string range $v 1 end] + lappend varspecs_trimmed [list $vname $key] + } + ^ { + lappend classes [list 2] + #use vname - may already have trailing +/- stripped + set vname [string range $vname 1 end] + set secondclassifier [string index $v 1] + switch -- $secondclassifier { + "&" { + #pinned boolean + lappend classes 3 + set vname [string range $v 2 end] + } + "#" { + #pinned numeric comparison instead of string comparison + #e.g set x 2 + # this should match: ^#x.= list 2.0 + lappend classes 8 + set vname [string range $vname 1 end] + } + "*" { + #pinned glob + lappend classes 7 + set vname [string range $v 2 end] + } + } + #todo - check for second tag - & for pinned boolean? + #consider requiring ^# for numeric comparisons. currently no way to do a strictly string comparison on pinned variables.... default ^var really shouldn't be doing any magic. + #while we're at it.. pinned glob would be nice. ^* + #maybe even pinned scan ^% ? regex? ^/ or ^? these would be hard to have corresponding literals in the pattern mini-lang. + #These all limit the range of varnames permissible - which is no big deal. + lappend var_class [list $v_key $classes] + lappend varspecs_trimmed [list $vname $key] + } + & { + #we require boolean literals to be single-quoted so we can use cross-binding on boolean vars. + #ie &true is the variable true whereas &'true' or &'1' &'t' etc are literal booleans + #allow exception of &1 &0 to be literal booleans - because we disallow 0 & 1 as varnames in other contexts anyway - so it would be more consistent not to treat as varnames here. + lappend var_class [list $v_key 3] + set vname [string range $v 1 end] + lappend varspecs_trimmed [list $vname $key] + } + default { + if {([string first ? $v]) >=0 || ([string first * $v] >=0)} { + lappend var_class [list $v_key 7] ;#glob + #leave vname as the full glob + lappend varspecs_trimmed [list "" $key] + } else { + #scan vname not v - will either be same as v - or possibly stripped of trailing +/- + set numtestv [join [scan $vname %lld%s] ""] ;# handles octals (leading zeros), ok for use with bignums, decimal points and sci notation - fails to handle leading dot e.g .5 + #leading . still need to test directly for double + if {[string is double -strict $vname] || [string is double -strict $numtestv]} { + if {[string is integer -strict $numtestv]} { + #this will pick up boolean 1 or 0 - but that's ok - they require "&" marker if boolean comparison desired + #integer test before double.. + #note there is also string is wide (string is wideinteger) for larger ints.. + lappend classes 4 + lappend var_class [list $v_key $classes] + lappend varspecs_trimmed $v_key + } else { + #double + #sci notation 1e123 etc + #also large numbers like 1000000000 - even without decimal point - (tcl bignum) + lappend classes 5 + lappend var_class [list $v_key $classes] + lappend varspecs_trimmed $v_key + } + } else { + lappend var_class [list $v_key 6] ;#var + lappend varspecs_trimmed $v_key + } + } + } + } + } + lappend var_names $vname + } + + set result [list var_names $var_names var_class $var_class varspecs_trimmed $varspecs_trimmed] + + proc $cmdname {} [list return $result] + #JMN + #debug.punk.pipe.compile {proc $cmdname} + return $result + } + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::pipe::lib ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[section Internal] +#tcl::namespace::eval punk::pipe::system { + #*** !doctools + #[subsection {Namespace punk::pipe::system}] + #[para] Internal functions that are not part of the API + + + +#} + + +# == === === === === === === === === === === === === === === +# Sample 'about' function with punk::args documentation +# == === === === === === === === === === === === === === === +tcl::namespace::eval punk::pipe { + tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase + variable PUNKARGS + variable PUNKARGS_aliases + + lappend PUNKARGS [list { + @id -id "(package)punk::pipe" + @package -name "punk::pipe" -help\ + "Package + Description" + }] + + namespace eval argdoc { + #namespace for custom argument documentation + proc package_name {} { + return punk::pipe + } + proc about_topics {} { + #info commands results are returned in an arbitrary order (like array keys) + set topic_funs [info commands [namespace current]::get_topic_*] + set about_topics [list] + foreach f $topic_funs { + set tail [namespace tail $f] + lappend about_topics [string range $tail [string length get_topic_] end] + } + return $about_topics + } + proc default_topics {} {return [list Description outline *]} + + # ------------------------------------------------------------- + # get_topic_ functions add more to auto-include in about topics + # ------------------------------------------------------------- + proc get_topic_Description {} { + punk::args::lib::tstr [string trim { + punk pipeline features + } \n] + } + proc get_topic_License {} { + return "MIT" + } + proc get_topic_Version {} { + return $::punk::pipe::version + } + proc get_topic_Contributors {} { + set authors {{Julian Noble }} + set contributors "" + foreach a $authors { + append contributors $a \n + } + if {[string index $contributors end] eq "\n"} { + set contributors [string range $contributors 0 end-1] + } + return $contributors + } + proc get_topic_outline {} { + punk::args::lib::tstr -return string { + todo.. + } + } + # ------------------------------------------------------------- + } + + # we re-use the argument definition from punk::args::standard_about and override some items + set overrides [dict create] + dict set overrides @id -id "::punk::pipe::about" + dict set overrides @cmd -name "punk::pipe::about" + dict set overrides @cmd -help [string trim [punk::args::lib::tstr { + About punk::pipe + }] \n] + dict set overrides topic -choices [list {*}[punk::pipe::argdoc::about_topics] *] + dict set overrides topic -choicerestricted 1 + dict set overrides topic -default [punk::pipe::argdoc::default_topics] ;#if -default is present 'topic' will always appear in parsed 'values' dict + set newdef [punk::args::resolved_def -antiglobs -package_about_namespace -override $overrides ::punk::args::package::standard_about *] + lappend PUNKARGS [list $newdef] + proc about {args} { + package require punk::args + #standard_about accepts additional choices for topic - but we need to normalize any abbreviations to full topic name before passing on + set argd [punk::args::parse $args withid ::punk::pipe::about] + lassign [dict values $argd] _leaders opts values _received + punk::args::package::standard_about -package_about_namespace ::punk::pipe::argdoc {*}$opts {*}[dict get $values topic] + } +} +# end of sample 'about' function +# == === === === === === === === === === === === === === === + +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::pipe +} + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide punk::pipe [tcl::namespace::eval punk::pipe { + variable pkg punk::pipe + variable version + set version 1.0 +}] +return + +#*** !doctools +#[manpage_end] + diff --git a/src/vfs/_vfscommon.vfs/modules/punk/repl-0.1.tm b/src/vfs/_vfscommon.vfs/modules/punk/repl-0.1.tm index 63b82f02..354fa005 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/repl-0.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/repl-0.1.tm @@ -83,6 +83,8 @@ namespace eval repl { namespace eval punk::repl { tsv::set repl runid 0 + + #todo - key on shell/subshell tsv::set repl runchunks-0 [list] ;#last_run_display @@ -312,23 +314,38 @@ proc punk::repl::reset_terminal {} { } proc punk::repl::get_prompt_config {} { - if {$::tcl_interactive} { - set RST [a] - set resultprompt "[a green bold]-$RST " - set nlprompt "[a green bold].$RST " - set infoprompt "[a green bold]*$RST " - set debugprompt "[a purple bold]~$RST " + if {[catch {punk::console::vt52} is_vt52]} { + set is_vt52 0 + } + if {$is_vt52} { + set resultprompt "52-" + set nlprompt "52." + set infoprompt "52*" + set debugprompt "52~" } else { - set resultprompt "" - set nlprompt "" - set infoprompt "" - set debugprompt "" + if {$::tcl_interactive} { + set RST [a] + set resultprompt "[a green bold]-$RST " + set nlprompt "[a green bold].$RST " + set infoprompt "[a green bold]*$RST " + set debugprompt "[a purple bold]~$RST " + } else { + set resultprompt "" + set nlprompt "" + set infoprompt "" + set debugprompt "" + } } return [list resultprompt $resultprompt nlprompt $nlprompt infoprompt $infoprompt debugprompt $debugprompt] } proc repl::start {inchan args} { puts stderr "-->repl::start $inchan $args" + upvar ::punk::console::input_chunks_waiting input_chunks_waiting + if {![info exists input_chunks_waiting($inchan)]} { + set input_chunks_waiting($inchan) [list] + } + variable codethread #review if {$codethread eq ""} { @@ -356,7 +373,12 @@ proc repl::start {inchan args} { } incr startinstance set loopinstance 0 - thread::send $codethread { + if {[info exists ::punk::ns::ns_current]} { + set start_in_ns $::punk::ns::ns_current + } else { + set start_in_ns :: + } + thread::send $codethread [string map [list %ns1% $start_in_ns] { #set ::punk::repl::codethread::running 1 #the interp in which commands such as d/ run @@ -366,9 +388,9 @@ proc repl::start {inchan args} { namespace eval ::punk::repl::codethread {} set ::punk::repl::codethread::running 1 namespace eval ::punk::ns::ns_current {} - set ::punk::ns::ns_current :: + set ::punk::ns::ns_current %ns1% } - } + }] set commandstr "" # --- @@ -385,14 +407,15 @@ proc repl::start {inchan args} { set ::punk::console::ansi_wanted -1 } } + puts stderr "-->repl::start active on $inchan $args replthread:[thread::id] codethread:$codethread" set prompt_config [punk::repl::get_prompt_config] doprompt "P% " fileevent $inchan readable [list [namespace current]::repl_handler $inchan $prompt_config] set reading 1 - catch { - #set punk::console::tabwidth [punk::console::get_tabstop_apparent_width] - } + #catch { + # set punk::console::tabwidth [punk::console::get_tabstop_apparent_width] + #} vwait [namespace current]::done fileevent $inchan readable {} @@ -900,7 +923,11 @@ namespace eval punk::repl::class { append debug \n "input:[ansistring VIEW -lf 1 -vt 1 $new0] before row:$o_cursor_row after row: $result_row before col:$o_cursor_col after col:$result_col" package require textblock set debug [textblock::frame -checkargs 0 -buildcache 0 $debug] - catch {punk::console::move_emitblock_return $debug_first_row 1 $debug} + if {![punk::console::vt52]} { + catch {punk::console::move_emitblock_return $debug_first_row 1 $debug} + } else { + #?? + } # -- --- --- --- --- --- set o_cursor_col $result_col @@ -1363,8 +1390,9 @@ proc repl::repl_handler {inputchan prompt_config} { lappend input_chunks_waiting($inputchan) $chunk } } else { - if {[fblocked $inputchan]} { - #REVIEW - need to und + #'chan blocked' docs state: 'Note that this only ever returns 1 when the channel has been configured to be non-blocking..' + if {[chan blocked $inputchan]} { + #REVIEW - #todo - figure out why we're here. #can we even put a spinner so we don't keep emitting lines? We probably can't use any ansi functions that need to get a response on stdin..(like get_cursor_pos) #punk::console::get_size is problematic if -winsize not available on the stdout channel - which is the case for certain 8.6 versions at least.. platform variances? @@ -1372,9 +1400,9 @@ proc repl::repl_handler {inputchan prompt_config} { set outconf [chan configure stdout] set RED [punk::ansi::a+ red bold]; set RST [punk::ansi::a] if {"windows" eq $::tcl_platform(platform)} { - set msg "${RED}$inputchan fblocked is true. (line-length Tcl windows channel bug?)$RST \{$allwaiting\}" + set msg "${RED}$inputchan chan blocked is true. (line-length Tcl windows channel bug?)$RST \{$allwaiting\}" } else { - set msg "${RED}$inputchan fblocked is true.$RST \{$allwaiting\}" + set msg "${RED}$inputchan chan blocked is true.$RST \{$allwaiting\}" } set cols "" set rows "" @@ -1483,6 +1511,11 @@ proc repl::repl_handler {inputchan prompt_config} { chan configure $inputchan -translation lf } set chunk [read $inputchan] + #we expect a chan configured with -blocking 0 to be blocked immediately after reads + #test - just bug console for now - try to understand when/how/if a non blocking read occurs. + if {![chan blocked $inputchan]} { + puts stderr "repl_handler->$inputchan not blocked after read" + } punk::repl::repl_handler_restorechannel_if_not_eof $inputchan $original_input_conf uplevel #0 [list repl::repl_process_data $inputchan raw-read $chunk [list] $prompt_config] @@ -1532,6 +1565,10 @@ interp alias {} editbuf {} ::punk::repl::editbuf proc punk::repl::console_debugview {editbuf consolewidth args} { + if {[punk::console::vt52]} { + #topleft? + return [dict create width 0 height 0 topleft 0] + } package require textblock variable debug_repl if {$debug_repl <= 0} { @@ -1578,19 +1615,24 @@ proc punk::repl::console_debugview {editbuf consolewidth args} { set debug_width [textblock::widthtopline $info] set patch_height [expr {2 + $debug_height + 2}] set spacepatch [textblock::block $debug_width $patch_height " "] - puts -nonewline [punk::ansi::cursor_off] + #puts -nonewline [punk::ansi::cursor_off] + punk::console::cursor_off #use non cursorsave versions - cursor save/restore will interfere with any concurrent ansi rendering that uses save/restore - because save/restore is a single item, not a stack. set debug_offset [expr {$consolewidth - $debug_width - $opt_rightmargin}] set row_clear [expr {$opt_row -2}] punk::console::move_emitblock_return $row_clear $debug_offset $spacepatch punk::console::move_emitblock_return $opt_row $debug_offset $info set topleft [list $debug_offset $opt_row] ;#col,row REVIEW - puts -nonewline [punk::ansi::cursor_on] + #puts -nonewline [punk::ansi::cursor_on] + punk::console::cursor_on flush stdout return [dict create width $debug_width height $debug_height topleft $topleft] } proc punk::repl::console_editbufview {editbuf consolewidth args} { + if {[punk::console::vt52]} { + return [dict create width 0] + } package require textblock upvar ::repl::editbuf_list editbuf_list @@ -1647,6 +1689,12 @@ proc punk::repl::console_controlnotification {message consolewidth consoleheight } proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config} { + if {[info exists ::punk::console::is_vt52]} { + set is_vt52 $::punk::console::is_vt52 + } else { + set is_vt52 0 + } + variable loopinstance incr loopinstance upvar ::punk::console::input_chunks_waiting input_chunks_waiting @@ -1765,25 +1813,28 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config error "character 03 -> ctrl-c" } - - #review - configurable? - #translate raw del to backspace del for those terminals that send plain del if {$chunk eq "\x7f"} { + #review - configurable? + #translate raw del to backspace del for those terminals that send plain del set chunk "\b\x7f" - } - #ctrl-bslash - if {$chunk eq "\x1c"} { + } elseif {$chunk eq "\x7f\x7f"} { + #commonly if key held down we will get 2 dels in a row + #review - could get more in a row depending on hardware/os + set chunk "\b\x7f\b\x7f" + } elseif {$chunk eq "\x1c"} { + #ctrl-bslash #try to brutally terminate process #attempt to leave terminal in a reasonable state - punk::mode line + mode line ;#may be aliased to ::repl::interphelpers::mode after 250 {exit 42} return - } - #for now - exit with small delay for tidyup - #ctrl-z - if {$chunk eq "\x1a"} { + } elseif {$chunk eq "\x1a"} { + #for now - exit with small delay for tidyup + #ctrl-z #::punk::repl::handler_console_control "ctrl-z_via_rawloop" - punk::mode line + if {[catch {mode line}]} { + interp eval code {mode line} + } after 1000 {exit 43} return } @@ -1802,7 +1853,8 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config #-------------------------- # editbuf and debugview rhs frames - if {[set ::punk::console::ansi_available]} { + #for now disable entirely on vt52 - we can only do cursor save restore - nothing that requires responses on stdin (?) + if {!$is_vt52 && [set ::punk::console::ansi_available]} { #experimental - use punk::console::get_size to determine current visible width. #This should ideally be using sigwinch or some equivalent to set a value somewhere. #testing each time is very inefficient (1+ms) @@ -1811,7 +1863,14 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config set consolewidth 132 if {$do_checkwidth} { if {[catch {set consolewidth [dict get [punk::console::get_size] columns]} errM]} { - puts stderr "repl_process_data failed on call to punk::console::get_size :$errM" + #review + if {!$is_vt52} { + puts stderr "repl_process_data failed on call to punk::console::get_size :$errM" + } + } + #if chan conf stdout doesn't give dimensions and console doesn't respond to queries - we can get empty results in get_size dict + if {$consolewidth eq ""} { + set consolewidth 132 } } set debug_width 0 @@ -1850,14 +1909,25 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config set leftmargin 3 - puts -nonewline stdout [a+ cyan][punk::ansi::move_column [expr {$leftmargin +1}]][punk::ansi::erase_eol][$editbuf line $cursor_row][a][punk::ansi::move_column [expr {$leftmargin + [$editbuf cursor_column]}]] + if {!$is_vt52} { + puts -nonewline stdout [a+ cyan][punk::ansi::move_column [expr {$leftmargin +1}]][punk::ansi::erase_eol][$editbuf line $cursor_row][a][punk::ansi::move_column [expr {$leftmargin + [$editbuf cursor_column]}]] + } else { + puts -nonewline stdout [a+ cyan][punk::ansi::vt52move_column [expr {$leftmargin +1}]][punk::ansi::vt52erase_eol][$editbuf line $cursor_row][punk::ansi::vt52move_column [expr {$leftmargin + [$editbuf cursor_column]}]] + } #puts -nonewline stdout $chunk flush stdout if {[$editbuf last_char] eq "\n"} { set linelen [punk::ansi::printing_length [$editbuf line $nextsubmit_line_num]] - puts -nonewline stdout [a+ cyan bold][punk::ansi::move_column [expr {$leftmargin +1}]][$editbuf line $nextsubmit_line_num][a][punk::ansi::move_column [expr {$leftmargin + $linelen +1}]] - #screen_last_char_add "\n" input inputline - puts -nonewline stdout [punk::ansi::erase_eol]\n + if {!$is_vt52} { + puts -nonewline stdout [a+ cyan bold][punk::ansi::move_column [expr {$leftmargin +1}]][$editbuf line $nextsubmit_line_num][a][punk::ansi::move_column [expr {$leftmargin + $linelen +1}]] + #screen_last_char_add "\n" input inputline + puts -nonewline stdout [punk::ansi::erase_eol]\n + } else { + puts -nonewline stdout [a+ cyan bold][punk::ansi::vt52move_column [expr {$leftmargin +1}]][$editbuf line $nextsubmit_line_num][punk::ansi::vt52move_column [expr {$leftmargin + $linelen +1}]] + puts -nonewline stdout [punk::ansi::vt52erase_eol]\n + } + + #puts -nonewline stdout \n screen_last_char_add "\n" input inputline set waiting [$editbuf line end] @@ -2077,6 +2147,9 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config set repl_runid [tsv::incr repl runid] tsv::set repl runchunks-$repl_runid [list] ;#last_run_display catch { + #REVIEW - when we launch a subshell and run more than 10 commands, + #we delete runchunks from the outer shell that we'll return to! + #we should use a toplevel key pertaining to the shell/subshell instead of just 'repl' tsv::unset repl runchunks-[expr {$repl_runid - 10}] } @@ -2530,6 +2603,8 @@ proc repl::completion {context ebuf} { } namespace eval repl { + + proc init {args} { if {![info exists ::argv0]} { #error out before we create a thread - punk requires this - review @@ -2579,21 +2654,20 @@ namespace eval repl { error "repl:init codethread: $codethread already exists. use -force 1 to override" } set codethread [thread::create -preserved] - #review - naming of the possibly 2 cond variables parent and child thread - set codethread_cond [thread::cond create] ;#repl::codethread_cond held by parent(repl) vs punk::repl::codethread::replthread_cond held by child(codethread) - set codethread_mutex [thread::mutex create] + set codethread_cond [thread::cond create] ;#repl::codethread_cond held by parent(repl) vs punk::repl::codethread::replthread_cond held by child(codethread) + set codethread_mutex [thread::mutex create] set init_script [string map [list %args% [list $opts]\ - %argv0% [list $::argv0]\ - %argv% [list $::argv]\ - %argc% [list $::argc]\ - %replthread% [thread::id]\ + %argv0% [list $::argv0]\ + %argv% [list $::argv]\ + %argc% [list $::argc]\ + %replthread% [thread::id]\ %replthread_cond% $codethread_cond\ %replthread_interp% [list $opt_callback_interp]\ - %tmlist% [list [tcl::tm::list]]\ - %autopath% [list $::auto_path]\ + %tmlist% [list [tcl::tm::list]]\ + %autopath% [list $::auto_path]\ ] { set ::argv0 %argv0% set ::argv %argv% @@ -2711,6 +2785,9 @@ namespace eval repl { } #todo - add/remove shellfilter stacked ansiwrap } + proc vt52 {args} { + return [thread::send %replthread% [list punk::console::vt52 {*}$args]] + } proc mode args { #with tsv::set console is_raw we don't need to call mode in both the replthread and the codethread # REVIEW - call in local interp? how about if codethread is safe interp? @@ -2735,6 +2812,15 @@ namespace eval repl { proc md5 args { ::md5::md5 {*}$args } + proc fconfigure {args} { + code invokehidden fconfigure {*}$args + } + proc fnormalize name { + code invokehidden tcl:file:normalize $name + } + proc fdirname name { + code invokehidden tcl:file:dirname $name + } } namespace eval ::repl::interpextras { #install using safe::setLogCmd @@ -2775,32 +2861,44 @@ namespace eval repl { namespace export {[a-z]*} namespace ensemble create proc punk {} { - interp eval code { + set ts_start [clock seconds] + set replresult [interp eval code { package require punk::repl repl::init -safe punk repl::start stdin - } + }] + return [list replresult $replresult elapsed [expr {[clock seconds]-$ts_start}]] } proc safe {args} { + set ts_start [clock seconds] interp eval code { package require punk::repl } - interp eval code [list repl::init -safe safe {*}$args] - interp eval code [list repl::start stdin] + interp eval code [list repl::init -safe safe {*}$args] + set replresult [interp eval code [list repl::start stdin]] + + return [list replresult $replresult elapsed [expr {[clock seconds]-$ts_start}]] } proc safebase {args} { + set ts_start [clock seconds] interp eval code { package require punk::repl } - interp eval code [list repl::init -safe safebase {*}$args] - interp eval code [list repl::start stdin] + set codethread [interp eval code [list repl::init -safe safebase {*}$args]] + puts stdout "safebase codethread:$codethread" + set replresult [interp eval code [list repl::start stdin]] + + return [list replresult $replresult elapsed [expr {[clock seconds]-$ts_start}]] } proc punksafe {args} { + set ts_start [clock seconds] interp eval code { package require punk::repl } - interp eval code [list repl::init -safe punksafe {*}$args] - interp eval code [list repl::start stdin] + interp eval code [list repl::init -safe punksafe {*}$args] + set replresult [interp eval code [list repl::start stdin]] + + return [list replresult $replresult elapsed [expr {[clock seconds]-$ts_start}]] } } # -- --- --- --- --- @@ -2819,24 +2917,173 @@ namespace eval repl { switch -- $safe { safe { interp create -safe -- code + package require punk::args + } + safebase { + safe::interpCreate code -nested 1 -autoPath %autopath% + code alias "file normalize" "file normalize" + code alias "file dirname" "file dirname" + code alias "file exists" "file exists" + code alias ::tcl::file::normalize ::tcl::file::normalize + code alias ::tcl::file::dirname ::tcl::file::dirname + code alias ::tcl::file::exists ::tcl::file::exists + #code alias ::punk::console::colour ::punk::console::colour + } + punksafe { + #less safe than safebase - we need file normalize and info script to handle modpod? + package require punk::safe + punk::safe::interpCreate code -autoPath %autopath% + code alias "file normalize" "file normalize" + code alias "file dirname" "file dirname" + code alias "file exists" "file exists" + code alias ::tcl::file::normalize ::tcl::file::normalize + code alias ::tcl::file::dirname ::tcl::file::dirname + code alias ::tcl::file::exists ::tcl::file::exists + code alias ::punk::console::colour ::punk::console::colour + } + punk - 0 { + interp create code + } + punkisland { + #todo + #when no island paths specified - should be like safebase, but without folder hiding and with expanded read to ::auto_path folders + } + } + + interp eval code { + namespace eval codeinterp { + variable errstack {} + variable outstack {} + variable run_command_cache + proc set_clone {varname obj} { + append obj2 $obj {} + uplevel 1 [list set $varname $obj2] + } + } + } + + switch -- $safe { + safe { if {[llength $paths]} { package require punk::island foreach p $paths { punk::island::add code $p } } + interp share "" stdout code + interp share "" stderr code + interp share "" stdin code ;#needed for ANSI queries + + set codehidden [code hidden] + code alias file file + if {"source" in $codehidden} { + code expose source + } + if {"encoding" in $codehidden} { + code expose encoding ;#leave enabled + } + if {"tcl:encoding:system" in $codehidden} { + code expose tcl:encoding:system + code eval {rename ::tcl::encoding::system ""} + code eval {rename tcl:encoding:system ::tcl::encoding::system} + } + #interp alias is available in safe - so it seems unreasonable to disallow 'info cmdtype' + if {"tcl:info:cmdtype" in $codehidden} { + code eval {rename ::tcl::info::cmdtype ""} + code expose tcl:info:cmdtype + code eval {rename tcl:info:cmdtype ::tcl::info::cmdtype} + } + set pkgs [list\ + punk::args\ + punk::pipe\ + cmdline\ + struct::list\ + struct::set\ + textutil::wcswidth\ + textutil::trim\ + textutil::repeat\ + textutil::tabify\ + textutil::split\ + textutil::string\ + textutil::adjust\ + textutil\ + punk::encmime\ + punk::char\ + punk::assertion\ + punk::ansi\ + punk::lib\ + overtype\ + dictutils\ + debug\ + punk::ns\ + textblock\ + punk::args::tclcore\ + punk::aliascore\ + ] + + #pattern looks up versions available of patternlib before loading (but we don't have an index for tm files) todo fix pattern. + # patterncmd\ + # metaface\ + # patternpredator2\ + # patternlib\ + # pattern + + # - no longer required by textblock + # term::ansi::code\ + # term::ansi::code::attr\ + # term::ansi::code::ctrl\ + # term::ansi::code::macros + + #---------- + #all this scanning and loading core packages - we should possibly cache the file data for other interps? + #make sure codethread has scanned for packages - must do for each namespace level + #catch {package require flubber_nonexistent} + set ns_scanned [dict create] + #---------- + set prior_infoscript [code eval {info script}] ;#probably empty that's ok + foreach pkg $pkgs { + if {[catch { + set nsquals [namespace qualifiers $pkg] + if {$nsquals ne ""} { + if {![dict exists $ns_scanned $nsquals]} { + catch {package require ${nsquals}::flubber_nonexistant} ;#force scan + dict set ns_scanned $nsquals 1 + } + } + set versions [lsort -command {package vcompare} [package versions $pkg]] + if {[llength $versions]} { + set v [lindex $versions end] + set path [lindex [package ifneeded $pkg $v] end] + if {[file extension $path] in {.tcl .tm}} { + if {[file exists $path]} { + set data [readFile $path] + code eval [list info script $path] + code eval $data + code eval [list info script $prior_infoscript] + } else { + error "safe - failed to find $path" + } + } else { + error "safe - refusing to attempt load of $pkg from $path - (allowed extensions .tcl .tm)" + } + } else { + error "safe - no versions of $pkg found" + } + } errMsg]} { + puts stderr "safe - failed to load package $pkg\n$errMsg\n$::errorInfo" + } else { + #puts stdout "safe - loaded $pkg from $path" + } + } + code alias file "" + code hide source + #review argv0,argv,argc - interp eval code { - namespace eval ::codeinterp { - variable errstack {} - variable outstack {} - } - set ::argv0 %argv0% - set ::auto_path %autopath% - #puts stdout "safe interp" - #flush stdout - } + #interp eval code { + # set ::argv0 %argv0% + # set ::auto_path %autopath% + #} interp eval code [list set ::tcl_platform(os) $::tcl_platform(os)] interp eval code [list set ::tcl_platform(osVersion) $::tcl_platform(osVersion)] interp eval code [list set ::tcl_platform(machine) $::tcl_platform(machine)] @@ -2851,12 +3098,18 @@ namespace eval repl { interp share {} [shellfilter::stack::item_tophandle stderr] code } + #review + code alias ::shellfilter::stack ::shellfilter::stack + #code alias ::punk::lib::set_clone ::punk::lib::set_clone + #code alias ::aliases ::punk::lib::aliases + code alias ::punk::lib::aliases ::punk::lib::aliases + namespace eval ::codeinterp {} + code alias ::md5::md5 ::repl::interphelpers::md5 code alias exit ::repl::interphelpers::quit } safebase { #safebase - safe::interpCreate code -nested 1 -autopath %autopath% #safe::setLogCmd ::repl::interpextras::safe_msg ;#using setLogcmd early will show the auto_path notice - which is *verbose* #while it may conceivably be useful in debugging safe itself - auto_path and tcl::tm::list can be inspected to show these values in the safe interp itself anyway - so early logging is of limited utility here. if {[llength $paths]} { @@ -2871,15 +3124,13 @@ namespace eval repl { set ::argv {} #puts stdout "safebase interp" #flush stdout - namespace eval ::codeinterp { - variable errstack {} - variable outstack {} - } } interp eval code [list set ::tcl_platform(os) $::tcl_platform(os)] interp eval code [list set ::tcl_platform(osVersion) $::tcl_platform(osVersion)] interp eval code [list set ::tcl_platform(machine) $::tcl_platform(machine)] + code alias ::fconfigure ::repl::interphelpers::fconfigure ;#needed for shellfilter + #code invokehidden package require punk::lib if {"stdout" in [chan names]} { interp share {} stdout code @@ -2893,7 +3144,7 @@ namespace eval repl { } interp eval code { package require punk::lib - package require textblock ;#may fail to load term::ansi::code::macros - (only required for altg) + package require textblock } #JMN @@ -2926,60 +3177,65 @@ namespace eval repl { code alias exit ::repl::interphelpers::quit code alias ::md5::md5 ::repl::interphelpers::md5 - code alias ::fconfigure ::fconfigure ;#needed for shellfilter code alias ::file ::file interp eval code [list package provide md5 $md5version] } - punk - 0 { - interp create code + punksafe { interp eval code { - #safe !=1 and safe !=2, tmlist: %tmlist% - set ::argv0 %argv0% - set ::argv %argv% - set ::argc %argc% - set ::auto_path %autopath% - tcl::tm::remove {*}[tcl::tm::list] - tcl::tm::add {*}[lreverse %tmlist%] - #puts "code interp chan names-->[chan names]" - namespace eval ::codeinterp { - variable errstack {} - variable outstack {} - variable run_command_cache - } + set ::argv0 %argv0% + set ::argc 0 + set ::argv {} + #set ::auto_path %autopath% ;#jmn + #tcl::tm::remove {*}[tcl::tm::list] + #tcl::tm::add {*}[lreverse %tmlist%] + } + interp eval code [list set ::tcl_platform(os) $::tcl_platform(os)] + interp eval code [list set ::tcl_platform(osVersion) $::tcl_platform(osVersion)] + interp eval code [list set ::tcl_platform(machine) $::tcl_platform(machine)] - # -- --- - #review - #we have to blow some time on a rescan to provide more deterministic ordering (match behaviour of initial thread regarding pkg precedence) - #review - can we speed that scan up? - ##catch {package require flobrudder-nonexistant} - # -- --- + code alias ::fconfigure ::repl::interphelpers::fconfigure ;#needed for shellfilter + + if {"stdout" in [chan names]} { + interp share {} stdout code + } else { + interp share {} [shellfilter::stack::item_tophandle stdout] code + } + if {"stderr" in [chan names]} { + interp share {} stderr code + } else { + interp share {} [shellfilter::stack::item_tophandle stderr] code + } + + interp eval code { + package require punk::lib + package require punk::args + package require punk::args::tclcore + package require textblock + } + + interp eval code { if {[catch { - package require vfs - package require vfs::zip - } errM]} { - puts stderr "repl code interp can't load vfs,vfs::zip" + #package require packagetrace + #packagetrace::init + } errM]} { + puts stderr "========================" + puts stderr "code interp error 1:" + puts stderr $errM + puts stderr $::errorInfo + puts stderr "========================" + #error "$errM" } + } - #puts stderr ----- - #puts stderr [join $::auto_path \n] - #puts stderr ----- + interp eval code { if {[catch { - package require punk::config - package require punk::ns - #puts stderr "loading natsort" - #natsort has 'application mode' which can exit. - #Requiring it shouldn't trigger application - but zipfs/vfs interactions confused it in some early versions - package require natsort - #catch {package require packageTrace} - package require punk - package require punk::args - package require punk::args::tclcore - package require shellrun - package require shellfilter + package require punk::config ;#requires: none + #package require punk::console ;#requires: Thread,punk::ansi,punk::args #set running_config $::punk::config::running + package require shellfilter ;#requires: shellthread,Thread apply {running_config { if {[string length [dict get $running_config color_stderr]] && [punk::console::colour]} { lappend ::codeinterp::errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr]]] @@ -2989,63 +3245,85 @@ namespace eval repl { } }} $::punk::config::running - package require textblock - } errM]} { + } errM]} { puts stderr "========================" - puts stderr "code interp error:" + puts stderr "code interp error 2:" puts stderr $errM puts stderr $::errorInfo puts stderr "========================" error "$errM" } } + + interp eval code { + if {[catch { + + #puts stderr "loading natsort" + #natsort has 'application mode' which can exit. + #Requiring it shouldn't trigger application - but zipfs/vfs interactions confused it in some early versions + package require natsort + + #package require punk ;# Thread + #package require shellrun ;#subcommand exists of file + + + #----------------------------------------------------------------------------------------------------------------------------------------- + package require punk::ns ;#requires:punk::lib,punk::args,struct::list,cmdline+(tcllibc),struct::set,punk::ansi,punk::char, + #textutil,textutil::string,textutil::adjust,textutil::repeat,textutil::string,textutil::split,textutil::tabify,textutil::wcswidth + #punk::encmime,punk::assertion + #twapi,platform,registry,debug,overtype,patternpunk,pattern,patterncmd,metaface,patternpredator2,patternlib,dictutils + #----------------------------------------------------------------------------------------------------------------------------------------- + + #package require textblock + } errM]} { + puts stderr "========================" + puts stderr "code interp error 3:" + puts stderr $errM + puts stderr $::errorInfo + puts stderr "========================" + error "$errM" + } + + } + } - punksafe { - package require punk::safe - punk::safe::interpCreate code -autoPath %auto_path% + punk - 0 { interp eval code { - set ::argv0 %argv0% - set ::argc 0 - set ::argv {} + #safe !=1 and safe !=2, tmlist: %tmlist% + set ::argv0 %argv0% + set ::argv %argv% + set ::argc %argc% + set ::auto_path %autopath% tcl::tm::remove {*}[tcl::tm::list] tcl::tm::add {*}[lreverse %tmlist%] - namespace eval ::codeinterp { - variable errstack {} - variable outstack {} - variable run_command_cache - } - } - + #puts "code interp chan names-->[chan names]" - if {"stdout" in [chan names]} { - interp share {} stdout code - } else { - interp share {} [shellfilter::stack::item_tophandle stdout] code - } - if {"stderr" in [chan names]} { - interp share {} stderr code - } else { - interp share {} [shellfilter::stack::item_tophandle stderr] code - } + # -- --- + #review + #we have to blow some time on a rescan to provide more deterministic ordering (match behaviour of initial thread regarding pkg precedence) + #review - can we speed that scan up? + ##catch {package require flobrudder-nonexistant} + # -- --- - interp eval code { - package require punk::lib - package require textblock ;#may fail to load term::ansi::code::macros - (only required for altg) - } + if {[catch { + package require vfs + package require vfs::zip + } errM]} { + puts stderr "repl code interp can't load vfs,vfs::zip" + } + #puts stderr ----- + #puts stderr [join $::auto_path \n] + #puts stderr ----- - interp eval code { if {[catch { - catch { - package require packagetrace - packagetrace::init - } package require punk::config package require punk::ns #puts stderr "loading natsort" #natsort has 'application mode' which can exit. #Requiring it shouldn't trigger application - but zipfs/vfs interactions confused it in some early versions package require natsort + #catch {package require packageTrace} package require punk package require punk::args package require punk::args::tclcore @@ -3070,9 +3348,7 @@ namespace eval repl { puts stderr "========================" error "$errM" } - - } - + } } default { } @@ -3083,6 +3359,7 @@ namespace eval repl { code alias editbuf ::repl::interphelpers::editbuf code alias colour ::repl::interphelpers::colour code alias mode ::repl::interphelpers::mode + code alias vt52 ::repl::interphelpers::vt52 #code alias after ::repl::interphelpers::do_after code alias ::punk::set_repl_last_unknown ::repl::interphelpers::set_repl_last_unknown diff --git a/src/vfs/_vfscommon.vfs/modules/punk/repl/codethread-0.1.1.tm b/src/vfs/_vfscommon.vfs/modules/punk/repl/codethread-0.1.1.tm index 6158fdce..feee9d87 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/repl/codethread-0.1.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/repl/codethread-0.1.1.tm @@ -114,6 +114,10 @@ tcl::namespace::eval punk::repl::codethread { variable output_stdout "" variable output_stderr "" + #review/test + catch {package require punk::ns} + catch {package rquire punk::repl} + #variable xyz #*** !doctools @@ -191,9 +195,14 @@ tcl::namespace::eval punk::repl::codethread { #shennanigans to keep compiled script around after call. #otherwise when $script goes out of scope - internal rep of vars set in script changes. #The shimmering may be no big deal(?) - but debug/analysis using tcl::unsupported::representation becomes impossible. - interp eval code [list ::punk::lib::set_clone ::codeinterp::clonescript $script] ;#like objclone + + #interp eval code [list ::punk::lib::set_clone ::codeinterp::clonescript $script] ;#like objclone + interp eval code [list ::codeinterp::set_clone ::codeinterp::clonescript $script] ;#like objclone + + interp eval code {lappend ::codeinterp::run_command_cache $::codeinterp::clonescript} + interp eval code { - lappend ::codeinterp::run_command_cache $::codeinterp::clonescript + #lappend ::codeinterp::run_command_cache $::codeinterp::clonescript if {[llength $::codeinterp::run_command_cache] > 2000} { set ::codeinterp::run_command_cache [lrange $::codeinterp::run_command_cache 1750 end][unset ::codeinterp::run_command_cache] } @@ -205,10 +214,19 @@ tcl::namespace::eval punk::repl::codethread { package require punk::ns punk::ns::nseval_ifexists $::punk::ns::ns_current $::codeinterp::clonescript } else { + if {![namespace exists $::punk::ns::ns_current]} { + namespace eval $::punk::ns::ns_current { + puts stderr "Created namespace: $::punk::ns::ns_current" + } + } tcl::namespace::inscope $::punk::ns::ns_current $::codeinterp::clonescript } } } result] + #temp test for subshell experimentation + #if {$status == 1} { + # puts stderr "--codethread::runscript error--------\n$::errorInfo" + #} flush stdout diff --git a/src/vfs/_vfscommon.vfs/modules/punk/repo-0.1.1.tm b/src/vfs/_vfscommon.vfs/modules/punk/repo-0.1.1.tm index 063a13c0..f53a06fd 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/repo-0.1.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/repo-0.1.1.tm @@ -107,14 +107,16 @@ namespace eval punk::repo { } - #lappend PUNKARGS [list -dynamic 1 { + #lappend PUNKARGS [list { + # @dynamic # @id -id ::punk::repo::fossil_proxy # @cmd -name fossil -help "fossil executable # " # @argdisplay -header "fossil help" -body {${[runout -n fossil help]}} # } ""] - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + @dynamic @id -id ::punk::repo::fossil_proxy @cmd -name fossil -help "fossil executable" ${[punk::repo::get_fossil_usage]} @@ -123,20 +125,24 @@ namespace eval punk::repo { #experiment - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + @dynamic @id -id "::punk::repo::fossil_proxy diff" @cmd -name "fossil diff" -help "fossil diff " @argdisplay -header "fossil help diff" -body {${[runout -n fossil help diff]}} } ""] - lappend PUNKARGS [list -dynamic 1 { + lappend PUNKARGS [list { + #todo - remove this comment - testing dynamic directive + @dynamic @id -id "::punk::repo::fossil_proxy add" @cmd -name "fossil add" -help "fossil add " @argdisplay -header "fossil help add" -body {${[runout -n fossil help add]}} } ""] #TODO - #lappend PUNKARGS [list -dynamic 1 { + #lappend PUNKARGS [list { + # @dynamic # @id -glob 1 -id "::punk::repo::fossil_proxy *" -aliases {fs} # @cmd -name "fossil add" -help "fossil add # " @@ -1699,12 +1705,10 @@ namespace eval punk::repo::lib { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -if {![info exists ::punk::args::register::NAMESPACES]} { - namespace eval ::punk::args::register { - set ::punk::args::register::NAMESPACES [list] ;#use fully qualified so 8.6 doesn't find existing var in global namespace - } +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::repo } -lappend ::punk::args::register::NAMESPACES ::punk::repo # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ diff --git a/src/vfs/_vfscommon.vfs/modules/punk/safe-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/safe-0.1.0.tm index 1c02675a..553fafeb 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/safe-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/safe-0.1.0.tm @@ -458,7 +458,7 @@ tcl::namespace::eval punk::safe { # If we have exactly 2 arguments the semantic is a "configure get" lassign $args child arg - set spec_dict [punk::args::define [punk::args::rawdef punk::safe::interpIC]] + set spec_dict [punk::args::define [punk::args::raw_def punk::safe::interpIC]] set opt_names [dict get $spec_dict opt_names] CheckInterp $child @@ -773,7 +773,7 @@ tcl::namespace::eval punk::safe::system { "::auto_path for the child"} } punk::args::define $OPTS - set optlines [punk::args::resolved_def -type @opts punk::safe::OPTS -*] + set optlines [punk::args::resolved_def -types opts ::punk::safe::OPTS -*] set INTERPCREATE { @id -id ::punk::safe::interpCreate @@ -783,6 +783,7 @@ tcl::namespace::eval punk::safe::system { @leaders child -type string -default "" -regexprefail "^-" -regexprefailmsg "" -optional 1 -help\ "name of the child (optional)" + #opts added separately } append INTERPCREATE \n $optlines append INTERPCREATE \n {@values -max 0} @@ -1020,6 +1021,7 @@ tcl::namespace::eval punk::safe::system { # Add the tcl::tm directories to the access path. set morepaths [::tcl::tm::list] + set morepaths [lreverse $morepaths] ;#JMN - maintains same order when re-adding. set firstpass 1 while {[llength $morepaths]} { set addpaths $morepaths @@ -1059,6 +1061,13 @@ tcl::namespace::eval punk::safe::system { # 'platform/shell-X.tm', i.e arbitrarily deep # subdirectories. lappend morepaths {*}[glob -nocomplain -directory $dir -type d *] + + #experiment + #if {$firstpass} { + # package require punk::zip + # set subs [punk::zip::walk -resultrelative "" $dir *.tm] ;#walk finds files and dirs - dirs have trailing slash + # lappend morepaths {*}[lsearch -all -inline $subs */] + #} } set firstpass 0 } @@ -1142,7 +1151,8 @@ tcl::namespace::eval punk::safe::system { fconfigure $f -encoding $encoding -eofchar \x1A set contents [read $f] close $f - ::interp eval $child [list info script $file] + #::interp eval $child [list info script $file] + ::interp eval $child [list info script $realfile] } msg opt ] @@ -1513,7 +1523,7 @@ tcl::namespace::eval punk::safe::system { # Add (only if needed, avoid duplicates) 1 level of sub directories to an # existing path list. Also removes non directories from the returned # list. - proc AddSubDirs {pathList} { + proc AddSubDirs1 {pathList} { set res {} foreach dir $pathList { if {[file isdirectory $dir]} { @@ -1532,6 +1542,29 @@ tcl::namespace::eval punk::safe::system { } return $res } + proc AddSubDirs {pathList} { + set res {} + foreach dir $pathList { + if {[file isdirectory $dir]} { + # check that we don't have it yet as a children of a previous + # dir + if {$dir ni $res} { + lappend res $dir + } + package require punk::zip + set subs [punk::zip::walk -resultrelative "" $dir *] ;#walk finds files and dirs - dirs have trailing slash + set dirs [lsearch -all -inline $subs */] + foreach sub $dirs { + if {[file isdirectory $sub] && ($sub ni $res)} { + # new sub dir, add it ! + lappend res $sub + } + } + } + } + return $res + } + # # Sets the child auto_path to its recorded access path. Also sets diff --git a/src/vfs/_vfscommon.vfs/modules/punk/winrun-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/winrun-0.1.0.tm index 1bd0e43b..69aea9c9 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/winrun-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/winrun-0.1.0.tm @@ -39,13 +39,13 @@ namespace eval punk::winrun { proc readchild_handler {chan hpid} { #fileevent $chan readable {} set data [read $chan 4096] - while {![fblocked $chan] && ![eof $chan]} { + while {![chan blocked $chan] && ![eof $chan]} { append data [read $chan 4096] } - puts stdout "-->$data eof:[eof $chan] fblocked [fblocked $chan]" + puts stdout "-->$data eof:[eof $chan] chan blocked [chan blocked $chan]" flush stdout if {![eof $chan]} { - puts stdout "not eof $chan [fconfigure $chan] fblocked:[fblocked $chan]" + puts stdout "not eof $chan [fconfigure $chan] chan blocked:[chan blocked $chan]" #fileevent $chan readable [list punk::winrun::readchild_handler $chan $hpid] } else { #puts "eof: waiting exit process" diff --git a/src/vfs/_vfscommon.vfs/modules/punk/winshell-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/winshell-0.1.0.tm index e0c738ef..38b99b8b 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/winshell-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/winshell-0.1.0.tm @@ -129,6 +129,7 @@ tcl::namespace::eval punk::winshell { set pipename_stdin $pipebase$shellid-stdin set pipename_stdout $pipebase$shellid-stdout set pipename_stderr $pipebase$shellid-stderr + #swapped thisend/child - labels now wrong - todo - relabel or swap back? set h_stdin [twapi::namedpipe_server $pipename_stdin] ;#handle for child process redirection set p_stdin [twapi::namedpipe_client $pipename_stdin] ;#this end set h_stdout [twapi::namedpipe_server $pipename_stdout] ;#handle for child process redirection @@ -138,15 +139,53 @@ tcl::namespace::eval punk::winshell { set p_stderr [twapi::namedpipe_client $pipename_stderr] ;#this end chan configure $p_stderr -blocking 0 - set pid [exec cmd.exe /k >@$h_stdout 2>@$h_stderr <@$h_stdin &] + set pid [exec cmd.exe /k >@$p_stdout 2>@$p_stderr <@$p_stdin &] dict set shellinfo $shellid id $shellid dict set shellinfo $shellid pid $pid - dict set shellinfo $shellid stdin $p_stdin - dict set shellinfo $shellid stdout $p_stdout - dict set shellinfo $shellid stderr $p_stderr + dict set shellinfo $shellid stdin $h_stdin + dict set shellinfo $shellid stdout $h_stdout + dict set shellinfo $shellid stderr $h_stderr return [dict get $shellinfo $shellid] } + variable ack 0 + proc handle_out {chan args} { + variable ack + #if {[catch { + # if {$ack} { + # punk::console::move_emit_return 3 79 "\\" + # set ack 0 + # } else { + # punk::console::move_emit_return 3 79 / + # set ack 1 + # } + #} errM]} { + # puts "err on move_emit_return" + #} + puts -nonewline stdout [punk::ansi::ansistring VIEW [read $chan]] + } + proc handle_err {chan args} { + variable ack + #if {$ack} { + # punk::console::move_emit_return 3 79 - + # set ack 0 + #} else { + # punk::console::move_emit_return 3 79 | + # set ack 1 + #} + puts -nonewline stderr [read $chan] + } + + proc cmdtest {{id ""}} { + set cinfo [cmdexec $id] + set o [dict get $cinfo stdout] + chan conf $o -buffering none -blocking 0 + set e [dict get $cinfo stderr] + chan conf $e -buffering none -blocking 0 + chan event $o readable [list ::punk::winshell::handle_out $o] + chan event $e readable [list ::punk::winshell::handle_err $e] + return $cinfo + } #test with twapi create_process proc cmdcreate {{id ""}} { @@ -255,10 +294,10 @@ tcl::namespace::eval punk::winshell { #review - *no running instance* works with windows taskkill - "*No such process*" works with kill -9 on FreeBSD and linux - other platforms? if {![string match "*no running instance*" $errMsg] && ![string match "*No such process*" $errMsg]} { - lappend failed_kits [list kit $targetkit reason "could not kill running process for $targetkit (using '$killcmd')"] + lappend failed_kits [list reason "could not kill running process for shellid $shellid (using '$killcmd')"] continue } else { - puts stderr " + puts stderr "" } } else { puts stderr "$killcmd ran without error" @@ -267,6 +306,10 @@ tcl::namespace::eval punk::winshell { } + proc shellinfo {} { + variable shellinfo + return $shellinfo + } proc cmdinfo {{id ""}} { variable autoshellid variable shellinfo @@ -279,8 +322,11 @@ tcl::namespace::eval punk::winshell { set info [dict get $shellinfo $shellid] set pid [dict get $info pid] - set statusresult [tcl::process status $pid] - dict set info status $statusresult + catch { + set statusresult [tcl::process status $pid] + dict set info status $statusresult + } + set cmdline [twapi::get_process_commandline $pid] dict set info cmdline $cmdline return [showdict $info] @@ -297,7 +343,11 @@ tcl::namespace::eval punk::winshell { set shellid $id } set pid [dict get $shellinfo $shellid pid] - set statusresult [tcl::process status $pid] + set statusresult "" + catch { + #not in 8.6? + set statusresult [tcl::process status $pid] + } return [dict create id $shellid status $statusresult] } diff --git a/src/vfs/_vfscommon.vfs/modules/punk/zip-0.1.1.tm b/src/vfs/_vfscommon.vfs/modules/punk/zip-0.1.1.tm index 2895b024..99bc359d 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/zip-0.1.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/zip-0.1.1.tm @@ -194,6 +194,12 @@ tcl::namespace::eval punk::zip { Defaults to the value of base. If empty string is given to -resultrelative the paths returned are effectively absolute paths." + -emptydirs -default 0 -type boolean -help\ + "Whether to include directory trees in the result which had no + matches for the given fileglobs. + Intermediate dirs are always returned if there is a match with + fileglobs further down even if -emptdirs is 0. + " -excludes -default "" -help "list of glob expressions to match against files and exclude" -subpath -default "" -help\ "May contain glob chars for folder elements" @@ -205,6 +211,7 @@ tcl::namespace::eval punk::zip { set fileglobs [dict get $argd values fileglobs] set subpath [dict get $argd opts -subpath] set excludes [dict get $argd opts -excludes] + set emptydirs [dict get $argd opts -emptydirs] set received [dict get $argd received] @@ -242,13 +249,32 @@ tcl::namespace::eval punk::zip { if {!$excluded} {lappend result [file join $prefix $file]} } foreach dir [glob -nocomplain -tails -types d -directory $base -- [file join $subpath *]] { - set subdir_entries [walk -subpath $dir -excludes $excludes $base {*}$fileglobs] - if {[llength $subdir_entries]>0} { - #NOTE: trailing slash required for entries to be recognised as 'file type' = "directory" - #This is true for 2024 Tcl9 mounted zipfs at least. zip utilities such as 7zip seem(icon correct) to recognize dirs with or without trailing slash - #Although there are attributes on some systems to specify if entry is a directory - it appears trailing slash should always be used for folder names. - set result [list {*}$result "[file join $prefix $dir]/" {*}$subdir_entries] + set submatches [walk -subpath $dir -emptydirs $emptydirs -excludes $excludes $base {*}$fileglobs] + set subdir_entries [list] + set thisdir_match [list] + set has_file 0 + foreach sd $submatches { + set fullpath [file join $prefix $sd] ;#file join destroys trailing slash + if {[string index $sd end] eq "/"} { + lappend subdir_entries $fullpath/ + } else { + set has_file 1 + lappend subdir_entries $fullpath + } + } + if {$emptydirs} { + set thisdir_match [list "[file join $prefix $dir]/"] + } else { + if {$has_file} { + set thisdir_match [list "[file join $prefix $dir]/"] + } else { + set subdir_entries [list] + } } + #NOTE: trailing slash required for entries to be recognised as 'file type' = "directory" + #This is true for 2024 Tcl9 mounted zipfs at least. zip utilities such as 7zip seem(icon correct) to recognize dirs with or without trailing slash + #Although there are attributes on some systems to specify if entry is a directory - it appears trailing slash should always be used for folder names. + set result [list {*}$result {*}$thisdir_match {*}$subdir_entries] } return $result } diff --git a/src/vfs/_vfscommon.vfs/modules/punkcheck-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punkcheck-0.1.0.tm index 3b4217df..db8a3db5 100644 --- a/src/vfs/_vfscommon.vfs/modules/punkcheck-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punkcheck-0.1.0.tm @@ -1170,6 +1170,7 @@ namespace eval punkcheck { } #skip writing punkcheck during checksum/timestamp checks + #todo - punk::args - fetch from punkcheck::install (with overrides) proc install_tm_files {srcdir basedir args} { set defaults [list\ -glob *.tm\ @@ -1209,13 +1210,71 @@ namespace eval punkcheck { return [lindex $args end] } } + lappend PUNKARGS [list { + @id -id ::punkcheck::install + @cmd -name ::punkcheck::install -help\ + "Unidirectional file transfer to possibly non-empty target folder." + @leaders -min 2 -max 2 + srcdir -type directory + tgtdir -type directory + -call-depth-internal -type integer -default 0 -help "(internal recursion tracker)" + -subdirlist -type list -default "" -help "(primarily internal - length generally matching -call-depth-internal)" + -max_depth -type integer -default 1000 -help\ + "Deepest subdirectory - use -1 for no limit." + -createdir -type boolean -default 0 -help\ + "Whether to create the folder at tgtdir. + Any required subdirectories are created regardless of this setting." + -createempty -type boolean -default 0 -help\ + "Whether to create folders at target that had no matches for our glob" + -glob -type string -default "*" -help\ + "Pattern matching for source file(s) to copy. Can be glob based or exact match." + -antiglob_file_core -default {${[::punkcheck::default_antiglob_file_core]}} + -antiglob_file -default "" + -antiglob_dir_core -default {${[::punkcheck::default_antiglob_dir_core]}} + -antiglob_dir -default "" + -antiglob_paths -default {} + -overwrite -default no-targets\ + -choices {no-targets newer-targets older-targets all-targets installedsourcechanged-targets synced-targets}\ + -choicecolumns 1\ + -choicelabels { + no-targets "only copy files that are missing at the target" + newer-targets "copy files with older source timestamp over newer + target timestamp and those missing at the target + (a form of 'restore' operation)" + older-targets "copy files with newer source timestamp over older + target timestamp and those missing at the target" + all-targets "copy regardless of timestamp at target" + installedsourcechanged-targets "copy if the target doesn't exist or the source changed" + synced-targets "copy if the target doesn't exist or the source changed + and the target cksum is the same as the last INSTALL-RECORD -targets_cksums entry" + } + -source_checksum -default comparestore -choicecolumns 3 -choices {compare store comparestore false true}\ + -choicelabels { + true "same as comparestore" + } + -punkcheck_folder -default target -choices {target source project} -choicerestricted 0 -help\ + "The location of the .punkcheck file to track installations and checksums. + The default value 'target' is generally recommended. + Can also be an absolute path to a folder." + -punkcheck_records -default "" -help\ + "Empty string or a parsed TDL records structure. + e.g + {tag FILEINFO - ... body { + {tag INSTALL-RECORD - ... body {}} + ... + }... + }" + -installer -default "punkcheck::install" -help\ + "A user nominated string that is stored in the .punkcheck file + This might be the name of a script or installation process." + }] ## unidirectional file transfer to possibly non empty folder #default of -overwrite no-targets will only copy files that are missing at the target # -overwrite newer-targets will copy files with older source timestamp over newer target timestamp and those missing at the target (a form of 'restore' operation) # -overwrite older-targets will copy files with newer source timestamp over older target timestamp and those missing at the target # -overwrite all-targets will copy regardless of timestamp at target # -overwrite installedsourcechanged-targets will copy if the target doesn't exist or the source changed - # -overwrite synced-targets will copy if the target doesn't exist or the source changed and the target cksum is the same as the last INSTALL-RECORD targets_cksums entry + # -overwrite synced-targets will copy if the target doesn't exist or the source changed and the target cksum is the same as the last INSTALL-RECORD -targets_cksums entry # review - timestamps unreliable # - what about slightly mismatched system clocks and mounted filesystems? caller responsibility to verify first? # if timestamp exactly equal - should we check content-hash? This is presumably only likely to occur deliberately(maliciously?) @@ -1243,6 +1302,7 @@ namespace eval punkcheck { -max_depth 1000\ -subdirlist {}\ -createdir 0\ + -createempty 0\ -glob *\ -antiglob_file_core "\uFFFF"\ -antiglob_file "" \ @@ -1271,13 +1331,14 @@ namespace eval punkcheck { #(as opposed to a more 'standard' mechanism of adjusting srcdir & tgtdir as we move down the tree) #It comes from build_modules_from_source_to_base where we need to keep track of position relative to our targetdir starting point to handle submodules e.g pkg::something::mypkg-0.1.tm #It could have been handled with some other parameter such as -depth, but this -subdirlist mechanism, whilst perhaps not beautiful, is straightforward enough - #and may be less error prone than doing slightly more opaue path manipulations at each recursion level to determine where we started + #and may be less error prone than doing slightly more opaque path manipulations at each recursion level to determine where we started #For consistency - we'll use the same mechanism in various recursive directory walking procedures such as this one. - set CALLDEPTH [dict get $opts -call-depth-internal] ;#added for extra debug/sanity checking - clearer test for initial function call ie CALLDPEPTH = 0 + set CALLDEPTH [dict get $opts -call-depth-internal] ;#added for extra debug/sanity checking - clearer test for initial function call ie CALLDEPTH = 0 set max_depth [dict get $opts -max_depth] ;# -1 for no limit set subdirlist [dict get $opts -subdirlist] ;# generally should be same length as CALLDEPTH - but user could prefill set fileglob [dict get $opts -glob] set createdir [dict get $opts -createdir] ;#defaults to zero to help avoid mistakes with initial target dir - required target subdirs are created regardless of this setting + set opt_createempty [dict get $opts -createempty] if {$CALLDEPTH == 0} { #expensive to normalize but we need to do it at least once @@ -1285,6 +1346,13 @@ namespace eval punkcheck { set tgtdir [file normalize $tgtdir] if {$createdir} { file mkdir $tgtdir + } else { + if {![file exists $tgtdir]} { + error "punkcheck::install base target dir:'$tgtdir' doesn't exist (srcdir:$srcdir tgtdir:$tgtdir args:'$args')" + } + } + if {([file type $srcdir] ni [list directory]) || ([file type $tgtdir] ni [list directory])} { + error "punkcheck::install requires source and target dirs to be of type 'directory' type current source: [file type $srcdir] type current target: [file type $tgtdir]" } #now the values we build from these will be properly cased } @@ -1450,13 +1518,7 @@ namespace eval punkcheck { if {![file exists $current_source_dir]} { - error "copy_files_from_source_to_target current source dir:'$current_source_dir' doesn't exist (srcdir:$srcdir tgtdir:$tgtdir args:'$args')" - } - if {![file exists $current_target_dir]} { - error "copy_files_from_source_to_target current target dir:'$current_target_dir' doesn't exist (srcdir:$srcdir tgtdir:$tgtdir args:'$args')" - } - if {([file type $current_source_dir] ni [list directory]) || ([file type $current_target_dir] ni [list directory])} { - error "copy_files_from_source_to_target requires source and target dirs to be of type 'directory' type current source: [file type $current_source_dir] type current target: [file type $current_target_dir]" + error "punkcheck::install current source dir:'$current_source_dir' doesn't exist (srcdir:$srcdir tgtdir:$tgtdir args:'$args')" } set files_copied [list] @@ -1500,7 +1562,13 @@ namespace eval punkcheck { # SOURCE -type file -path ../src/modules/jjjetc-999999.0a1.0.tm -cksum b646fc2ee88cbd068d2e946fe929b7aea96bd39d -cksum_all_opts {-cksum_content 1 -cksum_meta 0 -cksum_acls 0 -cksum_usetar 0 -cksum_algorithm sha1} -changed 0 -metadata_us 3338 # } #} - + + if {[llength $match_list]} { + #example - target dir has a file where there is a directory at the source + if {[file exists $current_target_dir] && ([file type $current_target_dir] ni [list directory])} { + error "punkcheck::install target subfolder $current_target_dir exists but is not of type 'directory'. Type current target folder: [file type $current_target_dir]" + } + } #proc get_relativecksum_from_base_and_fullpath {base fullpath args} @@ -1579,10 +1647,12 @@ namespace eval punkcheck { set is_skip 0 if {$overwrite_what eq "all-targets"} { + file mkdir $current_target_dir file copy -force $current_source_dir/$m $current_target_dir lappend files_copied $current_source_dir/$m } else { if {![file exists $current_target_dir/$m]} { + file mkdir $current_target_dir file copy $current_source_dir/$m $current_target_dir set new_tgt_cksum_info [punk::mix::base::lib::cksum_path $current_target_dir/$m] lappend files_copied $current_source_dir/$m @@ -1592,6 +1662,7 @@ namespace eval punkcheck { installedsourcechanged-targets { if {[llength $changed]} { #An unrecorded installation is considered a source change (from unknown/unrecorded source to recorded) + file mkdir $current_target_dir file copy -force $current_source_dir/$m $current_target_dir set new_tgt_cksum_info [punk::mix::base::lib::cksum_path $current_target_dir/$m] lappend files_copied $current_source_dir/$m @@ -1619,6 +1690,7 @@ namespace eval punkcheck { set target_cksum_compare "norecord" } if {$is_target_unmodified_since_install} { + file mkdir $current_target_dir file copy -force $current_source_dir/$m $current_target_dir set new_tgt_cksum_info [punk::mix::base::lib::cksum_path $current_target_dir/$m] lappend files_copied $current_source_dir/$m @@ -1642,6 +1714,12 @@ namespace eval punkcheck { } } } + #target dir was created as necessary if files matched above + #now ensure target dir exists if -createempty true + if {$opt_createempty && ![file exists $current_target_dir]} { + file mkdir $current_target_dir + } + set ts_now [clock microseconds] @@ -1724,10 +1802,9 @@ namespace eval punkcheck { continue } - - if {![file exists $current_target_dir/$d]} { - file mkdir $current_target_dir/$d - } + #if {![file exists $current_target_dir/$d]} { + # file mkdir $current_target_dir/$d + #} set sub_opts_1 [list\ @@ -2096,8 +2173,10 @@ namespace eval punkcheck { - - +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punkcheck +} diff --git a/src/vfs/_vfscommon.vfs/modules/punkcheck/cli-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punkcheck/cli-0.1.0.tm index 609df5c3..bbf882a0 100644 --- a/src/vfs/_vfscommon.vfs/modules/punkcheck/cli-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punkcheck/cli-0.1.0.tm @@ -64,6 +64,8 @@ namespace eval punkcheck::cli { #vfs can mask mounted files - so we can't just use 'file type' or glob with -type f ##set files [glob -nocomplain -dir $fullpath -type f *] package require punk::nav::fs + + #TODO - get all files in tree!!! set folderinfo [punk::nav::fs::dirfiles_dict $fullpath] set files [concat [dict get $folderinfo files] [dict get $folderinfo underlayfiles]] } diff --git a/src/vfs/_vfscommon.vfs/modules/shellfilter-0.1.9.tm b/src/vfs/_vfscommon.vfs/modules/shellfilter-0.1.9.tm index 25ba28b1..d70d657c 100644 --- a/src/vfs/_vfscommon.vfs/modules/shellfilter-0.1.9.tm +++ b/src/vfs/_vfscommon.vfs/modules/shellfilter-0.1.9.tm @@ -751,6 +751,12 @@ namespace eval shellfilter::chan { } else { + #REVIEW - this holding a buffer without emitting as we go is ugly. + # - we may do better to detect and retain the opener, then use that opener to avoid false splits within the sequence. + # - we'd then need to detect the appropriate close to restart splitting and codestacking + # - we may still need to retain and append the data to the opener (in some cases?) - which is a slight memory issue - but at least we would emit everything immediately. + + #puts "-->esc but no detect" #no complete ansi codes - but at least one esc is present if {[string last \x1b $buf] == [llength $buf]-1} { @@ -1118,8 +1124,8 @@ namespace eval shellfilter::stack { proc status {{pipename *} args} { variable pipelines set pipecount [dict size $pipelines] - set tableprefix "$pipecount pipelines active\n" - set t [textblock::class::table new $tableprefix] + set tabletitle "$pipecount pipelines active" + set t [textblock::class::table new $tabletitle] $t add_column -headers [list channel-ident] $t add_column -headers [list device-info localchan] $t configure_column 1 -header_colspans {3} @@ -1402,7 +1408,8 @@ namespace eval shellfilter::stack { } dict set pipelines $pipename stack $stack } - show_pipeline $pipename -note "after_remove $remove_id" + #JMNJMN 2025 review! + #show_pipeline $pipename -note "after_remove $remove_id" return 1 } @@ -1607,7 +1614,9 @@ namespace eval shellfilter::stack { #puts stdout "==" #puts stdout "==>stack: $stack" #puts stdout "==" - show_pipeline $pipename -note "after_add $transformname $args" + + #JMNJMN + #show_pipeline $pipename -note "after_add $transformname $args" return $id } proc show_pipeline {pipename args} { diff --git a/src/vfs/_vfscommon.vfs/modules/shellthread-1.6.1.tm b/src/vfs/_vfscommon.vfs/modules/shellthread-1.6.1.tm index f0d3ad8a..c529f234 100644 --- a/src/vfs/_vfscommon.vfs/modules/shellthread-1.6.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/shellthread-1.6.1.tm @@ -398,8 +398,8 @@ namespace eval shellthread::manager { error {wrong # args: should be "dict_getdef dictValue ?key ...? key default"} } set keys [lrange $args 0 end-1] - if {[dict exists $dictValue {*}$keys]} { - return [dict get $dictValue {*}$keys] + if {[tcl::dict::exists $dictValue {*}$keys]} { + return [tcl::dict::get $dictValue {*}$keys] } else { return [lindex $args end] } diff --git a/src/vfs/_vfscommon.vfs/modules/textblock-0.1.3.tm b/src/vfs/_vfscommon.vfs/modules/textblock-0.1.3.tm index 56651d21..8d66978f 100644 --- a/src/vfs/_vfscommon.vfs/modules/textblock-0.1.3.tm +++ b/src/vfs/_vfscommon.vfs/modules/textblock-0.1.3.tm @@ -62,14 +62,16 @@ catch {package require patternpunk} package require overtype #safebase interps as at 2024-08 can't access deeper paths - even though they are below the supposed safe list. -if {[catch { - package require term::ansi::code::macros ;#required for frame if old ansi g0 used - review - make package optional? -} errM]} { - #catch this too in case stderr not available - catch { - puts stderr "textblock package failed to load term::ansi::code::macros with error: $errM" - } -} +#2025 - required term::ansi features for altg now built in to textblock +#the deeper paths issue is still a potential issue for some packages - review +#if {[catch { +# package require term::ansi::code::macros ;#required for frame if old ansi g0 used - review - make package optional? +#} errM]} { +# #catch this too in case stderr not available +# catch { +# puts stderr "textblock package failed to load term::ansi::code::macros with error: $errM" +# } +#} package require textutil @@ -139,7 +141,8 @@ tcl::namespace::eval textblock { # hash_algorithm -optional 1 -choices {${[::textblock::argdoc::hash_algorithm_choices]}} -help\ # "algorithm choice" - punk::args::define -dynamic 1 { + punk::args::define { + @dynamic @id -id ::textblock::use_hash @cmd -name "textblock::use_hash" -help\ "Hashing algorithm to use for framecache lookup. @@ -4068,12 +4071,12 @@ tcl::namespace::eval textblock { return $frametypes } - tcl::namespace::eval cd { - #todo - save and restore existing tcl::namespace::export in case macros::cd has default exports in future - tcl::namespace::eval ::term::ansi::code::macros::cd {tcl::namespace::export *} - tcl::namespace::import ::term::ansi::code::macros::cd::* - tcl::namespace::eval ::term::ansi::code::macros::cd {tcl::namespace::export -clear} - } + #tcl::namespace::eval cd { + # #todo - save and restore existing tcl::namespace::export in case macros::cd has default exports in future + # tcl::namespace::eval ::term::ansi::code::macros::cd {tcl::namespace::export *} + # tcl::namespace::import ::term::ansi::code::macros::cd::* + # tcl::namespace::eval ::term::ansi::code::macros::cd {tcl::namespace::export -clear} + #} proc spantest {} { set t [list_as_table -columns 5 -return tableobject {a b c d e aa bb cc dd ee X Y}] $t configure_column 0 -headers [list span3 "1-span4\n2-span4 second line" span5/5 "span-all etc blah 123 hmmmmm" span2] @@ -5071,7 +5074,7 @@ tcl::namespace::eval textblock { #only call width functions if known_samewidth - otherwise let the pad algorithm below determine it as we go if {$known_samewidth ne "" && $known_samewidth} { if {$known_blockwidth eq ""} { - set datawidth [textblock::widthtopline $block + set datawidth [textblock::widthtopline $block] } else { set datawidth $known_blockwidth } @@ -6214,16 +6217,22 @@ tcl::namespace::eval textblock { switch -- $f { "altg" { #old style ansi escape sequences with alternate graphics page G0 - set hl [cd::hl] + #set hl [cd::hl] + set hl [punk::ansi::g0 q] set hlt $hl set hlb $hl - set vl [cd::vl] + #set vl [cd::vl] + set vl [punk::ansi::g0 x] set vll $vl set vlr $vl - set tlc [cd::tlc] - set trc [cd::trc] - set blc [cd::blc] - set brc [cd::brc] + #set tlc [cd::tlc] + set tlc [punk::ansi::g0 l] + #set trc [cd::trc] + set trc [punk::ansi::g0 k] + #set blc [cd::blc] + set blc [punk::ansi::g0 m] + #set brc [cd::brc] + set brc [punk::ansi::g0 j] #horizontal and vertical bar joins set hltj $hlt @@ -7417,13 +7426,15 @@ tcl::namespace::eval textblock { set blc \U1fb7c ;#legacy block set brc \U1fb7f ;#legacy block - if {[punk::console::check::has_bug_legacysymbolwidth]} { - #rather than totally fail on some mixed layout that happens to use block2 - just degrade it - but prevent alignment problems - set sp \u00a0 ;#non breaking space (plain space may act transparent in some use cases) - set tlc $sp - set trc $sp - set blc $sp - set brc $sp + if {(![interp issafe])} { + if {![catch {punk::console::check::has_bug_legacysymbolwidth} symbug] && $symbug} { + #rather than totally fail on some mixed layout that happens to use block2 - just degrade it - but prevent alignment problems + set sp \u00a0 ;#non breaking space (plain space may act transparent in some use cases) + set tlc $sp + set trc $sp + set blc $sp + set brc $sp + } } #horizontal and vertical bar joins @@ -7555,12 +7566,12 @@ tcl::namespace::eval textblock { @cmd -name textblock::frame_cache -help\ "Display or clear the frame cache." -pretty -default 1 -help\ - "Uses 'pdict textblock::frame_cache */*' for prettier output - Either way this is set, output requires long lines and may - still wrap in an ugly manner. Try 'textblock::use_cache md5' - to shorten the argument display and reduce wrapping. + "Uses 'pdict textblock::frame_cache */*' for prettier output + Either way this is set, output requires long lines and may + still wrap in an ugly manner. Try 'textblock::use_cache md5' + to shorten the argument display and reduce wrapping. " - @values -min 0 -max 1 + @values -min 0 -max -1 action -default {display} -choices {clear size info display} -choicelabels { clear "Clear the textblock::frame_cache dictionary." } -help "Perform an action on the frame cache." @@ -7569,6 +7580,8 @@ tcl::namespace::eval textblock { set argd [punk::args::get_by_id ::textblock::frame_cache $args] set action [dict get $argd values action] variable frame_cache + set all_values_dict [dict get $argd values] + set action_values [lrange [dict values $all_values_dict] 1 end] switch -- $action { clear { set size [dict size $frame_cache] @@ -7589,8 +7602,65 @@ tcl::namespace::eval textblock { error "frame_cache -action '$action' not understood. Valid actions: clear size info display" } } + if {[llength $action_values]} { + return [frame_cache_display -pretty [dict get $argd opts -pretty] {*}$action_values] + } else { + return [frame_cache_display -pretty [dict get $argd opts -pretty]] + } + } + punk::args::define { + @dynamic + @id -id ::textblock::frame_cache_display + @opts + ${[::punk::args::resolved_def -types opts ::textblock::frame_cache -pretty]} + @values -min 0 -max 2 + startindex -default "" -type indexexpression -help\ + "If both startindex and endindex are missing/empty, it is treated as + startindex 0 endindex end. (ie displays all records) + If only startindex has a value - the frame_cache record at that + index will be displayed" + endindex -default "" -type indexexpression + } + proc frame_cache_display {args} { + set argd [punk::args::get_by_id ::textblock::frame_cache_display $args] + variable frame_cache + lassign [dict values [dict get $argd values]] startidx endidx + set limit "" + if {$startidx ne ""} { + if {$endidx ne ""} { + if {$startidx eq $endidx} { + set limit "index" + } else { + set limit "range" + } + } else { + set limit "index" + } + } else { + set limit "all" + } + + set display_dict {} + switch -- $limit { + all { + set display_dict $frame_cache + } + index { + set k [lindex [dict keys $frame_cache] $startidx] + if {$k ne ""} { + set display_dict [dict create $k [dict get $frame_cache $k]] + } + } + range { + set keys [lrange [dict keys $frame_cache] $startidx $endidx] + foreach k $keys { + dict set display_dict $k [dict get $frame_cache $k] + } + } + } + if {[dict get $argd opts -pretty]} { - set out [pdict -chan none frame_cache */*] + set out [pdict -chan none display_dict */*] } else { set out "" if {[catch { @@ -7599,7 +7669,7 @@ tcl::namespace::eval textblock { set termwidth 80 } - tcl::dict::for {k v} $frame_cache { + tcl::dict::for {k v} $display_dict { lassign $v _f frame _used used set fwidth [textblock::widthtopline $frame] #review - are cached frames uniform width lines? @@ -7651,7 +7721,8 @@ tcl::namespace::eval textblock { # ${[textblock::frame_samples]} #todo punk::args alias for centre center etc? - punk::args::define -dynamic 1 { + punk::args::define { + @dynamic @id -id ::textblock::frame @cmd -name "textblock::frame"\ -help "Frame a block of text with a border." @@ -8208,9 +8279,11 @@ tcl::namespace::eval textblock { } altg { set tbar [tcl::string::repeat $hlt $frame_inner_width] - set tbar [cd::groptim $tbar] + #set tbar [cd::groptim $tbar] + set tbar [punk::ansi::groptim $tbar] set bbar [tcl::string::repeat $hlb $frame_inner_width] - set bbar [cd::groptim $bbar] + #set bbar [cd::groptim $bbar] + set bbar [punk::ansi::groptim $bbar] } default { set tbar [tcl::string::repeat $hlt $frame_inner_width] diff --git a/src/vfs/_vfscommon.vfs/modules/tomlish-1.1.1.tm b/src/vfs/_vfscommon.vfs/modules/tomlish-1.1.1.tm index 3e13e75d..0c8d0b1a 100644 --- a/src/vfs/_vfscommon.vfs/modules/tomlish-1.1.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/tomlish-1.1.1.tm @@ -716,6 +716,7 @@ namespace eval tomlish { set toml [::tomlish::to_toml $tomlish] } + #TODO use huddle? proc from_json {json} { set jstruct [::tomlish::json_struct $json] return [::tomlish::from_json_struct $jstruct] @@ -1080,11 +1081,13 @@ namespace eval tomlish::decode { # For this reason, we also do absolutely no line-ending transformations based on platform. # All line-endings are maintained as is, and even a file with mixed cr crlf line-endings will be correctly interpreted and can be 'roundtripped' - proc toml {s} { + proc toml {args} { #*** !doctools - #[call [fun toml] [arg s]] + #[call [fun toml] [arg arg...]] #[para] return a Tcl list of tomlish tokens + set s [join $args \n] + namespace upvar ::tomlish::parse is_parsing is_parsing set is_parsing 1 @@ -2380,7 +2383,7 @@ namespace eval tomlish::parse { squotedkey {PUSHSPACE "itable-keyval-space" state "itable-keyval-syntax"}\ endinlinetable "POPSPACE"\ startquote "quoted-key"\ - startsquote {TOSTATE "squoted-key" comment "jn-ok"}\ + startsquote {TOSTATE "squoted-key" comment "jn-testing"}\ comma "itable-space"\ comment "err-state"\ eof "err-state"\ diff --git a/src/vfs/mkzipfix.vfs/modules/commandstack-0.3.tm b/src/vfs/mkzipfix.vfs/modules/commandstack-0.3.tm index d7d9813e..f14c5987 100644 --- a/src/vfs/mkzipfix.vfs/modules/commandstack-0.3.tm +++ b/src/vfs/mkzipfix.vfs/modules/commandstack-0.3.tm @@ -234,8 +234,7 @@ namespace eval commandstack { set next_target ::commandstack::renamed_commands::${mungedcommand}_${munged_next_implementor}-$mungedrenamer-$tokenid set do_rename 1 } elseif {$next_implementor in {unspecified undetermined}} { - #review - probably don't need a warning anyway - puts stderr "(commandstack::rename_command) WARNING - Something may have renamed the '$command' command. Attempting to cooperate.(untested)" + #could be a standard tcl proc, or from an application or package set next_target ::commandstack::renamed_commands::${mungedcommand}_${munged_next_implementor}-$mungedrenamer-$tokenid set do_rename 1 } else { diff --git a/src/vfs/punk9magicsplat.vfs/bin/concrt140.dll b/src/vfs/punk9magicsplat.vfs/bin/concrt140.dll new file mode 100644 index 0000000000000000000000000000000000000000..402b6aba67169131d7456266b123dc8362c2cc4c GIT binary patch literal 322672 zcmeFad3;pW`3F2%1_lHtDAA}WqXdmoH8n25V3{EaxkDxrR5Y%{A{rGnh8aXf4Nf8q z*IRI_w%SV7RieH^ecrVbYuI+zkyMttTvy%G%XP!=KFGG8b-Ir89h83X@vb%LF4wv=xjnZT zzq90Lz1-n%-0Fp|zWC2?`K$v5@vr?wH}F{Q~`%J(iQ{ zYU9lXnXYx5kXkf$CcYobbk$bkyD8H(9UV3um*J|#<-R`k$7Z@Bb~`wHhBSx;@Xl>xp!i7ISZ|%5-VbH}YEe!1|#47T%5z z-LQ@|Sbhn~AfCNtqtrU-;^bNdO@XKy)wWbI2Ugkn*|K@47 zr>Do#^ii3yK&C#*BXvfhb|A~HGsxHNr>`Nu$-tFbB4doc;E zqi-xjipPpGW5pg|&Ua}`jkc$SFXW#>{uvP6lNLEi(~Gm> z*;BDnJC2D?^tj9paEHdGFzUa~igx|mJ*PEwoEk08j7NI67JJBnRMjF@9r*3sXhuBJ zUoXzwwfU$O(dLX;xo1I|reBtu&v8z$!C$@1Z+#;7sUk8u}fe zMVn60qT9ASXHS3Em!J&)jW&U9BO7S8pxmgMH)7AX3v z+fr3MNtEO*M1Xo++a?Rc>&ow=io5yBu(sVG`Q63?j zc=jD=tK(A5aNjE}l|Bsmew>u>w3+@6CZV84~*kuOt)9}N6q$+t9N{)23mX_hM z%kH(}Ve@cI20AtH(|0I-wvY@t6h($pazKhcA;ZL4KCp4Gf9n9po%z$_ZbVx$?viff z?)!F^aR*P8abNd7ab3EvaTg@Uz5S4%7&mx0W_ogNjus2$dM>;ua3L7FKdA2s>Sjp) zhLS^b6YGm86}0G+)iMduCu^+lS~V%|H6~%g%5Xo}&R@MycA9#o*W=qf`jj*-Onosg z>Uj~>cjI?l(;v*O$IO9qnd>fcxhfiWhHuwme`U+11x*DT_@FF^0G_#t-0U`lnXVQ zJ~_7*9Nr(eV!{>VN%wIG!a9e6o!~~zGh8U-r3WwIO7WjRUT`&I`&@zCJs3){Rsey} zkXw&CLA|{~@6_}?1v{}O@}Wu?qdnTLk2T}mxaRc(zBY6B$r(ml#e6aVPCsAz) z4IJ}Hc|bM`_IfVHbw~$GhRFT<|Mr&v2){LgS_fGOOQa|IX!U;i1vb_Hsc^a|8fnh+ivO=}3XkR-*5Ci&iw) zd-vsWwt`iCuMAQvSZ$Wg!{Zrm5DP@!<(Iasrd|MY0xJ-jvNVMEfDE${qy!ppANvUh z)LS$D*-5HG*+MOPbs;8CiK0V=!@R5M(A6dpfY|6lixk$HtFg{CeXZ$(U4$tFIF|ur zJq(nHd}sflX^^wk^&a&2;fHJ`?PU)D)iPF^cin?;!#!7S10lxPeDn5UX|95%SXm8b zr569Ewa%! zQUB(6KrMLx$in;Mv>7q}&2l4ys_0CvR(x@>&YC$3e;tfJTf!%gbLn>(tu@z4xHgBP z6#M#{pcZrNzJ42fovFHfd^3B-6cut=PvekR#LE3ztX#wYO8l=v6`xctuGXUEHF4a- zbd*oiVtT!xU!Nskb7~0c9P$YZEWbSoJ-{`ptPyc4E(Pxuo*{DO^7S zAH-M0o*Q?;#{!oyT;uVkWPEA+fUEOgtnyQERSLeU_JOa|HDfLT%OG5nY<$@?Gf2>u zp+%o2#ejAC7)P%G%P_|J%|1T}taD}oS7t5&X`R`I-~5D(GH{1Y1uM)|fY)Xi z)^hC;hKZYq%&su}_%8468wPhW4D(Ld2MlEg2*aj#5->!AS#cmC{5Ed|a)28j#@?J~ z-v3`U>{<@{WYy(@#IRw|aM*9((rwr_k4{>*=wR3fs!!u$2ncI|ZaTi_g|JJo@lyo% z2=G5^&OH3pjK}Bm3v2%U?*X;QB|>**5_Eoh`6j^!Ijb}hQ=>XUUf%L=fwMJ0W)4hT znFXC7ki(0TSkNb^S-X;}Dtb*Vp5IaE3j3G%@z~TJK~>lUv69>xO4lJ;w3=e4LM$L9 zb~cLG`Lczb6c<8dZq;HFYBgvjxf+#-O`5GltV9``phSOw0HpeG9+$Fc3)>;japS~4 z+3LeuaUJY`d=DJJ_`X`vk5n)Iv@_hQDA<^T>w4dFJC=Oaju{%5b_1CN-JH91%lMb_z|;w_HWG9$`!IefR%~ zFhte=+}%C)AA6kr0}OVb=zmO){m=SlU;SfwiVuf&m*JkA)Nf9r->8f`s>c1K8h7+b zt79mC8!_D z>fI(DQrm}iDV4j_{aufBTj@S9+;4QLs}``~ensxX_hz{NBtI>p>C*N&J+^(lYI|Fk zw!73#>#^>stZR>iy1nJoQh0a^_E~p4{P#&2i@&G-@`1zUFn|F+5qYoOKnXQs3!5+{ zh|U*PGkZ|PL1%vVxd_@#q|C)Fs`8+oVDLHf*uTfRMXK&2$sL0TWb9qwUky`95YPks z-_iYQxW^?o(*yi5yNML||EVf}f``uFZ5R^pSM*r-c2(Dt+;R811A44GQq}#TOTQS$ ziQ*TATNS?zXd_l-xhVzHiZq;Vz=Gie*DC7xd7QIwaK}_Qb1#rB%`j6en43 zHk}#nZ-1)(uT}m3S^%fk=X&kKP7gINxextBhu}Zlr}zW8*u8A9M`vIB6;_3_Pt_pr zwaq8;p3cp9jPV&ulve6~UJRGs%V$)9!=;%c#)94Hy zt>J!F6vG*U0zJkd^e}*zmdZG3oAmJXVR^bru-snPhkoP)zcJjJG7~{ZK2~;{PtxxJ zzdEl5nzznD+ewo&s-_cj80bhR}kL%F|m=J^*w%hPhol5cwKlU=U3CQpFSvxw9(-&Pztn$HgLIPNgidb`oeZZB>h`Ni*l2!nRhK+O6`f$oclEBX2iH92; z80PE}JUsV+jfWS0Pds#`|6GL*b33JqvDC94G9La9b}L?irEOR(`y%%NN#$nkr(F9> zPJ89~=Bj@aUhv|C4B7^xzbm|-yopLN$i$z9H7p%#7osK!>Cr%@{DV>KnL zSMzD~8jXJ{`KJmvT5C3bL@ILMDGRI@eoeO|guZbJtZDeKu4b#c__C^`aJk?7oD*l1 z=a}z`B0q>E=maO6(L(QfE<6d~JQ zKn?w;akQA_xBwj-Ex(7ON#N*yN<9Zh^ZB$pj;`D$I9l0^r-&pO?sYBvh2dH_a!q2Z z3P-0)Vc=+rjiWOaj#f$apT-fL3cDOSvJ~9E3)caTs$>ydN*6f2KZ2uXs=HhSq@x!t z9KEs-FzJue$-3XT`hzT&5?6nsk)u(bUg|+#kU8sch>OzKz^BoPq@#(Xqlu)WRpvP# z3XaZHa|z1oLJRF-GRiJ`{3CCmEz#qxM z9^ZZO{*zBFmHp8VIE>_leEE;@ICCyEVEoUoD^Q}hdR!4VGzg6<-dHLaBB5^nn&Zp< zjbTfN2OkvmC`G^U%jlsBtygQu{Izs1YiAIXX8F*W9N)n1;tluj&Q$^;clV@jDVpdc`g5-GW!&+pHp(oe4A9O-wu!M zeweveAWmjfM+?NjJ`EdYx#ZJ9d^n?{xJ))=HvWynDbF*JN1M@3 z-rar`7%*?z*I*m=HJM)fC%say2lh_AE=gQVd*Q^j)PKsp?j~#X@1vim?Oc`~K3y|z z-W@Xf{|+&d=i65 zX@3sI`TpDg;TdWFA)3P7+K=DC`qoqcr${4Aw69BYL)-Rvd}j-RVipHgy_Hf)Ca;w% zDUo}~DePK*)(*SA=+US@`#|dhW%SzgZ6)ZCUbgpW(pdz=_8t|nxm53wg~dV(i$`=H zB_UOxBzUd8Z7g+0|zq8C{o1G~Zh>}@{> ze^uS;U-z@>Kh~}ONk6Opwr=&mxb^42pZk?fKN>Z2(9g3!tNw%C>R

>Ssb_RQw5& zTlzogXVstX)VKN57x;1D^j{5yUiEL+fA(k9FG09c)fdk@@ORzMs^96czH3ULH?iRo2Xx>j*A#Y3_g+ z!;c(uatD97vlp{cZ-sfW8iD!Fsko^^=J~c{>)zjy^sG=GS=QN@r2g)-`+L>yuiolU zP|>Bo`k(I4Y;fjROn5*!Mrs`>fBwO#-)XJSzCWw}WaJT8^lkC?l@Vg;K>Kg&R)6*Z z*2gTJ@I1TP18hSXVP-^iW4cR0qg14|=7=6zbLPxXpL;2?LqUNM1>cAJ1`R*90|Y#` zOfG1mBmQJf$L^STlNLSO750R%M`HNd;VIN&gGEhspH&pKP3fy)i^`bTh_;TC>Au%= z(pwK(>l07sP|BmV@t0M=2#lO=TaD=2DY7u{tq zq5B%JgmC9?PLab^ksPPUjVvOcg#4P(ycsiEu)!FW*6CgNz++tgurTr?zrxlE3Uim4 zu^z+@?-I(n%qPwxGGWlccfqX`A3vVXlr}sM7+ShW$@V)@hP5+U;Y|{ALep0LJGk|6 zV)S5+=6xR7Y|-W{ZN?t%sH^L3PJb&NM-UBWkJo$-NgB*eLI|y&WF3Km7hg$arKp__ z3qkZF>?zkv+K{-HPJ7sJx4(uaV%TMB~}UC05y6o$sk&d5Nb@zYW4e28b71r2kttTL^}Ld zd5lEq<2aL83(;km$?s(*VYG6O(6SS>Va?b!grBdJ zf2UH@kJR*Ak!bTU9c5~*{T(}M=ZfnO`ET$g)<1$?7u1yC;Yh&8fC69_J73SoYR2XdyuKM~B*h7Sn$7yi}^j^@v)`!X>VfR zOWF;G{eP*KtF@wWIaB(O1!{Wcx|RZGqntGZj8?h{x%Ei+1NUBF{f2XMoMd(V3$3*o znfCF;9>C2_1J;It)|(U?GA5vh&d~7QVP9x?##Dsay<_yu<}tC%<-vGUs3@au2X2`m z6xU+IECDnb`3OEE4a_8~`+U{v@oZI= zGs@T?mZg?Smohy7#|#G5%!j|Tn=!+L#Jo}d)(BK;g7vhhnGxNc=KZajd0wYScc4k5J_cC_#@2<^Yic+=) z9<>_YLX^(uZ`c_*3ZXm9QR51~_o3x_c@6eaRMYF$xZ&&D*rDDee90~G+*m1`F_YG! z^+}uf=R>TLiqG-mD_-qF@$qZT!{NdKe0P8omVTubm2L_dkzG?VL&oW?75bUnqJ*7e zy+X#5)HN&gH|(uNdGYKQALiz;$c@M<{+y$7n;#4%t;fS)4r|Sqt_MdAVwePP@gCrE z(QZH<-5d8dj^YLzXWtZ_7Xo~+Um)yU{NnyK;u8DU3WNF-KlZK#CIqesTsGlyNXK4D zVB}-}C%}L>n})Wb%g8P&aP|499?u?tXBeFg->;J4%O-psx}rBb2MqcPYgaCt-NwqOO+w_~vmvH1GWEU&@t zUvz$-1U-SRRp!}0ttW3+KfE9Ou;)HXyYw+B(FbHMVnAIw8Lv8- z>U1)hoseE2FA^~*9Bm-Fa!}uGe$yKW5p@}OhiP{fNU7HoyqCV1SZ6B!H-{k=A0~w1 zer$m}0p_E>&cVH`)=@qba=}K~fEAy`tsF5}dYn|s@fYt$d5~^lW0Uv6Cdyuzb^CMpPhM~}DtDHWEh9ay&gMV^oh2n>vzpMvK29-y&!o5(5>vQKusR?3deZ)mJFZtym= zVTj7QXz9fPB{q!|0>n-82uOy5u9j?|3zn?mzJZo_EF+-ziWP$zkfPaIY~yRIW?WRQ z*4D4S69I#eCbl`+>;FDhod8t!vbHhnYZOka@dOaasw~+FY4P9mh!micdLw61>Q~X!HL@SN(Wc6xh!BjWk3tpQCr(y4IC}=RaTO}K%q@?T-?U<-$;9R- z(v+bhl25aJ%i^oXN~6^z`MpN=oeXfx&}!DoeE)f}J+yK-8Zac=hMpn172J?$>#8D* zYJwvB)fq%QjcUau0#MhasNvr72R=$Li#HFknZ-!%D~Qp<0NU?qg)Wo9^k`ov@rW5z zTd?tpYq2SO32}X%g6hmJP!(zV92N%s6?cK^R0pape-)?*RP2%*FpbzHKGA5zvjT;L zJj%g`G}j#;ucUX!ht=~6SgOhRcxix*k5d&}{h#n5ayWa3vv4QSf;F+# z%cwM9yQY-7>}wJ~yl@ZC!myOg^~bZvqaf9S*pa-Mq#@B1%;Mf1zZPB6gerKv#oKT{ ze*m0==@z9rSY>WN7KVs-y;&& za;}an+(3fK3YxMMd)Tv_9fJQDvM`>#NXLl|kkdH(qW@XAX`VI*(z17FT-pZ;RjA-G zi8m7;_pFwQeX_>J;WIGZf&XT|w9X@pCZNs4RLd_s2me6td_J=KbDN&u(_($;rUiH5 zhLGbh7=jFKsV^$2;DyiHx1V((%(Z$!ojbG%;HZ?2T52mhjnQDn9x? z!QALv6+PR0bt$|SxPk_;a1qvoD{=|e<@pTU3nPKt?8H#<8#0uf1;1*bS$RUdqAYuQ zv22EeQA+FriIO;ypL`<01;{O4kk*lYS`)SPT59Xf6F88^a_O_eX$1B7y24q{TRH}) zGbAo8cfl|V!&iZPfid#?GcJ8AiA3n#$lf6tG@O>NR?4*WyT+cDLvBo-1V>(qk_BUI zvusc$OZHnVUkni<8*0%XV#4w@=q{iVTk88r!jakY}I&iMY>R?7(;8VkA@`z`#}VT zdlxjd{{~psYn3iy#uJ+9i3jnJGpM04QBT)Ag;|JY#HK*W z@S!cL@sP8!hd;KZUQRqk;aLc>Ttsb}LoXd?PFp#yl92u*SzjD@%IMEzV_v;NQoDQKLup){J zGv`IP%{mL>Mj2V(QnJ1<+*QE17*4EI0=FjHBY&CbZ$%(oY@4f3je^R)WLbl1$K zrocgELPj~KKO=sycT>G zew^SmIrkYbb*cvNt=zKS8fs}-$cRC9qY}c-I6nzo?)^x>B9Qtz)^Ob|i2RuH~z>H=Fcm$ps z1fD!xroaPUX62tIk!gRzqkM<4N9S7Li|=pBMG0gjF=|Jh^?@D{A{Pd6=zpN}8PR;W z*O~6@mUbM9y!iAaUf*N=jo(Rqt>^kj{AB$HSf4z&Ti^dGNa~xz;OUkj#xG%=tq&qD z3C;`V>_#fBjMCD7`hx*ChN)%*H&y0rk>& z_IwBl(c$U)M2A3~9qLEdv-#A>-blZJbnt4E^!WYdc8~L}O7!UThm|enM6x3D)yE?E zw}#JyS47lC`hWq!@m(Q^XCErJ;CZ2!7(i9Vvt77lsW6{@LP}N)l}lK3mwX4rBNd1j zIUxQx(Z(P3Ez5^(!Iw}>#_kKgd+zFjp?LNbxs?K6HEvn(mG%VR+&|hVyzO;C;Xg04 zQFyrnAML&9k{SpZmpBcm69 z$MOgsNCKkf7hLI#%Zti=5v&p{u7?;Yg|LEarJkA{wJ(x%+hyN_PBm;75N_eryBZ$s>ph$$So|A z`mx5BoL``b^b19#-iAjpFc~QJvAB?!@H$spQET{WxU1mZNTO2&Gm{3o;WioQNbys* z=;PrPp`Y3p&t8lt8n-YpP=N-rXWs6K#?vBwBz)3Whf}Yqqu*jGwyF4-49yBAL^akY zvcSx&E7WA~MxauS_=%SVDIZ>BBc;(Q@~KngE>+|er^v5a#Q8Yq$kxCLsD+bzn&tPm z50<(QLIAPcPMmeq=09zRdDQ#hE78}<{aoRGI8eg>Qd(^0ZgLx0Uypv^axLXUf5VOl zq6Y^fmy&B!zYqv%)pl(T>H%NHQB9#CV3}*;*^k~z#osyH;}BadAw_iZ+yqoyV- z1-ztxqAS&l(xMXzcuM;)7S?fS=XomNa>u!rTSI!Kj|om3=Bl8+3rfov==53I5FSsaQXQ>JF)hWDTW z%#K=RdP`D4$4Cb0bqzouvry*<0I!-7%o1iLr~~A50lAX|+h@77kk;XTU0Gjrz`OuL zXpBb?u%+KaA(8Hpcy=3NZ7LU{nsZdcIjRK>S2F0LU50dSeQ zDX~^iO8|MC&>bIOv!I!H_U@?wwx_`AhkVerxs|-x*d&3~2PCjMe=EUBC{Nw&x#YO9 zU+Hn3@lihH=3oxc*oyG5u3iZH0kw*x<3uXhId#3*<5EHfzHPajTuGOkucH(IZ$qHj z6q0AG`3TmDm3AV!Ml?_X6fDTte?S;aY8a>yFSTmH;{CV%Ai1eEyoshT{>Z}$u^NcdF0iv(%4+ zXVKS^{i6wgZ`(VTfAm^$^p=54ZAb64c=q>ofJHWlS;^1!^%xKGpK;%^K3X@WWKKBV zT>^P2#5)G?3kS%LFH~dv2GMIZ#`j;4F&^QJ@pTqapMArhFrz&Ch5zh*z<*o<{@(k6 z|Iyh3|6~Wa<1F}3bKoDO;JZ>jR6ukm^Oz`(sTqlr(h{FpJ0eJLlVqk?gBOR zJaGaeksLB8k21(dbQhXOyem;uWUIkZ*Y87FNbi6*YVquYZ^oR&ajx?Rb)PT*facel zN0ic;==kohhc|HwvF-5O1y|dO6g;tUnSrPN#>JVr1&o*H+ z_fw_DZG^q>hFT+TP2bxw40}r|vA3kEZh*75#3N+U^Nxo=lXA!TjZL0$H7U6(#CN$O+G$bI%PQTiZRr1W9S zYloS6|1Rs{7h~-8aN0O$@p1ihmxrhKAP?U}d=ByuQPpA(L?LpJRA|=r^Knbh*9 z1WkmL3e8@)I;|;*$vGk{yWD~D3$NzJR1%Y%NXWW%JpFL(f`dqcFA>uuE9O{#~8W6{G&js zU%`&6x0tV105(ATXGC`u*2X?7Si85(#@cBFA4TqWiu^(qxz;J-O^opWetfrG>x{3f ze@u<Jw|`NtlG znF(r#A(P@C^T)H9g0`=5xvg>SK!{Y0>*4t_uD46=aouJWdCw^lRz(&%MJ{5I)Q`|N zWSW;N;$-DiwbGkrI1LR`4b?ae9c=Y=qf^AAij+DogL{CR4x6DCM zuI7m>h9e_>bvj*hZgI_FiNndBnE(IDAM>v^u)hDzA5#Zlu)~R3UyuHn<5ng6W7HUw zKc)~h_vw#;Jah7)xt$XMex@9q{$M;_5QnI|D=Es4uHkUoXpBYvR}KkJqVV=+GG;sF zn`?gyI@I;~G(zFHfCkN=R|hlK0aFOOb@%^O^MXu{F_ObSFdP5{i|@(JoH*& z_>$1XWA}l5s)>Y8r6RQ7_W&Z>qHHCRFgSM770W|kwld$a)dZy69#pBH*D(|5g=YiD=p699I@cEkV&ux9d2LcQkGZ?~Hg0promEW6V z4<`uR^$S(miH|lTdg_cJv0hYtvOuT4x5xT3_FZ3ZcIs|Ctf#(9lj{-);1BVxWd$38 zdQ+$7T{tc)f`AvGw}Pcm7Plal2E?j8goIb+>u`PG{co}vqFS6A%rtc0j>syUC?K>+ zZKyVB9sg{`EqJA(lT2Q90x9F$%x93<2}9zJHoPg!)QT=&rx~T4Q!+Ip^Fs{@E=bUq zdlhnzc3dA$gz;MmJMVf=J8FYAgt{|y#xn^b?7GV<61Y$*L^zvDX}%EN(;Zw0nF{~wL-Ld4*D7~k#8E40UV-kJX= z<6C;yfsU^o37r4S_$2I~I)76Ufa_s=kK*tTXMA;M{GW{P0mMKLZ2tQE#Q09?kv_$o z14(idpFJd`AAtIWB-_4B8q(vZ|KyMo{6Qs#&%_A>aJ6CsDGYFKvr-G-4EB~}lVjN) zC%0^_V{=X6m(T|rP+pj0d>#NYvIm`GGsojfl6j!hKLo>jl9smtkuqakHES1|H!KrN zc8(H9;QH`bQjGr@kvV8R*rJ;76XeCSe}mhtWmS;d=zVOK`Q=Sgoh?m#gFG|gM3)SN zzjLw#%tsyKd7{0PG5R`6kCLkfIfB6bGDobYUH z=>eW&9C$nmo>B*%j#2x9$98QLnj`lKPXrwUUtQt3A^}fvPw@N(p>c(uX@3;_yi{c4 z=TZwE<|iA7a0X zzGTS*Oa>x3Bogd93pU9lFH$sugH5?BPC}<07h_@I0(4_1765zgvN$O%L z+b>L{yrjHO8Ksq2jGEQ2OB<>2D8!4qz!1BPLtLkZ2z?a$GZj7TI@p^>!87bcd-UoRz1>QQ4MR#~b zzbE-%BS*ap+neZJ!XMkMg!d7gj(YSi=`#>$;I0H=5EEz7$HY70|1r+bSL?X^RSq)x zRBk;UxjF`G`n~d#?6`}+w(}CeXgsJMGl_NZAckHeu#U+Q{)Fkpib*+sQRQ9Qo4wr! zKaEww-2)9yAJ;)ADno(*^ZD>|H8QF2Gm(Y~eYXNBndXy(A3^5*y_Rq+0A%RW8UeCM zUp*Bdt2YtK%K|D8ry;aH^BVZWz}KHT3lPbTF~1^%@{d3NLgey3ms|B;JfE?BzMHe) z9{(2$@J7CqJD`7!#D0d}uo2z|7pS+P4l9Lu$av$179Fw7i<<{q2E`e+*?c903}au%d0vP80CIHCaWwYfAiShTM06UyT0 zc=aN5uj3G7_<*n=S=^4)!YT6zVdI`=_Xd&9 zq~I@4mg(fAOt|7wd97A4!#e;z&wS_+nb8ers2R;Or;WgjVvc=Ikvdi6d8f#D7D@j2 zG5ts~n6W(vk$z14WluR2%L5!MIP;xON|)LYnmX@WIJ2Dh7S21~x@o>R7b6N8_vU5+ zSJoa*A-Pq$h3*G&1_NqI>EmW{1%S0rXVfOMH3`SPh*xB(^R;8d>xbR(8bSzA@cIGq zy4JjGm?g3OrkiG-es33zVSs(vlNJd~Qdswj9aJs!dPAXE^+~5?+ zRYk6Jiu7iY)Q{x;VO>9W6&m)I%IPTNxv(MZ_sj(#3$YIjFIK1ReJp4baRdZc&FNSO zb3t#Fu`*w4S*|P@zUObThbZ3lZ|g)9`y`ZCPeK=X7hlN8{1?kIiKflG^=u+Qng5m* z%`}sVQJfjv z^^pz5S!lNeIXoKz(Wb!w#}jNe5uIoYHg8Kew+{z{>V*fmhc$GZD56l=c z5T1cDPi$a@EF`|o;v?F{egS_n){`v6=o|TofRP2Oy}#5>f?epMuL0|-7|414BXtZ{ao|zuY#Cv1T%aoURv@3T2A}@s; zvmX;<@5QX7>Vy<32+N4y(9&p>m-`}TEUCnln|BZt@X=~K4j&ORiajDAOLQt7P>tHm zyM82li52_sKM&!FJT`Rlv0%OUe>(nS6PkN8u*PQmDngTQ4xPcZBZb2|08J&gho$1) zzZmEQ-FD6l0BHKO0m3is=+AdUyG3TyI$Kq5?T(vSjJ@%ZFZA6OKCX>T{U;ci%%y;s#=Q+@fg#`hzifZZY=?=0Wu`YS?epYrzN^QKQMbYjt~;m z$%x(N-{DE|H^jr>H0S#|GVvE;sLrSN$|%k$GV3Zd<2K+2Z)4gJ`P>*&X&whE5u6aU z#}cFZ!GVkw#IZ<0g`_JI+I=kolD=on6DZfreIX-VN9-5@}VmVRN12_GZi{fg3oGgX5kCI$LY{fi$Ec z4voj--stX($npC5ek_W4#AWlxz+=C3FjZ`$*TrTl5U0-|#L$xrMW>Ja61{K82uv&3 z8i+Oz4uBto#0b<|O7xATka;&_Mvo361{TycPe9)gh%eJK=MKrdue4}=-M@jyO4%X_ zudF!}`i4GdF5p0#4q8KFXyACL@+C~J#?e;#9A*mZnHimZ)KYP{#5STR&#VQF5l}7{ z!L7Um({N`^<;^E%{Uj2 zECalUY8frsuC3Y-5E;)lO9bub0Hct#SLNIC;(HkH7JtP+fWhGIc=nqJL7|rNm2u7> zVuzz=dtavE{;Omj;Rq+pwEG{th^1kVacdw8atd{ubIf0$WiZ}qynhbj;$?6;+=tA- zpDdSmKp+SIp(_OnqgQIK=#?Rt`EdceeUkAKjHG3`yp;-f)HYA$GZ!M^tNFf$4b=VJ zeuJe`_xoW&1fv+4eBuu`+$(Sk<V*!cTp|M3EDQ9d{T0gY(vltQtGc z?*g7j(o#X@KA9d5kig0XBhzqWxLjkk$9{zut9#6|m(ajbAGf5sVB+CXaw|a32Kr6*LY2v(t-1=U^S)9 zToIlGO;yK!{o%uLs2z_Xlths29l1m-ka%GYD3$Mx2H-{(a>%c@V z#+JjCl@ zVTvGPh+ILl9%{$&62=T}zAM2!nJ-J0?J;X$dg_}oc<;gqS&@qzWWo3OG>XehF!UBY z9h>DX-ORIF3NWy0a}?@f&{yg+pF@u_op^T=o-Ciq(WaRvpn#y@O#HAXgu8Q7CZrgB z5FM5}7jKiH$D~m+9W_@g-0V6BN!{h`tgNruw#=Z8@_+#;LV^pWM>pjVo z#va>gHLl1|P24kDPB7-L!T(wu5Sta;wHd(&2GfSDGfzDUt?g5<_Hpl-F{%oO%)VTM zj$m18-jZdZ;hxA8oJN^tjGB*IG`YMbotl0V$o|eM{I4!43?3Uk*%(FCRH$(b2=8s1M>rfnh>de+~F57N1kCB(n zxO?9OWjwa13FRq6Vt*w~sjb!q-crirrr{xVxkVKu2^l{+{IoA1%N((P& znmH=#RqCFdY1aYB*_3jamAN3ITWn6@=L#`l@R3tQS-|2H;cN9WDS8ezHyB!$S;P@Q z*kcf|-;rUb#qyD$=pmdq2>32cIylAHnhx;YvRY^X=yGf=6%fB^paX1sV9;}o`K4%r zD&fb+cVH(iz`Iey(*-)n|Gg+<{}_)j8=6DvSR8? zhoDi4`GDdc((^;H7p+6^MuS93=ux>H51I4GB>(a(WcW)!3}L&s%u`_lFrv4{{OFT3 z=v%w#keUyy6ztT{&^-Loo#XO1rMQT`+w0->&zF?3ILC{&LkPAU$5X7Kdm#H%sMjzjeCW@%n`4pL7RXRl$tupe8@%k(73|ecrX}faMv3` zKnDkaU@kCk<1U~eppUKsEg!~j%wV{``r-CAZoyNBX6`8^&0s?yMi~M_@P|M>p!2J8 z3q!aEq6WU;->{+j?Ph_>g0XNJt`49!pr7Z!Zx+2$@pF;N3zy3Rt z3s2Vs6T=aR=ELWJT|qiOOhJT`A5kM+R9A@xJY8Jae=hn<1CJQnsChzXLZN% z_>NwUBP63&SK|)+u4<9IL#}bxdeARCY4s#?c+xI9f=(8k3n_D$dJN~~IEWJ*2xrom z>%NtBv}K4|N44fAnAA!QasF~W+2?D%2VwjjlDh=OdvGuyyrA&deP53+oF5A(V~G(M zq(#5?ml(lJ%{#go&R1hxzaV}EjNl%v=snzA7A)HGGLJgN?IsH4SXq|o{)Wqh+H+vB z9D@p8HdYM$32>Ca=SXt_dQ`&EWI>pKk4=fS8!##>jWG+&h0G?1^%jj0>9*Jt<_X0x zja43A!LL&v)Zxqb=V>t*+0kWCGrzB_gYJgu=AI)=JQRA}?++D0YewGDN##bSAMUe^ z=r*YL7c^(F9F%+OUr;NOMt}~NVRc9zcbu_tFh1+^qAKIPTSSz zoOcEXK_7E0Mjd&q2!?xQGxuI z*RJ@`3)E#-8%hrM;mfDa)QnsC@~Q3coP==1s1Gz`-ZT*Mdgt;q1`Q8~`vZyem=y?` zQ?fa#)(&_9+;!I^PhjBRM4~+1el_G1nMUOP)64zkV=+x+VKr z-_h+5F+sq#J|I?cX9W)b@pC0|6&jiK8Z~^QUvmYlN4%$$3J^rB&xD^HoxD-#pjw6? z@H_e2K25is$07Ytumyib(YmldsBZ`wW8n2$MsMyxAq0Ox7~9Yr1m9Zpi(Ls6LRRl^ zO|_WF+=q1?UTmLy!}Z^d`owPeS>t((TC0rbIx_d}nOhd z0`J412#bwMP@lk~kumtpE4HI2BfH>eB@KM$3K-c5TcZ{_&NO)Gt9?qTk~}i(Cr12f zcZlv~ct$?o4T^|ez71(zA!F!zaGFqTQYUGuqd$Uy+sqrULmzzUeNk)VOS>eBbYSZ> z9*#Z3E5`+sFuk#pkP#rySb`E z-Y46p9JUB^cQE?Jx`hbFuI4upSA&{_KK}WAJU+XH2?LeLEAy#Sh;GlX&?gpR4-wT( z3B(Jpm6(w7ci^0GoYqsJ?}66jeZ6_{l#2r3oEdDNpfZTFb}RL ziO<1>kM}HqN#c+U{D8L=ycujb6vNrdu>fFQY2M$SB-U;AsqB*wCX`0AW1+yA7SeCa z3mG?~Y5+-&UsvecLJ}b9m&!|JJb4orB&}9-W zj;jR8tTK2`lC*40 zH)shy(4u9~OT-BWCHkBa_>Kxz7y)n)&{}lFN*A0M8EruXKz0BL8YW%IHEkchARik> zEC@5O2fSalFvB5ajBD|htQ5J;W;e50W<6{{v-(YWT5DMz1_Y$<2$zCgLiqsEP3uLX zQ$tnbBXyU7gg~|+tLUDQQ~Lx-T;q|v3r|60DcwilZwYnGPg_wFq`-Yd z`4Wn0J}eygNh+~;G|%~|E2Ac)?|E5bEqX8y%YsbVA4HcG#zhco%Swz<=ad-N?FGt~ z73|;x49vv9f*Cu42psOe$ZRyd^g6^8O-<(O#Ph|`Ym7};ard{rf=sI zH+Sxho>~&ppUM^b6f~}=+H^e|U??_XRV>W55 z`{{a6ruuU-u8N{fQ?3pgnaHVHrQAprdTVgwM-{`C1*0GB#j1Dlug2prO zgL0!^zj*d7NbRM-!C4~ZRu0X^k2^Bhr;c6y8%R=cgL+FoU_Q-5>=y)rS)iYZ!pTNZ zNC(thCBBf6`6C`+EkOpYFekx+g?kTc{}-^d=w)aSsBJF51ptQDq-Eg!I+?4$mhk3< zx{n}-W2fg9tO&;L@>O6VqyBX=dQE>Ww++n)i`GslA7f+!Kby2+aK44!2MuAEZw9@i z*5Ulq)78juY@j;abDGo|n#b-JQ3G^j%oH-Ud3cL&hYqkkb4h z0xV$R@r)^Tyd*OpIrSQ0`Y;BI@w`=W`&0XJdYSQ{xO@wi2vREHELvVMY&lpF$Y@Up zra#0Q)*R5_X8k6in$+(c|ItRZ;x3b!roiD zHZ<%%TC6ZM401~0I#~2p&|CIa2;l(SnMdry;bCN+h{Hu~RbFIni}?&(0v3XMl9%c= zK=QVtYk^><%4kJjOgRHwfy&OUdCV3tVU*PE=+T zYL1GhAzcPOj-hQ>XRnC_Gj7ihVct)}*r6$b^DK`Xj}7oKsQsM0eEcu8Q+!5UE;vG& z@RuE#1zYuRrPk@4T6}qM_%V?ac`jr=cJ~|I!Ha>zHmCNF@FblVn@DBJr7`!;}t? z1!ug9Wk4Ob<2;y8=!xHm>a^ZF^J&tSF-A@6^*_p3^)esFU@OF9A;50IQZLIFO{>JX zwgnRx@Rq#Qv#y0Hs{;O##Tk^>DW?RB{)NK=&ATqO52WWQXB#xfNq z{kz(*jcERTEn|?tUyGLG*;k_<3|-*I>r?gz|E{`4R%6<*|4K`s{*=a!Kx3TQN=Moy z%`v_A<`#HXgnF&@8qy&q^yZL$US37x)<~ZUW`HY6AM{li2#M;We29kowAdIp2*x1& z%b&05mw?Ke@dkmSEs^8lMhtkfj`#+D#$^S(1Jd|T%Pd?Dpkwg}q<4?Y>bM+FVSkT; zYcY)_QGn0UGFJL1h@MgT2*;qgT$E!UT^eEm1mvN!`tv)og1QDEaEH}nWAZCvmEfkA zfEFRf6gR^7qT8XnZwL?Lx!Ks2%>)geuaZYn?|mLf9T6jDRrlY3b0N%CaF_7nZ@hSo z7hOKm9+iM6_h212sg~pn7wfeTbLet4vU3lz-C)b46(u*oDQba4Wv3u7TXJQ75G_@9gaKpymLn@MI|MDbBfD3Bq_A4Q#0&eJGa;rd5h zAn#bjQt^KT{`*-~Q&kJiwhLJ`gEe919rQ9HiY_GVPyH1mF-q}nWsD=1`E3W%?!mlQ z$(X87#F$WNC{;T=#foihKNU)fnb%+3Z~eYCKS5jO5xg`H#b1X9r|2z~%#n!B*Km1z zj4_4g$D0@;3M^Kc#BET$%#+bVz>=(2AfFMsM3F1vC?J(s=lc*LpN>x&VzkAhMR%k{ zuz;xCkwfXBEI`y33BU*xeVGPlB^-8~%RBR#O|aH{5zr|1OM#=Lk0WI;D#S>Hgh_9^ z+)tucNh`Y7M22t8!0@8<_UIG{gqR!`dNDa zI@bSmChDWI+tgW^>p>AZ%bUYSv%z&Jz#VFU7Y(np+FgpM8e;Z#73C8%_mm1fg)zld z)#6KJa7bU(ynE36G^jt2F_*S)djVNwtMCU8;Oh36Prk(8P^$U#?nTHX%7#&9ghVB_G8BUDp5lG1<$P1*q(`gI9O%J|9&tr{QH48R%4N(}Hl z?A8Y44ePlcUNHb#?qK_a&vC%=3n3>?n3bH{G2#jk0xh4pw`GHV9N8jUQR%dZ*DG>Oc@m5=J}5XgVY#fFI4?wQYIxL(LCIeS^% zpc363!Bt>qQ+n82qOZj^0ElpNz;TkODXuG2chdfor^A`=yjnFQ)_lJ;ACuy503b5o zpB*MMVm>>N$I_G@=dir_OWrdcCpCcK zn5SSmFn*7Dgp?&jhWnv0=pR!9O6|>och3(H{yQ75k;A8+OYt=9`7{4~HyV?vDbG%G z#b<3}C*-2!7hHqP@~t;W014j8iMQs&a33W-C-R3qXu-U5ClP1o53{`BMOK;QCYWzS zu~u)q?_`&dBx9tGAlOP3U>&Sc?3YNgN&E;^Ru$|-R-8oJ_5`DA;w8q7X(hv_WKGvX z`auO7hF?^9=NT2q&c|sC5nqWh@HB1W%F@`wPobxRrV@QZErO>DN38HRJcv7ijCX?3 zCQs2tmDATCNzU829XFQ%ym&xgjx^Bntc+VK>>UC9o6@3<)7_mVX*bm(0E<-JDOnxoqfHE0n^-ovsI2A=Zn9tELuN+>5)M!_+zDOC!+|$&(BgN{m%}=S#&tbB5bCA1 z$UN&t+hQwyt<6|QtbohS#TT}-m~X9*$CpRxG)v)Wrii-DRza!vWi8 z$q@A!WRVyttp3cR-FF>{iCDs0kuO!^FZ9LIcg+o8k9w4RRF#|F7v+SnLR0CvKbzBo zX#=ZPtLDONG}Mas=|tJPRLyAR8yfAkr1V};V~yy(w$AH=c?`dN$PiW^iq(38%x&Kb z2{$*W9|O+O{sLw2>bn*xw*uEM!Tz$T&0R=P>us@ z&L(qVCSHC74L7KnKMYAj1Q@CH<2C(GUq`WK+_X;9M>2?VmZlqIVCGfdkTV#RV`i27 zuE;XSsvkM#X#99tF@(3w;k*lv@M0}?g>U8+u#km0NF1e`5Ne+Y_!E4I*)8vtsCR%)?wf8=Z+HQ$`xfkHTf zl|VE_ii~qB&0{+iKZRJun?A{aZ~B;{+l{EMA9hSfAM-HeoFWK}D;Q)MYs@DkO}N;v z#U7c@UNMd?nvK9{^9q7zrl<6LjWng+p924i1TSQ-#_fLQcxdYgGtJAPOGwY=^sl-C zx$+|i$PTv|7LWm*{YsYe{pJt5#dJ-D(jpAJrzjY^6fOsxh!`vPB*#9mWVh(@c1hsl z6bOPsT7M(>#}B-^13S{VtA8Ek0M0MLbm_A13i#X}UHUelb=?V72RlXR#*HqW%R7mXItiw5s4R@OGc&tG;Usue1H@MUmD)?&MIU}zks4KH}H?Nl39`_D~*yO zk#>P?Lk#wPhLT#5JU|YxevOBj-JgVv=gB!k&;sBFsHieKo+8>h#pet>d(88oSA*va zW-p%sHtfTZPL_}Xnl-m#tHdkiX(C7i zi^+q)@J<5PPc=JU)03!!G1r$b!TZcrI~`{W`J3==n9r0<56^L;FCC z1Y`AkA8f@A9B;!0@MD5~DxSB$i3@5<>Qi992+g|I1G#wHW+2xxZ&xEbBCc*JiG^zfX(^;AYkM6iB^F$k%0 zpK7l$vCK`(yGakk%QIQ^{R+?~*v~jnaMsH?=-V8#J&h-SzG3MFCHn8S;Wm69I$&O3 z+PL-33roqdXHzK-=uORLW^{Mv6rj9cGY-?xgE>*8FM_RefA%hzIe<92%{%N>0syZA0lgtDH1STM(K@moY8XIg=!J0U<&LuN20}}}X z3a+szV%-pCSc+(H*e185ShZ@a)z&U_RcjT{wk9A+AOZn5ma4c^PaM&p7J^pi|9#HA zGnufx_49k*KOZu4=iYPA@|@>9=h;unxz6A;x>RGpyZ+WcNoO;9wl4Tr8l`i4Xg$>W zN~6SefA-34E!sIobcY1D!Ye^CWT439aUJezZ3PIkqcLN$y9ob- zYl6%t-`YFRri&K8t0T+8=Drbo%>~ZJ6zRooDTt+JV_ zNm&&;WK}?QMBO1CR%`3z*>~kx+@V7>toP!BTiBg7wid@ecEmnro5DDXSNLaEbz43- zdUYSkGrKx=b{sq|FECK6XJF{8QoDX78{{ZK%FMhhHDxor41`N>M?m^&^v8vq!tyMRglUf7sfhMoC{{2q@`}q)O+RB z$Y{$)p!Eql35D^=8(JgRV}Dht1AQ%n%=<;I>;vE9Sr;QMN=jYR8jC22mI}s7@B*J5 zYF1Xww@`CCrb0Qe@ik2^yL@9UV2J%nEMZFS7=&ZBS`>MDy5S_CE;xN+K{!!^)apxxhQW>-MgF+q3@!!V|9j}Bw#9$6A^ z!eTx z#J&c)_Z1`mqKe@3SA`M|5_;T41_{^_Iv9*?h7NWS>v(2BC(HKX(Z&2Fc$0JuX{we6 zx(^9gF_C&Rv7Nv^tv>|1wc_T@9QQ$bZhXht_=Pj+h_zxbTf2wJWGAWYc`FNZt2&bz z5i#px=#{W5iwc4d;P|sn7?ukyhUG$wVUbvsyx3bfTn%h#&ZCx`_$AI%&yHAONshU! zf!`3m-bXmn05mZW_Hxaz1t4&Ws=_&q}#V z#Lt_t2=IM&9uggEFSant*Ba4-EQ8OD=ViSLPkE_f78%1{Lt$bR8^fB} zhu9npPpHyY5IH-|izTL%ixUy<4XEabRh+Vi{?L9o`L8ggiJKOBVZS+xp~`(E_#esr z*g{{9<=s^&5lMiE19y3s9V5EOACD?^kT8Y+cW_-oUO^niCRL!^DK>=Z&Es6GS!Q6* zh!$hm))9>%a}z%Q5JCTl(Zzvb&GO~v4iOGGe+3lp4d(Z|{Kgu}5lVEE^REhJY!>?j zcx$vq2T$D0zJCZFbP`n*W{@HK5ZUPyod!&zVdj=?ax}8*4GB#TAs84QEu)WWAu`A? z7Zkz(IUS!TPqrwCo^~d?l(q>%*r>LN(ysGxC>5lP|0AT@+D8TsQi%|DXf#jf%}R3F*Hwcpec;-*d|;V)|lu)0o{ zEqw4U7>C$zS5XEOZdD_9^V_@t`t+LmkOPB~0n-85J5io>?Cf5)fU?48q~E@v+;|ej z=ki}kU1>ejYif|LI<3r051{?0dxi1Pv_acoWCQfbZb92SwSTG^njA3OjF%ARKKGlK z*7(cb2n^fd_fEROmH2>4i6g7!*UVdo_{%2E3{J1Y3)SDyIsbTrpt5SnYOrie^gyy_ zX!^Qp)7cO*i$>t2j*qtZFZn{#TgA~}INCqGRpVZ$@00wS72mut!^Oxr`%f=x$P32Z9p8W&fx+3amqc)Dj`n;5b&TH+gHzfg-!@EXMXfs zx>#R|u?~ZHej=?xA*(znfA1%hMg4RjP{lY+b8k9{)2wewAECl#o24+flEED!OUV2u zo_$mxo_O#94R|u7+$?j8>;|V0XD2@aRt$ba)Jn?)?}OgX!}LW}oEZ*&4gA zztZ?<`8KrQ{)JSLg(KMMEWJfqLv2(JaoyR(yCL%?)YKtSQ*V$g>Cxl5tEt<6Aq|M8 z`UWKHrC6i%$ftiwqIG_!qUBP)NjUef3{g^tP*PWGCG{s-Nj>i{CAEoV;maRuk<1%3 zZ!8L$o7KU4az&+N=}E}V>65VWe@et3stjb*&FY>z7_HKy-K?IG6=i-b`pKnppdbQg zdzNFiiX&(quvOi6YJUCpEtX9<&0E>$Hw7yeKEmK;VB)^JdC2<7St8HAV{fQBtlV-M~gt%5_PvUz@^AmI!M zM=QFXqbqtOSAwPC5uZ{NId!~pWNpv&Qq(-6w&(aGXnTlmVMUc@ltTpi3At>1Ssasl z`pt`-fwDF~LQ*&}q0lgU8D*P{vKF{_N23wX^~ZZwB}juf7TG;jJ^gJw=>to*-&P$q z-;kUS^F!0yx&#hpTeL%kU!`wZ0!k@-WQZ(_q8zG1IfU-9xjJ!aQMLC!w?2=@Y@tv# zR9iCed8KAgBR9A1_TrpKzS;B4v4cf>gmQOmfu$Vs$1iq$`b5E2a?i;O@h#u&STInlvB?1a?TlhUUPBIXJkj2)y8rS9hw>sHf>g?d9ow zbP{*GGk~(CSmf&#_2kc`0NSMzv`b|5hzvHz&$2DUjf;ke33U)_X{MBkI#KfUwY5<8 z0a&bN@~oowFj2&qjb#%HQ!U62_&=an_>drTGvxGcbH(qc`-WM-p_-s{!icvYX*rgnlyW+HiTkL1zvUQ_Sm&fozHaw21BjcRKFl| zkG&mbEVT&JK{|&{Sh}bGrTxP?$6FpLOs6=+J-h^`l%iVM54A0!Ks|+Tv-~g}sM%}% zrq8J+CsQdjedxdYbfjd8n7dC`W~$cp%UmAF|EXQO_`8gjs-M1++7P5UV?*kVHO#kx zX7xv_iLv1hK~|0$X=4cg;Ke_`dwPmFd__9~~PM~nAo1!g*R z2p@p?(%hMt=R_Zb%5NwqpsC;AsM~a!P08Nr#uhqhFS#q$o*N0s$C>ic6ZKu>TggH4 zQdGYb;RVf+#d%>)!PyPTvtm`wRJ3PvRe^xlw>tOJmA?As}>zbOX!4%B-WzT<11&`^epvmqkp|-D zxIQ0Jzeno7P`}gyIba3T2FA$IwYr%WahBGr#hzcElt0xfFN1(NlTOi10lM!}fPSyM zqXE+UWDTLmUQa{l$vs&R()exL%XgvaQ;&U2aap&okxl~wIaOzhP3yy{`8;aw0%-U3 zfvI163^%4N$<%p>zpqA+Zq58 z1kMl=p&e^4T3q=$5fRZIDfbzjdg03Ep6&-qABoO0%I6^ZkH<;60U5PaT?d~HpHmw2 zR+Z0w&%P_;(1DSe-dQqR+9yEHN-a=ZzAvw~s#8(V>3~PQDF_JKZ$CZTH9^;6uY*JU zz(@wtSfrNdnuZ2rU*yg`Cuo+@LFg79S?h&aBjdpNj0fHg%A_BlVI}$IH)N26)h*o{ z1p`0};D8Mmi~%NE4NIYXT}bmG@9G?L*3OmTG<0{{P~c?YNFx9KQ$P=$<5mpMM+ET; z`|&g0-%RE=&F}~y*0xHA5IECBE3=sc0hzZof(iHx8Y5E;!dDg~YQCpp@|MkrWx>0B zD`m5O9|?YvPE*I9;Y5?JdvvMPof|zx+*N$_ohwF9v=QX{AhiYy=h=Ql@1@H>pb_!8 z#4Uqmwpon^S*`x-)uk7ch16N_5#{nGO>hq)nF=?%QP0wYRLU$-7m)~C75S*_x~v*3 z7_jG+Kda$DkS^v14x0cKVV(2Uf=yYF5O{_0bD+GBWU-h(MY%K47wJzZbo68O1bnKF znkZclcYZ*_mtCX4Zw8Bu*ulIA%6eY`-n)`o9<5KXNVt6hc(&ua9XmA#dzGHp?ULiA zH!fId(7c4VtzB^z__fX=%ci424{q#C!`-N`;BM3{D9?!;C#D6^HB>6V&sS%!XJ||J z3;yCHx}s_n8Ukt9B@N4l%bZ+7!wkhfC=fc6&0b~J@lF|mQ$}EDhb4TA8{yu86z(bH z_=$r5VuB!hR4?%xW|EgeWMT30;M+imMI;E z(I^hjdEzVDqOT;9^;1%C%+e4Gmje zl3-Xt11wQ_)Wq};s5d53p&cbtlzdO4gO>jU&*lAkW0XZ@y-=Z4{KUB8zJd4XBWQ zYTIeLpAd+MPGF;%4b#f}5T&aO2 zT}qx!0#`cKkAm7NDybHvQ+Lx8;x;=uy^^Qa?Eld2!A3!8J?M%lGHB@zv~HHwr=aMx zK^gY*^oxePh$4~Nr7D)*x44sh&c+<;>kxV&l7${bf^*;!!4~zfoS?-|x5$#&it{aq!Q#UY9oN7wg~`|zjFZ?~WWPE+SvqZdRt#fzfci2i zbcOj#+yJ`7A6_Zf@u#&OKmPYe`4x`;dX?NX^PiIw?M7@MH``1C1V-#e;!ouF6VK*& zfSz7n#2;BQWjNIpYV(B*Cov~CwESGsPUO0ly+SRx3Xwyokx5|UqWfXb9c0-eeQQhb zB;2A~B2$Bl59Xlmokzwq!v)sP>m6K!(N_Msh*0fNPqScxWqX2TlYnsUb}jjgdYc_D zz6dG~Ou1jh71+**-LE-E*iF(A7HLmGDcme0BK|2(Z)4XK=a8+}1i0if5EN;`aL(Ic z$ju*V`1T>`5PK@ZfZ$Ozz1}D=FZ?1!An9k-OW%z)ki*0zW2_9hH#5j&olIhwFE}xy zQ{%mj5JRXi)|`sIUyaN#fUty)E@t>d-RJ6=!4aF)T-k?BYaUE%9!zTWX?Xz@_VqrlWY`7E2J$WjG%w{oz6 zVAtc%PTv55`GSN#TKj z&$ncMbch+~DWvy!9Rs0_Z`JxnzS_2)D3u1Cx0kNqVUDe0A>MB9SSJJ8^daL9W!s!) z8Nxk(fT)e_G}`m*hW2&59s4R3EmT9{aGuC*f07$(eSD~oG$58($@?IRF6nTKdQ5wD zbb|j3{7S4K7a=Z&agzV$1U=~_5>W@pMa@));zR0ghconu8Ap6b+`s<}E%6rRcuru9 zwE@3LTpVHlpga?V89x)Y=BSRTT$&>+8~{c0`z`s;&qCE<>55_A?qHWax%z5mMo?}emyX2Cz#a$3=H#N zpuP=x1BkIu$#Nv3BX}k`x`JHWc_O@TMu&;f;CH|<6@>%qrAyyR2~5xd*sgZ+b`cc^ zdC_O=HFCz@?c51Dn)O+0yo|m4OA;f;2&r@3*GQ+ZX{|TvSzp!nt8utItPGs}ZUE!2 z5Sw62H;W`)3rVV5G%qJ| z8T74P6Q%(o)J!N)UNTVI^vN1sFt+I0oJet?{{7@}f5}xRrJtW`KTcGCtiFE%`8pgQ z(~bAT-lXe}S->HAbIScg>JGS`fzPE5t9-x}ct4cdK(RUWsrnJpT5JwFsvi%U(ffmF z%!7`7p|aPZfX`Pu4v?wyd3(1_jOm1yO2<>~VN^?7kA%wJj1rDa2i{`5fhF&{mfpd% z0h!ez5_z{q=F-G!eaenrKBTK4UFcQt1jD3|VQxh<4Z=QerEt{GVb!aHvFTU@S1g>E zJde4Elv|aRN|cKDrBXtabewm>I)G$VAPi~CH!EavICs(W>N^bpkjiD-mOY6~Sgk48 zud=}7{M`@5JP>_EHWZoIiA=1PpC2mGUSf-1(0G@X0+3=`)ki|!`7<+ zknG%=bqHKq=`GA*ynAlVRU+mm@=q4QJFQ&IC~v8oXSqD%_3q~nrJL3K_95*R9izPp ztG!>#kdD$`oM&IFy+@JOjyAp)5#AZ!G1|-hy6u%8qrItCd-oL`eS8ae_O-^>fTVP^ z@u`h^d|w`;y|=z@do{;sZ@$&ujjp4QZz9jW*7)`yHyv$!1y+0RW3+b=SIe)}-mGJ^ z_dtt==ikMB^CW&N136wc6WEk)yTur1koLzy4MtY8?%pYebWl$ba}4<6Hc7 z$LBdld!jL>y}&WrJM-(d_XJ|r(Z;t!w0nvC%f-$0DD!9V>}%nR?-=dPwAwrQ813bL z-S*lL^Nu#Y&JB8e_lXPaQO38xvT^?R_)>d}_EuQ!xkc7JN_z*b*Z=$WI*^KvHoju3 zy}kKIAKx~feXaScJ4Sn}M6gWcN5y^hDC3*Pv#-@&(J|Vqu-f}KMUK|qPV4pm9-faP zNgfTJEh1Sa^7|GXeSG_R9%FpGTiNT7=kbZf852TA&vgh7P?*&xLqeFlvmM{Iy7dO# ziZ4Wqie?4bL5!e>*gt818-=>TKfC?3o_D934L?ii$FfIyh%yhRk_ ze%EBzdI*0MI<$Wo;0XUD^4-N~eLVE-fR>032JQ0|3sgC^TiHWAnkU}M`C+sNAONTM zcpsJkg>V2e@{-#u|5T=hnnr9i;v|5Jk1L+R1wqu~2t~cn!*?lvBx4&_VVJ&wMtro7 z=V5-=@HaIOALlplc}f&EV4kROJu|rlhj?F6e`+!8Z zIZeY1>CrLp{f>JMl{GtwtkdmR&cz> zaNXOeT8e=sa>RF2ZnwC5Vj<_GF110c_pmh*OI0mJ#O}!Tfxw(537Yw4sp!jaRKoRFB85UE?IsW@EC)A<;LZ_eV!sxH?F5f& z>7Cs2n`7zvZu4TF?)D&$bbEL7HvE9K-zMEgEsQv#jz{YtU|St5m=Tvy%>r{QaOI3D zD#ME&RXv6Ub6|mMwZEW93)6C@yGKWfFvc08K~^tlJs~e3_|_1PreEgz-u?gpjn`}H z)B$pLs}k>LQE~d@6rycUSitC}rOnKZ&$4=m8R(nR3w1mKFoJWmN&~ZUL6M}>2+?P( zaMr19zAM{LtEYj4du|VKS&RPVCut$+Mgo?t8^@vIKnfAHfShX-w42uC55nSrVK=gD+TM*+|5Vt>kvg|Y^J2RTos*!-!K#WFKm zN=t~$*a|Tmq>ZWVXLH|L=h`>cTI}SHp*@sY>e9c;u>pzvKiE53>@f*Xr^&}em_#?K zt~-~X@mP`87m()aZrtG!SFOyWs?VPV>TQBgLD72;i+QY-<132Q64zEsM%CI<{)Xo? z`^u$C)IOZNbWf+WB8jpVH`Z`l&E>;a|C$(?hUIHbm!`P3<7k1}D|6kPfVZhVdWPh_jN^FMt%o&RZYCjZk3$ISh-{eLI-Q`;Yo zkozftPSDEz6y>p?{WhGj{;i3dO?#W!WVW+IU<@y1`!cGOXYEi!*Z&AipRZ*RuU28|^!a;L^N0XRP zg=G)IUNiJnJhSWbKfENJn(idC?{0qVZ_JAnS*ddL2@z^8PE~1(ebr>kVt-uFG=(N$ zxr}W}rQEYo@^_IP*)KCVt46PpJ*e-^zdlU=Wg3&kBET_MR`*w^}ANw-660s_odwXnUnak zI(~BE@--><8+wj9Q|@2uiybNVi(EAOOUfZ7gdaa6Glb!^G>3Eye0!*-McYmBo?J{( z`ge|``A)dSFAdw2`t&j26<-FQ0#ncs87s(Liyj?g0x5Gy&ZKqe>r?J=yzW}9c?I9% zO=MiGLvw#Yn>r7DKJ^{)Qmt~In} z;hMFTTEG_=YTGCdai_k)l+Mb(J?|$lHa!X+s%sFq{ z>|)dXC_m+_xxUuYso$o)*Oor8v}&@XOM#&4HIs7trB4|?W4&Hd^M)ipw5I$gcwPgO z=j}0i)SsTAbJnvDtY=l3XLrl9^gjy@IxanHp?^oZ+t*3|bY3i$`DYhpmU%1rC#|!P z@7hYU0-*L^eB1V-68kVH8mrwQ`(CW}pE>)D8Yck+zCAbqBx-i3U5~P*<9%U>CAvHF zsp0#AL_5{QYWG+byvwk6rt46;jy-C|uc%|b)FH73Hw(4NGw;{Q`>`Xx-$fH-6RF8Cy{;v|fCdSB+hq9_oT@Rf zL!fj5P=bGldWl`QBIWL3J!}8hR7+AOpU}X)FGe zz*;&+YCP?dvydWKkN&jD-Z4QAvN12R#2@wASVX4P;yA;=d^6%>m@^6o<6{s;4|lj0$Ite8>UaUI~gek;6xP1f2i( z!9#K0@hm$egNHxx`9NLm_5X9RpmqC~?yvSQJP#hGPTr!IIE;18;SAnO&mq2xJd^c{ z@GAATe^$#Y3HP9b7GOPUVW9@zn%`N#GG`GKhv1njXyGt$RWRLEI;z@IaQdEwK6h&P>_Xs#(Z|j+lN6R^3{1O>3SE*jeVIL zjSBXC<7Tk$`t)2p`tV_M!9*7%VNV1DZ|UrYf%q(CFmQ`@NEF|?!L799?UaxVA`~sR z`>jk7+;Ofv(pxlMgHvTO)(U(<+W5p-VTp`mLO9Z?h2q695Zf@V!B0pG7!290V$H?J zY7434V6(44ke@Yb8WpU{r4rS~j1^$mh2{#`^`zW)QG-22HNe_2B@^}{C=@Gs|dmxJ*R@_3N`0D9j@)q@%^YlTUqV*InY56QZ$&E2VNSi2yZ9Yb}Q;BPP_?08+ONEJ`JWFz0aF4z+9ftG zjZ1n}TDp;YGrEyF844@mn?IvL4d%3VTkwz7tn=67&^je^#uYho7Jpbr#hh}8tfhA2 z2SzSb`OUgj$X1ePVzN2qQKD}j#fv6r40{DUB-zY-!|Y)Ud!Y|H z?M7q7@y4*1`HW9_RKo6q@hPhe^CD+_%CGoIFQz;JLzHrhO>YS_gmuE2CdGwF0sT>n@E%n=XivA=b+ZbPnK5=WmuO`p66#XjwUM^y_x#DF$McvMN zZ~P!X_SR6-xsn5JU9p2aNSCS^481FBlQE*`Eha`cv5UuH^EMwa44IEe#eex*Ls^RAR396%ZnO(aqK5mI|2{;F5k3xwfhmun7#?40t5B zj=xV!e9DIct`QssQr&6YZZJml0H|x?0Tmebq8V6Y4BHT&@;9T8lxg9iv6if6v?(xu zf!|PpcwmjH!(Z9%s!aSZ08LhJd4pHBsyF@sjSR`v%Uqd(HkxW9V4FsaVbJWJT6 z7rtpkwfXmi(V>&{?hg*zC&*YXY48lXv=S~rV5-z2!CVMji+Z?HE_XuJK65;*|Rx>@HTe;b3A8v$I7_ zeAccE#y~QbLETbrCvh(;n*$y|kn?OWJ%kqZ2yv`16E1bpR0O8Z9(dud&P_T9Bg28N zT={q`QDJ?_zr0pnR6kiJbG1eN2}y6{t=Khf zqAJlz8tNXC4gE_55! zNK9#ywl3>0_gZOsaBNXqZe*-HP(P+JdHMsZC&|-QEmt@y!v?jgHt?Z7CR596edLbt zjtrf_x|UQk7s*0lRKRfcK%qEM?niC=kEMF-=@izb>BFV2xbpJ$3uV`)XSe-EdRDE} zId95^`_5kqSH$nXqv)}CzicunY$!SPM@YpMK=7icKdCzON1S&fwNb!-k`!oF9{oF8 zA-nx)Ss;2%WMqEuf32)#UfCI`4JH;)<5uu?qk>Np_+a6VibKttkH+Q z)+5QJI0p>oLw0nb8iFqhHk{SD5&a@v1fiDfrCe;$9=zFKm!UwAR4?773xYV}eiLrR zB2t~|6V{*RCYI@f99{1ltdYva`{?&x!(?r&a3#+Vns;hs)am>r*=(av`arYNv7Wr0 za&N#Q2C`I0)4UpSOC4yvjTPdazDI34P6RoS}hHg(+L-KBu|h!8QEmi9?&@|!#mtq0gs>$xFbM9JiOD@Yb1mUXY8zhp`hiDfIKufY%Z3KD@24Q__R*q`QmaT%yHPT zdKnoR#YE;>D7NNT-)Bk5wW%q#Sto3nUCOp@bfQx0M8NW3z(gLY9w}Pv!N~ML3G!slsRvvu(IIhQiLvrCSwBibVU>pN% zH+OM}2z&d;2juv&Nnyea6Sw6C8W51Em zDe__T^uqy`h_pt1MLyiZpD*1i=fPDM9C)qclu-`~sB7fFG?BwCiTqZr1Z4YLf9(EY zqKEZ3pksb@9~}q02cj29C+VGZva5%Y?mZmUt%n4RYa#CVOb_M!lj?$wUjI}7^knd% z?LT>z{m0td>egyn&h$hl+cRFbMtG&1h(ESg?-_GXOw&7=?O0>2xl&L@xG=yo4E@5x-(ZPU#Zmg3#rX~%3?Y`4x7`1sC49) z{0p1UiA*5wFUM)w9Kl-j6hC6)L@2j{bfFyn<>PCs&ErWQ7BWYpBDq1H6IE7*??Pe< zxtX@8Yoa>Uw%Yqg;jDWmrsR?9pW4vwe2>yeQvdWcbb@(gdg~Dl4bu&6QC~bF1e(?} z!aLB?962mi`|CVSPo4hObLPWhr#HNv*zL;Yynx}NHoaW^Sy!exa%)lgIR9&nj7V4- zRC5Umu<$BTb@5WP48m@KVIz5r&6vJMp$A)_gMsypXuis0h`IvXBsk+0I-PK*ewtPy zBpzbnvjxW|`c^EKX~74JSZWDos$a!VF}Os(BN?wda*fjUlF2Xqi0;|XVT+B@wX)}h z%<8GP6~8dorBI~K`*|w$tVsBRrS~D2 z1aYFuqRS`p{7_zV6XIT)*Hrg0n%HAvl*ws|3GA}ty+ywz3a&zit!Kxw%ep^%m+op> zFysJg#)SLQd((4~ixRq_K%&J;2<6~=@ zHLl4=7jGbpPz|-gK&mkh3({heoa3?Z41~TAGhlsR58;q$8($IEwkdy0#>V%Dr{q;l z_I(7NFkFI-6XQE{fQy>K?<8c%LSfM{GKI)ndXKM?jKZ)P{t`^ydb6iAU^hxr?w6m| z8$L)yvOlTMT5)Ox69R|4njNZD-9=oWFvze`W`}-NHZB;dpYXQ50yBo4^q#|hb3Oab z9Gw%>r!y!U^)NbUU3R*3f=_dCEgb=PatMouX~|!;TYRkLt}s{g0p zLE#7vSy&IB>8pQAqy@-y{_=&j$ysC&^)}C&B%6jM0*f$di@}mUx}i^-q=_CeQRHBq z$CyjGqnRxOVHkG7GzRlkBIu@9j(TO0G!Yq4ZT6Ie$7r5};k z`IobDtY&n1l9?NCIJ1S=#<2N;o&_{^kvU~sT}#$bQQ6kW0Pj}UQg)b}=fUWl_FwYx zzdW9N#*?hpQ*?dT6fOLVEbGv@4y|wTn0?RVQuo0}%1OL*HYX;aEEAPWn`r!ivCLBu z+CYh}l=&xo(cXtcrkLW6v=0N?S=CHfx6L?(9gWSHol>@hSM*lgPjAHrTk%`+lvjp# zZN2|V`gd2-iUw7eGC)geN&`vd_Xu5bOe@)Ob*7I zldU4l4&~J}Qs|?lpY4+O0RRzww{)nnzmZ9LHF#iG^+^rkVe2vIxt6pt7#Lmnz=aUH z@fE49{%kVZhwjw7cb?PDv!jWh+Oq=#0I)Wwg?DJKnoONJsz9ggpHyz+ zc=eveZ*jXra*KoFE%E9-BgS#r!Y9|7=@<=e2NYSvNg_@<6L?}&Kqxyc`xJEb)+Yp_ zS+V|byH{SmJ~1{IA~kPt@*OQV&DhAyC){`aSc}hl)NS{Q_$-3f->fI@^pmUQN!PxT zv8%ATc+ABfW_rY463dte49oCynPwmT619AxecVc7Hyt+w6XZvCsDP&zje?PZ-=7 z&O0{WuwV7NPg96)u1qJ=iTb|k>@L1x2iMsyfCv>iY7Q#Q4BzmC<{OS<$=ZCw$ymzT z&(Q$0S%)cmV%O|BgmFMeZ}AP5Ld_^oxgWxaA$p4av|;HfmU1Nk`99_uS)a`3a_BC% zkUUga?uyOBlwyM6KkcJ|m=C@r&k3eE7nYIsND|#d71>oZyCPg-%6%qHQW(IWCoPH# z64jjV0D;`nAULURTrVvy!aF7X#5ve4K_sqDD(6G#E%KZeE zK3c^*O?z|lq!*pZhkegz-e}G}!W->BoHzO*Z)NdDq{`7LKhRo;qe$uEw^KR^#Z?6` zlp=~Z#`_c4;3UAIz?S*C{9AmnQ>g2pBX)p%2A$Q$Y8}2C~|S#8f`|3ULcl) zH-9WsaHpsUIE-Vy&Kv>TGa7F5-9KP69`Cmpdr~eV@ySPAc%&`OMC`z*a41sz$|Cik zuEkQn2vamQ%@mn=r%B&kOC-nui72vAK5l~ML>y-~5JtkOWoyz$sQJxtB)0a`RFUf$ ze_>JZSvGn|25SkKgd9$;$Jar7oN|=fIFAIPH*k&`LLclCv7AQ^8M}($EOm{Gqp1u=hO|HDiS_VNRk+$OlqK(a6Fzv@51p1 z2l5radoZ7$1YO_Y!Gj*ISqog1a^;UdSk70|;*oq3CbYPSZ_*|&7OxDZ5FbU$nCm)o zmI|92U1!eUVQ%uf&h)j!-a4P};2P2o^IfxwkEsvPei^4iyp>Pa*M%G#rT1L6@V)U9 z*A*?569-}si%;Zyu>Rrr#De(5f&3~q%pI|J&JQ-elOJ;I^jB65f?@S5fY#0cpu_UBU4nQXoZv zhU9TP@=BowdEOw;J3nz<*6DYZzV?aVbw!(eY~$lH_hql<=BQRIXFS{CDsBEG;JRWb zPm20p!V|+anOXT()7(>q690-~QkPUXb-lXzN7(X9I~eBy%I*8aHSL@syyGfuQWxk) zBqef{-da*i)##DX_+_-=)uWrnYPDbe)NvU6s?O%BQ;6 z!Xm2fj1~Y68DoFoTqQ6VAwZ`S9qJ7;m&uf&Uh$Qylv)^%bigBcNdsVWskvBi#BXl* zwnZk!7Z>vb1T)vg@0R>XsT>9=M$Yhmx{*y zhrbW``^+C7=M2Wyf!z2AH|hM?u^$%Y&pVw@$803gO=<_KKG)>@zrUQD!^Gs@$2XZi zl0CBXjG=Ru^}rxOVZ&Uh=!s$0{Z%?-K7feEuN6=5^g~@n zFAMDXRoe_RE^sjbhT&z#Mzi!AX1p@2-Gr z>`R7sJ1=Ypt7ZQ=NtpntdRru09u3J(HQ&OF$X~= zrh#NOwAVrz&8IAog>qS}{&>0BoLU#xO>0{9lyqFkQ;XTCsT2#R@9Wz&>bB6id41wf z30k%fkh)%ty$wpfogZ|(R5@D{li8rm+2Q!?g7|D`#B2_vj!AK(R!Ef4qM)PIUug`C z9OsYULfLPJqgg-GHpWL6Ljv=-Gp>M(aiIJyMOeVR z+aj0BvXA1aC9K&U8WMV_+&1r#R#gkKjx~JNCAGzblFG0;T%}v6vW4s6+pvCoSLITa zJ56$@Es3XCt2$9v9Vx4ijnqTfV%{ULqqX}Q`M9^iv2BHZB!y3-Fy?(U|6)6a*{UR!Wzl29V#yWo(J;!vV+{gcd=5Z;Z2UB!7NSk;fB|`MK_5FQ|iXDFV86+&WUn{$f>TW-6=H9b@mnAD(x#o}4;3=QnlQ zcex?3%$IL51*A^-8zLkn_{MnLgszWNP12RssEByT#Iy&Q183_n8B zCM@~&H_@v&F`59TpE%}pVZFrxFU2E*H!is?jg=jDbV0zf`LQ94AYl=L-%ipfpuaLa zraMG`)DsZ9?644uNou3qbTNt|W#P?^TO<-5f5i+>20|U2OAU;KY-Rp6%g6yjW3#~s z4l(9XN(+SYkg-do+t+O`E~$ojf0X@xW*$8Hcy1C^U*$n7ZKY{%HpHI943zT8*Kqkd zkbhZw*F-o^Wg_MY5cEWxyiz7&Ea~Co*d~{V=F3n=2+Yg7f@3qI&BBAP(f&VGSNls& zq5T7*ch~Jdd{?*j)mZ@Xu*R)9WiBmW*C!Fhn6zNLTa56Vb)Zcm|1%~e+t>Bz@HQ&Q zRPaAeb9ZpsPPpTD-~=JOyk;Y9ri9z|Wm{RSEe2e%G)Q9>M?2uz!O@ zPA>sBKo@m#|09iC!2bWx{xwnd`ieQmT>ul36m7WyUcf0p%r1_nNzSXl+n7S^$< z2zx@K$}{#ix$ zc~59a-vc+`@lDJ;Sr&`~9gh5=+>Z99T&b+-WFg9XkNlF^rS4U^qGJ-f;zvK#=_Zq1 zG^%~~E!`~InZA2K7?P9gG?C;f*QxHtd7=Y?CaMwJO!x7F=*UWfu^)0|(#g8tFg>G7 zQVkI4zR${{mXi+KZv@4~O9tav#yiII1Ht=rt`V&xIk-(dnY*MhijJmen_AKs@tK#P zf+>ovFNnSKIloK!0RSn&A-S|EacXvFJSq40=?vO5&VzMw5O<&TxW9L`m!W~of8|fI z<{y-9_XDRi$;kA{$NI%@iLz!V`?-LWKXFp26rD8J<;i{|{yWWr?7*h4QrcYj!9NL|qs;Wp9>(%zEFo=%<$@s!i%~cgL zqc*+imexGo{p|HeY)O?9KXaEs$KX1hXtp;Xoth3|3*JeP(4B0|-57XOxuZ7^* ze+3gu#Vs&l^V}q0LC^A<`lrxey>QgGA`3Bj~R_9#z| zH8OU~^q9I2=w~ma2Xu-xpdTzq52ykcUqLiY^J0xoGZ*aYBiIFIT`v?lrVqkO(_kyc z4z{ST+Mwxmt9lqszaWd{yCJ+^*;&|uWR|@xCpDb*C}cFAKjAH!wCZBLF8*=WdTqay z8Zy|P<;Rh754wl7I?0KQ=@t~vy|o|elej}pW76DArroU9^;k4OC%Rosj}>W5kKN&Y5y#ohU)-3_aidqdkTCVl7}Ys7~5hg9o43 zsSRIj&lj=IKH}~jDo@nx*KbS|3^6qI6bl3j2YZ(ev3_*FGII)TU%+T2)3!LV#K$8( z94AVQv*e(U(YX?WVR&3i7lVdJtaAU|kl7iozTB+(vBcqCvzDdY_S)*4w)-QvT^mBZacA?}2~j<;)&5Vk7B}f8MAz z5L=R{!tYCdU$EZXK`ap`mp4V*1o426?64@6d_p+VN9bwWfEZ9EfdL>qkpE{Y}oFA z$y-!Jx@zu_qa9?i%gwFoCE&&OezyH{r7U{Q)DG4gzR=E+R3qo~Ff*Z4|S5ZIds}m#1lmd?$M+Y6>(L5a|t5u*wnnm<^`OD1C@uf7(B> z24|nraN@g*u0ZmHOCc7S%?H*xK8@A6I|`v}()>=jYe@spkY_MEYlPXUjxTIU@B4e# z$iB~en%RNDw&JXx~+>i$D( z4OZS%968B4$!JUoCmCrVC2CF==4#rNOcQ;sPac`08ie^U9i`;4vj5LX$A%p4Z^ph1 z9ATVpwGOSF#AFI!^9Xq|^~7qPSo2D_6u{4}t!MS7dE|ALI**-13qdXFXYGP8nLIFh zy@;f5<>`}hiTv9^6Zo$YsrZ6|_<}-FrxgM8_=3{-g5fv_m8)MTB^ETka4LVb{LSQV z7Ju`D@#pGfe&WxqkT;$~pC&&ZkgtUKC|~NyZxZT8Zn4HQWFA}9LE+is&k5Zi```5h zqp+-IaYA_lhV8&x!Ni1A(B*3sY##@D@Nm8ifTd&S>dVGIIF^cMrL*nZFBc+aucvI8 z(Ie=U$p0xwE`!`#dEMZ-^oTqo{&RIX>8CD#*Jx|;pyb~IIc6@&ypYS{~Y)4TY7rS($ zVQy1ZqtHl=pmM3RG+=JD>pWtG*u6us_S`7R9CmkK15gBb4%}OCVwL<3R)k{ypZbUu zt|8+0yH*$Rw{?c${d`VI*qlmA(P;$%*XqVl;~q|dUO&UAoLUeWFau6-M!>siHtv<= z#_XRASM&O(pzuNQLoAnK?j2PuEMYAe1@5Ve7!+7#RiQqsk;`2D$@>rl$odc>>m4KW4nyfRqd7;am`a)a zbER$kyMmHt^#_-7UvsG`_gv|PWri%xHbc(Pah>k-ueDSOrE2eWEPe}@`}U%?l>0du zb?me+dSL{Ooz@{=)QT5{MI-E(bSoB;jW=w5-y^3_wTI(Zm&~lZWw2}6I~wWskJue* ze6L4U!d*Pf7rgKtMy7_m{E`Oz!*`j0ajFiih{N?}*eHY)s`zGzthkLS}vroYpZ z$}yUqohUkT0u?uO8d1(rT(2aO&iK3VTFJrkyJ!rZ(H#*pL$H`m?j?DrzR#4LAI?~(btB&l;4y^W>69;QYl;DB4L(Lnc z!jQ{HcAFM;|5V^^?g*G;2D4Inh)CF?CeP%Il@ae6=7)jG8GyDA12De~Hoo7Z+PtlH zw5!N@zN^1;C>P=Li(LJ~LyOGFP%r~C{F)$R4IX$eUH`ed{uV*L8d(#Sl6B@>EP6%$ zxF;O1#i6T~%Ubd?*AC{dgzMoXY_2W$uc$p67cV?si6Gpbbc9THi}272(?3+aa`dt1 zD4tfKR|%Le`YW#$$UCCNh(a)1fkr>!=RmK(!E3ugZ|wZZV-#1#Bnd{C_IZECl;j;{F-oYiy~ zDe-E2?^wzIMz3WBqnJB!#(7p871>P3O_ViN#U9ZR8SpG+n2Hv?nA&&0#U!~;tII5? z^6UlWmcY$~`=jaBf+|-Jp>Uzu7u)AiiM?j@gy=9CkIowbfg``H&UpvIOK`+Du|%$1 zD^?&i=_2V0%@;lc1*B$o$ z{ax>Oq(lSNs{VF?G?IT7O*iNNmQVR-@nzydc2qwmk6|jm&H%$kC7hTEzZ5o?34L(Gb=?kP5q%y|FBc4ND|K{+z51<4FZ-3~n|Rrms}DY4=Qo=V zWfItQSSeajafpn3NGf zh06WJ&f}LWD;1=VkD01opN@v?iouDoM)1Hpx@fGSAm|#cU-<}B(Pve$83p6ToJLq6 zG+{H<4A#|f4^oG}@~kHu4yXc&62AL;t_*W;!2FkM*;n)e8N6M*iVu?PMmRZt z#aVMGVg-T(%zw}Ddv6}%iv3+WoInaOt2zbI%Gm$=@VCJaFu?j(O^YLSTu>`_N(Cc5 z>OSJ|QyW~X#||-4#2T$H@_RdO{abPljr5}tiJiFEBk_ah5toibB-OcAPbk%Oat3qb zJ3Xw*9Ap^O@lLO*(NrmgQyb8i#{GSY!=xA#3>qSDa?dbd)~v4MqNzseh4|>g_&A7a zo;lX(cXS3FSd_l|%RB~nM;;TTmLrqUn>y}9E;h_p{FOHio_m1-9FdvkelKiZQ5!Zd zn#$33ArPg?ylfCLMUB;t26m%$1<~H)P3NHTOP%YYy;6A zycZ3g{g-sa4pP(gc4C`MQX3>F!B0(=0ONzQFofY>x;q&#W2^Wjl*fnTeUU_d2?e!7 zkGTrw2!*n=Ck32;xCngVMqIxa^gbe$fgR?h2nf5aGdjh)oa`dD97RrR*`+)Z@0{T! zNcbQx(v5c4l0QHU;ghXyO)WR?5&fOH4)3}rxbQn-iZA$T!&TK#851secHfv5j&fYf zM)ESxARs($Q@bIWrYRNp%{~6I$E37*k5u5eM`{DNJl;)yGeCNPg{7{lP2Oscrkfns zwgHDod=gzt_D~S5rt6svfu--d0xkafcA|AJuQErjHWC+*U1v+cd_(3c?7+ndx6C<) zaG*8SiGg<+<^aRQ2}GnB$7_|NOXl|Q%LcS5)fkGcb5eNrKLg%RBQAp;o6ftc;?C7Z zeB@nK=BU+hSM2ve2US(hE0`Nb_JWHl+#eg&k{dmhzKH(9-{L`k>bJLv)>Mv4F)$6dw?{iB_v z!C0NEzJY@P3ZA^w=3uNDu?Pm{uYo10=wnOwx|Spfv2vy%Wu9T6IwGORc(Hj ze$gDopl@f;-_kTGJ>F__tE}Iw5v%hH@MBiGa5OJPXuCb;r{Rr%o90)`(`l{9Oq9{z zA8B6!#yeyOZ4aEimqj3O`lSY0O0qHG2?CUt%78=kPmU(UI&a$1%po4hL~VjL`4>)OE)XK;FQTy{@G-TuAq}>z*>Xk=w#% z!kXC8xdA}zT|cLKd}0)O5>^{Y!_e^FF4Nj*O{?J=^Ae(@UzeP{3rFh65W5BnZJWT~ zcs;9n=;64t&3-!GEZk;IDK6K3?@P1qOi$^EluYXR0>k~0Q8v)3%~3t9X+4PqUDal@ zC>S@ZFrKPq9hoWQ?qg*D!I~Hl|DyG$Mei^^HM0a@b+)L;vF}9kCa!jbL zyslvG_w>0mw!X;$^PEaCDFp>JP8g+5g$LcL`xQ-g4ye= zwg%7s&Dg}qGvYUwn$Y?E(O#7|m$;S*XO8O973--la^=kRt?I=hDAvEt*UeWn2=`E@ zfY97Ts$n3=DV3(rhTxo`Kv1v{|J){!hQ~f02WP+5!NeGymxje)YaG|4bu z;XTb4Me+Iem;Jl!^$~kn8s9cAE`bO7hSiX?63Dc&LtRBH1l3xq@|SUGIP=Pq)L1y3 z(ssi2Ve}DRj*gD)1%zgl`O#DSzBLYuE2p ztPO%I#+C=l{-vMo@q71(*zBrmK`kN^_9ML&8d#t?Pg=HmTQ1ogOpI)aeb4Dy+E=jf zwu&6ratBv+w;4J0SNI|&OLj*Fz^X+01{~|sEhfuRjJTHU7MyZ?kUZ5Y!%6A^LQL$Y z$Pxxevt+d{^L8~nZZP4zkzX9dx}h2tSS#9$a^4**>c3LNQAye=7$u2b>P85lH>Jqq z=C7D*M2;iR8fAO#M`#6Uc~`AmBa7vsl1HV{`Yn>40xkeeNNdnB z$)k)_R+au-YXTyydmDtN1)s3YXW0C!W*1T$+S>#r@g&dM-L!KHGPwK`9hVZp9%;Y9 zhtS_ZVTlbAJDAqjNDc@wB|$0waWw_i)7wP0UsXuOCfg6oUuSF(^!A8+Xv>%)y&mabzLb9g{2`= z=~k0r^K3H z?7g4Gnywaz`;_mW(j`5F2!48Wz1;^rm8+m^Ca6b5UcHiZO)rLpMY9*gk)*bz>Cv46nr8<>{VZdrD|5&nz{ziK@EzuV_$v#HC;aOq*LUgFeiET^; z%!wrGK}84#Hc;G;EKnZsUOdq!1TZ!VzwXBg(!~3NxCOY~5kGXe&j zczIp>uMO02SQ_L#_3kSp0^!I!>qr7Y%grNkxX`=ujGB_wO0#P-#W39GsSPj&5> z5Xi?%wzEs=oy0z_;^G;{kLBueZ5K8GFDc)8PxX4(M%U{B*FOTjKbbZzyjoA)pGss) z4Jf)BW@Si|Y>-u_e#u}`<5*Wm^V4P$47q0co{Jt9^u6I}SxGY1Q7ac&M_@xnIe_E? zYcez9G8YRM0s3J8q%O7}&u+|DvWTJTYY(VTJ>$B=anpvfb|$}ag1YX{S@H3?vGcQ< z8qL_hAe*zA%M2tVbyer94u&7%tGw!b&$#n@%Pikt8!2q|P+xn`_4LWYv6GU@Qy?Lt z(9e6m!w2=HMCIq~j-YyuuvcCtW}EY%7)a1@>F{ZlWp4^~N@zd2V+O;DfgYE%^M?7& z3|{PayfB|uahICm$;@y_UCe&W>@L)^d%FlZML^@4=v5b$lwC9?azoigrOFzsZYwR@ zXZda)182z(v(3#o#6*_w;&N^;E_Zzq@mW=ss>AY(BSLE9VLWhK*_)%jBp@HV$P2`A z0*`_`w>k6aNT$)!6DFI^EVk*npf{Ojb=eqr`#(c|g@2M|#REUds*Z>MoRxj^m|lWh ze#Bf?`j_79Wf{*o5dHPzw}bd?qyqke3dpJtLlRzPKc|*?6SoljxUMwd+Y(r|O`yIm zk{euR1IYH6fZF>MjY?X+DXh~6rCn`7mAgp9)mGKqf|6(`K!D(&@6rP3=?Qf~Pc?Vy z)$!`;tkNLl#;~BT*HSweizfYv;!#(nGsX{iLG1f%{L_h23vwt>wY;R6ThEe5_^na<2|eIh9Opiy7Rv|JbwgpOG$JyzIYuTS1|r}Y z%ibS7K2U`pFMDs*#4)oAcw6ENc*aD^c`k1{otO)NAAt_HV3zJ>J!eT{{z+rP08xE_ zp`T?X!KTk=n5#dPNVT4Yjm*5nK{#6TW)$qEBH_%c$0R4^_R3WTx6Z`&NsX%BQp9)Z z6cia|BToGiHAwtvQJ~%aNlq3GuSZ_JnOiM)Ny)39(w`0`ufFg?BYRHCt53KuBd=~T z#eJaiPBM2R*zxDN0oJ?%UUcMrmtXl~?rrveCFcUT?f5LH0CP4#xro6qC`s6kbA2c7 zy-!3+PPW#`XnCFl=m>eY<83y7oXz#oiLMECRkI4BW5SCIBButF?Z!utO$S-hG@6%x zvF#G6QDC#%w=t5RTyNn?<-lz8J}br-IT-v22A0AAOEwvCq12+XLF1)I1cQ{kcFto; z>hK0`<#&sUL;nG7ZgdH>-EVYtKp*#&=>+l}1~>gkzvX$_)o-kNEe9Sj<67Bq4?`U z?161x3?W}_aid4d**zrWYK0pEd6!d17@R+WQXq#l&S%SO~@m}>K0ZZo`oaz zi+_WqnH$Cu$@;-!L^w&1wEB?{b3yfhNHHz7LN;{a+V1@;H-WMj5$S*fgP!r5tuk#x zVwFuR3Ai?KDHcciHeYvxheYH-78G#3XqCNIqi*n4d?cNl)ANKB>-zzFpj42W8YD{J zP!mdg6UKNJ-OXzwFB8NaRu7gmb4B3Vh#bWTZ^Mb)PUw)_=yWSKr!s5yG^=@zl@+}x zgounu)NJrXSGc@f!S3$MZmN{S=ZZ+=&x#b+s2bMxtNlaG?jp0d?-Xf{XbOd}IP>?2 zI5sCYB7k2MhEAN5+#qztxYYR858C@g6llg(z_UPe=%TOMUv))(6DxEA!n?8E&GSym zj*dnNQlNgQ1;Pttq+JVEOZU1&(ta!I{P_41v{}>h8#)EEfsqD!$mn%2n9KHJOocti zer@f*O`okkbi!3e%Op!d)IJ5cTkXcNz#wa_aoP}2@6*`&cq8_pW}C9(6{vAh8Q-1=NfJGYo12f;Ow|U3bv+J~k5= zQGI}1G{y&4|E6qVc{1z74iDV=kg zF~dujMg;{(?3_2wJGjs*2N$|*k><3moQ+E-5We7sTs>$KNXXv)vDP8bv4y8*R zsq+&=(5%;NKWxE9GV4Ao-xFI-M_jGkHtg5V4WT*Cx1~AeC@iPK+{>&ur*e-z>RFi` zaF*D-&ECs=0P>yAWs)$at?C$z>N$~blGLP1r5J0n+i`7*HR#hZk~yxA)WZEMUo;<+ z=0MoGobBT?Z4nEyQ_N@m=?OliQ!8npe!EI%I1uoq|3#32?gL;SO)6T_CE_@k=iGP{ zP*-)vH1l-*E>L5l@MfOYCX;l3_p>4dz3>`d5QZp>QZb%)DGy?UIZI$my@!G| zK^?BX;^gQ>@6amLte!=}35g-=xQf=9zVRnCo)@f0vLs%&)Yqs-a}dA*UK|0p**WSp zAx$@is~{W$doiopfF}0l6B@RMk(k^GrSj<_*P{O_!8 z0A0&HjNX%ZAhu8~xBwdT@c*VNG5lIof^3LRJlRK#CC`&PvCFD>QE262dA%k}lA{(K zD|THa&Y$sEtoX=U?Sj&YKT;xEN1_}j3%`90p?X%k5>wHCbS4YS(~n;LcoL6^siOf1 z?BiNRo~Dg1X2MTP3CTjSOGM)+E^f5;j=WT`Y^!E@5^%(~M2#bCfH4=&rS zz5RNED8NQK*D?HoWy>|nVRd+wlHIUkk5Pld(Fcq$K2Y`gWD!2QS z9l=HKMlUpVXR=i!Nm=9ddw$dbPzHUkSlsm)UY`z^CD1%*v z*nqs+;`|Qjql>+5i&K6Ca_;IijLh`8A~`WMpveJHWSD^ho9dA9(xSea46Ku%Tg z>0rJE?C(WzeHp?ID?YM@2s7;6HQ>__OuaVLl8xa^D3E>KNd3}^92U&JwpgCWLj4Sh<_F{DJe^h=$iAT@m|a)W zds6krzz%=5g_u7XNau3%Sj^*CE9oymbuDdMcpXzGbOtozxq<>1s3KvZn4pN*Ud}Bc z_>6Tmbd6t2F-5pru6+WXTadXBuT2y!;G&-Qcv4o1$%Cx2ts!Jf__#Z=4O(>CEacyAHOAx`?C1$;% zzNwDQ#|JylcX>&Zbx!NLlcYCl8*##sP|mUA7dQ|AKHXWd($Xdwp2eIzDB^O42rP0{ zd+e!wWXo!L_FriFeO-+Y;zaUaX&N!3FBXZpI3j#n^*ywRoEJge)T%CU@TDwB8Duma zZq6zetN+g>SSAf_8lTesU0zg0%YiU$U64jT8a-KM&x2Z^$vxv+EmxaweN%o4)mX0Q z5vOg6Pl0*SgB7TnP||p=DI|>CW18A_5g(pXw75zproc0-y~fU z1vR-CZ>-dBM)P<^3bp{9L5ARIdU-IZj5K$`oUqEpW}vnpwodBIYGN&JbH4o4fNOrk zUkzEz&L%cEhhE3l<*?w`{$M>WR@No3sW^c5o*Gg=5<+95DqbJEBR4C0T)?$$qRQPg zF`kP}!9x8lUfd~m(42H-p2gJQ+EN(60gqz_J|c|RXnC_G(*wvZ)LV!zJd0YWrQkq zH@sA1N(-stuGk%vb`;IWkf{?piLP|}XugO@mS{vl7K?5u;UgRX%bq3luQNYpeRwK-Cp6-3dly9OqwHiAy*^mr(r(J&5r47WnJgrBesbYL4Jso*al31E-r3( z2H||<2uvh?0eVom_l%3@{vr_1y(iT$D=B?DI^dgDYUFV|V*p|Kc6t_m1a9heF?Rx7 zUWk1GSFj+e06~S7nidBc_QM+*&w8&NuPqp;@vJ5GTW3X*IE!n71aBkI;zL2@C@UW` z5cp8fl8aoj!Y`VWm`ybP_3l7o8p@n~V$h1dJD?tO7^8q%U^wHrtU&cs!IZ(WtwE>+ zvzE(#DhmTX#Mj+)q?jLd5}&TEI+0r*aCHS-UrNc^hvBz`g!3%H(KIXQd)3qO5;vj5 zB#7YmtwgmuwD(=jj6wWgQ6_X_w~^9`EjhRxfh!&saCEDv%#IHi?+T)gjkK6j7eUDC zy+l7dcL(1*CGMSoI`A z^%#HH@qD~DrrnCwGUf}x{Dxm!szU-neio($7Eu#H>k{ccg?5Y^ z+>VDB`a`v2A^{g$X$KA{OQao}fbDcUib9C6)l!*@fLg6*rVJ~Il>%^uz8pD80HH5ar|$b@)Crgbs%GUj zO%pwgpjLk-z1ePYxe9mDRq8@jC7w>r*j;1hOzMdf|Kt^Hw+z7C{YQHKY)LRTVk)2Y5b7x`?NwF`p+rX%7!-BlPsiDqAt$xoFdn`}zA3@RW&dzV>66MN~0E%W8#9+tyE4Wt9 zizMEOG4ih!d|o$*C)RU+2pWRpEW!#Y#;16keI3mw+^9fkKy~(>$D3sIEJBVNyr$!j z5^7YIR0^h3L=#|rKQAGg%7{CJ31nH9-iMd)vPRurit%KPs`mz}E-P+|R;&Db&5pK} z{my5NiCn=(%Esw#qS?1qPD&K-QXj@Hcr!P8UTp50$UMuN=e~)|GZ&~mCAq01_su-Y zwUW(JCnDiDy-BxD;R(KM#oCgQGuZzEzAM}ftF?h02F}X(*cKf~_9J&{hgy9nHGf9# z-f!O_Aqh~M;&xar(+liwc5Zr71Is+G(5USwyVMF99@mQ1{Hhi~b;jhiMX+vT@w37O zSXJ}#qa(!x=9C?1$2?DbM3BtDCsN)E>nKkGzYOExR4hdPRwEnK!3Gy*Kc=99lXNIVB%&u?N1I3+TwJ=D1;R(`V;u(5t=ygm0B## zuUahFF^Ub&&7=6wUalP)NE01q$A7>e{Gd{T^`Je92g}o6PZ#_cMz+7VC5vYIt`S@qLN1)>+!{Ixa@LTo06KImya zRc{KFhY93HoW?MH6m192BU_!(w87Qwd!yl9fy~MQ9y-9sIzafvsUlXH|`JH(eG?)WV~W15v>*UC@~m_4(dxtmw$?1Piltv9J$h7X-2|_GT&_ z32qNm6)%apt&J^ard+QHb3Uq5Ebx5e+zpS$zMBv2x>Zy4j|x?v4^^N4s8ID{c`8F1 z@YNv0SPj7;fP#ci>N`N(L(I-y_^Sm~I~cXNDS+iNhU2EE7u68}TLNOkrd;W6IuSxt zh|oknN&_*boLC-+9}|dQQ4;W7>~45VGelN#!_zvRHQl!owK<82xz2kyGg< zp&`BfbXyKauR|L0oJ+8OrA4AxKIFQ9s62kh?V_-0H9@YS{)BBcn0z}{*F={Q`j<$< zmOE~t_8lfPz7VERtnL(bdUYq{Z^%&oI8(rn?X(hiV2%H|`b6A`12u`U#KJpDZ6wz? zY)tao)CN<4XWC|oTkjdaF}Xo3rWL}u4;!$oes3DQ zm<^r#+U&80rLZN(=B8uGoVV#V!WYE-(DheSy({UbuhY7Ohoc3Awq{s83e=vRaY0d zo9e+JS7C;ii+@W_IZQ>d6}z?=b0o_fRxttp8n9u%UmY6JUB;6xoP#Ib{xR{ue$3ML zmvS9rWn0BzpU&0qSBI-ab)DYisjp$Bs>U~kWz^+ac#{YLK0+ZU4cw<^Y6=b9qyAx| z7DrflIKs-8b;F;MmP}0KM!7)Gd>nFZ5c^fz6*wD}w;#MyS1dTUPM=n?Lg$%}n-T)$ zg*<2_hicK=W{ci7uSBHdotVh~hZGocZ2=VwLDM&?Gj{vfEH!RSQ&q^9j2?y=ujRS7 zwf6+peR*^kj|d|mLJsE+IR`JBjND|KlSQo}_amgYZmoDq=_W*%(8UmnbfoA3U*v40 zoMrSJNz{#C2sd{!wW7H_ShqHCN_EtkI;@sFPksuC9eDvdIUcMv{?F(ITk@{u6~cBV z?6h$F&Mv|Nb(8ReV`O&??$+U1HbvyLPtu-CT1bTt!&MjlW^)eqmshf91gb9F&I5{_ zC%#N3XNukWHN0ly_biHXW20A!N2gg&7cgofj=&Qc2IP}8!~W25LJxIQn|2>1Ksd5j zhWEKp*;moe#G&xbu-b~g_AEPbi91~Oc}Rti+J|B$_b8n-*g7*F?6l)GT#11;aUZ)+ zP1%-cH%{czhGwb_s~yNN5+P{vodMt0#_O<{(3($S&0Jq1fT${<&1t%X0HpC-7k4J(^o&t(?UQ_2Mb+J`NHk)hL7cqXVFjS9%*dE?(_hVTyIZ2DYt#{ z@KNnEgCv&v*VPDKTTV*nSP2BJE=)cTAfWpIqak>h;&xtP!u9<&XS2S2!P#M8K+noy zGviQt)3mm|gO)!_{y_Y~5;~B!-3Aux2I+a}bA+i)a9H&Hi!~#;^JJ3CbMtA2)m)iQ zaED2-CY@lqNkGz(vuJRl@LTCG!Bp0obXLE~dS^O8Nh-nEbb=F2f~(UBT&V=Z(+R%D zx|J$?=>%`Xhzle9S!1gCubTwNrW3U31ZiGt4uQAo@n@Lh#Q^VbsbflPmDj$K-ij(Q z2$d-DQ}%T7f@oTnVHr5_FYg^*vGmS}UH=fLia)~t)r?TytfTbuTf<;I9`Y~kwI3k9J18u>?E4E^^946oTqwp zdcmy{vw$6u?9*dmed&}h!b_&- z-q;HE^8^`2%_)2n8cM={TvP8E=?bgOVYNZRJl#`2j`##e^o{z~p)CdZd^&pS;zi_qQI$GNyZe|aoepbZ| z&#EOd*i}pP4)4moWt6%lKe;7-OMdLDY#8PEbb=BgLK^aWI7oSgE=~MAzVR&q@*xZ{ zjbkVVkBn$^uywtbm5_oJc*hi9pBa~)fjs;k;<2n0mUP5oS!Cki9v#KGyu!d4QDX6K zS&;jLoxSaMIx)&*iRc7*M*|`z*ueC5Z5kHFez!bQWo`8PQSWZXjALR^a$>o*EsMB= z*;k@^y%JJ2P*N(|*Wod5RxtYtl&|mx+0#neB_pcWaYe~-sZ2w8Do&0wc~HKlY<6F1 z*CfHsAg!aHW0gQprDIGCSVZ%dOTE;^QEib9YmVGnbO&)+>-K$t;jLWT_T{8+a?>~N z^i6@>0Bmuqc8#0Np&0}Y*MVNdTqz~0`27*!sTtL^I$VMa^vMi6vrfh=q~;jsVm_K- zqTb8Ixw&@#<;1+ySLsBN^1BX?&{_3ox}gS(rGVcZo>_$-)?SYEtd? z{gHfCeQC0F`~K(`@#;%c@B_msz$B2H;Sa*vNC|)~*XHg!iO$3cN^YW@oo~l)cLR9! z@$VJc@!P!oC(>DY{I;?2+bUH~to6h;Cy!R6oajK*h(z6lk=g@cPZ&8JC4^9gC>fke zPHIQu8Le7d%P2Y5q+mmn9mj-G?udVcIC#Riv6o%@KFFG7!14B!Ma7h7#42?(zFfO9 zGxs$860_1IJlkp})RyxYXnd>KmPvdJ*p;|d%B7P3e*QE6Z0th#xm8<5btQtkq-XT{ zv#Tqu3is$u{KO|!!pI;6uJ+^6nH#UZKs+aSwDtD1;R3kjY7iNVLq}B3$j0S-KUQXCtrY7dKW~xHgh795syifyfS!ds0n{R4V){I6!HK(8kw_ozZmpH{ zxRy#{XVX7P$Y;dsSr!trtlJF#Q0;;%> z{p)=af+$(|xEL^^s(YrKMhH-h0#N((UVoeuq^S}z;%}f|fOm;Wdtj;)GpW>cZ?9)S z{=EJ#vw@{OkwC?+s_C`!ip53&NdUWJ{%OvehfBZ}JMjazZ+h+A_eFI~EJUZ1*XxR; zRbb?&c#t57H0EiLf8Bw|zF&^lvr>{Cs3$PzNqcpdpFPiX`Psfym&eW2(IzP8`WolZr47 z#u~oN_Nq3*bhr6STy4=KYZM{H3!gn3fpWqwcjg6!(CL6ii?)Ir3JlN)cI~-QR|SEY z*G8Z$&{BIk_GBXOO?g8^$#^#A-lquuiS2Vm8Jh(Uu_)C=2=d+*og*Tz=2Zeha-Oem zvm6S&)I7ICG4zE!k74waP_mMp*(_e}<+C##Uj-IPopS_b(=Lthuj=U@Zs=OsKXuF~ zFRdG$Y0IAV*^y!EWD|29C1pQ;8B78VlyyVTFji>hjuo z=hi4ft5jx1y@AB2b2w@=7{7NFHHn0BdVODw=dlZrWQ(lJ61T@zx9{@Wxm!`#cr09yE=x2<7Ca{DAVP%c&RJzj)B$KZo8E=!Zbc z@u}}}>9p1kr{efjwm70L!{Ni%J6oo*=s6p`KGjuHfUK^9<22!F$*c62Q5TOpzW z6|$Y@s{p87i(192Vz##zLThqg>O8t{I+e^FI|QtMe7d(~`kd4jlyRr{S9?xC4GSf( z2VEec>pajLnBA~g_ChrD)Eu`b6nlRkdfe!Vp@haBoa1&j6(yE>nSYy9$L+F5@02r_ zw9N3v& zJ04rj)Q93%pXpUg#&8R#BSY@IgEraPJ5*YVYCrMJDn?J+zixB>iDWT_wKbjUAB?>< zeqc=db@OJ=EjNfk-9qH>u|CJM=wXUX)MTp-tmY}@kzD2Uz6ZY4Q8Anw-W1Am3Na1( zIMXbGw0C-`9O}_jswS7XrW8f~t|ob_CVQKxyk&yl4Kyt_IVOL~$EO%J&_|DMU^f}Nd5b$!$ zJ;Gl5M`;EB!xf#O&oiCAyy+|D4+?z=haic$MwO$wvvW zML!qz7rP4`y!CV0jr)|HZ^hlcj_f`1mxBG&dh(0?*%x}}6uVpRUUWx&_HnItZ1+A& zax>(%+bLRrMdN5yT~smjVGVE82ezr=OphTPb5j72tDg&)3gN?xA_7c8j-h8DHHF9F;jxT(7FX!&gnf45|lpE9~&0Kuj z=N6T1uR*i8Z_ZJPiP;#3U@?Tz)1Ka;_Kfv4Dz}vk^`x|u&)YLL;;Iy4eAF1m?4!sr z(EF*qUi*B#?0l3bb|ul1lNdkknY+M@p)G&}G@0YQ4cWtDih5g~(KD`oE+~0VH867; z7BUjQzcltmwybd&FHq~a%4Fe+vt)5kV!iHghEEdU*oY}`dJZz{&%mRmS&T^x=3mSD zFbs4%*PJQ2x@EFQ29|9_DrV${&h93&#w$}JT`o=a_wWA$ac1H+8{)C*yl8GkYwy`Y z{5oIZ7bAxOp!cS^7Izc z+X30r=ZB;jLt%aWQ6BOhX!hS{G~ zgCxwNo?@{AjQz5e>4TiGN;?*GbE}_(H@sJNH!`&6X_gvKa90WLNnz5&T6;m8&G?9@$N2)xj1*~Fe1e}Lp2bGs z+`vi5sTfBx%glxjtSx(l@cXv@oCz0{vOJfOH-G)>St8678Snc6a`l}-fusT|XuE#sI$x;0Qh4q9x4Ou3^xMdlq$r>F%5KvW8=u`=%ZKa`-<-{n^$Hn^Is zJMREbL8}O269D|r5L+K*3`T6DKx{8Y&Qud~Ii$OD{*`K(h-cNp)%=!qE`EN#triN> z5~pPVVY73V7|6w>g*b)ud6v&$hSc3c)GH+keVhEApD;B18@%*!W$*1}&9AQms=egz zS&6Z08W!cc#{wgc(2@^uB9X#c+bc58?R?kps`(j72{{)nMc_)(D@rB!`tddk8~Jsz z@RHL7cLJ68xov|z6g7+4RLTvO8(5Ywff6Hjlk;wa;6){9LJNao`~~=>8+t3g&d=y& zWSwR&0*A5OcWNp?g)R*e-EIekeGyPs)dtGm2#)R!_%6B0llYLKAreF#PqXHp5GcE3 zmOZ0-78_A38c8?+p9I}cXNvvBY`WWcZL`5c5op7dY;{2NlkSLYw*ocl>u7L@8x=f01#GN+sfP^Rglv@9i?b1MNqtRO-XZr@*; zEDX{rnKP|4?C)|jLDQq0v|uewigvhhwEg zpHehRJu7OfbM|TS%3;Hj+1Cp{movXg+1aK!_wVInVyf4UolK$$wRXJJj$dA@zdf`M zDX4S%agtq=Hm3{cd!~me;`FNHoAuEie2bATE0UM=dwXw5Y5`8~4fv@#rAuToC1>=~ zgza~xePK#sO-++Mbac!s`xh<&1+hABR;-SA-F2n>AH%6u<+N2J6FYHNt?twgXERI$ z04rs`Bv4lEeTrYt;^{>~S`TIQFnI1{;j`FW8xCCEB`mNY*Ljms9(hwc--M#k?Zdk& zE-xCrgC8u0ykZ0+i@j7$DCSbaGXo*Y95qDf1QLjBlJZfLO{aXB+*(<5bwbgJbtMEe z>-0vf2aN*g&g-=Tc3nP6jQDLpHAZBT^R1%GRnX;pbM<>Vz%t|L7Os9y@^$0|0k z4EyVyL1Nh5<)Sx87zz2b6zUvbQ2 zrH_=Gu@Y`YHg!+p_y5mEDnO%WsPyih;#tNrR(m2>tI3=O@Qm!|Y6!zMTsK-n-!Zz6 zTb+{Lfqldl1wc*j`9);c`8=6?^ZPr;NQHbKdzK@M)xu68T1%a7tdYTHM`<$m@oZW3PgU~hq%@dJmw_fZ8lR#7 z(+88M)nGd2&H(xW%^6IJYz+RC`W}0fi&?5<6Z-xB8gLyJV}ba5PKTI}@M1pP%=}9J z`*~+`t>ynT?(4YD;(tB&bHedwr9E7hatXwrmC5AkK66>c#ZEjR5b+lw9fOG}e!@VC zxx{9t9Ey7-Y0LS*1znI_{9NqB3Y&}b#6p?t6}8-_RafM7_9FON$@?xzb24e9lzk?j zsCu1wI$w*M`>>dw_=#vSr+^5<@fOTMvf?cz{L!qY5sxrvKKoVNHM>dlLYxy&(_x#rT$g{(`>1)C&!y3c%DWiEpGDfS_AdBj{+ zb0H-`i{#R3UUqR|ICpbN7M?>W1RnbI!ztz=3qm|uSY#dw^uus@h~Hsr%NOUXFrzx5 zATbpJWvlZEPc!2aiV{;{;kG)v^~X`hJzxh9s@u6A?}oPB#0zX1=BzaLy~9k3$0T{n z)70<$Y@YZ_djre12n&=b95S9mY+3*Fow?8^OiHJ;oUN4gubF^ZvLn^YW@JrAq@64b z)6A6|l{4T_53@V@zAd0tI4Uc>JFQ2AHjrk-b}%vG8dx|nEr<^~Q(lo2=B*PLwd3?S zr5Ns~H+9~V4w-j~$s73hdEbM@JGkB>Obw*dXgNOf6&-;)hHF{p;j#^HU2^pI#d`%1|4IMZd)?}4d z?>-+ng0r%a2zl3mepn*`Sr&Bsbtp)b7Qgng!kwTdMlt*dU+z+9`z)vr>8j5F%+wb1#QVS0pz)G$3__p8H2n1&|YFF;{^ zr$>U788UtVtcQx6n|1Cq?9}lz@OyzXdC+&iJSFn3m_%npPdbnn5R1w#^TBZrlXMT* zvc}miYFPXNpiY*~|A63Wd4F#Dy(2gwwJXe>pV>K_v06QDvz|-!19yIw*broSFVqGOngSUbY7zf3MVe{>T0tSYLtEcfz3hq%I?q|4;SA z!Hk~xoV1?!_>7+T@-hEbNxc1kM@jtKzp=v}s3gAbpX^^n(!(&HHJkJQg_8IzBtnN& z5^oF~q$GZtiTpQ8Vm%ir`GUx@)_SEk^HNkjy0KP4^7)#rrGs+{2wG6l>KUPgx`S1g zODLWtwha0{+AB*YZK0OYIrQsM5pdzt1BJQ?S^ykJ@lj&2eOojDy@=t=s^d%|(eOfU zAQ-q!-wECKE%dE!XY~Rh7xl`7RUJ^*zu4dWT1K~1gq3$n1Vzt6ISY^jr^4zy-2XyS z4XFMKG3TDqhpr18nct@tu-}W?6a6?A7%Kl$=Y#J_pC^?w0>(7yQz!ggB+tp}V&gvk zQFiqA8Af`VFw%8`ZZ$WJM-TMLk7cjd_LOJhvM&7f=jj(C5hq}8Qg}=-{bsmHVrP7_N!zvtQ41U^tb5=sCMl6POclP0yEXoSHh(*J+%E&d%YlN%H0^k#NpYtcwvw~Td@BKR2 zmy8LckdX*N96W!dNJOg~!oa zO+xJ=1b~p7&;jV^kkJZFkE{|e$2CIg+u!TzlL2 z?N=+MwbJxeqq}@vk#jg!8FzjmttPLs)i)18Bq_17#TeuDe_@OrJNYKK!(Y${qjvT#enw9o`ns3O*P$z0fn7zDqrf34ALu;Jn9hz)E&rDDx3L zUX8f;9zfNeUUV)YwSOh(unHud=Aq7To9Z42T`Vg1h4#8b(US znFZ!N^sS5qcec(G#e(~tpGdshc-}6qB9#6nek*56{lLa~?O9oS^YX+|Od5HdBhh`F zm+N8T@_t47z6B$ktIfxbyx;Lc{%9;#--p6aOeC@UZw<`5UeL;fa$AjYiE13nl`YPB zS3$jYNq!zaeizzX&Vh6LW(Vf(AlK}`yt8yJF!6v~XIw`vkvB-LHG^|O3a+9&=a;;O z1TJ^(GdGpa3Uh-Xum3dTFVRQHX~tg3@(UR_6zXkn=ZW8|fd35ga888RIhO8gEr43F zk{+7{fROgs0$Bi>J{p86drmq>@cIF8omg9>GqdMzb3WKDXz0jby+9y!^p%C~LyxhRlizhr%n!zdc?MoC}8&R{1d7TK|rXov_x z%2p!4q~uNd?ZgX+snl}~ejXCyRZso<25x^FcXqXwl3n~i;k*x3!R@32*II~i7y5;bUO zMmthLjjlNX7dSdq#RU$r$*|NyGm@Tap*9&_;1PqL9TAGMo3qV37au9N!?jg~=rH9Y{j5(2<_`42}G;{qj^pR2vgb)%Ivv>LuaKe8JxSIo_vDk z@|%p|l-Unc8=CXxPD;{^O`>CM&vu{Dd`Z3H{l*AWF~Ky<=sz)$8(`hj#hcg zxraI#fv3h=&BFCc)0l!X4WcNWhv!3Kl_|o_2e9YH`Or}FUHzWq=jw0 zdDM7g?91GS@%Uu8Ym_@tja7H$MUlo&QPun@b&S5T{#G+i;Zaf zK7lJu6tO1^5z}F{qK8i-4;1h3|m5gf1+023St)P(AUy3CyH&L zSW)RBb|Uut3L^^MGDMfOyT7C}C<%KLDM{WQSQ7m?t-qih%kn-+7>c?@AlXpV-MrEi zHE*(<^UtOSi6=!J&^t!N$cfR?B|ytYur^m306m#3ypp?=7;Cfh-d{-*`&L#IP36#3 zCs2x#bP!nK#rJc!Rz@BGFEE=GNi|~6a$xLx;-gG`&`PJYdk%!yr^kYn0QA zCSDqVq~5WQNR2n$8K_Yc>$saW_rze?xLKhYSfJTa zUz8p7ZoQ-0p&3ec)EZ-h@E;f!kzo}XFk4ACg}EixzCMz1?mfC0n7AaZ_+e@L;gl@b zJ2eyAOIx=4gNhh$Z&}9fOPjfin%N>eUgQe>JIumT(z963O@oKgYWVJS|`}&tiXC4UTR&)&IK!Z7U8rjnqEfNsC45pIg=trpSzp~AP~!3Zp1Q|%YOi8IAhjp z>$QwB*O=vcg>m@R%i5-UaW`ej^8=~pPM%FeIQ;@W?rcU+AMo?I{!kzTqm|CmsFdkK zztZ{o{~e{XX(uG$7U#>Cq@B?d2HYPpP|tiD?SsyI0-xZGq1baot(gr;xe7SfZ)Gw0 z<-8wIS*;M4w$PQ+gj&)1XNkQmw32fpmdWfv1!fCQ?{k;xI5e8E5J3~>*TK&I0Kwblu0o#vcC$V5fPvEK1dP9q_7z_b8C>4DB=|R<;_EtsjMW zKzOuV8&T`jpHdvQIBzc&-)zYve{>Em-Qf2DB1Hc(EuUS`)EnJjB*r7OOTjRXqsd68u_Xtu zR%EEd9kRZXh3{bxzfx#HPi)56tk{gotX_aqm|#N-=s~kngQj6fI25lmv$Z|*Tr&7M zZ}=jS=|D^j()VhafIcYeRO@92OUUr+E0BIh~I5|#jv2tq$nzrrp{ zAN0A+xk)b$-8hXq2A+KNFY9`26+Qnq)gApWtNUt?z|JA6(=^Ed->k%AS$e=BzqdM# zGbPu(`+!me7`Ptn>Sf=((rx>85EUZ!TltXHd$iyQ38tJ*svq$RU@C@oR2NAiDJ}Rt zDNQK9L(yiqHWC}-HG*-Lk^z|nvWbwISeY1?{Zni2?EwfZ2_y>3uT=@pN8S!s6}N{y z!F)~VL1A!`)(bDFABqr-aB(nHlsBr2)0|Uf+!hGWSU-7i8CG1U4=J|V%%A2@L3A90 z#=&5~-p@~y9teA1uK8wJZ$_lLpiO9gW9!NK5+lZe%PCqcp0RV0tYjAW(RO0QmuCR& zamdIzFV|_TUCyszc2eq>-p?~l(KiRp(OURUL^Wx5kg+!Ubm!wO(nybCfYbsZ25gkB zz}_H_kWaR1gviDBB2TtdbEPQFd z)TnJZYu0*)fXaTfMcV z$$@LP-&R8%leqmvSm3r#@?e1_lI^FyFPpAQ?Y8Pwz5UvI-%jtlpKKEXtCcg$@t6a; zk0DODIG9*!l-r7r%Bo5DVT1`G{bAXc@V@sUV9;SMa-5bor90@`>L?-{m$3MH_z8#^ zKU2tuevB^B>QcOdUY7%GE!5c{8TA@xM&7J;IO4F9YHF&X@1z?#UN@AO2z^){o)}g% znJr}szGk_H)xd;X@&2}cQ1(VBk^cmN4^nO2^@g++i24(t5{}O<=sm1)DE0kW)A$*v z={J4Q>u!N)71lC=t46mGW#`8O90t?^;bTRPE#WmTK~bGPW;$_G$yEy4&Dwa#^+5rC7v*~7h2{IdO%YO)Uv_wjCTI6iQhM_e+-fz#?XFcO37w#b( zS5=d^`AwXXHv|(ioe-hbJmWUVraFc`31ptGkF3IgCy`h4hE!m{a{H^=VMT`$LT1L`gT8c_FXiDG;{y<8+8%ClrLz#Z!=P8?&MjIL zfzA}3T-;Yqk|h;iQVwJ{+qJpG9l3M1vwWqTeY7tgd;n^{YMy`IIiVSEaB2~|+vHN) zwOL&jaEio^Lmm-*@XCTG%j1;}rq|@3OYwKf2pVY$G|ifQ^1y~0`~$<`S#%X2t;7_~ zV&QT8DpB#COhHwq!+kGECOicFF$%AC})t(56xx!f5WL*+slqXeI8Uf)HnzR+)xK zyB6OpYgAqHhp@Wyw*eKMzgA|}xpA`|$TtNLkEEIu!S{kKopQt~;G?x*(ky43N%(;z z#0!onu|Y+vpA<+I|5_Hfq~22#kGgBnJ&X^;uU}y$pG&t%24U+S8H9W3@CvftOMn!w z^BJv3r=i`yCy9(E$n+WfBX5vcRdjV*I1a-^tg3Jv8|Ku^l6)@7)3Bpzo^_UQ;(0OB zPQXUp`9R3T{P8Sa0{{jS*B@3hoOsid>j24bh)6myc@DS7>D#+j(oLS^Y;Zn^C?SUr zOrV^tIcT{xNGqIde@rpjS;zdr4)f(Ak;n$z)cGi(hrj0(C<=uQA?c;nbiVG->!@A(V^^#hDHYd&#W3S|Tf>t3N>37$R3 z)Kg?cUsB8JwamxxC$gt_)AoBiYgAta^wJmo4$U|-SJ~_SC@tYX&dheQ4QJ*}c5Huc z!`lZrGb82B?-RnqqlOZ6IdYDz4&yQUxjux?nM*G;{UamHkYM29MM7ku0>kf;OFoW_ zCsWGpiP4Jp&Vwwaop<^xJSrQczs)0tq(y~&h|OKN=ppUe<1}AgKChS?a`}oEYz^)uxn>=MJ@FHQX z)OHEri@3grcJT&TOor+N+g$*r5?Lr`HE^52xEz-zO&U2* z!;SYS;6ZIITPn=*g8f~HN}6trt?A||JNn&@X1SqM@XyLtZbbng7j~5*KtkWgFJ?WP z*Q|aWc%M;+S4_Vgm-&uXo9Jbk$9OGAbGHhpFc|R9eXIo8VNq7HHd|IvZ^et!Ufmm! zEeJ{H>a*>g(WWf4IwvHz~vT~CeS)1GRX#KB^EUJ+D8ky9)rfl=;3(D3=y%r8F(iS{@(lJh7C0c?DU6WDuKbjOT{4ouZycAA z1S*{eNnq9SHn%uP$4>bcH^}I2k_&$-ty!MuS9c4R6cQk-S#3h^GrSWUE+sD`N2*Rd zhx=ckx&CPHdb)R_@w(0i0Ut_JeIWry1r3XMz{ul_d_Z*78*tonD#bmKejS%KTRTEF zmakt%Pv&cn=K0S__U7v#xqaDB)zcE8I5s=CzfP_c;nn;Q4Nev&|0bQ0#;Q)Vu%30F zp5R&6b9}l7majGXzHo*oHc^ABBOP<5x{`%AgZDFKtHBX>-5H@o zKRQjzum{CLs^v@w;*O{huhM!p5aQ_u!@^5-hjDrq4;0a>K3_9>Q;lzDE|dqka_=M)_e5&h>RGo2Ob={#Mg^Q@Q5bYgnD*;(%f?+myrqpyxiDWJI_dF(h3nA7xBzp zeioo}-wtEqT*rW+{BC5>-qF6RM;~t*>UY{sr>j|Ih{Tt=?DB7dk_;s;HNU^5=9`-*(r>`Ae)*&^h%!|*A%^i-z~KV@UbUy zKIhEciBNKzbH`Cqvw$Drv(6+z@3FY8ijCX={kND0{7$cpjA$d)FIP|db2I!qgUHSy zK?ay56eSC9A!}b!&5_n5F8A6AwOcn#3X^i6!2a|;-wvX;L~xj)w~~bqkSNvuw%u}6 z9s$mzJZX9(-+GUcrc?cZrUL|h8VClrJXO~qduBWFn27v^+L98FktP{y1Y^_?nUImF zLurcQgTCEO;h3nHzFk7!QbPTA-jk9j=0&+l3p_=-A6+Y;UOrf&H9$uJjh>DNL*GsC z=KCe+<_UIw)KN@*J&}!>}`C!ZloQK)8ll9j<}qXC)@|himXG z0yOCwCSM-D>5vVVNyrAzU606zM5BSFx8F?-Ko2*h(kbrNS*z{8a9w4rT}Qv{dpRS}NFm^cLTi2oH_v$Y_3D{5PEwo}%sn z7P4Zvn-@o$X~&Vw$8(&M&}gLsL7Y!jR(~Lf6we@=v4krXI5GU7CdQeN|1o?9hQR;x zeAoxhha9jmD1HVW4xX&f6gSiN|F%I+eNpz>T&cxMZ2<8drRK0Z_t$S+3A5e_s{=gAo2^Kt;i7383>`M zj<4cY^l_Rp8B>7n#Z9RKH7c7JaJE8 zjsqz3{!Vl0ZO>UH4m}a!E`oK-o0uGQem}9sP0&7_^n^L|H}W zb<&nCA72k0cr9rJSg`Tx zbjmrbQzS@fqD2Vr1wzk|pdeA3EuJFs812D2)moO(kQ{Qq)&aBCh^5p*)HG+GUqDYA z+#M@*J@>qjnjPX$wb_|152~{lS?3B7FtdTD<4|&c@P5qbtl6zWOt04i^v#(y>4jPd zan#!g7mWysi`QpPeSbS3u{xa#Qti+P^OH_&KWIdYG=d{+2z95IT<3v}K$>C8;Nv#i zf!I{HqW>oi|9V^mwbjxP=f#m?Z-7U|b=NV5p2cD$2Rc~6lW>KzQvBn5o*C~$cyQ#g zxeVYR-_OtRkCSvB@wK^ds1zQZ$dVZ%1+!$J7O|nuAFyQZ|0A+7SwGHyaVJIA3k>87 z_rZ|-0GscXn3QaokpmObk=Mgj{ub>LFp)5DvFB=qrk42RUa<*I6!xq)NTJfXyj@RB z?6y(NVO#Wc^&`=T8!h-8G*FxiA;BZ_JJUXOk$0^4%B!hDSWo>YHa3k%Ev5 z$^gNnj@U*78!-#P;~16qn{!W5_Mz^8U>E=WLjs^@=xMbG}NYFs;glBV9wc+Ec3j#>gw4hBm zx$98CL1rJ*FCHV7{n(1w2DH6C!?P~FkzI`TG)@QpvlTqFjET7MZEzlvQ1N34-R!*8<+ zs;)qE2UQMJkHm9AIe{`=kP@Cn8+e!T)OemZcLAEbNqK5)&vFZl#a%EF+1LXXq=ZM4Bb{8UZ5}u1&VyF5F$Ozat{~vM$}TC5SC^{l5}Gt= zOuTx`pvF{VQW`x|RhL#(d!ye_)nlrvOQI)Wyr%`guv=T5*P$xc`K7HOn+pI%(*sUF zb3DsMz9xvnFJy;psLTV64G+DCAbpxJoo#B}`N^cF?Qui#FZ)=q)u^=OVz?X!3)))J zCYuP$6ZLKLN}2-y2h`GZjoVNC2)cJ-Y+p_k@1|zPn-4=;{wQ|`h@%FIqCPyNDC(V8 zAe0M&TfDKY;T!S<2mOe=^fUsS{~AE zn>RXR#CD+ug(%{%ZN$gf)~$E!=<}F%s+LqoJaQaIeLC;_nQBFs^s8-eH*%mBxyPj8 zC#_JIm!F5)V{97i~I$AD-xPg@Gl#Ip^!*oD-5J~Uyh9B3vGHj z-t1Vq_)KGE;Bi1Yw=!*Qr#6>$`r40saWwuWP1HwGT}QCe@F!{K2X+>HE!J%Kar zMFfDum0Iw$+~5!5f-(w}wL+#}*I2Y>3;T|>cefbPw>e^yn%8p|HCYSxiH%Om z?;X6FMiGsLgY)E&=YrmA`1;p8zK$S6j|WxN9qg8btsTL? ziL`!c@HuD6QjO&6IDP9N`A-o|2beW?^_o)-##Ak(ysL6Wjx|C^iLR|*x!RJgM(Ngj z2xjc~hxzF!ka~|OdFh0USc%nLoLv5#YbL3Q>hDJlE#f1SlsoUTAO;D$o-e zGmKI`V>@847m~*?VDIFl85POU@S$i<8_vVYBaOnMzq9nPXbtEpnhb(O?`RBiL6b}` zX!53)8HkDJwD#JZpo-0xq+VcBX9rxEfMrsSBcMb>`2aI$g zv;~aIk#GrhTZ> zJ5FmRlQtRchksGZCq|s~7A(v`v9qQ;Ns|+KFMTB~XD3e8nOQp~?|ZusmG?-KxAWiU zefW@hUlkbuXQdvHH$5JV|2i4co?rb&k3Etq0y}vMvOFVmJOwrbI#C8x#;Bd%UEWr!ZMB=C zRufPNLH1jO?xy!ldo_qG2DxLLs zRz(t_XA(!@$Z6x@P^yV;G==1_jvGU@9rI60-J}n=Y+yC8F~x?E(g5}Os(I{*Bo7aw z&C17iEX}DPX5DN4sMF)M`iO0{F4yWyq7hh0kvwxp|AGly@Q7T&Ur0gQ^-19@y!x;B_;_SKc%s|NGGcr}n7 z<%^uQJ6UGd;!E#tO00vm8q9eQ@$wp{Fb-)NoSa@jQ0!{{|Ey@yN9n_B8Vdd68w$bM zv|q}|2>p{9ijtCQJ4>ZkKQWX(A~Q|o9NgkpC4U``?IOPubA&QBvD?1mC*?!z6o}le`>% zGdV5q@=E^4C%+?Twvq{Exs$wV4n*5Oav}$uE^T50_z{LZ`78DszW&t<_GgRz*~U-u zS4RKtvXAm);UzC786CDABr0#;$9bLwD_OtOx_|d zaltLoEf#L(eg=_TDw4W6?;GIkmgG|S**y1_cK+hID80oCEK`8L_|8viJFgj{N zA%~_ynNR`S=FT0-rH}HAH0&^WoQ{HEuyZ@dA`(S%lr0`kF8z~ywNwV1=?oQgP;BRp z^fxj8*h=gdwzN|1F`Xg*uPM1cd5e4+9@7y{HIO1=y*#!RRlP{kjbVxQJ=7Q4`Ehy_ z%|Ola#&l>CG(i9CBgR~29>cjjSp6#jQ|xOitBV-)MpnNl%QS$2b8R>oX|;Qoz(c^c z{b<-KX6AW3zvq}ivjGq=1h#y0RUqpzy;r>6<67m!ike?Z!TATdB@zrY! zI}5o@F6tbY|I9Y7B(eRlIv6J??yLi0t}}8f zt^Lk-Amr%{A#mphr3iI)nML5oa!KFaOda*^=k7=KlDy3t%%A}GK@uRk9d7}j zDbz7>dNd^m3rB}mM^fjOOy*c&3#3T$+&TQ;Xn_=AMd&*&8f_u3=k_MqFmrNpdPmuW zOt_;YqDD1xytR0=hk4f1*v0SQa5|9x40MRu?J_r<vZa zDrK5c+)JclEp|Sce%b!Ta3$IyIWJ?hJol)8<{>HV`GhCR8c!aqn_BBnv%B9{A68yt zKXO`jxd&7<>j~F9retS9$lXIcz0>jT0ZzdUfpE=@Mc_EW;!{)QnX}y3HYT+86(`p@PYP|7u>q5Rp~UP7W9nDf?UjoUEcSBoHBz5BL5o44VXZ`wiGd+&?dmk6 zI9pe3a9!r!9=TK|nNIf)vC=F%+1c{=HEq-LO<|S1fI_3@CH#yJTIXyH`*6-W+9VEBP#}d)mt7jN06Cj|`<#w@}nS@SmI?MZg?n{4eGNlF`tQ zfn-s5R(E_DcY>hoaYC4*sp0JibezjlQoVhGza!kKr+ggiHa|)m9CO($yE^BUmig~k z6{=|%HGgQtb>?PDn>uJ+Im=u>b8=TUZ34=rkZNi^4z=}=ZUXe?7?ji6i7yPW4l1i< ze;XdoU$p16aQ@1_(U4qM$Iq1B@#Hn0L<;^A&cA+a)1p1&^I}8I3{<@&3>`0O?HGp9 z2~-rVtWGT2JuWXkIGq2KP?EjT-y>vuVI%zpW=CbuayB3D#57O>nU{Gy`feSb=Sv}U zM)x?e)s>uA`6#KbFj6qRs4|>S<}&yV&JU3ov*^hn*;Jt= z4GxEYbIt#g*v>+-Yo1)@)b4`T)dpwg{7V`lNqH_++%HQ627KuU3@thM$wqA-ikL$Z zR6)wwU@boSF3{2HrjShMlo4eeu+A@%YN^L=b42w4s=F!_tih~`D!2bIbT9#Yh!lZSaqx0-nRlR$S@vzgD3+;s1CdNE(Mg@| z?IKtxsP1mJ??nl*#r%-$UpZQuRhLOS%tAJ0swDzW%~=6h=|<`?i92LUQMX!3J+dz? z>DIS$WcuT`aTjwm0cSWmxnPyTk5h zvT{$sULniPRT>d?Z&#PVKP z?xc_4g1k}gQ`}pHS#f{e&fnS{*ZTaw z{xDsfs>_Vo;s5n^|F3%rKIDtj$n;q5Zt(c)z0-p@w_C6`kpF;c8^FDakea~jPI{XM z!Eo}@@@m8yuA#aw)z$ua-Vl06@&{-@xOUlg+V&@&=LY91Xa?KXwSk(81J@3zxwzcF z^Z_a5-drwN7JVFwkn+>k7xtZg~A^1>yDMYQyE@<_(Td4A(v%4}k~c(qE>)(Xp@BT)4ja z+7s(R1az3s$B*R?ij%+9`NMD9Ns}QnbPES>4(bZhJ=dZD3A>NzoFp#})D^4_Q*XFO z&aI`Rf-r{>xmw=f<)3)r6QMMs#M-!=!*}j07co4h-HZpdFQjih>HXE{^CqRXi?fHFNbCl!cAnt zdpIalx3?Tu+Rxn4&)x$^QU+o32>w3~vv35vgNbbgv7;S<#n+w0+k0Tl11J&Mz=+?H zJ)vpA+&nq|xyyY2uaH_i73ix-8fGGUjM&y}5Bk$`c2h)nj|UFWE*x0?`0{*J1_-R+ zAfoQPYM6yykO2bQ&fic?xOW`;pXv`_E_%m(MO}eHiA#IO<%OCS^@cbA%v7P&4y_6I z2H`X>fk%c?O7FI_iNPR;dxg!7O;=%?i^-8%9*N*FM+6VlBM#$Q7aP-b9pgH7O=vDB z`VeOTIc3cGA;l934&#ZW?Aa>Q&w5_+LHzg9Oij7&$tnPg>!z??;sX6bCMkk+)LkEy zt)8tvk__s$&%Ipp%nIRb{^BCrkA-oP_D#yy#jFxo=_Cg!_tLX4mD}58ix0Q0BKlHP zH$6khfui%PXM9QgUhaIar9SM?Rao6{C#!4Qh0`A*NLFrVHoDAnM=^-1-qggRn!1w3 zM>w!W_T>ACeF#=pPGnFuU zqM7M7*WD}~A%;xOXnH|=bziw)OTROkM9n4OVSQTQJTl+90%q@jhgK`X=j=UeDSSot4~X&ZD`a7nAA!MTe;LP_9w>48G$HSJsJFQv6sRB zB(MuTZ1wnym_{pX|8?gVVuw2X&aANA@dM#IL0Zf2s1iA=LRR@_2f`Odrj8QH=bQLO zQJy)6L*|#Sofwd#j}n)a<1yF-OZ13K8_9_kSCN`o14ofwOA9^g98> z7FmABIz+FiCjD?h7nl|P8>G%7nbM_VB*d2cD*7#S81EwP{x_dZ&3z{4w*>ZSA$u4L zdZ+TfqV@!rY4!vc3=3!;P)}J4Gkxm!(MOos`VMf}l0Cp>R}#;>G9V{9$}~6L0WQCU zVl?hwws@XW18A@43meQT0Z58u)jit;*i$RaeOetSTPh6~3fhy*ehYqBovZbn)R?mK zXIAy%WMz+Lk0dr`!l|qB!yLN3$jP0>@%8Lk9D&?f9CzPG_y6s292?nG{7Xb#B^FUR z7Z=Bc$t4BXHaLleMS1=uE3^hVP~wUr|B~->=ggkkkYyW5WWsXqG-Y&tpW`_Gd=Iq> z0L>p;`An#iSYp7Eu}-3~h{Q1D#AYbTxh3g9sO^K0`*9r^FMZp?`QMvM@?VK~DM?Qw zte8^H>`7PFPMSkV6D!W0)Cj5Rq}-LxvS~%pnk$OpV^r6I6u4sPzwp&K<;^cLQZ%+* za!Jd;TV&9hbdf|IYVEtC&)O%n-NX5P zdvqbNZ!*mV^`f0e5W+Q1v^5LC{WR3XpM8#Qo=^f1v9!@H3n7+=vSPQd(TruRPCX>p zN!~9@cY8*ZYkv23VOc>khck*r9vU2Gr)QtktEQiFRae^)XH(=w@CZ!ci`g^T#5b7R zB*xbDbEx0Duc^aqM09s-@f*#Le;`$Dk{o=K_+Qd;Sz<4pN6GjM#xUaGY&{X`(Vd_x zgoC>I)m75C>gQB%78D8sGFgplHjXPB6Svh||8wa^Ehbz^YZrBoat>d|zA}0}j#PE- zw8l_k6*2tp`Rbs)XQpQ6v#9{KN$9nv%^8mq!1&RHZQ+8hy4v;g{s!2OP&w1>1kWfm zFyZH*lU{A}bb0-GmZGqGZ#z&_S4xz29d%1yU3|@c{9bQ3_x}r@SH~^H?GrBpr{*4( z1*#u>SL7M{kY>xNJn5h z-_G3L5OR}0r65iK;;nnz(_G(heq?r1Fsq)^b@|D9>Spt**AL9AUaxu8lPf5RvnuIn z)matcdKA5WF*ZCzCf%Bwgh`K)w9c|`nReVJ7A5fK!@VTyrknjGH3{drN)XL_4iXX3xbp*d(_$^{5W+60&;A;7C2% ze{kW>tQ#_J>)4y)y#y85vzYl{1s@E|K02Jiaj;je59YV%HgIwqZ5x+-ql*$YkwT?l zH)}7qFOqcOU8NJUoAcJ{OFVz0qD<*>d~w6>gz%Hh8yDzH5afizIjBHTU-jAIK-4eh zYXI!RoL3)gdr#b#$oJdsPjyK5XV*Hjy@;&Q-MxjK`LV;GXfT*$y>SXK=-v6btZM%f zBza0t*3<_Qzcso$x{Qpzz3ut_7V)r*@{ZKod!nPeBYYd>TM`h5T*+JKl;NShIg%qfcWlmx{Nk{L|e;UH-7wC|Z4C)AJzYviCoM>bs#qRPid8Lnk!F2TTN+Mi)N8JtNl`i-t<@$J~ zr~b>&M&~}u@=60+=*RZ#dL-L|ciP>5!z-=kqy6woFEsVzm7eA1Kl4iWQY!1yrW44* zu_tv~f2Gvqfb1HxdL9KtigC;I2&jIr_0+aIkc%Ai$HzP;RSZvyl})_W4*g7z5$!kh zFCLbmXJAB8bS%4gK|gNJ?hHM5gQCLsTl|9`6LpE|iDiZV#~{}az@Yyabi7ZHD?%!I z#NdBEBVN|+fHUG3!dT#U@gPb!IV1k=ZQ!TGu=X7jKaY11olNOchq{1Z2=pszi*Q?Uo{EN`%TE&enVOr6CFd&Lw}#7PQ2vX(Q1cqH17>^^RF z+r9Z^OirxWTvVjgTl|7+619V3Lld=y@iB;Zp3pjt&pGMv`s-x@LlYr7#Z9fp(Omvo z9Lxk#JQeI?GuE}NsFtWf_(K=Il?rPL<7Es^4(&NH-UjWb5hc<-gJ) zG2f`3cZl9O0^P)F5-Mb)A4ATf_Qiuu{#_`yMcE=TI*2#)ZIg(Y6{Z`QsS9NtE^#zX5_I`?d9ljG+X4>iBPQy9Bl=?PVt^qCa7@tRBPQ*+Cz;QP-l zB#{=$X9yRoXug^yF4N{kh#geBVUN2(1b-*B7hV*5^{`!)cII8DL z7EhG7r zt(RK<=Jx(|kUmB0z*AJ}sBqjLJSre(iz9iKKrV|Li*yt9{BTyYX5Y%jF-KfF-l-lD z;^T1&zQh8*qr4RnFn|2aTM-4iARf&JZiJ}=6&CW|^S(cjFff(t0L20U1x%|zW8J|D zjRUjMsNIHhV`Lb!5t%F;Y7`DtVVu2M7s>H?0tx|ID)%iQ5Zi#kkS^b%=gonjb07#T zA7S$y2?Q`&Wc@*!1onzZ2xFhdP7bwgHba{%BAqS>QJ6&}8NHy=eh}$kGfj9GU^i4g zDf#y}G#3tRKR86rzhGNTa0s)R&i-2rFxWabi$k}UD%1`Ow^^7V>Z*TEw>iN=;OhQ} zG(iD)x>lt^@k_y0wp;<&S$kDPJ{qqg*^ll0{6K0L zfSX4{Kb2bl7r2>=m8fK0G_pu@XGzK-u*igHgI_l9Du*9Gx_9-^7&HVt^=qtUeN5zimNDpE`H@$6RyI&Tgp_IEH5gt+DP6B2u@EA>wW#hsKVP`K8QWJ>7yu z!RzUlq+q@fbgMAgU@|(4T=)8!!9`^1qpyL)H%1|5ZV|Zvi^ol(8qsVO;}tGUwSgZT{{= z4al)Ic3z^Ugi{d&kHj~6obVSSEbv7~qq&VFuDvin8D}&~_1Jhh`?A}-F*D05$eK-$ z#i)Dfljda?Yk}P+CY1CRlu4(mana583HB-X&!ctWRwqD45SZ77 z0fz79_gBzjsBNna#TKhy9;jWF3AgPuV|Bt}MaXPD8EjG}oe{2K6QT}nil$i812WIi zG3}A&U7EztXCC^sER`t~>2StO4Cwh0&gq5<{7c_fa83c)_`GK2F52?9JjcVHoA^`1 z**_%w3$m8Q9?N<3T|{h)BI@s+40{))(&vV;f1Mq5-;Ji8*hJZodmcQ?V0e}jBM3V} z=9uR$Q*pJ&vviwZk}5CiZj+~{&f{s@edW8Ts(#7e;zvZ?r^^jD(kD~>BZaVk$y_K? zn!}d<@xfn<)+Y`9NK_@E$a# zDB@enw@cmJ%yeqVdf;z)4ESLdAN@Sf$eK0<4c5dGOaY`VZeBrI)ZCo0x?%n~x%*Mv z|9O6C#I=eYl&cZ{V`Is}zezgrvS@aW^%scc1gBc>MqY zjep5I3?S6|{Lt8$3~{pw9`k&g?NTer4s0z^YJuq#^0HSY@3U&8k{{VhM#WB}63Eg2 zvs#X^;=?66h$CfY;)g`t5g3un2~yJmpU0lb#&cSb%|0knn~X%PByW>z&JZY5 zvyDHzWN7RHlK&t>ZDE7}u+b*HlUxm>JBD=vmc~$3QE2o!{>n`@Z^IlfZ^NaMx5297 z;oBR{M~Evy{~u)X>b{87zDAgajZGY3PP;@%1Vs40@@+JR*=+?s18weEf}{LNm>GiH zgv-@3+2>?47eYh&0Tpw0lbAZx_D{2RmlFKJh${i1G0Q&lXv`!Ch=60iG^Xxhp)q1M zfyPK~(Vv!YlCF7V<}JBSPKC@67+CX=B{QpeXlDM9B9AsK9AC1sm!F07Ib1FW|~1e_9M&@U@mm0of;f>@R}weGHe|%0FO0s8AT`2 zpeG=yKTY*RN@Wf-Up+^Wb4bgp>ar6nh`6t>36}@+Es=RdajN*yZZK&0yyT4D;)Ao6Ub&gN@blFIh)hb?!exiFfj2Gaw||wh|KB&JvO~MkQomKp$?0h{`11 zL=C!l3Bkb5BB}%J;}3=_crJsL4(7!UtAmFxMU;<uK3QDKN{lNMSNZk@9!Ik(fagNXvZIz^M|x~bxrJ=m-UEClyA@FQMI3wlTZ znHQzYA+_(4$Yt+MD8f;z_5C)XNbQRQHlccwxalS&2T!pF9nEI9oJ#B3K&j_IK$h|b z^9I@Iq(kV@k1{ave6)OHEQz@2sTB~3mv6IPE?jlpR~dl>6`Mn@s{|`p@QoiOg1_ApRdu=a1O<{{7nfowxRO_g{PH z`S!c^nA^F!_F5HX{Yxe@ZQ1EkoSh`OQ+(!6Y%k&_xS&V4=l@G<4-C=?leIV7LpR+w zW$hu7E47CU+F%|-HiA$FAkR(oN0miug&uRBqP(xOGnZX~GGjWLi|*9Xymv?6oK+5- zv;QkAFw3p%Gj}R)XLV%ol+ehnxLcT`bvk0gr4-4Gh|>6V`cChl6uW}GYuKAOK|}UQ z5-C~rMwdArjz-D`+l(OlDnMiDm6^`RwtRdO$D1pmLfB!!o&hMm^0LcQ_0U)->Y}8{ z#A?EBZ)o#}p{9580WsjW-fhJ+VO~EU(K=*Y@y%%t0(d!1U;knr`Yo}JZD_VG6f4EvDgrO23X$B(KUt=z&{DcBe{Y4K8;w#pSglhiN+BC{t3pyc3CHS1^}nadhp{wFecPT zg3U(Z4e>KIzhRyHxeuPi%V?ZNznp48;+jM$nwqiA>WRz|JwhXH*p~hl%MEEGR%dn) zh3lQ15pr+U4XkckhBPw<80Os@P1fz&xf^X^{VqJp@pDJAJ+ z%E*;HZ81~G$t0G7G=>RmP9cob>oTRMvD?}K#gCUbD0Vg)?J|XQC<-*_ z(53-;K>C6;D!X^j(Y;$8_3Q>No(N5U_c(AyjC`-kV+Q`D$~J<={{`$+Uw*tt793pwb2+5DI|VQ<9!XW*daxfw|Pn;D?l z5}Hjf8-Po?BsDH>cLe8DS&RRhQiNJ0R+VvLhQGz-HYD--mxWMk`IoeCzjKiAr?Kye z#NCTU3d2tJu zk1o8ej&R7gDezSs#v9UydUYSvukLzVckyrY(?jfQ|DCI|emo#sbyoki*M6MSp+e8k z$NOPj#Fg}uXa;dB3gb?+xSX&{4t@L7nf*%QGje)I@OG zyK2F0@H3Zra&@%!`PhM4wJP?<0}H@V6Ll{sN?nuBi)>RXL#e{Ad2PYx{-S?VPiC7+ z-;Sd8w*Gttj?_6PzZ7W2#8 zJIb4AK#zJjI_xfK=O&u6the;!0^1Ye=iB24XWyt*X@fc4z9i+Jf64h^kp=Et0q%k< zxd>e(vDa2Ct}y90by1>gv#V0HZc|vB={35?uq69phj6_4Sggh7t=OInW?z){MUMM~ zDD4Tnt9?=~VsaQv`t;sO4TbSD#cjpkF-hYB@ftwBc+U}sio7M z=6bX*i81-{w*|e$%#ih!(8#o#AeNoV$!#I8(?Q*0*ZTOXy3=6JehC9wFxXgyDP zR*Ic=k9@Kgg!8P;yUvqKQNZhJCm&M^QQks4Ys(2Rz#9%_d!R`y#DmOgKFSmb%)u40 zYV-q+&_HD0u*OI3^!@J779vz3KskQ|KzTs}e?6dlZ_z-Y%*>QNoup4*l{#*3$QPjb z+3mQ)%mmt(@gC~T2AVH%_>~=Ww}~)lhy)$&GIz4r?9l9RNCb4Y-$}f+-679OfIJU{ zpy+B2QZ7t<8dzMp5*{&c=PI0tGmD2pL07#*=7k%36FoNb+DqFqoduhAZW@jAAD&zV zn@NK)z&=7KfHsS$gg@;r>EAHm{_G#=#q1-VkRDCd9nTz5DQcB zhUZKTy6k^~PnxiL4#Bn}X~mD8T$Gp{;IyhMiZ~E#HfOtNvhn1!lH>$*S1-oSTjG1= zrTn~DiCcWraHjR2?}EF~C7=0$b^XBNml+f*#G4ko#DY0wl#qKI$?PafFJ;%%(=WQs z29nu0iB9bDxP}lY*&ifXn5dr+fPrpn=R<8qx7V!%%}0|p&5m#<{bu@L8zKr2lNu|^03M}9 zGk>AdfoRQwpsb5d^T+SdG{M7e>k8f{HK4e8wgS%sy(4>uP$z^A-7h5997D75yc|c8 z^&%2?9r3IBiU)i>5Gr|jS@QBM?8(qmk-Xf3z6Filawqw)bc-K>dGcWadGcX_IFAJ4 z&d#-2@J%Y(>APlgANUU+3ixl~&=`wm;}#46fAWfkfZ=ahUxQY|0}3Xya?>Ik9p{t1l&I$8X*D{F7STuzC91(++` z{{}ESec#^H2MhlYU~v;BdJBsRVsZMR;(lRK{*DKWt~>f*ah~9Ce^}f<=f8x7QdPT0 zfCe`AUC(V8ANR?dcgP%OB<1`3S28gy6K|i!qgU+07d{R9{^)Zfdd>n%Cq0Y_;C5lz- z=w0TsVZw09=1Wf&mT;_;sjOzyH4{oCJgUpQLIJxWH~v^)R=WF}*$w$T>g{V?eepG8`k@;v+GmXta@oKE>}m#?+2y{qzL zLv7m3GrX=?21VQETy%={9nZ;mDj|;OJkVK5iZhH#>?T#6k<2QN=v;@tchS5z_c@}I zs5cwAFf!r}b4Wmk8=5OTX#8XG8N)$oH8-(O#D#l1zT+j4WKsHEE8pXRKe{mK9E+|r_X|K{9MTuuf%a&jr1)sssfR~?Gr0P}Jk9LZMqYCH#J9?$+R^9TZ* znAs=+$w&!_#*)0IXIq(4+Fd5gBIe5k%hLyBntsYnW^!Oj?~TtT7D7!A5e#tAsu5l- zm(jyuyOn>5 z{#I#cjc)w0kzO7R3DAgfdUtw67Wv&LEDgp;3;oM$TFkDn2rZ$ESyXmwCYI!-0BC7FyH%N%bUL+$!y_4-8j%<@p)5vvY+ z%(n&!yf7hjnf1st*>6VVz7fyuzJWLCzzGcY!3LzipZJNi3+3sJ6(%k#Bq2m^e3)0= zC-iG?Ozfwy0r{%Ig$h&_#d8jkqN^kjHvqcZwCkzT9kMmgosR}#5#{EeYPQVHWV}rG zPO4Q=5daOr)>n}afH+jG{YkYB_`{G$`@C6@6w*`e$zOfp12na}s&}XF49>pepUUCy zWb*UO`LD`!s4lh0eEwa*jV(^iHOl^VnTIctw-Y>$*r~mwEM8oD>n3WDFtD}h`2x#d z%(lyj(6T3lUd9?ds9cA89o>vKtP~ym;MdCU{B^r7J6QK`1VYbEIy5?l3qT3uuLYo zX;A;)N--h(`}+L$=>*kzRhJvwUvtq@~`D{P=-R?Psy# zU>nN5F0)noF~(gulgzsh;U<-dP14g+^nkF*GdWo2Z6NCvp3C4dt$25^A#`>ix$K9e zI`%7M>?qWP>Ku4J*qHGNlIvdmj^^oYH55tZD0SYUG5X(LS}Dq1cbWjW=72D2NZ_uJD& zZT+5Q*UzQpLFIaaX2dAL8O>J#jaU~ujO4{AFV8MYe5$N51a>^E@#t$QwsW;|&qrGB zc|wtJ&+t`{RvImc&?0cy&9PacHlyR$ew{SXesm7k4t1Wuge(70t8LqE{x+F!#%yy)?;L>3^tT|a z<*hAv0f9UXAF-bJ?KmZr497;S%@Yw%lA;iRL#9B=qXwln7omUpRtf$zR!5U)Z$xNR zosoDCOK^H&m#F;QXYJ0laZ!)tNmELz#N)m;!HLx5?Vc1lDpT4V6S^h}AZFH#X%*zF zuXL(5nC`QrOF+{Fnl8|EfoAGkL5_q-)t8y~M^iLa+A&?k9PVeLNS0Y`3k4_;s+1Yc zk$|B1Jv1?!tUx0DuPcua6Mi~Wxs0vs1j||n*cwFYJ#UhX6_U^V!w0BL^~sOE$Z$wa z?b^j32}-MeSa=;PO5&q!@yDYdo=s2BW8dx6oL?q8LAaeR$j--3@cu4#f=lGgTh+?> zzAZZeE`T+cRH)nfY*|^|W~9iPR%LY{{)@{YGehP1ox9P^Zz0VbjOw*zp^j~Zp^jaJ zoG6lsv0*?hHk!-WI8nDA>@Jo4f`}^Eif$7

KAY-{$YnlH|cF$FBz5&~!jX7r%mv zxy0+qiC#~R+ne~BrF2Wo1WMs^7Ao_}PN5jP2*jtmbNA`)Ch6|u7i)Jra@~a-b(E|Wb8=Bkd!VrpABur};xXz#nt@TVp#hHl%Zn(^88i!W>ZXZd0RbI)~3^ReSmtmipFETY5cM*2~~NrLSUP>(KIA* zT0lsk5TizOhY%ySB%rntwkT72kW{@d?X~?^a!w7QfXxYY2nuppeFC6gv`A}R<~Pm! z>JU8G^vkPk_geGp2x&tl)a}jAbb1xc4mt-XZ(lZ#?^CvEU|9=s2A%ek>wWzo7U^v= z*Rg{i92EP&RN*#}lXTCmQ@8^DSn(nag!xkuh3BhGlZIKeCqsw|u|;AZreAVu{~32QBgf1*2?+}0Bb7_p=*dOf z8unzGCtC$=$|{L#4vj^!{Cs?YOv*K!>!Iw5vIVv>>A{AcnBu1lQ{?^lP`m1n<7t+J zVtV{5$w`(?n9hNa$4i%SLS;9VE<3i%)#ltEl5;1qu%ajiaq2Q}7bD6->G9i?le@3L zgW#IVh&|&?IRuN#@>kUpnvw_Aeb$Gv`F&XnYBR=+g~UoH#_aU9s8g-w+{bd3l6inY zOwmt5ABxO)yd>l%xfq`RX?1^(rfy^h1hf&CQ^`lj@)(9D5fe?v?n2Bs9aR&Hj-{pT zRUOHRoL+E>ME6yT<7pHQED%jyhPeQtrM_ltdF%w`zlBtMjs`G_{K%ri6MAA%mi&oK z$J#%;ku65jz=eA!R**n~v$JtK5E|ev6G5<`bIH2J2df%}Eveho%@WGvU-A>m!H1Ej z4MyQl*!Cic%S!UxiGidIM3Al7y32H%dtsi%orzb5Ds4kI{D+2KgFTmqW>8N0ca9g~ zKr$xVLL{*#KXy-MO5oop0CGJ%Dc3{$anFT3_ z50VO(FcdIO$`}diR=wJKUwI`ZV7g(P{NdEXd|4tRa!Vvs(48LScCk(-<<<#1esVFK zkVZzbusM8yZ_s1x#(d}0PML#Wx7#h=Y^l;WJ|<{=#4&=Z+hnzna&b~_wM5)=OJpXG z0hN~{yODJ0M(ARJzvUBVs-C2WlVx>uv88+Lp4}Xme9miE4+pdd8pwL`-!htk=$caI zV+XQocCPC{N|1D?R*`XQfpcWdOsP(u@|A7d(PwO+~*ZHEf<(35%aqA#3*L;VY8HO`XGoKg+7QgcSt>kt6o)vfhg1nJo6Cwh$f4T#lcUI&>Y385hjOhCr6vW_Cl(~hev8ICOkmMiK4;}W>~D+ z0t75MsRlx37qI(}-(KQh!TdAID0nr;ykuX!=DnI@UeQ-KtM{|{y?y(PzV)81^a?c5uDQb&_@P%opWQ$f}+b*NX;I6d3Ut;L10T zVr)rLOeDvbWkLb?d-i$!zjpfWQ_F~zQ^N1F&p*DFqP+8&i?CQ&jTIBp*(V6~n3)18 zVV{l{{xMbhiAP-nrUTJ4*CUT#%lSM?ry^{mwqF;~uk~O0SN$sN*RMy?^y{cxzn(we z_A47Z>vava1Lkcpj=i7jUt2=^H!at{qX+a4@A@Q3u*r=rv7?^S{$oe_>0cuIojDd% zRr-!c0r@Kxj0A|z*5t#I^;BsTU>2G@4`0-*i7-AUMS7xNoGJ@pi%^{d6DaE&3lRYt zi}Kb4(PE3VowVga#Hs&)exEZ-nuAm6G%h=%@Hky2A9qXSqT@2!X!AnzsSf_V6&x)fbu` zD+(>?h`n=CJ2?vm%8MfVkqAcOqca@Pg}3d2Y|6;U2{oHr{X{=~Bjp3Zlkhbc6|D^= z_KelTtbi13c|LZQxz16!_+&9X1pN=J^$ZDOuvRye^nr376q)seY)F`+f9e;qf_s7_ z*Bjw!W2e7^Q+o@@bsl^9IqZ`yjdA$i($|6nK(vF;pRm16jhG$d&VXWY~I% z*^N|)D~%E8iYlUN9XfzRq*UU~JtA~B%T~@woNUGH=r0o8n;c4E%2uRNiBQ%0eDTUT zyCOFD!GhQa-dyQ>6a$+QZ(#^qKin%)-S&^w``0FjnneOH4d;d^!rf* zzxV0)e5j2TX&$jxYHM%aZoxuo3BP^cOERS(Ii^Sk`qPjzi0D zyj#Y++ri;Qy!S?(DFbD3@apD!cqJZ~zEyfPsYG1(ES~qLnc^VRbC5vB{?mJ`PI5n> zt!cD{YXVKF8{r+&G&vhg_dRTa6y3w!20d;+p>o+yhb9#A%_A=k> z3KLnP9u}1awz|XiS6yxh@_A1!u9`f_>2Oxcw`NC`RIrb(>q*d|pRTLlTG_o)hG16e zcUy$tM5vS;sHsVk@=|rzun}FRn@msiId~Thh~K4esa{R6+UEhTC4J-8n88n1ih;?T z+t)S6s^NyK^Ww{<1%nJoFVNG;LNB~s)^zrtg3G$s;OzTXoNu#l?61OrZviT)xW1&K z+-j<_CzCR#GT$$Q_ugj;ziF7J`rn_|toOOTH$V&nY%k{r6WL{dF=$?&mp8Zx&B&BZrem@0oEL=c&dK>VAq&mixC4^GDCKLsLK^0< z9!VUw8$!ids37-rU(Wwxb@rlhDL$1yn{(cvH+w&T?~r-o%xPoxZ)8^vv=RQ$fH+Luij*MD^V*09RvkuoiN zx0Yq)NpU&jcYH;r^evt3f#@GqK7MH{q zJ#}5lGldp_nbPW+3@ov>#7TUZAOFB}6{{X-6I8mKJ-5dZmO&`+{ZFHtFz+*q__O!% z4Jlvz4uKWCRv!+i^O2KII!NHTLr- zYoPb$Lz$8+yP_ZU;R|Da{PsQ?Zmz=g=n-xYa~{>N`(sXSK2pBl@@@b28l}C(`?Qzq zUt+KFMN)psKIOH4IeyZf?<1_+j+IUF!3p|-(&8Y_!64Vy>}guEpDXCRy&{VOXaJ_4QCo(%3( zN#AKaSlK9D`SA$?fWB=3eqCfr&B;VBs${&$g0&MGWUZ~4Fx}&nyoSBzv^~$gj(wD% zk~rH78AU)*_RB8w0`tv+$GnXXLASYxVWF5al{vF_IGiKU@eZkMccN!uUC$6|+g|G%^m=~Y4UapiX^r~)2Ru)=TX^@` z>)OO#Cxi?^=oq>LAg{komN0#5=HkET)+-Q)|J<#y*=}9&+JJ5q^1N-*boj`pw40w# zr?!-{BD>#jj{QWz01Pf*AOeTWrNPt$ioB{U!KV1@JqxotYIcVUHDuJnYS%-eOI!fX zZ%Cx`N&JicligYT04h?`@-wAnRG3|~1J^^JKL>Jl>V!*{1Dalr@#Gj2U>2^8=Usb@ zGkarS&`PFsO#cDA>WtnRAHxJCo-a)7DO|LHd5z=vJ2)f)y3A{Jru5!(1%N8xA510- z&A-5`ha5_f|6Jdy--e=cQ0O2GK|lYEKI+7Ja@Y6Vj0)Bp2Y9D(u=cz%J>;T4rM+bu zYP(d>gLY)}rr2n4wRABFW}*EV6SNn!bF`T$(`6&*h|M6Vy&_3vzkfM;yCyU}-(XW? ze=T4+G4wJiE+JF*&_wo=p5uP61XucR_Y9@<>X>3VIB1hO7hA=0aP_WR>0FXiHUJI8 zV52GaEBmJIR(tIjwgrWY*2d@O@j2KJYr#%_5>_HhkA+2)#UEf7^G29s-EAJ_lMO+` zs9cVE0FpjAqS#tDCUPfB_ahR6Er@w`{L zM0;>1y)pcIG_B<`~s+QT1D`Uf20pVNHAE6)}`mWP#J&Fe+ zE|tEKef2Z%)ie4E7^h05KK-oCd-r4eu7r2p*>_iY@0Qwk@Y|(b*>~r7@4jQ-1$ehM z`|f1#-4y$dozuff)`K-Pd-Qs@&wuM*7@)u9xBQg=>rQ@gpYyjoo4xo$_TravAwkza z<-&1`D~Q~TxSNgGKb)j*B)7QjW^h>Z2+p%~ql)18U)M|d((S}G^4Si4%*(@d$@ z6=1NH{3`4Q)Du8GPCe$xe)YU6H&V~>{p2m0liX4_$##;yl4J=gat`RK-(!duC>^5u&rz~)nX8U095Mfvp1JFY4w=9KqQ1L z+)Oj2Jc0e|+OzG_dYwb^_ z2h1&Ejm*h#uO7vb%;C}%=61^7m3TAJN0ddCK0@d>A;Q?x(WY8-6KEM78&-v4LxqcIWm*(!| zGA}-DWhKp-tw-|(l`)b|^S4ihSMkNAy;SkJ@&lmZLyOP3*IpB2I+)L3NCU0X+0v~d zcJQfW23)?@x5ow*O8;llf3e3j;06+ulX(L(ra7rOKjPpoAs;warlis;iqxG#xAapd zRd+4-KWF#xnJ=ib&G#x*o>n+-gzMYD)q?@`up>4a3w6u=RD{<}s(xiSHGaN1>}xFU zy0--vpIE@F%aV1EbFA0*sPWy_i=J9j_jIAZ#P?--F1XtbTYp9(Jt+3oM7jWIrt@Pb zl3i8u>el@{>S9H2k9{SA17vF2Q8e*Uru0Gs!y&gC((Ij*GNB*0Cbq^f7)G#T2jH;$Ko&*7(WvEy?v7-!1%w{58oB z|ICTn!{Qe1pHy^sQuczxvGb&W#laj8Wj+7bhD0*}UYt!JYSEcot_0e7W`lf4jPc4m z-kWFjPP8Gw@G$V>$)J3MW$oZg-C zouFDIR8Q(!MmRD|O7c3i%N=D#`~gW|AB3Fo1Gf$_Ux@6xa3=pZ^8XzEpUeLXoa9qY z(wXE_;DP)I)w(SC)IIzJTc7%0_Thc@M>etKQ;*o2NA1rO_NSd68`w-8FW6^)(r2&P zn{D>T=(FwiW*0xSg$7UB8YECoK2>CYO6*S=KmL)406)p6D($msekdQbuP_-)iJ9`Q zZ_|OS%E;fa$nK0$+GvqBtI6F-p$eCbMOOs8%klPk=#_M%c@-}4xE{orr; z(fa`MK(4$^Kl+#asO$mW{v~p)n064j)|)H759=nP2jo_y4+O73MEaYxw#E+bO&rJg zh%U@5lSyd$iQIDBqqLPJq)jVjw(?@dYnt`q35w*w#Do^ONtueU+mU$ls0i6yNH?J` zU)n~o3>9ly0E!zRaOVmZ%s-rh=^lK@ieV^6;|Y=+&LZF zAWx2arhpdlHQ&>{!4J%E1mOSXoQ~`c&~qyQNiTolx;g<|73m`b#Gs&N_WaMsp#;FXY#(%EC9Pxwu3dng{UV(ApI$?7}@&)z-< z>2PjYU!00eLD=O0h934>mCp%dt_-o}W5oP+J z2{=c<6Fi6+#z`jhsaI6j6HvM`ch+cw9PpPsdqFh$m@IK*YOWqtfb0%&R$lUB$YN#BMbWB1Bj!GAp_)Fhm|ntk@M6+GhSLHi?=iaVh%6cbv)o%Be)k~I)) zeMlBg1jCSvdmC+t-uOq&zA7Fp=g2Vq&_+LzRfL3&0NQL>ix`7V|?_wFsy zO}EosA12dqRi`AD@w@6NHoCKFz57z~Rw==8bqngM^24Lyg!9A6W%4Y7Mbt?y+s0*x zlTDJ#gsAfnL|n-saoWnVJ zd!uJQM^T(?Zl^mSZXE=p4FB?&FY#$%9Q#mYfjB1*F~89WJ&%So3k`9Uh6F29ld>d4 zo+yoJwny>_jR}rhwvg?%AMsV*Zmv@I%0#09hz-U`G;Yr$CvE5nzxHFdIR^Gn7`2~p zPh?_XQ0xf#DUv99ASOyT3_Il$@S9sk5rp-?nq_i;4(p#lMmyt`h?=ou2y2y`L$?an z<38A~KNOP_S>GNHV-~SQqnoo^pwlC9gAJ(Nq}xaqoHUYDH_(c=HF=Q14tcW2LK5?*BBxlFH|AwxvSd6Ns#aOcitdVivVpMVN{ zEw5P+KT(VQhGP4k%k=p!R5oX_v!?L@;asK`O8vWYnLPOQ<%3`%Qny*+$TnSM-kv4X zJ8^+~mu&w+E98vH4H^_NQMStJre}m&szG6*#qtQwsB&52E#}TKw>(IRqy|ZC&u@E# z8FrTn590Fb5q%|pdG#o-nw}9tnnxa;jO6Hr)X8>Yxy$iv%Ty{4crj%GgdprLRYp3|(V$*%1CE>P z`2g7ko58C|!iXGXnpM0U|Bjmz<3L66X7PwtSdHg+naZvfEx0wbX?d&kRLzoL=W zCi~$P#96ornGV^c--BU@;UIHkFfTq*lHQ35=Py9Xgq9BEPT3M~QhawUgm2d>lu3g2 ze4AG`Y>F{vT^3hUn^4@1=7kZ0lDnkEham{52J}~5<_wXvArV58SA9)FnbLoRzGQVY zs-pRDl@;G+sfy-BQO!h?GekwRDx92=Rng4Y6M8bpkPvJ?SU{fh8EmSh5A$g_S@)0r zYML2YHBD>Xb0}@Lo3}oc`Lfy?58nGZ2QwQ(EAvD?s5;33D)tt~tq9u#B4QI;UW}jX z-YZMaGUEB-wN$^r{6pOF+|&wQaKM#4>R}XXlE9}gd(Sb~Z6}}hX+`N#czzBqv&Wy+J~V3oy2E_ z^Xj6h5KLTAY67VQ3!Cf7E$73+cg+dzY8==Ss|wwZYd6i?35s)g7}?`V+DWGi#kX~NH&VVU=Ew(r`p&w|TDG@_#O5F{DaQI#hbju4}d&B?6ybCg~3E{!o^E z_q4p@pXe3DO`O=X1va-$>g*Dji%N46Rt{Pcot5{fXY`G_l5_Wdir6|FQP~v#{90Hm zRjy}Be}b{VN&1dpxU#4(r1cfNhV*4hZKK1dMTImNdk10`OMjCB~g8J@Q|a zFSh01IXqkb4qN^Mda}RzU%$Y@HCO&pDbGL4R|rc{JcMqVrw4;;T{_taTL+vfr97R^ z4i0fN_win!&C4GAZ?pI%h;??!06k6O8%N}=36-IC8IB)PKYh)SBLqMb0#;w+*Sr5p zUjt8;RnKJk8JzMwA)lOj_ij_%d&#W+0F9vfAxx_DpNEEdYLNdM)-KZxLJB2*E-N}O z@pIW+<@Q1SP1&qXL}Hf1uP>}eoDEm{QBgl+O{q@LkJulT+9PHCeWcv#}>oPwbLhYYb_toB2)t(%joCN#-C{-kv z{Z9YNe%Y#_tVxYjN$QXg45a^kOmfc+7)F87{`(Z5toG?l+b6*T$K8xvEJNs-QA|(! z-M{Xad&@s&eRoKTpt%7o$a%+l?=o+I`pY$0!bWp942p`vU1mFDTb_d#8&y#7%i0)_ zN%0Y%(Jv+nN9KCBr=G|o!AjJ1a3YPSMXGie7P?myrs8A_E(q0bU+|6S>^*W)Z)7z5 z#e_iA9oH%GaY2nO!FC-khX)zYl0YUIV;@G`=QE`z+DB!zAH@qZ-RY8kbvTLg&b-XV z%m#N@?T+gnShkQoQ`#SE$8aGcr$_p2_=nmXnmc5Udd7k?eQ=U~7v=Im;Qg*iAa;ub z!DHJfE<5yxjEcS;rimK5&1~gsw#b{Oc_WE9+g68K$t|SjF=sE6zsIBWw{wuk2!4XY zj{zRXQ7wZF3KfROtR>Hc|CYCg zga<3-K?*XJ41AW`{4_TN%Aal31MqAc$Ellru=;^cUd0ZF`wF(H0?AR$ojQ4-8SG5Y zF~9f>Njz-dJ_ zPFZ}o8S?WlY@UrYEp>5h{fe}3p^8c@*PI^8u0?AP8Y?*&Vm?!PjJK((tSxaZ**uZN zw&db{iR!2#q{6swL~+JA;T-W#*cEy@zfd}Z=-ni}VoP)-GLn7tnoQ}H*hwO8w`^MZQ!ISCYIKY2;Bn<1@bN?$pN&WhrrcLrmgqN^$gGicg0eO7 zv^RkbkfES8l?(ZXUguZ6xU6KgQ&rsa2bco4BkSX6hss|tlHzF;SnCV%SDGi!fVREGsX8)$vG7obtNDebQj)O+`7|g(YEa=KN>}lS8&lN@HGBg!8_|w6%fQ0#e5^e4y`yxmSDUvdgMf~gsV^1%np366G z-$G1J?;AE;gPkh?UZ4U6dBUUDpqJGzm2?DU7jl^0z0Q)PNjYp-#4{QcnKo0pXH2fa zFPX<6Su}V(4QjW<0Fx%wjikwIV)3ou9l>-I;kvREBnfT%4Q9$EGPGvt5Bp^2ETx5 zuFNU}4q~?VRtD%ay*Dds5vM%sScIc2b$H>0%a*^;cLUx<-Pavb5f$)@zr*9IS1%(rI3ORgHtTeDO^+=9 z*}m^k4-~F8>iVWq6gtfeLMC?Zh-BKMN#CjRaLJ2tY^cRw;yP2>3EE!~M8v)y~MEW0_L*Y04zF)TGR-(9_o%h=$P zUNr~uJez06!wL2$(=}OUTNCi1#D$dz1;y#iiX#`uqT;gW15y$r3;LRWlP?yz0e%1k z-&@V+rw+$>LlVtPECaAh#CI4-czRqe*$ti(G!q;rz*kS`i^`&y2BXUNsKU2P$|iIu zf=@33dYCPb2RO@%F`RJBw4*Vv(vF^opeBhiX8rFjC2%6}3T zZf;;^kepBSlUSs3;?%WbB*zC;ijE>$MnZ5cfcT@>HYl-Us$q7Zh;rs%BY?%KK{F3M@TF@D-qM3EG zdTyf~nI9X^ySIHY;+{{3KGtYfOpHiP8zb)SXlg>CLHnO^>k7*+>)oRL%$kte!%HR< z#zqoOlMO%JV4fKP5UjQ)$A}Fu2r@pX!e#!WTIddCYyS^>Zvq}wku`o-H%W-B4YInn z3L0FnS;WX9jRFP*ZCNxTN(T~11d^U4V8E>v7a-z9T!wLNciiJ1TpMr%*NHf4+}ph) z&P;S1K}Y5Low~P@>ZUWV&O85ad7iKG{7%)aI(2Hfb?Yu&_onMROFaBX)PfBgeDk(% z*tv7Dhwt3K=xg4eBd)c-S^qB2S>$${wWIQV+kRwD@>GQbr}gGp+fK8;{A+&1>os69 zqab(6u=gf&66-hlkj5$9k9nhHa_wFN*=hWfj5n(K%o}&%C#q%2>gzdk?i}|*2Z>$G zC?YTI;St;OK6Z}myW}}sI?(F?ip0s!RfI_Y~L+QI(Cbi}uBU;yQnl{2>^wnLzzMolFX0dT3Cg*kk zg^6Qvc5%{r%tCT1mOjnr!szU?k{jrBx;c+!>innSuBVWiyse9Fs?_pK*}h6|R}ZFF zht2C=k^N$^G-u0B7C2=OM1d=u!FaMMKAT74y^!redUOT2u+*Q%NY2w^n6~xf0ZPM^ znOtxml|AU#pLg;dq`6&Z5#UiufAKoJbm38<3H<0WyMgcaqc*PJ;^~tQ+1UMwlUa?k zv0p)l*SkM4E{8{?(aEd3@SiPu4VX0Q_3D1L$9I`LYC~lwe#!2zVe+VWB?EP1-nNg} zU!3D)Wb|6TY=AmXLY)|gIrz?h!RY6HziQPx$$RP8VO!~!&U^x~W5H#;2lJmn*$uSA z^y2~Yzd~2NQ=P?w=`P77e3g6E%gG8n(_qH8J2$fK>|Rc*9IX6PzQWFoa;8ci?siQQ zog77kl*PRuXQYizDekfH6cY_EM(i2i-n4Uz3|>h$!qN5H_K17EOG08jhqnk zn)}gZQl9e+UEh&8?gqg zH)oH=C}U0Wemy($Z`6gi-xrTf=88csr$3xR z;Jowoo!MhBrTd7Noa64K;J!6cKwtRzpYeK?V{&>n&%0zUlz!3IEWuSj)Mo$8`jDPuG!esNThx)z3%% zMn~~)RJb`jdjeOh&xh$Frm#+%#}AMn+SE3_-1y)Da$hgExbl?XVPfgA+PCGCHMdil zwxmDUNk?#d_)>t%FVZ@s^%!?v7Z?@20WRSu6D_Js2_ z2sy3d+Qzf&JU>4i%K73O`TZ$7`5b-AwWeHZ@|03;R5-YtC&|tH+X%USYTikUv?WKl zbB6qLq@BG_;=WbiJe^2jXK$ZhHn%*vTb7dJOutJrfD|h`_2FqGHOXJ!mp3zl2Ny75`gdpVqa=m49_4%` zPVQey<-{D8|9eNb@QE`%dc_C6WJAB~%tNG|y?@+`e%j1`w>kGA*}3{k+S#uh2JUlk zAGeV&cE6Q%L=%R+$Eve&7q*mFmn;F+M zsJ$^sH49c>(?lZ2q<-wNSyC8rqs@q0ozSUTscqEpag5dS&kgms6Ppt7%K?7AHhsw! zNn~V(3RYes#YjbTwT*PN3sTc}<}9Re6CmHm{hJ?Rh7~x@5bJ&K0_3R29mJVQJSX)tCB5hzsT3_Z2f>6Qs zMmE2aP0o+hm1`B5czvvLA2yTDkpDsR1~*1+S1UX(=sHN|x19qwQUi|j)m{6u-CRlM z@ho9)!rD&qHa=ijusnA_l8@j>z)KnWx94n+){*h0r~HD|dmp|@GLOl_<1@#sW@JoI zbUiZ*-$>^Fcz;yc?9Bhn+9~hctlqnWllP~Msd=m0$-8slRQB)Afz!1-Max1hXKFc1 z%QLkMYdJ^DVlC%sS*qn(S}xSGT+4`-m0DJ7xkSqrq&dgz9Jp(Gjn-PG<+)nQxOQ^v z9GD)zb6}m;xkyW=oSSqwrscz0KC0!1S~~jg>hSwkd_spm(eg7b<+$EC(6O^dhc8B& zy0`gl_uD%YZLw`3D}CTsSSVP%D$aOnzG9)=p{(*t_#!L(;jGqpehF&iO`h*9 zy|1kB<867G-EdIsE|cE@RXa|ZOPsJyUcMo>`BtgB zla)5+Hg9a(Zthmnn%3N@tTjwq8pZ5<9<`cMN9~$C-AZ1Vk}MNK^B^nv#kPV>N4=}p zayd=% zEwdawJ+MYQ@nOjyAiPVZ^OI-DxA&aU=vLr8si+Cd9$&pm8~*ehU9q4T`_$2Cl!M{V zG7?s=ib?$0XXtQ&g#X|a9+dFCj*ef#7f8G{e19LeD;7e9-V7(7mv7+dinZ0+P2?DA zO{C z70~;I&)b{>F68K(Bat7POw(`_M@%@E5w+?bi5Y+qVMmg~KuLPlj)t9W5AXi`kF2#Zp z;DyHt1rqR2u6=oO?Ikg-%P(cl?pyPT6ve}CCui-H;N(L#@E^!F6?A`)*Coi>A(xM$ zu4Zv_!Kh~>bLAg(RTdNDRHbbmyB1hXX z(?T+>2qdfc!e!b4MSPx2Aju>7(o~&0=3BEy&+{w!Cw;4!WuCxk;#v_Vsr{OWAw78b#wAaZJyg-&pU+@o_)3s zhb26XaBE$k3=)Ms8A8dGyVyI)u_2{3?c-b ze!XqL?7{|ZCv6u>WO5(daG@Beaf}5dTqxmMU5Gwk-SDJ6LZxh7yVpN!ZLhn3PHoZ| z!=k|<**uqwW`CV3Vdt`qv~crtZ@1}QxFJTC=9V|@D8F0=G|PVoaWD4v`)6xdSL>EB zl;3Kxp!wtP?DTN+>nYnc%^R%k3pdnBi5u6qRmxrbHjM`}#_EL|LQ;vz-`Y|7%4~79 z9hEO9)=nu}@{U*YcE0-5wp)Ef(QyUIwV#@f+a<9ydCsnhwG;fUSEYX5-(+O$CKWf= z0kTJ$uNrNSHR(JQ1Ia^M&83~$CInh`uBeeJtzMDPHJcISWWfWYar_>_J#SF$a(->A zu3w&0N?Tr$Qn#9DRR3^kI)oE4%O(jz*Zqib%4#HdM}*qX?2 zDTG@F=xz7d8!u7rWn_b7U%jeE zin-4Ti)wSM&1`d*mD)tmF&Sr^0bzy!9 zU$(*?!#kWz`N`6@O!iLWF_E^**YGQ|3*`SsGLRBvN}h1H>^Pa}v~vnfy*lL5!>QCY z33Mijjgi}r$tCQsK6K~tevC``?!W(&e=DQ^0igSj5u=jk{6oq~PQfoFALi4E?G&mn z-SYHR(=~befVeSVyyZW7EBT+2?tfPNVXbs2{~P{~>4x(3N{iNu!2i+GgRZ5s|BWSc zMq{@WCSSTnewUJEM{Ioata~|>%Oj#)F1AXOH?}F4CZ9LT?{PO>XGYK(b|eRm-oclq z>{RC~tlWKH^`RLFZNnt$%v$-$B^eSUPGUjwwAMsZ#I^@oi(|a=J<@V}@I~2IG%T3( zw`OcBGVCPgCp)wz8mr$thgJ8G_~)ZKEZWUec&Vn%fUKj`L;Ixnas6LLG28l{Bzg!)%()v zdiv#81lgr}Y^=oA$|(UZq=BD2xNNMQkauDJ+^R*1>Moln_$h^_lm2b{Cr{)R15D)= ztju-P3v-h}iCft(ISXH`>)}ULel`EUhE?OcRxv^qDR4$1c0?)c;w~7ktR+cfZwV7DOUDBzcZ=z@>2%~hM(_>4PkDV-Z7oC z8|q?-C#P*szIYzG+vPkD{jT^Ip1}V9?*DB)u>Sy#C*19W9DkMTSG)d9*PrP62fKbB z*WZ!nsF{SmG|!1a5%{x1hQc9X9E7uSE*_1C%n6|P_H`tw}>c-J59`g^&)*Y&>|=-A)t z`VFpslj~pP`e(ZSWY-_;`U70QkL%~U{!i}yO1ggJ0H>VGU4NbH$6bG`>wn?;-?@H{ zo4=3iKkxb@UH?SaFLwQlT>omfCuXFupUEkC%$M59p>G}g)f3)kL;`$3+ ze~If~;reS`zuxt~cl{>U-{|_Lyq2``=j`W{f0paFxW3V^cDI+M#gBHkpWWZd|FG+? zbN!3l^q*Y6n;W0!`p3KeJfrXW*SWqa|2{YW7T3Sd^}ld^qjyExcBrS4s|wZXzv$K5 zku=}ruixUNn{6Neja>2vTwl3<&}zv1V$q2 zL^O)P57O2plbOBI-r7hzQ7&yoiW;5iKGDK}1AE zqlmybL`;P57(_@!orp#ezGD%A@rZg6z6l7wh@gnDh^UB|h`5M^2sII+A{s@si0~bU z@QVnFs1uP8p$Z@*A}XRzL`+0nhmI#yFCs1?A)-Y@>;!~5349{_A_5|UB0?gxV~D!P5s?N&Xgwk(!uPaniinD+7vXyb5f)J=B92h%SwcY( zVG%9QA?h|D5(wqnh={y^2)>L6i3p2`h=_`azk*1JP_IJ$2MGUX7>J07il`USBEt7M zLVbYPSKh?off-w_cJz7|CA8$?t@y$JO!BoN-{KM=w15RD@0zefbNBf>in(H|u4 zCxrSL;TI7RQ70lHLj8gWiHL}Zi%5tF>_mh_#6-kJ_!J9210td#Vj@~Z`1rVyH!LD5 zqESSPh#(&W^oB*$i)a+#?|=x3s1s2yLh&Y>*DoR>qE19Ygvv(vMMOo!L^SF+)~zvsFx8z5%sT0=+B5o5x&h<_oQUm|>8A?p5)@P8{I5sB@H`W=Yi4~W2z2#!=XSp@41bRbkO zBACTyRQ@YyR9 zB6HAd6ycvMp%UWaWr)B6Hd_`V)FRPCsHli|1)I?bBKA8;sFu*#h|sx+gox;Qh`RF; zjTcCc<%mWR(TinMg#QvmSVTlborro7aS@FoBA3agh|mhzT#1N@NQm&QLIg!bYY{OK zfy)uT)d;_ckO~ln20#S>%S5a6w$bbxWKi9e0&+h z8(1rGvS`zHy(HX#@ZW?;+=2+-h6vq(h~J5btV0CvlQ(9ls-sbj1``mmw{%przd#IDocZ{>mt&L9S5?%XTk!znjH0^UQp?&VF zw9kEs_PIUNK6fJ8=bp%kztr)6ZGV{O9^4n{{M-v^KkBxJyFI;~INYf>cZ7PIn;-3S zZ>N3k?3{R4pIcPD&F!o9xgFO&cemP)4squ+Bf~cjg{W!CR6*| zq&eGeeYh>t+yCu;2%G)t?&omef7cH@pwRU+{Sa{bfu|BW{{QKI;AUFaBYixi_k$T< zJTB7ug>E}|+@rU-A9w65b$sRaV|0$Q9doz2d)0dRgPnd2xbww-s~>n^pzU+_t9>4I zXrDWC?el;_``qPg-y9F={lJ3)ou1wgJXFx}+{SCa!97lR*rm6BYd-|tdBx1XJlfKB z0!RGs#$6!o_{(+e@c>TSH~Z80t@|r&o;K-ghdTA)QC`OUM(?-!v3$p_nTL&U=3}1x z>GIO&BpZLUuGT(x$WTDvu?+)J^t#Vj=pc0)31U5azCWcLp*oY_2V(2_IX;WeI7Y# zzrA^gr&7_c@PmNXi~T=*J!aaUe*TTR`^#L9rH}hYw;lY_qT9iv zaP9NlS^H*x#NG36!nMbPW1U{;=I3`8z5UFlCH^@@)pJWriv5wwin%3KRb}P#5A`ptSnOZ4xT@M;v81H3vaGnoq|PoYk1Vd9 zy$Hpk`6X5UvT}cQX^G$6_Rm>ZF?YdWw}5r-btJ#~>3Yu&O>wfh>9a%ADi&AHEiv_J zbkBq4dMV(Z*CIzb$2C78YCGdg7M4^~P5;8O@&*3NlKEv-)s;*Ab4un_RF<&4sA7qv z7A;(;>n2)NQbtkL((<{pt4hj?{c}mA$!C{UmsTvUc5ReY>TEi3PSM;2re6PHHq*Zq zmBl5M6lVJ9f9&T-(fp$7lG)W2vx~}?&aN)1oL^G??|a&*>2KYiZaH+ouiK@wL(_F# zq_o+S=~cIbcDUoQ&OLwdgPq<_{5qz6Ghgv@pxzF<=MQzUvt4tvvw!^)oNeRt+p3fQ zB**7hSG^r|?>l$6`S@{G#~WX{>HJWtokt=i{jXYKQ|t@io# z+SzuW1MG0^{-@8aBJO=?&9P4XSb(7I^P{x(qi+59Emd#xv%2>A71+^p>&Gw3dYd2C zwa;(J+TY>Y4Y=o*|5m$e#yj;5xYtept@_G@=uRvCvMPUhMYX?baU@bvS7t6oRVP)J%`Yo2s;;P%L%ouDx2URQc4f)D-;}Rt?(Y_tRsQyTZh60{EUD+* zit?((i%NcTzRHrSlFB8&J>TMTt4Eore{Gkh3t?q8#;-8Z|fob=+L zyUUvU|M9eUj#|I;hwMux{Au7FC7<`cX2zRGJhu3sT~|+e^|1RF{dMmf&-h@>Gw1!> zVfnF}4!CXZr@LP@?TulNRQ;oK?Fla*a_@p|dtQI~d!wE@=U*K!J8ttqcg_E@?;lQm z`^YEG-roK9C;j>G2P^)*@6EG68vEP@J8O<}`p@)Ny3f)G-B0Q9F*jfOe)1P&-hY$I zi%V+!a@|rf&tF+oKHt59N{O#3nZJm;yDEQm(VT@`6}71;M~`7zR$e8ScCM=b?9#Hi zrT%$EWpZg$UBLyFTtmq)D=C)aijzNwRe80fag5DfTv^H1>?I|0nIJ}vbPu1rLHdW6 zlH#gNN{fnWW>=LhE6E$A)H=6)>HX2(c4C9me>IbweqsGZN`JBxBW2szVLeC2c$40q z&%zI#kF_7#XZeR?$MsnRl43XJ)@zsjc>KQ~7wP4%b@f@bq3xUd2jiRjWwYJygx_YL zl^@#fS~nkSLiD!JEsqr>dYdI7+Gml7lkVp8Pj<><8HtWJ^)UB0tRhK?H|4E!^RW;m zC7op}dYg49De-|RZoAy{$b=;_qSZP#o<$m3-~8^EccP=89$)Xqr|*}*NsfMce0@9d zflxd8?ZgL8Zb!eJ_`uY5^xKIKOlwEKo%q1?cJ$kc56oys-;HNMjP8F{$7tWbo8z-& zMsG)^$$jPGg(dpxL8<5|jy-eSvSdcpGjrLh&<81eIe3sSdZPwUm zpOrXHy1V^rk6TuE>3q4TI`v|qjoxPIjrREsTl*}}(LSqjob+~{qqCqVB|Z5Y?Xng~ z=Vv95_E`s{eO3!;pT$Aij~rXU7rSbBa_6`zZe!<`POD~~))9@TIqgZGSK8fn^;t2b z?Xy%!`>Y$%J}ZQ@&)OnqdvC{Q!I9o(8IktQ@xRWs$KoR$&#EKsoBhl>BfZT+Bq!aq z$0{bh%@QQ-vnWaXtX0xJOP#bIa_#=w{cPGDnO<61QdAtOtf-M?oUQJ#WB1zj$%sA1 z{&e>@Tc^y4j2))krm>E~fS}{I@QRpr7Z|@Y3A@8UI2I1|dcX`f|C+GoX* z_9L#p*41Y6D@>Zt~|=ESAT_Dso(9 z#o~xbQ;J7JRkFIG;K8S_`}XZ+N27vk8JmB`uN!|XhSKHMyZS7Na_ZC0@l`s@vCFzB zt!Kt7%ck@;E2kXawac2S6nlxMQny)nrPJksjMUr@KFFW#l*0BBK{kQ#kw>;Ky z>GGP~ZI*fI?ZP5=zq{!y*V6H3|FMuuZ?jrU`>fT{J`1H(t+L2y<_{?87&RC15?X#p)`>dPOKFj2^ z&uTpFv+h&-C35+4(wwunUS^bWJVj0^tE^sJw2&D|p1f96POYfm`o?xL*T{4t^*Wcp$O|HMg^?m&uy*$^?cm0s-m%4t`^;=KlCzO@Tjlh(m8qPq@<^Nn} z(kW%-DcjCd!joirSUjg{Ze^KXgf+29ZWE-w%zs4--E-KnMO-6H=Zmd{CY6L2(j}%89rO zKB%tvpt|9M>W&Y(^LpU-1UYHdWxpx)`?cpyziUs;clY;YuKjkdk61SBl<%hJrRC$z0Vmz{Sr)9fSz4_9 zy8cdjy_@gXj!PCK>--!FDkwq@3XbvIGN<0GMs~`nb^LU@=J!6);MVD^x%NyuYTS5MUu!+qUTgohKRmwuu_>dbJo~%nw_g0k zX@{S8{6m$KBS#;zX2eiQSJ+yo5pi`d>^`CIjDcj4|{_dBTH=lUP`Om*PGx*rU_iTUh%fED)9X;sqC4F8w z@!B8HufK78;P4l^-nn$k?5UG(->b*m2fjYD;qo9rpLy=3VGlj_ z`k1f3o3!?}iBtBtY2rl--rX{!r0AGn?V77^8Zvvz#h1MO#H@KYo-y&sk0n2v z%b$2`{q7yt7TmhW3ri=x|JRO1s#q;iMVz0?)G#$v4Q6{Gf5uJKzucBoPOmJQTXNju zvf`>!b<&J-=QmwDMG~~0eg@=NIIg5xM@_DnKfk21ps2ifVTq)e_zC6m=yNicT~3*) z@e>yo&3CS~cDVb4we5O8nEh@1-@4!DstUD8&7tL0s>Evb)QZ-N5M9ry6*J1^HcMZY z5OX?rlErG|E;3KY3{q#vNeJg(;EXF4%j^2;NQ8S|+UlA3ma;6ZS9g}nLnrD-~n*;st)Svb5rxlC5l`sHIUZe zrm^{7bN23EJ0wf3JD>wE-8gl~REX%ut@K7KEc#-@I2nWz4uaUVon3B(JpKV4T#0AL{Bb|3ZY?YL-q%>IRO@!O4gJcw&W=Pxh zkaBEi*JB5H@&=MFwBy8P&`K{PoT(qgma%P@ukBm5jgCb5hqC{%$2%;RMru$};#PWs zaC>!-oMJOmKS(*5oYcpEU|U+i3X6XIQJKeAZknFmt~h-WC7pM0G8L)gq>gK?^m@XX z`c-Th+jhT-ecKrwiCaM*sDnBv-u1CnQo>SxKXi->5YAM-*fO^5^2NUGjE=;G$P*=< zcZzJ4l(25Um0nLcQ~6@c*tW|T`?fPW64xN@&!hcmI<~%UKRU(*2xlr^Y#G~j`C{L8 zMn~dWr2VAxj+CvE64vdv((4IlDqn0F+jjY4-*!ev;*v6E2hsjC9a~?wA06WYgbS^0 z6EC)mZM%H2Z##3G$nCPN_wSCAypbIL*x}tS+f+(e%8pyPGyB<+#Kk2+vXRD-y#b&Nt5V_7zxWL*r@nXx^w#yg$w%dZ9akgG0gH6#B zn=7oe^s-HvqU#%-rQ+!FuAgjXbkd$CE4_tq`aYG6V$0aJ>nZkaXLKa4o;<+7g@iaY?M{G7(X_?9vU0wFzwz7OySkmj-DK}}^ zZnYx;ToZZ1*x{WsCn8NsneuqC#!6pDxKZ*P?(C;J{D0@94AUcaze%~a^BWoDDR$H8mU34r(ZrA>biWw>2s|li7jK>uBX_yozaoF7V@kh zop(NMm6WiQAG6XM2q&y|G#c2*L2Mb@c6-FW?c(jUyD3f2w(au8zU|`Z8E5OM z{8T-oBR2b4Y3XH~GDTnJBAIu1$Ju0W^+nGdZ$^)Ih+ET5z_urIj?6E-J8qI&eOu3e zT$b8`4)3(Lrl$v_9}`yk4#JtPg~gV!ZTFAZ&*Vfm|ERXK0xK-~3G5kX+w-UCnKDH; zRFI|ClFqwzChIP~=+|56aVsp!V#7GQT(O(U>GDUmrTMI|=(n_EFPUb~Zbxtu*DcuL z9pg+z>NrWMvC`KPjzjwM3u8cRW;)KK9NX2QXX;|NKbfXy@@Si*+HAB}2V+z6Nf}~~ zceIU}U3}3mw9-qhuqfvppLst8)Aa0e!{lioop)zMz!#F8Ru4Tm8{V3(zt{y$p5?im3^3t8uPi#i4wBK4c-wBzod$w3MO}SE@)GcA9 z{px;j&#Mg>vD=mDdO~!>nf=4Nz)plET@@W8eJ1_GJK>gw6BIpT&*<^4bw)iCDSaaC z=Usaf)#}^!j2`c@x2BtbT|YIM=YL1@{4ax^(U;>UA06XDgm<|nlSFJ8+jc*SecKrw ziEANGjC9^XwN+BWQhtM#-bgro?ve~*%hB5h;aJ7l%$C*W7{rY z?Ay-hNStp5?I)dgqivOxux`JV-bgr8`^A>AZI>_hZD({OE!KuSJJv;ru{Fr zjBUI9V&8T~N8*Civ*394KeXpWKWwE(tgz$}8^+n?ie1~;<<^iVPCD;o+bStxX?K&A z-a4JEJ3U{+YC&biS2ftE7Z=`>pic zQ0DfFEo0j*U+mk?=tx|cJcZcfn+&!}N?5nwN?*}V`C`l1w#yg$wlg{s7nAmrUZ198 z>+AMg>A5FoZok+vw(au8zU_>T#3iKt*y9@$wn|D^x8F)%(N6hd%h-Jmexl=Q@Uu+rMcKKr8c1B0y3dvK5J-(S?tE7Z=`>pg9?UXOJjBUGo zv2Q!0BXKclKk4;pI<~%Uzm=XlEpz+Dma%P@FZOL`bR@1t+K)ZH0b;A9gmwF^^cC%t zFSd+ryL_>4JEJ3U!CADQ^!hX%TVJ=|O3$61x&30x*tW|T`?fPW61Rdph1lbpCbmjS zShwFwU(rtaV$0aJ%NP5$GddF2DD5Y`K268g*X_5`b7y33zt}Ri?efLG?Tn7Z^*e+1 zV~=mN*eWSu-F_>5MLXq-Eo0j*U+mk?=tx`vd74PCPt&pWb^ERK+*7D8q&u-?Y}@6F zecP=-&p2DJFoR9e6Ppn$Exl}0rs&48y$)TzQ6rlfoutIA^aSDd?#0A_*pxmHXV+KC zv7KEHb!Ha-vyb&3(4Lc&0xP|ga2=$#uQfk5Gu1=Nv0V^7Qy06w4QYBNkJxOq(%P$o zu_^hYl;JDn`Jt81*fYNDYBW3xmG%3S&=KfyZ8ME6b_wTkd&ll45(w{Hb`$hUh+8?#b zH#SAjyqIV7_{NV(ZuM<@(spSl-y&*FPY-CjGuzVrR#HvEew=i^C1k6lgmwF^^cKSXX6>pkwv27Ne6er473djf z>jg8|6g{z7Xr-l>ZORngIJWE1-Ls!bxk}WD;A(wp~xLpW=!#x5sxz znx30UZ01>M>1CTTwK}%N4&Pi#DN;59?UcJBgRba{-I$dYw!$V|d~sr1?C|X-C&H3; z{i0HbGg(iTLC<6n3;obBE}w9FeJ(m;Q}&TKyWgc8+u8NlBK0MmZ~NFPDPc*8S?O`Y z|E?ZlGgCdJ9NXp2X=ne>PSrDcq~3W}S~AU^-L4?E!|3wODwBN|U-WCN^c7ZEl*NW| zc7KXp+u7wxn|!46?J8SEhi$!x*bcM*Gw7L&(ue)fF)lzjz0Hy)wv27Np8A6`CNsX# zk*Ip|M6t)Wr!0-spp?JXO0OrJKK3Pt*fO^5^2NUGjE;_*OZ$sxf0~Z1uiKA~aRI`a z%2(Jjw(au8zU_>T#1)VyN;=;VvsF^Uy8TvqJ>m2*Vr&`PcKKr8c1B0yqSF33v_DP9 z*4OPv$G8CDLTlT^i!Ec@E??~1E-q!d&en^j=@}idxznCnbBXwG5rAb|ECv%GF3)^1$JYdc%>GvU-&MT&0O@Hz2Cc8)- zw)<7uB=zT8TD$1gk!EyL>X$)RGVA%zN-HE>Z*7|bwzSiaO&N40kJO>XN=vtC>L|KW z=cwq;-?crq-VXFa=t)-DvonazjO|a;Z$!`3 zC8fS;dd9ZcY_ZbXtAnvA`J{{{^6>2}W2V)&^@8(x{)Z0VtZGe94@mhDD}4pwdTZP0 zi!Ec@ZkO1%-3s)Kv-O(N^o)+!Y_ZbP%Qj_-{uXTKoke*b?#C^qg6L-L+d^@og zeh+J5Iv**T1K+^+@FR5Ki%2_RU%sul9s2TpMGuDO^KHdSI2XQzZ{a6cKso2byO7Iw z7yCdZ#NYww#CI6;VItfP4R9FWWqb$*@NLF(;BN3y(Y>Greu9toFLd5!S=r)5r_2!O-bSZG%6|APo*Xh2`;Z7rY4k4;!8{GbZ2@_!73m z3_fBNhWQYOi%(PPJ{Wce@B2UrTyQ4WOmKFX&vX`11{^d;sng(>5~UuWr_{Cc`5#eb zTt~ot@EAO@K+&P>510o{i>M}KpW>o?0`y{~w!*B-l=@)>pZ8ozUU*~`*XgU3`seSl zS;wn~FcOZ21#lI-1h2zKunqnWJ0Nf+-=&2~a6O!~hTA;&4nDt%zPgsO|G+qgJK$Bg zbuE1g9sbBQ-}QX56#Bw3@ZAl3vh+r-17UwS6jt9vpTL9g1jM0#jC}z|!C06C*Wbc^ zheoKqmHhz^!bk8Ke0>{za=TJb!zTC#?0pCIh4t_>{27Ma$(Vz4VfVYJ2aJQ`;fQq{ z6HozHzzuLSJPaShXLmDi+(W%!987~6SPfUh1Mo0B1uw%}@CkIdmp*{Q;TX6C{s7Ow z7TE1R`Wiy867GU0;aT_&PQRbA3Q>3n_IZFg>OuBnJ#nxKu7HQ(S@;Wl3g1ERhm<-P zX23o0I81(+u>~K(7jW<+)CK+w2R_O&5|{4r}gYN7zl^J;V=x2gi$aSIzGuf z2z?+QMnf1@!?kcT+y+~q5w=10Q}i?33-3ej)9jyTIsTx}bIg~pKjgt+7!G&Bqj23u z>I<9UeVDX~eFaOP^YhdJ#zF{Y!dXxQcfw=P`%mmI2))2KfqP&R^xVw8gbQ9|Y{Lz& zun%7&4>Z72kpE}$!n3dyw!xl_j4${Cdc974VJM7+a##U>fH=GiuR*u1v<;4g1#s3I zj5SyTSHtb_4D|U6#{nD-K?uPWFy>93v%nNM73RPqXn~)h!&{7xw>hR^D7*ph!A~%u ziSq&!!o+tNUvLGy0SWj5mcC0rz?X3Nd(2aC7UaKA*)Rc4fDp`pdGH9-eZW}xh`9~| zFc;=QIaI+?SPSdmQMfBX|HDRj30{ZMA9MbK8E`txh8y5du=Eqo4{!@KKqI^d+hN~N znG2u*=6}ZdGs(Qr%=mzlVGf)He}}BEIG4Z!@EAM|??AV0ipfiH1Lp$8lT#c(d% z1P$;Nbod8j8`i+xuuZnV<9q|R!IA%D-+j;Z4NTjv)Q#{2w1C>d@d^7u0N#WI9P|Ta z{Ycwk*1wo%;bOQB?uOfPJgRF)kGijuM_t>+qppKZ&;%2@demg7gmK+G>LjRu?}7iN zqR#2zQLEq%IJl=rjew89x4TD;f%#Agb9#AHIa~>M!6Wb-yas3V_NYF6$P1I<6bQqO za3|aYGx~beC2&1_2tPtYKabiB??QL}F~+`-2ZzE#P_PHK_VjT5=TW`(@~FMxKo|{6 z;Zlh0O&j;|s0C07i{Vzd4>mz)Uk?{Fv>BpsBRm8fq04?AwGWJdgZHQIa2l+JFAngi zolrW!qqf5r13jwhK#%$WN)Gao`+%!ra&bug*EUhoOqZ=mBCH$5_B8v zQG37cj`Y(p_z zEdFrX54S)Aya7AlkRv>NkAir33nq^6sHw0B>Y)3P)CaagQNBlga};B8oJaMa;86qM z5Eu$A@E!aMI!yGaPS6$nFbF0>7>Z#5RKYSh4=#l};C^@%o`QkLdDLMr97e(W@Ckec z-@tc}SHO6LVK4&L!F})uJPv0}Vl2Qqcno?R?@=@10(cyrhgYEyK7i~Ks5e{yPr*CT zb+Sht0EfX8I0Y8KI(P`;@B+LAUxROoNA-n$;Yb(>V_+Pd04KrI@DY3t-@^CM<3x@l z=nH$oLRbYmq1Q>+fe?gY9@N5B@Ho5)@5AS?dk7n_FB}YmVFXNtLO2uVz(S~jDBKH= z!V~Z$JPTXk6G+0};9K|!a!;m>Fbc-Qad14G2)DzZ;AQw2w!<%wHPxdIhY4^poC*se z0yVG#u7?=h2@k*%@H32_=25?&?ooe$>)}>-9o~fxAqm?dYX)N#`oTVs2LTuXC%`nQ zgc_)YHE&Gq1UP8fg$ibY=eP?j7KPh1yBL! zz-4e7+y@P?2{ywU@E-gC-qWZ*42C128ZLpq!A{tII>+B^_IH^5K8O6!X)g7EAWVZl z!E3*x&*92Sk2-d#N1Y98Va77X-Z``fZino1*}s=EU)C}Hpy!p?fjMwC9DWVs=z8Yl z8$9Yoc;_a@WsG?r=HB8_&)i0xZs+*FgZ&Td;d%J@PR1cL!`JY4=yn&j;1rk%XTp_m z1KbNU){*~SjwARBd;n+M#~cCI-Os!Uo8f(!^Z>^JEP>q~WZ%K<@Ex37Pai%+J>ep_ z1g?SmVLfbuw_qDYAI3I32#-I)`~|l>%D98)AM>bxKJHPTCzwYYXfIp^n_<*?&LuD& zj)zmA43@$L@G^W4e|eHVgOA}$_!_>7+$uR&Yyv2Tj zPv7>aj!hnw4{P8iIQSjX-lgpKm=_`Eedgp3nL9q>n1&;u4*DlJx50WC@(ITZd;wp7 zO8)}QC1r~koQM10FKj6hL>06kWq@UorX67&W4)VY9sAHh&Z_HJHrySt_ zF{zqwI3K|c-?G18$v^04xENl7W#6%X|4Dse)c5oQtb(iIW_TDj!6z_gJNq4~;W2oA z2j_9<@&n`gN9@8kFy>#J2Vwb7%*9X#*TVG>gNGpNXZ8~u4r5^f^!kN9g8kqiI24A! zv9JYWidDW4JdDYP{0VczVhkMmj zI0x$BXUGcBCfH+$SM3KQVLVKOMMJ&nkYQeRCv+L^RV$&(5ni=B><4GSO1KRkhBx3% zcpE$;=r8DzB2WchbuC;6n@*rU@C95q*~_((S6wm1t8RjapzK61-+l0^ zu_w`AFbDPu(bsVLG%wFW85h&pudwf_UR4b9;VvjEWS^eyWi7i`RX{U*2Yt`*s#1tR zHQWoE;cZAj$(f`aNi zE8smCRLK~F2KWqqgiclT4O|A-!e;ms{sH}}ISv*xP9P31zUrqBn)bupS9sN`t2llj26sWpwagQs z{y?9>8F0#4uL{G>a3_2KpTeR);=?x(yxyyxgkCq$9ykfgpc+=eHE<7{bCZ{6x*R_@ zQ}>ux9S&n)3EU42@G3OH`%rf)dErL54c5W^@GNw@jXJ?2uoeCayWdWoAq+3W+c5hM z#sl06pTqulF;~JN>%3|rOo1=qy1TvVl6x4NFyLP19rz2p1@FK|upK_X&#RK~H#qrz z#s%a)zm`#7QTY5e`1b&fx5g(9bRJ`z!-?a zm2f@8q4%E|12CYG_Q6Fk^G)glWp8=aK26Lka62@@9`A76z?D$&9`iFygHvHHoCVcz z4#?t>M*5lm+oJ!6TOEF+E6++_s|6Px!4-@e zKXO*ltl4K*R4$k`WLDLzIc4QVm1QMWvx*iKj~HHAQY|sg#;jR$`Nw>f)kB5{2J6(p zk>WY(xMQbJma@ax8Z7@fc0h3%K@}!0(cpFC7L`j}kh+Y(ck~vO4+sQw{p9yQC$2_? z-{<_%sit|v9NlPbg=winfeZ`@ynJiE1pA_s`x6_3g8c}te!hy(l}keEh%v` zb^RLcxap2wQ%anpmmsc%y*IeVsbgcDHL#t`_JA6SQgttPP+g`FSK{d0&@W3pDs^!7 z{ZP>f_0Q7(QqPSWCUK?2Sz~0l#5L@lrTQ?KTs;|jJQ&T=|DSNMV_yG1l?aX0+jNus ze}nqLt=sf0W0~K!109K*Q>C|6gu#e44glTPsy@pZ|CLpha|Z<23*;d#qWe_G>3aK# zPd^4XEqs1uV%z3>`mFu&Q2Bp99?ASGoTpQk>NGq@bsCxz@#J__&QNc_lf^agMf~0< z+f&_bMqhvWrql4As?*k-$X_@n!`ScN8=bA*Kxn;J4X^E><`9=RhQN66b{c&ULn^D- zyGp9k-?dx0h53}^aFOVgtNv0>r8gk))kKw^hgdFY-7Y1{%jrn<=$@sz5AUeD5A7Tg zy&Fi*y94nQ?1Hybh{tJ>+&e*I4Lenw=iHf;}P9itAEcK7eg+_*JM?`uEFbBNRX zdJr2~S9@i0&|`*unZCa!qmnlRaXNUrz4a2Ox&oEw?Qe}gz5huLFBP4^%F~H!zRH|H z4;defF-gCgq`Vsuw~J1vfb5%`2wil(*)MHviHq)wh{jgkV9ro=4ExdT_wMw2H`RTO z)9)=t{|5q$jbmuEr%Mj^Be|-}(A-GJa85{%rJ+t;{8v!dfe7z`DPt^O;>Sq*kF-IK znNHGQxNWJE~qBbG?T8BI*59O}4!A5Lba2*Xw0SzbN858P`|a20^gi7}v>x-XOZqWhr_3&`?M@P{_xU#jaz?VVr>Y+PJE{KF-BthMZmR$EuB!j= zE~@{U-U-8_3806UUa7*rh~VWPtOOX-a#^+ zdi2auJ*#`Dp6K`7+F2hX)uJ!Q-gyLaj#jh0pSZ_zQsP( zcX)Tz_hFx|SC=}Ub*d6KZA;;Cw9DO`}Cbs^H_=lu*yPS40Go9&` zYa*vDZT;@M($(!xAZH@`Cf^<39mQUx|6VfR?XJ3hn-iAv!FbeUPRN@=U^+PGgK*Bp z>SFIg_S4=SRA*05o(pg;M!y=Bi$woC0vEUHN3-fg8~uSCGoHs(b|fp@A>a*3o^`0L z$tKT31m1v7orZHFAJ=)LoO;^ammi1#cI*t_*Yd zoiBwr#}wnnJzr-!9%Y=TkFSW>T#8r)IbAN+{n3vRIXF*-WypJH)?RXqr5`ivP!Hda z@IKsb`(7bgAHQ#k?W?`ZI9%=XSqsr~u&vK$Kd{01>~bkJI8w z(c6!}V93(fIPsy*mCmhMchXnA7^lU%F%L4=GsnxEIT_Ww8Ho9i(MSxlK7;jgnzvTMGJx@<3DSR4&xiftnM~K$*^ioM5@9nYYZfeiZ4pVzpAENdg zez4lplc#)cTW&xl?+(N!=+w!_ZG@-8F*O`A!4cPSe|(+9{9o+73wYGU+4n!YSz>?? z5{^NlMvR&&Xo!)bMcHr?6mSjUq}1JzEF>C|b(3&tJw$6QTC|bUii$QWDk^Q`8C$f` zqNPgvM2m{8*4TPLOWV|Hr7dmW&pk7{+1>m$+2HfO&-1^of3EBM`%Y$O?z!il^I?DM z{iS3n>q0fceVu1kdTz$JLEmv>r(WcKB69!5W9%&=ce{}*P0`8~pBT9}Xt@Q0ZjH!o zEKp;sjziyZ=$jwacP`=z7xGvIG6uDXz%!-CYo7Em>TV1$mNpN%P?ftc_l!%Qo1t|~ zB5SkAx+^NHL(7sCfR$B1pWjS9&B-CJ% zJam=p$Y^$-;wj6RO|`UTWX3nCLyb%g%{(qsjVK>X8y}=bgqg=Vq~+aAT61`qw8V%# z(lTq0?m26t#F6>;6*xR+s`1pI*!9aMymcM9Lq0!2ZRPXC^~(;CA@%TC9O+ZkDeh&q zUmV7G#oUJZ*63Hvyyo3V*gs0x8ET39-*( zk&Re)l{kkFlh>lkwqGzUr&+fAf@y=ssmI;!V)d3=&&BjwsF?M~_`&MPsx#G*C1Uwv&Oc!lGIhZvA zYX{154CCLJvXPxRdJQ!wx`q-PFGH=uAdgz$9<+B8P1e)y-Y9Z%vNKe6$zYXToY^_3 z-K@JLPK(63l}BqdPP^v;xBGI5<4}(65?;#j=QupYdTktA2Rrc&yeF~>l-~1L?mV_- zY_V-F2Zv{gT28@@8I_?%m5k(!Hag1a@v4L%lS_H{fFGo13{&h8zvDi4-`$M)QsztW zcDtHo8#m)N_r~-?sycnlVCKThkMN}znfh`$VZLx3k8goCPsSi4#IwxZ>d84KQysG_ zM;+6ct&XW0s*a(LJ7!~U*Qm}Bdabg9D231R*bUr+mPxwlx2b2`UfY-0v8a=e1Mf+g z+#dbhA^FU82cOM~Yqult3XBo|GHZiOHL6(Kpo5WC+h8&u>$*M@N4bP0)ANK~&9Y~m z9$+W-OmxW|pmLuZ(K#%X6UestZj8je8b^zbd%cM(d*11b)P2-D*5w|R8K!PvF;`xu z%45BjS3XqbVT-)5wnfLV_Uw==cM#vp%u>0mVRPxra>FCKhIQhv$8_o_^OP~H$Hy>N z8B;v6({wqs2D=+LOZNZ$x_bLD5MeAZ$4^!fSp`T50pT}O82c8qEt zVPr9HA$}J#myV(BX1s9?;GCd@`v6)$bR=#bar25}^gAk39mRU{DD*!H{f|Qbqc)D| z8r?aveN0{k`N|;;Ux zoPjE5+K{fnodY|LXz!i_OM2TQ@gK*LagAEd=-~2r?AX{ne(#lVZ}IpDq!04mMBA7= zOHxW7uikLGkH$7;{?6Q;^-E;_p4m#gkvvWS>6r)Gi8pB%mObTl9vQ!Lw|mB?(|eh* zxI4WW5^o-l1;Cy4Hv*@RQ!Va%73s6O*GZC(#z^=paHOwRXA;siJVOmH$x*{MW_Atg zH2tC3R~l^gmGtMs;y!ok4?9G*^oMWYU|;bow9A}4>SNU~>KOIR)G^&|ow>;e{f$-G2-0v3bgO}nxP3VevPH&bk#QG~?II)VBB?9#$Y@lP z=^GeIkuhqJ8daW6A3ao!3U~KUX6_b0U$A3qQS8`o2+;x8-IUoVyPh4$dWNzp8yp&= z_qyWu@pK(z`z&Yl5$qqaCs4(n0BexQ+G8%F3K#NNCNlNDWqbN&wV&=)jhT{l{3*M} zs1qA=>0?II7mZTGjvGSk^e#`Q+2?2>+70BZ@Kzl60nea9uAcjfWe2ov&`x)o=gV$) zx!Nf0MC+HuoM;Gjn0e|(GbidGn%*~hL*k#!T#vBF4pzsO9IKAy%Wv_$ml=mV_Yh|Y zkFmfrXbEWsbehMyhwV`t-OD{Mx+i(|xZmN3*gXxq>-|nMpG{of_z)3T$iqEO*dW+)MYK1bF zuo*mFo#44aZ4g`Nc>#O8^v{uf-hC2R_J!ZU!M^!i_qp85iReB=?}fYc-W&UG%ne5} zHjFIJ=``mb=5sm!@KPR$`+X%_k$o1A8Ni)+upN6brq6J9Az#bPMke!R`uUNMbyLAm=w7%#{xrx56>~xjQ7?n+5#C*t(TZ}bT?8h>mjA1+(6K34feL%Jv z9`2qq>Gbp*p8dnHww=$V_kUPtGnS1ejnNykn$b9HYin<*IQdqt&>NqvNK}jH&clwDCOjiyQOx{4rZ)hhzH7 zv4hlD=1XI-{a9>2cBAf-e5RimLO&6m$Ho%{v<&7u&~k3& zD$Y{H)Q1V%($w*rJ?g0S1JtOs*rECeHTYx7R-Xe6QA0MS`<(ja>ie+IWjxjZch(}Y z=Ok+XNn#h>muAzK4y7+;9%J+l>2mypbzCER)cB8ngmRSgHQJz*(N07Ko)vk8*jCm? z*tR&ki&E@}%&Bv9-O8kHG1m@f>bb=yL@E3ikAe3~S$%R5*Wz?p4cbl#PgD7xQ-t7FCwQb&I>QXT#72z7MhaQ1wLsiQw0q4$J$5-dzwh0o*I1B~pp zj1E=i{xD6gAb!s1LD-Ex`jL2>NS+Q7rO-uTW&vY^XWeIi=~wJGJ*a%{Ydzmdb043^ zVp7US=8@Q+bxz#e&-B5pN6X{q5#@+1{4$RkExQx@+O}}68s?s++d{H&uSMeC%H!T> zTswBoryVt$xJkyQJrY;O{#PaL6!kB+o3UT!%|mEIFm)hyUMhA_4-jV{kCDJLNOU!I zAuFs3+|Rp7u*_YqleP24p7UvuGh5_H+82l%pSl~-QM(l<*sTwpHi@h|c-#ZrS>L6S zc|z*f_Drk0&)F&Ap6Ag4JXsBdJLPLUGHO`{W_$Dy6<^QaNogF12;_9nfI zV(GJ0uKR3{t9Y0yUeEoowP~t=`vUn@!&!3-W6hDR@;4@~IdXc`JD1e!#&r7k0cteA zwKKXTO^xnie9(OWbAp6EK<@{WuVi)3^AP$t!+XzheffV}3WbYfR_pj*;!dL&E|&K3RLZj;24M43925vMaZ9RL6*R zy(;zTdipN)x{-Ava{;?f>~bABP#t;As4iBo9og+!p&@}x-(Zm=Yn;XbjPV{dvYe(< z!hNky>d&#V$23t5b)BTl44&`#${d2d8nbtpsdCD?_bD&mj@`e`qXl@f*3m^NTk2mA+%+ULBV@{C%`$)x^Tilo?Hf1_#ZP0TK zVr5x^B-xx*}&GEh76?9W&7_h-(?Iy3voVgDF$@u-CZ z)HTwc^}LfiD71m0k8lniGmn=(JoAU7J(9<J9}|0h65ZDdNBb3@OV8nQ zdd}fwUd{fAo>SX-s?p!<@rwR?NV4!%9>0;av+f{S&owIK)^nL+GneU-FjCL{E@6J) zHtljyT)Q06Mwp{`90%N4gOTGtJ5pEJ_Z-T4SJsG5^E{u#75PhXupik-Jg0DLBjK)= zaO3rS#k3#V4&!vR{ph`;!R#FkV((}mdq)}SsAALm#m=*Ki#(ZUy^JIMO7<_8#LeOM z%jbXL@h@QKe0uXG{W^}iCwX#?LcVK^ircvL(d ztV`5W>F%dIo=NV!bg%nk@;idIM_rG-10&^AD{{m(O*lNC>P>HBo9^}};WkOQJ9yj! z+*xOlNO~<-v+}7sv3cGp;hyL53NU$UE0)o=HRDPZ;CzQkpx#5oW|?IfA-#TT^G1b%gBOC9ECI9ShrsZ5-^2?@!H|MRc6}2x*t{mY43fXxM{S!v9!Cj~Ha$Vu z)hzdq)6Z3>yWJ!4MOS?;MjI;b9@~}>w6KClE%0RBOq5gZ68ki&AGp`0GrZkt*Zo7O z?^#^IFynJi<3I)=APuRGLnJj#6xImhxi5xBEHKn^E$+^f-hPRuuGqjpbRuO&tAxe`a_ z(hG59EK+B?PnY?#-KWYT4r@>|PtkGAe9YeGDUQj%$hm{Z1Hk0JMX%4&|D?9N$9cw# zlfA-RHT>i5dL?&KItU&npM`JWcrO~)Yu4d)Y*4(fC-TO2J=ZOnkCU#fTSnrbfKPDm z@tFHb@p~k?{!3V?v!ysZZ023ZT0^&`_;a>EBwUSzD^?u9+Hmo0e!Yadna3@_o#lC* za`UPZU2aZ$wL2vIvpn_yPu3ZPKV^ig?%0oA3*GoP3 zaU}lQNc^jDuwWVD=8l8Z6@6wAv+rZpob6HnD!U&P@s~Et{9Nzzly$e^oZ|--a~ zu$0HVXneD7%m}D?Hoh6l*@t2MIhHx$*sz@s>HUs`ITq(QvG*?J+%EP^d>hFGzR!cR zjWJ_0xOXs8#jeCer#*bE=OJ(4_?v{K&w2;8$DHzgiJOneX_oI!+>I>x_dmfOtgFGJ3<7D8@+9_3~S%ux5QntCw4Y~i5OPpNhbgT>Y-ij|0XDN>K zo74tEo4YjZ_0ea@{X<>;d>pt!d`HAH!_8JIaq|YMJXc=)o-h+M(J%L@NdJ#x z8j$oSz}A-Xos$a&=QPXrPA(WcXoh;#?SB3UHP7Q7BchdSFk|dAbM|BAx-yp^s74o4 zNA10z%Mn-jbspao`B~e=zMHu=co{9!^d)vbzS!7oyM%w7$B%XRJraJd`iPxi^74hj z$B%uNdk^gY4QKyP=D358OXq~aoS7dWN*Un_KgDrK;tyIMU}=_qh1-1wSCB+$m%i6& z*6~jBlJP$x{nL4r0&}hrFl|OgnDzQxBX+L2Ou`3wTngM-E==ahv?nWM) zBwXeW^a{9_Gk4MY&=-;aoPm5-dYUPl$0YpIJa*~u%Lp294 zv`fPMg2%5UT-FM7;-JsV=`~^XJW9s8?)%u1kAo7&wKGi}0o+-0Bp*{`d>_Od#on9E zk<4CVw4G(aEcX`L z%1IvDJ#+n{Y@e*9+ejyIuOato@^ussH)A`0X74`!yeYOUXG{2b68`MCIu*dHu!cvy ze3o^;*l;d$c{A2__laihWABOExuBlAvyPCtdt#f}A#$JP@eAO|oZBwj6CFtB{QEkl z{!Z=pfW-NfhwB-!pFS5h_LF@%%0~C;vd`Cjo+)Rf@;#epzR&mq{!9|`7u#-TAWr9T zp2)2tcYGe%Gfvq1l)Bd_;jiFvy@c0#w3~ip5u?ksvh~KCk?$jwnOhUCVFT2#<=y*F zW4^$CpDV*9ds1kT`OtJhYujA^60`@!*~YhP-KPavttQF`vu-i(@_? zcx1Xd5_=sP=B7?)cp#$pjf81(x`R(s%uee7< zzIvf&enoyR{!V$7-v*Yyi2nJww+xPqZ1Rcui^vZok-s*H{7(5Y8-Ee`QXdL>k>8#~ z{=Ovgt!^IooG4{!aFh-;7L@ALvE@<|OhrCy_6|$(bmBb6#@&JCn#i zm_)w(=47J$YtKn8-@Dt{K1=X-vQMi+`R;o@x%}27@^>VWA8?Sr;f3V#)z6*v&&A(K zfB8-3MEi{BMSdWO{IyBs=R4@{>qUNh68Za*$d}*L?V&$M1c`r<_M88rvwbGx?_?kO z&D=!!8+wu7oJ9WSB=Y4qaTDeHdXe9mME=1f^5r*Y6XnkhB)5J`cRQC z=YaAT>F4rs?`6+8*`K`MKt3DwI?FZqI39u>q%)&~D<69)4#2MY0`2JD0(Sy60DsU7T7lx-q0K;XjkH5PONXgL zEzc^If45Rz(8-wGir)Ez5y+KOc`1T?C82}*Am1&K4F@0V3Lk5^PQnW7FXt031X{$_ zVoS@Nq|t#}&}GqaOq%j8<(~OY$_{rv$Ob;3-Y5QRq`92*aR-2pa4oR+C4<0)$Q1vt zkXN|ltJv-XY|8#uC+;qwF2_!UZzisn&qAOLceAAPD4QnVCa<6!WIxSk__u>r0b#u^ z@`~FF0({1b9^!8$+(6Q* zp?+OT{O?j%R#A5!Cr=>%UH*TDGMG%9&A4;W9lvJMZkvJZ@0vU|If`9_|K;cnnyB8_aYN`uS5^fJR6%YqO3q*G3B^~&p>D?j4o|| zL+|UcG4Ia~93-t9h{OA`eH)mw(NA3nZU*gOKNz+zO`QY220j2|-(U|KYyi)Kzk-u~ z%~b*LO|TOj04M$?OfhEVvRp3VsiUzJtEttKdoSXHfV%uJnTY!5=~4@A=9TxDh-F zI>CT<*%Alqzysh_px#SUr-9|*d!Q4Hc|T1p0vkaG82$lQ3P2Ft2%ZCnz|{R|>MP&} zU_UtKL%vcBTEUCJ^AShV;3BXN+zr~nA3**e($r$`ZLk*%KfrM;_zrjx{1Z(0BVoYT zz(e3gZ~%<>6IY(VC14YH4UGOXVZkHd-{90P(gjz7R`4|V6ddyxbOd*U_rR$ilP