diff options
| author | William Joye <wjoye@cfa.harvard.edu> | 2016-10-27 19:39:39 (GMT) |
|---|---|---|
| committer | William Joye <wjoye@cfa.harvard.edu> | 2016-10-27 19:39:39 (GMT) |
| commit | ea28451286d3ea4a772fa174483f9a7a66bb1ab3 (patch) | |
| tree | 6ee9d8a7848333a7ceeee3b13d492e40225f8b86 /tcllib/modules/html | |
| parent | b5ca09bae0d6a1edce939eea03594dd56383f2c8 (diff) | |
| parent | 7c621da28f07e449ad90c387344f07a453927569 (diff) | |
| download | blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.zip blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.tar.gz blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.tar.bz2 | |
Merge commit '7c621da28f07e449ad90c387344f07a453927569' as 'tcllib'
Diffstat (limited to 'tcllib/modules/html')
| -rw-r--r-- | tcllib/modules/html/ChangeLog | 300 | ||||
| -rw-r--r-- | tcllib/modules/html/html.man | 476 | ||||
| -rw-r--r-- | tcllib/modules/html/html.tcl | 1506 | ||||
| -rw-r--r-- | tcllib/modules/html/html.test | 958 | ||||
| -rw-r--r-- | tcllib/modules/html/pkgIndex.tcl | 2 |
5 files changed, 3242 insertions, 0 deletions
diff --git a/tcllib/modules/html/ChangeLog b/tcllib/modules/html/ChangeLog new file mode 100644 index 0000000..2628b6a --- /dev/null +++ b/tcllib/modules/html/ChangeLog @@ -0,0 +1,300 @@ +2013-02-01 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.15 ======================== + * + +2011-12-13 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.14 ======================== + * + +2011-01-24 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.13 ======================== + * + +2009-12-07 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.12 ======================== + * + +2008-12-12 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.11.1 ======================== + * + +2008-10-16 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.11 ======================== + * + +2007-09-12 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.10 ======================== + * + +2007-08-21 Andreas Kupries <andreask@activestate.com> + + * html.man: Documentation of tableFrom{Array,List} extended per + [Tcllib SF Bug 1740573] (David Scott Cargo). Disabled the + documentation of 'html::title', per the same report, the command + seems to be not really for users, but only for internal use. + +2007-06-20 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * html.man: Fixed bug [SF Bug 1740573], documentation typos, + etc. Thanks to David Scott Cargo <escargo@users.sourceforge.net> + for the report. + +2007-03-21 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * html.man: Fixed all warnings due to use of now deprecated + commands. Added a section about how to give feedback. + +2006-10-03 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.9 ======================== + * + +2006-09-19 Andreas Kupries <andreask@activestate.com> + + * html.man: Bumped version to 1.4. + * html.tcl: + * pkgIndex.tcl: + +2006-09-12 Michael Schlenker <mic42@users.sourceforge.net> + + * html.tcl : fixed [SF Tcllib Bug 1557268], and + html.test: updated the test suite. + +2006-07-02 Michael Schlenker <mic42@users.sourceforge.net> + + * html.tcl : fixed [SF Tcllib Bug 1230699] and updated the tests. + html.test: Removed unused variables leftover from use in tclhttpd. + +2006-06-28 Michael Schlenker <mic42@users.sourceforge.net> + + * html.tcl (::html::meta): fixed [SF Tcllib Bug 1494597] and + changed tests so the test against the correct HTML 4.01 spec + for <meta>. + +2006-06-13 Andreas Kupries <andreask@activestate.com> + + * html.tcl (::html::css, ::html::js): New commands, implementing + [SF Tcllib RFE 970878]. Reworked the internals to be cleaner. + + * html.tcl (::html::doctype): New command, implements [SF Tcllib + RFE 1494660], proposed by <robert_hicks@users.sourceforge.net>. + Changed the implementation to be table-driven. + +2006-01-29 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * html.test: Fixed use of duplicate test names. + +2006-01-22 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * html.test: More boilerplate simplified via use of test support. + +2006-01-19 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * html.test: Hooked into the new common test support code. + +2005-10-06 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.8 ======================== + * + +2005-10-03 Andreas Kupries <andreask@activestate.com> + + * html.tcl (::html::html_entities): Accepted the [SF Tcllib Patch + * html.tcl (::html::nl2br): 1294733], creating two small + * html.man: commands for the conversion of + * html.test: special characters to their + entities, and line-endings to + <br>. Extended documentation + and testsuite. + +2005-01-19 Andreas Kupries <andreask@activestate.com> + + * html.tcl (::html::font): Fixed [Tcllib SF Bug 1105010], reported + by Luciano <lucianoes@users.sourceforge.net>. The parameters for + the font tag were duplicated. + * html.test: Added tests for "html::font". + +2004-10-05 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.7 ======================== + * + +Wed Sep 29 12:01:34 2004 Andreas Kupries <andreask@activestate.com> + + * html.man: Accepted patch provided by Michael Schlenker + <mic42@users.sourceforge.net>, completes the documentation of + html::checkSet. This fixes [Tcllib SF Bug 898774]. + +2004-05-23 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.6.1 ======================== + * + +2004-02-15 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.6 ======================== + * + +2003-05-05 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.4 ======================== + * + +2003-04-11 Andreas Kupries <andreask@activestate.com> + + * pkgIndex.tcl: + * html.man: + * html.tcl: Fixed bug #614591. Set version of the package to to + 1.2.2. Fixed equivalent of bug #648679. + +2003-02-24 David N. Welton <davidw@dedasys.com> + + * html.tcl (html::quoteFormValue): Package requires Tcl 8.2 in any + case, so having an implementation of this proc for older Tcl + versions doesn't make much sense. + +2003-01-16 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * html.man: More semantic markup, less visual one. + +2002-08-30 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * html.tcl: Updated 'info exist' to 'info exists'. + +2002-06-03 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * pkgIndex.tcl: + * html.tcl: + * html.n: + * html.man: Bumped to version 1.2.1. + +2002-04-10 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * html.man: Added doctools manpage. + +2002-02-14 Joe English <jenglish@users.sourceforge.net> + + * html.n: Remove mention of (unimplemented, undocumented) + formatCode procedure (SF BUG #461434). + +2002-01-15 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * Bumped version to 1.2 + +2002-01-11 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * html.n: + * html.tcl: Accepted patch #484117 provided by Decoster Jos + <decosterjos@users.sourceforge.net> providing two new function + to generated lists and parameterized table rows. + +2001-10-16 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * html.n: + * html.test: + * html.tcl: + * pkgIndex.tcl: Version up to 1.1.1 + +2001-08-01 Jeff Hobbs <jeffh@ActiveState.com> + + * html.tcl: added 8.1+ improved version of quoteFormValue. + +2001-07-10 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * html.tcl: Frink 2.2 run, fixed dubious code. + +2001-06-19 Melissa Chawla <melissachawla@yahoo.com> + + * modules/html/html.tcl: Added set and eval commands to this + package. These commands have the same syntax as those built in to + Tcl, but they are reworked to return "" so they blend into HTML + template files without appending unwanted results. The html::set + command must take two arguments. + +2001-06-15 Brent Welch <welch@panasas.com> + + * modules/html/html.tcl: Updated the version to 1.1 + Removed the "namespace export *" because you really do not + want to import these routines, especialy the new "if", "foreach", etc. + +2001-06-15 Melissa Chawla <melissachawla@yahoo.com> + + * modules/html/html.tcl: Added if, for, foreach, and while control + structures to this package. The control structures have the same + syntax as those built in to Tcl, but these are reworked to blend + into HTML template files. Rather than evaluating a body clause, + we return the subst'ed body (concatenated to eachother in cases + where multiple loop bodies were subst'ed). + + Fixed minor bug in textInput that caused tests to fail. + +2000-08-22 Dan Kuchler <kuchler@ajubasolutions.com> + + * modules/html/html.tcl: + Removed the 'html::resolveUrl' procedure because it provided + the same functionality as the uri::resolve function, only + html::resolveUrl was undocumented and untested and as a result + did not seem to work as well as uri::resolve. + +2000-07-31 Brent Welch <welch@scriptics.com> + + * modules/html/html.tcl: + Changed html::textInput to take "args" for additional stuff to + put into the <text> tag instead of "defaultValue". The ncgi + module now has ncgi::setDefaultValue for that purpose. + +2000-07-28 Brent Welch <welch@scriptics.com> + + * modules/html/html.tcl, html.n: Added html::passwordInputRow + +2000-07-24 Brent Welch <welch@scriptics.com> + + * modules/html/html.tcl: Fixed html::closeTag to tolerate + bad calls - when noone has called openTag on anything + or when the tag stack is empty. + +2000-06-04 Brent Welch <welch@scriptics.com> + + * modules/html/html.tcl: Added html::headTag to add any tag + to the HEAD section generated by html::head. + +2000-05-16 Brent Welch <welch@scriptics.com> + + * modules/html/html.tcl: Added html::refresh to generate + META tags that cause a page to refresh. + +2000-04-26 Brent Welch <welch@scriptics.com> + + * html/html.tcl: Added urlResove and urlParent URL parsing + routines. + +2000-04-26 Brent Welch <welch@scriptics.com> + + * html/html.tcl: track name changes in ncgi + +2000-04-24 Brent Welch <welch@scriptics.com> + + * html/html.tcl, html.test: Cleanup of procedure names in html package. + * html/html.n: Updates to the man page + * html/html.test: 60% through tests + diff --git a/tcllib/modules/html/html.man b/tcllib/modules/html/html.man new file mode 100644 index 0000000..f18cf4b --- /dev/null +++ b/tcllib/modules/html/html.man @@ -0,0 +1,476 @@ +[comment {-*- tcl -*- doctools manpage}] +[vset HTML_VERSION 1.4.4] +[manpage_begin html n [vset HTML_VERSION]] +[see_also htmlparse] +[see_also ncgi] +[keywords checkbox] +[keywords checkbutton] +[keywords form] +[keywords html] +[keywords radiobutton] +[keywords table] +[moddesc {HTML Generation}] +[titledesc {Procedures to generate HTML structures}] +[category {CGI programming}] +[require Tcl 8.2] +[require html [opt [vset HTML_VERSION]]] +[description] +[para] + +The package [package html] provides commands that generate HTML. +These commands typically return an HTML string as their result. In +particular, they do not output their result to [const stdout]. + +[para] + +The command [cmd ::html::init] should be called early to initialize +the module. You can also use this procedure to define default values +for HTML tag parameters. + +[list_begin definitions] + +[call [cmd ::html::author] [arg author]] + +[emph {Side effect only}]. Call this before [cmd ::html::head] to +define an author for the page. The author is noted in a comment in +the HEAD section. + +[call [cmd ::html::bodyTag] [arg args]] + +Generate a [term body] tag. The tag parameters are taken from [arg args] or +from the body.* attributes define with [cmd ::html::init]. + +[call [cmd ::html::cell] [arg {param value}] [opt [arg tag]]] + +Generate a [term td] (or [term th]) tag, a value, and a closing +[term td] (or [term th]) tag. The +tag parameters come from [arg param] or TD.* attributes defined with +[cmd ::html::init]. This uses [cmd ::html::font] to insert a standard +[term font] tag into the table cell. The [arg tag] argument defaults to "td". + +[call [cmd ::html::checkbox] [arg {name value}]] + +Generate a [term checkbox] form element with the specified name and value. +This uses [cmd ::html::checkValue]. + +[call [cmd ::html::checkSet] [arg {key sep list}]] + +Generate a set of [term checkbox] form elements and associated labels. The +[arg list] should contain an alternating list of labels and values. +This uses [cmd ::html::checkbox]. All the [term checkbox] buttons share the +same [arg key] for their name. The [arg sep] is text used to separate +the elements. + +[call [cmd ::html::checkValue] [arg name] [opt [arg value]]] + +Generate the "name=[arg name] value=[arg value]" for a [term checkbox] form +element. If the CGI variable [arg name] has the value [arg value], +then SELECTED is added to the return value. [arg value] defaults to +"1". + +[call [cmd ::html::closeTag]] + +Pop a tag off the stack created by [cmd ::html::openTag] and generate +the corresponding close tag (e.g., </body>). + +[call [cmd ::html::default] [arg key] [opt [arg param]]] + +This procedure is used by [cmd ::html::tagParam] to generate the name, +value list of parameters for a tag. The [cmd ::html::default] +procedure is used to generate default values for those items not +already in [arg param]. If the value identified by [arg key] matches +a value in [arg param] then this procedure returns the empty string. +Otherwise, it returns a "parameter=value" string for a form element +identified by [arg key]. The [arg key] has the form "tag.parameter" +(e.g., body.bgcolor). Use [cmd ::html::init] to register default +values. [arg param] defaults to the empty string. + +[call [cmd ::html::description] [arg description]] + +[emph {Side effect only}]. Call this before [cmd ::html::head] to +define a description [term meta] tag for the page. This tag is generated +later in the call to [cmd ::html::head]. + +[call [cmd ::html::end]] + +Pop all open tags from the stack and generate the corresponding close +HTML tags, (e.g., </body></html>). + +[call [cmd ::html::eval] [arg arg] [opt [arg args]]] + +This procedure is similar to the built-in Tcl [cmd eval] command. The +only difference is that it returns "" so it can be called from an HTML +template file without appending unwanted results. + +[call [cmd ::html::extractParam] [arg {param key}] [opt [arg varName]]] + +This is a parsing procedure that extracts the value of [arg key] from +[arg param], which is a HTML-style "name=quotedvalue" list. + +[arg varName] is used as the name of a Tcl variable that is changed to +have the value found in the parameters. The function returns 1 if the +parameter was found in [arg param], otherwise it returns 0. If the +[arg varName] is not specified, then [arg key] is used as the variable +name. + +[call [cmd ::html::font] [arg args]] + +Generate a standard [term font] tag. The parameters to the tag are taken +from [arg args] and the HTML defaults defined with [cmd ::html::init]. + +[call [cmd ::html::for] [arg {start test next body}]] + +This procedure is similar to the built-in Tcl [cmd for] control +structure. Rather than evaluating the body, it returns the subst'ed +[arg body]. Each iteration of the loop causes another string to be +concatenated to the result value. + +[call [cmd ::html::foreach] [arg {varlist1 list1}] [opt [arg {varlist2 list2 ...}]] [arg body]] + +This procedure is similar to the built-in Tcl [cmd foreach] control +structure. Rather than evaluating the body, it returns the subst'ed +[arg body]. Each iteration of the loop causes another string to be +concatenated to the result value. + +[call [cmd ::html::formValue] [arg name] [opt [arg defvalue]]] + +Return a name and value pair, where the value is initialized from +existing CGI data, if any. The result has this form: + +[para] +[example { + name="fred" value="freds value" +}] + +[call [cmd ::html::getFormInfo] [arg args]] + +Generate hidden fields to capture form values. If [arg args] is +empty, then hidden fields are generated for all CGI values. Otherwise +args is a list of string match patterns for form element names. + +[call [cmd ::html::getTitle]] + +Return the title string, with out the surrounding [term title] tag, +set with a previous call to [cmd ::html::title]. + +[call [cmd ::html::h] [arg {level string}] [opt [arg param]]] + +Generate a heading (e.g., [term h[var level]]) tag. The [arg string] is nested in the +heading, and [arg param] is used for the tag parameters. + +[call [cmd ::html::h1] [arg string] [opt [arg param]]] + +Generate an [term h1] tag. See [cmd ::html::h]. + +[call [cmd ::html::h2] [arg string] [opt [arg param]]] + +Generate an [term h2] tag. See [cmd ::html::h]. + +[call [cmd ::html::h3] [arg string] [opt [arg param]]] + +Generate an [term h3] tag. See [cmd ::html::h]. + +[call [cmd ::html::h4] [arg string] [opt [arg param]]] + +Generate an [term h4] tag. See [cmd ::html::h]. + +[call [cmd ::html::h5] [arg string] [opt [arg param]]] + +Generate an [term h5] tag. See [cmd ::html::h]. + +[call [cmd ::html::h6] [arg string] [opt [arg param]]] + +Generate an [term h6] tag. See [cmd ::html::h]. + +[call [cmd ::html::hdrRow] [arg args]] + +Generate a table row, including [term tr] and [term th] tags. +Each value in [arg args] is place into its own table cell. +This uses [cmd ::html::cell]. + +[call [cmd ::html::head] [arg title]] + +Generate the [term head] section that includes the page [term title]. +If previous calls have been made to +[cmd ::html::author], +[cmd ::html::keywords], +[cmd ::html::description], +or +[cmd ::html::meta] +then additional tags are inserted into the [term head] section. +This leaves an open [term html] tag pushed on the stack with +[cmd ::html::openTag]. + +[call [cmd ::html::headTag] [arg string]] + +Save a tag for inclusion in the [term head] section generated by + +[cmd ::html::head]. The [arg string] is everything in the tag except +the enclosing angle brackets, < >. + +[call [cmd ::html::html_entities] [arg string]] + +This command replaces all special characters in the [arg string] with +their HTML entities and returns the modified text. + +[call [cmd ::html::if] [arg {expr1 body1}] [opt "[const elseif] [arg {expr2 body2 ...}]"] [opt "[const else] [arg bodyN]"]] + +This procedure is similar to the built-in Tcl [cmd if] control +structure. Rather than evaluating the body of the branch that is +taken, it returns the subst'ed [arg body]. Note that the syntax is +slightly more restrictive than that of the built-in Tcl [cmd if] +control structure. + +[call [cmd ::html::init] [opt [arg list]]] + +[cmd ::html::init] accepts a Tcl-style name-value list that defines +values for items with a name of the form "tag.parameter". For +example, a default with key "body.bgcolor" defines the background +color for the [term body] tag. + +[call [cmd ::html::keywords] [arg args]] + +[emph {Side effect only}]. Call this before [cmd ::html::head] to +define a keyword [term meta] tag for the page. The [term meta] tag +is included in the result of [cmd ::html::head]. + +[call [cmd ::html::mailto] [arg email] [opt [arg subject]]] + +Generate a hypertext link to a mailto: URL. + +[call [cmd ::html::meta] [arg args]] + +[emph {Side effect only}]. Call this before [cmd ::html::head] to +define a [term meta] tag for the page. The [arg args] is a Tcl-style name, +value list that is used for the name= and value= parameters for the +[term meta] tag. The [term meta] tag is included in the result of +[cmd ::html::head]. + +[call [cmd ::html::css] [arg href]] + +[emph {Side effect only}]. Call this before [cmd ::html::head] to +define a [term link] tag for a linked CSS document. The [arg href] +value is a HTTP URL to a CSS document. The [term link] tag is included +in the result of [cmd ::html::head]. + +[para] + +Multiple calls of this command are allowed, enabling the use of +multiple CSS document references. In other words, the arguments +of multiple calls are accumulated, and do not overwrite each other. + +[call [cmd ::html::css-clear]] + +[emph {Side effect only}]. Call this before [cmd ::html::head] to +clear all links to CSS documents. +[para] + +Multiple calls of this command are allowed, doing nothing after the +first of a sequence with no intervening [cmd ::html::css]. + +[call [cmd ::html::js] [arg href]] + +[emph {Side effect only}]. Call this before [cmd ::html::head] to +define a [term script] tag for a linked JavaScript document. The +[arg href] is a HTTP URL to a JavaScript document. The [term script] +tag is included in the result of [cmd ::html::head]. + +[para] + +Multiple calls of this command are allowed, enabling the use of +multiple JavaScript document references. In other words, the arguments +of multiple calls are accumulated, and do not overwrite each other. + + +[call [cmd ::html::js-clear]] + +[emph {Side effect only}]. Call this before [cmd ::html::head] to +clear all links to JavaScript documents. +[para] + +Multiple calls of this command are allowed, doing nothing after the +first of a sequence with no intervening [cmd ::html::js]. + +[call [cmd ::html::minorList] [arg list] [opt [arg ordered]]] + +Generate an ordered or unordered list of links. The [arg list] is a +Tcl-style name, value list of labels and urls for the links. + +[arg ordered] is a boolean used to choose between an ordered or +unordered list. It defaults to [const false]. + +[call [cmd ::html::minorMenu] [arg list] [opt [arg sep]]] + +Generate a series of hypertext links. The [arg list] is a Tcl-style +name, value list of labels and urls for the links. The [arg sep] is +the text to put between each link. It defaults to " | ". + +[call [cmd ::html::nl2br] [arg string]] + +This command replaces all line-endings in the [arg string] with a +[term br] tag and returns the modified text. + +[call [cmd ::html::openTag] [arg tag] [opt [arg param]]] + +Push [arg tag] onto a stack and generate the opening tag for +[arg tag]. Use [cmd ::html::closeTag] to pop the tag from the +stack. The second argument provides any tag arguments, as a +list whose elements are formatted to be in the form +"[var key]=[const value]". + +[call [cmd ::html::paramRow] [arg list] [opt [arg rparam]] [opt [arg cparam]]] + +Generate a table row, including [term tr] and [term td] tags. Each value in + +[arg list] is placed into its own table cell. This uses + +[cmd ::html::cell]. The value of [arg rparam] is used as parameter for +the [term tr] tag. The value of [arg cparam] is passed to [cmd ::html::cell] +as parameter for the [term td] tags. + +[call [cmd ::html::passwordInput] [opt [arg name]]] + +Generate an [term input] tag of type [term password]. The [arg name] defaults to +"password". + +[call [cmd ::html::passwordInputRow] [arg label] [opt [arg name]]] + +Format a table row containing a label and an [term input] tag of type +[term password]. The [arg name] defaults to "password". + +[call [cmd ::html::quoteFormValue] [arg value]] + +Quote special characters in [arg value] by replacing them with HTML +entities for quotes, ampersand, and angle brackets. + +[call [cmd ::html::radioSet] [arg {key sep list}]] + +Generate a set of [term input] tags of type [term radio] and an associated text +label. All the radio buttons share the same [arg key] for their name. +The [arg sep] is text used to separate the elements. The [arg list] +is a Tcl-style label, value list. + +[call [cmd ::html::radioValue] [arg {name value}]] + +Generate the "name=[arg name] value=[arg value]" for a [term radio] form +element. If the CGI variable [arg name] has the value [arg value], +then SELECTED is added to the return value. + +[call [cmd ::html::refresh] [arg {seconds url}]] + +Set up a refresh [term meta] tag. Call this before [cmd ::html::head] and the +HEAD section will contain a [term meta] tag that causes the document to +refresh in [arg seconds] seconds. The [arg url] is optional. If +specified, it specifies a new page to load after the refresh interval. + +[call [cmd ::html::row] [arg args]] + +Generate a table row, including [term tr] and [term td] tags. Each value in +[arg args] is place into its own table cell. This uses +[cmd ::html::cell]. Ignores any default information set up via +[cmd ::html::init]. + +[call [cmd ::html::select] [arg {name param choices}] [opt [arg current]]] + +Generate a [term select] form element and nested [term option] tags. The [arg name] +and [arg param] are used to generate the [term select] tag. The [arg choices] +list is a Tcl-style name, value list. + +[call [cmd ::html::selectPlain] [arg {name param choices}] [opt [arg current]]] + +Like [cmd ::html::select] except that [arg choices] is a Tcl list of +values used for the [term option] tags. The label and the value for each +[term option] are the same. + +[call [cmd ::html::set] [arg {var val}]] + +This procedure is similar to the built-in Tcl [cmd set] command. The +main difference is that it returns "" so it can be called from an HTML +template file without appending unwanted results. The other +difference is that it must take two arguments. + +[call [cmd ::html::submit] [arg label] [opt [arg name]]] + +Generate an [term input] tag of type [term submit]. [arg name] defaults to "submit". + +[call [cmd ::html::tableFromArray] [arg arrname] [opt [arg param]] [opt [arg pat]]] + +Generate a two-column [term table] and nested rows to display a Tcl array. The +table gets a heading that matches the array name, and each generated row +contains a name, value pair. The array names are sorted ([cmd lsort] without +special options). The argument [arg param] is for the [term table] tag and has +to contain a pre-formatted string. The [arg pat] is a [cmd {string match}] +pattern used to select the array elements to show in the table. It defaults to +[const *], i.e. the whole array is shown. + +[call [cmd ::html::tableFromList] [arg querylist] [opt [arg param]]] + +Generate a two-column [term table] and nested rows to display [arg querylist], +which is a Tcl dictionary. Each generated row contains a name, value pair. The +information is shown in the same order as specified in the dictionary. The +argument [arg param] is for the [term table] tag and has to contain a +pre-formatted string. + +[call [cmd ::html::textarea] [arg name] [opt [arg param]] [opt [arg current]]] + +Generate a [term textarea] tag wrapped around its current values. + +[call [cmd ::html::textInput] [arg {name value args}]] + +Generate an [term input] form tag with type [term text]. This uses + +[cmd ::html::formValue]. The args is any additional tag attributes +you want to put into the [term input] tag. + +[call [cmd ::html::textInputRow] [arg {label name value args}]] + +Generate an [term input] form tag with type [term text] formatted into a table row +with an associated label. The args is any additional tag attributes +you want to put into the [term input] tag. + +[comment { +[call [cmd ::html::title] [arg title]] + +[emph {Side effect only}]. Call this before [cmd ::html::head] to +define the [term title] for a page. +}] + +[call [cmd ::html::varEmpty] [arg name]] + +This returns 1 if the named variable either does not exist or has the +empty string for its value. + +[call [cmd ::html::while] [arg {test body}]] + +This procedure is similar to the built-in Tcl [cmd while] control +structure. Rather than evaluating the body, it returns the subst'ed +[arg body]. Each iteration of the loop causes another string to be +concatenated to the result value. + +[call [cmd ::html::doctype] [arg id]] + +This procedure can be used to build the standard DOCTYPE +declaration string. It will return the standard declaration +string for the id, or throw an error if the id is not known. +The following id's are defined: + +[list_begin enumerated] +[enum] HTML32 +[enum] HTML40 +[enum] HTML40T +[enum] HTML40F +[enum] HTML401 +[enum] HTML401T +[enum] HTML401F +[enum] XHTML10S +[enum] XHTML10T +[enum] XHTML10F +[enum] XHTML11 +[enum] XHTMLB +[list_end] + +[list_end] + +[vset CATEGORY html] +[include ../doctools2base/include/feedback.inc] +[manpage_end] diff --git a/tcllib/modules/html/html.tcl b/tcllib/modules/html/html.tcl new file mode 100644 index 0000000..3c0c443 --- /dev/null +++ b/tcllib/modules/html/html.tcl @@ -0,0 +1,1506 @@ +# html.tcl -- +# +# Procedures to make generating HTML easier. +# +# This module depends on the ncgi module for the procedures +# that initialize form elements based on current CGI values. +# +# Copyright (c) 1998-2000 by Ajuba Solutions. +# Copyright (c) 2006 Michael Schlenker <mic42@users.sourceforge.net> +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# Originally by Brent Welch, with help from Dan Kuchler and Melissa Chawla + +package require Tcl 8.2 +package require ncgi +package provide html 1.4.4 + +namespace eval ::html { + + # State about the current page + + variable page + + # A simple set of global defaults for tag parameters is implemented + # by storing into elements indexed by "key.param", where key is + # often the name of an HTML tag (anything for scoping), and + # param must be the name of the HTML tag parameter (e.g., "href" or "size") + # input.size + # body.bgcolor + # body.text + # font.face + # font.size + # font.color + + variable defaults + array set defaults { + input.size 45 + body.bgcolor white + body.text black + } + + # In order to nandle nested calls to redefined control structures, + # we need a temporary variable that is known not to exist. We keep this + # counter to append to the varname. Each time we need a temporary + # variable, we increment this counter. + + variable randVar 0 + + # No more export, because this defines things like + # foreach and if that do HTML things, not Tcl control + # namespace export * + + # Dictionary mapping from special characters to their entities. + + variable entities { + \xa0 \xa1 ¡ \xa2 ¢ \xa3 £ \xa4 ¤ + \xa5 ¥ \xa6 ¦ \xa7 § \xa8 ¨ \xa9 © + \xaa ª \xab « \xac ¬ \xad ­ \xae ® + \xaf ¯ \xb0 ° \xb1 ± \xb2 ² \xb3 ³ + \xb4 ´ \xb5 µ \xb6 ¶ \xb7 · \xb8 ¸ + \xb9 ¹ \xba º \xbb » \xbc ¼ \xbd ½ + \xbe ¾ \xbf ¿ \xc0 À \xc1 Á \xc2  + \xc3 à \xc4 Ä \xc5 Å \xc6 Æ \xc7 Ç + \xc8 È \xc9 É \xca Ê \xcb Ë \xcc Ì + \xcd Í \xce Î \xcf Ï \xd0 Ð \xd1 Ñ + \xd2 Ò \xd3 Ó \xd4 Ô \xd5 Õ \xd6 Ö + \xd7 × \xd8 Ø \xd9 Ù \xda Ú \xdb Û + \xdc Ü \xdd Ý \xde Þ \xdf ß \xe0 à + \xe1 á \xe2 â \xe3 ã \xe4 ä \xe5 å + \xe6 æ \xe7 ç \xe8 è \xe9 é \xea ê + \xeb ë \xec ì \xed í \xee î \xef ï + \xf0 ð \xf1 ñ \xf2 ò \xf3 ó \xf4 ô + \xf5 õ \xf6 ö \xf7 ÷ \xf8 ø \xf9 ù + \xfa ú \xfb û \xfc ü \xfd ý \xfe þ + \xff ÿ \u192 ƒ \u391 Α \u392 Β \u393 Γ + \u394 Δ \u395 Ε \u396 Ζ \u397 Η \u398 Θ + \u399 Ι \u39A Κ \u39B Λ \u39C Μ \u39D Ν + \u39E Ξ \u39F Ο \u3A0 Π \u3A1 Ρ \u3A3 Σ + \u3A4 Τ \u3A5 Υ \u3A6 Φ \u3A7 Χ \u3A8 Ψ + \u3A9 Ω \u3B1 α \u3B2 β \u3B3 γ \u3B4 δ + \u3B5 ε \u3B6 ζ \u3B7 η \u3B8 θ \u3B9 ι + \u3BA κ \u3BB λ \u3BC μ \u3BD ν \u3BE ξ + \u3BF ο \u3C0 π \u3C1 ρ \u3C2 ς \u3C3 σ + \u3C4 τ \u3C5 υ \u3C6 φ \u3C7 χ \u3C8 ψ + \u3C9 ω \u3D1 ϑ \u3D2 ϒ \u3D6 ϖ + \u2022 • \u2026 … \u2032 ′ \u2033 ″ + \u203E ‾ \u2044 ⁄ \u2118 ℘ \u2111 ℑ + \u211C ℜ \u2122 ™ \u2135 ℵ \u2190 ← + \u2191 ↑ \u2192 → \u2193 ↓ \u2194 ↔ \u21B5 ↵ + \u21D0 ⇐ \u21D1 ⇑ \u21D2 ⇒ \u21D3 ⇓ \u21D4 ⇔ + \u2200 ∀ \u2202 ∂ \u2203 ∃ \u2205 ∅ + \u2207 ∇ \u2208 ∈ \u2209 ∉ \u220B ∋ \u220F ∏ + \u2211 ∑ \u2212 − \u2217 ∗ \u221A √ + \u221D ∝ \u221E ∞ \u2220 ∠ \u2227 ∧ \u2228 ∨ + \u2229 ∩ \u222A ∪ \u222B ∫ \u2234 ∴ \u223C ∼ + \u2245 ≅ \u2248 ≈ \u2260 ≠ \u2261 ≡ \u2264 ≤ + \u2265 ≥ \u2282 ⊂ \u2283 ⊃ \u2284 ⊄ \u2286 ⊆ + \u2287 ⊇ \u2295 ⊕ \u2297 ⊗ \u22A5 ⊥ + \u22C5 ⋅ \u2308 ⌈ \u2309 ⌉ \u230A ⌊ + \u230B ⌋ \u2329 ⟨ \u232A ⟩ \u25CA ◊ + \u2660 ♠ \u2663 ♣ \u2665 ♥ \u2666 ♦ + \x22 " \x26 & \x3C < \x3E > \u152 Œ + \u153 œ \u160 Š \u161 š \u178 Ÿ + \u2C6 ˆ \u2DC ˜ \u2002   \u2003   \u2009   + \u200C ‌ \u200D ‍ \u200E ‎ \u200F ‏ \u2013 – + \u2014 — \u2018 ‘ \u2019 ’ \u201A ‚ + \u201C “ \u201D ” \u201E „ \u2020 † + \u2021 ‡ \u2030 ‰ \u2039 ‹ \u203A › + \u20AC € + } +} + +# ::html::foreach +# +# Rework the "foreach" command to blend into HTML template files. +# Rather than evaluating the body, we return the subst'ed body. Each +# iteration of the loop causes another string to be concatenated to +# the result value. No error checking is done on any arguments. +# +# Arguments: +# varlist Variables to instantiate with values from the next argument. +# list Values to set variables in varlist to. +# args ?varlist2 list2 ...? body, where body is the string to subst +# during each iteration of the loop. +# +# Results: +# Returns a string composed of multiple concatenations of the +# substitued body. +# +# Side Effects: +# None. + +proc ::html::foreach {vars vals args} { + variable randVar + + # The body of the foreach loop must be run in the stack frame + # above this one in order to have access to local variable at that stack + # level. + + # To support nested foreach loops, we use a uniquely named + # variable to store incremental results. + incr randVar + ::set resultVar "result_$randVar" + + # Extract the body and any varlists and valuelists from the args. + ::set body [lindex $args end] + ::set varvals [linsert [lreplace $args end end] 0 $vars $vals] + + # Create the script to eval in the stack frame above this one. + ::set script "::foreach" + ::foreach {vars vals} $varvals { + append script " [list $vars] [list $vals]" + } + append script " \{\n" + append script " append $resultVar \[subst \{$body\}\]\n" + append script "\}\n" + + # Create a temporary variable in the stack frame above this one, + # and use it to store the incremental results of the multiple loop + # iterations. Remove the temporary variable when we're done so there's + # no trace of this loop left in that stack frame. + + upvar 1 $resultVar tmp + ::set tmp "" + uplevel 1 $script + ::set result $tmp + unset tmp + return $result +} + +# ::html::for +# +# Rework the "for" command to blend into HTML template files. +# Rather than evaluating the body, we return the subst'ed body. Each +# iteration of the loop causes another string to be concatenated to +# the result value. No error checking is done on any arguments. +# +# Arguments: +# start A script to evaluate once at the very beginning. +# test An expression to eval before each iteration of the loop. +# Once the expression is false, the command returns. +# next A script to evaluate after each iteration of the loop. +# body The string to subst during each iteration of the loop. +# +# Results: +# Returns a string composed of multiple concatenations of the +# substitued body. +# +# Side Effects: +# None. + +proc ::html::for {start test next body} { + variable randVar + + # The body of the for loop must be run in the stack frame + # above this one in order to have access to local variable at that stack + # level. + + # To support nested for loops, we use a uniquely named + # variable to store incremental results. + incr randVar + ::set resultVar "result_$randVar" + + # Create the script to eval in the stack frame above this one. + ::set script "::for [list $start] [list $test] [list $next] \{\n" + append script " append $resultVar \[subst \{$body\}\]\n" + append script "\}\n" + + # Create a temporary variable in the stack frame above this one, + # and use it to store the incremental resutls of the multiple loop + # iterations. Remove the temporary variable when we're done so there's + # no trace of this loop left in that stack frame. + + upvar 1 $resultVar tmp + ::set tmp "" + uplevel 1 $script + ::set result $tmp + unset tmp + return $result +} + +# ::html::while +# +# Rework the "while" command to blend into HTML template files. +# Rather than evaluating the body, we return the subst'ed body. Each +# iteration of the loop causes another string to be concatenated to +# the result value. No error checking is done on any arguments. +# +# Arguments: +# test An expression to eval before each iteration of the loop. +# Once the expression is false, the command returns. +# body The string to subst during each iteration of the loop. +# +# Results: +# Returns a string composed of multiple concatenations of the +# substitued body. +# +# Side Effects: +# None. + +proc ::html::while {test body} { + variable randVar + + # The body of the while loop must be run in the stack frame + # above this one in order to have access to local variable at that stack + # level. + + # To support nested while loops, we use a uniquely named + # variable to store incremental results. + incr randVar + ::set resultVar "result_$randVar" + + # Create the script to eval in the stack frame above this one. + ::set script "::while [list $test] \{\n" + append script " append $resultVar \[subst \{$body\}\]\n" + append script "\}\n" + + # Create a temporary variable in the stack frame above this one, + # and use it to store the incremental resutls of the multiple loop + # iterations. Remove the temporary variable when we're done so there's + # no trace of this loop left in that stack frame. + + upvar 1 $resultVar tmp + ::set tmp "" + uplevel 1 $script + ::set result $tmp + unset tmp + return $result +} + +# ::html::if +# +# Rework the "if" command to blend into HTML template files. +# Rather than evaluating a body clause, we return the subst'ed body. +# No error checking is done on any arguments. +# +# Arguments: +# test An expression to eval to decide whether to use the then body. +# body The string to subst if the test case was true. +# args ?elseif test body2 ...? ?else bodyn?, where bodyn is the string +# to subst if none of the tests are true. +# +# Results: +# Returns a string composed by substituting a body clause. +# +# Side Effects: +# None. + +proc ::html::if {test body args} { + variable randVar + + # The body of the then/else clause must be run in the stack frame + # above this one in order to have access to local variable at that stack + # level. + + # To support nested if's, we use a uniquely named + # variable to store incremental results. + incr randVar + ::set resultVar "result_$randVar" + + # Extract the elseif clauses and else clause if they exist. + ::set cmd [linsert $args 0 "::if" $test $body] + + ::foreach {keyword test body} $cmd { + ::if {[string equal $keyword "else"]} { + append script " else \{\n" + ::set body $test + } else { + append script " $keyword [list $test] \{\n" + } + append script " append $resultVar \[subst \{$body\}\]\n" + append script "\} " + } + + # Create a temporary variable in the stack frame above this one, + # and use it to store the incremental resutls of the multiple loop + # iterations. Remove the temporary variable when we're done so there's + # no trace of this loop left in that stack frame. + + upvar $resultVar tmp + ::set tmp "" + uplevel $script + ::set result $tmp + unset tmp + return $result +} + +# ::html::set +# +# Rework the "set" command to blend into HTML template files. +# The return value is always "" so nothing is appended in the +# template. No error checking is done on any arguments. +# +# Arguments: +# var The variable to set. +# val The new value to give the variable. +# +# Results: +# Returns "". +# +# Side Effects: +# None. + +proc ::html::set {var val} { + + # The variable must be set in the stack frame above this one. + + ::set cmd [list set $var $val] + uplevel 1 $cmd + return "" +} + +# ::html::eval +# +# Rework the "eval" command to blend into HTML template files. +# The return value is always "" so nothing is appended in the +# template. No error checking is done on any arguments. +# +# Arguments: +# args The args to evaluate. At least one must be given. +# +# Results: +# Returns "". +# +# Side Effects: +# Throws an error if no arguments are given. + +proc ::html::eval {args} { + + # The args must be evaluated in the stack frame above this one. + ::eval [linsert $args 0 uplevel 1] + return "" +} + +# ::html::init +# +# Reset state that gets accumulated for the current page. +# +# Arguments: +# nvlist Name, value list that is used to initialize default namespace +# variables that set font, size, etc. +# +# Side Effects: +# Wipes the page state array + +proc ::html::init {{nvlist {}}} { + variable page + variable defaults + ::if {[info exists page]} { + unset page + } + ::if {[info exists defaults]} { + unset defaults + } + array set defaults $nvlist +} + +# ::html::head +# +# Generate the <head> section. There are a number of +# optional calls you make *before* this to inject +# meta tags - see everything between here and the bodyTag proc. +# +# Arguments: +# title The page title +# +# Results: +# HTML for the <head> section + +proc ::html::head {title} { + variable page + ::set html "[openTag html][openTag head]\n" + append html "\t[title $title]" + ::if {[info exists page(author)]} { + append html "\t$page(author)" + } + ::if {[info exists page(meta)]} { + ::foreach line $page(meta) { + append html "\t$line\n" + } + } + ::if {[info exists page(css)]} { + ::foreach style $page(css) { + append html "\t$style\n" + } + } + ::if {[info exists page(js)]} { + ::foreach script $page(js) { + append html "\t$script\n" + } + } + append html "[closeTag]\n" +} + +# ::html::title +# +# Wrap up the <title> and tuck it away for use in the page later. +# +# Arguments: +# title The page title +# +# Results: +# HTML for the <title> section + +proc ::html::title {title} { + variable page + ::set page(title) $title + ::set html "<title>$title</title>\n" + return $html +} + +# ::html::getTitle +# +# Return the title of the current page. +# +# Arguments: +# None +# +# Results: +# The title + +proc ::html::getTitle {} { + variable page + ::if {[info exists page(title)]} { + return $page(title) + } else { + return "" + } +} + +# ::html::meta +# +# Generate a meta tag. This tag gets bundled into the <head> +# section generated by html::head +# +# Arguments: +# args A name-value list of meta tag names and values. +# +# Side Effects: +# Stores HTML for the <meta> tag for use later by html::head + +proc ::html::meta {args} { + variable page + ::set html "" + ::foreach {name value} $args { + append html "<meta name=\"$name\" content=\"[quoteFormValue $value]\">" + } + lappend page(meta) $html + return "" +} + +# ::html::refresh +# +# Generate a meta refresh tag. This tag gets bundled into the <head> +# section generated by html::head +# +# Arguments: +# content Time period, in seconds, before the refresh +# url (option) new page to view. If not specified, then +# the current page is reloaded. +# +# Side Effects: +# Stores HTML for the <meta> tag for use later by html::head + +proc ::html::refresh {content {url {}}} { + variable page + ::set html "<meta http-equiv=\"Refresh\" content=\"$content" + ::if {[string length $url]} { + append html "; url=$url" + } + append html "\">" + lappend page(meta) $html + return "" +} + +# ::html::headTag +# +# Embed a tag into the HEAD section +# generated by html::head +# +# Arguments: +# string Everything but the < > for the tag. +# +# Side Effects: +# Stores HTML for the tag for use later by html::head + +proc ::html::headTag {string} { + variable page + lappend page(meta) <$string> + return "" +} + +# ::html::keywords +# +# Add META tag keywords to the <head> section. +# Call this before you call html::head +# +# Arguments: +# args The keywords +# +# Side Effects: +# See html::meta + +proc ::html::keywords {args} { + html::meta keywords [join $args ", "] +} + +# ::html::description +# +# Add a description META tag to the <head> section. +# Call this before you call html::head +# +# Arguments: +# description The description +# +# Side Effects: +# See html::meta + +proc ::html::description {description} { + html::meta description $description +} + +# ::html::author +# +# Add an author comment to the <head> section. +# Call this before you call html::head +# +# Arguments: +# author Author's name +# +# Side Effects: +# sets page(author) + +proc ::html::author {author} { + variable page + ::set page(author) "<!-- $author -->\n" + return "" +} + +# ::html::tagParam +# +# Return a name, value string for the tag parameters. +# The values come from "hard-wired" values in the +# param agrument, or from the defaults set with html::init. +# +# Arguments: +# tag Name of the HTML tag (case insensitive). +# param pname=value info that overrides any default values +# +# Results +# A string of the form: +# pname="keyvalue" name2="2nd value" + +proc ::html::tagParam {tag {param {}}} { + variable defaults + + ::set def "" + ::foreach key [lsort [array names defaults $tag.*]] { + append def [default $key $param] + } + return [string trimleft $param$def] +} + +# ::html::default +# +# Return a default value, if one has been registered +# and an overriding value does not occur in the existing +# tag parameters. +# +# Arguments: +# key Index into the defaults array defined by html::init +# This is expected to be in the form tag.pname where +# the pname part is used in the tag parameter name +# param pname=value info that overrides any default values +# +# Results +# pname="keyvalue" + +proc ::html::default {key {param {}}} { + variable defaults + ::set pname [string tolower [lindex [split $key .] 1]] + ::set key [string tolower $key] + ::if {![regexp -nocase "(\[ \]|^)$pname=" $param] && + [info exists defaults($key)] && + [string length $defaults($key)]} { + return " $pname=\"$defaults($key)\"" + } else { + return "" + } +} + +# ::html::bodyTag +# +# Generate a body tag +# +# Arguments: +# none +# +# Results +# A body tag + +proc ::html::bodyTag {args} { + return [openTag body [join $args]]\n +} + +# The following procedures are all related to generating form elements +# that are initialized to store the current value of the form element +# based on the CGI state. These functions depend on the ncgi::value +# procedure and assume that the caller has called ncgi::parse and/or +# ncgi::init appropriately to initialize the ncgi module. + +# ::html::formValue +# +# Return a name and value pair, where the value is initialized +# from existing form data, if any. +# +# Arguments: +# name The name of the form element +# defvalue A default value to use, if not appears in the CGI +# inputs. DEPRECATED - use ncgi::defValue instead. +# +# Retults: +# A string like: +# name="fred" value="freds value" + +proc ::html::formValue {name {defvalue {}}} { + ::set value [ncgi::value $name] + ::if {[string length $value] == 0} { + ::set value $defvalue + } + return "name=\"$name\" value=\"[quoteFormValue $value]\"" +} + +# ::html::quoteFormValue +# +# Quote a value for use in a value=\"$value\" fragment. +# +# Arguments: +# value The value to quote +# +# Retults: +# A string like: +# "Hello, <b>World!" + +proc ::html::quoteFormValue {value} { + return [string map [list "&" "&" "\"" """ \ + "'" "'" "<" "<" ">" ">"] $value] +} + +# ::html::textInput -- +# +# Return an <input type=text> element. This uses the +# input.size default falue. +# +# Arguments: +# name The form element name +# args Additional attributes for the INPUT tag +# +# Results: +# The html fragment + +proc ::html::textInput {name {value {}} args} { + ::set html "<input type=\"text\" " + append html [formValue $name $value] + append html [default input.size $args] + ::if {[llength $args] != 0} then { + append html " " [join $args] + } + append html ">\n" + return $html +} + +# ::html::textInputRow -- +# +# Format a table row containing a text input element and a label. +# +# Arguments: +# label Label to display next to the form element +# name The form element name +# args Additional attributes for the INPUT tag +# +# Results: +# The html fragment + +proc ::html::textInputRow {label name {value {}} args} { + ::set html [row $label [::eval [linsert $args 0 html::textInput $name $value]]] + return $html +} + +# ::html::passwordInputRow -- +# +# Format a table row containing a password input element and a label. +# +# Arguments: +# label Label to display next to the form element +# name The form element name +# +# Results: +# The html fragment + +proc ::html::passwordInputRow {label {name password}} { + ::set html [row $label [passwordInput $name]] + return $html +} + +# ::html::passwordInput -- +# +# Return an <input type=password> element. +# +# Arguments: +# name The form element name. Defaults to "password" +# +# Results: +# The html fragment + +proc ::html::passwordInput {{name password}} { + ::set html "<input type=\"password\" name=\"$name\">\n" + return $html +} + +# ::html::checkbox -- +# +# Format a checkbox so that it retains its state based on +# the current CGI values +# +# Arguments: +# name The form element name +# value The value associated with the checkbox +# +# Results: +# The html fragment + +proc ::html::checkbox {name value} { + ::set html "<input type=\"checkbox\" [checkValue $name $value]>\n" +} + +# ::html::checkValue +# +# Like html::formalue, but for checkboxes that need CHECKED +# +# Arguments: +# name The name of the form element +# defvalue A default value to use, if not appears in the CGI +# inputs +# +# Retults: +# A string like: +# name="fred" value="freds value" CHECKED + + +proc ::html::checkValue {name {value 1}} { + ::foreach v [ncgi::valueList $name] { + ::if {[string compare $value $v] == 0} { + return "name=\"$name\" value=\"[quoteFormValue $value]\" checked" + } + } + return "name=\"$name\" value=\"[quoteFormValue $value]\"" +} + +# ::html::radioValue +# +# Like html::formValue, but for radioboxes that need CHECKED +# +# Arguments: +# name The name of the form element +# value The value associated with the radio button. +# +# Retults: +# A string like: +# name="fred" value="freds value" CHECKED + +proc ::html::radioValue {name value {defaultSelection {}}} { + ::if {[string equal $value [ncgi::value $name $defaultSelection]]} { + return "name=\"$name\" value=\"[quoteFormValue $value]\" checked" + } else { + return "name=\"$name\" value=\"[quoteFormValue $value]\"" + } +} + +# ::html::radioSet -- +# +# Display a set of radio buttons while looking for an existing +# value from the query data, if any. + +proc ::html::radioSet {key sep list {defaultSelection {}}} { + ::set html "" + ::set s "" + ::foreach {label v} $list { + append html "$s<input type=\"radio\" [radioValue $key $v $defaultSelection]> $label" + ::set s $sep + } + return $html +} + +# ::html::checkSet -- +# +# Display a set of check buttons while looking for an existing +# value from the query data, if any. + +proc ::html::checkSet {key sep list} { + ::set s "" + ::foreach {label v} $list { + append html "$s<input type=\"checkbox\" [checkValue $key $v]> $label" + ::set s $sep + } + return $html +} + +# ::html::select -- +# +# Format a <select> element that retains the state of the +# current CGI values. +# +# Arguments: +# name The form element name +# param The various size, multiple parameters for the tag +# choices A simple list of choices +# current Value to assume if nothing is in CGI state +# +# Results: +# The html fragment + +proc ::html::select {name param choices {current {}}} { + ::set def [ncgi::valueList $name $current] + ::set html "<select name=\"$name\"[string trimright " $param"]>\n" + ::foreach {label v} $choices { + ::if {[lsearch -exact $def $v] != -1} { + ::set SEL " selected" + } else { + ::set SEL "" + } + append html "<option value=\"$v\"$SEL>$label\n" + } + append html "</select>\n" + return $html +} + +# ::html::selectPlain -- +# +# Format a <select> element where the values are the same +# as those that are displayed. +# +# Arguments: +# name The form element name +# param Tag parameters +# choices A simple list of choices +# +# Results: +# The html fragment + +proc ::html::selectPlain {name param choices {current {}}} { + ::set namevalue {} + ::foreach c $choices { + lappend namevalue $c $c + } + return [select $name $param $namevalue $current] +} + +# ::html::textarea -- +# +# Format a <textarea> element that retains the state of the +# current CGI values. +# +# Arguments: +# name The form element name +# param The various size, multiple parameters for the tag +# current Value to assume if nothing is in CGI state +# +# Results: +# The html fragment + +proc ::html::textarea {name {param {}} {current {}}} { + ::set value [quoteFormValue [ncgi::value $name $current]] + return "<[string trimright \ + "textarea name=\"$name\"\ + [tagParam textarea $param]"]>$value</textarea>\n" +} + +# ::html::submit -- +# +# Format a submit button. +# +# Arguments: +# label The string to appear in the submit button. +# name The name for the submit button element +# +# Results: +# The html fragment + + +proc ::html::submit {label {name submit}} { + ::set html "<input type=\"submit\" name=\"$name\" value=\"$label\">\n" +} + +# ::html::varEmpty -- +# +# Return true if the variable doesn't exist or is an empty string +# +# Arguments: +# varname Name of the variable +# +# Results: +# 1 if the variable doesn't exist or has the empty value + +proc ::html::varEmpty {name} { + upvar 1 $name var + ::if {[info exists var]} { + ::set value $var + } else { + ::set value "" + } + return [expr {[string length [string trim $value]] == 0}] +} + +# ::html::getFormInfo -- +# +# Generate hidden fields to capture form values. +# +# Arguments: +# args List of elements to save. If this is empty, everything is +# saved in hidden fields. This is a list of string match +# patterns. +# +# Results: +# A bunch of <input type=hidden> elements + +proc ::html::getFormInfo {args} { + ::if {[llength $args] == 0} { + ::set args * + } + ::set html "" + ::foreach {n v} [ncgi::nvlist] { + ::foreach pat $args { + ::if {[string match $pat $n]} { + append html "<input type=\"hidden\" name=\"$n\" \ + value=\"[quoteFormValue $v]\">\n" + } + } + } + return $html +} + +# ::html::h1 +# Generate an H1 tag. +# +# Arguments: +# string +# param +# +# Results: +# Formats the tag. + +proc ::html::h1 {string {param {}}} { + html::h 1 $string $param +} +proc ::html::h2 {string {param {}}} { + html::h 2 $string $param +} +proc ::html::h3 {string {param {}}} { + html::h 3 $string $param +} +proc ::html::h4 {string {param {}}} { + html::h 4 $string $param +} +proc ::html::h5 {string {param {}}} { + html::h 5 $string $param +} +proc ::html::h6 {string {param {}}} { + html::h 6 $string $param +} +proc ::html::h {level string {param {}}} { + return "<[string trimright "h$level [tagParam h$level $param]"]>$string</h$level>\n" +} + +# ::html::openTag +# Remember that a tag is opened so it can be closed later. +# This is used to automatically clean up at the end of a page. +# +# Arguments: +# tag The HTML tag name +# param Any parameters for the tag +# +# Results: +# Formats the tag. Also keeps it around in a per-page stack +# of open tags. + +proc ::html::openTag {tag {param {}}} { + variable page + lappend page(stack) $tag + return "<[string trimright "$tag [tagParam $tag $param]"]>" +} + +# ::html::closeTag +# Pop a tag from the stack and close it. +# +# Arguments: +# None +# +# Results: +# A close tag. Also pops the stack. + +proc ::html::closeTag {} { + variable page + ::if {[info exists page(stack)]} { + ::set top [lindex $page(stack) end] + ::set page(stack) [lreplace $page(stack) end end] + } + ::if {[info exists top] && [string length $top]} { + return </$top> + } else { + return "" + } +} + +# ::html::end +# +# Close out all the open tags. Especially useful for +# Tables that do not display at all if they are unclosed. +# +# Arguments: +# None +# +# Results: +# Some number of close HTML tags. + +proc ::html::end {} { + variable page + ::set html "" + ::while {[llength $page(stack)]} { + append html [closeTag]\n + } + return $html +} + +# ::html::row +# +# Format a table row. If the default font has been set, this +# takes care of wrapping the table cell contents in a font tag. +# +# Arguments: +# args Values to put into the row +# +# Results: +# A <tr><td>...</tr> fragment + +proc ::html::row {args} { + ::set html <tr>\n + ::foreach x $args { + append html \t[cell "" $x td]\n + } + append html "</tr>\n" + return $html +} + +# ::html::hdrRow +# +# Format a table row. If the default font has been set, this +# takes care of wrapping the table cell contents in a font tag. +# +# Arguments: +# args Values to put into the row +# +# Results: +# A <tr><th>...</tr> fragment + +proc ::html::hdrRow {args} { + variable defaults + ::set html <tr>\n + ::foreach x $args { + append html \t[cell "" $x th]\n + } + append html "</tr>\n" + return $html +} + +# ::html::paramRow +# +# Format a table row. If the default font has been set, this +# takes care of wrapping the table cell contents in a font tag. +# +# Based on html::row +# +# Arguments: +# list Values to put into the row +# rparam Parameters for row +# cparam Parameters for cells +# +# Results: +# A <tr><td>...</tr> fragment + +proc ::html::paramRow {list {rparam {}} {cparam {}}} { + ::set html "<tr $rparam>\n" + ::foreach x $list { + append html \t[cell $cparam $x td]\n + } + append html "</tr>\n" + return $html +} + +# ::html::cell +# +# Format a table cell. If the default font has been set, this +# takes care of wrapping the table cell contents in a font tag. +# +# Arguments: +# param Td tag parameters +# value The value to put into the cell +# tag (option) defaults to TD +# +# Results: +# <td>...</td> fragment + +proc ::html::cell {param value {tag td}} { + ::set font [font] + ::if {[string length $font]} { + ::set value $font$value</font> + } + return "<[string trimright "$tag $param"]>$value</$tag>" +} + +# ::html::tableFromArray +# +# Format a Tcl array into an HTML table +# +# Arguments: +# arrname The name of the array +# param The <table> tag parameters, if any. +# pat A string match pattern for the element keys +# +# Results: +# A <table> + +proc ::html::tableFromArray {arrname {param {}} {pat *}} { + upvar 1 $arrname arr + ::set html "" + ::if {[info exists arr]} { + append html "<table $param>\n" + append html "<tr><th colspan=2>$arrname</th></tr>\n" + ::foreach name [lsort [array names arr $pat]] { + append html [row $name $arr($name)] + } + append html </table>\n + } + return $html +} + +# ::html::tableFromList +# +# Format a table from a name, value list +# +# Arguments: +# querylist A name, value list +# param The <table> tag parameters, if any. +# +# Results: +# A <table> + +proc ::html::tableFromList {querylist {param {}}} { + ::set html "" + ::if {[llength $querylist]} { + append html "<table $param>" + ::foreach {label value} $querylist { + append html [row $label $value] + } + append html </table> + } + return $html +} + +# ::html::mailto +# +# Format a mailto: HREF tag +# +# Arguments: +# email The target +# subject The subject of the email, if any +# +# Results: +# A <a href=mailto> tag </a> + +proc ::html::mailto {email {subject {}}} { + ::set html "<a href=\"mailto:$email" + ::if {[string length $subject]} { + append html ?subject=$subject + } + append html "\">$email</a>" + return $html +} + +# ::html::font +# +# Generate a standard <font> tag. This depends on defaults being +# set via html::init +# +# Arguments: +# args Font parameters. +# +# Results: +# HTML + +proc ::html::font {args} { + + # e.g., font.face, font.size, font.color + ::set param [tagParam font [join $args]] + + ::if {[string length $param]} { + return "<[string trimright "font $param"]>" + } else { + return "" + } +} + +# ::html::minorMenu +# +# Create a menu of links given a list of label, URL pairs. +# If the URL is the current page, it is not highlighted. +# +# Arguments: +# +# list List that alternates label, url, label, url +# sep Separator between elements +# +# Results: +# html + +proc ::html::minorMenu {list {sep { | }}} { + ::set s "" + ::set html "" + regsub -- {index.h?tml$} [ncgi::urlStub] {} this + ::foreach {label url} $list { + regsub -- {index.h?tml$} $url {} that + ::if {[string compare $this $that] == 0} { + append html "$s$label" + } else { + append html "$s<a href=\"$url\">$label</a>" + } + ::set s $sep + } + return $html +} + +# ::html::minorList +# +# Create a list of links given a list of label, URL pairs. +# If the URL is the current page, it is not highlighted. +# +# Based on html::minorMenu +# +# Arguments: +# +# list List that alternates label, url, label, url +# ordered Boolean flag to choose between ordered and +# unordered lists. Defaults to 0, i.e. unordered. +# +# Results: +# A <ul><li><a...><\li>.....<\ul> fragment +# or a <ol><li><a...><\li>.....<\ol> fragment + +proc ::html::minorList {list {ordered 0}} { + ::set s "" + ::set html "" + ::if { $ordered } { + append html [openTag ol] + } else { + append html [openTag ul] + } + regsub -- {index.h?tml$} [ncgi::urlStub] {} this + ::foreach {label url} $list { + append html [openTag li] + regsub -- {index.h?tml$} $url {} that + ::if {[string compare $this $that] == 0} { + append html "$s$label" + } else { + append html "$s<a href=\"$url\">$label</a>" + } + append html [closeTag] + append html \n + } + append html [closeTag] + return $html +} + +# ::html::extractParam +# +# Extract a value from parameter list (this needs a re-do) +# +# Arguments: +# param A parameter list. It should alredy have been processed to +# remove any entity references +# key The parameter name +# varName The variable to put the value into (use key as default) +# +# Results: +# returns "1" if the keyword is found, "0" otherwise + +proc ::html::extractParam {param key {varName ""}} { + ::if {$varName == ""} { + upvar $key result + } else { + upvar $varName result + } + ::set ws " \t\n\r" + + # look for name=value combinations. Either (') or (") are valid delimeters + ::if { + [regsub -nocase [format {.*%s[%s]*=[%s]*"([^"]*).*} $key $ws $ws] $param {\1} value] || + [regsub -nocase [format {.*%s[%s]*=[%s]*'([^']*).*} $key $ws $ws] $param {\1} value] || + [regsub -nocase [format {.*%s[%s]*=[%s]*([^%s]+).*} $key $ws $ws $ws] $param {\1} value] } { + ::set result $value + return 1 + } + + # now look for valueless names + # I should strip out name=value pairs, so we don't end up with "name" + # inside the "value" part of some other key word - some day + + ::set bad \[^a-zA-Z\]+ + ::if {[regexp -nocase "$bad$key$bad" -$param-]} { + return 1 + } else { + return 0 + } +} + +# ::html::urlParent -- +# This is like "file dirname", but doesn't screw with the slashes +# (file dirname will collapse // into /) +# +# Arguments: +# url The URL +# +# Results: +# The parent directory of the URL. + +proc ::html::urlParent {url} { + ::set url [string trimright $url /] + regsub -- {[^/]+$} $url {} url + return $url +} + +# ::html::html_entities -- +# Replaces all special characters in the text with their +# entities. +# +# Arguments: +# s The near-HTML text +# +# Results: +# The text with entities in place of specials characters. + +proc ::html::html_entities {s} { + variable entities + return [string map $entities $s] +} + +# ::html::nl2br -- +# Replaces all line-endings in the text with <br> tags. +# +# Arguments: +# s The near-HTML text +# +# Results: +# The text with <br> in place of line-endings. + +proc ::html::nl2br {s} { + return [string map [list \n\r <br> \r\n <br> \n <br> \r <br>] $s] +} + +# ::html::doctype +# Create the DOCTYPE tag and tuck it away for usage +# +# Arguments: +# arg The DOCTYPE you want to declare +# +# Results: +# HTML for the doctype section + +proc ::html::doctype {arg} { + variable doctypes + ::set code [string toupper $arg] + ::if {![info exists doctypes($code)]} { + return -code error -errorcode {HTML DOCTYPE BAD} \ + "Unknown doctype \"$arg\"" + } + return $doctypes($code) +} + +namespace eval ::html { + variable doctypes + array set doctypes { + HTML32 {<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">} + HTML40 {<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN" "http://www.w3.org/TR/REC-html40/strict.dtd">} + HTML40T {<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/REC-html40/loose.dtd">} + HTML40F {<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Frameset//EN" "http://www.w3.org/TR/REC-html40/frameset.dtd">} + HTML401 {<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">} + HTML401T {<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">} + HTML401F {<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">} + XHTML10S {<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">} + XHTML10T {<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">} + XHTML10F {<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Frameset//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd">} + XHTML11 {<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">} + XHTMLB {<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML Basic 1.0//EN" "http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd">} + } +} + +# ::html::css +# Create the text/css tag and tuck it away for usage +# +# Arguments: +# href The location of the css file to include the filename and path +# +# Results: +# None. + +proc ::html::css {href} { + variable page + lappend page(css) "<link rel=\"stylesheet\" type=\"text/css\" href=\"[quoteFormValue $href]\">" + return +} + +# ::html::css-clear +# Drop all text/css references. +# +# Arguments: +# None. +# +# Results: +# None. + +proc ::html::css-clear {} { + variable page + catch { unset page(css) } + return +} + +# ::html::js +# Create the text/javascript tag and tuck it away for usage +# +# Arguments: +# href The location of the javascript file to include the filename and path +# +# Results: +# None. + +proc ::html::js {href} { + variable page + lappend page(js) "<script language=\"javascript\" type=\"text/javascript\" src=\"[quoteFormValue $href]\"></script>" + return +} + +# ::html::js-clear +# Drop all text/javascript references. +# +# Arguments: +# None. +# +# Results: +# None. + +proc ::html::js-clear {} { + variable page + catch { unset page(js) } + return +} diff --git a/tcllib/modules/html/html.test b/tcllib/modules/html/html.test new file mode 100644 index 0000000..6646fb6 --- /dev/null +++ b/tcllib/modules/html/html.test @@ -0,0 +1,958 @@ +# -*- tcl -*- Tests for the html module. +# +# This file contains a collection of tests for a module in the +# Standard Tcl Library. Sourcing this file into Tcl runs the tests and +# generates output for errors. No output means no errors were found. +# +# Copyright (c) 1998-2000 by Ajuba Solutions. +# Copyright (c) 2006 Michael Schlenker <mic42@users.sourceforge.net> +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: html.test,v 1.23 2006/10/09 21:41:40 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +source [file join \ + [file dirname [file dirname [file join [pwd] [info script]]]] \ + devtools testutilities.tcl] + +testsNeedTcl 8.4 +testsNeedTcltest 2.0 + +testing { + useLocal html.tcl html +} + +# ------------------------------------------------------------------------- + +test html-1.1 {html::init} -body { + html::init + list \ + [array exists html::defaults] \ + [array size html::defaults] \ + [info exists html::page] +} -result {1 0 0} + +test html-1.2 {html::init} -body { + html::init { + font.face arial + body.bgcolor white + body.text black + } + lsort [array names html::defaults] +} -result {body.bgcolor body.text font.face} + +test html-1.3 {html::init, too many args} -body { + html::init wrong num args +} -returnCodes error -result {wrong # args: should be "html::init ?nvlist?"} + +test html-1.4 {html::init, bad arg, odd-length list} -body { + html::init {wrong num args} +} -returnCodes error -result {list must have an even number of elements} + +test html-2.1 {html::head, not enough args} -body { + html::head +} -returnCodes error -result {wrong # args: should be "html::head title"} + +test html-2.2 {html::head} -body { + html::head "The Title" +} -result "<html><head>\n\t<title>The Title</title>\n</head>\n" + +test html-2.3 {html::head} -body { + html::description "The Description" + html::keywords key word + html::author "Cathy Coder" + html::meta metakey metavalue + html::head "The Title" +} -result {<html><head> + <title>The Title</title> + <!-- Cathy Coder --> + <meta name="description" content="The Description"> + <meta name="keywords" content="key, word"> + <meta name="metakey" content="metavalue"> +</head> +} + +test html-3.1 {html::title, not enough args} -body { + html::title +} -returnCodes error -result {wrong # args: should be "html::title title"} + +test html-3.2 {html::title} -body { + html::title "blah blah" +} -result "<title>blah blah</title>\n" + +test html-4.1 {html::getTitle} -body { + html::init + html::getTitle +} -result "" + +test html-4.2 {html::getTitle} -body { + html::init + html::title "blah blah" + html::getTitle +} -result {blah blah} + +test html-5.1 {html::meta} { + html::init + html::meta one two +} {} + +test html-5.2 {html::meta} { + html::init + html::meta one two + lindex $html::page(meta) 0 +} {<meta name="one" content="two">} + +test html-5.3 {html::meta} { + html::init + html::meta one {"one val"} + lindex $html::page(meta) 0 +} {<meta name="one" content=""one val"">} + +test html-6.1 {html::keywords} { + html::init + html::keywords one two +} {} + +test html-6.2 {html::keywords} { + html::init + html::keywords one two + lindex $html::page(meta) 0 +} {<meta name="keywords" content="one, two">} + +test html-6.3 {html::keywords} { + html::init + html::keywords one {"one val"} & + lindex $html::page(meta) 0 +} {<meta name="keywords" content="one, "one val", &">} + +test html-7.1 {html::description} { + html::init + html::description "This is the description." +} {} + +test html-7.2 {html::description} { + html::init + html::description "This is the description." + lindex $html::page(meta) 0 +} {<meta name="description" content="This is the description.">} + +test html-7.3 {html::description} { + html::init + html::description {one "one val" &} + lindex $html::page(meta) 0 +} {<meta name="description" content="one "one val" &">} + +test html-8.1 {html::author} { + html::init + html::author "This is the author." +} {} + +test html-8.2 {html::author} { + html::init + html::author "This is the author." + set html::page(author) +} {<!-- This is the author. --> +} + +test html-8.3 {html::author} { + html::init + html::author {one "one val" &} + set html::page(author) +} {<!-- one "one val" & --> +} + +test html-9.0 {html::tagParams} { + html::init { + body.bgcolor red + font.face times + } + html::tagParam font color="red" +} {color="red" face="times"} + +test html-9.1 {html::default} { + html::init { + body.bgcolor red + font.face times + } + html::default xyzzy +} {} + +test html-9.2 {html::default} { + html::init { + body.bgcolor red + font.face times + } + html::default body.bgcolor +} { bgcolor="red"} + +test html-9.3 {html::default} { + html::init { + body.bgcolor red + font.face times + } + html::default font.face "face=arial" +} {} + +test html-9.4 {html::default} { + html::init { + body.bgcolor red + font.face times + } + html::default font.face "color=blue size=1" +} { face="times"} + +test html-10.1 {html::bodyTag} { + html::init + html::bodyTag +} {<body> +} + +test html-10.2 {html::bodyTag} { + html::init { + body.bgcolor white + body.text black + } + html::bodyTag +} {<body bgcolor="white" text="black"> +} + +test html-10.3 {html::bodyTag} { + html::init { + body.bgcolor white + body.text black + } + html::bodyTag "text=red" +} {<body text=red bgcolor="white"> +} + +test html-11.1 {html::formValue} { + ncgi::reset name=value + ncgi::parse + html::formValue name +} {name="name" value="value"} + +test html-11.2 {html::formValue} { + ncgi::reset name=value + ncgi::parse + html::formValue name2 +} {name="name2" value=""} + +test html-11.3 {html::formValue} { + ncgi::reset "name=one+value&name2=%7e" + ncgi::parse + html::formValue name2 +} {name="name2" value="~"} + +test html-12.1 {html::quoteFormValue} { + html::quoteFormValue name2 +} {name2} + +test html-12.2 {html::quoteFormValue} { + html::quoteFormValue {"name2"} +} {"name2"} + +test html-12.3 {html::quoteFormValue} { + html::quoteFormValue {"'><&} ;# need a " for balance +} {"'><&} + +test html-12.4 {html::quoteFormValue} { + html::quoteFormValue "This is the value." +} {This is the value.} + +test html-13.1 {html::textInput} { + html::init + ncgi::reset + ncgi::parse + html::textInput email +} {<input type="text" name="email" value=""> +} + +test html-13.2 {html::textInput} { + html::init + ncgi::reset email=welch@scriptics.com + ncgi::parse + html::textInput email +} {<input type="text" name="email" value="welch@scriptics.com"> +} + +test html-13.3 {html::textInput} { + html::init { + input.size 30 + } + ncgi::reset + ncgi::parse + html::textInput email +} {<input type="text" name="email" value="" size="30"> +} + +test html-13.4 {html::textInput} { + html::init { + input.size 30 + } + ncgi::reset + ncgi::parse + html::textInput email default@foo.com +} {<input type="text" name="email" value="default@foo.com" size="30"> +} + +test html-13.5 {html::textInput} { + html::init + ncgi::reset email=welch@scriptics.com + ncgi::parse + html::textInput email value=default@foo.com +} {<input type="text" name="email" value="welch@scriptics.com"> +} + +test html-13.6 {html::textInput} { + html::init + ncgi::reset + ncgi::parse + html::textInput email default@foo.com size="80" +} {<input type="text" name="email" value="default@foo.com" size="80"> +} + +test html-13.7 {html::textInput} { + html::init { + input.size 30 + } + ncgi::reset + ncgi::parse + html::textInput email default@foo.com size="80" +} {<input type="text" name="email" value="default@foo.com" size="80"> +} + +test html-14.1 {html::textInputRow} { + html::init + ncgi::reset email=welch@scriptics.com + ncgi::parse + html::textInputRow Email email +} {<tr> + <td>Email</td> + <td><input type="text" name="email" value="welch@scriptics.com"> +</td> +</tr> +} + +test html-15.1 {html::passwordInput} { + html::passwordInput +} {<input type="password" name="password"> +} + +test html-15.2 {html::passwordInput} { + html::passwordInput form_pass +} {<input type="password" name="form_pass"> +} + +test html-16.1 {html::checkbox} { + ncgi::reset email=welch@scriptics.com + ncgi::parse + html::checkbox item value +} {<input type="checkbox" name="item" value="value"> +} + +test html-16.2 {html::checkbox} { + ncgi::reset email=welch@scriptics.com + ncgi::parse + html::checkbox email value +} {<input type="checkbox" name="email" value="value"> +} + +test html-17.1 {html::checkValue} { + ncgi::reset item=xyz + ncgi::parse + html::checkbox item xyz +} {<input type="checkbox" name="item" value="xyz" checked> +} + +test html-18.1 {html::radioValue} { + ncgi::reset item=xyz + ncgi::parse + html::radioValue item xyz +} {name="item" value="xyz" checked} + +test html-19.1 {html::radioSet} { + ncgi::reset item=2 + ncgi::parse + html::radioSet item " |\n" { + One 1 + Two 2 + Three 3 + } +} {<input type="radio" name="item" value="1"> One | +<input type="radio" name="item" value="2" checked> Two | +<input type="radio" name="item" value="3"> Three} + +test html-20.1 {html::checkSet} { + ncgi::reset item=2&item=3+4&x=y + ncgi::parse + html::checkSet item " |\n" { + One 1 + Two 2 + Three {3 4} + } +} {<input type="checkbox" name="item" value="1"> One | +<input type="checkbox" name="item" value="2" checked> Two | +<input type="checkbox" name="item" value="3 4" checked> Three} + +test html-21.1 {html::select} { + ncgi::reset item=2&x=y + ncgi::parse + html::select item "multiple" { + One 1 + Two 2 + Three {3 4} + } +} {<select name="item" multiple> +<option value="1">One +<option value="2" selected>Two +<option value="3 4">Three +</select> +} + +test html-22.1 {html::selectPlain} { + ncgi::reset item=Three + ncgi::parse + html::selectPlain item "" { + One Two Three + } +} {<select name="item"> +<option value="One">One +<option value="Two">Two +<option value="Three" selected>Three +</select> +} + +test html-22.2 {html::selectPlain} { + ncgi::reset item=Three + ncgi::parse + html::selectPlain another "" { + One Two Three + } One +} {<select name="another"> +<option value="One" selected>One +<option value="Two">Two +<option value="Three">Three +</select> +} + +test html-23.1 {html::textarea} { + ncgi::reset item=Three + ncgi::parse + html::textarea info +} {<textarea name="info"></textarea> +} +test html-23.2 {html::textarea} { + html::init { + textarea.cols 50 + textarea.rows 8 + } + ncgi::reset info=[ncgi::encode "The textarea value."] + ncgi::parse + html::textarea info +} {<textarea name="info" cols="50" rows="8">The textarea value.</textarea> +} + +test html-23.3 {html::textarea, dangerous input} { + html::init { + textarea.cols 50 + textarea.rows 8 + } + ncgi::reset info=[ncgi::encode "</textarea><script>alert(1)</script>"] + ncgi::parse + html::textarea info +} {<textarea name="info" cols="50" rows="8"></textarea><script>alert(1)</script></textarea> +} + + +test html-24.1 {html::submit} { + catch {html::submit} +} {1} + +test html-24.2 {html::submit} { + catch {html::submit wrong num args} +} {1} + +test html-24.3 {html::submit} { + html::submit "Push Me" +} {<input type="submit" name="submit" value="Push Me"> +} + +test html-24.4 {html::submit} { + html::submit "Push Me" push +} {<input type="submit" name="push" value="Push Me"> +} + +test html-25.1 {html::varEmpty} { + catch {html::varEmpty} +} 1 +test html-25.2 {html::varEmpty} { + catch {html::varEmpty wrong num args} +} 1 + +test html-25.3 {html::varEmpty} { + if {[info exist x]} { + unset x + } + html::varEmpty x +} 1 +test html-25.4 {html::varEmpty} { + if {[info exist x]} { + unset x + } + set x "" + html::varEmpty x +} 1 + +test html-25.5 {html::varEmpty} { + if {[info exist x]} { + unset x + } + set x "foo" + html::varEmpty x +} 0 + +test html-26.1 {html::refresh} { + catch {html::refresh} +} 1 +test html-26.2 {html::refresh} { + catch {html::refresh wrong num args} +} 1 +test html-26.3 {html::refresh} { + html::refresh 4 +} {} +test html-26.4 {html::refresh} { + html::init + html::refresh 4 + html::head title +} {<html><head> + <title>title</title> + <meta http-equiv="Refresh" content="4"> +</head> +} +test html-26.5 {html::refresh} { + html::init + html::refresh 9 http://www.scriptics.com + html::head title +} {<html><head> + <title>title</title> + <meta http-equiv="Refresh" content="9; url=http://www.scriptics.com"> +</head> +} + +test html-27.1 {html::foreach--1 var, 1 iteration} { + html::foreach x {a} {<td>$x</td>} +} {<td>a</td>} + +test html-27.2 {html::foreach--1 var, multiple iterations} { + html::foreach x {a b} {<td>$x</td>} +} {<td>a</td><td>b</td>} + +test html-27.3 {html::foreach--1 var, 0 iterations} { + html::foreach x {} {<td>$x</td>} +} {} + +test html-27.4 {html::foreach--multiple vars, 1 iteration} { + html::foreach {x y} {a b} {<td>$x</td><td>$y</td>} +} {<td>a</td><td>b</td>} + +test html-27.5 {html::foreach--multiple vars, multiple iterations} { + html::foreach {x y} {a b c d} {<td>$x</td><td>$y</td>} +} {<td>a</td><td>b</td><td>c</td><td>d</td>} + +test html-27.6 {html::foreach--multiple varlists and vallists} { + html::foreach {a b} {1 2 3 4} {c d} {5 6 7 8} {e f} {9 10 11 12} { + $a$b$c$d$e$f} +} { + 1256910 + 34781112} + +test html-27.7 {html::foreach--subst body w/ vars and procs} { + html::foreach x {2 8} {<td>$x</td><td>[incr x]</td>} +} {<td>2</td><td>3</td><td>8</td><td>9</td>} + +test html-27.8 {html::foreach--subst body w/ nested foreach} { + html::foreach x {a b} { + [html::foreach y {c d} {$x$y}] + } +} { + acad + + bcbd + } + +test html-27.9 {html::foreach--subst body w/ multiple nested foreach's} { + html::foreach x {a b} { + [html::foreach y {c d} {$x$y + [html::foreach z {e f} {$z}] + }]} +} { + ac + ef + ad + ef + + bc + ef + bd + ef + } + +test html-28.1 {html::for--1 iteration} { + html::for {set i 0} {$i < 1} {incr i} {<td>$i</td>} +} {<td>0</td>} + +test html-28.2 {html::for--multiple iterations} { + html::for {set i 0} {$i < 3} {incr i} {<td>$i</td>} +} {<td>0</td><td>1</td><td>2</td>} + +test html-28.3 {html::for--0 iterations} { + html::for {set i 0} {$i < 0} {incr i} {<td>$i</td>} +} {} + +test html-28.4 {html::for--complex start, text, and next} { + html::for {set i 0; set j 10} {$i < 1 && $j < 11} {incr i; incr j} {$i $j} +} {0 10} + +test html-28.5 {html::for--subst body w/ vars and procs} { + html::for {set i 0} {$i < 3} {incr i} {$i [expr {$i + 5}] } +} {0 5 1 6 2 7 } + +test html-28.6 {html::for--subst body w/ nested for} { + set result [html::for {set i 0} {$i < 3} {incr i} { + [html::for {set j $i} {$j < 3} {incr j} {${i}__${j} }] + }] + regsub -all "\n" $result " " result + regsub -all " +" $result " " result + set result +} { 0__0 0__1 0__2 1__1 1__2 2__2 } + +test html-28.7 {html::for--subst body w/ multiple nested for's} { + set result [html::for {set i 0} {$i < 3} {incr i} { + [html::for {set j $i} {$j < 3} {incr j} { + [html::for {set k $j} {$k < 3} {incr k} {${i}__${j}__${k} }] + }] + }] + regsub -all "\n" $result " " result + regsub -all " +" $result " " result + set result +} { 0__0__0 0__0__1 0__0__2 0__1__1 0__1__2 0__2__2 1__1__1 1__1__2 1__2__2 2__2__2 } + +test html-29.1 {html::while--1 iteration} { + set i 0 + html::while {$i < 1} {<td>$i, [incr i]</td>} +} {<td>0, 1</td>} + +test html-29.2 {html::while--multiple iterations} { + set i 0 + html::while {$i < 3} {<td>$i, [incr i]</td>} +} {<td>0, 1</td><td>1, 2</td><td>2, 3</td>} + +test html-29.3 {html::while--0 iterations} { + set i 0 + html::while {$i < 0} {<td>$i</td>} +} {} + +test html-29.4 {html::while--complex start, text, and next} { + set i 0 + set j 10 + html::while {$i < 1 && $j < 11} {$i $j, [incr i] [incr j]} +} {0 10, 1 11} + +test html-29.5 {html::while--subst body w/ nested while} { + set i 0 + set result [html::while {$i < 3} { + [set j $i] + [html::while {$j < 3} { + ${i}__${j} + [incr j] + }] + [incr i] + }] + regsub -all "\n" $result " " result + regsub -all " +" $result " " result + set result +} { 0 0__0 1 0__1 2 0__2 3 1 1 1__1 2 1__2 3 2 2 2__2 3 3 } + +test html-29.7 {html::while--subst body w/ multiple nested while's} { + set i 0 + set result [html::while {$i < 3} { + [set j $i] + [html::while {$j != 3} { + [set k $j] + [html::while {$k != 3} { + ${i}__${j}__${k} + [incr k] + }] + [incr j] + }] + [incr i] + }] + regsub -all "\n" $result " " result + regsub -all " +" $result " " result + set result +} { 0 0 0__0__0 1 0__0__1 2 0__0__2 3 1 1 0__1__1 2 0__1__2 3 2 2 0__2__2 3 3 1 1 1 1__1__1 2 1__1__2 3 2 2 1__2__2 3 3 2 2 2 2__2__2 3 3 3 } + +test html-30.1 {html::if--eval then clause} { + set i 0 + html::if {$i < 1} {$i, [incr i]} +} {0, 1} + +test html-30.2 {html::if--don't eval then clause} { + set i 0 + html::if {$i == 1} {$i, [incr i]} +} {} + +test html-30.3 {html::if--eval else clause} { + set i 0 + html::if {$i == 1} {then clause} else {$i, [incr i]} +} {0, 1} + +test html-30.4 {html::if--1 elseif clause, eval else cause} { + set i 0 + html::if {$i < 0} { + then clause + } elseif {$i == 1} { + elseif clause + } else {$i, [incr i]} +} {0, 1} + +test html-30.5 {html::if--1 elseif clause, eval elseif cause} { + set i 0 + html::if {$i < 0} { + then clause + } elseif {$i == 0} {$i, [incr i]} +} {0, 1} + +test html-30.6 {html::if--1 elseif clause, eval elseif cause} { + set i 0 + html::if {$i < 0} { + then clause + } elseif {$i == 1} { + $i, [incr i] + } +} {} + +test html-30.7 {html::if--1 elseif clause, eval elseif cause} { + set i 0 + html::if {$i < 0} { + then clause + } elseif {$i == 0} {$i, [incr i]} else { + else clause + } +} {0, 1} + +test html-30.8 {html::if--1 elseif clause, eval elseif cause} { + set i 0 + html::if {$i < 0} { + then clause + } elseif {$i == 1} { + elseif1 clause + } elseif {$i == 0} {$i, [incr i]} elseif {$i == 2} { + elseif3 clause + } else { + else clause + } +} {0, 1} + +test html-30.9 {html::if--1 elseif clause, eval elseif cause} { + set i 0 + html::if {$i < 0} { + then clause + } elseif {$i == 1} { + elseif3 clause + } elseif {$i == 2} { + elseif1 clause + } elseif {$i == 0} {$i, [incr i]} else { + else clause + } +} {0, 1} + +test html-30.10 {html::if--multiple nested} { + set i 0 + set result [html::if {$i < 1} { + begin1 + [html::if {$i > -1} { + begin2 + [html::if {$i == 0} { + begin3 + [html::if {$i} {4}] + end3 + }] + end2 + }] + end1 + }] + regsub -all "\n" $result " " result + regsub -all " +" $result " " result + set result +} { begin1 begin2 begin3 end3 end2 end1 } + +test html-31.1 {html::set--set a new variable} { + set result [html::set x 1] + list $result $x +} {{} 1} + +test html-31.2 {html::set--set an existing variable} { + set x 0 + set result [html::set x 1] + list $result $x +} {{} 1} + +test html-32.1 {single argument} { + set x 0 + set result [html::eval {set x [format 22]}] + list $result $x +} {{} 22} + +test html-32.2 {multiple arguments} { + set a {$b} + set b xyzzy + set x 0 + set result [html::eval {set x [eval format $a]}] + list $result $x +} {{} xyzzy} + +test html-32.3 {single argument} { + set x [list] + set y 1 + set result [html::eval lappend x a b c d {$y} e f g] + list $result $x +} {{} {a b c d 1 e f g}} + +test html-32.4 {error: not enough arguments} -body { + html::eval +} -returnCodes error -result {wrong # args: should be "uplevel ?level? command ?arg ...?"} + +test html-32.6 {error in eval'ed command} -body { + html::eval {error "test error"} +} -returnCodes error -result {test error} + +test html-33.0 {html::font} -body { + html::font +} -result {} + +test html-33.1 {html::font} -body { + html::font size=18 +} -result {<font size=18>} + +test html-34.0 {html::nl2br} -body { + html::nl2br "a\n\rb\nc\rd" +} -result {a<br>b<br>c<br>d} + +test html-34.1 {html::nl2br, ticket 1742078} -body { + html::nl2br "a\r\nb" +} -result {a<br>b} + +# ------------------------------------------------------------------------- + +test html-tkt3439702-35.0 {html::css, not enough arguments} -body { + html::css +} -returnCodes error -result {wrong # args: should be "html::css href"} + +test html-tkt3439702-35.1 {html::css, too many arguments} -body { + html::css REF X +} -returnCodes error -result {wrong # args: should be "html::css href"} + +test html-tkt3439702-35.2 {html::css, single ref} -setup { + html::css-clear +} -body { + html::css "http://test.css" + string trim [html::head T] +} -cleanup { + html::css-clear +} -result "<html><head>\n\t<title>T</title>\n\t<meta http-equiv=\"Refresh\" content=\"9; url=http://www.scriptics.com\">\n\t<link rel=\"stylesheet\" type=\"text/css\" href=\"http://test.css\">\n</head>" + +test html-tkt3439702-35.3 {html::css, multiple ref} -setup { + html::css-clear +} -body { + html::css "http://test1.css" + html::css "http://test2.css" + string trim [html::head T] +} -cleanup { + html::css-clear +} -result {<html><head> + <title>T</title> + <meta http-equiv="Refresh" content="9; url=http://www.scriptics.com"> + <link rel="stylesheet" type="text/css" href="http://test1.css"> + <link rel="stylesheet" type="text/css" href="http://test2.css"> +</head>} + +# ------------------------------------------------------------------------- + +test html-tkt3439702-36.0 {html::js, not enough arguments} -body { + html::js +} -returnCodes error -result {wrong # args: should be "html::js href"} + +test html-tkt3439702-36.1 {html::js, too many arguments} -body { + html::js REF X +} -returnCodes error -result {wrong # args: should be "html::js href"} + +test html-tkt3439702-36.2 {html::js, single ref} -setup { + html::js-clear +} -body { + html::js "http://test.js" + string trim [html::head T] +} -cleanup { + html::js-clear +} -result {<html><head> + <title>T</title> + <meta http-equiv="Refresh" content="9; url=http://www.scriptics.com"> + <script language="javascript" type="text/javascript" src="http://test.js"></script> +</head>} + +test html-tkt3439702-36.3 {html::js, multiple ref} -setup { + html::js-clear +} -body { + html::js "http://test1.js" + html::js "http://test2.js" + string trim [html::head T] +} -cleanup { + html::js-clear +} -result {<html><head> + <title>T</title> + <meta http-equiv="Refresh" content="9; url=http://www.scriptics.com"> + <script language="javascript" type="text/javascript" src="http://test1.js"></script> + <script language="javascript" type="text/javascript" src="http://test2.js"></script> +</head>} + +test html-tkt3439702-37.0 {html::js, html::css, mixed} -setup { + html::css-clear + html::js-clear +} -body { + html::css "http://test.css" + html::js "http://test.js" + string trim [html::head T] +} -cleanup { + html::js-clear + html::css-clear +} -result {<html><head> + <title>T</title> + <meta http-equiv="Refresh" content="9; url=http://www.scriptics.com"> + <link rel="stylesheet" type="text/css" href="http://test.css"> + <script language="javascript" type="text/javascript" src="http://test.js"></script> +</head>} + +# ------------------------------------------------------------------------- +# TODO: html::css-clear, html::js-clear + + +test html-tktafe4366e2e-38.0 {html::doctype, not enough args} -body { + html::doctype +} -returnCodes error -result {wrong # args: should be "html::doctype arg"} + +test html-tktafe4366e2e-38.1 {html::doctype, too many args} -body { + html::doctype HTML401T X +} -returnCodes error -result {wrong # args: should be "html::doctype arg"} + +test html-tktafe4366e2e-38.2 {html::doctype, unknown type} -body { + html::doctype HTML401TXXX +} -returnCodes error -result {Unknown doctype "HTML401TXXX"} + +test html-tktafe4366e2e-38.3 {html::doctype} -body { + html::doctype HTML401T +} -result {<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">} + +# ------------------------------------------------------------------------- +testsuiteCleanup diff --git a/tcllib/modules/html/pkgIndex.tcl b/tcllib/modules/html/pkgIndex.tcl new file mode 100644 index 0000000..9d91097 --- /dev/null +++ b/tcllib/modules/html/pkgIndex.tcl @@ -0,0 +1,2 @@ +if {![package vsatisfies [package provide Tcl] 8.2]} {return} +package ifneeded html 1.4.4 [list source [file join $dir html.tcl]] |