[SCM] Render HTML and CSS content with tk branch, upstream, updated. 03f985498ecd3d90ae2c80eb8de88b84425594e0
Ole Streicher
debian at liska.ath.cx
Mon Feb 20 14:25:48 UTC 2012
The following commit has been merged in the upstream branch:
commit 5ab54e90ce329efe24abaf400b9ccad08b697f03
Author: Ole Streicher <debian at liska.ath.cx>
Date: Mon Feb 20 15:22:11 2012 +0100
Update to latest "fossil" SCM release b992a146316ef5c829a445f86257a44f52fa50e0
http://tkhtml.tcl.tk/fossil/info/b992a14631
http://tkhtml.tcl.tk/fossil/tarball/tkHTML-b992a146316ef5c8.tar.gz?uuid=b992a146316ef5c829a445f86257a44f52fa50e0
diff --git a/COMPILE.txt b/COMPILE.txt
index ddb9dc9..6f00cb5 100644
--- a/COMPILE.txt
+++ b/COMPILE.txt
@@ -115,7 +115,7 @@ This file has two sections:
If Boehm GC is not in the various paths, need to set CFLAGS, LDFLAGS and
LD_LIBRARY_PATH before running configure:
- INSTALL_PATH=/home/dan/javascript/install
+ INSTALL_PATH=/home/dan/work/tkhtml/js/
export CFLAGS="-I${INSTALL_PATH}/include/ -O2 -DNDEBUG"
export LDFLAGS=-L${INSTALL_PATH}/lib/
export LD_LIBRARY_PATH=${INSTALL_PATH}/lib/
diff --git a/COPYING b/COPYING
new file mode 100644
index 0000000..594c776
--- /dev/null
+++ b/COPYING
@@ -0,0 +1,448 @@
+GNU LESSER GENERAL PUBLIC LICENSE
+
+ Version 2.1, February 1999
+
+Copyright (C) 1991, 1999 Free Software Foundation, Inc.
+59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+Everyone is permitted to copy and distribute verbatim copies
+of this license document, but changing it is not allowed.
+
+[This is the first released version of the Lesser GPL. It also counts
+ as the successor of the GNU Library Public License, version 2, hence
+ the version number 2.1.]
+
+Preamble
+
+ The licenses for most software are designed to take away your freedom
+ to share and change it. By contrast, the GNU General Public Licenses
+ are intended to guarantee your freedom to share and change free
+ software--to make sure the software is free for all its users.
+
+ This license, the Lesser General Public License, applies to some
+ specially designated software packages--typically libraries--of the
+ Free Software Foundation and other authors who decide to use it. You
+ can use it too, but we suggest you first think carefully about whether
+ this license or the ordinary General Public License is the better
+ strategy to use in any particular case, based on the explanations
+ below.
+
+ When we speak of free software, we are referring to freedom of use,
+ not price. Our General Public Licenses are designed to make sure that
+ you have the freedom to distribute copies of free software (and charge
+ for this service if you wish); that you receive source code or can get
+ it if you want it; that you can change the software and use pieces of
+ it in new free programs; and that you are informed that you can do
+ these things.
+
+ To protect your rights, we need to make restrictions that forbid
+ distributors to deny you these rights or to ask you to surrender these
+ rights. These restrictions translate to certain responsibilities for
+ you if you distribute copies of the library or if you modify it.
+
+ For example, if you distribute copies of the library, whether gratis
+ or for a fee, you must give the recipients all the rights that we gave
+ you. You must make sure that they, too, receive or can get the source
+ code. If you link other code with the library, you must provide
+ complete object files to the recipients, so that they can relink them
+ with the library after making changes to the library and recompiling
+ it. And you must show them these terms so they know their rights.
+
+ We protect your rights with a two-step method: (1) we copyright the
+ library, and (2) we offer you this license, which gives you legal
+ permission to copy, distribute and/or modify the library.
+
+ To protect each distributor, we want to make it very clear that there
+ is no warranty for the free library. Also, if the library is modified
+ by someone else and passed on, the recipients should know that what
+ they have is not the original version, so that the original author's
+ reputation will not be affected by problems that might be introduced
+ by others.
+
+ Finally, software patents pose a constant threat to the existence of
+ any free program. We wish to make sure that a company cannot
+ effectively restrict the users of a free program by obtaining a
+ restrictive license from a patent holder. Therefore, we insist that
+ any patent license obtained for a version of the library must be
+ consistent with the full freedom of use specified in this license.
+
+ Most GNU software, including some libraries, is covered by the
+ ordinary GNU General Public License. This license, the GNU Lesser
+ General Public License, applies to certain designated libraries, and
+ is quite different from the ordinary General Public License. We use
+ this license for certain libraries in order to permit linking those
+ libraries into non-free programs.
+
+ When a program is linked with a library, whether statically or using a
+ shared library, the combination of the two is legally speaking a
+ combined work, a derivative of the original library. The ordinary
+ General Public License therefore permits such linking only if the
+ entire combination fits its criteria of freedom. The Lesser General
+ Public License permits more lax criteria for linking other code with
+ the library.
+
+ We call this license the "Lesser" General Public License because it
+ does Less to protect the user's freedom than the ordinary General
+ Public License. It also provides other free software developers Less
+ of an advantage over competing non-free programs. These disadvantages
+ are the reason we use the ordinary General Public License for many
+ libraries. However, the Lesser license provides advantages in certain
+ special circumstances.
+
+ For example, on rare occasions, there may be a special need to
+ encourage the widest possible use of a certain library, so that it
+ becomes a de-facto standard. To achieve this, non-free programs must
+ be allowed to use the library. A more frequent case is that a free
+ library does the same job as widely used non-free libraries. In this
+ case, there is little to gain by limiting the free library to free
+ software only, so we use the Lesser General Public License.
+
+ In other cases, permission to use a particular library in non-free
+ programs enables a greater number of people to use a large body of
+ free software. For example, permission to use the GNU C Library in
+ non-free programs enables many more people to use the whole GNU
+ operating system, as well as its variant, the GNU/Linux operating
+ system.
+
+ Although the Lesser General Public License is Less protective of the
+ users' freedom, it does ensure that the user of a program that is
+ linked with the Library has the freedom and the wherewithal to run
+ that program using a modified version of the Library.
+
+ The precise terms and conditions for copying, distribution and
+ modification follow. Pay close attention to the difference between a
+ "work based on the library" and a "work that uses the library". The
+ former contains code derived from the library, whereas the latter must
+ be combined with the library in order to run.
+
+TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License Agreement applies to any software library or other
+ program which contains a notice placed by the copyright holder or
+ other authorized party saying it may be distributed under the terms of
+ this Lesser General Public License (also called "this License"). Each
+ licensee is addressed as "you".
+
+ A "library" means a collection of software functions and/or data
+ prepared so as to be conveniently linked with application programs
+ (which use some of those functions and data) to form executables.
+
+ The "Library", below, refers to any such software library or work
+ which has been distributed under these terms. A "work based on the
+ Library" means either the Library or any derivative work under
+ copyright law: that is to say, a work containing the Library or a
+ portion of it, either verbatim or with modifications and/or translated
+ straightforwardly into another language. (Hereinafter, translation is
+ included without limitation in the term "modification".)
+
+ "Source code" for a work means the preferred form of the work for
+ making modifications to it. For a library, complete source code means
+ all the source code for all modules it contains, plus any associated
+ interface definition files, plus the scripts used to control
+ compilation and installation of the library.
+
+ Activities other than copying, distribution and modification are not
+ covered by this License; they are outside its scope. The act of
+ running a program using the Library is not restricted, and output from
+ such a program is covered only if its contents constitute a work based
+ on the Library (independent of the use of the Library in a tool for
+ writing it). Whether that is true depends on what the Library does and
+ what the program that uses the Library does.
+
+ 1. You may copy and distribute verbatim copies of the Library's
+ complete source code as you receive it, in any medium, provided that
+ you conspicuously and appropriately publish on each copy an
+ appropriate copyright notice and disclaimer of warranty; keep intact
+ all the notices that refer to this License and to the absence of any
+ warranty; and distribute a copy of this License along with the
+ Library.
+
+ You may charge a fee for the physical act of transferring a copy, and
+ you may at your option offer warranty protection in exchange for a
+ fee.
+
+ 2. You may modify your copy or copies of the Library or any portion of
+ it, thus forming a work based on the Library, and copy and distribute
+ such modifications or work under the terms of Section 1 above,
+ provided that you also meet all of these conditions:
+
+ * a) The modified work must itself be a software library.
+ * b) You must cause the files modified to carry prominent notices
+ stating that you changed the files and the date of any change.
+ * c) You must cause the whole of the work to be licensed at no
+ charge to all third parties under the terms of this License.
+ * d) If a facility in the modified Library refers to a function or a
+ table of data to be supplied by an application program that uses
+ the facility, other than as an argument passed when the facility
+ is invoked, then you must make a good faith effort to ensure that,
+ in the event an application does not supply such function or
+ table, the facility still operates, and performs whatever part of
+ its purpose remains meaningful.
+ (For example, a function in a library to compute square roots has
+ a purpose that is entirely well-defined independent of the
+ application. Therefore, Subsection 2d requires that any
+ application-supplied function or table used by this function must
+ be optional: if the application does not supply it, the square
+ root function must still compute square roots.)
+ These requirements apply to the modified work as a whole. If
+ identifiable sections of that work are not derived from the
+ Library, and can be reasonably considered independent and separate
+ works in themselves, then this License, and its terms, do not
+ apply to those sections when you distribute them as separate
+ works. But when you distribute the same sections as part of a
+ whole which is a work based on the Library, the distribution of
+ the whole must be on the terms of this License, whose permissions
+ for other licensees extend to the entire whole, and thus to each
+ and every part regardless of who wrote it.
+ Thus, it is not the intent of this section to claim rights or
+ contest your rights to work written entirely by you; rather, the
+ intent is to exercise the right to control the distribution of
+ derivative or collective works based on the Library.
+ In addition, mere aggregation of another work not based on the
+ Library with the Library (or with a work based on the Library) on
+ a volume of a storage or distribution medium does not bring the
+ other work under the scope of this License.
+
+ 3. You may opt to apply the terms of the ordinary GNU General Public
+ License instead of this License to a given copy of the Library. To do
+ this, you must alter all the notices that refer to this License, so
+ that they refer to the ordinary GNU General Public License, version 2,
+ instead of to this License. (If a newer version than version 2 of the
+ ordinary GNU General Public License has appeared, then you can specify
+ that version instead if you wish.) Do not make any other change in
+ these notices.
+
+ Once this change is made in a given copy, it is irreversible for that
+ copy, so the ordinary GNU General Public License applies to all
+ subsequent copies and derivative works made from that copy.
+
+ This option is useful when you wish to copy part of the code of the
+ Library into a program that is not a library.
+
+ 4. You may copy and distribute the Library (or a portion or derivative
+ of it, under Section 2) in object code or executable form under the
+ terms of Sections 1 and 2 above provided that you accompany it with
+ the complete corresponding machine-readable source code, which must be
+ distributed under the terms of Sections 1 and 2 above on a medium
+ customarily used for software interchange.
+
+ If distribution of object code is made by offering access to copy from
+ a designated place, then offering equivalent access to copy the source
+ code from the same place satisfies the requirement to distribute the
+ source code, even though third parties are not compelled to copy the
+ source along with the object code.
+
+ 5. A program that contains no derivative of any portion of the
+ Library, but is designed to work with the Library by being compiled or
+ linked with it, is called a "work that uses the Library". Such a work,
+ in isolation, is not a derivative work of the Library, and therefore
+ falls outside the scope of this License.
+
+ However, linking a "work that uses the Library" with the Library
+ creates an executable that is a derivative of the Library (because it
+ contains portions of the Library), rather than a "work that uses the
+ library". The executable is therefore covered by this License. Section
+ 6 states terms for distribution of such executables.
+
+ When a "work that uses the Library" uses material from a header file
+ that is part of the Library, the object code for the work may be a
+ derivative work of the Library even though the source code is not.
+ Whether this is true is especially significant if the work can be
+ linked without the Library, or if the work is itself a library. The
+ threshold for this to be true is not precisely defined by law.
+
+ If such an object file uses only numerical parameters, data structure
+ layouts and accessors, and small macros and small inline functions
+ (ten lines or less in length), then the use of the object file is
+ unrestricted, regardless of whether it is legally a derivative work.
+ (Executables containing this object code plus portions of the Library
+ will still fall under Section 6.)
+
+ Otherwise, if the work is a derivative of the Library, you may
+ distribute the object code for the work under the terms of Section 6.
+ Any executables containing that work also fall under Section 6,
+ whether or not they are linked directly with the Library itself.
+
+ 6. As an exception to the Sections above, you may also combine or link
+ a "work that uses the Library" with the Library to produce a work
+ containing portions of the Library, and distribute that work under
+ terms of your choice, provided that the terms permit modification of
+ the work for the customer's own use and reverse engineering for
+ debugging such modifications.
+
+ You must give prominent notice with each copy of the work that the
+ Library is used in it and that the Library and its use are covered by
+ this License. You must supply a copy of this License. If the work
+ during execution displays copyright notices, you must include the
+ copyright notice for the Library among them, as well as a reference
+ directing the user to the copy of this License. Also, you must do one
+ of these things:
+
+ * a) Accompany the work with the complete corresponding
+ machine-readable source code for the Library including whatever
+ changes were used in the work (which must be distributed under
+ Sections 1 and 2 above); and, if the work is an executable linked
+ with the Library, with the complete machine-readable "work that
+ uses the Library", as object code and/or source code, so that the
+ user can modify the Library and then relink to produce a modified
+ executable containing the modified Library. (It is understood that
+ the user who changes the contents of definitions files in the
+ Library will not necessarily be able to recompile the application
+ to use the modified definitions.)
+ * b) Use a suitable shared library mechanism for linking with the
+ Library. A suitable mechanism is one that (1) uses at run time a
+ copy of the library already present on the user's computer system,
+ rather than copying library functions into the executable, and (2)
+ will operate properly with a modified version of the library, if
+ the user installs one, as long as the modified version is
+ interface-compatible with the version that the work was made with.
+ * c) Accompany the work with a written offer, valid for at least
+ three years, to give the same user the materials specified in
+ Subsection 6a, above, for a charge no more than the cost of
+ performing this distribution.
+ * d) If distribution of the work is made by offering access to copy
+ from a designated place, offer equivalent access to copy the above
+ specified materials from the same place.
+ * e) Verify that the user has already received a copy of these
+ materials or that you have already sent this user a copy.
+
+ For an executable, the required form of the "work that uses the
+ Library" must include any data and utility programs needed for
+ reproducing the executable from it. However, as a special exception,
+ the materials to be distributed need not include anything that is
+ normally distributed (in either source or binary form) with the major
+ components (compiler, kernel, and so on) of the operating system on
+ which the executable runs, unless that component itself accompanies
+ the executable.
+
+ It may happen that this requirement contradicts the license
+ restrictions of other proprietary libraries that do not normally
+ accompany the operating system. Such a contradiction means you cannot
+ use both them and the Library together in an executable that you
+ distribute.
+
+ 7. You may place library facilities that are a work based on the
+ Library side-by-side in a single library together with other library
+ facilities not covered by this License, and distribute such a combined
+ library, provided that the separate distribution of the work based on
+ the Library and of the other library facilities is otherwise
+ permitted, and provided that you do these two things:
+
+ * a) Accompany the combined library with a copy of the same work
+ based on the Library, uncombined with any other library
+ facilities. This must be distributed under the terms of the
+ Sections above.
+ * b) Give prominent notice with the combined library of the fact
+ that part of it is a work based on the Library, and explaining
+ where to find the accompanying uncombined form of the same work.
+
+ 8. You may not copy, modify, sublicense, link with, or distribute the
+ Library except as expressly provided under this License. Any attempt
+ otherwise to copy, modify, sublicense, link with, or distribute the
+ Library is void, and will automatically terminate your rights under
+ this License. However, parties who have received copies, or rights,
+ from you under this License will not have their licenses terminated so
+ long as such parties remain in full compliance.
+
+ 9. You are not required to accept this License, since you have not
+ signed it. However, nothing else grants you permission to modify or
+ distribute the Library or its derivative works. These actions are
+ prohibited by law if you do not accept this License. Therefore, by
+ modifying or distributing the Library (or any work based on the
+ Library), you indicate your acceptance of this License to do so, and
+ all its terms and conditions for copying, distributing or modifying
+ the Library or works based on it.
+
+ 10. Each time you redistribute the Library (or any work based on the
+ Library), the recipient automatically receives a license from the
+ original licensor to copy, distribute, link with or modify the Library
+ subject to these terms and conditions. You may not impose any further
+ restrictions on the recipients' exercise of the rights granted herein.
+ You are not responsible for enforcing compliance by third parties with
+ this License.
+
+ 11. If, as a consequence of a court judgment or allegation of patent
+ infringement or for any other reason (not limited to patent issues),
+ conditions are imposed on you (whether by court order, agreement or
+ otherwise) that contradict the conditions of this License, they do not
+ excuse you from the conditions of this License. If you cannot
+ distribute so as to satisfy simultaneously your obligations under this
+ License and any other pertinent obligations, then as a consequence you
+ may not distribute the Library at all. For example, if a patent
+ license would not permit royalty-free redistribution of the Library by
+ all those who receive copies directly or indirectly through you, then
+ the only way you could satisfy both it and this License would be to
+ refrain entirely from distribution of the Library.
+
+ If any portion of this section is held invalid or unenforceable under
+ any particular circumstance, the balance of the section is intended to
+ apply, and the section as a whole is intended to apply in other
+ circumstances.
+
+ It is not the purpose of this section to induce you to infringe any
+ patents or other property right claims or to contest validity of any
+ such claims; this section has the sole purpose of protecting the
+ integrity of the free software distribution system which is
+ implemented by public license practices. Many people have made
+ generous contributions to the wide range of software distributed
+ through that system in reliance on consistent application of that
+ system; it is up to the author/donor to decide if he or she is willing
+ to distribute software through any other system and a licensee cannot
+ impose that choice.
+
+ This section is intended to make thoroughly clear what is believed to
+ be a consequence of the rest of this License.
+
+ 12. If the distribution and/or use of the Library is restricted in
+ certain countries either by patents or by copyrighted interfaces, the
+ original copyright holder who places the Library under this License
+ may add an explicit geographical distribution limitation excluding
+ those countries, so that distribution is permitted only in or among
+ countries not thus excluded. In such case, this License incorporates
+ the limitation as if written in the body of this License.
+
+ 13. The Free Software Foundation may publish revised and/or new
+ versions of the Lesser General Public License from time to time. Such
+ new versions will be similar in spirit to the present version, but may
+ differ in detail to address new problems or concerns.
+
+ Each version is given a distinguishing version number. If the Library
+ specifies a version number of this License which applies to it and
+ "any later version", you have the option of following the terms and
+ conditions either of that version or of any later version published by
+ the Free Software Foundation. If the Library does not specify a
+ license version number, you may choose any version ever published by
+ the Free Software Foundation.
+
+ 14. If you wish to incorporate parts of the Library into other free
+ programs whose distribution conditions are incompatible with these,
+ write to the author to ask for permission. For software which is
+ copyrighted by the Free Software Foundation, write to the Free
+ Software Foundation; we sometimes make exceptions for this. Our
+ decision will be guided by the two goals of preserving the free status
+ of all derivatives of our free software and of promoting the sharing
+ and reuse of software generally.
+
+ NO WARRANTY
+
+ 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
+ WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
+ EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
+ OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
+ KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+ PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
+ LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
+ THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+ 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
+ WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
+ AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
+ FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
+ CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
+ LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
+ RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
+ FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+ SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
+ DAMAGES.
+
+END OF TERMS AND CONDITIONS
diff --git a/COPYING.html b/COPYING.html
new file mode 100644
index 0000000..801ac90
--- /dev/null
+++ b/COPYING.html
@@ -0,0 +1,490 @@
+<H2><A NAME="SEC1" HREF="#TOC1">GNU LESSER GENERAL PUBLIC LICENSE</A></H2>
+<P>
+Version 2.1, February 1999
+
+<P>
+<PRE>
+Copyright (C) 1991, 1999 Free Software Foundation, Inc.
+59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+Everyone is permitted to copy and distribute verbatim copies
+of this license document, but changing it is not allowed.
+
+[This is the first released version of the Lesser GPL. It also counts
+ as the successor of the GNU Library Public License, version 2, hence
+ the version number 2.1.]
+</PRE>
+
+
+<H2><A NAME="SEC2" HREF="#TOC2">Preamble</A></H2>
+
+<P>
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+Licenses are intended to guarantee your freedom to share and change
+free software--to make sure the software is free for all its users.
+<P>
+ This license, the Lesser General Public License, applies to some
+specially designated software packages--typically libraries--of the
+Free Software Foundation and other authors who decide to use it. You
+can use it too, but we suggest you first think carefully about whether
+this license or the ordinary General Public License is the better
+strategy to use in any particular case, based on the explanations below.
+<P>
+ When we speak of free software, we are referring to freedom of use,
+not price. Our General Public Licenses are designed to make sure that
+you have the freedom to distribute copies of free software (and charge
+for this service if you wish); that you receive source code or can get
+it if you want it; that you can change the software and use pieces of
+it in new free programs; and that you are informed that you can do
+these things.
+<P>
+ To protect your rights, we need to make restrictions that forbid
+distributors to deny you these rights or to ask you to surrender these
+rights. These restrictions translate to certain responsibilities for
+you if you distribute copies of the library or if you modify it.
+<P>
+ For example, if you distribute copies of the library, whether gratis
+or for a fee, you must give the recipients all the rights that we gave
+you. You must make sure that they, too, receive or can get the source
+code. If you link other code with the library, you must provide
+complete object files to the recipients, so that they can relink them
+with the library after making changes to the library and recompiling
+it. And you must show them these terms so they know their rights.
+<P>
+ We protect your rights with a two-step method: (1) we copyright the
+library, and (2) we offer you this license, which gives you legal
+permission to copy, distribute and/or modify the library.
+<P>
+ To protect each distributor, we want to make it very clear that
+there is no warranty for the free library. Also, if the library is
+modified by someone else and passed on, the recipients should know
+that what they have is not the original version, so that the original
+author's reputation will not be affected by problems that might be
+introduced by others.
+<P>
+ Finally, software patents pose a constant threat to the existence of
+any free program. We wish to make sure that a company cannot
+effectively restrict the users of a free program by obtaining a
+restrictive license from a patent holder. Therefore, we insist that
+any patent license obtained for a version of the library must be
+consistent with the full freedom of use specified in this license.
+<P>
+ Most GNU software, including some libraries, is covered by the
+ordinary GNU General Public License. This license, the GNU Lesser
+General Public License, applies to certain designated libraries, and
+is quite different from the ordinary General Public License. We use
+this license for certain libraries in order to permit linking those
+libraries into non-free programs.
+<P>
+ When a program is linked with a library, whether statically or using
+a shared library, the combination of the two is legally speaking a
+combined work, a derivative of the original library. The ordinary
+General Public License therefore permits such linking only if the
+entire combination fits its criteria of freedom. The Lesser General
+Public License permits more lax criteria for linking other code with
+the library.
+<P>
+ We call this license the "Lesser" General Public License because it
+does Less to protect the user's freedom than the ordinary General
+Public License. It also provides other free software developers Less
+of an advantage over competing non-free programs. These disadvantages
+are the reason we use the ordinary General Public License for many
+libraries. However, the Lesser license provides advantages in certain
+special circumstances.
+<P>
+ For example, on rare occasions, there may be a special need to
+encourage the widest possible use of a certain library, so that it becomes
+a de-facto standard. To achieve this, non-free programs must be
+allowed to use the library. A more frequent case is that a free
+library does the same job as widely used non-free libraries. In this
+case, there is little to gain by limiting the free library to free
+software only, so we use the Lesser General Public License.
+<P>
+ In other cases, permission to use a particular library in non-free
+programs enables a greater number of people to use a large body of
+free software. For example, permission to use the GNU C Library in
+non-free programs enables many more people to use the whole GNU
+operating system, as well as its variant, the GNU/Linux operating
+system.
+<P>
+ Although the Lesser General Public License is Less protective of the
+users' freedom, it does ensure that the user of a program that is
+linked with the Library has the freedom and the wherewithal to run
+that program using a modified version of the Library.
+<P>
+ The precise terms and conditions for copying, distribution and
+modification follow. Pay close attention to the difference between a
+"work based on the library" and a "work that uses the library". The
+former contains code derived from the library, whereas the latter must
+be combined with the library in order to run.
+<P>
+
+<H2><A NAME="SEC3" HREF="#TOC3">TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION</A></H2>
+
+
+<P>
+<STRONG>0.</STRONG>
+This License Agreement applies to any software library or other
+program which contains a notice placed by the copyright holder or
+other authorized party saying it may be distributed under the terms of
+this Lesser General Public License (also called "this License").
+Each licensee is addressed as "you".
+<P>
+ A "library" means a collection of software functions and/or data
+prepared so as to be conveniently linked with application programs
+(which use some of those functions and data) to form executables.
+<P>
+ The "Library", below, refers to any such software library or work
+which has been distributed under these terms. A "work based on the
+Library" means either the Library or any derivative work under
+copyright law: that is to say, a work containing the Library or a
+portion of it, either verbatim or with modifications and/or translated
+straightforwardly into another language. (Hereinafter, translation is
+included without limitation in the term "modification".)
+<P>
+ "Source code" for a work means the preferred form of the work for
+making modifications to it. For a library, complete source code means
+all the source code for all modules it contains, plus any associated
+interface definition files, plus the scripts used to control compilation
+and installation of the library.
+<P>
+ Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running a program using the Library is not restricted, and output from
+such a program is covered only if its contents constitute a work based
+on the Library (independent of the use of the Library in a tool for
+writing it). Whether that is true depends on what the Library does
+and what the program that uses the Library does.
+<P>
+<STRONG>1.</STRONG>
+You may copy and distribute verbatim copies of the Library's
+complete source code as you receive it, in any medium, provided that
+you conspicuously and appropriately publish on each copy an
+appropriate copyright notice and disclaimer of warranty; keep intact
+all the notices that refer to this License and to the absence of any
+warranty; and distribute a copy of this License along with the
+Library.
+<P>
+ You may charge a fee for the physical act of transferring a copy,
+and you may at your option offer warranty protection in exchange for a
+fee.
+<P>
+<STRONG>2.</STRONG>
+You may modify your copy or copies of the Library or any portion
+of it, thus forming a work based on the Library, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+<P>
+<UL>
+ <LI><STRONG>a)</STRONG>
+ The modified work must itself be a software library.
+ <LI><STRONG>b)</STRONG>
+ You must cause the files modified to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ <LI><STRONG>c)</STRONG>
+ You must cause the whole of the work to be licensed at no
+ charge to all third parties under the terms of this License.
+
+ <LI><STRONG>d)</STRONG>
+ If a facility in the modified Library refers to a function or a
+ table of data to be supplied by an application program that uses
+ the facility, other than as an argument passed when the facility
+ is invoked, then you must make a good faith effort to ensure that,
+ in the event an application does not supply such function or
+ table, the facility still operates, and performs whatever part of
+ its purpose remains meaningful.
+ <P>
+ (For example, a function in a library to compute square roots has
+ a purpose that is entirely well-defined independent of the
+ application. Therefore, Subsection 2d requires that any
+ application-supplied function or table used by this function must
+ be optional: if the application does not supply it, the square
+ root function must still compute square roots.)
+ <P>
+ These requirements apply to the modified work as a whole. If
+ identifiable sections of that work are not derived from the Library,
+ and can be reasonably considered independent and separate works in
+ themselves, then this License, and its terms, do not apply to those
+ sections when you distribute them as separate works. But when you
+ distribute the same sections as part of a whole which is a work based
+ on the Library, the distribution of the whole must be on the terms of
+ this License, whose permissions for other licensees extend to the
+ entire whole, and thus to each and every part regardless of who wrote
+ it.
+ <P>
+ Thus, it is not the intent of this section to claim rights or contest
+ your rights to work written entirely by you; rather, the intent is to
+ exercise the right to control the distribution of derivative or
+ collective works based on the Library.
+ <P>
+ In addition, mere aggregation of another work not based on the Library
+ with the Library (or with a work based on the Library) on a volume of
+ a storage or distribution medium does not bring the other work under
+ the scope of this License.
+</UL>
+<P>
+<STRONG>3.</STRONG>
+You may opt to apply the terms of the ordinary GNU General Public
+License instead of this License to a given copy of the Library. To do
+this, you must alter all the notices that refer to this License, so
+that they refer to the ordinary GNU General Public License, version 2,
+instead of to this License. (If a newer version than version 2 of the
+ordinary GNU General Public License has appeared, then you can specify
+that version instead if you wish.) Do not make any other change in
+these notices.
+<P>
+ Once this change is made in a given copy, it is irreversible for
+that copy, so the ordinary GNU General Public License applies to all
+subsequent copies and derivative works made from that copy.
+<P>
+ This option is useful when you wish to copy part of the code of
+the Library into a program that is not a library.
+<P>
+<STRONG>4.</STRONG>
+You may copy and distribute the Library (or a portion or
+derivative of it, under Section 2) in object code or executable form
+under the terms of Sections 1 and 2 above provided that you accompany
+it with the complete corresponding machine-readable source code, which
+must be distributed under the terms of Sections 1 and 2 above on a
+medium customarily used for software interchange.
+<P>
+ If distribution of object code is made by offering access to copy
+from a designated place, then offering equivalent access to copy the
+source code from the same place satisfies the requirement to
+distribute the source code, even though third parties are not
+compelled to copy the source along with the object code.
+<P>
+<STRONG>5.</STRONG>
+A program that contains no derivative of any portion of the
+Library, but is designed to work with the Library by being compiled or
+linked with it, is called a "work that uses the Library". Such a
+work, in isolation, is not a derivative work of the Library, and
+therefore falls outside the scope of this License.
+<P>
+ However, linking a "work that uses the Library" with the Library
+creates an executable that is a derivative of the Library (because it
+contains portions of the Library), rather than a "work that uses the
+library". The executable is therefore covered by this License.
+Section 6 states terms for distribution of such executables.
+<P>
+ When a "work that uses the Library" uses material from a header file
+that is part of the Library, the object code for the work may be a
+derivative work of the Library even though the source code is not.
+Whether this is true is especially significant if the work can be
+linked without the Library, or if the work is itself a library. The
+threshold for this to be true is not precisely defined by law.
+<P>
+ If such an object file uses only numerical parameters, data
+structure layouts and accessors, and small macros and small inline
+functions (ten lines or less in length), then the use of the object
+file is unrestricted, regardless of whether it is legally a derivative
+work. (Executables containing this object code plus portions of the
+Library will still fall under Section 6.)
+<P>
+ Otherwise, if the work is a derivative of the Library, you may
+distribute the object code for the work under the terms of Section 6.
+Any executables containing that work also fall under Section 6,
+whether or not they are linked directly with the Library itself.
+<P>
+<STRONG>6.</STRONG>
+As an exception to the Sections above, you may also combine or
+link a "work that uses the Library" with the Library to produce a
+work containing portions of the Library, and distribute that work
+under terms of your choice, provided that the terms permit
+modification of the work for the customer's own use and reverse
+engineering for debugging such modifications.
+<P>
+ You must give prominent notice with each copy of the work that the
+Library is used in it and that the Library and its use are covered by
+this License. You must supply a copy of this License. If the work
+during execution displays copyright notices, you must include the
+copyright notice for the Library among them, as well as a reference
+directing the user to the copy of this License. Also, you must do one
+of these things:
+<P>
+<UL>
+ <LI><STRONG>a)</STRONG> Accompany the work with the complete corresponding
+ machine-readable source code for the Library including whatever
+ changes were used in the work (which must be distributed under
+ Sections 1 and 2 above); and, if the work is an executable linked
+ with the Library, with the complete machine-readable "work that
+ uses the Library", as object code and/or source code, so that the
+ user can modify the Library and then relink to produce a modified
+ executable containing the modified Library. (It is understood
+ that the user who changes the contents of definitions files in the
+ Library will not necessarily be able to recompile the application
+ to use the modified definitions.)
+
+ <LI><STRONG>b)</STRONG> Use a suitable shared library mechanism for linking with the
+ Library. A suitable mechanism is one that (1) uses at run time a
+ copy of the library already present on the user's computer system,
+ rather than copying library functions into the executable, and (2)
+ will operate properly with a modified version of the library, if
+ the user installs one, as long as the modified version is
+ interface-compatible with the version that the work was made with.
+
+ <LI><STRONG>c)</STRONG> Accompany the work with a written offer, valid for at
+ least three years, to give the same user the materials
+ specified in Subsection 6a, above, for a charge no more
+ than the cost of performing this distribution.
+
+ <LI><STRONG>d)</STRONG> If distribution of the work is made by offering access to copy
+ from a designated place, offer equivalent access to copy the above
+ specified materials from the same place.
+
+ <LI><STRONG>e)</STRONG> Verify that the user has already received a copy of these
+ materials or that you have already sent this user a copy.
+</UL>
+<P>
+ For an executable, the required form of the "work that uses the
+Library" must include any data and utility programs needed for
+reproducing the executable from it. However, as a special exception,
+the materials to be distributed need not include anything that is
+normally distributed (in either source or binary form) with the major
+components (compiler, kernel, and so on) of the operating system on
+which the executable runs, unless that component itself accompanies
+the executable.
+<P>
+ It may happen that this requirement contradicts the license
+restrictions of other proprietary libraries that do not normally
+accompany the operating system. Such a contradiction means you cannot
+use both them and the Library together in an executable that you
+distribute.
+<P>
+<STRONG>7.</STRONG> You may place library facilities that are a work based on the
+Library side-by-side in a single library together with other library
+facilities not covered by this License, and distribute such a combined
+library, provided that the separate distribution of the work based on
+the Library and of the other library facilities is otherwise
+permitted, and provided that you do these two things:
+<P>
+<UL>
+ <LI><STRONG>a)</STRONG> Accompany the combined library with a copy of the same work
+ based on the Library, uncombined with any other library
+ facilities. This must be distributed under the terms of the
+ Sections above.
+
+ <LI><STRONG>b)</STRONG> Give prominent notice with the combined library of the fact
+ that part of it is a work based on the Library, and explaining
+ where to find the accompanying uncombined form of the same work.
+</UL>
+<P>
+<STRONG>8.</STRONG> You may not copy, modify, sublicense, link with, or distribute
+the Library except as expressly provided under this License. Any
+attempt otherwise to copy, modify, sublicense, link with, or
+distribute the Library is void, and will automatically terminate your
+rights under this License. However, parties who have received copies,
+or rights, from you under this License will not have their licenses
+terminated so long as such parties remain in full compliance.
+<P>
+<STRONG>9.</STRONG>
+You are not required to accept this License, since you have not
+signed it. However, nothing else grants you permission to modify or
+distribute the Library or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Library (or any work based on the
+Library), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Library or works based on it.
+<P>
+<STRONG>10.</STRONG>
+Each time you redistribute the Library (or any work based on the
+Library), the recipient automatically receives a license from the
+original licensor to copy, distribute, link with or modify the Library
+subject to these terms and conditions. You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties with
+this License.
+<P>
+<STRONG>11.</STRONG>
+If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Library at all. For example, if a patent
+license would not permit royalty-free redistribution of the Library by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Library.
+<P>
+If any portion of this section is held invalid or unenforceable under any
+particular circumstance, the balance of the section is intended to apply,
+and the section as a whole is intended to apply in other circumstances.
+<P>
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system which is
+implemented by public license practices. Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+<P>
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+<P>
+<STRONG>12.</STRONG>
+If the distribution and/or use of the Library is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Library under this License may add
+an explicit geographical distribution limitation excluding those countries,
+so that distribution is permitted only in or among countries not thus
+excluded. In such case, this License incorporates the limitation as if
+written in the body of this License.
+<P>
+<STRONG>13.</STRONG>
+The Free Software Foundation may publish revised and/or new
+versions of the Lesser General Public License from time to time.
+Such new versions will be similar in spirit to the present version,
+but may differ in detail to address new problems or concerns.
+<P>
+Each version is given a distinguishing version number. If the Library
+specifies a version number of this License which applies to it and
+"any later version", you have the option of following the terms and
+conditions either of that version or of any later version published by
+the Free Software Foundation. If the Library does not specify a
+license version number, you may choose any version ever published by
+the Free Software Foundation.
+<P>
+<STRONG>14.</STRONG>
+If you wish to incorporate parts of the Library into other free
+programs whose distribution conditions are incompatible with these,
+write to the author to ask for permission. For software which is
+copyrighted by the Free Software Foundation, write to the Free
+Software Foundation; we sometimes make exceptions for this. Our
+decision will be guided by the two goals of preserving the free status
+of all derivatives of our free software and of promoting the sharing
+and reuse of software generally.
+<P>
+<STRONG>NO WARRANTY</STRONG>
+<P>
+<STRONG>15.</STRONG>
+BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
+WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
+EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
+OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
+KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
+LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
+THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+<P>
+<STRONG>16.</STRONG>
+IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
+WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
+AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
+FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
+CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
+LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
+FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGES.
+<P>
+<H2>END OF TERMS AND CONDITIONS</H2>
diff --git a/Makefile.in b/Makefile.in
index dcd975f..553510f 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -12,7 +12,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: Makefile.in,v 1.32 2006/10/07 13:36:26 danielk1977 Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.35 2008/03/02 15:00:13 danielk1977 Exp $
#========================================================================
# Add additional lines to handle any additional AC_SUBST cases that
@@ -36,7 +36,7 @@
#========================================================================
PKG_SOURCES = @PKG_SOURCES@
-PKG_OBJECTS = @PKG_OBJECTS@ cssprop.$(OBJEXT) cssparse.$(OBJEXT)
+PKG_OBJECTS = @PKG_OBJECTS@ cssprop.$(OBJEXT)
PKG_STUB_SOURCES = @PKG_STUB_SOURCES@
PKG_STUB_OBJECTS = @PKG_STUB_OBJECTS@
@@ -184,7 +184,21 @@ all: binaries libraries doc
binaries: $(BINARIES) pkgIndex.tcl
-libraries:
+HV3_VERSION = 0.1
+HV3_LIB = hv3-$(HV3_VERSION).tm
+
+HV3_TCL_SOURCE = \
+ $(srcdir)/hv/hv3_util.tcl \
+ $(srcdir)/hv/hv3.tcl \
+ $(srcdir)/hv/hv3_encodings.tcl \
+ $(srcdir)/hv/hv3_form.tcl \
+ $(srcdir)/hv/hv3_request.tcl
+
+$(HV3_LIB): $(HV3_TCL_SOURCE)
+ echo "package provide $(HV3_LIB)" > $@
+ cat $(HV3_TCL_SOURCE) >> $@
+
+libraries: $(HV3_LIB)
#========================================================================
@@ -212,6 +226,8 @@ install-libraries: libraries
echo "Installing $(srcdir)/$$i" ; \
$(INSTALL_DATA) $(srcdir)/$$i $(DESTDIR)$(includedir) ; \
done;
+ echo "Installing $(HV3_LIB)"
+ @$(INSTALL_DATA) $(HV3_LIB) $(DESTDIR)$(pkglibdir)
#========================================================================
# Install documentation. Unix manpages should go in the $(mandir)
@@ -279,8 +295,9 @@ $(PKG_STUB_LIB_FILE): $(PKG_STUB_OBJECTS)
VPATH = $(srcdir):$(srcdir)/src:$(srcdir)/unix:$(srcdir)/win:.
-HEADERS = htmlprop.h html.h cssparse.h css.h cssInt.h \
- cssprop.h htmltokens.h swproc.h htmldefaultstyle.c
+HEADERS = html.h cssInt.h css.h cssprop.h htmltokens.h htmldefaultstyle.c
+
+HDR = $(GENHDR) $(SRCHDR)
%. at OBJEXT@: %.c $(HEADERS)
$(COMPILE) -c -I. -I$(srcdir)/src `@CYGPATH@ $<` -o $@
@@ -303,18 +320,6 @@ cssprop.h: cssprop.tcl
cssprop.c: cssprop.h
-LEMON = lemon$(EXEEXT)
-
-$(LEMON): $(srcdir)/tools/lemon.c
- $(COMPILE) `@CYGPATH@ $(srcdir)/tools/lemon.c` -o $(LEMON)
-
-cssparse.h: $(srcdir)/src/cssparse.lem $(LEMON)
- cp $(srcdir)/src/cssparse.lem .
- cp $(srcdir)/tools/lempar.c .
- ./$(LEMON) cssparse.lem
-
-cssparse.c: cssparse.h
-
#========================================================================
# Create the pkgIndex.tcl file.
# It is usually easiest to let Tcl do this for you with pkg_mkIndex, but
@@ -328,6 +333,7 @@ cssparse.c: cssparse.h
pkgIndex.tcl:
echo 'package ifneeded $(PACKAGE_NAME) $(PACKAGE_VERSION) [list load [file join $$dir $(PKG_LIB_FILE)]]' > pkgIndex.tcl
+ echo 'package ifneeded hv3 $(HV3_VERSION) [list source [file join $$dir $(HV3_LIB)]]' >> pkgIndex.tcl
#========================================================================
# Distribution creation
diff --git a/configure b/configure
index a71f507..34fa09d 100755
--- a/configure
+++ b/configure
@@ -6422,6 +6422,40 @@ echo "$as_me: error: could not find source file '$i'" >&2;}
+ vars="cssparser.c"
+ for i in $vars; do
+ case $i in
+ \$*)
+ # allow $-var names
+ PKG_SOURCES="$PKG_SOURCES $i"
+ PKG_OBJECTS="$PKG_OBJECTS $i"
+ ;;
+ *)
+ # check for existence - allows for generic/win/unix VPATH
+ if test ! -f "${srcdir}/$i" -a ! -f "${srcdir}/src/$i" \
+ -a ! -f "${srcdir}/win/$i" -a ! -f "${srcdir}/unix/$i" \
+ ; then
+ { { echo "$as_me:$LINENO: error: could not find source file '$i'" >&5
+echo "$as_me: error: could not find source file '$i'" >&2;}
+ { (exit 1); exit 1; }; }
+ fi
+ PKG_SOURCES="$PKG_SOURCES $i"
+ # this assumes it is in a VPATH dir
+ i=`basename $i`
+ # handle user calling this before or after TEA_SETUP_COMPILER
+ if test x"${OBJEXT}" != x ; then
+ j="`echo $i | sed -e 's/\.[^.]*$//'`.${OBJEXT}"
+ else
+ j="`echo $i | sed -e 's/\.[^.]*$//'`.\${OBJEXT}"
+ fi
+ PKG_OBJECTS="$PKG_OBJECTS $j"
+ ;;
+ esac
+ done
+
+
+
+
vars="csssearch.c"
for i in $vars; do
case $i in
diff --git a/configure.in b/configure.in
index c0eb3c9..9629b8e 100644
--- a/configure.in
+++ b/configure.in
@@ -3,7 +3,7 @@ dnl This file is an input file used by the GNU "autoconf" program to
dnl generate the file "configure", which is run during Tcl installation
dnl to configure the system for the local environment.
#
-# RCS: @(#) $Id: configure.in,v 1.30 2007/07/22 06:45:49 danielk1977 Exp $
+# RCS: @(#) $Id: configure.in,v 1.31 2007/10/26 09:31:15 danielk1977 Exp $
#-----------------------------------------------------------------------
# Sample configure.in for Tcl Extensions. The only places you should
@@ -73,6 +73,7 @@ TEA_SETUP_COMPILER
TEA_ADD_SOURCES([css.c])
TEA_ADD_SOURCES([cssdynamic.c])
+TEA_ADD_SOURCES([cssparser.c])
TEA_ADD_SOURCES([csssearch.c])
TEA_ADD_SOURCES([htmldraw.c])
TEA_ADD_SOURCES([htmlfloat.c])
diff --git a/doc/browser.man b/doc/browser.man
new file mode 100644
index 0000000..fb67dd5
--- /dev/null
+++ b/doc/browser.man
@@ -0,0 +1,37 @@
+[TH ::hv3::browser n]
+
+[Section Name]
+ ::hv3::browser - Web browser widget.
+
+[Section Synopsis]
+ ::hv3::browser pathName ?options?
+
+[Section Standard Options]
+ [Code {
+ }]
+
+ See the options(n) manual entry for details on the standard options.
+
+[Section Widget-Specific Options]
+
+ [Option enablejavascript {
+ If set to true and the Tclsee package can be loaded,
+ javascript is enabled in the browser widget.
+
+ The default value is false.
+ }]
+ [Option unsafe {
+ This boolean option determines whether or not the javascript
+ interpreter has access to the function window.tcl(). Because
+ this function allows javascript programs embedded in
+ documents to evaluate Tcl scripts in the widget's intepreter,
+ any document loaded while this option is set should be
+ from a trusted source.
+
+ The default value is false.
+ }]
+
+[Section Description]
+
+[Section Widget Command]
+
diff --git a/doc/html.man b/doc/html.man
index 4c8a8e5..6a77240 100644
--- a/doc/html.man
+++ b/doc/html.man
@@ -40,14 +40,13 @@
passed to [SQ ::tkhtml::htmlstyle] then the returned document
includes some extra rules used when rendering legacy documents.
+ If the value of the -defaultstyle option is changed, the new
+ value does not take effect until after the next call to the
+ widget [SQ reset] method.
+
The default value of this option is the same as the string
returned by the [SQ ::tkhtml::htmlstyle] command.
}]
- [Option doublebuffer {
- This is a boolean option. If true, use a double buffered
- window to improve performance. The default is true for
- windows systems, and false for others.
- }]
[Option fontscale {
This option is set to a floating point number, default 1.0.
After CSS algorithms are used to determine a font size,
@@ -64,7 +63,7 @@
'xx-small', 'x-small', 'small', 'medium', 'large', 'x-large' or
'xx-large', respectively.
- The default value is {7 8 9 10 12 14 16}.
+ The default value is {8 9 10 11 13 15 17}.
}]
[Option forcefontmetrics {
This is a boolean option. If true, the font-metrics returned
@@ -86,6 +85,20 @@
The default value is false.
}]
+ [Option imagecache {
+ This boolean option (default true) determines whether or not
+ Tkhtml3 caches the images returned to it by the -imagecmd
+ callback script. If true, all images are cached until the
+ next time the [SQ reset] sub-command is invoked. If false,
+ images are discarded as soon as they are not in use.
+
+ For simple applications, or applications that retrieve
+ images from local sources, false is usually a better value
+ for this option (since it may save memory). However for
+ web-browser applications where the background images of
+ elements may be modified by mouseover events and so on,
+ true is a better choice.
+ }]
[Option imagecmd {
As well as for replacing entire document nodes (i.e. <img>),
images are used in several other contexts in CSS formatted
@@ -108,20 +121,6 @@
If the size or content of the image are modified while it is in
use the widget display is updated automatically.
}]
- [Option imagecache {
- This boolean option (default true) determines whether or not
- Tkhtml3 caches the images returned to it by the -imagecmd
- callback script. If true, all images are cached until the
- next time the [SQ reset] sub-command is invoked. If false,
- images are discarded as soon as they are not in use.
-
- For simple applications, or applications that retrieve
- images from local sources, false is usually a better value
- for this option (since it may save memory). However for
- web-browser applications where the background images of
- elements may be modified by mouseover events and so on,
- true is a better choice.
- }]
[Option mode {
This option may be set to "quirks", "standards" or
"almost standards", to set the rendering engine mode. The
@@ -129,6 +128,22 @@
TODO: List the differences between the three modes in Tkhtml.
}]
+ [Option parsemode {
+ This option may be set to "html", "xhtml" or "xml", to set
+ the parser mode. The default value is "html".
+
+ In "html" mode, the parser attempts to mimic the tag-soup
+ approach inherited by modern web-browsers from the bad old
+ days. Explicit XML style self-closing tags (i.e. closing
+ a markup tag with "/>" instead of ">") are not handled
+ specially. Unknown tags are ignored.
+
+ "xhtml" mode is the same as "html" mode except that explicit
+ self-closing tags are recognized.
+
+ "xml" mode is the same as "xhtml" mode except that unknown
+ tag names and XML CDATA sections are recognized.
+ }]
[Option shrink {
This boolean option governs the way the widgets requested width
and height are calculated. If it is set to false (the default),
@@ -917,4 +932,3 @@
[Section Orphan Nodes]
-
diff --git a/doc/hv3.man b/doc/hv3.man
index 32b3841..fdc7513 100644
--- a/doc/hv3.man
+++ b/doc/hv3.man
@@ -3,12 +3,75 @@
[Section Name]
hv3 - Mega-widget building on Tkhtml.
+ THIS IS A WORK IN PROGRESS. IT IS POSSIBLE TO USE THE HV3 WIDGET, BUT
+ IT IS NOT YET PROPERLY PACKAGED. POST ON THE MAILING LIST IF YOU WISH
+ TO USE IT NOW.
+
+ Comments and feedback also welcome.
+
[Section Synopsis]
[Code {
+ package require snit
package require hv3
- hv3 pathName ?options?
+ ::hv3::hv3 pathName ?options?
}]
+[Section Description]
+
+ The [SQ hv3] command creates a new window (given by the pathName
+ argument) and makes it into hv3 widget. The hv3 command
+ returns its pathName argument. At the time this command is invoked,
+ there must not exist a window named pathName, but pathName's parent
+ must exist. Hv3 is a pure Tcl widget implemented using Tkhtml3 and
+ the excellent mega-widget framework Snit.
+
+ An [SQ hv3] widget is not a web-browser. If it were to be used as
+ a component in a web-browser application it would represent a single
+ browser frame (or iframe). The API described in this document is
+ not the whole API offered by the snit object ::hv3::hv3. Instead,
+ it is the subset of that API that is expected not to change. No
+ guarantees of course.
+
+ There are two 'objects' involved in using the [SQ hv3] widget. One
+ is the widget itself ([SQ ::hv3::hv3]). The other is the
+ request-handle ([SQ ::hv3::request]). A request-handle is the
+ interface between the hv3 widget and wherever it is getting its
+ data from (i.e. your implementation of http://, https:// etc.).
+ Many users will also wish to understand the Tkhtml3 "node-handle"
+ interface, documented as part of the Tkhtml3 manpage.
+
+ An [SQ hv3] widget provides the following features on top of the
+ [SQ html] widget:
+
+[Bulletlist {
+ Built-in scrollbars.
+} {
+ Support for selecting text with the pointer.
+} {
+ Support for loading linked images and stylesheets from URIs.
+} {
+ Support for HTML forms and submission thereof.
+} {
+ Support for CSS configured hover (mouseover) effects.
+} {
+ Support for loading a new document by clicking on a hyper-link.
+}]
+
+ The two most important interfaces are the [SQ goto] method and the
+ _-requestcmd_ option. The [SQ goto] method tells the widget to
+ load the document identified by the specified absolute or relative
+ URI.
+
+ The _-requestcmd_ option must be configured with a callback script that
+ the widget invokes to request the requested document. It is the
+ users responsibility to retrieve the document and pass it back to
+ the widget. If the document contains links to external resources
+ (images or CSS stylesheets), then the widget invokes the
+ _-requestcmd_ script to request these. The _-requestcmd_ callback may
+ choose to implement handling for one or more of http:// URIs,
+ file:// URIs or any other existing or invented URI scheme. See
+ the "Example Usage" section below for an example.
+
[Section Standard Options]
[Code {
-height
@@ -20,55 +83,67 @@
this mega-widget.
[Code {
- -logcmd
+ -fontscale
-fonttable
+ -forcefontmetrics
+ -zoom
+ }]
+
+[Section Html Commands]
+ The following Tkhtml commands are exposed as public options of
+ this mega-widget.
+
+ [Code {
+ node ? ?-index? _x_ _y_?
}]
[Section Widget-Specific Options]
- [Option statusvar {
- If not set to an empty string (the default value), this
- option is set to the name of a Tcl variable in which the
- widget stores an English language message describing the
- outstanding downloads the widget is waiting on. The
- description is dynamically updated as download status
- changes.
- }]
- [Option cursorvar {
- If not set to an empty string (the default value), this
- option is set to the name of a Tcl variable in which the
- widget stores an English language message based on the
- node currently under the pointer. If the node is a
- hyper-link, the message displays the link target. Otherwise
- it displays the node element type, and the element types of
- the parent and ancestor nodes. The description is dynamically
- updated as the cursor moves.
+
+ [Option enableimages {
+ Boolean option (default true). True for image support, false
+ otherwise. If this option is set to false, then the
+ _-requestcmd_ script will never be invoked to request an
+ image resource.
}]
+ [Option isvisitedcmd {
+ If not an empty string, this option specifies a script for
+ the widget to invoke to determine if a hyperlink (<A>)
+ node should be styled with the :link or :visited
+ pseudo-class. The script is invoked with the node handle
+ appended to it. If true is returned, :visited is used,
+ otherwise :link.
+ }]
+ [Option requestcmd {
+ If this option is not set by the user code, then the Hv3
+ widget will be unable to display anything.
-[Section Description]
+ It should be set to a script that may be invoked by the hv3
+ widget to request a resource required to display a URI
+ requested via the [SQ goto] method. Each time a resource
+ is required, the _-requestcmd_ script is invoked with
+ a single argument appended to it, the name of a request
+ handle object. See section "Request Handles" for details.
+ }]
+ [Option targetcmd {
+ If this option is not set to an empty string (the default),
+ it should be set to a script that will be invoked each time
+ a hyper-link is clicked or a form submitted in the hv3 widget
+ by the end-user. A single argument is appended to the script
+ before it is evaluated, the Tkhtml3 node-handle for the
+ relevant <FORM> (in the case of form submittal) or
+ <A> (if the end user clicked a hyperlink) node. The
+ script should return the path of an hv3 widget into which
+ the new resource should be loaded. This is useful for
+ implementing browsers that support HTML frames and iframes.
- The [SQ hv3] command creates a new window (given by the pathName
- argument) and makes it into hv3 widget. The hv3 command
- returns its pathName argument. At the time this command is invoked,
- there must not exist a window named pathName, but pathName's parent
- must exist.
+ If the script returns an empty string the request is
+ abandoned and the new resource never loaded and the
+ form data (if any) not submitted.
- An [SQ hv3] widget provides the following features on top of the
- [SQ html] widget:
+ If the option is set to an empty string the new resource is
+ always loaded into the hv3 widget itself.
+ }]
-[Bulletlist {
- Built-in scrollbars.
-} {
- Support for selecting text with the pointer.
-} {
- Built-in support for the file:// protocol and an API to
- allow further protocols (http://, https:// ...) to be added.
-} {
- Support for loading linked images and stylesheets from URIs.
-} {
- Support for loading a new document by clicking on a
- hyper-link.
-}]
-
[Section Widget Command]
The [SQ hv3] command creates a new Tcl command whose name is
pathName. This command may be used to invoke various operations on
@@ -98,57 +173,301 @@
}]
[Subcommand {
- pathName goto _url_ _?options?_
- Where available options are:
- [Code {
- -noresolve
- -nocallback
- }]
+ pathName goto _uri_
+ Load the resource at _uri_ into the widget. If _uri_ is
+ not an absolute URI, it is resolved with respect to
+ the widget's current document URI (or <BASE> element
+ contents, if present).
}]
[Subcommand {
- pathName protocol _protocol_ _script_
- Register a new protocol handler with the widget. The
- protocol parameter is the name of the new protocol to
- handle, for example "http" or "https". When hv3 requires
- data from a URI matching the specified protocol it appends
- a download-handle to the supplied script and evaluates the
- result. See the "download-handle" section below for a
- description of the interface a protocol-handler script
- uses to return downloaded data to the widget.
+ pathName stop
+ Abandon all pending requests. All request handle objects
+ that are still outstanding are destroyed (it is an error
+ to use such a request handle after calling [SQ stop]).
}]
-[Section Download Handle]
- A download handle is passed to a protocol-handler script. It's
- job is to retrieve the data for a specified URI and pass it on
- to the hv3 widget. A download-handle is itself a Tcl command
- implementing the following sub-commands:
+[Section Request Handles]
+ To be useful, the user must provide the hv3 with some way to
+ request resources ((X)HTML documents, CSS stylesheets and binary
+ image files) identified by URI for display. To this end, the
+ user configures a _-requestcmd_ script with the hv3 widget.
+ Each time a resource is required, the _-requestcmd_ script
+ is evaluated with a single argument, a request handle object
+ identifier, appended to it.
-[Subcommand {
- downloadHandle append _data_
+ A request handle object is a snit object. The _-requestcmd_
+ script can query the object to determine the parameters of the
+ request and then invoke object methods to return data and
+ meta data. The key APIs are the _-uri_ option and the
+ [SQ finish] method.
+
+ Data may be returned asynchronously. That is, it is not necessary
+ to return data from within the _-requestcmd_ evaluation, the
+ request handle may be stored and data returned at some later time.
+
+[Subsection Request Handle Options]
+
+[Option enctype {
+ This option is used by "POST" requests, which may be made by an
+ hv3 widget if the loaded document contains a form and the end-user
+ submits it. For a "GET" request (all other requests, the usual
+ case) it is set to an empty string.
+
+ The cannonical test to check if a given request is a POST or GET
+ request is:
+
+ [Code {
+ if {[$handle cget -postdata] ne ""} {
+ # This is a POST request.
+ } else {
+ # This is a GET request.
+ }
+ }]
+
+ For POST requests, this option may be set by the Hv3 widget to
+ contain the Content-Type of the data stored in the _-postdata_
+ option. For example "application/x-www-form-urlencoded".
}]
-[Subcommand {
- downloadHandle binary
- Return true if binary data is expected, false if UTF-8.
+[Option header {
+ The Hv3 widget sets this option to an empty string before passing
+ the request handle to the user code.
+
+ The user code may set this option to a list containing data to
+ be handled by the hv3 widget as if it had been returned as the
+ HTTP header for an HTTP request. The list consists of alternating
+ HTTP header-names and values. This is the same format as the
+ "meta" element of the "state array" interface used by Tcl's
+ built-in http package.
+
+ The Hv3 widget interprets the following HTTP headers:
+
+[Bulletlist {
+ TODO.
+}]
}]
+[Option mimetype {
+ The Hv3 widget sets this option to the expected mime type of the
+ resource requested.
-[Subcommand {
- downloadHandle finish _data_
+ If the user code knows the mime type of the resource being returned,
+ it should set this option before the first invocation of the
+ [SQ append] method. Useful values recognized by the hv3 widget
+ include "text/xhtml" and "image/gif".
}]
+[Option postdata {
+ This option is used by "POST" requests, which may be made by an
+ hv3 widget if the loaded document contains a form and the end-user
+ submits it.
-[Subcommand {
- downloadHandle redirect _uri_
+ It contains the data to be posted.
+}]
+[Option requestheader {
+ The Hv3 widget sets this option to a list of HTTP header-names and
+ values to be handled as request parameters for an HTTP request (i.e.
+ the "referrer" header).
+
+ The user code should not change the value of this option.
}]
+[Option uri {
+ This option is always set by the Hv3 widget before passing the
+ request handle to the user code. It contains the absolute URI
+ of the resource required by the widget.
+
+ The user code should not change the value of this option.
+}]
+
+[Subsection Request Handle Methods]
[Subcommand {
- downloadHandle uri
- Return the URI to be retrieved. The URI is never relative
- and never includes a fragment (a URI fragment is the bit on
- the end after a # character).
+ requestHandle append _data_
+ This method should be invoked one or more times to return
+ data to the hv3 widget.
+
+ The data passed to this method should always be binary data.
+ If the data is actually text data for a document or stylesheet,
+ it's encoding is determined based on either a HTTP header
+ returned via the [SQ header] option, or a <meta>
+ element in the header section of an HTML or XHTML document.
+ If neither of these are present, the assumed encoding is
+ either the document encoding in the case of linked CSS
+ stylesheet, or the value returned by [SQ encoding system] for
+ an HTML or XHTML document.
}]
[Subcommand {
- downloadHandle cancelvar _varname_
+ requestHandle finish
+ This method should be called after all data has been
+ obtained. The request handle object is deleted by the
+ system from within this call, so the object may not be used
+ after this method has been invoked.
}]
+[Section Examples ]
+
+[Subsection Custom URI Schemes]
+
+ The hv3 widget may seem a little unusual at first in that there
+ is no interface to feed data directly from the users script to
+ the widget. Instead, the widget requests the required data by
+ invoking the _-requestcmd_ script. Data is identified by
+ the _-uri_ option of the request handle passed as an argument.
+
+ The reason for this is that the widget often deals with documents
+ that contain linked resources (external CSS stylesheets or images).
+ The resources are not always known when the user script initiates
+ loading the document. For example, if the following document is
+ to be loaded from URI "http://tkhtml.tcl.tk":
+
+ [Code {
+ <HTML>
+ <BODY>
+ <IMG src="image.gif">
+ </BODY>
+ </HTML>
+ }]
+
+ then the _-requestcmd_ must implement the HTTP protocol. The
+ user calls:
+
+ [Code {
+ $hv3 goto http://tkhtml.tcl.tk
+ }]
+
+ which causes the _-requestcmd_ script to be invoked with a
+ request handle argument specifying the URI "http://tkhtml.tcl.tk".
+
+ When the _-requestcmd_ returns the data for the URI
+ "http://tkhtml.tcl.tk", the widget invokes the _-requestcmd_ a
+ second time, with a request handle argument specifying the URI
+ "http://tkhtml.tcl.tk/image.gif". If the document contained links
+ to CSS stylesheets or other images, the _-requestcmd- script would
+ be invoked for each of these also.
+
+ All this is fine if you are fetching data from http servers, but
+ a little inconvenient if the user script already has the document
+ to display ready in a Tcl variable (or variables). The solution
+ here is to invent a custom URI scheme to use within the
+ application. For example, the following example demonstrates a
+ _-requestcmd_ script that implements the "tclvar:", URI scheme
+ for refering to global Tcl variables.
+
+ [Code {
+ proc tclvar_requestcmd {R} {
+ # Get the URI from the request handle. The URI should look
+ # something like:
+ #
+ # tclvar:///<global varname>
+ #
+ set uri \[$R cget -uri]
+
+ # Strip "tclvar:///" from the start of the URI.
+ set var \[string range $uri 10 end]
+
+ # Return the data in the global variable $var to the widget.
+ global $var
+ $R finish \[set $var]
+ }
+ }]
+
+ And a simple script for using this _-requestcmd_:
+
+ [Code {
+ set my_document {
+ <HTML>
+ <LINK rel="stylesheet" href="my_stylesheet">
+ <BODY>
+ <P>Some red text.</P>
+ </BODY>
+ </HTML>
+ }
+ set my_stylesheet {
+ P { color : red }
+ }
+
+ ::hv3::hv3 .hv3
+ pack .hv3 -fill both -expand true
+
+ .hv3 configure -requestcmd tclvar_requestcmd
+ .hv3 goto tclvar:///my_document
+ }]
+
+ Note the complication in the code above - the string "tclvar:///" is
+ found at the start of each URI passed to [SQ tclvar_requestcmd]. This
+ is because Hv3 resolves and escapes all URIs against the base URI
+ of the currently loaded document before passing them to the
+ _-requestcmd_. This means you need to be careful with special
+ characters. If the name of the variable storing the stylesheet
+ document in the above example were _::css::my_stylesheet_, then
+ markup like this:
+
+ [Code {
+ <LINK rel="stylesheet" href="::css::my_stylesheet">
+ }]
+
+ would not work. The string "::css::my_stylesheet" is not a valid
+ relative or absolute URI, so the results of resolving it against
+ the base URI of the document, "tclvar:///my_document", are not
+ defined. The solution is to escape the variable names using URI
+ escapes. The Tkhtml3 package provides the [SQ ::tkhtml::encode]
+ and [SQ ::tkhtml::decode] commands for escaping and unescaping
+ strings, respectively. After modifying the _-requestcmd_ proc
+ to support escaped strings, it looks like this:
+
+ [Code {
+ proc tclvar_requestcmd {R} {
+ # Get the URI from the request handle. The URI should look
+ # something like:
+ #
+ # tclvar:///<global varname>
+ #
+ set uri \[$R cget -uri]
+
+ # Strip "tclvar:///" from the start of the URI.
+ set var \[::thtml::decode \[string range $uri 10 end]]
+
+ # Return the data in the global variable $var to the widget.
+ global $var
+ $R finish \[set $var]
+ }
+ }]
+
+ This could be used with a script like this:
+
+ [Code {
+ set my/document {
+ <HTML>
+ <LINK rel="stylesheet" href="%3A%3Acss%3A%3Amy_stylesheet">
+ <BODY>
+ <P>Some red text.</P>
+ </BODY>
+ </HTML>
+ }
+ namespace eval ::css {
+ set my_stylesheet {
+ P { color : red }
+ }
+ }
+
+ ::hv3::hv3 .hv3
+ pack .hv3 -fill both -expand true
+
+ .hv3 configure -requestcmd tclvar_requestcmd
+ .hv3 goto tclvar:///\[::tkhtml::encode my/document]
+ }]
+
+ In this case the two invocation of tclvar_requestcmd are made with
+ request handle arguments with the following _-uri_ option values:
+
+ [Code {
+ tclvar:///my%2Fdocument
+ tclvar:///%3A%3Acss%3A%3Amy_stylesheet
+ }]
+
+ Other custom URI scheme handlers could retrieve data by evaluating
+ Tcl scripts, querying a database or accessing any other part of the
+ application.
+
+
+
diff --git a/doc/interface.html b/doc/interface.html
new file mode 100644
index 0000000..0188cb1
--- /dev/null
+++ b/doc/interface.html
@@ -0,0 +1,89 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<HTML>
+<HEAD>
+ <META HTTP-EQUIV="CONTENT-TYPE" CONTENT="text/html; charset=utf-8">
+ <TITLE></TITLE>
+ <META NAME="GENERATOR" CONTENT="OpenOffice.org 1.1.3 (Linux)">
+ <META NAME="CREATED" CONTENT="20050506;10123100">
+ <META NAME="CHANGED" CONTENT="20050518;10552700">
+ <STYLE>
+ <!--
+ @page { size: 8.5in 11in; margin-left: 1.25in; margin-right: 1.25in; margin-top: 1in; margin-bottom: 1in }
+ H1 { margin-bottom: 0.08in }
+ H1.western { font-family: "Nimbus Sans L", sans-serif; font-size: 16pt }
+ H1.cjk { font-family: "HG Mincho Light J", "MS Mincho", "HG Mincho J", "HG Mincho L", "HG Mincho", "Mincho", "MS PMincho", "HG Mincho Light J", "MS Gothic", "HG Gothic J", "HG Gothic B", "HG Gothic", "Gothic", "MS PGothic", "Andale Sans UI", "Arial Unicode MS", "Lucida Sans Unicode", "Tahoma"; font-size: 16pt }
+ H1.ctl { font-family: "Lucidasans"; font-size: 16pt }
+ P { margin-bottom: 0.08in }
+ -->
+ </STYLE>
+</HEAD>
+<BODY LANG="en-US" DIR="LTR">
+<H1 CLASS="western">Synopsis</H1>
+<P STYLE="margin-bottom: 0in">html <I>pathName</I> ?<I>options</I>?</P>
+<H1 CLASS="western">Widget Specific Options</H1>
+<PRE STYLE="margin-bottom: 0.2in">-importCommand
+-selectionStyle</PRE><H1 CLASS="western">
+Widget Command</H1>
+<P><I>pathName </I>handler node <I>tag script</I></P>
+<P><I>pathName </I>handler script <I>tag script</I></P>
+<P><BR><BR>
+</P>
+<P><I>pathName </I>html parse ?-final? <I>html-text</I></P>
+<P><I>pathName </I>html clear</P>
+<H3>Stylesheets</H3>
+<P>The following commands are used to add style information to a
+document, in the form of CSS stylesheets.</P>
+<P><I>pathName</I> style parse <I>stylesheet-id</I> <I>stylesheet-text</I></P>
+<P STYLE="margin-left: 0.79in; font-style: normal">Add a stylesheet
+to the widget. The value passed as <I>stylesheet-text</I> should
+contain a valid CSS stylesheet. If the stylesheet contains an
+“@import†directive, and a value has been set for the widget
+-importCommand option, then the callback script passed to
+-importCommand is invoked from within this call.</P>
+<P STYLE="margin-left: 0.79in; font-style: normal">The <I>stylesheet-id</I>
+is a string used to determine the priority of the stylesheet relative
+to other stylesheets added to the same widget. The first part of the
+<I>stylesheet-id</I> must be either “author.â€, “user.†or
+“agent.â€, to mark the stylesheet as an author, user or agent
+stylesheet respectively (see CSS documentation for how this affects
+the priority of the stylesheet). For stylesheets where the first part
+of the id is identical, the id strings are compared lexographically
+to determine priority. A stylesheet id that occurs later in
+dictionary order has a higher priority.</P>
+<P STYLE="margin-left: 0.79in; font-style: normal">For example, the
+following list of stylesheet ids is sorted from lowest to highest
+priority:</P>
+<P STYLE="margin-left: 1.58in; font-style: normal">agent.1<BR>agent.2<BR>user.1<BR>user.2<BR>author.1<BR>author.1.1</P>
+<P STYLE="margin-left: 0.79in; font-style: normal">A <I>stylesheet-id</I><SPAN STYLE="font-style: normal">
+need not be unique. In this case the stylesheet priority is
+determined by the order in which the stylesheets are added.</SPAN></P>
+<P><I>pathName</I> style clear ?<I>stylesheet-id</I>?</P>
+<P STYLE="margin-left: 0.79in">Remove the stylesheet(s) with the
+specified <I>stylesheet-id</I> from the widget.
+</P>
+<P><I>pathName</I> style apply</P>
+<P><I>pathName</I> style syntax_errs</P>
+<H3>Layout</H3>
+<P><I>pathName</I> layout primitives</P>
+<PRE>draw_text
+draw_quad
+draw_image
+draw_window
+draw_origin
+draw_background</PRE><P>
+<I>pathName </I>layout node ?-width <I>width</I>? <I>x y</I></P>
+<P><I>pathName</I> layout force -width <I>?width?</I> -window
+?<I>window?</I></P>
+<H1 CLASS="western">Node Command</H1>
+<P><I>node </I>tag</P>
+<P><I>node</I> attr <I>attribute-name</I></P>
+<P><I>node </I>property <I>property-name ?value?</I></P>
+<P><I>node </I>clearproperties</P>
+<P><I>node </I>parent</P>
+<P><I>node </I>numchildren</P>
+<P><I>node</I> child <I>child-index</I></P>
+<P><I>node </I>html</P>
+<P><BR><BR>
+</P>
+</BODY>
+</HTML>
\ No newline at end of file
diff --git a/doc/macros.tcl b/doc/macros.tcl
index 2885b94..d2932f7 100644
--- a/doc/macros.tcl
+++ b/doc/macros.tcl
@@ -277,7 +277,7 @@ proc Section {args} {
proc Subsection {args} {
set n [incr ::HtmlMacros::N]
lappend ::HtmlMacros::Index [list SUBSECTION $args]
- return [Block "<a name=\"section$n\"><h3$args</h3></a>"]
+ return [Block "<a name=\"section$n\"><h3>$args</h3></a>"]
}
proc Code {args} {
@@ -351,7 +351,11 @@ close $fd
set ::TABS ""
catch {
source [file join [file dirname $file] .. webpage common.tcl]
- set ::TABS [getTabs 2]
+ if {[string match *hv3* $file]} {
+ set ::TABS [getTabs 4]
+ } else {
+ set ::TABS [getTabs 2]
+ }
} msg
# puts stderr "ERROR $msg"
diff --git a/doc/notes1.txt b/doc/notes1.txt
new file mode 100644
index 0000000..120f33f
--- /dev/null
+++ b/doc/notes1.txt
@@ -0,0 +1,52 @@
+The HTML widget uses lots of TCL callback routines. But a TCL
+callback can do nasty things. For example, a TCL callback
+could delete the HTML widget that invoked the callback. Or
+it could delete the TCL interpreter in which the HTML widget
+is running. So we have to call HtmlLock() before invoking
+a TCL callback and check to make sure the widget was not
+deleted before using any fields in the widget structure after
+the callback runs.
+
+The following routines can call TCL callbacks, either directly
+or indirectly:
+
+ HtmlTokenizerAppend()
+ HtmlParseCmd()
+ HtmlWidgetCommand()
+ HtmlGetImage()
+ HtmlAddStyle()
+ HtmlParseCmd()...
+ HtmlSizer()
+ HtmlLayout()
+ HtmlRedrawCallback()
+ GetLinkColor()
+ HtmlAddStyle()...
+ HtmlCallResolver()
+ HtmlGetImage()...
+ HtmlResolveCmd()
+ HtmlWidgetCommand()
+ HtmlRedrawCallback()...
+ HtmlGetFont()
+ DrawSelectionBackground()
+ HtmlBlockDraw()...
+ HtmlBlockDraw()
+ HtmlRedrawCallback()
+ FindIndexInBlock()
+ DecodeBaseIndex()
+ HtmlGetIndex()
+ HtmlIndexCmd()
+ HtmlWidgetCommand()...
+ HtmlSelectionSetCmd()
+ HtmlWidgetCommand()...
+ HtmlInsertCmd()
+ HtmlWidgetCommand()...
+ Paragraph()
+ DoBreakMarkup()
+ HtmlLayoutBlock()
+ HtmlLayout()...
+ HtmlTableLayout()
+ DoBreakMarkup()...
+ HtmlDeleteControls()
+ HtmlClear()
+ HtmlWidgetCommand()...
+ HtmlDestroyWidget()
diff --git a/doc/simple.make b/doc/simple.make
new file mode 100644
index 0000000..cd99dc6
--- /dev/null
+++ b/doc/simple.make
@@ -0,0 +1,80 @@
+#! /bin/sh
+#
+# Trying to generate a loadable module for Tcl/Tk8.1.1 on
+# WindowsNT using Cygwin20 cross-compiler running under
+# RedHat6.0.
+
+# Step -1:
+# Make a copy of winsock.h into winsock2.h. "Winsock2.h" is needed by
+# tclWinPort.h. tclWinPort.h is included by tclStubLib.c in step 3.
+#
+
+# Step 0:
+# Make sure the cross-compiler tools are on PATH and remove
+# old files.
+#
+PATH=$PATH:/opt/cygwin20/bin
+rm -f simple.o stublib.o simple.dll
+
+# Step 1:
+# Generate the C source code into "simple.c"
+#
+cat >simple.c <<\END
+#include <tcl.h>
+
+int Simple_Init(Tcl_Interp *interp){
+ Tcl_InitStubs(interp,"8.1",0);
+ Tk_InitStubs(interp,"8.1",0);
+ return TCL_OK;
+}
+END
+
+# Step 2:
+# Compile the C source code yielding simple.o
+#
+i586-cygwin32-gcc \
+ -I/home/drh/tcltk/tcl8.1.1/generic \
+ -mno-cygwin \
+ -DUSE_TCL_STUBS=1 \
+ -c simple.c
+
+# Step 3:
+# Compile the Stub libraries yielding tclstub.o and tkstub.o
+#
+i586-cygwin32-gcc \
+ -I/home/drh/tcltk/tcl8.1.1/generic \
+ -I/home/drh/tcltk/tcl8.1.1/win \
+ -mno-cygwin \
+ -o tclstub.o \
+ -c /home/drh/tcltk/tcl8.1.1/generic/tclStubLib.c
+i586-cygwin32-gcc \
+ -I/home/drh/tcltk/tcl8.1.1/generic \
+ -I/home/drh/tcltk/tcl8.1.1/win \
+ -I/home/drh/tcltk/tk8.1.1/generic \
+ -I/home/drh/tcltk/tk8.1.1/win \
+ -I/home/drh/tcltk/tk8.1.1/xlib \
+ -mno-cygwin \
+ -o tkstub.o \
+ -c /home/drh/tcltk/tk8.1.1/generic/tkStubLib.c
+
+# Step 4:
+# Generate the DEF file
+#
+cat >simple.def <<\END
+EXPORTS
+Simple_Init
+END
+
+# Step 5:
+# Use dllwrap to build the DLL. Note: tclstub81.lib is copied out
+# of the binary tk8.1 distribution from Scriptics.
+#
+i586-cygwin32-dllwrap \
+ --def simple.def \
+ -v \
+ --driver-name i586-cygwin32-gcc \
+ --dlltool-name i586-cygwin32-dlltool \
+ --as i586-cygwin32-as \
+ --dllname simple.dll \
+ --target i386-mingw32 -mno-cygwin \
+ simple.o tclstub.o tkstub.o
diff --git a/doc/spec.html b/doc/spec.html
new file mode 100644
index 0000000..72548db
--- /dev/null
+++ b/doc/spec.html
@@ -0,0 +1,993 @@
+<html>
+<!--
+ Specifications for the Tk HTML Widget
+ $Revision: 1.12 $
+ Copyright (C) 1997, 1998, 1999 D. Richard Hipp
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ Author Contact Information:
+ drh at acm.org
+ http://www.hwaci.com/drh/
+
+ @(#) $Id: spec.html,v 1.12 2002/09/27 16:51:30 andreas_kupries Exp $
+-->
+<head>
+<title>Interface Specification For The HTML Widget</title>
+</head>
+<body bgcolor=white>
+<h1>Interface Specification For The HTML Widget</h1>
+
+<p>This is a draft interface specification for the Tk HTML
+widget currently under development.
+Since it is still a draft, it is subject to change.
+Eventually, the interface will stabilize and this interface
+specification will morph into a manual page.</p>
+
+<h2>Configuration Options</h2>
+
+<table cellspacing=10>
+<tr><td valign=top><tt>-appletcommand</tt></td>
+<td>
+ <p>This option specifies the name of the Tcl procedure to invoke when the
+ <tt><applet>...</applet></tt> tag sequence is seen. The html
+ widget will append two arguments to the procedure before calling it.
+ The first argument is the name of a widget that the callback should
+ create to hold the applet.
+ The second argument is
+ a list of name/value pairs which are the arguments to
+ the <tt><applet></tt> tag.</p>
+
+ <p>The text between <tt><applet></tt> and <tt></applet></tt>
+ is normally suppressed.
+ However, if the <tt>-appletcommand</tt> option is set to the empty string,
+ the <tt><applet></tt> tag is ignored and all text between
+ <tt><applet></tt> and <tt></applet></tt> is displayed
+ normally.</p>
+
+ <p>"<embed>" is treated as an alias for
+ "<applet></applet>".</p>
+</td></tr>
+
+<tr><td valign=top><tt>-background</tt></td>
+<td>
+ <p>The background color for the widget.</p>
+
+ <p>Note that the <tt><body bgcolor=...></tt> HTML tag does not
+ automatically cause the widget to change its background color. If
+ you want the background color to change in response to this HTML tag,
+ then your Tcl script should intercept
+ the <tt><body></tt> tag using the
+ ``<tt>token handler</tt>'' widget command (described below) and
+ change the background color manually.</p>
+</td></tr>
+
+<tr><td valign=top><tt>-base</tt></td>
+<td>
+ <p>The base URI for the current document. This should be set to
+ the URI that was used to retrieve the document before parsing
+ begins.</p>
+</td></tr>
+
+<tr><td valign=top><tt>-bd</tt><td>An alias for <tt>-borderwidth</tt>
+
+<tr><td valign=top><tt>-bg</tt><td>An alias for <tt>-background</tt>
+
+<tr><td valign=top><tt>-borderwidth</tt></td>
+<td>
+ <p>The width of the 3-D border drawn around the parameter of the widget, in
+ pixels.</p>
+</td></tr>
+
+<tr><td valign=top><tt>-cursor</tt></td>
+<td>
+ <p>The cursor displayed when the pointer is positioned over the HTML widget.
+ If {}, the cursor reverts to its default shape.</p>
+</td></tr>
+
+<tr><td valign=top><tt>-exportselection</tt></td>
+</tr>
+
+<tr><td valign=top><tt>-fontcommand</tt></td>
+<td>
+ <p>The name of a TCL procedure that is used to convert HTML font names
+ into TCL font names. A default built-in procedure is used if the value
+ of this option is {}.</p>
+
+ <p>When the HTML widget needs a new font, it calls this procedure with
+ two arguments. This first argument is the font size expressed as an
+ integer between 1 and 7. The standard size is 4. The second argument
+ is a set of between 0 and 3 keywords drawn from the following set:
+ "bold", "italic", and "fixed". If the "bold" keyword is present in
+ the second argument, the font returned should be bold. If the "italic"
+ keyword is present, the font should be italic. If the "fixed" keyword
+ is present, the font should be fixed-width. The TCL procedure should
+ return the name of the TCL font that the HTML widget will use to render
+ the given HTML font. If the TCL procedure returns an empty string,
+ then the built-in default procedure is used to determine the font.</p>
+
+ <p>Examples: This is {4 {}}. <tt>This is {4 fixed}</tt>.
+ <small>This is {3 {}}</small>. <large><tt><bold>This is {5 {fixed bold}}
+ </bold></tt></large></p>
+</td></tr>
+
+
+<tr><td valign=top><tt>-fg</tt></td>
+<td>An alias for <tt>-foreground</tt>.</td>
+</tr>
+
+<tr><td valign=top><tt>-foreground</tt></td>
+<td>
+ The default foreground color in which HTML text is rendered.
+ The HTML can override this using the <tt>color=...</tt> attribute
+ on various HTML tags.
+</td></tr>
+
+<tr><td valign=top>
+<code>-formcommand <var>string</var></code>
+</td><td>
+Declares a handler for everything to do with forms within a document.
+Arguments will be appended to <var>string</var> and the result evaluated
+during parsing (for form creation) and when the widget is cleared (for
+form cleanup). The first argument is a token for
+identifying a form. The second argument selects the action to perform.
+The remaining arguments depend on the action, as follows.
+
+<dl><dt><code><var>string token</var> form <var>URL method attrs</var></code>
+<dd>The handler should begin taking notes for form <var>token</var>,
+especially the (resolved) <var>URL</var> of the action and the
+<var>method</var> to be applied. The raw attributes of the FORM element
+are in the pairlist <var>attrs</var>.
+
+<dt><code><var>string token</var> flush</code>
+<dd>When the document is cleared, the widget will destroy all the windows
+it requested. This handler should clean up anything else
+it created for that form.
+
+<dt><code><var>string token</var> input <var>path attrs</var></code>
+<dd>The handler should create a window named <var>path</var>
+appropriate for the element described by the <var>attrs</var>.
+The widget will map the window into its rendering appropriately.
+<p>It is not an error for the handler to return without creating such a window
+(it's natural in the case of type=hidden); the widget simply
+ignores the element in that case.
+The attributes are the raw values in the HTML, with one exception;
+a <code>src</code> will be resolved before the handler is called.
+
+<dt><code><var>string token</var> textarea <var>path attrs initial</var></code>
+<dd>The handler should create a window (a single Text, or a Frame with Text
+and Scrollbars, or whatever) appropriate for a <textarea> and
+initialise it to the <var>initial</var> string.
+
+<dt><code><var>string token</var> select <var>path attrs choices initial</var></code>
+<dd><em><select> is quite a complicated case...</em>
+The handler should create a window
+appropriate for a <select> of the given attributes and
+present the list of <var>choices</var>. Each choice is a pair, the
+value and its label. <var>initial</var> is a list of values initially
+selected. <em>This approach is somewhat questionable but should do
+most of the time.</em>
+</dl>
+
+Caution: Be very careful to avoid confusing HTML variables with TCL
+variables. It may be tempting to use the <code>name</code> attribute
+fairly directly to link
+together related widgets, but it will likely cause incorrect
+behaviours. Also be careful to observe the order in which the elements are
+created; this determines the order in which they must be submitted.
+A default form handler with the correct bahaviour written in TCL will be
+bundled with the widget.
+<p>The attribute names will be downcased within <var>attrs</var>.
+</td></tr>
+
+<tr><td valign=top><tt>-framecommand</tt><td>
+The script specified by this option is invoked when the HTML parser
+encounters a <tt><frameset>...</frameset></tt> tag sequence.
+The arguments to the script are TBD.
+If the value of the option is the empty string, then the text within
+the <tt><noframe>...</noframe></tt> tag sequence is displayed.
+
+<tr><td valign=top><tt>-height</tt><td>
+Specifies the height of the area into which HTML is rendered.
+This value plus twice the <tt>-padx</tt>, <tt>-borderwidth</tt> and
+<tt>-highlightthickness</tt> values is the total height of the widget.
+
+<tr><td valign=top><tt>-highlightbackground</tt><td>
+
+<tr><td valign=top><tt>-highlightcolor</tt><td>
+
+<tr><td valign=top><tt>-highlightthickness</tt><td>
+
+<tr><td valign=top><tt>-hyperlinkcommand</tt></td>
+<td>
+ The script specified by this option is invoked whenever the user
+ clicks on a hyperlink on the HTML page. Before invoking this
+ script, the URI for the hyperlink is appended.
+</td></tr>
+
+<tr><td valign=top><tt>-imagecommand</tt></td>
+<td>
+ When a ``<tt><img src=...></tt>'' tag is encountered, the
+ HTML widget invokes the script specified by this option in order to
+ get the name of a Tk image object to display the HTML image.
+ Before invoking the script, the following arguments are appended:
+ <ol>
+ <li>The value of the <tt>src=...</tt> parameter after have been
+ processed by the resolver.
+ <li>The value of the <tt>width=...</tt> parameter.
+ <li>The value of the <tt>height=...</tt> parameter.
+ <li>A list containing the names and values of all parameters.
+ </ol>
+ If the name returned by this script is the empty string, or if the
+ script is an empty string, then the HTML widget displays the
+ <tt>alt=...</tt> text of the <tt><img></tt> tag instead of
+ an image.
+</td></tr>
+
+<tr><td valign=top><tt>-bgimagecommand</tt></td>
+<td>
+ When a ``<tt><table background=...></tt>'' tag is encountered, the
+ HTML widget invokes the script specified by this option in order to
+ get the name of a Tk image object to display as the background for
+ the table. Similarly for TD, TH, and TR.
+ Before invoking the script, the following arguments are appended:
+ <ol>
+ <li>The value of the <tt>background=...</tt> parameter after have been
+ processed by the resolver.
+ <li>The token id (TID) of the table, row or col markup tag.
+ </ol>
+ The image name to use for the background can may be returned. Or
+ if the return value is empty. the user can set
+ the background image when available via the <tt>bgimage</tt> command
+ with the tokenid.
+
+</td></tr>
+
+<tr><td valign=top><tt>-isvisitedcommand</tt><td>
+When the HTML widget encounters a hyperlink
+(``<tt><a href=...></tt>'') it invokes the script specified
+by this option in order to determine whether or not the hyperlink
+has been visited.
+This information is needed to determine what color to use to display
+the hyperlink.
+
+<tr><td valign=top><tt>-padx</tt><td>
+The amount of extra space to insert between the 3-D border and the
+left and right sides of the document text.
+
+<tr><td valign=top><tt>-pady</tt><td>
+The amount of extra space to insert between the 3-D border and the top
+and bottom of the document text.
+
+<tr><td valign=top><tt>-relief</tt><td>
+The relief used to draw the 3-D border.
+
+<tr><td valign=top><tt>-resolvercommand</tt></td>
+<td>
+ <p>The name of a TCL command used to resolve URIs. If blank, a built-in
+ resolver is used. If a TCL command is specified but it returns
+ an empty string, the built-in resolver is used then too.
+ The build-in resolver is based on the algorithm
+ in section 5.2 of RFC 2396. </p>
+
+ <p>Multiple URIs are appended to the TCL command before it is executed.
+ The first URI is the BASE URI of the document (the URL that specified
+ by the -base configuration option and updated according to any prior
+ <BASE> markup). Zero or more additional URIs are
+ appended to this base. The result of the script should be the resolution
+ of the whole series or URIs.</p>
+</td></tr>
+
+<tr><td valign=top><tt>-rulerelief</tt></td>
+<td>
+ <p>Determines the appearance of the Horizontal Rule (<HR>) markup.
+ The default is "sunken". This can also be "raised" or "flat". If
+ "flat", then the <HR> is drawn using a solid line in the current
+ foreground color. "groove" and "ridge" are the same as "flat".</p>
+</td></tr>
+
+<tr><td valign=top><tt>-scriptcommand</tt></td>
+<td>
+ <p>Whenever <SCRIPT>...</SCRIPT> markup is encountered in
+ the input HTML, the line number, the attributes of the <SCRIPT>
+ markup and
+ the body of the script are appended to this string and the result
+ is executed as a TCL command. If this options is the empty string,
+ then the script is ignored.
+</td></tr>
+
+<tr><td valign=top><tt>-selectioncolor</tt><td>
+The background color used when drawing the selection. The
+foreground color for the selection is the same as the regular
+foreground color.
+
+<tr><td valign=top><tt>-tablerelief</tt></td>
+<td>
+ <p>Determines the appearance of the borders around tables.
+ The default is "raised". This can also be "sunken" or "flat". If
+ "flat", then the borders is drawn using solid lines in the current
+ foreground color. "groove" and "ridge" are the same as "flat".</p>
+</td></tr>
+
+<tr><td valign=top><tt>-takefocus</tt><td>
+
+<tr><td valign=top><tt>-unvisitedcolor</tt><td>
+The foreground color used to draw hyperlinks that have not been visited.
+
+<tr><td valign=top><tt>-underlinehyperlinks</tt><td>
+Set to TRUE to cause hyperlinks to be drawn using an underlined font.
+
+<tr><td valign=top><tt>-visitedcolor</tt><td>
+The foreground color used to draw hyperlinks that have been visited.
+
+<tr><td valign=top><tt>-width</tt><td>
+The width of the document text.
+This value does not include space allocated for
+<tt>-highlightthickness</tt>, <tt>-borderwiddth</tt> or
+<tt>-padx</tt>.
+
+<tr><td valign=top><tt>-xscrollcommand</tt><td>
+
+<tr><td valign=top><tt>-yscrollcommand</tt><td>
+
+</table>
+
+<h2>Indices</h2>
+
+<p>Internally, the HTML widget stores the HTML document as a list of
+tokens.
+Each token is either
+<ul>
+<li>a contiguous sequence of non-space characters (Text),
+<li>a contiguous sequence of spaces, tabs or newlines (Space),
+<li>or an HTML markup tag (such as ``<tt><em></tt>''.)
+</ul>
+<p>Tokens are identified by number.
+The first token is ``1'', the second is ``2'' and so forth.
+So in its simplest form, an index is just an integer greater than 0.
+<p>
+Within a single Text or Space token, individual characters are
+also identified by number, though the counting starts with 0 instead
+of 1.
+The character number is connected to the token number by a period.
+So, for example, the 4th character in the 9th token would be
+``9.3''.
+<p>
+Two integers separated by a dot is called the <em>connonical</em> form
+of an index.
+Other index forms are available, including:
+
+<table cellspacing=10>
+<tr><td valign=top>end<td>
+The keyword ``end'' means one character past
+the last character of the last token.
+<tr><td valign=top>last<td>
+The keyword ``last'' means the last character of the last token.
+<tr><td valign=top>@X,Y<td>
+The character located at screen coordinates X,Y.
+<tr><td valign=top>&DOM<td>
+The element matching the given DOM address. eg. ``tables(1).rows(3)''.
+<tr><td valign=top>*.last<td>
+The second integer can be replaced by the keyword ``last'' to mean the
+last character in the token.
+<tr><td valign=top>sel.first<td>
+This is the first character that is part of the selection.
+<tr><td valign=top>sel.last<td>
+This is the last character that is part of the selection.
+<tr><td valign=top>insert<td>
+The character immediately following the insertion cursor.
+</table>
+
+<h2>Commands</h2>
+
+<dl>
+<dt><b>html</b> <i>window</i> ?<i>options ...</i>?</dt><p>
+<dd>
+ Create a new HTML widget instance named <i>windows</i>
+</dd>
+<p>
+<dt><b>html</b> <b>reformat</b> <i>from to text</i><p>
+<dd>
+Convert text from one encoding to another. The text is given
+in the <i>text</i> argument. The current encoding of the text
+is specified by the <i>from</i> argument. This command returns
+the same text in the <i>to</i> encoding.
+<p>
+<i>From</i> and <i>to</i> may be any of the following values:
+<p>
+<table cellspacing=10>
+<tr><td valign=top>plain</td>
+<td>
+ Ordinary text with no characters escaped.
+</td></tr>
+<tr><td valign=top>http</td>
+<td>
+ The text is encoded in a form suitable for use with the HTTP
+ protocol. Spaces are converted to "+". Special characters
+ and escaped as "%aa" where "a" is a hexadecimal digit. A special
+ character is anything other than an alphanumeric or one of these:
+ ".", "$", "-", or "_".
+</td></tr>
+<tr><td valign=top>url</td>
+<td>
+ The text is encoded in a form suitable for use as a URI.
+ Spaces are converted to "+". Special characters
+ and escaped as "%aa" where "a" is a hexadecimal digit. A special
+ character is anything other than an alphanumeric or one of these:
+ ".", "$", "-", "_", or "/".
+</td></tr>
+<tr><td valign=top>html</td>
+<td>
+ The text is encoded in a form suitable for use within HTML.
+ "&" is encoded as "&", "<" is encoded as "<" and so
+ forth.
+</td></tr>
+</table>
+<p>
+This command is intended to be useful to the TCL procedures that implement
+callbacks for the HTML widget.
+</dd>
+<p>
+<dt><b>html</b> <b>urljoin</b> <i>scheme authority path query fragment</i><p>
+<dd>
+This command takes the five main components of a URI and joins them together
+into a complete URI. Special characters in any component are escaped.
+</dd>
+<p>
+<dt><b>html</b> <b>urlsplit</b> <i>uri</i><p>
+<dd>
+This command takes a single URI and splits it into its five major
+components: scheme, authorithy, path, query and fragement. The command
+returns a list where each component is an element of the list.
+Components missing from the URI are represented as empty elements in
+the list.
+</dd>
+
+<p>
+<dt><b>html</b> <b>gzip file</b> <i>FILE DATA</i><p>
+<dd>
+This command gzips data to a file.
+</dd>
+
+<p>
+<dt><b>html</b> <b>gunzip file</b> <i>FILE</i><p>
+<dd>
+This command gunzips data from a file.
+</dd>
+
+<p>
+<dt><b>html</b> <b>gunzip data</b> <i>DATA</i><p>
+<dd>
+This command gunzips data from a string.
+</dd>
+
+<p>
+<dt><b>html</b> <b>gunzip data</b> <i>DATA</i><p>
+<dd>
+This command gzips data from a string.
+</dd>
+
+<p>
+<dt><b>html</b> <b>gzip file</b> <i>FILE DATA</i><p>
+<dd>
+This command gzips data to a file.
+</dd>
+
+<p>
+<dt><b>html</b> <b>base64 encode</b> <i>DATA</i><p>
+<dd>
+This command base64 encodes data.
+</dd>
+
+<p>
+<dt><b>html</b> <b>base64 decode</b> <i>DATA</i><p>
+<dd>
+This command base64 decodes data.
+</dd>
+
+<p>
+<dt><b>html</b> <b>text format</b> <i>DATA LEN</i><p>
+<dd>
+This command formats text limiting line length to that
+specified.
+</dd>
+
+<p>
+<dt><b>html</b> <b>xor</b> <i>CMD DATA ...</i><p>
+<dd>
+This command returns an xor encryption of data. <i>CMD</i> is one
+of <i>xor, encrypt or decrypt</i>. The last two take a password argument.
+</dd>
+
+<p>
+<dt><b>html</b> <b>stdchan</b> <i>CMD CHANNEL</i><p>
+<dd>
+This command sets the channel to work around MS Windows exec problems.
+<i>CMD</i> is one of <i>stdin, stdout, stderr</i>.
+</dd>
+
+<p>
+<dt><b>html</b> <b>crc32</b> <i>DATA</i><p>
+<dd>
+This command produces a 32 bit checksum (but not a real CRC).
+</dd>
+
+
+</dl>
+
+<h2>Widget Commands</h2>
+
+<dl>
+
+<dt><i>WIDGET</i>  <tt>bgimage</tt>  <i>IMAGE ?TID?</i><p>
+<dd>Set IMAGE to be the background image. TID, if supplied,
+is the token id of a TABLE, TD, TH or TR. If TID is ommitted,
+it is the background image for the whole page.
+<p>
+
+<dt><i>WIDGET</i>  <tt>cget</tt> <i>config-option</i><p>
+<dd>
+Return the value of a configuration option. Works just like any
+other Tk widget.
+<p>
+
+<dt><i>WIDGET</i>  <tt>clear</tt><p>
+<dd>
+Remove all tokens and text from the HTML widget.
+The parser is reset to its initial state.
+This routine should be called to changes pages.
+<p>
+
+<dt><i>WIDGET</i>  <tt>configure</tt> ?<i>args...</i>?<p>
+<dd>
+The standard Tk configuration command.
+<p>
+
+<dt><i>WIDGET</i>  <tt>coords</tt>  <i>?INDEX ?percent??</i><p>
+<dd>Return the screen coordinates of INDEX.
+<p>
+
+<dt><i>WIDGET</i>  <tt>forminfo</tt>  INDEX<p>
+<dd>Return forminfo for given INDEX.
+<p>
+
+<dt><i>WIDGET</i>  <tt>href</tt>  <i>X  Y</i><p>
+<dd>If the coordinates <i>X Y</i> define a point above a hyperlink,
+then this command will return the target URL for that hyperlink.
+The URL will be resolved using the -resolvercommand before it
+is returned.
+<p>
+
+<dt><i>WIDGET</i>  <tt>imageadd</tt>  <i>ID  IMAGE</i><p>
+<dd>
+Add a single image onto animated image list.
+<p>
+
+<dt><i>WIDGET</i>  <tt>imageat</tt>  <i>X  Y</i><p>
+<dd>If the coordinates <i>X Y</i> define a point above an image,
+then this command will return the Token Id for that image.
+<p>
+
+<dt><i>WIDGET</i>  <tt>images</tt><p>
+<dd>
+Return the list of animated images.
+<p>
+
+<dt><i>WIDGET</i>  <tt>imageset</tt>  <i>ID  NUM</i><p>
+<dd>For animated gifs, set image number NUM to be the current image.
+This is only used for buffered animations.
+<p>
+
+<dt><i>WIDGET</i>  <tt>imageupdate</tt>  <i>ID  IMAGES</i><p>
+<dd>When an Animated gif comes in, this allows changing the
+current image into multiple images.
+<p>
+
+
+
+<dt><i>WIDGET</i>  <tt>index</tt>  <i>INDEX  ?COUNT  UNITS?</i></p>
+<dd>
+Translates <i>INDEX</i> into its connonical form.
+The connonical form of an index is two integers separated by a period.
+<p>
+The optional 3rd and 4th arguments specify a displacement from <i>INDEX</i>
+to the value of the index returned.
+<i>COUNT</i> can be any integer value, including a negative number.
+<i>UNITS</i> must be either ``<tt>char</tt>'' or ``<tt>line</tt>''.
+<p>
+
+<dt><i>WIDGET</i>  <tt>insert</tt>  <i>INDEX</i><p>
+<dd>
+Causes the insertion cursor (a flashing vertical bar) to be positioned
+immediately before the character specified by <i>INDEX</i>.
+<p>
+
+<dt><i>WIDGET</i>  <tt>names</tt><p>
+<dd>
+This command causes the widget to scan the entire text of the document
+looking for tags of the form ``<tt><a name=...></tt>''.
+It returns a list of values of the <tt>name=...</tt> fields.
+<p>
+The vertical position of the document can be moved to any of these names
+using the ``<i>WIDGET</i> <tt>yview</tt> <i>NAME</i>'' command described
+below.
+<p>
+
+<dt><i>WIDGET</i>  <tt>onscreen</tt>  ID <i>X  Y</i><p>
+<dd>Return 1 if ID is onscreen (visible).
+<p>
+
+<dt><i>WIDGET</i>  <tt>over</tt>  <i>X  Y ?-muponly?</i><p>
+<dd>Return a list of TIDS where the coordinates <i>X Y</i>
+define a point above objects. If -muponly, give only markup elements.
+<p>
+
+<dt><i>WIDGET</i>  <tt>overattr</tt>  <i>X  Y ATTRS</i><p>
+<dd>Like <b>over</b> but returns markup containing one or more
+of the attributes in the list ATTRS.
+ATTRS.
+<p>
+
+<dt><i>WIDGET</i>  <tt>parse</tt>  <i>HTML-TEXT</i><p>
+<dd>Adds the given HTML text to the end of any text previously received
+through the <tt>parse</tt> command and parses as much of the text as
+possible into tokens.
+Afterwards, the display is updated to show the new tokens, if they are
+visible.<p>
+
+<dt><i>WIDGET</i> <tt>resolver</tt> ?<i>uri ...</i>?<p>
+<dd>The resolver specified by the -resolvercommand option
+ is called with the
+ base URI of the document followed
+ by the remaining arguments to this commant. The result of this
+ command is the result of the -resolvercommand script.<p>
+
+<dt><i>WIDGET</i>  <tt>selection</tt>  <i>subcommand args...</i><p>
+<dd>The selection widget command is used to control the selection.<p>
+ <dl>
+ <dt><i>WIDGET</i>  <tt>selection clear</tt><p>
+ <dd>Clear the current selection. No text will be selected after this
+ command executes.<p>
+
+ <dt><i>WIDGET</i>  <tt>selection set</tt>  <i>START  END</i><p>
+ <dd>Change the selection to be all text contained within the given
+ indices.<p>
+ </dl>
+ <p>
+
+<dt><i>WIDGET</i>  <tt>refresh</tt> <i>options</i><p>
+<dd>Cause a relayout and redraw. Useful after a token insert or update.
+Valid options are zero or more of: images, resize, focus, text, border, extend,
+clipwin,, styler, animate, vscroll, hscroll, gotfocus, layout.
+The default is layout. You may abreviate options with the first letter.
+<p>
+
+<dt><i>WIDGET</i>  <tt>source</tt><p>
+<dd>Return the html source for the current page.
+<p>
+
+
+<dt><i>WIDGET</i>  <tt>text</tt>  <i>subcommand args...</i><p>
+<dd>There are several token commands. They all have the common
+property that they directly manipulate the text that is displayed.
+These commands can be used
+to build an WYSIWYG editor for HTML.<p>
+ <dl>
+ <dt><i>WIDGET</i> <tt>text ascii</tt>  <i>INDEX-1  INDEX-2</i><p>
+ <dd><p>
+ Returns plain ASCII text that represents all characters between
+ <i>INDEX-1</i> and <i>INDEX-2</i>. Formatting tags are omitted.
+ The <i>INDEX-1</i> character is included by <i>INDEX-2</i> is omitted.
+ <p>
+
+ <dt><i>WIDGET</i> <tt>text delete</tt>  <i>INDEX-1  INDEX-2</i><p>
+ <dd><p>
+ All text from <i>INDEX-1</i> up to, but not including <i>INDEX-2</i> is
+ removed and the display is updated accordingly.
+ <p>
+
+ <dt><i>WIDGET</i> <tt>text html</tt>  <i>INDEX-1  INDEX-2</i><p>
+ <dd><p>
+ Returns HTML text that represents all characters and formatting tags
+ between <i>INDEX-1</i> and <i>INDEX-2</i>.
+ The <i>INDEX-1</i> character is included by <i>INDEX-2</i> is omitted.
+ <p>
+
+ <dt><i>WIDGET</i> <tt>text insert</tt>  <i>INDEX  TEXT</i><p>
+ <dd><p>
+ Inserts one or more characters immediately before the character whose
+ index is given.
+ The insertion cursor is updated.
+ <p>
+
+ <dt><i>WIDGET</i> <tt>text break</tt>  <i>INDEX </i><p>
+ <dd><p>
+ Break the text token at index into two text tokens.
+ <p>
+
+
+ <dt><i>WIDGET</i> <tt>text find TEXT</tt>  <i>?nocase? ?before|after INDEX? </i><p>
+ <dd><p>
+ Find text. If index is given, start search from there. If before,
+ search backwards. nocase will ignore case.
+ <p>
+ </dl>
+
+ <dt><i>WIDGET</i> <tt>text table INDEX</tt>  <i>?images? ?attrs? </i><p>
+ <dd><p>
+ Return text (and optionally attributes and images) from a table as lists.
+ The first list is a list of rows (each a list of cells).
+ The next optional list is the list of attributes, like above, but
+ the element 0 contains the table attrs, and element 0 of each
+ row contains the row attrs.
+ Another optional list is the list of images, each as a set of
+ values: row col charoffset tokenid. charoffset is the
+ character offset within the text that the image appears at.
+ tokenid is the index to use to lookup the attributes
+ such as src.
+
+ <p>
+ </dl>
+
+
+<dt><i>WIDGET</i>  <tt>token</tt>  <i>subcommand args...</i><p>
+<dd>There are several token commands. They all have the common
+ property that they involve the list of tokens into which the
+ HTML is parsed.<p>
+ Some of the following subcommands make use of indices. The
+ character number of these indices is ignored since these commands
+ deal only with whole tokens.
+ <p>
+ <dl>
+ <dt><i>WIDGET</i> <tt>token append</tt>
+ <i>TAG ARGUMENTS</i><p>
+ <dd>
+ The command causes a token to be appended to the current list of
+ tokens in the HTML widget. This command is typically used within
+ a token handler.
+ <p>
+
+
+ <dt><i>WIDGET</i> <tt>token delete</tt>
+ <i>INDEX  ?INDEX-2?</i><p>
+ <dd>
+ Deletes the single token indentified by the index. If a second index is
+ given, the range of tokens from the first to the second index inclusive
+ is deleted.
+ <p>
+
+ <dt><i>WIDGET</i> <tt>token find</tt>
+ <i>TAG</i> ?before|after|near INDEX?<p>
+ <dd>
+ Locates all tokens with the given <i>TAG</i> and returns them all
+ as a list.
+ Each element of the returned list is a sublist containing the index
+ for the token and the arguments for the token.
+ <p>
+
+ <dt><i>WIDGET</i> <tt>token get</tt>
+ <i>INDEX  ?INDEX-2?</i><p>
+ <dd>
+ Returns a list of tokens in the range of <i>INDEX</i> through
+ <i>INDEX-2</i>.
+ Each element of the list consists of the token tag followed by
+ the token arguments.
+ <p>
+
+ <dt><i>WIDGET</i> <tt>token list</tt>
+ <i>INDEX  INDEX-2?</i><p>
+ <dd>
+ The same as <b>token get</b>, but has the token id as the first
+ item in each list element.
+ <p>
+
+ <dt><i>WIDGET</i> <tt>token markup</tt>
+ <i>INDEX  INDEX-2?</i><p>
+ <dd>
+ The same as <b>token list</b>, but ignores space and text.
+ <p>
+
+ <dt><i>WIDGET</i> <tt>token domtokens</tt>
+ <i>INDEX  INDEX-2?</i><p>
+ <dd>
+ The same as <b>token domtokens</b>, but ignores all non-DOM tokens.
+ <p>
+
+ <dt><i>WIDGET</i> <tt>token getend</tt>
+ <i>INDEX</i><p>
+ <dd>
+ Given a start token, find the matching end token.
+ <p>
+
+ <dt><i>WIDGET</i> <tt>token offset</tt>
+ <i>START NUM1 NUM2</i><p>
+ <dd>
+ Hard to describe, but used as follows: when you extract text, and do
+ a regex on it, with -indices, you need to convert these offsets back
+ into INDEXES. This returns those begin and end anchor.
+ <p>
+
+ <dt><i>WIDGET</i> <tt>token attr</tt>
+ <i>INDEX ?NAME ?VALUE??</i><p>
+ <dd>
+ Allow get or set a tokens attribute(s). Getting non-existent
+ attr returns an empty string.
+ <p>
+
+ <dt><i>WIDGET</i> <tt>token handler</tt>
+ <i>TAG ?SCRIPT?</i><p>
+ <dd>
+ This command allows special processing to occur for selected tokens
+ in the HTML input stream.
+ The <i>TAG</i> argument is either ``Text'' or ``Space'' or the name
+ of an HTML tag (ex: ``H3'' or ``/A'').
+ If a non-empty script is specified for a particular tag, then when
+ instances of that tag are encountered by the parser, the parser calls the
+ corresponding script instead of appending the token to the end of the
+ token list. Before calling the script, three arguments are appended:
+ <ol>
+ <li>The token number.
+ <li>The tag. (ex: <tt>H3</tt>)
+ <li>A list of name/value pairs describing all arguments to the tag.
+ </ol>
+ An empty handler script causes the default processing to occur for
+ the tag. If the script argument is omitted all together, then
+ the current value of the token handler for the given tag is returned.
+ <p>
+ Only one handler may be defined for each token type. If a new
+ handler is specified for a token type that previously had a different
+ handler defined, then the old handler is overwritten by the new.
+ <p>
+
+ <dt><i>WIDGET</i> <tt>token insert</tt>
+ <i>INDEX  TAG  ARGUMENTS</i><p>
+ <dd>
+ Inserts a single token given by <i>TAG</i> and <i>ARGUMENTS</i> into
+ the token list immediately before <i>INDEX</i>.
+ if index is after end of a text token, inserts after token.
+ The insertion cursor is updated.
+ <p>
+
+ <dt><i>WIDGET</i> <tt>token attrs</tt>
+ <i>ATTRLIST</i> <i>?INDEX ?INDEX? ?</i><p>
+ <dd>
+ Find all tags that contain an attr named in input list. Return TIDs.
+ <p>
+
+
+ <dt><i>WIDGET</i> <tt>token onEvents</tt>
+ <i>?INDEX ?INDEX? ?</i><p>
+ <p>
+ <dd>
+ Look for all the onSubmit, onMouseover, etc attributes. returns list of: Event TID Event TID...
+ <p>
+
+ <dt><i>WIDGET</i> <tt>token unique</tt>
+ <i>TAG</i>
+ <i>?INDEX ?INDEX? ?</i><p>
+ <dd>
+ For the given tag, return all known unique attribute names for the tag.
+ <p>
+
+
+ </dl>
+<p>
+
+<dt><i>WIDGET</i>  <tt>dom</tt>  <i>subcommand args...</i><p>
+<dd>There are several dom commands. In all the following,
+ <i>DOMSPEC</i> is a DOM style address. eg. TABLE(1).ROW(2).
+ The Token Id is returned for that element in the page.
+
+ <dl>
+ <dt><i>WIDGET</i> <tt>dom nameidx</tt>
+ TAG <i>NAME</i><p>
+ <dd>
+ Convert a named markup to it's array position. ie. <B>TABLE foo</B>
+ might translate to <B>TABLE[2]</B> returning the integer index 2.
+
+ <p>
+
+ <dt><i>WIDGET</i> <tt>dom radioidx</tt>
+ TAG <i>NAME</i><p>
+ <dd>
+ Translate a radio input items array index to a form item index.
+
+ <p>
+ <dt><i>WIDGET</i> <tt>dom id</tt>
+ <i>DOMSPEC</i><p>
+ <dd>
+ Given a DOMSPEC, return the TID. Obsolete, use ``index &DOMSPEC''.
+ <p>
+
+ <dt><i>WIDGET</i> <tt>dom ids</tt>
+ <i>DOMSPEC</i><p>
+ <dd>
+ Like above, but returns both begin and end TID.
+ <p>
+
+ <dt><i>WIDGET</i> <tt>dom value</tt>
+ <i>DOMSPEC</i><p>
+ <dd>
+ Like dom id, but returns the attributes rather than the TID.
+ Obsolete. Should now use: token attr &DOMSPEC.
+ <p>
+
+ <dt><i>WIDGET</i> <tt>dom addr</tt>
+ <i>INDEX</i><p>
+ <dd>
+ Given an index, return the best guess of the DOM address.
+ eg. TABLES(2).ROWS(1)
+ <p>
+
+ <dt><i>WIDGET</i> <tt>dom formel</tt>
+ <i>N</i>NAME<p>
+ <dd>
+ For the forms(N), return the form element with name NAME.
+ <p>
+
+ <dt><i>WIDGET</i> <tt>dom tree</tt>
+ <i>INDEX</i> VALUE<p>
+ <dd>
+ Return the HTML Doc as one big DOM tree list. Not fully implemented.
+ <p>
+ </dl>
+
+<p>
+
+<dt><i>WIDGET</i> <tt>xview</tt> <i>args...</i><p>
+<dd>Used to control horizontal scrolling.<p>
+ <dl>
+ <dt><i>WIDGET</i>  <tt>xview</tt><p>
+ <dd>Returns a list containing two elements. The elements are a fractions
+ between 0.0 and 1.0 that define the position of the left and right
+ edges of
+ the visible part of the document as a fraction of the whole.<p>
+ <dt><i>WIDGET</i>  <tt>xview moveto</tt>  <i>FRACTION</i><p>
+ <dd>Adjusts the horizontal position of the document so that
+ <i>FRACTION</i> of the horizontal span of the document is off-screen
+ to the left.<p>
+ <dt><i>WIDGET</i>  <tt>xview scroll</i>  <i>NUMBER  WHAT</i><p>
+ <dd>
+ Shifts the view in the window left or right according to
+ <i>NUMBER</i> and <i>WHAT</i>.   <i>NUMBER</i> is an integer
+ and <i>WHAT</i> is either <tt>units</tt> or <tt>pages</tt>.<p>
+ </dl>
+
+<dt><i>WIDGET</i>  <tt>yview</tt> <i>args...</i><p>
+<dd>Used to control the vertical position of the document.<p>
+ <dl>
+ <dt><i>WIDGET</i>  <tt>yview</tt><p>
+ <dd>Returns a list containing two elements. The elements are a fractions
+ between 0.0 and 1.0 that define the position of the top and bottom
+ edges of
+ the visible part of the document as a fraction of the whole.<p>
+ <dt><i>WIDGET</i>  <tt>yview</tt>  <i>NAME</i><p>
+ <dd>Adjusts the vertical position of the document so that the tag
+ ``<tt><a name=</tt><i>NAME</i><tt>></tt>'' is on screen,
+ and preferably near the top of the screen.<p>
+ <dt><i>WIDGET</i>  <tt>yview moveto</tt>  <i>FRACTION</i><p>
+ <dd>Adjusts the horizontal position of the document so that
+ <i>FRACTION</i> of the vertical span of the document is off-screen
+ above the visible region.<p>
+ <dt><i>WIDGET</i>  <tt>xview scroll</i> <i>NUMBER WHAT</i><p>
+ <dd>
+ Shifts the view in the window up or down according to
+ <i>NUMBER</i> and <i>WHAT</i>.   <i>NUMBER</i> is an integer
+ and <i>WHAT</i> is either <tt>units</tt> or <tt>pages</tt>.<p>
+ </dl>
+
+</dl>
+</body>
+</html>
diff --git a/doc/tkhtml.html b/doc/tkhtml.html
new file mode 100644
index 0000000..78c5157
--- /dev/null
+++ b/doc/tkhtml.html
@@ -0,0 +1,905 @@
+
+ <html>
+ <head>
+ <title>tkhtml (n)</title>
+ </head>
+ <body>
+ <h1>tkhtml (n)</h1>
+ <p><a href="#TOC">Table Of Contents</a>
+ <a name="section1"><h2>Name</h2></a>
+
+<p>
+tkhtml - Widget to render html documents.
+</p>
+
+
+<a name="section2"><h2>Synopsis</h2></a>
+
+<p>
+html pathName ?options?
+</p>
+
+
+<a name="section3"><h2>Standard Options</h2></a>
+
+
+<div style="margin-left:8ex"><pre><p>
+-exportselection
+-height
+-width
+-xscrollcommand
+-xscrollincrement
+-yscrollcommand
+-yscrollincrement
+</pre></div>
+
+
+
+<a name="section4"><h2>Widget-Specific Options</h2></a>
+
+
+
+ <p>Command-Line Name: -defaultstyle<br>
+ Database Name: defaultstyle<br>
+ Database Class: Defaultstyle
+ </p>
+ <div style="margin-left:8ex">
+
+ <p>
+This option is used to set the default style-sheet for the
+widget. The option value should be the entire text of the
+default style-sheet, or an empty string, in which case a
+built-in default stylesheet (for HTML) is used.
+</p>
+
+<p>
+TODO: Describe the role of the default stylesheet.
+
+
+ </div>
+
+
+
+
+ <p>Command-Line Name: -imagecmd<br>
+ Database Name: imagecmd<br>
+ Database Class: Imagecmd
+ </p>
+ <div style="margin-left:8ex">
+
+ <p>
+Specify a Tcl command to be run when an image URI is
+encountered by the widget. The URI is appended to the value
+of this option and the resulting list evaluated. The value
+returned should be the name of a Tk image, or an empty
+string if an error occurs.
+</p>
+
+<p>
+See section "IMAGE LOADING" for more detail.
+
+
+ </div>
+
+
+
+
+ <p>Command-Line Name: -logcmd<br>
+ Database Name: logcmd<br>
+ Database Class: Logcmd
+ </p>
+ <div style="margin-left:8ex">
+
+ <p>
+This option is only used for internally debugging the widget.
+
+
+ </div>
+
+
+
+
+<a name="section5"><h2>Description</h2></a>
+
+
+<p>
+The [html] command creates a new window (given by the pathName
+argument) and makes it into an html widget. The html command
+returns its pathName argument. At the time this command is invoked,
+there must not exist a window named pathName, but pathName's parent
+must exist.
+</p>
+
+
+<a name="section6"><h2>Widget Command</h2></a>
+
+<p>
+The [html] command creates a new Tcl command whose name is
+pathName. This command may be used to invoke various operations on
+the widget as follows:
+</p>
+
+
+
+ <p>
+ pathName cget option
+ </p>
+ <div style="margin-left:8ex"><p>
+Returns the current value of the configuration option given
+by option. Option may have any of the values accepted by
+the [html] command.
+</div>
+
+
+
+
+ <p>
+ pathName configure option value
+ </p>
+ <div style="margin-left:8ex"><p>
+Query or modify the configuration options of the widget. If
+no option is specified, returns a list describing all of
+the available options for pathName (see Tk_ConfigureInfo
+for information on the format of this list). If option is
+specified with no value, then the command returns a list
+describing the one named option (this list will be
+identical to the corresponding sublist of the value
+returned if no option is specified). If one or more
+option-value pairs are specified, then the command modifies
+the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. Option may
+have any of the values accepted by the [html] command.
+</div>
+
+
+
+
+ <p>
+ pathName handler type tag script
+ </p>
+ <div style="margin-left:8ex"><p>
+This command is used to define "handler" scripts - Tcl
+callback scripts that are invoked by the widget when
+document elements of specified types are encountered. The
+widget supports two types of handler scripts: "node" and
+"script". The type parameter to this command must
+take one of these two values.
+</p>
+
+<p>
+For a "node" handler script, whenever a document element
+having the specified tag type (e.g. "p" or "link") is
+encountered during parsing, then the node handle for the
+node is appended to script and the resulting list
+evaluated as a Tcl command. See the section "NODE COMMAND"
+for details of how a node handle may be used to query and
+manipulate a document node.
+</p>
+
+<p>
+If the handler script is a "script" handler, whenever a
+document node of type tag is parsed, then the text
+that appears between the start and end tags of the node is
+appended to script and the resulting list evaluated
+as a Tcl command.
+</p>
+
+<p>
+Handler callbacks are always made from within
+[pathName parse] commands. The callback for a given node
+is made as soon as the node is completely parsed. This can
+happen because an implicit or explicit closing tag is
+parsed, or because there is no more document data and the
+-final switch was passed to the [pathName parse]
+command.
+</div>
+
+
+
+
+ <p>
+ pathName image
+ </p>
+ <div style="margin-left:8ex"><p>
+This command returns the name of a new Tk image containing
+the rendered document. Where Tk widgets would be mapped in a
+live display, the image contains blank space.
+</p>
+
+<p>
+The returned image should be deleted when the script has
+finished with it, for example:
+</p>
+
+<div style="margin-left:8ex"><pre><p>
+set img [.html image]
+# ... Use $img ...
+image delete $img
+</pre></div>
+
+
+<p>
+This command is included mainly for automated testing and
+should be used with care, as large documents can result in very
+large images that take a long time to create and use vast
+amounts of memory.
+</div>
+
+
+
+
+ <p>
+ pathName node ? ?-index? x y?
+ </p>
+ <div style="margin-left:8ex"><p>
+This command is used to retrieve a handle for a document
+node that is part of the currently parsed document. If the
+x and y parameters are omitted, then the handle returned is
+the root-node of the document, or an empty string if the
+document has no root-node (i.e. an empty document).
+</p>
+
+<p>
+If the x and y arguments are present, then the handle
+returned is for the node which generated the document
+content currently located at viewport coordinates (x, y).
+If no content is located at the specified coordinates or
+the widget window is not mapped, then an empty string is
+returned.
+</p>
+
+<p>
+If both the -index option is also specified, then instead
+of a node handle, a list of two elements is returned. The
+first element of the list is the node-handle. The second
+element is -1 if the returned node is not a text node (would
+return other than an empty string for [nodeHandle tag]).
+If the node is a text node, then the value returned is an
+index into the text obtainable by [nodeHandle text] for
+the character at coordinates (x, y). The index may be used
+with the [pathName select] commands.
+</p>
+
+<p>
+The document node can be queried and manipulated using the
+interface described in the "NODE COMMAND" section.
+</div>
+
+
+
+
+ <p>
+ pathName parse ?-final? html-text
+ </p>
+ <div style="margin-left:8ex"><p>
+Append extra text to the end of the (possibly empty)
+document currently stored by the widget.
+</p>
+
+<p>
+If the -final option is present, this indicates that the
+supplied text is the last of the document. Any subsequent
+call to [pathName parse] before a call to [pathName reset]
+will raise an error.
+</div>
+
+
+
+
+ <p>
+ pathName reset
+ </p>
+ <div style="margin-left:8ex"><p>
+This is used to clear the internal contents of the widget
+prior to parsing a new document. The widget is reset such
+that the document tree is empty (as if no calls to
+[pathName parse] had ever been made) and no stylesheets
+except the default stylesheet are loaded (as if no
+invocations of [pathName style] had occured).
+</div>
+
+
+
+
+ <p>
+ pathName select clear<br>pathName select from ?nodeHandle ?index? ?<br>pathName select to ?nodeHandle ?index? ?
+ </p>
+ <div style="margin-left:8ex"><p>
+The [pathName select] commands are used to query and
+manipulate the widget selection. If the widget
+-exportselection option is set to true, then these commands
+may also manipulate the X11-selection.
+</p>
+
+<p>
+TODO: Describe these commands.
+</div>
+
+
+
+
+ <p>
+ pathName style ?options? stylesheet-text
+ </p>
+ <div style="margin-left:8ex"><p>
+Add a stylesheet to the widgets internal configuration. The
+stylesheet-text argument should contain the text of a
+complete stylesheet. Incremental parsing of stylesheets is
+not supported, although of course multiple stylesheets may
+be added to a single widget.
+</p>
+
+<p>
+The following options are supported:
+</p>
+
+<div style="margin-left:8ex"><pre><p>
+Option Default Value
+--------------------------------------
+-id <stylesheet-id> "author"
+-importcmd <script> ""
+-urlcmd <script> ""
+</pre></div>
+
+
+<p>
+The value of the -id option determines the priority taken
+by the style-sheet when assigning property values to
+document nodes (see chapter 6 of the CSS specification for
+more detail on this process). The first part of the
+style-sheet id must be one of the strings "agent", "user"
+or "author". Following this, a style-sheet id may contain
+any text.
+</p>
+
+<p>
+When comparing two style-ids to determine which stylesheet
+takes priority, the widget uses the following approach: If
+the initial strings of the two style-id values are not
+identical, then "user" takes precedence over "author", and
+"author" takes precedence over "agent". Otherwise, the
+lexographically largest style-id value takes precedence.
+For more detail on why this seemingly odd approach is
+taken, please refer to the "STYLESHEET LOADING" below.
+</p>
+
+<p>
+The -importcmd option is used to provide a handler script
+for @import directives encountered within the stylesheet
+text. Each time an @import directive is encountered, if the
+-importcmd option is set to other than an empty string, the
+URI to be imported is appended to the option value and the
+resulting list evaluated as a Tcl script. The return value
+of the script is ignored. If the script raises an error,
+then it is propagated up the call-chain to the
+[pathName style] caller.
+</p>
+
+<p>
+The -urlcmd option is used to supply a script to translate
+"url(...)" CSS attribute values. If this option is not set to
+"", each time a url() value is encountered the URI is appended
+to the value of -urlcmd and the resulting script evaluated. The
+return value is stored as the URL in the parsed stylesheet.
+</div>
+
+
+
+
+ <p>
+ pathName xview ?options?
+ </p>
+ <div style="margin-left:8ex"><p>
+This command is used to query or adjust the horizontal
+position of the viewport relative to the document layout.
+It is identical to the [pathName xview] command
+implemented by the canvas and text widgets.
+</div>
+
+
+
+
+ <p>
+ pathName yview ?options?
+ </p>
+ <div style="margin-left:8ex"><p>
+This command is used to query or adjust the vertical
+position of the viewport relative to the document layout.
+It is identical to the [pathName yview] command
+implemented by the canvas and text widgets.
+</div>
+
+
+
+<a name="section7"><h2>Node Command</h2></a>
+
+<p>
+There are several interfaces by which a script can obtain a "node
+handle". Each node handle is a Tcl command that may be used to
+access the document node that it represents. A node handle is valid
+from the time it is obtained until the next call to
+[pathName reset]. The node handle may be used to query and
+manipulate the document node via the following subcommands:
+</p>
+
+
+
+ <p>
+ nodeHandle attr ?attribute?
+ </p>
+ <div style="margin-left:8ex"><p>
+If the attribute argument is present, then return the value
+of the named html attribute, or an empty string if the
+attribute specified does not exist. If it is not present,
+return a key-value list of the defined attributes of the
+form that can be passed to [array set].
+</p>
+
+
+<div style="margin-left:8ex"><pre><p>
+# Html code for node
+<p class="normal" id="second" style="color : red">
+</p>
+
+<p>
+# Value returned by [nodeHandle attr]
+{class normal id second style {color : red}}
+</p>
+
+<p>
+# Value returned by [nodeHandle attr class]
+normal
+</pre></div>
+</div>
+
+
+
+
+ <p>
+ nodeHandle child index
+ </p>
+ <div style="margin-left:8ex"><p>
+Return the node handle for the index'th child of the node.
+Children are numbered from zero upward.
+</div>
+
+
+
+ <p>
+ nodeHandle nChild
+ </p>
+ <div style="margin-left:8ex"><p>
+Return the number of children the node has.
+</div>
+
+
+
+ <p>
+ nodeHandle parent
+ </p>
+ <div style="margin-left:8ex"><p>
+Return the node handle for the node's parent. If the node
+does not have a parent (i.e. it is the document root), then
+return an empty string.
+</div>
+
+
+
+ <p>
+ nodeHandle replace ? ?options? newValue?
+ </p>
+ <div style="margin-left:8ex"><p>
+This command is used to set and get the name of the
+replacement object for the node, if any. If the newValue
+argument is present, then this command sets the nodes
+replacement object name and returns the new value. If
+newValue is not present, then the current value is
+returned.
+</p>
+
+<p>
+A nodes replacement object may be set to the name of a Tk
+image, the name of a Tk window, or an empty string. If it
+is an empty string (the default and usual case), then the
+node is rendered normally. If it is set to the name of a Tk
+image, then the image is displayed in the widget in place
+of any other node content (for example to implement HTML
+<img> tags). If the node replacement object is set to the
+name of a Tk window, then the Tk window is mapped into the
+widget in place of any other content (for example to
+implement form elements or plugins).
+</p>
+
+<p>
+The following options are supported:
+</p>
+
+
+<div style="margin-left:8ex"><pre><p>
+Option Default Value
+--------------------------------------
+-deletecmd <script> See below
+-configurecmd <script> ""
+</pre></div>
+
+
+<p>
+When a replacement object is no longer being used by the
+widget (e.g. because the node has been deleted or
+[pathName reset] is invoked), the value of the
+-deletecmd option is evaluated as Tcl script. The default
+-deletecmd script (used if no explicit -deletecmd option is
+provided) deletes the Tk image or window.
+</p>
+
+<p>
+If it is not set to an empty string (the default) each time
+the nodes CSS properties are recalculated, a serialized
+array is appended to the value of the -configurecmd option
+and the result evaluated as a Tcl command. The script
+should update the replacement objects appearance where
+appropriate to reflect the property values. The format of
+the appended argument is {p1 v1 p2 v2 ... pN vN} where the
+pX values are property names (i.e. "background-color") and
+the vX values are property values (i.e. "#CCCCCC"). The
+CSS properties that currently may be present in the array
+are listed below. More may be added in the future.
+</p>
+
+
+<div style="margin-left:8ex"><pre><p>
+background-color color
+font selected
+</pre></div>
+
+
+<p>
+The value of the "font" property, if present in the
+serialized array is not set to the value of the
+corresponding CSS property. Instead it is set to the name
+of a Tk font determined by combining the various
+font-related CSS properties. Unless they are set to
+"transparent", the two color values are guaranteed to parse
+as Tk colors. The "selected" property is either true or
+false, depending on whether or not the replaced object is
+part of the selection or not. Whether or not an object is
+part of the selection is governed by previous calls to the
+[pathName select] command.
+</p>
+
+<p>
+The -configurecmd callback is always executed at least once
+between the [nodeHandle replace] command and when the
+replaced object is mapped into the widget display.
+</div>
+
+
+
+ <p>
+ nodeHandle tag
+ </p>
+ <div style="margin-left:8ex"><p>
+Return the name of the Html tag that generated this
+document node (i.e. "p" or "link"), or an empty string if
+the node is a text node.
+</div>
+
+
+
+ <p>
+ nodeHandle text
+ </p>
+ <div style="margin-left:8ex"><p>
+If the node is a "text" node, return the string contained
+by the node. If the node is not a "text" node, return an
+empty string.
+</div>
+
+
+<p>
+TODO: Add the "write" part of the DOM compatible interface to this
+section.
+</p>
+
+
+<a name="section8"><h2>Replaced Objects</h2></a>
+
+<p>
+Replaced objects are html document nodes that are replaced by
+either a Tk image or a Tk window. For example <IMG> or <INPUT>
+tags. To implement replaced objects in Tkhtml the user supplies the
+widget with a Tcl script to create and return the name of the image
+or window, and the widget maps, manages and eventually destroys the
+image or window.
+</p>
+
+<p>
+TODO: Finish this section.
+</p>
+
+
+<a name="section9"><h2>Image Loading</h2></a>
+
+<p>
+As well as for replaced objects, images are used in several other
+contexts in CSS formatted documents, for example as list markers or
+backgrounds. If the -imagecmd option is not set to an empty
+string (the default), then each time an image URI is encountered in
+the document, it is appended to the -imagecmd script and the
+resulting list evaluated.
+</p>
+
+<p>
+The command should return either an empty string, the name of a Tk
+image, or a list of exactly two elements, the name of a Tk image
+and a script. If the result is an empty string, then no image can
+be displayed. If the result is a Tk image name, then the image is
+displayed in the widget. When the image is no longer required, it
+is deleted. If the result of the command is a list containing a Tk
+image name and a script, then instead of deleting the image when it
+is no longer required, the script is evaluated.
+</p>
+
+
+<a name="section10"><h2>Stylesheet Loading</h2></a>
+
+<p>
+Apart from the default stylesheet that is always loaded (see the
+description of the -defaultstyle option above), a script may
+configure the widget with extra style information in the form of
+CSS stylesheet documents. Complete stylesheet documents (it is not
+possible to incrementally parse stylesheets as it is HTML document
+files) are passed to the widget using the [pathName style]
+command.
+</p>
+
+<p>
+As well as any stylesheets specified by the application,
+stylesheets may be included in HTML documents by document authors
+in several ways:
+</p>
+
+
+<ul><li>
+Embedded in the document itself, using a <style> tag. To
+handle this case an application script must register a
+"script" type handler for <style> tags using the
+[pathName handler] command. The handler command should
+call [pathName style] to configure the widget with the
+stylesheet text.
+<li>
+Linked from the document, using a <link> tag. To handle
+this case the application script should register a "node"
+type handler for <link> tags.
+<li>
+Linked from another stylesheet, using the @import
+directive. To handle this, an application needs to
+configure the widget -importcommand option.
+</ul>
+
+
+
+<div style="margin-left:8ex"><pre><p>
+# Implementations of application callbacks to load
+# stylesheets from the various sources enumerated above.
+# ".html" is the name of the applications tkhtml widget.
+# The variable $document contains an entire HTML document.
+# The pseudo-code <LOAD URI CONTENTS> is used to indicate
+# code to load and return the content located at $URI.
+</p>
+
+<p>
+proc script_handler {tagcontents} {
+ incr ::stylecount
+ set id "author.[format %.4d $::stylecount]"
+ set handler "import_handler $id"
+ .html style -id $id.9999 -importcmd $handler $tagcontents
+}
+</p>
+
+<p>
+proc link_handler {node} {
+ if {[node attr rel] == "stylesheet"} {
+ set URI [node attr href]
+set stylesheet [<LOAD URI CONTENTS>]
+</p>
+
+<p>
+ incr ::stylecount
+ set id "author.[format %.4d $::stylecount]"
+ set handler "import_handler $id"
+ .html style -id $id.9999 -importcmd $handler $stylesheet
+ }
+}
+</p>
+
+<p>
+proc import_handler {parentid URI} {
+ set stylesheet [<LOAD URI CONTENTS>]
+</p>
+
+<p>
+ incr ::stylecount
+ set id "$parentid.[format %.4d $::stylecount]"
+ set handler "import_handler $id"
+ .html style -id $id.9999 -importcmd $handler $stylesheet
+}
+</p>
+
+<p>
+.html handler script style script_handler
+.html handler node link link_handler
+</p>
+
+<p>
+set ::stylecount 0
+</p>
+
+<p>
+.html parse -final $document
+</pre></div>
+
+
+<p>
+The complicated part of the example code above is the generation of
+stylesheet-ids, the values passed to the -id option of the
+[.html style] command. Stylesheet-ids are used to determine the
+precedence of each stylesheet passed to the widget, and the role it
+plays in the CSS cascade algorithm used to assign properties to
+document nodes. The first part of each stylesheet-id, which must be
+either "user", "author" or "agent", determines the role the
+stylesheet plays in the cascade algorithm. In general, author
+stylesheets take precedence over user stylesheets which take
+precedence over agent stylesheets. An author stylesheet is one
+supplied or linked by the author of the document. A user stylesheet
+is supplied by the user of the viewing application, possibly by
+configuring a preferences dialog or similar. An agent stylesheet is
+supplied by the viewing application, for example the default
+stylesheet configured using the -defaultstyle option.
+</p>
+
+<p>
+The stylesheet id mechanism is designed so that the cascade can be
+correctly implemented even when the various stylesheets are passed
+to the widget asynchronously and out of order (as may be the case
+if they are being downloaded from a network server or servers).
+</p>
+
+
+<div style="margin-left:8ex"><pre><p>
+#
+# Contents of HTML document
+#
+</p>
+
+<p>
+<html><head>
+ <link rel="stylesheet" href="A.css">
+ <style>
+ @import uri("B.css")
+ @import uri("C.css")
+ ... rules ...
+ </style>
+ <link rel="stylesheet" href="D.css">
+... remainder of document ...
+</p>
+
+<p>
+#
+# Contents of B.css
+#
+</p>
+
+<p>
+ at import "E.css"
+... rules ...
+</pre></div>
+
+
+<p>
+In the example above, the stylesheet documents A.css, B.css, C.css,
+D.css, E.css and the stylesheet embedded in the <style> tag are all
+author stylesheets. CSS states that the relative precedences of the
+stylesheets in this case is governed by the following rules:
+</p>
+
+
+<ul><li>
+Linked, embedded or imported stylesheets take precedence
+over stylesheets linked, embedded or imported earlier in
+the same document or stylesheet.
+<li>
+Rules specified in a stylesheet take precedence over rules
+specified in imported stylesheets.
+</ul>
+
+
+<p>
+Applying the above two rules to the example documents indicates
+that the order of the stylesheets from least to most important is:
+A.css, E.css, B.css, C.css, embedded <stylesheet>, D.css. For the
+widget to implement the cascade correctly, the stylesheet-ids
+passed to the six [pathName style] commands must sort
+lexigraphically in the same order as the stylesheet precedence
+determined by the above two rules. The example code above shows one
+approach to this. Using the example code, stylesheets would
+be associated with stylesheet-ids as follows:
+</p>
+
+
+<div style="margin-left:8ex"><pre><p>
+Stylesheet Stylesheet-id
+-------------------------------
+A.css author.0001.9999
+<embedded style> author.0002.9999
+B.css author.0002.0003.9999
+E.css author.0002.0003.0004.9999
+C.css author.0002.0005.9999
+D.css author.0006.9999
+</pre></div>
+
+
+<p>
+Entries are specified in the above table in the order in which the
+calls to [html style] would be made. Of course, the example code
+fails if 10000 or more individual stylesheet documents are loaded.
+More inventive solutions that avoid this kind of limitation are
+possible.
+</p>
+
+<p>
+Other factors, namely rule specificity and the !IMPORTANT directive
+are involved in determining the precedence of individual stylesheet
+rules. These are completely encapsulated by the widget, so are not
+described here. For complete details of the CSS cascade algorithm,
+refer to [1].
+</p>
+
+
+<a name="section11"><h2>Incremental Document Loading</h2></a>
+
+<p>
+This section discusses the widget API in the context of loading a
+document incrementally, for example from a network server. We
+assume both remote stylesheets and image files are retrieved as
+well as the document.
+</p>
+
+<p>
+Before a new document (html file) is loaded, any previous document
+should be purged from memory using the [pathName reset] command.
+The portion of the new document that is read is passed to the
+widget using the [pathName parse] command. As new chunks of the
+document are downloaded, they should also be passed to
+[pathName parse]. When the final chunk of the document file is
+passed to the [pathName parse] command the -final option should
+be specified. This ensures node-handler callbacks (see the
+description of the [pathname handler] command above) are made
+for tags that are closed implicitly by the end of the document.
+</p>
+
+<p>
+The widget display is updated in an idle callback scheduled after
+each invocation of the [pathName parse] command.
+</p>
+
+
+<a name="section12"><h2>HTML Specific Processing</h2></a>
+
+<p>
+TODO: Detail implicit opening and closing tag rules here.
+</p>
+
+
+<a name="section13"><h2>References</h2></a>
+
+
+<p>
+[1] CSS2 specification.
+
+ </p>
+ <a name="TOC"><h1>tkhtml (n) - Table Of Contents</h1></a>
+ <a name="index"><ul></a><li><a href="#section1">Name</a><li><a href="#section2">Synopsis</a><li><a href="#section3">Standard Options</a><li><a href="#section4">Widget-Specific Options</a><li><a href="#section5">Description</a><li><a href="#section6">Widget Command</a><li><a href="#section7">Node Command</a><li><a href="#section8">Replaced Objects</a><li><a href="#section9">Image Loading</a><li><a href="#section10">Stylesheet Loading</a><li><a href="#section11">Incremental Document Loading</a><li><a href="#section12">HTML Specific Processing</a><li><a href="#section13">References</a></ul>
+ </body>
+ </html>
+
diff --git a/doc/tkhtml.n b/doc/tkhtml.n
new file mode 100644
index 0000000..a7498f5
--- /dev/null
+++ b/doc/tkhtml.n
@@ -0,0 +1,682 @@
+.TH "tkhtml" "n" "Sat Feb 25 06:44:47 PM ICT 2006"
+
+
+.SH "NAME"
+tkhtml - Widget to render html documents.
+
+.SH "SYNOPSIS"
+html pathName ?options?
+
+.SH "STANDARD OPTIONS"
+.RS
+
+.nf
+-height
+-width
+-xscrollcommand
+-xscrollincrement
+-yscrollcommand
+-yscrollincrement
+.fi
+.RE
+
+.SH "WIDGET-SPECIFIC OPTIONS"
+Command-Line Name:-defaultstyle
+.br
+Database Name: defaultstyle
+.br
+Database Class: Defaultstyle
+.br
+.RS
+.PP
+This option is used to set the default style-sheet for the
+widget. The option value should be the entire text of the
+default style-sheet, or an empty string, in which case a
+built-in default stylesheet (for HTML) is used.
+
+At the moment, this option is not very useful. The default
+stylesheet defines things that are "built-in" to the
+document - for example the behaviour of <p> or <img> tags
+in html. The idea behind making it flexible is to allow
+Tkhtml to display anything that looks roughly like an XML
+document. But it will not work at the moment because of
+other assumptions the implementation makes about the set
+of valid tags.
+.RE
+Command-Line Name:-imagecmd
+.br
+Database Name: imagecmd
+.br
+Database Class: Imagecmd
+.br
+.RS
+.PP
+As well as for replacing entire document nodes (i.e. <img>),
+images are used in several other contexts in CSS formatted
+documents, for example as list markers or backgrounds. If the
+-imagecmd option is not set to an empty string (the default),
+then each time an image URI is encountered in the document, it
+is appended to the -imagecmd script and the resulting list
+evaluated.
+
+The command should return either an empty string, the name of a
+Tk image, or a list of exactly two elements, the name of a Tk
+image and a script. If the result is an empty string, then no
+image can be displayed. If the result is a Tk image name, then
+the image is displayed in the widget. When the image is no
+longer required, it is deleted. If the result of the command is
+a list containing a Tk image name and a script, then instead of
+deleting the image when it is no longer required, the script is
+evaluated.
+
+If the size or content of the image are modified while it is in
+use the widget display is updated automatically.
+.RE
+Command-Line Name:-logcmd
+.br
+Database Name: logcmd
+.br
+Database Class: Logcmd
+.br
+.RS
+.PP
+This option is used for internally debugging the widget.
+.RE
+
+.SH "DESCRIPTION"
+
+The [html] command creates a new window (given by the pathName
+argument) and makes it into an html widget. The html command
+returns its pathName argument. At the time this command is invoked,
+there must not exist a window named pathName, but pathName's parent
+must exist.
+
+.SH "WIDGET COMMAND"
+The [html] command creates a new Tcl command whose name is
+pathName. This command may be used to invoke various operations on
+the widget as follows:
+
+pathName bbox nodeHandle
+.br
+.RS
+If node nodeHandle generates content, this command returns a
+list of four integers that define the bounding-box of the
+generated content, relative to the top-left hand corner of the
+rendered document. The first two integers are the x and y
+coordinates of the top-left corner of the bounding-box, the
+later two are the x and y coordinates of the bottom-right
+corner of the same box. If the node does not generate content,
+then an empty string is returned.
+.RE
+
+pathName cget option
+.br
+.RS
+Returns the current value of the configuration option given
+by option. Option may have any of the values accepted by
+the [html] command.
+.RE
+
+pathName configure ?option? ?value?
+.br
+.RS
+Query or modify the configuration options of the widget. If
+no option is specified, returns a list describing all of
+the available options for pathName (see Tk_ConfigureInfo
+for information on the format of this list). If option is
+specified with no value, then the command returns a list
+describing the one named option (this list will be
+identical to the corresponding sublist of the value
+returned if no option is specified). If one or more
+option-value pairs are specified, then the command modifies
+the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. Option may
+have any of the values accepted by the [html] command.
+.RE
+
+pathName handler type tag script
+.br
+.RS
+This command is used to define "handler" scripts - Tcl
+callback scripts that are invoked by the widget when
+document elements of specified types are encountered. The
+widget supports two types of handler scripts: "node" and
+"script". The type parameter to this command must
+take one of these two values.
+
+For a "node" handler script, whenever a document element
+having the specified tag type (e.g. "p" or "link") is
+encountered during parsing, then the node handle for the
+node is appended to script and the resulting list
+evaluated as a Tcl command. See the section "NODE COMMAND"
+for details of how a node handle may be used to query and
+manipulate a document node.
+
+If the handler script is a "script" handler, whenever a
+document node of type tag is parsed, then the text
+that appears between the start and end tags of the node is
+appended to script and the resulting list evaluated
+as a Tcl command.
+
+Handler callbacks are always made from within
+[pathName parse] commands. The callback for a given node
+is made as soon as the node is completely parsed. This can
+happen because an implicit or explicit closing tag is
+parsed, or because there is no more document data and the
+-final switch was passed to the [pathName parse]
+command.
+
+TODO: Return values of handler scripts? If an exception
+occurs in a handler script?
+.RE
+
+pathName image
+.br
+.RS
+This command returns the name of a new Tk image containing
+the rendered document. Where Tk widgets would be mapped in a
+live display, the image contains blank space.
+
+The returned image should be deleted when the script has
+finished with it, for example:
+.RS
+
+.nf
+set img [.html image]
+# ... Use $img ...
+image delete $img
+.fi
+.RE
+
+This command is included mainly for automated testing and
+should be used with care, as large documents can result in very
+large images that take a long time to create and use vast
+amounts of memory.
+
+Currently this command is not available on windows. On that
+platform an empty string is always returned.
+.RE
+
+pathName node ? ?-index? x y?
+.br
+.RS
+This command is used to retrieve one or more document node
+handles from the current document. If the x and y parameters
+are omitted, then the handle returned is the root-node of the
+document, or an empty string if the document has no root-node
+(i.e. an empty document).
+
+If the x and y arguments are present, then a list of node
+handles is returned. The list contains one handle for each
+node that generates content currently located at viewport
+coordinates (x, y). Usually this is only a single node, but
+floating boxes and other overlapped content can cause
+this command to return more than one node. If no content is
+located at the specified coordinates or the widget window is
+not mapped, then an empty string is returned.
+
+If the -index option is specified along with the x and y
+coordinates, then instead of a list of node handles, a list of
+two elements is returned. The first element of the list is the
+node-handle associated with the generated text closest to
+the specified (x, y) coordinates. The second list value is an
+index into the text obtainable by [nodeHandle text] for the
+character closest to coordinates (x, y). The index may be used
+with the [pathName select] commands.
+
+The document node can be queried and manipulated using the
+interface described in the "NODE COMMAND" section.
+.RE
+
+pathName parse ?-final? html-text
+.br
+.RS
+Append extra text to the end of the (possibly empty)
+document currently stored by the widget.
+
+If the -final option is present, this indicates that the
+supplied text is the last of the document. Any subsequent
+call to [pathName parse] before a call to [pathName reset]
+will raise an error.
+.RE
+
+pathName reset
+.br
+.RS
+This is used to clear the internal contents of the widget
+prior to parsing a new document. The widget is reset such
+that the document tree is empty (as if no calls to
+[pathName parse] had ever been made) and no stylesheets
+except the default stylesheet are loaded (as if no
+invocations of [pathName style] had occured).
+.RE
+
+pathName select clear
+.br
+pathName select from ?nodeHandle ?index? ?
+.br
+pathName select to ?nodeHandle ?index? ?
+.br
+pathName select span
+.br
+.RS
+The [pathName select] commands are used to query and
+manipulate the widget selection.
+
+TODO: Describe these commands.
+.RE
+
+pathName style ?options? stylesheet-text
+.br
+.RS
+Add a stylesheet to the widgets internal configuration. The
+stylesheet-text argument should contain the text of a
+complete stylesheet. Incremental parsing of stylesheets is
+not supported, although of course multiple stylesheets may
+be added to a single widget.
+
+The following options are supported:
+.RS
+
+.nf
+Option Default Value
+--------------------------------------
+-id <stylesheet-id> "author"
+-importcmd <script> ""
+-urlcmd <script> ""
+.fi
+.RE
+
+The value of the -id option determines the priority taken
+by the style-sheet when assigning property values to
+document nodes (see chapter 6 of the CSS specification for
+more detail on this process). The first part of the
+style-sheet id must be one of the strings "agent", "user"
+or "author". Following this, a style-sheet id may contain
+any text.
+
+When comparing two style-ids to determine which stylesheet
+takes priority, the widget uses the following approach: If
+the initial strings of the two style-id values are not
+identical, then "user" takes precedence over "author", and
+"author" takes precedence over "agent". Otherwise, the
+lexographically largest style-id value takes precedence.
+For more detail on why this seemingly odd approach is
+taken, please refer to the "STYLESHEET LOADING" below.
+
+The -importcmd option is used to provide a handler script
+for @import directives encountered within the stylesheet
+text. Each time an @import directive is encountered, if the
+-importcmd option is set to other than an empty string, the
+URI to be imported is appended to the option value and the
+resulting list evaluated as a Tcl script. The return value
+of the script is ignored. If the script raises an error,
+then it is propagated up the call-chain to the
+[pathName style] caller.
+
+The -urlcmd option is used to supply a script to translate
+"url(...)" CSS attribute values. If this option is not set to
+"", each time a url() value is encountered the URI is appended
+to the value of -urlcmd and the resulting script evaluated. The
+return value is stored as the URL in the parsed stylesheet.
+.RE
+
+pathName xview ?options?
+.br
+.RS
+This command is used to query or adjust the horizontal
+position of the viewport relative to the document layout.
+It is identical to the [pathName xview] command
+implemented by the canvas and text widgets.
+.RE
+
+pathName yview ?options?
+.br
+.RS
+This command is used to query or adjust the vertical
+position of the viewport relative to the document layout.
+It is identical to the [pathName yview] command
+implemented by the canvas and text widgets.
+.RE
+
+.SH "NODE COMMAND"
+There are several interfaces by which a script can obtain a "node
+handle". Each node handle is a Tcl command that may be used to
+access the document node that it represents. A node handle is valid
+from the time it is obtained until the next call to
+[pathName reset]. The node handle may be used to query and
+manipulate the document node via the following subcommands:
+
+nodeHandle attr ?attribute?
+.br
+.RS
+If the attribute argument is present, then return the value
+of the named html attribute, or an empty string if the
+attribute specified does not exist. If it is not present,
+return a key-value list of the defined attributes of the
+form that can be passed to [array set].
+.RS
+
+.nf
+# Html code for node
+<p class="normal" id="second" style="color : red">
+
+# Value returned by [nodeHandle attr]
+{class normal id second style {color : red}}
+
+# Value returned by [nodeHandle attr class]
+normal
+.fi
+.RE
+.RE
+
+nodeHandle child index
+.br
+.RS
+Return the node handle for the index'th child of the node.
+Children are numbered from zero upward.
+.RE
+
+nodeHandle nChild
+.br
+.RS
+Return the number of children the node has.
+.RE
+
+nodeHandle parent
+.br
+.RS
+Return the node handle for the node's parent. If the node
+does not have a parent (i.e. it is the document root), then
+return an empty string.
+.RE
+
+nodeHandle replace ? ?options? newValue?
+.br
+.RS
+This command is used to set and get the name of the
+replacement object for the node, if any. If the newValue
+argument is present, then this command sets the nodes
+replacement object name and returns the new value. If
+newValue is not present, then the current value is
+returned.
+
+A nodes replacement object may be set to the name of a Tk
+window or an empty string. If it is an empty string (the
+default and usual case), then the node is rendered normally.
+If the node replacement object is set to the name of a Tk
+window, then the Tk window is mapped into the widget in place
+of any other content (for example to implement form elements or
+plugins).
+
+The following options are supported:
+.RS
+
+.nf
+Option Default Value
+--------------------------------------
+-deletecmd <script> "destroy <window>"
+-configurecmd <script> ""
+.fi
+.RE
+
+When a replacement object is no longer being used by the
+widget (e.g. because the node has been deleted or
+[pathName reset] is invoked), the value of the
+-deletecmd option is evaluated as Tcl script.
+
+If it is not set to an empty string (the default) each time
+the nodes CSS properties are recalculated, a serialized
+array is appended to the value of the -configurecmd option
+and the result evaluated as a Tcl command. The script
+should update the replacement objects appearance where
+appropriate to reflect the property values. The format of
+the appended argument is {p1 v1 p2 v2 ... pN vN} where the
+pX values are property names (i.e. "background-color") and
+the vX values are property values (i.e. "#CCCCCC"). The
+CSS properties that currently may be present in the array
+are listed below. More may be added in the future.
+.RS
+
+.nf
+background-color color
+font selected
+.fi
+.RE
+
+The value of the "font" property, if present in the
+serialized array is not set to the value of the
+corresponding CSS property. Instead it is set to the name
+of a Tk font determined by combining the various
+font-related CSS properties. Unless they are set to
+"transparent", the two color values are guaranteed to parse
+as Tk colors. The "selected" property is either true or
+false, depending on whether or not the replaced object is
+part of the selection or not. Whether or not an object is
+part of the selection is governed by previous calls to the
+[pathName select] command.
+
+The -configurecmd callback is always executed at least once
+between the [nodeHandle replace] command and when the
+replaced object is mapped into the widget display.
+.RE
+
+nodeHandle tag
+.br
+.RS
+Return the name of the Html tag that generated this
+document node (i.e. "p" or "link"), or an empty string if
+the node is a text node.
+.RE
+
+nodeHandle text
+.br
+.RS
+If the node is a "text" node, return the string contained
+by the node. If the node is not a "text" node, return an
+empty string.
+.RE
+
+TODO: Add the "write" part of the DOM compatible interface to this
+section.
+
+.SH "STYLESHEET LOADING"
+Apart from the default stylesheet that is always loaded (see the
+description of the -defaultstyle option above), a script may
+configure the widget with extra style information in the form of
+CSS stylesheet documents. Complete stylesheet documents (it is not
+possible to incrementally parse stylesheets as it is HTML document
+files) are passed to the widget using the [pathName style]
+command.
+
+As well as any stylesheets specified by the application,
+stylesheets may be included in HTML documents by document authors
+in several ways:
+.RS
+.IP * 2
+Embedded in the document itself, using a <style> tag. To
+handle this case an application script must register a
+"script" type handler for <style> tags using the
+[pathName handler] command. The handler command should
+call [pathName style] to configure the widget with the
+stylesheet text.
+.IP * 2
+Linked from the document, using a <link> tag. To handle
+this case the application script should register a "node"
+type handler for <link> tags.
+.IP * 2
+Linked from another stylesheet, using the @import
+directive. To handle this, an application needs to
+configure the widget -importcommand option.
+.RE
+.RS
+
+.nf
+# Implementations of application callbacks to load
+# stylesheets from the various sources enumerated above.
+# ".html" is the name of the applications tkhtml widget.
+# The variable $document contains an entire HTML document.
+# The pseudo-code <LOAD URI CONTENTS> is used to indicate
+# code to load and return the content located at $URI.
+
+proc script_handler {tagcontents} {
+ incr ::stylecount
+ set id "author.[format %.4d $::stylecount]"
+ set handler "import_handler $id"
+ .html style -id $id.9999 -importcmd $handler $tagcontents
+}
+
+proc link_handler {node} {
+ if {[node attr rel] == "stylesheet"} {
+ set URI [node attr href]
+ set stylesheet [<LOAD URI CONTENTS>]
+
+ incr ::stylecount
+ set id "author.[format %.4d $::stylecount]"
+ set handler "import_handler $id"
+ .html style -id $id.9999 -importcmd $handler $stylesheet
+ }
+}
+
+proc import_handler {parentid URI} {
+ set stylesheet [<LOAD URI CONTENTS>]
+
+ incr ::stylecount
+ set id "$parentid.[format %.4d $::stylecount]"
+ set handler "import_handler $id"
+ .html style -id $id.9999 -importcmd $handler $stylesheet
+}
+
+.html handler script style script_handler
+.html handler node link link_handler
+
+set ::stylecount 0
+
+.html parse -final $document
+.fi
+.RE
+
+The complicated part of the example code above is the generation of
+stylesheet-ids, the values passed to the -id option of the
+[.html style] command. Stylesheet-ids are used to determine the
+precedence of each stylesheet passed to the widget, and the role it
+plays in the CSS cascade algorithm used to assign properties to
+document nodes. The first part of each stylesheet-id, which must be
+either "user", "author" or "agent", determines the role the
+stylesheet plays in the cascade algorithm. In general, author
+stylesheets take precedence over user stylesheets which take
+precedence over agent stylesheets. An author stylesheet is one
+supplied or linked by the author of the document. A user stylesheet
+is supplied by the user of the viewing application, possibly by
+configuring a preferences dialog or similar. An agent stylesheet is
+supplied by the viewing application, for example the default
+stylesheet configured using the -defaultstyle option.
+
+The stylesheet id mechanism is designed so that the cascade can be
+correctly implemented even when the various stylesheets are passed
+to the widget asynchronously and out of order (as may be the case
+if they are being downloaded from a network server or servers).
+.RS
+
+.nf
+#
+# Contents of HTML document
+#
+
+<html><head>
+ <link rel="stylesheet" href="A.css">
+ <style>
+ @import uri("B.css")
+ @import uri("C.css")
+ ... rules ...
+ </style>
+ <link rel="stylesheet" href="D.css">
+... remainder of document ...
+
+#
+# Contents of B.css
+#
+
+ at import "E.css"
+... rules ...
+.fi
+.RE
+
+In the example above, the stylesheet documents A.css, B.css, C.css,
+D.css, E.css and the stylesheet embedded in the <style> tag are all
+author stylesheets. CSS states that the relative precedences of the
+stylesheets in this case is governed by the following rules:
+.RS
+.IP * 2
+Linked, embedded or imported stylesheets take precedence
+over stylesheets linked, embedded or imported earlier in
+the same document or stylesheet.
+.IP * 2
+Rules specified in a stylesheet take precedence over rules
+specified in imported stylesheets.
+.RE
+
+Applying the above two rules to the example documents indicates
+that the order of the stylesheets from least to most important is:
+A.css, E.css, B.css, C.css, embedded <stylesheet>, D.css. For the
+widget to implement the cascade correctly, the stylesheet-ids
+passed to the six [pathName style] commands must sort
+lexigraphically in the same order as the stylesheet precedence
+determined by the above two rules. The example code above shows one
+approach to this. Using the example code, stylesheets would
+be associated with stylesheet-ids as follows:
+.RS
+
+.nf
+Stylesheet Stylesheet-id
+-------------------------------
+A.css author.0001.9999
+<embedded style> author.0002.9999
+B.css author.0002.0003.9999
+E.css author.0002.0003.0004.9999
+C.css author.0002.0005.9999
+D.css author.0006.9999
+.fi
+.RE
+
+Entries are specified in the above table in the order in which the
+calls to [html style] would be made. Of course, the example code
+fails if 10000 or more individual stylesheet documents are loaded.
+More inventive solutions that avoid this kind of limitation are
+possible.
+
+Other factors, namely rule specificity and the !IMPORTANT directive
+are involved in determining the precedence of individual stylesheet
+rules. These are completely encapsulated by the widget, so are not
+described here. For complete details of the CSS cascade algorithm,
+refer to [1].
+
+.SH "INCREMENTAL DOCUMENT LOADING"
+This section discusses the widget API in the context of loading a
+document incrementally, for example from a network server. We
+assume both remote stylesheets and image files are retrieved as
+well as the document.
+
+Before a new document (html file) is loaded, any previous document
+should be purged from memory using the [pathName reset] command.
+The portion of the new document that is read is passed to the
+widget using the [pathName parse] command. As new chunks of the
+document are downloaded, they should also be passed to
+[pathName parse]. When the final chunk of the document file is
+passed to the [pathName parse] command the -final option should
+be specified. This ensures node-handler callbacks (see the
+description of the [pathname handler] command above) are made
+for tags that are closed implicitly by the end of the document.
+
+The widget display is updated in an idle callback scheduled after
+each invocation of the [pathName parse] command.
+
+TODO: Finish this section.
+
+.SH "HTML SPECIFIC PROCESSING"
+TODO: Detail implicit opening and closing tag rules here. LATER: If
+only I could figure them out...
+
+.SH "REFERENCES"
+
+[1] CSS2 specification.
diff --git a/hv/README b/hv/README
index e4d52b3..8b13789 100644
--- a/hv/README
+++ b/hv/README
@@ -1,114 +1 @@
-Widget Wrappers
----------------
-
- ::hv3::scrolledwidget
- ::hv3::toolbutton
- ::hv3::pretend_tile_notebook
-
- ::hv3::scrollbar
- ::hv3::button
- ::hv3::entry
- ::hv3::text
- ::hv3::label
- ::hv3::toolbutton
-
-
-
-OBJECTS
--------
-
-Hv3 Mega-Widget Object Types:
-
- Widgets:
-
- ::hv3::hv3 (hv3.tcl)
- Reusable mega-widget built on top of Tkhtml. There is no man-page
- yet, but the widget interface is described at the top of the
- file hv3.tcl.
-
-
- ::hv3::tclet (hv3_object.tcl)
- A widget containing a Tcl applet running in a safe interpreter.
- Widget's of this type are used as replacement objects for Tkhtml
- nodes whenever a Tclet specified as an <object> or <embed> tag
- is encountered.
-
- ::hv3::control (hv3_form.tcl)
- A widget class for form controls. This is used as the replacement
- object for <input>, <select>, <textarea>, <isindex> and <button>
- element nodes.
-
- ::hv3::fileselect (hv3_form.tcl)
- Used (and encapsulated) by ::hv3::control to implement
- <input type=file> controls.
-
- ::hv3::filedownloader (hv3_http.tcl)
- This widget implements the file-downloading dialog (i.e. the thing
- with the progress bar and Ok/Cancel button).
-
- ::hv3::findwidget (hv3_widgets.tcl)
- This widget implements logic and gui for the "find text" function. It
- currently uses Tkhtml3 interfaces only (no hv3 interfaces).
- NOTE: This will have to change to support frameset documents.
-
- Other Types:
-
- ::hv3::hv3::selectionmanager (hv3.tcl)
- ::hv3::hv3::dynamicmanager (hv3.tcl)
- ::hv3::hv3::hyperlinkmanager (hv3.tcl)
- Internal components to manage the selection, dynamic (i.e. :hover)
- effects and hyperlinks, respectively. These are really just used
- to break up the hv3::hv3 a bit. Eventually, each of these (and the
- formmanager) will be optional functions that may be enabled or
- disabled by hv3 users. TODO: Images too? Should there be an
- ::hv3::hv3::imagemanager?
-
- ::hv3::formmanager (hv3_form.tcl)
- ::hv3::form (hv3_form.tcl)
-
- ::hv3::download (hv3.tcl)
-
- ::hv3::uri (hv3.tcl)
- Type to extract components from and perform other operations on URIs.
-
-Hv3 Protocol Object Types:
-
- Other Types:
-
- ::hv3::protocol (hv3_http.tcl)
- ::hv3::cookiemanager (hv3_http.tcl)
-
-Hv3 Application Object Types:
-
- Widgets:
-
- ::hv3::frameset (hv3_frameset.tcl)
-
- ::hv3::browser_frame (hv3_main.tcl)
-
- ::hv3::browser_toplevel (hv3_main.tcl)
- Instances of this widget are managed directly by the notebook.
- Each instance of this widget creates it's own ::hv3::protocol
- and ::hv3::history objects. It also creates and destroys
- ::hv3::findwidget widgets as requested by the user.
-
- ::hv3::finddialog (hv3_widgets.tcl)
- This widget implements the find-text dialog.
-
- Other Types:
-
- ::hv3::history (hv3_main.tcl)
-
-Tree browser:
-
- HtmlDebug
-
-
-
-NOTES ON FRAMES AND TABS
-------------------------
-
- Both frames and tabs are implemented as part of the demo application, not
- Tkhtml or the hv3 mega-widget.
-
diff --git a/hv/bookmarks.html b/hv/bookmarks.html
new file mode 100644
index 0000000..361769d
--- /dev/null
+++ b/hv/bookmarks.html
@@ -0,0 +1,553 @@
+
+<HTML>
+ <HEAD>
+ <STYLE>
+ h1 {
+ font-size: 1.4em;
+ font-weight: normal;
+ }
+ h2 {
+ float: left;
+ width: 45%;
+ border: solid 1px purple;
+ border-right: none;
+ border-bottom: none;
+ color: purple;
+ margin: 2px;
+ background: #CCCCCC;
+ cursor: pointer;
+ font-size: 1.4em;
+ }
+ li {
+ float: left;
+ width: 50%;
+ min-width: 180px;
+ }
+ form {
+ margin: 0;
+ }
+
+ .bookmark[active="true"]:hover {
+ background-color: #DDDDDD;
+ }
+ .bookmark[clickable="0"]:hover {
+ background-color: #EEEEEE;
+ }
+ .bookmark {
+ cursor:pointer;
+ margin: 1px;
+ padding: 2px 0 2px 15px;
+ background: #EEEEEE;
+
+ border-top: solid 2px purple;
+ border-left: solid 2px purple;
+
+ display: block;
+ position: relative;
+
+ float: left;
+ width: 45%;
+ min-width: 180px;
+ }
+ .bookmark a {
+ text-decoration: none;
+ color: black;
+ display: block;
+ }
+
+ ul {
+ padding: 0;
+ margin: auto auto auto 15px;
+ }
+ .folder {
+ padding: 0px 5px;
+ margin: 0 0 10px 0;
+ width: 100%;
+ display: table;
+ position: relative;
+ }
+
+ #controls {
+ border-bottom: solid black 2px;
+ background: white;
+ position: fixed;
+ top: 0px;
+ left: 0px;
+ right: 0px;
+ z-index: 5;
+ }
+ .edit {
+ display: block;
+ float: right;
+ font-size: small;
+ color: darkblue;
+ text-decoration: underline;
+ font-weight: normal;
+ padding-right: 5px;
+ }
+
+ body {
+ margin-top: 3em;
+ }
+
+ #searchbox {
+ width:100%;
+ }
+ #searchbox[active="1"] {
+ border-color: red;
+ }
+
+ #undelete {
+ display:block;
+ float:right;
+ font-size:medium;
+ }
+ </STYLE>
+ <SCRIPT>
+
+var drag = new Object()
+drag.element = undefined
+drag.interval = undefined
+drag.x = undefined
+drag.y = undefined
+drag.original_x = undefined
+drag.original_y = undefined
+drag.isDelete = false
+
+var app = new Object()
+app.zFilter = ""
+
+function mouseup_handler (event) {
+ drag.element.style.top = '0px'
+ drag.element.style.left = '0px'
+ drag.element.style.zIndex = 'auto'
+ drag.element.style.backgroundColor = ""
+ clearInterval(drag.interval)
+ document.onmouseup = undefined
+ document.onmousemove = undefined
+
+ if (drag.isDelete) {
+ drag.element.parentNode.removeChild(drag.element)
+ app.version = hv3_bookmarks.remove(drag.element)
+
+ var u = document.getElementById("undelete")
+ u.innerHTML = hv3_bookmarks.get_undelete()
+
+ } else if (drag.element.onclick == ignore_click) {
+ if (drag.element.className == 'bookmark') {
+ app.version = hv3_bookmarks.bookmark_move(drag.element)
+ }
+ if (drag.element.className == 'folder') {
+ app.version = hv3_bookmarks.folder_move(drag.element)
+ }
+ }
+ drag.isDelete = false
+ drag.element = undefined
+ return 0
+}
+function mousemove_handler (event) {
+ drag.x = event.clientX
+ drag.y = event.clientY
+ return 0
+}
+
+function ignore_click () {
+ this.onclick = undefined
+ this.setAttribute("clickable", "1")
+ return 0
+}
+
+function drag_cache_position(d) {
+ d.drag_x1 = 0
+ d.drag_y1 = 0
+ for (var p = d; p != null; p = p.offsetParent) {
+ d.drag_x1 += p.offsetLeft
+ d.drag_y1 += p.offsetTop
+ }
+ d.drag_x2 = d.drag_x1 + d.offsetWidth
+ d.drag_y2 = d.drag_y1 + d.offsetHeight
+}
+
+function drag_makedropmap(elem) {
+ drag.drag_targets = new Array()
+
+ var dlist = document.getElementsByTagName('div');
+ for ( var i = 0; i < dlist.length; i++) {
+ var d = dlist[i]
+ if (d != elem && d.className == elem.className) {
+ if (d.className == "folder" && d.id == "0") {
+ continue
+ }
+ if (d.parentNode.style.display == "none") {
+ continue
+ }
+ drag_cache_position(d)
+ drag.drag_targets.push(d)
+ }
+ }
+
+ if (elem.className == "bookmark") {
+ var hlist = document.getElementsByTagName('h2')
+ for ( var i = 0; i < hlist.length; i++) {
+ var h = hlist[i]
+ if (h.nextSibling.style.display != "none") {
+ drag_cache_position(h)
+ drag.drag_targets.push(h)
+ }
+ }
+
+ hlist = document.getElementsByTagName('h1')
+ for ( var i = 0; i < hlist.length; i++) {
+ var h = hlist[i]
+ drag_cache_position(h)
+ h.drag_y2 += 15
+ drag.drag_targets.push(h)
+ }
+ }
+
+ drag_cache_position(drag.controls)
+}
+
+// This function is called periodically while an object is being
+// dragged (once every 20 ms or so).
+//
+function drag_update() {
+ if (
+ Math.abs(drag.x - drag.original_x) > 10 ||
+ Math.abs(drag.y - drag.original_y) > 10
+ ) {
+ drag.element.onclick = ignore_click
+ drag.element.setAttribute("clickable", "0")
+ }
+ drag.element.style.left = (drag.x - drag.original_x) + 'px'
+ drag.element.style.top = (drag.y - drag.original_y) + 'px'
+
+ if (!drag.drag_targets) {
+ drag_makedropmap(drag.element)
+ }
+
+ drag_cache_position(drag.element)
+ var cx = (drag.element.drag_x1 + drag.element.drag_x2) / 2
+ var cy = (drag.element.drag_y1 + drag.element.drag_y2) / 2
+
+ var isDelete = ((drag.element.drag_y1+5) < drag.controls.drag_y2)
+ if (isDelete && !drag.isDelete) {
+ drag.element.style.backgroundColor = "black"
+ drag.isDelete = isDelete
+ } else if (!isDelete && drag.isDelete) {
+ drag.element.style.backgroundColor = ""
+ drag.isDelete = isDelete
+ }
+
+ for (var i = 0; i < drag.drag_targets.length; i++) {
+ var a = drag.drag_targets[i]
+ if (a.drag_x1 < cx && a.drag_x2 > cx &&
+ a.drag_y1 < cy && a.drag_y2 > cy
+ ) {
+
+ var x = drag.element.drag_x1
+ var y = drag.element.drag_y1
+
+ var p = a.parentNode
+ if (a.nodeName == "H2") {
+ p = a.nextSibling
+ a = p.firstChild
+ } else if (a.nodeName == "H1") {
+ p = app.nofolder.childNodes[1]
+ a = p.firstChild
+ }
+
+ if (drag.element.parentNode == p) {
+ for (var j = 0; j < p.childNodes.length; j++) {
+ var child = p.childNodes[j]
+ if (child == a) {
+ break
+ } else if (child == drag.element) {
+ a = a.nextSibling
+ break
+ }
+ }
+ }
+
+ if (drag.element == a) return
+ p.insertBefore(drag.element, a)
+
+ drag_cache_position(drag.element)
+ var sx = drag.element.drag_x1 - x
+ var sy = drag.element.drag_y1 - y
+
+ drag.original_x += sx
+ drag.original_y += sy
+
+ drag.element.style.left = (drag.x - drag.original_x) + 'px'
+ drag.element.style.top = (drag.y - drag.original_y) + 'px'
+
+ drag_makedropmap(drag.element)
+ break
+ }
+ }
+}
+
+function mousedown_handler (elem, event) {
+ clearInterval(drag.interval)
+ drag.isDelete = false
+ drag.element = elem
+
+ drag.original_x = event.clientX
+ drag.original_y = event.clientY
+ drag.x = event.clientX
+ drag.y = event.clientY
+ drag.element.style.zIndex = 10
+ drag.interval = setInterval(drag_update, 20)
+ document.onmouseup = mouseup_handler
+ document.onmousemove = mousemove_handler
+
+ drag_makedropmap(drag.element)
+ return 0
+}
+
+// Toggle visibility of folder contents.
+//
+function folder_toggle (folder, event, toggle) {
+ var h2 = folder.childNodes[0]
+ var ul = folder.childNodes[1]
+
+ if (folder.onclick == ignore_click) return
+
+ var isHidden = (1 * folder.getAttribute('folder_hidden'))
+ if (toggle) {
+ isHidden = (isHidden ? 0 : 1)
+ folder.setAttribute('folder_hidden', isHidden)
+ app.version = hv3_bookmarks.folder_hidden(folder)
+ }
+
+ if (isHidden) {
+ /* Hide the folder contents */
+ ul.style.display = 'none'
+ ul.style.clear = 'none'
+
+ h2.childNodes[1].innerHTML = '+ '
+ h2.style.width = 'auto'
+ h2.style.cssFloat = 'none'
+
+ folder.style.cssFloat = 'left'
+ folder.style.width = '45%'
+ folder.style.clear = 'none'
+ folder.style.marginBottom = '0'
+ } else {
+ /* Expand the folder contents */
+ ul.style.display = 'table'
+ ul.style.clear = 'both'
+
+ h2.childNodes[1].innerHTML = '- '
+ h2.style.width = '45%'
+ h2.style.cssFloat = 'left'
+
+ folder.style.clear = 'both'
+ folder.style.cssFloat = 'none'
+ folder.style.width = '100%'
+ folder.style.marginBottom = '10px'
+ }
+
+ return 0
+}
+
+function bookmark_mousedown(elem, event) {
+ mousedown_handler(elem, event)
+ return 0
+}
+function folder_mousedown(elem, event) {
+ mousedown_handler(elem.parentNode, event)
+ return 0
+}
+
+function bookmark_submit(form) {
+ var elem = form.parentNode.parentNode
+
+ var new_name = form.n.value
+ var new_uri = form.u.value
+ var new_tags = form.t.value
+
+ elem.setAttribute('bookmark_name', new_name)
+ elem.setAttribute('bookmark_uri', new_uri)
+ elem.setAttribute('bookmark_tags', new_tags)
+
+ var a = elem.childNodes[1]
+ a.firstChild.data = new_name
+ a.href = new_uri
+
+ app.version = hv3_bookmarks.bookmark_edit(elem)
+
+ bookmark_edit(elem)
+ return 0
+}
+
+function bookmark_edit(elem) {
+ var div = elem.childNodes[2]
+ if (div.isExpanded) {
+ div.innerHTML = ""
+ elem.firstChild.firstChild.data = "(edit)"
+ elem.setAttribute("active", "true")
+ div.isExpanded = 0
+ } else {
+ var str = ""
+ str += '<FORM onsubmit="return bookmark_submit(this)">'
+ str += '<TABLE width=100%>'
+ str += '<TR><TD>Name: <TD width=100%><INPUT width=90% name=n></INPUT>'
+ str += '<TR><TD>URI: <TD><INPUT width=90% name=u></INPUT>'
+ str += '<TR><TD>Tags: <TD><INPUT width=90% name=t></INPUT>'
+ str += '</TABLE></FORM>'
+
+ div.innerHTML = str
+ var f = div.firstChild;
+ f.n.value = elem.getAttribute('bookmark_name')
+ f.u.value = elem.getAttribute('bookmark_uri')
+ f.t.value = elem.getAttribute('bookmark_tags')
+ f.n.select()
+ f.n.focus()
+ elem.firstChild.firstChild.data = "(cancel)"
+ elem.setAttribute("active", "false")
+
+ div.isExpanded = 1
+ }
+ return 0
+}
+
+function folder_submit(form) {
+ var elem = form.parentNode.parentNode.parentNode
+ var t = elem.firstChild.childNodes[2]
+ var new_name = form.n.value
+ elem.setAttribute('folder_name', new_name)
+ t.data = new_name
+
+ app.version = hv3_bookmarks.folder_edit(elem)
+ folder_edit(elem)
+ return 0
+}
+
+function folder_edit(elem) {
+ var ed = elem.firstChild.firstChild
+ var div = elem.firstChild.childNodes[3]
+
+ if (div.isExpanded) {
+ ed.firstChild.data = "(edit)"
+ div.innerHTML = ""
+ div.isExpanded = 0
+ } else {
+ ed.firstChild.data = "(cancel)"
+
+ var str = "";
+ str += '<FORM onsubmit="return folder_submit(this)">'
+ str += '<TABLE width=100% style="color:black;margin-left:15px">'
+ str += '<TR><TD>Name: <TD width=100%><INPUT name=n></INPUT>'
+ str += '</TABLE></FORM>'
+ div.innerHTML = str
+
+ f = div.firstChild
+ f.n.value = elem.getAttribute('folder_name')
+ f.n.select()
+ f.n.focus()
+
+ div.isExpanded = 1
+ }
+ return 0
+}
+
+// The following are "onclick" handlers for the "New Bookmark"
+// and "New Folder" buttons respectively.
+//
+function bookmark_new() {
+ var id = hv3_bookmarks.bookmark_new(app.zFilter)
+ refresh_content()
+ bookmark_edit(document.getElementById(id))
+}
+function folder_new() {
+ var id = hv3_bookmarks.folder_new()
+ refresh_content()
+ folder_edit(document.getElementById(id))
+}
+
+function refresh_content() {
+ drag.content.innerHTML = hv3_bookmarks.get_html_content(app.zFilter)
+ app.version = hv3_bookmarks.get_version()
+ app.nofolder = document.getElementById("0")
+
+ var u = document.getElementById("undelete")
+ u.innerHTML = hv3_bookmarks.get_undelete()
+
+ var dlist = document.getElementsByTagName('div');
+ for ( var i = 0; i < dlist.length; i++) {
+ var d = dlist[i]
+ if (d.className == "folder") {
+ folder_toggle(d, 0, 0)
+ }
+ }
+}
+function check_refresh_content() {
+ if (app.version != hv3_bookmarks.get_version()) {
+ refresh_content()
+ }
+}
+
+function filter_bookmarks () {
+ var s = document.getElementById("searchbox")
+ app.zFilter = s.value
+ refresh_content()
+ if (app.zFilter != "") {
+ s.setAttribute("active", "1")
+ } else {
+ s.setAttribute("active", "0")
+ }
+ return 0
+}
+
+function clear_filter () {
+ var s = document.getElementById("searchbox")
+ s.value = ""
+ return filter_bookmarks()
+}
+
+function bookmark_undelete () {
+ hv3_bookmarks.undelete()
+ refresh_content()
+ return 0
+}
+
+window.onload = function () {
+ document.getElementById("searchbox").focus()
+ drag.controls = document.getElementById("controls")
+ drag.content = document.getElementById("content")
+ refresh_content()
+ setInterval(check_refresh_content, 2000)
+}
+
+ </SCRIPT>
+ </HEAD>
+ <BODY>
+ <TABLE id="controls"><TR>
+ <TD align="center">
+ <INPUT type="button" value="New Folder" onclick="folder_new()">
+ <TD align="center">
+ <INPUT type="button" value="New Bookmark" onclick="bookmark_new()">
+ </INPUT>
+ <TD align="left" style="padding-left:15px">
+ Filter:
+ <TD align="left" width=100% style="padding-right:2px">
+ <FORM onsubmit="return filter_bookmarks()">
+ <INPUT type="text" id="searchbox"></INPUT>
+ </FORM>
+ <TD align="center">
+ <INPUT type="button" value="View All" onclick="clear_filter()"></INPUT>
+ </TABLE>
+
+ <H1>BOOKMARKS:<span id="undelete"></H1>
+ <DIV id=content></DIV>
+ <P style="clear:both;padding-top:1cm">
+ <I>To delete individual bookmarks or entire folders, drag to the top
+ of the page (i.e. over the "Filter:" or "New Bookmark" controls).
+ A single level of undelete is available.
+ </I>
+ </P>
+ </BODY>
+</HTML>
+
diff --git a/hv/hv3_bugreport.tcl b/hv/bugreport.html
similarity index 66%
copy from hv/hv3_bugreport.tcl
copy to hv/bugreport.html
index 36e53fb..c12402a 100644
--- a/hv/hv3_bugreport.tcl
+++ b/hv/bugreport.html
@@ -1,9 +1,4 @@
-namespace eval ::hv3::bugreport {
-
- proc init {hv3 uri} {
- $hv3 reset 0
- $hv3 parse {
<HTML>
<HEAD>
@@ -24,7 +19,37 @@ namespace eval ::hv3::bugreport {
a[href]:hover { background: purple ; color: white }
</STYLE>
- </HEAD> <BODY>
+ <SCRIPT>
+ function onload_handler (e) {
+ document.forms.quickreport.t.focus()
+ document.getElementById("formcontainer").style.display="block"
+
+ var uri = decodeURIComponent(document.location.pathname)
+ document.getElementById('uritext').value = uri.substring(1, uri.length-1)
+
+ document.getElementById("version").value = navigator.hv3_version
+ }
+
+ function submit_handler(e) {
+ var caption = document.forms.quickreport.t.value
+ if (caption.length < 1 || caption.length > 60) {
+ alert("Caption field must be between 1 and 60 characters in length")
+ return false
+ }
+
+ var uri = document.getElementById("uritext").value
+ var desc = document.forms.quickreport.d
+ desc.value = " URI: " + uri + "\n\n" + desc.value
+
+ var email = document.forms.quickreport.c
+ if (email.value=="") {
+ email.value = "Anonymous Hv3 User"
+ }
+
+ return true
+ }
+ </SCRIPT>
+ </HEAD> <BODY onload="onload_handler()">
<DIV class=block>
<H1>Report a bug in Hv3</H1>
<CENTER><A href=#guidelines>View bug report guidelines</A></CENTER>
@@ -32,22 +57,22 @@ namespace eval ::hv3::bugreport {
<DIV class=block>
<H2>Quick Bug Report</H2>
- <DIV id="formcontainer">
+ <DIV id="formcontainer" style="display:none">
<FORM
name=quickreport
action="http://tkhtml.tcl.tk/cvstrac/tktnew"
method=POST
+ onsubmit="return submit_handler()"
>
<TABLE>
<TR><TD>Caption: <TD><INPUT name=t size=60>
<TR><TD>Uri: <TD><INPUT id=uritext size=60>
<TR><TD>E-mail <B>(optional)</B>: <TD><INPUT size=60 name=c>
- <TR><TD>Description:<TD><TEXTAREA name=d cols=70 rows=8></TEXTAREA>
+ <TR><TD>Description:<TD><TEXTAREA name=d cols=70 rows=15></TEXTAREA>
</TABLE>
<CENTER>
- <SPAN id=submit_button></SPAN>
- <SPAN id=preview_button></SPAN>
- <INPUT type=hidden id="trick_control">
+ <INPUT type=submit name=submit value="Submit Report!">
+ <INPUT type=submit name=preview value="Online preview...">
</CENTER>
<INPUT type=hidden name=f value="">
<INPUT type=hidden name=s value="">
@@ -58,6 +83,14 @@ namespace eval ::hv3::bugreport {
<INPUT type=hidden id=version name=v value="">
</FORM>
</DIV>
+ <NOSCRIPT>
+ <P>
+ The Quick Bug Report form is unavailable because javascript is not
+ installed. Please submit the bug
+ <A href="http://tkhtml.tcl.tk/cvstrac/tktnew">via the web interface</A>.
+ Thanks.
+ </P>
+ </NOSCRIPT>
</DIV>
<DIV class=block>
@@ -118,51 +151,3 @@ namespace eval ::hv3::bugreport {
</BODY>
</HTML>
- }
-
- set uri_field [[$hv3 search #uritext] replace]
- $uri_field dom_value $uri
- set caption_field [[$hv3 search {[name="t"]}] replace]
- $caption_field dom_focus
-
- set node [$hv3 search #submit_button]
- set button [::hv3::button [$hv3 html].document.submit \
- -command [list ::hv3::bugreport::submitform submit $hv3] \
- -text "Submit Report!"
- ]
- $node replace $button -deletecmd [list destroy $button]
-
- set node [$hv3 search #preview_button]
- set button [::hv3::button [$hv3 html].document.preview \
- -command [list ::hv3::bugreport::submitform preview $hv3] \
- -text "Online Preview..."
- ]
- $node replace $button -deletecmd [list destroy $button]
- }
-
- proc submitform {status hv3} {
- set caption_field [[$hv3 search {[name="t"]}] replace]
-
- set v [$caption_field value]
- if {[string length $v]>60 || [string length $v]==0} {
- tk_dialog .error "Caption too long" \
- {The Caption field should be between 1 and 60 characters in length} \
- {} 0 OK
- return
- }
-
- set uri [[[$hv3 search #uritext] replace] value]
- if {$uri ne ""} {
- set widget [[[$hv3 search {[name="d"]}] replace] get_text_widget]
- $widget insert 0.0 " URI: $uri\n\n"
- }
-
- set trick [$hv3 search #trick_control]
- $trick attribute name $status
- $trick attribute value 1
-
- set formnode [::hv3::control_to_form $trick]
- [$formnode replace] submit ""
- }
-}
-
diff --git a/hv/hv.tcl b/hv/hv.tcl
new file mode 100644
index 0000000..681264d
--- /dev/null
+++ b/hv/hv.tcl
@@ -0,0 +1,369 @@
+#
+# This script implements the "hv" application. Type "hv FILE" to
+# view FILE as HTML.
+#
+# This application is used for testing the HTML widget. It can
+# also server as an example of how to use the HTML widget.
+#
+# @(#) $Id: hv.tcl,v 1.31 2003/01/28 09:43:23 hkoba Exp $
+#
+wm title . {HTML File Viewer}
+wm iconname . {HV}
+
+# Make sure the html widget is loaded into
+# our interpreter
+#
+if {[info command html]==""} {
+ if {[catch {package require Tkhtml} error]} {
+ foreach f {
+ ./libTkhtml*.so
+ ../libTkhtml*.so
+ /usr/lib/libTkhtml*.so
+ /usr/local/lib/libTkhtml*.so
+ ./tkhtml.dll
+ } {
+ if {[set f [lindex [glob -nocomplain $f] end]] != ""} {
+ if {[catch {load $f Tkhtml}]==0} break
+ }
+ }
+ }
+}
+
+# The HtmlTraceMask only works if the widget was compiled with
+# the -DDEBUG=1 command-line option. "file" is the name of the
+# first HTML file to be loaded.
+#
+set HtmlTraceMask 0
+set file {}
+foreach a $argv {
+ if {[regexp {^debug=} $a]} {
+ scan $a "debug=0x%x" HtmlTraceMask
+ } else {
+ set file $a
+ }
+}
+
+# These images are used in place of GIFs or of form elements
+#
+image create photo biggray -data {
+ R0lGODdhPAA+APAAALi4uAAAACwAAAAAPAA+AAACQISPqcvtD6OctNqLs968+w+G4kiW5omm
+ 6sq27gvH8kzX9o3n+s73/g8MCofEovGITCqXzKbzCY1Kp9Sq9YrNFgsAO///
+}
+image create photo smgray -data {
+ R0lGODdhOAAYAPAAALi4uAAAACwAAAAAOAAYAAACI4SPqcvtD6OctNqLs968+w+G4kiW5omm
+ 6sq27gvH8kzX9m0VADv/
+}
+image create photo nogifbig -data {
+ R0lGODdhJAAkAPEAAACQkADQ0PgAAAAAACwAAAAAJAAkAAACmISPqcsQD6OcdJqKM71PeK15
+ AsSJH0iZY1CqqKSurfsGsex08XuTuU7L9HywHWZILAaVJssvgoREk5PolFo1XrHZ29IZ8oo0
+ HKEYVDYbyc/jFhz2otvdcyZdF68qeKh2DZd3AtS0QWcDSDgWKJXY+MXS9qY4+JA2+Vho+YPp
+ FzSjiTIEWslDQ1rDhPOY2sXVOgeb2kBbu1AAADv/
+}
+image create photo nogifsm -data {
+ R0lGODdhEAAQAPEAAACQkADQ0PgAAAAAACwAAAAAEAAQAAACNISPacHtD4IQz80QJ60as25d
+ 3idKZdR0IIOm2ta0Lhw/Lz2S1JqvK8ozbTKlEIVYceWSjwIAO///
+}
+
+# Construct the main window
+#
+frame .mbar -bd 2 -relief raised
+pack .mbar -side top -fill x
+menubutton .mbar.file -text File -underline 0 -menu .mbar.file.m
+pack .mbar.file -side left -padx 5
+set m [menu .mbar.file.m]
+$m add command -label Open -underline 0 -command Load
+$m add command -label Refresh -underline 0 -command Refresh
+$m add separator
+$m add command -label Exit -underline 1 -command exit
+menubutton .mbar.view -text View -underline 0 -menu .mbar.view.m
+pack .mbar.view -side left -padx 5
+set m [menu .mbar.view.m]
+set underlineHyper 0
+$m add checkbutton -label {Underline Hyperlinks} -variable underlineHyper
+trace variable underlineHyper w ChangeUnderline
+proc ChangeUnderline args {
+ global underlineHyper
+ .h.h config -underlinehyperlinks $underlineHyper
+}
+set showTableStruct 0
+$m add checkbutton -label {Show Table Structure} -variable showTableStruct
+trace variable showTableStruct w ShowTableStruct
+proc ShowTableStruct args {
+ global showTableStruct HtmlTraceMask
+ if {$showTableStruct} {
+ set HtmlTraceMask [expr {$HtmlTraceMask|0x8}]
+ .h.h config -tablerelief flat
+ } else {
+ set HtmlTraceMask [expr {$HtmlTraceMask&~0x8}]
+ .h.h config -tablerelief raised
+ }
+ Refresh
+}
+set showImages 1
+$m add checkbutton -label {Show Images} -variable showImages
+trace variable showImages w Refresh
+
+# Construct the main HTML viewer
+#
+frame .h
+pack .h -side top -fill both -expand 1
+html .h.h \
+ -yscrollcommand {.h.vsb set} \
+ -xscrollcommand {.f2.hsb set} \
+ -padx 5 \
+ -pady 9 \
+ -formcommand FormCmd \
+ -imagecommand ImageCmd \
+ -scriptcommand ScriptCmd \
+ -appletcommand AppletCmd \
+ -underlinehyperlinks 0 \
+ -bg white -tablerelief raised
+
+# If the tracemask is not 0, then draw the outline of all
+# tables as a blank line, not a 3D relief.
+#
+if {$HtmlTraceMask} {
+ .h.h config -tablerelief flat
+}
+
+# A font chooser routine.
+#
+# .h.h config -fontcommand pickFont
+proc pickFont {size attrs} {
+ puts "FontCmd: $size $attrs"
+ set a [expr {-1<[lsearch $attrs fixed]?{courier}:{charter}}]
+ set b [expr {-1<[lsearch $attrs italic]?{italic}:{roman}}]
+ set c [expr {-1<[lsearch $attrs bold]?{bold}:{normal}}]
+ set d [expr {int(12*pow(1.2,$size-4))}]
+ list $a $d $b $c
+}
+
+# This routine is called for each form element
+#
+proc FormCmd {n cmd style args} {
+ # puts "FormCmd: $n $cmd $args"
+ switch $cmd {
+ select -
+ textarea -
+ input {
+ set w [lindex $args 0]
+ label $w -image nogifsm
+ }
+ }
+}
+
+# This routine is called for every <IMG> markup
+#
+# proc ImageCmd {args} {
+# puts "image: $args"
+# set fn [lindex $args 0]
+# if {[catch {image create photo -file $fn} img]} {
+# return nogifsm
+# } else {
+# global Images
+# set Images($img) 1
+# return $img
+# }
+#}
+proc ImageCmd {args} {
+ global OldImages Images showImages
+ if {!$showImages} {
+ return smgray
+ }
+ set fn [lindex $args 0]
+ if {[info exists OldImages($fn)]} {
+ set Images($fn) $OldImages($fn)
+ unset OldImages($fn)
+ return $Images($fn)
+ }
+ if {[catch {image create photo -file $fn} img]} {
+ return smgray
+ }
+ if {[image width $img]*[image height $img]>20000} {
+ global BigImages
+ set b [image create photo -width [image width $img] \
+ -height [image height $img]]
+ set BigImages($b) $img
+ set img $b
+ after idle "MoveBigImage $b"
+ }
+ set Images($fn) $img
+ return $img
+}
+proc MoveBigImage b {
+ global BigImages
+ if {![info exists BigImages($b)]} return
+ $b copy $BigImages($b)
+ image delete $BigImages($b)
+ unset BigImages($b)
+ update
+}
+
+
+# This routine is called for every <SCRIPT> markup
+#
+proc ScriptCmd {args} {
+ # puts "ScriptCmd: $args"
+}
+
+# This routine is called for every <APPLET> markup
+#
+proc AppletCmd {w arglist} {
+ # puts "AppletCmd: w=$w arglist=$arglist"
+ label $w -text "The Applet $w" -bd 2 -relief raised
+}
+namespace eval tkhtml {
+ array set Priv {}
+}
+
+# This procedure is called when the user clicks on a hyperlink.
+# See the "bind .h.h.x" below for the binding that invokes this
+# procedure
+#
+proc HrefBinding {x y} {
+ # koba & dg marking text
+ .h.h selection clear
+ set ::tkhtml::Priv(mark) $x,$y
+ set list [.h.h href $x $y]
+ if {![llength $list]} {return}
+ foreach {new target} $list break
+ if {$new!=""} {
+ global LastFile
+ set pattern $LastFile#
+ set len [string length $pattern]
+ incr len -1
+ if {[string range $new 0 $len]==$pattern} {
+ incr len
+ .h.h yview [string range $new $len end]
+ } else {
+ LoadFile $new
+ }
+ }
+}
+bind .h.h.x <1> {HrefBinding %x %y}
+# marking text with the mouse and copying to the clipboard just with tkhtml2.0 working
+bind .h.h.x <B1-Motion> {
+ %W selection set @$::tkhtml::Priv(mark) @%x,%y
+ clipboard clear
+ # avoid tkhtml0.0 errors
+ # anyone can fix this for tkhtml0.0
+ catch {
+ clipboard append [selection get]
+ }
+}
+
+# Pack the HTML widget into the main screen.
+#
+pack .h.h -side left -fill both -expand 1
+scrollbar .h.vsb -orient vertical -command {.h.h yview}
+pack .h.vsb -side left -fill y
+
+frame .f2
+pack .f2 -side top -fill x
+frame .f2.sp -width [winfo reqwidth .h.vsb] -bd 2 -relief raised
+pack .f2.sp -side right -fill y
+scrollbar .f2.hsb -orient horizontal -command {.h.h xview}
+pack .f2.hsb -side top -fill x
+
+# This procedure is called when the user selects the File/Open
+# menu option.
+#
+set lastDir [pwd]
+proc Load {} {
+ set filetypes {
+ {{Html Files} {.html .htm}}
+ {{All Files} *}
+ }
+ global lastDir htmltext
+ set f [tk_getOpenFile -initialdir $lastDir -filetypes $filetypes]
+ if {$f!=""} {
+ LoadFile $f
+ set lastDir [file dirname $f]
+ }
+}
+
+# Clear the screen.
+#
+# Clear the screen.
+#
+proc Clear {} {
+ global Images OldImages hotkey
+ if {[winfo exists .fs.h]} {set w .fs.h} {set w .h.h}
+ $w clear
+ catch {unset hotkey}
+ ClearBigImages
+ ClearOldImages
+ foreach fn [array names Images] {
+ set OldImages($fn) $Images($fn)
+ }
+ catch {unset Images}
+}
+proc ClearOldImages {} {
+ global OldImages
+ foreach fn [array names OldImages] {
+ image delete $OldImages($fn)
+ }
+ catch {unset OldImages}
+}
+proc ClearBigImages {} {
+ global BigImages
+ foreach b [array names BigImages] {
+ image delete $BigImages($b)
+ }
+ catch {unset BigImages}
+}
+
+# Read a file
+#
+proc ReadFile {name} {
+ if {[catch {open $name r} fp]} {
+ tk_messageBox -icon error -message $fp -type ok
+ return {}
+ } else {
+ set r [read $fp [file size $name]]
+ close $fp
+ return $r
+ }
+}
+
+# Load a file into the HTML widget
+#
+proc LoadFile {name} {
+ set html [ReadFile $name]
+ if {$html==""} return
+ Clear
+ global LastFile
+ set LastFile $name
+ .h.h config -base $name
+ .h.h parse $html
+ ClearOldImages
+}
+
+# Refresh the current file.
+#
+proc Refresh {args} {
+ global LastFile
+ if {![info exists LastFile]} return
+ LoadFile $LastFile
+}
+
+# If an arguent was specified, read it into the HTML widget.
+#
+update
+if {$file!=""} {
+ LoadFile $file
+}
+
+
+# This binding changes the cursor when the mouse move over
+# top of a hyperlink.
+#
+bind HtmlClip <Motion> {
+ set parent [winfo parent %W]
+ set url [$parent href %x %y]
+ if {[string length $url] > 0} {
+ $parent configure -cursor hand2
+ } else {
+ $parent configure -cursor {}
+ }
+}
diff --git a/hv/hv3.tcl b/hv/hv3.tcl
index 2e966f5..16b7c8c 100644
--- a/hv/hv3.tcl
+++ b/hv/hv3.tcl
@@ -1,7 +1,20 @@
-namespace eval hv3 { set {version($Id: hv3.tcl,v 1.205 2007/10/07 16:30:08 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3.tcl,v 1.248 2008/03/02 15:00:13 danielk1977 Exp $)} 1 }
+
+# This file contains the mega-widget hv3::hv3 that is at the core
+# of the Hv3 web browser implementation. An instance of this widget
+# displays a single HTML frame. Documentation for the published
+# interface to this widget is found at:
+#
+# http://tkhtml.tcl.tk/hv3_widget.html
+#
+# Other parts of the interface, used internally and by the Hv3
+# web-browser, are documented in comments in this file. Eventually,
+# the Hv3 web-browser will use the published interface only. But
+# that is not the case yet.
#
-# This file contains the mega-widget hv3::hv3 used by the hv3 demo web
-# browser. An instance of this widget displays a single HTML frame.
+#-------------------------------------------------------------------
+#
+#
#
# Standard Functionality:
#
@@ -18,7 +31,7 @@ namespace eval hv3 { set {version($Id: hv3.tcl,v 1.205 2007/10/07 16:30:08 danie
# If not an empty string, this option specifies a script to be
# invoked for a GET or POST request. The script is invoked with a
# download handle appended to it. See the description of class
-# ::hv3::download for a description.
+# ::hv3::request for a description.
#
# -targetcmd
# If not an empty string, this option specifies a script for
@@ -41,12 +54,6 @@ namespace eval hv3 { set {version($Id: hv3.tcl,v 1.205 2007/10/07 16:30:08 danie
# -locationvar
# Set to the URI of the currently displayed document.
#
-# -pendingcmd
-# Name of command to invoke to inform the user as to whether or not
-# there are currently resource requests pending. This is useful for a
-# web browser GUI that needs to disable the "stop" button after all
-# resource requests are completed.
-#
# -scrollbarpolicy
# This option may be set to either a boolean value or "auto". It
# determines the visibility of the widget scrollbars. TODO: This
@@ -95,13 +102,6 @@ namespace eval hv3 { set {version($Id: hv3.tcl,v 1.205 2007/10/07 16:30:08 danie
# to display a document have been loaded. This is analogous
# to the Html "onload" event.
#
-# <<Reset>>
-# This event is generated just before [$html reset] is called
-# and mega-widget state data discarded (because a new document
-# is about to be loaded). This gives the application a final
-# chance to query the current state of the browser before it
-# is discarded.
-#
# <<Location>>
# This event is generated whenever the "location" is set.
#
@@ -112,14 +112,14 @@ namespace eval hv3 { set {version($Id: hv3.tcl,v 1.205 2007/10/07 16:30:08 danie
# The code in this file is partitioned into the following classes:
#
# ::hv3::hv3
-# ::hv3::download
# ::hv3::selectionmanager
# ::hv3::dynamicmanager
# ::hv3::hyperlinkmanager
+# ::hv3::mousemanager
#
# ::hv3::hv3 is, of course, the main mega-widget class. Class
-# ::hv3::download is part of the public interface to ::hv3::hv3. A
-# single instance of ::hv3::download represents a resource request made
+# ::hv3::request is part of the public interface to ::hv3::hv3. A
+# single instance of ::hv3::request represents a resource request made
# by the mega-widget package - for document, stylesheet, image or
# object data.
#
@@ -139,11 +139,15 @@ namespace eval hv3 { set {version($Id: hv3.tcl,v 1.205 2007/10/07 16:30:08 danie
package require Tkhtml 3.0
package require snit
-source [file join [file dirname [info script]] hv3_form.tcl]
-source [file join [file dirname [info script]] hv3_object.tcl]
-source [file join [file dirname [info script]] hv3_doctype.tcl]
-source [file join [file dirname [info script]] hv3_request.tcl]
-source [file join [file dirname [info script]] hv3_dom.tcl]
+package provide hv3 0.1
+
+if {[info commands ::hv3::make_constructor] eq ""} {
+ source [file join [file dirname [info script]] hv3_encodings.tcl]
+ source [file join [file dirname [info script]] hv3_util.tcl]
+ source [file join [file dirname [info script]] hv3_form.tcl]
+ source [file join [file dirname [info script]] hv3_request.tcl]
+}
+#source [file join [file dirname [info script]] hv3_request.tcl.bak]
#--------------------------------------------------------------------------
# Class ::hv3::hv3::mousemanager
@@ -177,110 +181,111 @@ source [file join [file dirname [info script]] hv3_dom.tcl]
# ::hv3::selectionmanager
# motion
#
-snit::type ::hv3::hv3::mousemanager {
+namespace eval ::hv3::hv3::mousemanager {
- variable myHv3 ""
- variable myHtml ""
+ proc new {me hv3} {
+ upvar $me O
- # In browsers with no DOM support, the following option is set to
- # an empty string.
- #
- # If not set to an empty string, this option is set to the name
- # of the ::hv3::dom object to dispatch events too. The DOM
- # is a special client because it may cancel the "default action"
- # of mouse-clicks (it may also cancel other events, but they are
- # dispatched by other sub-systems).
- #
- # Each time an event occurs, the following script is executed:
- #
- # $options(-dom) mouseevent EVENT-TYPE NODE X Y ?OPTIONS?
- #
- # where OPTIONS are:
- #
- # -button INTEGER (default 0)
- # -detail INTEGER (default 0)
- # -relatedtarget NODE-HANDLE (default "")
- #
- # the EVENT-TYPE parameter is one of:
- #
- # "click", "mouseup", "mousedown", "mouseover" or "mouseout".
- #
- # NODE is the target leaf node and X and Y are the pointer coordinates
- # relative to the top-left of the html widget window.
- #
- # For "click" events, if the $options(-dom) script returns false, then
- # the "click" event is not dispatched to any subscribers (this happens
- # when some javascript calls the Event.preventDefault() method). If it
- # returns true, proceed as normal. Other event types ignore the return
- # value of the $options(-dom) script.
- #
- option -dom -default ""
+ set O(myHv3) $hv3
+ set O(myHtml) [$hv3 html]
- # This variable is set to the node-handle that the pointer is currently
- # hovered over. Used by code that dispatches the "mouseout", "mouseover"
- # and "mousemove" to the DOM.
- #
- variable myCurrentDomNode ""
-
- # Database of callback scripts for each event type.
- #
- variable myScripts -array [list]
-
- # List of nodes currently "hovered" over and "active". An entry in
- # the correspondoing array indicates the condition is true.
- #
- variable myHoverNodes -array [list]
- variable myActiveNodes -array [list]
-
- # The "top" node from the myHoverNodes array. This is the node
- # that determines the pointer to display (via the CSS2 'cursor'
- # property).
- #
- variable myTopHoverNode ""
-
- # List of handled HTML4 event types (a constant)
- variable EVENTS [list \
- onmouseover onmouseout onclick onmousedown onmouseup motion
- ]
-
- variable myCursor ""
- variable myCursorWin ""
-
- constructor {hv3} {
- foreach e $EVENTS {
- set myScripts($e) [list]
- }
-
- set myHv3 $hv3
- set myHtml [$hv3 html]
- set myCursorWin [$hv3 hull]
+ # In browsers with no DOM support, the following option is set to
+ # an empty string.
+ #
+ # If not set to an empty string, this option is set to the name
+ # of the ::hv3::dom object to dispatch events too. The DOM
+ # is a special client because it may cancel the "default action"
+ # of mouse-clicks (it may also cancel other events, but they are
+ # dispatched by other sub-systems).
+ #
+ # Each time an event occurs, the following script is executed:
+ #
+ # $O(-dom) mouseevent EVENT-TYPE NODE X Y ?OPTIONS?
+ #
+ # where OPTIONS are:
+ #
+ # -button INTEGER (default 0)
+ # -detail INTEGER (default 0)
+ # -relatedtarget NODE-HANDLE (default "")
+ #
+ # the EVENT-TYPE parameter is one of:
+ #
+ # "click", "mouseup", "mousedown", "mouseover" or "mouseout".
+ #
+ # NODE is the target leaf node and X and Y are the pointer coordinates
+ # relative to the top-left of the html widget window.
+ #
+ # For "click" events, if the $O(-dom) script returns false, then
+ # the "click" event is not dispatched to any subscribers (this happens
+ # when some javascript calls the Event.preventDefault() method). If it
+ # returns true, proceed as normal. Other event types ignore the return
+ # value of the $O(-dom) script.
+ #
+ set O(-dom) ""
+
+ # This variable is set to the node-handle that the pointer is currently
+ # hovered over. Used by code that dispatches the "mouseout", "mouseover"
+ # and "mousemove" to the DOM.
+ #
+ set O(myCurrentDomNode) ""
+
+ # The "top" node from the ${me}.hovernodes array. This is the node
+ # that determines the pointer to display (via the CSS2 'cursor'
+ # property).
+ #
+ set O(myTopHoverNode) ""
+
+ set O(myCursor) ""
+ set O(myCursorWin) [$hv3 hull]
- bind $myHv3 <Motion> "+[list $self Motion %W %x %y]"
- bind $myHv3 <ButtonPress-1> "+[list $self Press %W %x %y]"
- bind $myHv3 <ButtonRelease-1> "+[list $self Release %W %x %y]"
+ # Database of callback scripts for each event type.
+ #
+ set O(scripts.onmouseover) ""
+ set O(scripts.onmouseout) ""
+ set O(scripts.onclick) ""
+ set O(scripts.onmousedown) ""
+ set O(scripts.onmouseup) ""
+ set O(scripts.motion) ""
+
+ # There are also two arrays that store lists of nodes currently "hovered"
+ # over and "active". An entry in the correspondoing array indicates the
+ # condition is true. The arrays are named:
+ #
+ # ${me}.hovernodes
+ # ${me}.activenodes
+ #
+
+ set w [$hv3 win]
+ bind $w <Motion> "+[list $me Motion %W %x %y]"
+ bind $w <ButtonPress-1> "+[list $me Press %W %x %y]"
+ bind $w <ButtonRelease-1> "+[list $me Release %W %x %y]"
}
- method subscribe {event script} {
+
+ proc subscribe {me event script} {
+ upvar $me O
# Check that the $event argument is Ok:
- if {0 > [lsearch $EVENTS $event]} {
+ if {![info exists O(scripts.$event)]} {
error "No such mouse-event: $event"
}
# Append the script to the callback list.
- lappend myScripts($event) $script
+ lappend O(scripts.$event) $script
}
- method reset {} {
- array unset myActiveNodes
- array unset myHoverNodes
- set myCurrentDomNode ""
+ proc reset {me} {
+ upvar $me O
+ array unset ${me}.activenodes
+ array unset ${me}.hovernodes
+ set O(myCurrentDomNode) ""
}
- method GenerateEvents {eventlist} {
+ proc GenerateEvents {me eventlist} {
+ upvar $me O
foreach {event node} $eventlist {
if {[info commands $node] ne ""} {
- foreach script $myScripts($event) {
+ foreach script $O(scripts.$event) {
eval $script $node
}
}
@@ -299,31 +304,35 @@ snit::type ::hv3::hv3::mousemanager {
# Mapping from CSS2 cursor type to Tk cursor type.
#
- typevariable CURSORS -array [list \
- crosshair crosshair \
- default "" \
- pointer hand2 \
- move fleur \
- text xterm \
- wait watch \
+ variable CURSORS
+ array set CURSORS [list \
+ crosshair crosshair \
+ default "" \
+ pointer hand2 \
+ move fleur \
+ text xterm \
+ wait watch \
progress box_spiral \
help question_arrow \
]
- method Motion {W x y} {
+ proc Motion {me W x y} {
+ upvar $me O
+ variable CURSORS
+
if {$W eq ""} return
- AdjustCoords "${myHv3}.html.widget" $W x y
+ AdjustCoords [$O(myHv3) html] $W x y
# Figure out the node the cursor is currently hovering over. Todo:
# When the cursor is over multiple nodes (because overlapping content
# has been generated), maybe this should consider all overlapping nodes
# as "hovered".
- set nodelist [lindex [$myHtml node $x $y] end]
+ set nodelist [lindex [$O(myHtml) node $x $y] end]
# Handle the 'cursor' property.
#
set topnode [lindex $nodelist end]
- if {$topnode ne "" && $topnode ne $myTopHoverNode} {
+ if {$topnode ne "" && $topnode ne $O(myTopHoverNode)} {
set Cursor ""
if {[$topnode tag] eq ""} {
@@ -333,11 +342,11 @@ snit::type ::hv3::hv3::mousemanager {
set css2_cursor [$topnode property cursor]
catch { set Cursor $CURSORS($css2_cursor) }
- if {$Cursor ne $myCursor} {
- $myCursorWin configure -cursor $Cursor
- set myCursor $Cursor
+ if {$Cursor ne $O(myCursor)} {
+ $O(myCursorWin) configure -cursor $Cursor
+ set O(myCursor) $Cursor
}
- set myTopHoverNode $topnode
+ set O(myTopHoverNode) $topnode
}
# Dispatch any DOM events in this order:
@@ -347,18 +356,18 @@ snit::type ::hv3::hv3::mousemanager {
# mousemotion
#
set N [lindex $nodelist end]
- if {$N eq ""} {set N [$myHv3 node]}
+ if {$N eq ""} {set N [$O(myHv3) node]}
- if {$options(-dom) ne ""} {
- if {$N ne $myCurrentDomNode} {
- $options(-dom) mouseevent mouseout $myCurrentDomNode $x $y
- $options(-dom) mouseevent mouseover $N $x $y
- set myCurrentDomNode $N
+ if {$O(-dom) ne ""} {
+ if {$N ne $O(myCurrentDomNode)} {
+ $O(-dom) mouseevent mouseout $O(myCurrentDomNode) $x $y
+ $O(-dom) mouseevent mouseover $N $x $y
+ set O(myCurrentDomNode) $N
}
- $options(-dom) mouseevent mousemove $N $x $y
+ $O(-dom) mouseevent mousemove $N $x $y
}
- foreach script $myScripts(motion) {
+ foreach script $O(scripts.motion) {
eval $script $N $x $y
}
@@ -377,8 +386,8 @@ snit::type ::hv3::hv3::mousemanager {
if {[info exists hovernodes($n)]} {
break
} else {
- if {[info exists myHoverNodes($n)]} {
- unset myHoverNodes($n)
+ if {[info exists ${me}.hovernodes($n)]} {
+ unset ${me}.hovernodes($n)
} else {
lappend events(onmouseover) $n
}
@@ -386,10 +395,10 @@ snit::type ::hv3::hv3::mousemanager {
}
}
}
- set events(onmouseout) [array names myHoverNodes]
+ set events(onmouseout) [array names ${me}.hovernodes]
- array unset myHoverNodes
- array set myHoverNodes [array get hovernodes]
+ array unset ${me}.hovernodes
+ array set ${me}.hovernodes [array get hovernodes]
set eventlist [list]
foreach key [list onmouseover onmouseout] {
@@ -397,23 +406,24 @@ snit::type ::hv3::hv3::mousemanager {
lappend eventlist $key $node
}
}
- $self GenerateEvents $eventlist
+ $me GenerateEvents $eventlist
}
- method Press {W x y} {
+ proc Press {me W x y} {
+ upvar $me O
if {$W eq ""} return
- AdjustCoords "${myHv3}.html.widget" $W x y
- set N [lindex [$myHtml node $x $y] end]
+ AdjustCoords [$O(myHv3) html] $W x y
+ set N [lindex [$O(myHtml) node $x $y] end]
if {$N ne ""} {
if {[$N tag] eq ""} {set N [$N parent]}
}
- if {$N eq ""} {set N [$myHv3 node]}
+ if {$N eq ""} {set N [$O(myHv3) node]}
# Dispatch the "mousedown" event to the DOM, if any.
#
set rc ""
- if {$options(-dom) ne ""} {
- set rc [$options(-dom) mouseevent mousedown $N $x $y]
+ if {$O(-dom) ne ""} {
+ set rc [$O(-dom) mouseevent mousedown $N $x $y]
}
# If the DOM implementation called preventDefault(), do
@@ -422,30 +432,31 @@ snit::type ::hv3::hv3::mousemanager {
# into an annoying state.
#
if {$rc eq "prevent"} {
- $myHv3 selectionmanager clear
+ $O(myHv3) theselectionmanager clear
} else {
- $myHv3 selectionmanager press $N $x $y
+ $O(myHv3) theselectionmanager press $N $x $y
}
for {set n $N} {$n ne ""} {set n [$n parent]} {
- set myActiveNodes($n) 1
+ set ${me}.activenodes($n) 1
}
set eventlist [list]
- foreach node [array names myActiveNodes] {
+ foreach node [array names ${me}.activenodes] {
lappend eventlist onmousedown $node
}
- $self GenerateEvents $eventlist
+ $me GenerateEvents $eventlist
}
- method Release {W x y} {
+ proc Release {me W x y} {
+ upvar $me O
if {$W eq ""} return
- AdjustCoords "${myHv3}.html.widget" $W x y
- set N [lindex [$myHtml node $x $y] end]
+ AdjustCoords [$O(myHv3) html] $W x y
+ set N [lindex [$O(myHtml) node $x $y] end]
if {$N ne ""} {
if {[$N tag] eq ""} {set N [$N parent]}
}
- if {$N eq ""} {set N [$myHv3 node]}
+ if {$N eq ""} {set N [$O(myHv3) node]}
# Dispatch the "mouseup" event to the DOM, if any.
#
@@ -454,8 +465,8 @@ snit::type ::hv3::hv3::mousemanager {
# But in the DOM things are different - the event target for "mouseup"
# depends on the current cursor location only.
#
- if {$options(-dom) ne ""} {
- $options(-dom) mouseevent mouseup $N $x $y
+ if {$O(-dom) ne ""} {
+ $O(-dom) mouseevent mouseup $N $x $y
}
# Check if the is a "click" event to dispatch to the DOM. If the
@@ -463,24 +474,24 @@ snit::type ::hv3::hv3::mousemanager {
# not sent to the other hv3 sub-systems (default action is cancelled).
#
set domrc ""
- if {$options(-dom) ne ""} {
+ if {$O(-dom) ne ""} {
for {set n $N} {$n ne ""} {set n [$n parent]} {
- if {[info exists myActiveNodes($N)]} {
- set domrc [$options(-dom) mouseevent click $n $x $y]
+ if {[info exists ${me}.activenodes($N)]} {
+ set domrc [$O(-dom) mouseevent click $n $x $y]
break
}
}
}
set eventlist [list]
- foreach node [array names myActiveNodes] {
+ foreach node [array names ${me}.activenodes] {
lappend eventlist onmouseup $node
}
if {$domrc ne "prevent"} {
set onclick_nodes [list]
for {set n $N} {$n ne ""} {set n [$n parent]} {
- if {[info exists myActiveNodes($n)]} {
+ if {[info exists ${me}.activenodes($n)]} {
lappend onclick_nodes $n
}
}
@@ -489,11 +500,19 @@ snit::type ::hv3::hv3::mousemanager {
}
}
- $self GenerateEvents $eventlist
+ $me GenerateEvents $eventlist
- array unset myActiveNodes
+ array unset ${me}.activenodes
+ }
+
+ proc destroy me {
+ array unset $me
+ array unset ${me}.hovernodes
+ array unset ${me}.activenodes
+ rename $me {}
}
}
+::hv3::make_constructor ::hv3::hv3::mousemanager
#--------------------------------------------------------------------------
# ::hv3::hv3::selectionmanager
@@ -501,55 +520,61 @@ snit::type ::hv3::hv3::mousemanager {
# This type encapsulates the code that manages selecting text
# in the html widget with the mouse.
#
-snit::type ::hv3::hv3::selectionmanager {
-
- # Variable myMode may take one of the following values:
- #
- # "char" -> Currently text selecting by character.
- # "word" -> Currently text selecting by word.
- # "block" -> Currently text selecting by block.
- #
- variable myState false ;# True when left-button is held down
- variable myMode char
+namespace eval ::hv3::hv3::selectionmanager {
- # The ::hv3::hv3 widget.
- #
- variable myHv3
-
- variable myFromNode ""
- variable myFromIdx ""
-
- variable myToNode ""
- variable myToIdx ""
+ proc new {me hv3} {
+ upvar $me O
- variable myIgnoreMotion 0
+ # Variable myMode may take one of the following values:
+ #
+ # "char" -> Currently text selecting by character.
+ # "word" -> Currently text selecting by word.
+ # "block" -> Currently text selecting by block.
+ #
+ set O(myState) false ;# True when left-button is held down
+ set O(myMode) char
+
+ # The ::hv3::hv3 widget.
+ #
+ set O(myHv3) $hv3
+ set O(myHtml) [$hv3 html]
+
+ set O(myFromNode) ""
+ set O(myFromIdx) ""
+
+ set O(myToNode) ""
+ set O(myToIdx) ""
+
+ set O(myIgnoreMotion) 0
- constructor {hv3} {
- set myHv3 $hv3
- selection handle $myHv3 [list ::hv3::bg [list $self get_selection]]
+ set w [$hv3 win]
+ selection handle $w [list ::hv3::bg [list $me get_selection]]
# bind $myHv3 <Motion> "+[list $self motion %x %y]"
# bind $myHv3 <ButtonPress-1> "+[list $self press %x %y]"
- bind $myHv3 <Double-ButtonPress-1> "+[list $self doublepress %x %y]"
- bind $myHv3 <Triple-ButtonPress-1> "+[list $self triplepress %x %y]"
- bind $myHv3 <ButtonRelease-1> "+[list $self release %x %y]"
+ bind $w <Double-ButtonPress-1> "+[list $me doublepress %x %y]"
+ bind $w <Triple-ButtonPress-1> "+[list $me triplepress %x %y]"
+ bind $w <ButtonRelease-1> "+[list $me release %x %y]"
}
# Clear the selection.
#
- method clear {} {
- $myHv3 tag delete selection
- $myHv3 tag configure selection -foreground white -background darkgrey
- set myFromNode ""
- set myToNode ""
+ proc clear {me} {
+ upvar $me O
+ $O(myHtml) tag delete selection
+ $O(myHtml) tag configure selection -foreground white -background darkgrey
+ set O(myFromNode) ""
+ set O(myToNode) ""
}
- method press {N x y} {
+ proc press {me N x y} {
+ upvar $me O
+
# Single click -> Select by character.
- $self clear
- set myState true
- set myMode char
- $self motion $N $x $y
+ clear $me
+ set O(myState) true
+ set O(myMode) char
+ motion $me $N $x $y
}
# Given a node-handle/index pair identifying a character in the
@@ -569,78 +594,91 @@ snit::type ::hv3::hv3::selectionmanager {
# Add the widget tag "selection" to the word containing the character
# identified by the supplied node-handle/index pair.
#
- method TagWord {node idx} {
+ proc TagWord {me node idx} {
+ upvar $me O
foreach {i1 i2} [ToWord $node $idx] {}
- $myHv3 tag add selection $node $i1 $node $i2
+ $O(myHtml) tag add selection $node $i1 $node $i2
}
# Remove the widget tag "selection" to the word containing the character
# identified by the supplied node-handle/index pair.
#
- method UntagWord {node idx} {
+ proc UntagWord {me node idx} {
+ upvar $me O
foreach {i1 i2} [ToWord $node $idx] {}
- $myHv3 tag remove selection $node $i1 $node $i2
+ $O(myHtml) tag remove selection $node $i1 $node $i2
}
- method ToBlock {node idx} {
- set t [$myHv3 text text]
- set offset [$myHv3 text offset $node $idx]
+ proc ToBlock {me node idx} {
+ upvar $me O
+ set t [$O(myHtml) text text]
+ set offset [$O(myHtml) text offset $node $idx]
set start [string last "\n" $t $offset]
if {$start < 0} {set start 0}
set end [string first "\n" $t $offset]
if {$end < 0} {set end [string length $t]}
- set start_idx [$myHv3 text index $start]
- set end_idx [$myHv3 text index $end]
+ set start_idx [$O(myHtml) text index $start]
+ set end_idx [$O(myHtml) text index $end]
return [concat $start_idx $end_idx]
}
- method TagBlock {node idx} {
- foreach {n1 i1 n2 i2} [$self ToBlock $node $idx] {}
- $myHv3 tag add selection $n1 $i1 $n2 $i2
+ proc TagBlock {me node idx} {
+ upvar $me O
+ foreach {n1 i1 n2 i2} [ToBlock $me $node $idx] {}
+ $O(myHtml) tag add selection $n1 $i1 $n2 $i2
}
- method UntagBlock {node idx} {
- foreach {n1 i1 n2 i2} [$self ToBlock $node $idx] {}
- catch {$myHv3 tag remove selection $n1 $i1 $n2 $i2}
+ proc UntagBlock {me node idx} {
+ upvar $me O
+ foreach {n1 i1 n2 i2} [ToBlock $me $node $idx] {}
+ catch {$O(myHtml) tag remove selection $n1 $i1 $n2 $i2}
}
- method doublepress {x y} {
+ proc doublepress {me x y} {
+ upvar $me O
+
# Double click -> Select by word.
- $self clear
- set myMode word
- set myState true
- $self motion "" $x $y
+ clear $me
+ set O(myMode) word
+ set O(myState) true
+ motion $me "" $x $y
}
- method triplepress {x y} {
+ proc triplepress {me x y} {
+ upvar $me O
+
# Triple click -> Select by block.
- $self clear
- set myMode block
- set myState true
- $self motion "" $x $y
+ clear $me
+ set O(myMode) block
+ set O(myState) true
+ motion $me "" $x $y
}
- method release {x y} {
- set myState false
+ proc release {me x y} {
+ upvar $me O
+ set O(myState) false
}
- method reset {} {
- set myState false
+ proc reset {me} {
+ upvar $me O
+
+ set O(myState) false
# Unset the myFromNode variable, since the node handle it (may) refer
# to is now invalid. If this is not done, a future call to the [selected]
# method of this object will cause an error by trying to use the
# (now invalid) node-handle value in $myFromNode.
- set myFromNode ""
- set myToNode ""
+ set O(myFromNode) ""
+ set O(myToNode) ""
}
- method motion {N x y} {
- if {!$myState || $myIgnoreMotion} return
+ proc motion {me N x y} {
+ upvar $me O
+ if {!$O(myState) || $O(myIgnoreMotion)} return
- set to [$myHv3 node -index $x $y]
+ set to [$O(myHtml) node -index $x $y]
foreach {toNode toIdx} $to {}
# $N containst the node-handle for the node that the cursor is
@@ -655,11 +693,10 @@ snit::type ::hv3::hv3::selectionmanager {
}
if {[llength $to] > 0} {
-
- if {$myFromNode eq ""} {
- set myFromNode $toNode
- set myFromIdx $toIdx
+ if {$O(myFromNode) eq ""} {
+ set O(myFromNode) $toNode
+ set O(myFromIdx) $toIdx
}
# This block is where the "selection" tag is added to the HTML
@@ -669,82 +706,84 @@ snit::type ::hv3::hv3::selectionmanager {
# If so, catch the exception and clear the selection.
#
set rc [catch {
- if {$myToNode ne $toNode || $toIdx != $myToIdx} {
- switch -- $myMode {
+ if {$O(myToNode) ne $toNode || $toIdx != $O(myToIdx)} {
+ switch -- $O(myMode) {
char {
- if {$myToNode ne ""} {
- $myHv3 tag remove selection $myToNode $myToIdx $toNode $toIdx
+ if {$O(myToNode) ne ""} {
+ $O(myHtml) tag remove selection $O(myToNode) $O(myToIdx) $toNode $toIdx
}
- $myHv3 tag add selection $myFromNode $myFromIdx $toNode $toIdx
- if {$myFromNode ne $toNode || $myFromIdx != $toIdx} {
- selection own $myHv3
+ $O(myHtml) tag add selection $O(myFromNode) $O(myFromIdx) $toNode $toIdx
+ if {$O(myFromNode) ne $toNode || $O(myFromIdx) != $toIdx} {
+ selection own [$O(myHv3) win]
}
}
word {
- if {$myToNode ne ""} {
- $myHv3 tag remove selection $myToNode $myToIdx $toNode $toIdx
- $self UntagWord $myToNode $myToIdx
+ if {$O(myToNode) ne ""} {
+ $O(myHtml) tag remove selection $O(myToNode) $O(myToIdx) $toNode $toIdx
+ $me UntagWord $O(myToNode) $O(myToIdx)
}
- $myHv3 tag add selection $myFromNode $myFromIdx $toNode $toIdx
- $self TagWord $toNode $toIdx
- $self TagWord $myFromNode $myFromIdx
- selection own $myHv3
+ $O(myHtml) tag add selection $O(myFromNode) $O(myFromIdx) $toNode $toIdx
+ $me TagWord $toNode $toIdx
+ $me TagWord $O(myFromNode) $O(myFromIdx)
+ selection own [$O(myHv3) win]
}
block {
- set to_block2 [$self ToBlock $toNode $toIdx]
- set from_block [$self ToBlock $myFromNode $myFromIdx]
+ set to_block2 [$me ToBlock $toNode $toIdx]
+ set from_block [$me ToBlock $O(myFromNode) $O(myFromIdx)]
- if {$myToNode ne ""} {
- set to_block [$self ToBlock $myToNode $myToIdx]
- $myHv3 tag remove selection $myToNode $myToIdx $toNode $toIdx
- eval $myHv3 tag remove selection $to_block
+ if {$O(myToNode) ne ""} {
+ set to_block [$me ToBlock $O(myToNode) $O(myToIdx)]
+ $O(myHtml) tag remove selection $O(myToNode) $O(myToIdx) $toNode $toIdx
+ eval $O(myHtml) tag remove selection $to_block
}
- $myHv3 tag add selection $myFromNode $myFromIdx $toNode $toIdx
- eval $myHv3 tag add selection $to_block2
- eval $myHv3 tag add selection $from_block
- selection own $myHv3
+ $O(myHtml) tag add selection $O(myFromNode) $O(myFromIdx) $toNode $toIdx
+ eval $O(myHtml) tag add selection $to_block2
+ eval $O(myHtml) tag add selection $from_block
+ selection own [$O(myHv3) win]
}
}
- set myToNode $toNode
- set myToIdx $toIdx
+ set O(myToNode) $toNode
+ set O(myToIdx) $toIdx
}
} msg]
if {$rc && [regexp {[^ ]+ is an orphan} $msg]} {
- $self clear
+ $me clear
}
}
-
set motioncmd ""
- if {$y > [winfo height $myHv3]} {
+ set win [$O(myHv3) win]
+ if {$y > [winfo height $win]} {
set motioncmd [list yview scroll 1 units]
} elseif {$y < 0} {
set motioncmd [list yview scroll -1 units]
- } elseif {$x > [winfo width $myHv3]} {
+ } elseif {$x > [winfo width $win]} {
set motioncmd [list xview scroll 1 units]
} elseif {$x < 0} {
set motioncmd [list xview scroll -1 units]
}
if {$motioncmd ne ""} {
- set myIgnoreMotion 1
- eval $myHv3 $motioncmd
- after 20 [list $self ContinueMotion]
+ set O(myIgnoreMotion) 1
+ eval $O(myHv3) $motioncmd
+ after 20 [list $me ContinueMotion]
}
}
- method ContinueMotion {} {
- set myIgnoreMotion 0
- set x [expr [winfo pointerx $myHv3] - [winfo rootx $myHv3]]
- set y [expr [winfo pointery $myHv3] - [winfo rooty $myHv3]]
- set N [lindex [$myHv3 node $x $y] 0]
- $self motion $N $x $y
+ proc ContinueMotion {me} {
+ upvar $me O
+ set win [$O(myHv3) win]
+ set O(myIgnoreMotion) 0
+ set x [expr [winfo pointerx $win] - [winfo rootx $win]]
+ set y [expr [winfo pointery $win] - [winfo rooty $win]]
+ set N [lindex [$O(myHv3) node $x $y] 0]
+ $me motion $N $x $y
}
# get_selection OFFSET MAXCHARS
@@ -753,47 +792,50 @@ snit::type ::hv3::hv3::selectionmanager {
# while it is owned by the html widget. The text of the selected
# region is returned.
#
- method get_selection {offset maxChars} {
- set t [$myHv3 text text]
+ proc get_selection {me offset maxChars} {
+ upvar $me O
+ set t [$O(myHv3) html text text]
- set n1 $myFromNode
- set i1 $myFromIdx
- set n2 $myToNode
- set i2 $myToIdx
+ set n1 $O(myFromNode)
+ set i1 $O(myFromIdx)
+ set n2 $O(myToNode)
+ set i2 $O(myToIdx)
- set stridx_a [$myHv3 text offset $myFromNode $myFromIdx]
- set stridx_b [$myHv3 text offset $myToNode $myToIdx]
+ set stridx_a [$O(myHv3) html text offset $O(myFromNode) $O(myFromIdx)]
+ set stridx_b [$O(myHv3) html text offset $O(myToNode) $O(myToIdx)]
if {$stridx_a > $stridx_b} {
foreach {stridx_a stridx_b} [list $stridx_b $stridx_a] {}
}
- if {$myMode eq "word"} {
+ if {$O(myMode) eq "word"} {
set stridx_a [string wordstart $t $stridx_a]
set stridx_b [string wordend $t $stridx_b]
}
- if {$myMode eq "block"} {
+ if {$O(myMode) eq "block"} {
set stridx_a [string last "\n" $t $stridx_a]
if {$stridx_a < 0} {set stridx_a 0}
set stridx_b [string first "\n" $t $stridx_b]
if {$stridx_b < 0} {set stridx_b [string length $t]}
}
- set T [string range [$myHv3 text text] $stridx_a [expr $stridx_b - 1]]
+ set T [string range $t $stridx_a [expr $stridx_b - 1]]
set T [string range $T $offset [expr $offset + $maxChars]]
-#puts "document text {[$myHv3 text text]}"
-#puts "from -> to {$n1 $i1 -> $n2 $i2}"
-#puts "from -> to {$stridx_a -> $stridx_b}"
-
return $T
}
- method selected {} {
- if {$myFromNode eq ""} {return ""}
- return [$self get_selection 0 10000000]
+ proc selected {me} {
+ upvar $me O
+ if {$O(myFromNode) eq ""} {return ""}
+ return [$me get_selection 0 10000000]
}
+ proc destroy {me} {
+ array unset $me
+ rename $me {}
+ }
}
+::hv3::make_constructor ::hv3::hv3::selectionmanager
#
# End of ::hv3::hv3::selectionmanager
#--------------------------------------------------------------------------
@@ -806,21 +848,25 @@ snit::type ::hv3::hv3::selectionmanager {
# be extended to handle :focus and :active, but it's not yet clear
# exactly how these should be dealt with.
#
-snit::type ::hv3::hv3::dynamicmanager {
+namespace eval ::hv3::hv3::dynamicmanager {
- constructor {hv3} {
- $hv3 Subscribe onmouseover [list $self handle_mouseover]
- $hv3 Subscribe onmouseout [list $self handle_mouseout]
- $hv3 Subscribe onmousedown [list $self handle_mousedown]
- $hv3 Subscribe onmouseup [list $self handle_mouseup]
+ proc new {me hv3} {
+ $hv3 Subscribe onmouseover [list $me handle_mouseover]
+ $hv3 Subscribe onmouseout [list $me handle_mouseout]
+ $hv3 Subscribe onmousedown [list $me handle_mousedown]
+ $hv3 Subscribe onmouseup [list $me handle_mouseup]
+ }
+ proc destroy {me} {
+ uplevel #0 [list unset $me]
+ rename $me ""
}
- method handle_mouseover {node} { $node dynamic set hover }
- method handle_mouseout {node} { $node dynamic clear hover }
-
- method handle_mousedown {node} { $node dynamic set active }
- method handle_mouseup {node} { $node dynamic clear active }
+ proc handle_mouseover {me node} { $node dynamic set hover }
+ proc handle_mouseout {me node} { $node dynamic clear hover }
+ proc handle_mousedown {me node} { $node dynamic set active }
+ proc handle_mouseup {me node} { $node dynamic clear active }
}
+::hv3::make_constructor ::hv3::hv3::dynamicmanager
#
# End of ::hv3::hv3::dynamicmanager
#--------------------------------------------------------------------------
@@ -841,27 +887,28 @@ snit::type ::hv3::hv3::dynamicmanager {
# to the <Motion>, <ButtonPress-1> and <ButtonRelease-1> events on the
# associated hv3 widget.
#
+namespace eval ::hv3::hv3::hyperlinkmanager {
+
+ proc new {me hv3 baseuri} {
+ upvar $me O
+
+ set O(myHv3) $hv3
-snit::type ::hv3::hv3::hyperlinkmanager {
- variable myHv3
- variable myBaseUri ""
- variable myLinkHoverCount 0
+ set O(myBaseUri) $baseuri
- option -isvisitedcmd -default "" -configuremethod SetVisitedCmd
- option -targetcmd -default ""
+ set O(myLinkHoverCount) 0
- constructor {hv3 baseuri} {
- set myHv3 $hv3
- set myBaseUri $baseuri
+ set O(-targetcmd) [list ::hv3::ReturnWithArgs $hv3]
- # Set up the default -targetcmd script to always return $myHv3.
- set options(-targetcmd) [list ::hv3::ReturnWithArgs $hv3]
+ set O(-isvisitedcmd) [list ::hv3::ReturnWithArgs 0]
- $myHv3 Subscribe onclick [list $self handle_onclick]
+ configure-isvisitedcmd $me
+ $O(myHv3) Subscribe onclick [list $me handle_onclick]
}
- method reset {} {
- set myLinkHoverCount 0
+ proc reset {me} {
+ upvar $me O
+ set O(myLinkHoverCount) 0
}
# This is the configure method for the -isvisitedcmd option. This
@@ -869,12 +916,12 @@ snit::type ::hv3::hv3::hyperlinkmanager {
# and 'link' properties of an <a href="..."> element. This is a
# performance critical operation because it is called so many times.
#
- method SetVisitedCmd {option value} {
- set options($option) $value
+ proc configure-isvisitedcmd {me} {
+ upvar $me O
# Create a proc to use as the node-handler for <a> elements.
#
- set P_NODE ${selfns}::a_node_handler
+ set P_NODE ${me}.a_node_handler
catch {rename $P_NODE ""}
set template [list \
proc $P_NODE {node} {
@@ -889,11 +936,13 @@ snit::type ::hv3::hv3::hyperlinkmanager {
}
}
]
- eval [::snit::Expand $template %BASEURI% $myBaseUri %VISITEDCMD% $value]
+ eval [::hv3::Expand $template \
+ %BASEURI% $O(myBaseUri) %VISITEDCMD% $O(-isvisitedcmd)
+ ]
# Create a proc to use as the attribute-handler for <a> elements.
#
- set P_ATTR ${selfns}::a_attr_handler
+ set P_ATTR ${me}.a_attr_handler
catch {rename $P_ATTR ""}
set template [list \
proc $P_ATTR {node attr val} {
@@ -910,10 +959,12 @@ snit::type ::hv3::hv3::hyperlinkmanager {
}
}
]
- eval [::snit::Expand $template %BASEURI% $myBaseUri %VISITEDCMD% $value]
+ eval [::hv3::Expand $template \
+ %BASEURI% $O(myBaseUri) %VISITEDCMD% $O(-isvisitedcmd)
+ ]
- $myHv3 handler node a $P_NODE
- $myHv3 handler attribute a $P_ATTR
+ $O(myHv3) html handler node a $P_NODE
+ $O(myHv3) html handler attribute a $P_ATTR
}
# This method is called whenever an onclick event occurs. If the
@@ -925,162 +976,258 @@ snit::type ::hv3::hv3::hyperlinkmanager {
# callback script. This allows the upper layer to implement frames,
# links that open in new windows/tabs - all that irritating stuff :)
#
- method handle_onclick {node} {
+ proc handle_onclick {me node} {
+ upvar $me O
if {[$node tag] eq "a"} {
set href [$node attr -default "" href]
if {$href ne "" && $href ne "#"} {
- set hv3 [eval [linsert $options(-targetcmd) end $node]]
- set href [$myBaseUri resolve $href]
- after idle [list $hv3 goto $href -referer [$myHv3 location]]
+ set hv3 [eval [linsert $O(-targetcmd) end $node]]
+ set href [$O(myBaseUri) resolve $href]
+ after idle [list $hv3 goto $href -referer [$O(myHv3) location]]
}
}
}
+
+ proc destroy {me} {
+ catch {rename ${me}.a_node_handler ""}
+ catch {rename ${me}.a_attr_handler ""}
+ }
}
+::hv3::make_constructor ::hv3::hv3::hyperlinkmanager
#
# End of ::hv3::hv3::hyperlinkmanager
#--------------------------------------------------------------------------
-#--------------------------------------------------------------------------
-# Class hv3 - the public widget class.
-#
-snit::widget ::hv3::hv3 {
+namespace eval ::hv3::hv3::framelog {
- # Object components
- component myHtml ;# The [::hv3::scrolled html] widget
- component myHyperlinkManager ;# The ::hv3::hv3::hyperlinkmanager
- component myDynamicManager ;# The ::hv3::hv3::dynamicmanager
- component mySelectionManager -public selectionmanager
- component myFormManager ;# The ::hv3::formmanager
+ proc new {me hv3} {
+ upvar $me O
- option -dom -default "" -configuremethod SetDom
-
- option -storevisitedcmd -default ""
-
- variable myStorevisitedDone 0
-
- component myMouseManager ;# The ::hv3::hv3::mousemanager
- delegate method Subscribe to myMouseManager as subscribe
-
- # The current location URI and the current base URI. If myBase is "",
- # use the URI stored in myUri as the base.
- #
- component myUri -public uri
- variable myBase "" ;# The current URI (type ::hv3::hv3uri)
-
- # Full text of referrer URI, if any.
- #
- # Note that the DOM attribute HTMLDocument.referrer has a double-r,
- # but the name of the HTTP header, "Referer", has only one.
- #
- variable myReferrer ""
+ set O(myHv3) $hv3
+ set O(myStyleErrors) {}
+ set O(myHtmlDocument) {}
+ }
+ proc destroy {me} {
+ uplevel #0 [list unset $me]
+ rename $me ""
+ }
- # Used to assign internal stylesheet ids.
- variable myStyleCount 0
+ proc loghtml {me data} {
+ upvar $me O
+ if {![info exists ::hv3::log_source_option]} return
+ if {$::hv3::log_source_option} {
+ append O(myHtmlDocument) $data
+ }
+ }
- # This variable may be set to "unknown", "quirks" or "standards".
- variable myQuirksmode unknown
+ proc log {me id filename data parse_errors} {
+ upvar $me O
+ if {![info exists ::hv3::log_source_option]} return
+ if {$::hv3::log_source_option} {
+ lappend O(myStyleErrors) [list $id $filename $data $parse_errors]
+ }
+ }
- # List of currently outstanding download-handles. See methods makerequest,
- # Finrequest and <TODO: related to stop?>.
- variable myCurrentDownloads [list]
+ proc clear {me} {
+ upvar $me O
+ set O(myStyleErrors) ""
+ set O(myHtmlDocument) ""
+ }
- variable myFirstReset 1
+ proc get {me args} {
+ upvar $me O
+ switch -- [lindex $args 0] {
+ html {
+ return $O(myHtmlDocument)
+ }
- # Current value to set the -cachecontrol option of download handles to.
- #
- variable myCacheControl normal
+ css {
+ return $O(myStyleErrors)
+ }
+ }
+ }
+}
+::hv3::make_constructor ::hv3::hv3::framelog
- # This variable stores the current type of resource being displayed.
- # When valid, it is set to one of the following:
- #
- # * html
- # * image
- #
- # Otherwise, it is set to an empty string, indicating that the resource
- # has been requested, but has not yet arrived.
- #
- variable myMimetype ""
+#--------------------------------------------------------------------------
+# Class hv3 - the public widget class.
+#
+namespace eval ::hv3::hv3 {
- # This variable is set to true while parsing the first chunk of an
- # html document. i.e. code below effectively does:
- #
- # set myChangeEncodingOk 1
- # $myHtml parse $first_chunk
- # set myChangeEncodingOk 0
- #
- # This is because we only do anything about <meta type="content-type">
- # tags if they are encountered in the first chunk of the document. The
- # default chunk-size is 2048 bytes, so this is reasonably safe.
- #
- variable myChangeEncodingOk 0
+ proc theselectionmanager {me args} {
+ upvar #0 $me O
+ eval $O(mySelectionManager) $args
+ }
+ proc log {me args} {
+ upvar #0 $me O
+ eval $O(myFrameLog) $args
+ }
+ proc uri {me args} {
+ upvar #0 $me O
+ eval $O(myUri) $args
+ }
- # If this variable is set to anything other than an empty string, then
- # it is set to the encoding of the document.
- #
- variable myEncoding ""
+ proc Subscribe {me args} {
+ upvar #0 $me O
+ eval $O(myMouseManager) subscribe $args
+ }
+ proc selected {me args} {
+ upvar #0 $me O
+ eval $O(mySelectionManager) selected $args
+ }
- variable myEncodedDocument ""
+ set TextWrapper {
+ <html>
+ <style>
+ body {background-color: #c3c3c3}
+ pre {
+ margin: 20px 30px;
+ background-color: #d9d9d9;
+ background-color: white;
+ padding: 5px;
+ border: 1px solid;
+ border-color: #828282 #ffffff #ffffff #828282;
+ }
+ </style>
+ <pre>
+ }
- # This variable is only used when ($myMimetype eq "image"). It stores
- # the data for the image about to be displayed. Once the image
- # has finished downloading, the data in this variable is loaded into
- # a Tk image and this variable reset to "".
- #
- variable myImageData ""
+ proc new {me args} {
+ upvar #0 $me O
+ set win $O(win)
+
+ # The scrolled html widget.
+ # set O(myHtml) [::hv3::scrolled html $win.html]
+ set O(myHtml) $O(hull)
+ set O(html) [html $me]
+ catch {::hv3::profile::instrument [$O(myHtml) widget]}
- # If this variable is not set to the empty string, it is the id of an
- # [after] event that will refresh the current document (i.e from a
- # Refresh header or <meta type=http-equiv> markup). This scheduled
- # event should be cancelled when the [reset] method is called.
- #
- # There should only be one Refresh event scheduled at any one time.
- # The [Refresh] method, which calls [after] to schedule the events,
- # cancels any pending event before scheduling a new one.
- #
- variable myRefreshEventId ""
+ # Current location and base URIs. The default URI is "blank://".
+ set O(myUri) [::tkhtml::uri home://blank/]
+ set O(myBase) [::tkhtml::uri home://blank/]
- # This boolean variable is set to zero until the first call to [goto].
- # Before that point it is safe to change the values of the -enableimages
- # option without reloading the document.
- #
- variable myGotoCalled 0
+ # Component objects.
+ set O(myMouseManager) [mousemanager %AUTO% $me]
+ set O(myHyperlinkManager) [hyperlinkmanager %AUTO% $me $O(myBase)]
+ set O(mySelectionManager) [selectionmanager %AUTO% $me]
+ set O(myDynamicManager) [dynamicmanager %AUTO% $me]
+ set O(myFormManager) [::hv3::formmanager %AUTO% $me]
+ set O(myFrameLog) [framelog %AUTO% $me]
- # This boolean variable is set after the DOM "onload" event is fired.
- # It is cleared by the [reset] method.
- variable myOnloadFired 0
+ set O(-storevisitedcmd) ""
- variable myFragmentSeek ""
+ set O(myStorevisitedDone) 0
+ set O(-historydoccmd) ""
- constructor {} {
+ # The option to display images (default true).
+ set O(-enableimages) 1
- # Create the scrolled html widget and bind it's events to the
- # mega-widget window.
- set myHtml [::hv3::scrolled html ${win}.html -propagate 1]
- ::hv3::profile::instrument [$myHtml widget]
- bindtags [$self html] [concat [bindtags [$self html]] $self]
- pack $myHtml -fill both -expand 1
+ # The option to execute javascript (default false).
+ #
+ # When javascript is enabled, the O(myDom) variable is set to the name of
+ # an object of type [::hv3::dom]. When it is not enabled, O(myDom) is
+ # an empty string.
+ #
+ # When the -enablejavascript option is changed from true to false,
+ # the O(myDom) object is deleted (and O(myDom) set to the empty
+ # string). But the dom object is not created immediately when
+ # -enablejavascript is changed from false to true. Instead, we
+ # wait until the next time the hv3 widget is reset.
+ #
+ set O(-enablejavascript) 0
+ set O(myDom) ""
- set myMouseManager [::hv3::hv3::mousemanager %AUTO% $self]
+ set O(-scrollbarpolicy) auto
- # $myHtml configure -layoutcache 0
+ set O(-locationvar) ""
+ set O(-downloadcmd) ""
+ set O(-requestcmd) ""
- # Location URI. The default URI is "blank://".
- set myUri [::tkhtml::uri home://blank/]
- set myBase [::tkhtml::uri home://blank/]
+ set O(-frame) ""
- # Create the event-handling components.
- set myHyperlinkManager [::hv3::hv3::hyperlinkmanager %AUTO% $self $myBase]
- set mySelectionManager [::hv3::hv3::selectionmanager %AUTO% $self]
- set myDynamicManager [::hv3::hv3::dynamicmanager %AUTO% $self]
+ # Full text of referrer URI, if any.
+ #
+ # Note that the DOM attribute HTMLDocument.referrer has a double-r,
+ # but the name of the HTTP header, "Referer", has only one.
+ #
+ set O(myReferrer) ""
+
+ # Used to assign internal stylesheet ids.
+ set O(myStyleCount) 0
+
+ # This variable may be set to "unknown", "quirks" or "standards".
+ set O(myQuirksmode) unknown
+
+ set O(myFirstReset) 1
+
+ # Current value to set the -cachecontrol option of download handles to.
+ #
+ set O(myCacheControl) normal
+
+ # This variable stores the current type of resource being displayed.
+ # When valid, it is set to one of the following:
+ #
+ # * html
+ # * image
+ #
+ # Otherwise, it is set to an empty string, indicating that the resource
+ # has been requested, but has not yet arrived.
+ #
+ set O(myMimetype) ""
+
+ # This variable is only used when ($O(myMimetype) eq "image"). It stores
+ # the data for the image about to be displayed. Once the image
+ # has finished downloading, the data in this variable is loaded into
+ # a Tk image and this variable reset to "".
+ #
+ set O(myImageData) ""
+
+ # If this variable is not set to the empty string, it is the id of an
+ # [after] event that will refresh the current document (i.e from a
+ # Refresh header or <meta type=http-equiv> markup). This scheduled
+ # event should be cancelled when the [reset] method is called.
+ #
+ # There should only be one Refresh event scheduled at any one time.
+ # The [Refresh] method, which calls [after] to schedule the events,
+ # cancels any pending event before scheduling a new one.
+ #
+ set O(myRefreshEventId) ""
+
+ # This boolean variable is set to zero until the first call to [goto].
+ # Before that point it is safe to change the values of the -enableimages
+ # option without reloading the document.
+ #
+ set O(myGotoCalled) 0
+
+ # This boolean variable is set after the DOM "onload" event is fired.
+ # It is cleared by the [reset] method.
+ set O(myOnloadFired) 0
+
+ set O(myFragmentSeek) ""
+
+ # The ::hv3::request object used to retrieve the main document.
+ #
+ set O(myDocumentHandle) ""
+
+ # List of handle objects that should be released after the page has
+ # loaded. This is part of the hack to work around the polipo bug.
+ #
+ set O(myShelvedHandles) [list]
+
+ # List of all active download handles.
+ #
+ set O(myActiveHandles) [list]
+
+ set O(myTitleVar) ""
- $myMouseManager subscribe motion [list $mySelectionManager motion]
+ $O(myMouseManager) subscribe motion [list $O(mySelectionManager) motion]
- set myFormManager [::hv3::formmanager %AUTO% $self]
- $myFormManager configure -getcmd [list $self Formcmd get]
- $myFormManager configure -postcmd [list $self Formcmd post]
+ $O(myFormManager) configure -getcmd [list $me Formcmd get]
+ $O(myFormManager) configure -postcmd [list $me Formcmd post]
- # Attach an image callback to the html widget
- $myHtml configure -imagecmd [list $self Imagecmd]
+ # Attach an image callback to the html widget. Store images as
+ # pixmaps only when possible to save memory.
+ $O(myHtml) configure -imagecmd [list $me Imagecmd] -imagepixmapify 1
# Register node handlers to deal with the various elements
# that may appear in the document <head>. In html, the <head> section
@@ -1092,65 +1239,92 @@ snit::widget ::hv3::hv3 {
# handler for <object> is the same whether the element is located in
# the head or body of the html document.
#
- $myHtml handler node link [list $self link_node_handler]
- $myHtml handler node base [list $self base_node_handler]
- $myHtml handler node meta [list $self meta_node_handler]
- $myHtml handler node title [list $self title_node_handler]
- $myHtml handler script style [list $self style_script_handler]
- $myHtml handler script script [list $self ::hv3::ignore_script]
-
- # $myHtml handler script script [list $self script_script_handler]
-
- # Register handler commands to handle <object> and kin.
- $myHtml handler node object [list hv3_object_handler $self]
- $myHtml handler node embed [list hv3_object_handler $self]
+ $O(myHtml) handler node link [list $me link_node_handler]
+ $O(myHtml) handler node base [list $me base_node_handler]
+ $O(myHtml) handler node meta [list $me meta_node_handler]
+ $O(myHtml) handler node title [list $me title_node_handler]
+ $O(myHtml) handler script style [list $me style_script_handler]
+ $O(myHtml) handler script script [list ::hv3::ignore_script]
# Register handler commands to handle <body>.
- $myHtml handler node body [list $self body_node_handler]
+ $O(myHtml) handler node body [list $me body_node_handler]
- bind $win <Configure> [list $self goto_fragment]
+ bind $win <Configure> [list $me goto_fragment]
+ #bind [html $me].document <Visibility> [list $me VisibilityChange %s]
+
+ eval $me configure $args
}
- destructor {
- # Clean up any pending downloads.
- foreach dl $myCurrentDownloads {
- $dl destroy
- }
+ # Destructor. This is called automatically when the window is destroyed.
+ #
+ proc destroy {me} {
+ upvar #0 $me O
+
+ # Cancel any and all pending downloads.
+ #
+ $me stop
+ catch {$O(myDocumentHandle) release}
# Destroy the components. We don't need to destroy the scrolled
# html component because it is a Tk widget - it is automatically
# destroyed when it's parent widget is.
- catch { $mySelectionManager destroy }
- catch { $myDynamicManager destroy }
- catch { $myHyperlinkManager destroy }
- catch { $myUri destroy }
- catch { $myFormManager destroy }
- catch { $myMouseManager destroy }
- catch { $myBase destroy }
-
- # Tell the DOM implementation that any Window object created for
- # this widget is no longer required.
- catch { $options(-dom) delete_window $self }
+ catch { $O(mySelectionManager) destroy }
+ catch { $O(myDynamicManager) destroy }
+ catch { $O(myHyperlinkManager) destroy }
+ catch { $O(myUri) destroy }
+ catch { $O(myFormManager) destroy }
+ catch { $O(myMouseManager) destroy }
+ catch { $O(myBase) destroy }
+ catch { $O(myDom) destroy }
# Cancel any refresh-event that may be pending.
- if {$myRefreshEventId ne ""} {
- after cancel $myRefreshEventId
- set myRefreshEventId ""
+ if {$O(myRefreshEventId) ne ""} {
+ after cancel $O(myRefreshEventId)
+ set O(myRefreshEventId) ""
}
- # Cancel any idle callbacks that might be pending. Otherwise
- # Tcl will throw a background error when they are delivered and
- # this object no longer exists.
- after cancel [list $self MightBeComplete]
+ unset $me
+ rename $me {}
+ }
+
+ proc VisibilityChange {me state} {
+ upvar #0 $me O
+
+ switch -- $state {
+ VisibilityUnobscured {
+ set enablelayout 1
+ }
+ VisibilityPartiallyObscured {
+ set enablelayout 1
+ }
+ VisibilityFullyObscured {
+ set enablelayout 0
+ }
+ }
+ if {[$O(myHtml) cget -enablelayout] != $enablelayout} {
+ $O(myHtml) configure -enablelayout $enablelayout
+ }
}
# Return the location URI of the widget.
#
- method location {} { return [$myUri get] }
+ proc location {me} {
+ upvar #0 $me O
+ return [$O(myUri) get]
+ }
# Return the referrer URI of the widget.
#
- method referrer {} { return $myReferrer }
+ proc referrer {me} {
+ upvar #0 $me O
+ return $O(myReferrer)
+ }
+
+ proc Forget {me handle} {
+ upvar #0 $me O
+ set idx [lsearch $O(myActiveHandles) $handle]
+ set O(myActiveHandles) [lreplace $O(myActiveHandles) $idx $idx]
+ }
# The argument download-handle contains a configured request. This
# method initiates the request.
@@ -1158,77 +1332,67 @@ snit::widget ::hv3::hv3 {
# This method is used by hv3 and it's component objects (i.e. code in
# hv3_object_handler). Also the dom code, for XMLHTTPRequest.
#
- method makerequest {downloadHandle} {
+ proc makerequest {me downloadHandle} { # PRIVATE
+ upvar #0 $me O
- # Put the handle in the myCurrentDownloads list. Add a wrapper to the
- # code in the -failscript and -finscript options to remove it when the
- # download is finished.
- lappend myCurrentDownloads $downloadHandle
- $self set_pending_var
- $downloadHandle destroy_hook [list $self Finrequest $downloadHandle]
+ lappend O(myActiveHandles) $downloadHandle
+ $downloadHandle finish_hook [list $me Forget $downloadHandle]
# Execute the -requestcmd script. Fail the download and raise
# an exception if an error occurs during script evaluation.
- set cmd [concat $options(-requestcmd) [list $downloadHandle]]
+ set cmd [concat $O(-requestcmd) [list $downloadHandle]]
set rc [catch $cmd errmsg]
if {$rc} {
- set einfo $::errorInfo
- catch {$downloadHandle finish}
- error $errmsg $einfo
- }
- }
-
- # This method is only called internally, via download-handle -failscript
- # and -finscript scripts. It removes the argument handle from the
- # myCurrentDownloads list and invokes [concat $script [list $data]].
- #
- method Finrequest {downloadHandle} {
- set idx [lsearch $myCurrentDownloads $downloadHandle]
- if {$idx >= 0} {
- set myCurrentDownloads [lreplace $myCurrentDownloads $idx $idx]
- $self set_pending_var
+ #set einfo $::errorInfo
+ #error $errmsg $einfo
+ puts "Error in -requestcmd [$downloadHandle cget -uri]: $errmsg"
+ catch {$downloadHandle destroy}
}
}
- # Based on the current contents of instance variable $myUri, set the
+ # Based on the current contents of instance variable $O(myUri), set the
# variable identified by the -locationvar option, if any.
#
- method set_location_var {} {
- if {$options(-locationvar) ne ""} {
- uplevel #0 [list set $options(-locationvar) [$myUri get]]
+ proc SetLocationVar {me } {
+ upvar #0 $me O
+ if {$O(-locationvar) ne ""} {
+ uplevel #0 [list set $O(-locationvar) [$O(myUri) get]]
}
- event generate $win <<Location>>
+ event generate $O(win) <<Location>>
}
- method set_pending_var {} {
- if {$options(-pendingcmd) ne ""} {
- uplevel #0 $options(-pendingcmd) [llength $myCurrentDownloads]
- }
- after cancel [list $self MightBeComplete]
- after idle [list $self MightBeComplete]
- }
-
- method MightBeComplete {} {
- if {[llength $myCurrentDownloads] == 0} {
- event generate $win <<Complete>>
+ proc MightBeComplete {me } {
+ upvar #0 $me O
+ if {[llength $O(myActiveHandles)] == 0} {
+ event generate $O(win) <<Complete>>
# There are no outstanding HTTP transactions. So fire
# the DOM "onload" event.
- if {$options(-dom) ne "" && !$myOnloadFired} {
- set bodynode [$myHtml search body]
- $options(-dom) event load [lindex $bodynode 0]
+ if {$O(myDom) ne "" && !$O(myOnloadFired)} {
+ set O(myOnloadFired) 1
+ set bodynode [$O(myHtml) search body]
+ # Workaround. Currently meta reload causes empty completion.
+ # XXX: Check this again!
+ if {[llength $bodynode]} {
+ $O(myDom) event load [lindex $bodynode 0]
+ }
}
- set myOnloadFired 1
}
}
- method onload_fired {} { return $myOnloadFired }
+ proc onload_fired {me } {
+ upvar #0 $me O
+ return $O(myOnloadFired)
+ }
- method resolve_uri {uri} {
+ # PUBLIC METHOD.
+ #
+ proc resolve_uri {me uri} {
+ upvar #0 $me O
if {$uri eq ""} {
- set ret "[$myBase scheme]://[$myBase authority][$myBase path]"
+ set ret "[$O(myBase) scheme]://[$O(myBase) authority][$O(myBase) path]"
} else {
- set ret [$myBase resolve $uri]
+ set ret [$O(myBase) resolve $uri]
}
return $ret
}
@@ -1241,7 +1405,8 @@ snit::widget ::hv3::hv3 {
# the contents of the Tk image are set to the returned data in proc
# ::hv3::imageCallback.
#
- method Imagecmd {uri} {
+ proc Imagecmd {me uri} {
+ upvar #0 $me O
# Massage the URI a bit. Trim whitespace from either end.
set uri [string trim $uri]
@@ -1253,19 +1418,20 @@ snit::widget ::hv3::hv3 {
set name [image create photo]
if {$uri ne ""} {
- set full_uri [$self resolve_uri $uri]
+ set full_uri [$me resolve_uri $uri]
# Create and execute a download request. For now, "expect" a mime-type
# of image/gif. This should be enough to tell the protocol handler to
# expect a binary file (of course, this is not correct, the real
# default mime-type might be some other kind of image).
- set handle [::hv3::download %AUTO% \
+ set handle [::hv3::request %AUTO% \
-uri $full_uri \
-mimetype image/gif \
- -cachecontrol $myCacheControl \
+ -cachecontrol $O(myCacheControl) \
+ -cacheable 0 \
]
- $handle configure -finscript [list $self Imagecallback $handle $name]
- $self makerequest $handle
+ $handle configure -finscript [list $me Imagecallback $handle $name]
+ $me makerequest $handle
}
# Return a list of two elements - the image name and the image
@@ -1278,7 +1444,8 @@ snit::widget ::hv3::hv3 {
# these). If there is a Location method, then the handle object is
# destroyed, a new one dispatched and 1 returned. Otherwise 0 is returned.
#
- method HandleLocation {handle} {
+ proc HandleLocation {me handle} {
+ upvar #0 $me O
# Check for a "Location" header. TODO: Handling Location
# should be done in one common location for everything except
# the main document. The main document is a bit different...
@@ -1292,15 +1459,15 @@ snit::widget ::hv3::hv3 {
if {$location ne ""} {
set finscript [$handle cget -finscript]
- $handle destroy
- set full_location [$self resolve_uri $location]
- set handle2 [::hv3::download $handle \
+ $handle release
+ set full_location [$me resolve_uri $location]
+ set handle2 [::hv3::request $handle \
-uri $full_location \
-mimetype image/gif \
- -cachecontrol $myCacheControl \
+ -cachecontrol $O(myCacheControl) \
]
$handle2 configure -finscript $finscript
- $self makerequest $handle2
+ $me makerequest $handle2
return 1
}
return 0
@@ -1312,12 +1479,13 @@ snit::widget ::hv3::hv3 {
# binary image format like gif). This proc sets the named Tk image to
# contain the downloaded data.
#
- method Imagecallback {handle name data} {
- if {0 == [$self HandleLocation $handle]} {
+ proc Imagecallback {me handle name data} {
+ upvar #0 $me O
+ if {0 == [$me HandleLocation $handle]} {
# If the image data is invalid, it is not an error. Possibly hv3
# should log a warning - if it had a warning system....
catch { $name configure -data $data }
- $handle destroy
+ $handle release
}
}
@@ -1326,58 +1494,118 @@ snit::widget ::hv3::hv3 {
# method is used for stylesheets obtained by either HTML <link>
# elements or CSS "@import {...}" directives.
#
- method Requeststyle {parent_id full_uri} {
- set id ${parent_id}.[format %.4d [incr myStyleCount]]
- set importcmd [list $self Requeststyle $id]
+ proc Requeststyle {me parent_id full_uri} {
+ upvar #0 $me O
+ set id ${parent_id}.[format %.4d [incr O(myStyleCount)]]
+ set importcmd [list $me Requeststyle $id]
set urlcmd [list ::hv3::ss_resolve_uri $full_uri]
append id .9999
- set handle [::hv3::download %AUTO% \
+ set handle [::hv3::request %AUTO% \
-uri $full_uri \
-mimetype text/css \
- -cachecontrol $myCacheControl \
+ -cachecontrol $O(myCacheControl) \
+ -cacheable 1 \
]
$handle configure -finscript [
- list $self Finishstyle $handle $id $importcmd $urlcmd
+ list $me Finishstyle $handle $id $importcmd $urlcmd
]
- $self makerequest $handle
+ $me makerequest $handle
}
# Callback invoked when a stylesheet request has finished. Made
# from method Requeststyle above.
#
- method Finishstyle {handle id importcmd urlcmd data} {
- if {0 == [$self HandleLocation $handle]} {
+ proc Finishstyle {me handle id importcmd urlcmd data} {
+ upvar #0 $me O
+ if {0 == [$me HandleLocation $handle]} {
set full_id "$id.[$handle cget -uri]"
- $myHtml style -id $full_id -importcmd $importcmd -urlcmd $urlcmd $data
- $self goto_fragment
- $handle destroy
+ $O(html) style \
+ -id $full_id \
+ -importcmd $importcmd \
+ -urlcmd $urlcmd \
+ -errorvar parse_errors \
+ $data
+
+ $O(myFrameLog) log $full_id [$handle cget -uri] $data $parse_errors
+
+ $me goto_fragment
+ $me MightBeComplete
+ $handle release
}
}
# Node handler script for <meta> tags.
#
- method meta_node_handler {node} {
+ proc meta_node_handler {me node} {
+ upvar #0 $me O
set httpequiv [string tolower [$node attr -default "" http-equiv]]
set content [$node attr -default "" content]
switch -- $httpequiv {
refresh {
- $self Refresh $content
+ $me Refresh $content
}
content-type {
- if {$myChangeEncodingOk} {
- foreach {a b enc} [::hv3::string::parseContentType $content] {}
- set myEncoding $enc
- if {[string match -nocase *utf-8* $myEncoding]} {
- set myEncoding ""
+ foreach {a b enc} [::hv3::string::parseContentType $content] {}
+ if {
+ ![$O(myDocumentHandle) cget -hastransportencoding] &&
+ ![::hv3::encoding_isequal $enc [$me encoding]]
+ } {
+ # This occurs when a document contains a <meta> element that
+ # specifies a character encoding and the document was
+ # delivered without a transport-layer encoding (Content-Type
+ # header). We need to start reparse the document from scratch
+ # using the new encoding.
+ #
+ # We need to be careful to work around a polipo bug here: If
+ # there are more than two requests for a single resource
+ # to a single polipo process, and one of the requests is
+ # cancelled, then the other (still active) request is truncated
+ # by polipo. The polipo developers acknowledge that this is
+ # a bug, but as it doesn't come up very often in normal polipo
+ # usage it is not likely to be fixed soon.
+ #
+ # It's a problem for Hv3 because if the following [reset] cancels
+ # any requests, then when reparsing the same document with a
+ # different encoding the same resources are requested, we are
+ # likely to trigger this bug.
+ #
+ puts "INFO: This page triggers meta enc reload"
+
+ # For all active handles except the document handle, configure
+ # the -incrscript as a no-op, and have the finscript simply
+ # release the handle reference. This means the polipo bug will
+ # not be triggered.
+ foreach h $O(myActiveHandles) {
+ if {$h ne $O(myDocumentHandle)} {
+ set fin [list ::hv3::release_handle $h]
+ $h configure -incrscript "" -finscript $fin
+ }
}
+
+ $me InternalReset
+ $O(myDocumentHandle) configure -encoding $enc
+ $me HtmlCallback \
+ $O(myDocumentHandle) \
+ [$O(myDocumentHandle) isFinished] \
+ [$O(myDocumentHandle) data]
}
}
}
}
+ # Return the default encoding that should be used for
+ # javascript and CSS resources.
+ proc encoding {me} {
+ upvar #0 $me O
+ if {$O(myDocumentHandle) eq ""} {
+ return [encoding system]
+ }
+ return [$O(myDocumentHandle) encoding]
+ }
+
# This method is called to handle "Refresh" and "Location" headers
# delivered as part of the response to a request for a document to
# display in the main window. Refresh headers specified as
@@ -1391,7 +1619,10 @@ snit::widget ::hv3::hv3 {
# In the case of Location headers, a synthetic Refresh content header is
# constructed to pass to this method.
#
- method Refresh {content} {
+ # Returns 1 if immediate refresh (seconds = 0) is requested.
+ #
+ proc Refresh {me content} {
+ upvar #0 $me O
# Use a regular expression to extract the URI and number of seconds
# from the header content. Then dequote the URI string.
set uri ""
@@ -1400,21 +1631,25 @@ snit::widget ::hv3::hv3 {
regexp {[^\"\']+} $uri uri ;# Primitive dequote
if {$uri ne ""} {
- if {$myRefreshEventId ne ""} {
- after cancel $myRefreshEventId
+ if {$O(myRefreshEventId) ne ""} {
+ after cancel $O(myRefreshEventId)
}
- set cmd [list $self RefreshEvent $uri]
- set myRefreshEventId [after [expr {$seconds*1000}] $cmd]
+ set cmd [list $me RefreshEvent $uri]
+ set O(myRefreshEventId) [after [expr {$seconds*1000}] $cmd]
# puts "Parse of content for http-equiv refresh successful! ($uri)"
+
+ return [expr {$seconds == 0}]
} else {
# puts "Parse of content for http-equiv refresh failed..."
+ return 0
}
}
- method RefreshEvent {uri} {
- set myRefreshEventId ""
- $self goto $uri -nosave
+ proc RefreshEvent {me uri} {
+ upvar #0 $me O
+ set O(myRefreshEventId) ""
+ $me goto $uri -nosave
}
# System for handling <title> elements. This object exports
@@ -1423,28 +1658,35 @@ snit::widget ::hv3::hv3 {
# "title" of this document. The idea is that the caller add a trace
# to that variable.
#
- method title_node_handler {node} {
+ proc title_node_handler {me node} {
+ upvar #0 $me O
set val ""
foreach child [$node children] {
append val [$child text]
}
- set myTitleVar $val
+ set O(myTitleVar) $val
+ }
+ proc titlevar {me} {
+ return ::${me}(myTitleVar)
+ }
+ proc title {me} {
+ upvar #0 $me O
+ return $O(myTitleVar)
}
- variable myTitleVar ""
- method titlevar {} {return [myvar myTitleVar]}
- method title {} {return $myTitleVar}
# Node handler script for <body> tags. The purpose of this handler
# and the [body_style_handler] method immediately below it is
# to handle the 'overflow' property on the document root element.
#
- method body_node_handler {node} {
- $node replace dummy -stylecmd [list $self body_style_handler $node]
+ proc body_node_handler {me node} {
+ upvar #0 $me O
+ $node replace dumO(my) -stylecmd [list $me body_style_handler $node]
}
- method body_style_handler {bodynode} {
+ proc body_style_handler {me bodynode} {
+ upvar #0 $me O
- if {$options(-scrollbarpolicy) ne "auto"} {
- $myHtml configure -scrollbarpolicy $options(-scrollbarpolicy)
+ if {$O(-scrollbarpolicy) ne "auto"} {
+ $O(myHtml) configure -scrollbarpolicy $O(-scrollbarpolicy)
return
}
@@ -1461,20 +1703,21 @@ snit::widget ::hv3::hv3 {
set overflow [$bodynode property overflow]
}
switch -- $overflow {
- visible { $myHtml configure -scrollbarpolicy auto }
- auto { $myHtml configure -scrollbarpolicy auto }
- hidden { $myHtml configure -scrollbarpolicy 0 }
- scroll { $myHtml configure -scrollbarpolicy 1 }
+ visible { $O(myHtml) configure -scrollbarpolicy auto }
+ auto { $O(myHtml) configure -scrollbarpolicy auto }
+ hidden { $O(myHtml) configure -scrollbarpolicy 0 }
+ scroll { $O(myHtml) configure -scrollbarpolicy 1 }
default {
puts stderr "Hv3 is confused: <body> has \"overflow:$overflow\"."
- $myHtml configure -scrollbarpolicy auto
+ $O(myHtml) configure -scrollbarpolicy auto
}
}
}
# Node handler script for <link> tags.
#
- method link_node_handler {node} {
+ proc link_node_handler {me node} {
+ upvar #0 $me O
set rel [string tolower [$node attr -default "" rel]]
set href [string trim [$node attr -default "" href]]
set media [string tolower [$node attr -default all media]]
@@ -1484,89 +1727,107 @@ snit::widget ::hv3::hv3 {
$href ne "" &&
[regexp all|screen $media]
} {
- set full_uri [$self resolve_uri $href]
- $self Requeststyle author $full_uri
+ set full_uri [$me resolve_uri $href]
+ $me Requeststyle author $full_uri
}
}
# Node handler script for <base> tags.
#
- method base_node_handler {node} {
+ proc base_node_handler {me node} {
+ upvar #0 $me O
# Technically, a <base> tag is required to specify an absolute URI.
# If a relative URI is specified, hv3 resolves it relative to the
# current location URI. This is not standards compliant (a relative URI
# is technically illegal), but seems like a reasonable idea.
- $myBase load [$node attr -default "" href]
+ $O(myBase) load [$node attr -default "" href]
}
# Script handler for <style> tags.
#
- method style_script_handler {attr script} {
+ proc style_script_handler {me attr script} {
+ upvar #0 $me O
array set attributes $attr
if {[info exists attributes(media)]} {
if {0 == [regexp all|screen $attributes(media)]} return ""
}
- set id author.[format %.4d [incr myStyleCount]]
- set importcmd [list $self Requeststyle $id]
- set urlcmd [list $self resolve_uri]
+ set id author.[format %.4d [incr O(myStyleCount)]]
+ set importcmd [list $me Requeststyle $id]
+ set urlcmd [list $me resolve_uri]
append id ".9999.<style>"
- $myHtml style -id $id -importcmd $importcmd -urlcmd $urlcmd $script
+ $O(html) style -id $id \
+ -importcmd $importcmd \
+ -urlcmd $urlcmd \
+ -errorvar parse_errors \
+ $script
+
+ $O(myFrameLog) log $id "<style> block $O(myStyleCount)" $script $parse_errors
+
return ""
}
- method goto_fragment {} {
- switch -- [llength $myFragmentSeek] {
+ proc goto_fragment {me } {
+ upvar #0 $me O
+ switch -- [llength $O(myFragmentSeek)] {
0 { # Do nothing }
1 {
- $myHtml _force
- $myHtml yview moveto [lindex $myFragmentSeek 0]
+ $O(myHtml) yview moveto [lindex $O(myFragmentSeek) 0]
}
2 {
- set fragment [lindex $myFragmentSeek 1]
+ set fragment [lindex $O(myFragmentSeek) 1]
set selector [format {[name="%s"]} $fragment]
- set goto_node [lindex [$myHtml search $selector] 0]
+ set goto_node [lindex [$O(myHtml) search $selector] 0]
# If there was no node with the name attribute set to the fragment,
# search for a node with the id attribute set to the fragment.
if {$goto_node eq ""} {
set selector [format {[id="%s"]} $fragment]
- set goto_node [lindex [$myHtml search $selector] 0]
+ set goto_node [lindex [$O(myHtml) search $selector] 0]
}
if {$goto_node ne ""} {
- $myHtml yview $goto_node
+ $O(myHtml) yview $goto_node
}
}
}
}
- method seek_to_fragment {fragment} {
+ proc seek_to_fragment {me fragment} {
+ upvar #0 $me O
+
# A fragment was specified as part of the URI that has just started
- # loading. Set myFragmentSeek to the fragment name. Each time some
+ # loading. Set O(myFragmentSeek) to the fragment name. Each time some
# more of the document or a stylesheet loads, the [goto_fragment]
# method will try to align the vertical scrollbar so that the
# named fragment is at the top of the view.
#
# If and when the user manually scrolls the viewport, the
- # myFragmentSeek variable is cleared. This is so we don't wrest
+ # O(myFragmentSeek) variable is cleared. This is so we don't wrest
# control of the vertical scrollbar after the user has manually
# positioned it.
#
- $myHtml take_control [list set [myvar myFragmentSeek] ""]
+ $O(myHtml) take_control [list set ::${me}(myFragmentSeek) ""]
if {$fragment ne ""} {
- set myFragmentSeek [list # $fragment]
+ set O(myFragmentSeek) [list # $fragment]
}
}
- method seek_to_yview {moveto} {
- $myHtml take_control [list set [myvar myFragmentSeek] ""]
- set myFragmentSeek $moveto
+ proc seek_to_yview {me moveto} {
+ upvar #0 $me O
+ $O(myHtml) take_control [list set ::${me}(myFragmentSeek) ""]
+ set O(myFragmentSeek) $moveto
}
- method documentcallback {handle referrer savestate final data} {
+ proc documenthandle {me } {
+ upvar #0 $me O
+ return $O(myDocumentHandle)
+ }
+
+ proc documentcallback {me handle referrer savestate final data} {
+ upvar #0 $me O
- if {$myMimetype eq ""} {
+ if {$O(myMimetype) eq ""} {
# TODO: Real mimetype parser...
set mimetype [string tolower [string trim [$handle cget -mimetype]]]
@@ -1575,189 +1836,179 @@ snit::widget ::hv3::hv3 {
switch -- $major {
text {
if {[lsearch [list html xml xhtml] $minor]>=0} {
- set q [::hv3::configure_doctype_mode $myHtml $data isXHTML]
- $self reset $savestate
- set myQuirksmode $q
- $myHtml configure -xhtml $isXHTML
- set myMimetype html
- set myEncoding ""
- set myChangeEncodingOk 1
- }
+ set q [::hv3::configure_doctype_mode $O(myHtml) $data isXHTML]
+ $me reset $savestate
+ set O(myQuirksmode) $q
+ if {$isXHTML} { $O(myHtml) configure -parsemode xhtml } \
+ else { $O(myHtml) configure -parsemode html }
+ set O(myMimetype) html
+ } else {
+ # Plain text mode.
+ $me reset $savestate
+ $O(myHtml) parse $::hv3::hv3::TextWrapper
+ set O(myMimetype) text
+ }
}
image {
- set myImageData ""
- $self reset $savestate
- set myMimetype image
+ set O(myImageData) ""
+ $me reset $savestate
+ set O(myMimetype) image
}
}
+
+ # If there is a "Location" or "Refresh" header, handle it now.
+ set refreshheader ""
+ foreach {name value} [$handle cget -header] {
+ switch -- [string tolower $name] {
+ location {
+ set refreshheader "0 ; URL=$value"
+ }
+ refresh {
+ set refreshheader $value
+ }
+ }
+ }
+
+ set isImmediateRefresh [$me Refresh $refreshheader]
-
- if {$myMimetype eq ""} {
+ if {!$isImmediateRefresh && $O(myMimetype) eq ""} {
# Neither text nor an image. This is the upper layers problem.
- if {$options(-downloadcmd) ne ""} {
+ if {$O(-downloadcmd) ne ""} {
# Remove the download handle from the list of handles to cancel
# if [$hv3 stop] is invoked (when the user clicks the "stop" button
# we don't want to cancel pending save-file operations).
- set idx [lsearch $myCurrentDownloads $handle]
- if {$idx >= 0} {
- set myCurrentDownloads [lreplace $myCurrentDownloads $idx $idx]
- $self set_pending_var
- }
- eval [linsert $options(-downloadcmd) end $handle $data $final]
+ $me Forget $handle
+ eval [linsert $O(-downloadcmd) end $handle $data $final]
} else {
- $handle destroy
+ $handle release
set sheepish "Don't know how to handle \"$mimetype\""
tk_dialog .apology "Sheepish apology" $sheepish 0 OK
}
return
}
- set myReferrer $referrer
-
- $myUri load [$handle cget -uri]
- $myBase load [$myUri get]
- $self set_location_var
+ $O(myUri) load [$handle cget -uri]
+ $O(myBase) load [$O(myUri) get]
+ $me SetLocationVar
- if {$myCacheControl ne "relax-transparency"} {
- $self seek_to_fragment [$myUri fragment]
+ if {$isImmediateRefresh} {
+ $handle release
+ return
}
- set myForceReload 0
- set myStyleCount 0
-
- # If there is a "Location" or "Refresh" header, handle it now.
- set refreshheader ""
- foreach {name value} [$handle cget -header] {
- switch -- [string tolower $name] {
- location {
- set refreshheader "0 ; URL=$value"
- }
- refresh {
- set refreshheader $value
- }
- content-type {
- set tokens [::hv3::string::tokenise $value]
- foreach {a b enc} [::hv3::string::parseContentType $value] {}
- if {$enc ne ""} {
- set myChangeEncodingOk 0
- }
- }
- }
+ set O(myReferrer) $referrer
+
+ if {$O(myCacheControl) ne "relax-transparency"} {
+ $me seek_to_fragment [$O(myUri) fragment]
}
- if {$refreshheader ne ""} {
- $self Refresh $refreshheader
+
+ set O(myStyleCount) 0
+ }
+
+ if {$O(myDocumentHandle) ne $handle} {
+ if {$O(myDocumentHandle) ne ""} {
+ $O(myDocumentHandle) release
}
+ set O(myDocumentHandle) $handle
}
- switch -- $myMimetype {
- html {$self HtmlCallback $handle $final $data}
- image {$self ImageCallback $handle $final $data}
+ switch -- $O(myMimetype) {
+ text {$me TextCallback $handle $final $data}
+ html {$me HtmlCallback $handle $final $data}
+ image {$me ImageCallback $handle $final $data}
}
- set myChangeEncodingOk 0
if {$final} {
- $handle destroy
- if {$myStorevisitedDone == 0 && $options(-storevisitedcmd) ne ""} {
- set myStorevisitedDone 1
- eval $options(-storevisitedcmd) 1
+ if {$O(myStorevisitedDone) == 0 && $O(-storevisitedcmd) ne ""} {
+ set O(myStorevisitedDone) 1
+ eval $O(-storevisitedcmd) 1
}
+ $me MightBeComplete
}
}
- method EncodingConvertfrom {encoding input} {
- set utf8 $input
- if {[catch {
- set utf8 [encoding convertfrom $encoding $utf8]
- } msg]} {
- tk_dialog .dialog "Unknown Encoding" $msg error 0 Ok
+ proc TextCallback {me handle isFinal data} {
+ upvar #0 $me O
+ set z [string map {< < > >} $data]
+ if {$isFinal} {
+ $O(myHtml) parse -final $data
+ } else {
+ $O(myHtml) parse $data
}
- return $utf8
}
- method HtmlCallback {handle isFinal data} {
- if {$myEncoding eq ""} {
- $myHtml parse $data
- }
- if {$myEncoding ne ""} {
- # This occurs when the document author has specified an encoding
- # using an HTML <META> element. In this case it's now too late to
- # modify the stream encoding, so accumulate the whole HTML document
- # in variable $myEncodedDocument before translating and passing
- # it to the Tkhtml widget.
- #
- # Note: At the moment we only handle such <META> constructs in
- # the first "chunk" of HTML parsed. Chunksize is determined by
- # the ::hv3::download object (see hv3_request.tcl).
- #
- $myHtml reset
- append myEncodedDocument $data
- }
+ proc HtmlCallback {me handle isFinal data} {
+ upvar #0 $me O
+ $O(myFrameLog) loghtml $data
if {$isFinal} {
- if {$myEncoding ne ""} {
- set utf8 [$self EncodingConvertfrom $myEncoding $myEncodedDocument]
- set myEncodedDocument ""
- $myHtml parse -final $utf8
- } else {
- $myHtml parse -final {}
- }
+ $O(html) parse -final $data
+ } else {
+ $O(html) parse $data
}
- $self goto_fragment
+ $me goto_fragment
}
- method ImageCallback {handle isFinal data} {
- append myImageData $data
+ proc ImageCallback {me handle isFinal data} {
+ upvar #0 $me O
+ append O(myImageData) $data
if {$isFinal} {
- set img [image create photo -data $myImageData]
- set myImageData ""
- set imagecmd [$myHtml cget -imagecmd]
- $myHtml configure -imagecmd [list ::hv3::ReturnWithArgs $img]
- $myHtml parse -final { <img src="unused"> }
- $myHtml _force
- $myHtml configure -imagecmd $imagecmd
+ set img [image create photo -data $O(myImageData)]
+ set O(myImageData) ""
+ set imagecmd [$O(myHtml) cget -imagecmd]
+ $O(myHtml) configure -imagecmd [list ::hv3::ReturnWithArgs $img]
+ $O(myHtml) parse -final { <img src="unused"> }
+ $O(myHtml) _force
+ $O(myHtml) configure -imagecmd $imagecmd
}
}
- method Formcmd {method node uri querytype encdata} {
- set cmd [linsert [$self cget -targetcmd] end $node]
+ proc Formcmd {me method node uri querytype encdata} {
+ upvar #0 $me O
+ set cmd [linsert [$me cget -targetcmd] end $node]
[eval $cmd] Formcmd2 $method $uri $querytype $encdata
}
- method Formcmd2 {method uri querytype encdata} {
- # puts "Formcmd $method $uri $querytype $encdata"
- set full_uri [$self resolve_uri $uri]
+ proc Formcmd2 {me method uri querytype encdata} {
+ upvar #0 $me O
+ puts "Formcmd $method $uri $querytype $encdata"
+
+ set uri_obj [::tkhtml::uri [$me resolve_uri $uri]]
- event generate $win <<Goto>>
+ event generate $O(win) <<Goto>>
- set handle [::hv3::download %AUTO% -mimetype text/html]
- set myMimetype ""
- set referer [$self uri get]
+ set handle [::hv3::request %AUTO% -mimetype text/html]
+ set O(myMimetype) ""
+ set referer [$me uri get]
$handle configure \
- -incrscript [list $self documentcallback $handle $referer 1 0] \
- -finscript [list $self documentcallback $handle $referer 1 1] \
+ -incrscript [list $me documentcallback $handle $referer 1 0] \
+ -finscript [list $me documentcallback $handle $referer 1 1] \
-requestheader [list Referer $referer] \
if {$method eq "post"} {
- $handle configure -uri $full_uri -postdata $encdata
+ $handle configure -uri [$uri_obj get] -postdata $encdata
$handle configure -enctype $querytype
$handle configure -cachecontrol normal
} else {
- $handle configure -uri "${full_uri}?${encdata}"
- $handle configure -cachecontrol $myCacheControl
- }
- $self makerequest $handle
+ $uri_obj load "?$encdata"
+ $handle configure -uri [$uri_obj get]
+ $handle configure -cachecontrol $O(myCacheControl)
+ }
+ $uri_obj destroy
+ $me makerequest $handle
# Grab the keyboard focus for this widget. This is so that after
# the form is submitted the arrow keys and PgUp/PgDown can be used
# to scroll the main display.
#
- focus [$self html]
+ focus [$me html]
}
- method seturi {uri} {
- $myUri load $uri
- $myBase load [$myUri get]
+ proc seturi {me uri} {
+ upvar #0 $me O
+ $O(myUri) load $uri
+ $O(myBase) load [$O(myUri) get]
}
#--------------------------------------------------------------------------
@@ -1766,15 +2017,16 @@ snit::widget ::hv3::hv3 {
# Method Delegate
# --------------------------------------------
# goto N/A
- # xview $myHtml
- # yview $myHtml
+ # xview $O(myHtml)
+ # yview $O(myHtml)
# html N/A
# hull N/A
#
- method dom {} {
- if {$options(-dom) eq ""} { return ::hv3::ignore_script }
- return $options(-dom)
+ proc dom {me} {
+ upvar #0 $me O
+ if {$O(myDom) eq ""} { return ::hv3::ignore_script }
+ return $O(myDom)
}
#--------------------------------------------------------------------
@@ -1788,6 +2040,7 @@ snit::widget ::hv3::hv3 {
# -cachecontrol "normal"|"relax-transparency"|"no-cache"
# -nosave
# -referer URI
+ # -history_handle DOWNLOAD-HANDLE
#
# The -cachecontrol option (default "normal") specifies the value
# that will be used for all ::hv3::request objects issued as a
@@ -1796,9 +2049,10 @@ snit::widget ::hv3::hv3 {
# Normally, a <<SaveState>> event is generated. If -nosave is specified,
# this is suppressed.
#
- method goto {uri args} {
+ proc goto {me uri args} {
+ upvar #0 $me O
- set myGotoCalled 1
+ set O(myGotoCalled) 1
# Process the argument switches. Local variable $cachecontrol
# is set to the effective value of the -cachecontrol option.
@@ -1807,6 +2061,7 @@ snit::widget ::hv3::hv3 {
set savestate 1
set cachecontrol normal
set referer ""
+ set history_handle ""
for {set iArg 0} {$iArg < [llength $args]} {incr iArg} {
switch -- [lindex $args $iArg] {
@@ -1821,6 +2076,10 @@ snit::widget ::hv3::hv3 {
-nosave {
set savestate 0
}
+ -history_handle {
+ incr iArg
+ set history_handle [lindex $args $iArg]
+ }
default {
error "Bad option \"[lindex $args $iArg]\" to \[::hv3::hv3 goto\]"
}
@@ -1831,222 +2090,275 @@ snit::widget ::hv3::hv3 {
# pass it to the current running DOM implementation instead of loading
# anything into the current browser.
if {[string match -nocase javascript:* $uri]} {
- if {$options(-dom) ne ""} {
- $options(-dom) javascript $self [string range $uri 11 end]
+ if {$O(myDom) ne ""} {
+ $O(myDom) javascript [string range $uri 11 end]
}
return
}
- set myCacheControl $cachecontrol
+ set O(myCacheControl) $cachecontrol
- set current_uri [$myUri get_no_fragment]
- set uri_obj [::tkhtml::uri [$self resolve_uri $uri]]
+ set current_uri [$O(myUri) get_no_fragment]
+ set uri_obj [::tkhtml::uri [$me resolve_uri $uri]]
set full_uri [$uri_obj get_no_fragment]
set fragment [$uri_obj fragment]
# Generate the <<Goto>> event.
- event generate $win <<Goto>>
+ event generate $O(win) <<Goto>>
if {$full_uri eq $current_uri && $cachecontrol ne "no-cache"} {
# Save the current state in the history system. This ensures
# that back/forward controls work when navigating between
# different sections of the same document.
if {$savestate} {
- event generate $win <<SaveState>>
+ event generate $O(win) <<SaveState>>
}
- $myUri load $uri
+ $O(myUri) load $uri
# If the cache-mode is "relax-transparency", then the history
# system is controlling this document load. It has already called
# [seek_to_yview] to provide a seek offset.
if {$cachecontrol ne "relax-transparency"} {
if {$fragment eq ""} {
- $self seek_to_yview 0.0
+ $me seek_to_yview 0.0
} else {
- $self seek_to_fragment $fragment
+ $me seek_to_fragment $fragment
}
}
- $self goto_fragment
+ $me goto_fragment
- $self set_location_var
- return [$myUri get]
+ $me SetLocationVar
+ return [$O(myUri) get]
}
# Abandon any pending requests
- if {$myStorevisitedDone == 0 && $options(-storevisitedcmd) ne ""} {
- set myStorevisitedDone 1
- eval $options(-storevisitedcmd) $savestate
- }
- $self stop
-
- # Base the expected type on the extension of the filename in the
- # URI, if any. If we can't figure out an expected type, assume
- # text/html. The protocol handler may override this anyway.
- set mimetype text/html
- set path [$uri_obj path]
- if {[regexp {\.([A-Za-z0-9]+)$} $path dummy ext]} {
- switch -- [string tolower $ext] {
- jpg { set mimetype image/jpeg }
- jpeg { set mimetype image/jpeg }
- gif { set mimetype image/gif }
- png { set mimetype image/png }
- gz { set mimetype application/gzip }
- gzip { set mimetype application/gzip }
- zip { set mimetype application/gzip }
- kit { set mimetype application/binary }
+ if {$O(myStorevisitedDone) == 0 && $O(-storevisitedcmd) ne ""} {
+ set O(myStorevisitedDone) 1
+ eval $O(-storevisitedcmd) $savestate
+ }
+ $me stop
+ set O(myMimetype) ""
+
+ if {$history_handle eq ""} {
+ # Base the expected type on the extension of the filename in the
+ # URI, if any. If we can't figure out an expected type, assume
+ # text/html. The protocol handler may override this anyway.
+ set mimetype text/html
+ set path [$uri_obj path]
+ if {[regexp {\.([A-Za-z0-9]+)$} $path dumO(my) ext]} {
+ switch -- [string tolower $ext] {
+ jpg { set mimetype image/jpeg }
+ jpeg { set mimetype image/jpeg }
+ gif { set mimetype image/gif }
+ png { set mimetype image/png }
+ gz { set mimetype application/gzip }
+ gzip { set mimetype application/gzip }
+ zip { set mimetype application/gzip }
+ kit { set mimetype application/binary }
+ }
}
+
+ # Create a download request for this resource. We expect an html
+ # document, but at this juncture the URI may legitimately refer
+ # to kind of resource.
+ #
+ set handle [::hv3::request %AUTO% \
+ -uri [$uri_obj get] \
+ -mimetype $mimetype \
+ -cachecontrol $O(myCacheControl) \
+ -hv3 $me \
+ ]
+ $handle configure \
+ -incrscript [list $me documentcallback $handle $referer $savestate 0]\
+ -finscript [list $me documentcallback $handle $referer $savestate 1]
+ if {$referer ne ""} {
+ $handle configure -requestheader [list Referer $referer]
+ }
+
+ $me makerequest $handle
+ } else {
+ # The history system has supplied the data to load into the widget.
+ # Use $history_handle instead of creating a new request.
+ #
+ $history_handle reference
+ $me documentcallback $history_handle $referer $savestate 1 [
+ $history_handle data
+ ]
+ $me goto_fragment
}
-
- # Create a download request for this resource. We expect an html
- # document, but at this juncture the URI may legitimately refer
- # to kind of resource.
- #
- set handle [::hv3::download %AUTO% \
- -uri [$uri_obj get] \
- -mimetype $mimetype \
- -cachecontrol $myCacheControl \
- -hv3 $self \
- ]
- set myMimetype ""
- $handle configure \
- -incrscript [list $self documentcallback $handle $referer $savestate 0]\
- -finscript [list $self documentcallback $handle $referer $savestate 1]
- if {$referer ne ""} {
- $handle configure -requestheader [list Referer $referer]
- }
-
- $self makerequest $handle
$uri_obj destroy
}
# Abandon all currently pending downloads. This method is
# part of the public interface.
- method stop {} {
- foreach dl $myCurrentDownloads {
- $dl finish
+ #
+ proc stop {me } {
+ upvar #0 $me O
+
+ foreach dl $O(myActiveHandles) {
+ if {$dl eq $O(myDocumentHandle)} {
+ set O(myDocumentHandle) ""
+ }
+ $dl release
}
- if {$myStorevisitedDone == 0 && $options(-storevisitedcmd) ne ""} {
- set myStorevisitedDone 1
- eval $options(-storevisitedcmd) 1
+
+ if {$O(myStorevisitedDone) == 0 && $O(-storevisitedcmd) ne ""} {
+ set O(myStorevisitedDone) 1
+ eval $O(-storevisitedcmd) 1
}
}
- method reset {isSaveState} {
+ proc InternalReset {me } {
+ upvar #0 $me O
+
+ $O(myFrameLog) clear
+
+ foreach m [list \
+ $O(myMouseManager) $O(myFormManager) \
+ $O(mySelectionManager) $O(myHyperlinkManager) \
+ ] {
+ if {$m ne ""} {$m reset}
+ }
+ $O(html) reset
+ $O(myHtml) configure -scrollbarpolicy $O(-scrollbarpolicy)
+
+ catch {$O(myDom) destroy}
+ if {$O(-enablejavascript)} {
+ set O(myDom) [::hv3::dom %AUTO% $me]
+ $O(myHtml) handler script script [list $O(myDom) script]
+ $O(myHtml) handler script noscript ::hv3::ignore_script
+ } else {
+ set O(myDom) ""
+ $O(myHtml) handler script script ::hv3::ignore_script
+ $O(myHtml) handler script noscript {}
+ }
+ $O(myMouseManager) configure -dom $O(myDom)
+ }
+
+ proc reset {me isSaveState} {
+ upvar #0 $me O
# Clear the "onload-event-fired" flag
- set myOnloadFired 0
- set myStorevisitedDone 0
+ set O(myOnloadFired) 0
+ set O(myStorevisitedDone) 0
# Cancel any pending "Refresh" event.
- if {$myRefreshEventId ne ""} {
- after cancel $myRefreshEventId
- set myRefreshEventId ""
+ if {$O(myRefreshEventId) ne ""} {
+ after cancel $O(myRefreshEventId)
+ set O(myRefreshEventId) ""
}
# Generate the <<Reset>> and <<SaveState> events.
- if {!$myFirstReset && $isSaveState} {
- event generate $win <<SaveState>>
+ if {!$O(myFirstReset) && $isSaveState} {
+ event generate $O(win) <<SaveState>>
}
- set myFirstReset 0
- event generate $win <<Reset>>
+ set O(myFirstReset) 0
- set myTitleVar ""
- set myEncoding ""
- set myEncodedDocument ""
+ set O(myTitleVar) ""
+ set O(myQuirksmode) unknown
- foreach m [list \
- $myMouseManager $myFormManager \
- $mySelectionManager $myHyperlinkManager \
- ] {
- if {$m ne ""} {$m reset}
- }
- $myHtml reset
+ $me InternalReset
+ }
- if {$options(-dom) ne ""} {
- $options(-dom) clear_window $self
- }
+ proc configure-enableimages {me} {
+ upvar #0 $me O
- set myQuirksmode unknown
+ # The -enableimages switch. If false, configure an empty string
+ # as the html widget's -imagecmd option. If true, configure the
+ # same option to call the [Imagecmd] method of this mega-widget.
+ #
+ # We used to reload the frame contents here. But it turns out
+ # that is really inconvenient. If the user wants to reload the
+ # document the reload button is right there anyway.
+ #
+ if {$O(-enableimages)} {
+ $O(myHtml) configure -imagecmd [list $me Imagecmd]
+ } else {
+ $O(myHtml) configure -imagecmd ""
+ }
}
- method SetOption {option value} {
- set options($option) $value
- switch -- $option {
- -enableimages {
- # The -enableimages switch. If false, configure an empty string
- # as the html widget's -imagecmd option. If true, configure the
- # same option to call the [Imagecmd] method of this mega-widget.
- #
- # We used to reload the frame contents here. But it turns out
- # that is really inconvenient. If the user wants to reload the
- # document the reload button is right there anyway.
- #
- if {$value} {
- $myHtml configure -imagecmd [list $self Imagecmd]
- } else {
- $myHtml configure -imagecmd ""
- }
- }
+ proc configure-enablejavascript {me} {
+ upvar #0 $me O
+ if {!$O(-enablejavascript)} {
+ catch {$O(myDom) destroy}
+ set O(myDom) ""
+ $O(myHtml) handler script script ::hv3::ignore_script
+ $O(myHtml) handler script noscript {}
+ $O(myMouseManager) configure -dom ""
}
}
- method SetDom {option value} {
- set options(-dom) $value
- $myMouseManager configure -dom $options(-dom)
- if {$options(-dom) ne ""} {
- $myHtml handler script script [list $options(-dom) script $self]
- $myHtml handler script noscript [list $options(-dom) noscript $self]
- $options(-dom) make_window $self
+ proc pending {me} {
+ upvar #0 $me O
+ return [llength $O(myActiveHandles)]
+ }
+ proc html {me args} {
+ upvar #0 $me O
+ if {[llength $args]>0} {
+ eval [$O(myHtml) widget] $args
} else {
- $myHtml handler script script ::hv3::ignore_script
- $myHtml handler script noscript {}
+ $O(myHtml) widget
}
}
+ proc hull {me} {
+ upvar #0 $me O
+ return $O(hull)
+ }
+ proc win {me} {
+ upvar #0 $me O
+ return $O(win)
+ }
+ proc me {me} { return $me }
- method pending {} { return [llength $myCurrentDownloads] }
- method html {} { return [$myHtml widget] }
- method hull {} { return $hull }
-
- method yview {args} {
- eval $myHtml yview $args
+ proc yview {me args} {
+ upvar #0 $me O
+ eval $O(html) yview $args
}
- method xview {args} {
- eval $myHtml xview $args
+ proc xview {me args} {
+ upvar #0 $me O
+ eval $O(html) xview $args
}
- method javascriptlog {args} {
- if {$options(-dom) ne ""} {
- eval $options(-dom) javascriptlog $args
+ proc javascriptlog {me args} {
+ upvar #0 $me O
+ if {$O(-dom) ne ""} {
+ eval $O(-dom) javascriptlog $args
}
}
- # The option to display images (default true).
- option -enableimages -default 1 -configuremethod SetOption
-
- option -scrollbarpolicy -default auto
+ #proc unknown {method me args} {
+ # puts "UNKNOWN: $me $method $args"
+ #upvar #0 $me O
+ #uplevel 3 [list eval $O(myHtml) $method $args]
+ #}
+ #namespace unknown unknown
- option -locationvar -default ""
- option -pendingcmd -default ""
- option -downloadcmd -default ""
- option -requestcmd -default ""
- delegate option -isvisitedcmd to myHyperlinkManager
- delegate option -targetcmd to myHyperlinkManager
+ proc node {me args} {
+ upvar #0 $me O
+ eval $O(myHtml) node $args
+ }
- # Delegated public methods
- delegate method selected to mySelectionManager
- delegate method * to myHtml
+ set DelegateOption(-isvisitedcmd) myHyperlinkManager
+ set DelegateOption(-targetcmd) myHyperlinkManager
# Standard scrollbar and geometry stuff is delegated to the html widget
- delegate option -xscrollcommand to myHtml
- delegate option -yscrollcommand to myHtml
- delegate option -width to myHtml
- delegate option -height to myHtml
+ #set DelegateOption(-xscrollcommand) myHtml
+ #set DelegateOption(-yscrollcommand) myHtml
+ set DelegateOption(-width) myHtml
+ set DelegateOption(-height) myHtml
# Display configuration options implemented entirely by the html widget
- delegate option -fonttable to myHtml
- delegate option -fontscale to myHtml
- delegate option -zoom to myHtml
- delegate option -forcefontmetrics to myHtml
+ set DelegateOption(-fonttable) myHtml
+ set DelegateOption(-fontscale) myHtml
+ set DelegateOption(-zoom) myHtml
+ set DelegateOption(-forcefontmetrics) myHtml
+}
+
+::hv3::make_constructor ::hv3::hv3 [list ::hv3::scrolled html]
+
+proc ::hv3::release_handle {handle args} {
+ $handle release
}
proc ::hv3::ignore_script {args} {}
diff --git a/hv/hv3_bookmarks.tcl b/hv/hv3_bookmarks.tcl
index 22680e3..eea3f1a 100644
--- a/hv/hv3_bookmarks.tcl
+++ b/hv/hv3_bookmarks.tcl
@@ -1,16 +1,7 @@
-namespace eval hv3 { set {version($Id: hv3_bookmarks.tcl,v 1.8 2007/10/06 10:29:35 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3_bookmarks.tcl,v 1.22 2008/02/10 07:50:01 danielk1977 Exp $)} 1 }
namespace eval ::hv3::bookmarks {
- # Test if fts3 is available. There must be a better way to do this
- proc test_for_fts3 {} {
- catch {::hv3::sqlitedb eval {
- CREATE VIRTUAL TEMP TABLE fts3test USING fts3(a);
- DROP TABLE fts3test;
- }} msg
- puts $msg
- }
-
set INSTRUCTIONS {
BASICS:
@@ -83,6 +74,31 @@ pressing enter.
proc noop {args} {}
+ proc have_fts3 {} {
+ if {[info exists ::hv3::have_fts3]} {return $::hv3::have_fts3}
+ # Test if fts3 is present.
+ #
+ set ::hv3::have_fts3 [expr {![catch {::hv3::sqlitedb eval {
+ SELECT * FROM bm_fulltext2 WHERE 0
+ }} msg]}]
+ if {$::hv3::have_fts3 == 0} {
+ puts "WARNING: fts3 not loaded ($msg)"
+ set ::hv3::bookmarks::save_snapshot_variable 0
+ }
+ }
+
+ proc ensure_initialized {} {
+ set db ::hv3::sqlitedb
+ $db transaction {
+ if {![$db exists {select * from sqlite_master
+ where name = 'bm_bookmark2'}]} {
+ puts stderr "initializing bookmark database.."
+ initialise_database
+ }
+ }
+ have_fts3
+ }
+
proc initialise_database {} {
set rc [catch {
::hv3::sqlitedb eval {
@@ -91,6 +107,9 @@ pressing enter.
);
}
}]
+
+ have_fts3
+
set rc [catch {
::hv3::sqlitedb eval {
@@ -159,6 +178,8 @@ pressing enter.
db_store_new_bookmark 0 $A $B $zDesc $iSnapshot $zSnapshot $zSnapshotText
}
}
+ } else {
+ puts stderr "Can't create bookmark tables! $msg"
}
if {$::hv3::have_fts3} {
@@ -189,26 +210,27 @@ pressing enter.
}
proc init {hv3} {
- initialise_database
+ set frames [[$hv3 win] child_frames]
+ set browser [[winfo parent [$hv3 win]] browser]
- set frames [[winfo parent [winfo parent $hv3]] child_frames]
set tree_hv3 [[lindex $frames 0] hv3]
set html_hv3 [[lindex $frames 1] hv3]
- set browser [[winfo parent $hv3] browser]
- set controller [winfo parent $html_hv3].controller
+ #set controller [winfo parent [$html_hv3 win]].controller
+ set controller [$html_hv3 win].controller
set treewidget [$tree_hv3 html].treewidget
controller $controller $browser $html_hv3 $treewidget
treewidget $treewidget $browser $controller
- pack $controller -before $html_hv3 -side top -fill x
+ #pack $controller -before [$html_hv3 win] -side top -fill x
+ grid configure $controller -row 0 -column 0 -columnspan 2 -sticky ew
place $treewidget -x 0.0 -y 0.0 -relwidth 1.0 -relheight 1.0
$treewidget populate_tree
focus ${controller}.filter
- foreach node [$html_hv3 search applet] {
+ foreach node [$html_hv3 html search applet] {
$controller applet $node
}
}
@@ -341,7 +363,7 @@ pressing enter.
::snit::widget treewidget {
- # The browser (::hv3::browser_toplevel) containing this frameset
+ # The browser (::hv3::browser) containing this frameset
#
variable myBrowser
@@ -376,7 +398,7 @@ pressing enter.
}
method click_new_bookmark {} {
${win}.newbookmark configure -state normal
- ::hv3::bookmarks::new_bookmark $self
+ ::hv3::bookmarks::new_bookmark ""
}
method click_importexport {} {
@@ -485,6 +507,9 @@ pressing enter.
$menu add command \
-label "Import Document Tree" \
-command [list ::hv3::bookmarks::import_tree]
+ $menu add command \
+ -label "Index Hv3 DOM Reference" \
+ -command [list ::hv3::bookmarks::import_dom]
::hv3::button ${win}.newfolder \
-text "New Folder" \
-command [list $self click_new_folder]
@@ -535,7 +560,8 @@ pressing enter.
}
method seek_tree {} {
- set C ${win}.canvas.widget
+ #set C ${win}.canvas.widget
+ set C ${win}.canvas
foreach {page pageid} [$myController current] {}
if {$page ne "folder" && $page ne "snapshot"} return
@@ -556,7 +582,8 @@ pressing enter.
}
method populate_tree {{isAutoOpen 0}} {
- set C ${win}.canvas.widget
+ #set C ${win}.canvas.widget
+ set C ${win}.canvas
set y 20
set x 10
@@ -648,7 +675,7 @@ pressing enter.
}
method set_drag_tag {item} {
- set C ${win}.canvas
+ set C ${win}.canvas.widget
set tag1 [lindex [$C itemcget $item -tags] 0]
if {[string range $tag1 0 7] eq "bookmark" ||
[string range $tag1 0 5] eq "folder"
@@ -669,7 +696,7 @@ pressing enter.
}
method motion_event {x y} {
- set C ${win}.canvas
+ set C ${win}.canvas.widget
set x [$C canvasx $x]
set y [$C canvasy $y]
set hover [$C find overlapping $x $y $x $y]
@@ -1086,7 +1113,7 @@ pressing enter.
proc html_to_text {zHtml} {
.tmphv3 reset
.tmphv3 parse -final $zHtml
- return [.tmphv3 text text]
+ return [.tmphv3 html text text]
}
proc rebuild_fts_database {} {
@@ -1278,7 +1305,7 @@ pressing enter.
set myTree $tree
set myBrowser $browser
- $myHv3 handler node applet [mymethod applet]
+ $myHv3 html handler node applet [mymethod applet]
set searchcmd [subst -nocommands {
$myHv3 goto "home://bookmarks/search/[${win}.filter get]"
@@ -1543,7 +1570,7 @@ pressing enter.
if {$::hv3::bookmarks::save_snapshot_variable && $hv3 ne ""} {
set has_snapshot 1
set snapshot [create_snapshot $hv3]
- set snapshot_text [$hv3 text text]
+ set snapshot_text [$hv3 html text text]
}
set bookmarkid [
db_store_new_bookmark 0 $caption $uri $desc $has_snapshot $snapshot $snapshot_text
@@ -1685,13 +1712,9 @@ pressing enter.
bind .new.uri <KeyPress-Return> {.new.save invoke}
}
- proc new_bookmark {treewidget} {
- set hv3 ""
- set dialog_version 2
- if {[$treewidget info type] eq "::hv3::hv3"} {
- set hv3 $treewidget
- set dialog_version 1
- }
+ proc new_bookmark {hv3} {
+ ::hv3::bookmarks::ensure_initialized
+ set dialog_version [expr {($hv3 eq "") ? 2 : 1}]
create_bookmark_dialog $dialog_version
.new.save configure \
@@ -1846,12 +1869,7 @@ pressing enter.
}
if {$zDirname eq ""} return
- set hv3 [::hv3::hv3 .tmphv3]
- set protocol [::hv3::protocol %AUTO%]
- $hv3 handler node object ""
- $hv3 handler node frameset ""
- $hv3 handler node embed ""
- $hv3 configure -requestcmd [list $protocol requestcmd]
+ setup_tmphv3
toplevel .import
::hv3::label .import.label -width 60 -anchor w
@@ -1869,8 +1887,8 @@ pressing enter.
import_dir $iFolder $zDirname
}} msg]
- destroy $hv3
- $protocol destroy
+ destroy .tmphv3
+ tmpprotocol destroy
destroy .import
if {$rc == 0} {
@@ -1900,6 +1918,25 @@ pressing enter.
set iRes
}
+ proc import_local_uri {iFolder zUri} {
+ set zCaption $zUri
+ set zDesc ""
+ set zSnapshot ""
+
+ set hv3 .tmphv3
+ $hv3 reset 0
+ $hv3 goto $zUri
+ set zSnapshot [create_snapshot $hv3]
+
+ set titlenode [$hv3 html search title]
+ if {$titlenode ne "" && [llength [$titlenode children]]>0} {
+ set zCaption [[lindex [$titlenode children] 0] text]
+ }
+
+ set text [$hv3 html text text]
+ db_store_new_bookmark $iFolder $zCaption $zUri $zDesc 2 $zSnapshot $text
+ }
+
proc import_dir {iFolder dir} {
set obj [::tkhtml::uri file://]
set hv3 .tmphv3
@@ -1910,26 +1947,14 @@ pressing enter.
error "Operation cancelled by user"
}
incr ::hv3::bookmarks::files_imported
- .import.label configure -text "Importing file ${::hv3::bookmarks::files_imported}/${::hv3::bookmarks::files_to_import} ($f)"
+ set T "Importing file ${::hv3::bookmarks::files_imported}/"
+ append T "${::hv3::bookmarks::files_to_import} ($f)"
+
+ .import.label configure -text $T
update
- set zCaption $f
- set zDesc ""
- set zUri ""
- set zSnapshot ""
set zUri [$obj resolve $f]
-
- $hv3 reset 0
- $hv3 goto $zUri
- set zSnapshot [create_snapshot $hv3]
-
- set titlenode [$hv3 search title]
- if {$titlenode ne "" && [llength [$titlenode children]]>0} {
- set zCaption [[lindex [$titlenode children] 0] text]
- }
-
- set text [[$hv3 html] text text]
- db_store_new_bookmark $iFolder $zCaption $zUri $zDesc 2 $zSnapshot $text
+ import_local_uri $iFolder $zUri
}
$obj destroy
@@ -1940,5 +1965,71 @@ pressing enter.
}
}
}
+
+ proc import_dom {} {
+ setup_tmphv3
+ ::hv3::sqlitedb transaction {
+ set iFolder [db_store_new_folder 0 "Hv3 DOM Reference"]
+ set iTreeFolder [db_store_new_folder $iFolder "DOM Tree Objects"]
+ set iEventFolder [db_store_new_folder $iFolder "DOM Event Objects"]
+ set iContFolder [db_store_new_folder $iFolder "DOM Container Objects"]
+ set iStyleFolder [db_store_new_folder $iFolder "DOM Style Objects"]
+ set iXMLFolder [db_store_new_folder $iFolder "XMLHttpRequest Objects"]
+ set iNSFolder [db_store_new_folder $iFolder "Compatibility Objects"]
+ set iElemFolder [
+ db_store_new_folder $iTreeFolder "HTMLElement Sub-classes"
+ ]
+
+ #set fname [file normalize [file join $::hv3::scriptdir dom_events.html]]
+ #import_local_uri $iFolder file://$fname
+
+ if {[llength [info commands ::hv3::DOM::docs::HTMLElement]] == 0} {
+ ::hv3::dom_init 1
+ }
+
+ foreach cmd [lsort [info commands ::hv3::DOM::docs::*]] {
+ set localcmd [string range $cmd [expr {[string last : $cmd]+1}] end]
+ set folder $iFolder
+
+ if {[string match HTML?*Element $localcmd]} {
+ set folder $iElemFolder
+ } elseif { [string match *XML* $localcmd] } {
+ set folder $iXMLFolder
+ } elseif { [string match *Event* $localcmd] } {
+ set folder $iEventFolder
+ } elseif { [lsearch \
+ {History Location Screen Window Navigator FramesList} $localcmd]>=0
+ } {
+ set folder $iNSFolder
+ } elseif { [lsearch \
+ {HTMLDocument HTMLElement NodePrototype Text} $localcmd]>=0
+ } {
+ set folder $iTreeFolder
+ } elseif { [lsearch \
+ {NodeListC NodeListS HTMLCollectionC HTMLCollectionS} $localcmd]>=0
+ } {
+ set folder $iContFolder
+ } elseif { [lsearch {CSSStyleDeclaration} $localcmd]>=0 } {
+ set folder $iStyleFolder
+ }
+
+ import_local_uri $folder home://dom/$localcmd
+ }
+ }
+ destroy .tmphv3
+ tmpprotocol destroy
+ refresh_gui
+ }
+
+ proc setup_tmphv3 {} {
+ set hv3 [::hv3::hv3 .tmphv3]
+ set protocol [::hv3::protocol ::tmpprotocol]
+ ::hv3::home_scheme_init $hv3 $protocol
+ $hv3 html handler node object ""
+ $hv3 html handler node frameset ""
+ $hv3 html handler node embed ""
+ $hv3 configure -requestcmd [list $protocol requestcmd]
+ }
+
}
diff --git a/hv/hv3_browser.tcl b/hv/hv3_browser.tcl
new file mode 100644
index 0000000..461a4b9
--- /dev/null
+++ b/hv/hv3_browser.tcl
@@ -0,0 +1,913 @@
+
+
+package require sqlite3
+package require Tkhtml 3.0
+
+proc sourcefile {file} [string map \
+ [list %HV3_DIR% [file dirname [info script]]] \
+{
+ return [file join {%HV3_DIR%} $file]
+}]
+
+source [sourcefile snit.tcl]
+source [sourcefile hv3_widgets.tcl]
+source [sourcefile hv3_notebook.tcl]
+source [sourcefile hv3_db.tcl]
+source [sourcefile hv3_home.tcl]
+source [sourcefile hv3.tcl]
+source [sourcefile hv3_prop.tcl]
+source [sourcefile hv3_log.tcl]
+source [sourcefile hv3_http.tcl]
+source [sourcefile hv3_download.tcl]
+source [sourcefile hv3_frameset.tcl]
+source [sourcefile hv3_polipo.tcl]
+source [sourcefile hv3_icons.tcl]
+source [sourcefile hv3_history.tcl]
+source [sourcefile hv3_bookmarks.tcl]
+source [sourcefile hv3_bugreport.tcl]
+source [sourcefile hv3_debug.tcl]
+source [sourcefile hv3_dom.tcl]
+source [sourcefile hv3_object.tcl]
+
+#--------------------------------------------------------------------------
+# Widget ::hv3::browser_frame
+#
+# This mega widget is instantiated for each browser frame (a regular
+# html document has one frame, a <frameset> document may have more
+# than one). This widget is not considered reusable - it is designed
+# for the web browser only. The following application-specific
+# functionality is added to ::hv3::hv3:
+#
+# * The -statusvar option
+# * The right-click menu
+# * Overrides the default -targetcmd supplied by ::hv3::hv3
+# to respect the "target" attribute of <a> and <form> elements.
+#
+# For more detail on handling the "target" attribute, see HTML 4.01.
+# In particular the following from appendix B.8:
+#
+# 1. If the target name is a reserved word as described in the
+# normative text, apply it as described.
+# 2. Otherwise, perform a depth-first search of the frame hierarchy
+# in the window that contained the link. Use the first frame whose
+# name is an exact match.
+# 3. If no such frame was found in (2), apply step 2 to each window,
+# in a front-to-back ordering. Stop as soon as you encounter a frame
+# with exactly the same name.
+# 4. If no such frame was found in (3), create a new window and
+# assign it the target name.
+#
+# Hv3 currently only implements steps 1 and 2.
+#
+namespace eval ::hv3::browser_frame {
+
+ proc new {me browser args} {
+ upvar #0 $me O
+
+ # The name of this frame (as specified by the "name" attribute of
+ # the <frame> element).
+ set O(-name) ""
+ set O(oldname) ""
+
+ # If this [::hv3::browser_frame] is used as a replacement object
+ # for an <iframe> element, then this option is set to the Tkhtml3
+ # node-handle for that <iframe> element.
+ #
+ set O(-iframe) ""
+
+ set O(-statusvar) ""
+
+ set O(myBrowser) $browser
+ eval $me configure $args
+
+ set O(myNodeList) "" ;# Current nodes under the pointer
+ set O(myX) 0 ;# Current location of pointer
+ set O(myY) 0 ;# Current location of pointer
+
+ set O(myPositionId) "" ;# See sub-command [positionid]
+
+ # If "Copy Link Location" has been selected, store the selected text
+ # (a URI) in set $O(myCopiedLinkLocation).
+ set O(myCopiedLinkLocation) ""
+
+ #set O(myHv3) [::hv3::hv3 $O(win).hv3]
+ #pack $O(myHv3) -expand true -fill both
+ set O(myHv3) $O(hull)
+ $O(myHv3) configure -frame $me
+
+ ::hv3::the_visited_db init $O(myHv3)
+
+ catch {$O(myHv3) configure -fonttable $::hv3::fontsize_table}
+
+ # Create bindings for motion, right-click and middle-click.
+ $O(myHv3) Subscribe motion [list $me motion]
+ bind $O(win) <3> [list $me rightclick %x %y %X %Y]
+ #bind $O(win) <2> [list $me goto_selection]
+ bind $O(win) <2> [list $me middleclick %x %y]
+
+ # When the hyperlink menu "owns" the selection (happens after
+ # "Copy Link Location" is selected), invoke method
+ # [GetCopiedLinkLocation] with no arguments to retrieve it.
+
+ # Register a handler command to handle <frameset>.
+ set html [$O(myHv3) html]
+ $html handler node frameset [list ::hv3::frameset_handler $me]
+
+ # Register handler commands to handle <object> and kin.
+ $html handler node object [list hv3_object_handler $O(myHv3)]
+ $html handler node embed [list hv3_object_handler $O(myHv3)]
+
+ $html handler node iframe [list ::hv3::iframe_handler $me]
+ $html handler attribute iframe [list ::hv3::iframe_attr_handler $me]
+
+ # Add this object to the browsers frames list. It will be removed by
+ # the destructor proc. Also override the default -targetcmd
+ # option of the ::hv3::hv3 widget with our own version.
+ if {$O(myBrowser) ne ""} {
+ $O(myBrowser) add_frame $O(win)
+ }
+ $O(myHv3) configure -targetcmd [list $me Targetcmd]
+
+ ::hv3::menu $O(win).hyperlinkmenu
+ selection handle $O(win).hyperlinkmenu [list $me GetCopiedLinkLocation]
+ }
+ proc destroy {me} {
+ upvar #0 $me O
+ catch {$me ConfigureName -name ""}
+ # Remove this object from the $theFrames list.
+ catch {$O(myBrowser) del_frame $O(win)} msg
+ catch {::destroy $O(win).hyperlinkmenu}
+ }
+
+ proc configure-name {me} {
+ update_parent_dom $me [[$me hv3 dom] see]
+ }
+ proc update_parent_dom {me my_see} {
+ upvar #0 $me O
+
+ # This method is called when the "name" of attribute of this
+ # frame is modified. If javascript is enabled we have to update
+ # the properties on the parent window object (if any).
+
+ set parent [$me parent_frame]
+ if {$parent ne ""} {
+ set parent_see [[$parent hv3 dom] see]
+
+ if {$parent_see ne ""} {
+ if {$O(oldname) ne ""} {
+ $parent_see global $O(oldname) undefined
+ }
+ if {$my_see ne ""} {
+ $parent_see global $O(-name) [list bridge $my_see]
+ }
+ }
+ }
+
+ set O(oldname) $O(-name)
+ }
+
+ proc Targetcmd {me node} {
+ upvar #0 $me O
+ set target [$node attr -default "" target]
+ if {$target eq ""} {
+ # If there is no target frame specified, see if a default
+ # target was specified in a <base> tag i.e. <base target="_top">.
+ set n [lindex [[$O(myHv3) html] search base] 0]
+ if {$n ne ""} { set target [$n attr -default "" target] }
+ }
+
+ set theTopFrame [[lindex [$O(myBrowser) get_frames] 0] hv3]
+
+ # Find the target frame widget.
+ set widget $O(myHv3)
+ switch -- $target {
+ "" { set widget $O(myHv3) }
+ "_self" { set widget $O(myHv3) }
+ "_top" { set widget $theTopFrame }
+
+ "_parent" {
+ set w [winfo parent $O(myHv3)]
+ while {$w ne "" && [lsearch [$O(myBrowser) get_frames] $w] < 0} {
+ set w [winfo parent $w]
+ }
+ if {$w ne ""} {
+ set widget [$w hv3]
+ } else {
+ set widget $theTopFrame
+ }
+ }
+
+ # This is incorrect. The correct behaviour is to open a new
+ # top-level window. But hv3 doesn't support this (and because
+ # reasonable people don't like new top-level windows) we load
+ # the resource into the "_top" frame instead.
+ "_blank" { set widget $theTopFrame }
+
+ default {
+ # In html 4.01, an unknown frame should be handled the same
+ # way as "_blank". So this next line of code implements the
+ # same bug as described for "_blank" above.
+ set widget $theTopFrame
+
+ # TODO: The following should be a depth first search through the
+ # frames in the list returned by [get_frames].
+ #
+ foreach f [$O(myBrowser) get_frames] {
+ set n [$f cget -name]
+ if {$n eq $target} {
+ set widget [$f hv3]
+ break
+ }
+ }
+ }
+ }
+
+ return $widget
+ }
+
+ proc parent_frame {me} {
+ upvar #0 $me O
+ set frames [$O(myBrowser) get_frames]
+ set w [winfo parent $O(win)]
+ while {$w ne "" && [lsearch $frames $w] < 0} {
+ set w [winfo parent $w]
+ }
+ return $w
+ }
+ proc top_frame {me } {
+ upvar #0 $me O
+ lindex [$O(myBrowser) get_frames] 0
+ }
+ proc child_frames {me } {
+ upvar #0 $me O
+ set ret [list]
+ foreach c [$O(myBrowser) frames_tree $O(win)] {
+ lappend ret [lindex $c 0]
+ }
+ set ret
+ }
+
+ # This method returns the "position-id" of a frame, an id that is
+ # used by the history sub-system when loading a historical state of
+ # a frameset document.
+ #
+ proc positionid {me } {
+ upvar #0 $me O
+ if {$O(myPositionId) eq ""} {
+ set w $O(win)
+ while {[set p [winfo parent $w]] ne ""} {
+ set class [winfo class $p]
+ if {$class eq "Panedwindow"} {
+ set a [lsearch [$p panes] $w]
+ set w $p
+ set p [winfo parent $p]
+ set b [lsearch [$p panes] $w]
+
+ set O(myPositionId) [linsert $O(myPositionId) 0 "${b}.${a}"]
+ }
+ if {$class eq "Html" && $O(myPositionId) eq ""} {
+ set node $O(-iframe)
+ set idx [lsearch [$p search iframe] $node]
+ set O(myPositionId) [linsert $O(myPositionId) 0 iframe.${idx}]
+ }
+ set w $p
+ }
+ set O(myPositionId) [linsert $O(myPositionId) 0 0]
+ }
+ return $O(myPositionId)
+ }
+
+ proc middleclick {me x y} {
+ upvar #0 $me O
+ set node [lindex [$O(myHv3) node $x $y] 0]
+
+ set href ""
+ for {set N $node} {$N ne ""} {set N [$N parent]} {
+ if {[$N tag] eq "a" && [catch {$N attr href}]==0} {
+ set href [$O(myHv3) resolve_uri [$N attr href]]
+ }
+ }
+
+ if {$href eq ""} {
+ $me goto_selection
+ } else {
+ $me menu_select opentab $href
+ }
+ }
+
+ # This callback is invoked when the user right-clicks on this
+ # widget. If the mouse cursor is currently hovering over a hyperlink,
+ # popup the hyperlink menu. Otherwise launch the tree browser.
+ #
+ # Arguments $x and $y are the the current cursor position relative to
+ # this widget's window. $X and $Y are the same position relative to
+ # the root window.
+ #
+ proc rightclick {me x y X Y} {
+ upvar #0 $me O
+ if {![info exists ::hv3::G]} return
+
+ set m $O(win).hyperlinkmenu
+ $m delete 0 end
+
+ set nodelist [$O(myHv3) node $x $y]
+
+ set a_href ""
+ set img_src ""
+ set select [$O(myHv3) selected]
+ set leaf ""
+
+ foreach leaf $nodelist {
+ for {set N $leaf} {$N ne ""} {set N [$N parent]} {
+ set tag [$N tag]
+
+ if {$a_href eq "" && $tag eq "a"} {
+ set a_href [$N attr -default "" href]
+ }
+ if {$img_src eq "" && $tag eq "img"} {
+ set img_src [$N attr -default "" src]
+ }
+
+ }
+ }
+
+ if {$a_href ne ""} {set a_href [$O(myHv3) resolve_uri $a_href]}
+ if {$img_src ne ""} {set img_src [$O(myHv3) resolve_uri $img_src]}
+
+ set MENU [list \
+ a_href "Open Link" [list $me menu_select open $a_href] \
+ a_href "Open Link in Bg Tab" [list $me menu_select opentab $a_href] \
+ a_href "Download Link" [list $me menu_select download $a_href] \
+ a_href "Copy Link Location" [list $me menu_select copy $a_href] \
+ a_href -- "" \
+ img_src "View Image" [list $me menu_select open $img_src] \
+ img_src "View Image in Bg Tab" [list $me menu_select opentab $img_src] \
+ img_src "Download Image" [list $me menu_select download $img_src]\
+ img_src "Copy Image Location" [list $me menu_select copy $img_src] \
+ img_src -- "" \
+ select "Copy Selected Text" [list $me menu_select copy $select] \
+ select -- "" \
+ leaf "Open Tree browser..." [list ::HtmlDebug::browse $O(myHv3) $leaf] \
+ ]
+
+ foreach {var label cmd} $MENU {
+ if {$var eq "" || [set $var] ne ""} {
+ if {$label eq "--"} {
+ $m add separator
+ } else {
+ $m add command -label $label -command $cmd
+ }
+ }
+ }
+
+ $::hv3::G(config) populate_hidegui_entry $m
+ $m add separator
+
+ # Add the "File", "Search", "View" and "Debug" menus.
+ foreach sub [list File Search Options Debug History] {
+ catch {
+ set menu_widget $m.[string tolower $sub]
+ gui_populate_menu $sub [::hv3::menu $menu_widget]
+ }
+ $m add cascade -label $sub -menu $menu_widget -underline 0
+ }
+
+ tk_popup $m $X $Y
+ }
+
+ # Called when an option has been selected on the hyper-link menu. The
+ # argument identifies the specific option. May be one of:
+ #
+ # open
+ # opentab
+ # download
+ # copy
+ #
+ proc menu_select {me option uri} {
+ upvar #0 $me O
+ switch -- $option {
+ open {
+ set top_frame [lindex [$O(myBrowser) get_frames] 0]
+ $top_frame goto $uri
+ }
+ opentab { set new [.notebook addbg $uri] }
+ download { $O(myBrowser) saveuri $uri }
+ copy {
+ set O(myCopiedLinkLocation) $uri
+ selection own $O(win).hyperlinkmenu
+ clipboard clear
+ clipboard append $uri
+ }
+
+ default {
+ error "Internal error"
+ }
+ }
+ }
+
+ proc GetCopiedLinkLocation {me args} {
+ upvar #0 $me O
+ return $O(myCopiedLinkLocation)
+ }
+
+ # Called when the user middle-clicks on the widget
+ proc goto_selection {me} {
+ upvar #0 $me O
+ set theTopFrame [lindex [$O(myBrowser) get_frames] 0]
+ $theTopFrame goto [selection get]
+ }
+
+ proc motion {me N x y} {
+ upvar #0 $me O
+ set O(myX) $x
+ set O(myY) $y
+ set O(myNodeList) $N
+ $me update_statusvar
+ }
+
+ proc node_to_string {me node {hyperlink 1}} {
+ upvar #0 $me O
+ set value ""
+ for {set n $node} {$n ne ""} {set n [$n parent]} {
+ if {[info commands $n] eq ""} break
+ set tag [$n tag]
+ if {$tag eq ""} {
+ set value [$n text]
+ } elseif {$hyperlink && $tag eq "a" && [$n attr -default "" href] ne ""} {
+ set value "hyper-link: [string trim [$n attr href]]"
+ break
+ } elseif {[set nid [$n attr -default "" id]] ne ""} {
+ set value "<$tag id=$nid>$value"
+ } else {
+ set value "<$tag>$value"
+ }
+ }
+ return $value
+ }
+
+ proc update_statusvar {me} {
+ upvar #0 $me O
+ if {$O(-statusvar) ne ""} {
+ set str ""
+
+ set status_mode browser
+ catch { set status_mode $::hv3::G(status_mode) }
+
+ switch -- $status_mode {
+ browser-tree {
+ set value [$me node_to_string [lindex $O(myNodeList) end]]
+ set str "($O(myX) $O(myY)) $value"
+ }
+ browser {
+ for {set n [lindex $O(myNodeList) end]} {$n ne ""} {set n [$n parent]} {
+ if {[$n tag] eq "a" && [$n attr -default "" href] ne ""} {
+ set str "hyper-link: [string trim [$n attr href]]"
+ break
+ }
+ }
+ }
+ }
+
+ if {$O(-statusvar) ne $str} {
+ set $O(-statusvar) $str
+ }
+ }
+ }
+
+ #--------------------------------------------------------------------------
+ # PUBLIC INTERFACE
+ #--------------------------------------------------------------------------
+
+ proc goto {me args} {
+ upvar #0 $me O
+ eval [concat $O(myHv3) goto $args]
+ set O(myNodeList) ""
+ $me update_statusvar
+ }
+
+ # Launch the tree browser
+ proc browse {me} {
+ upvar #0 $me O
+ ::HtmlDebug::browse $O(myHv3) [$O(myHv3) node]
+ }
+
+ proc hv3 {me args} {
+ upvar #0 $me O
+ if {[llength $args] == 0} {return $O(myHv3)}
+ eval $O(myHv3) $args
+ }
+ proc browser {me} {
+ upvar #0 $me O
+ return $O(myBrowser)
+ }
+ proc dom {me} {
+ upvar #0 $me O
+ return [$O(myHv3) dom]
+ }
+
+ # The [isframeset] method returns true if this widget instance has
+ # been used to parse a frameset document (widget instances may parse
+ # either frameset or regular HTML documents).
+ #
+ proc isframeset {me} {
+ upvar #0 $me O
+ # When a <FRAMESET> tag is parsed, a node-handler in hv3_frameset.tcl
+ # creates a widget to manage the frames and then uses [place] to
+ # map it on top of the html widget created by this ::hv3::browser_frame
+ # widget. Todo: It would be better if this code was in the same file
+ # as the node-handler, otherwise this test is a bit obscure.
+ #
+ set html [[$me hv3] html]
+ set slaves [place slaves $html]
+ set isFrameset 0
+ if {[llength $slaves]>0} {
+ set isFrameset [expr {[winfo class [lindex $slaves 0]] eq "Frameset"}]
+ }
+ return $isFrameset
+ }
+
+ set DelegateOption(-forcefontmetrics) myHv3
+ set DelegateOption(-fonttable) myHv3
+ set DelegateOption(-fontscale) myHv3
+ set DelegateOption(-zoom) myHv3
+ set DelegateOption(-enableimages) myHv3
+ set DelegateOption(-enablejavascript) myHv3
+ set DelegateOption(-dom) myHv3
+ set DelegateOption(-width) myHv3
+ set DelegateOption(-height) myHv3
+ set DelegateOption(-requestcmd) myHv3
+ set DelegateOption(-resetcmd) myHv3
+ set DelegateOption(-downloadcmd) myHv3
+
+ proc stop {me args} {
+ upvar #0 $me O
+ eval $O(myHv3) stop $args
+ }
+ proc titlevar {me args} {
+ upvar #0 $me O
+ eval $O(myHv3) titlevar $args
+ }
+ proc dumpforms {me args} {
+ upvar #0 $me O
+ eval $O(myHv3) dumpforms $args
+ }
+ proc javascriptlog {me args} {
+ upvar #0 $me O
+ eval $O(myHv3) javascriptlog $args
+ }
+
+ proc me {me} {
+ return $me
+ }
+}
+::hv3::make_constructor ::hv3::browser_frame ::hv3::hv3
+
+# An instance of this widget represents a top-level browser frame (not
+# a toplevel window - an html frame not contained in any frameset
+# document). These are the things managed by the notebook widget.
+#
+namespace eval ::hv3::browser {
+
+ proc new {me args} {
+ upvar #0 $me O
+
+ # Initialize the global database connection if it has not already
+ # been initialized. TODO: Remove the global variable.
+ ::hv3::dbinit
+
+ set O(-stopbutton) ""
+ set O(-unsafe) 0
+
+ # Variables passed to [$myProtocol configure -statusvar] and
+ # the same option of $myMainFrame. Used to create the value for
+ # $myStatusVar.
+ set O(myProtocolStatus) ""
+ set O(myFrameStatus) ""
+
+ set O(myStatusVar) ""
+ set O(myLocationVar) ""
+
+ # List of all ::hv3::browser_frame objects using this object as
+ # their toplevel browser.
+ set O(myFrames) [list]
+
+ # Create the protocol object.
+ set O(myProtocol) [::hv3::protocol %AUTO%]
+
+ # The main browser frame (always present).
+ set O(myHistory) ""
+ set O(myMainFrame) [::hv3::browser_frame $O(win).frame $me]
+ #set O(myMainFrame) $O(hull)
+
+ # The history sub-system.
+ set hv3 [$O(myMainFrame) hv3]
+ set O(myHistory) [::hv3::history %AUTO% $hv3 $O(myProtocol) $me]
+
+ # The widget may be in one of two states - "pending" or "not pending".
+ # "pending" state is when the browser is still waiting for one or more
+ # downloads to finish before the document is correctly displayed. In
+ # this mode the default cursor is an hourglass and the stop-button
+ # widget is in normal state (stop button is clickable).
+ #
+ # Otherwise the default cursor is "" (system default) and the stop-button
+ # widget is disabled.
+ #
+ set O(myIsPending) 0
+
+ set psc [list $me ProtocolStatusChanged]
+ trace add variable ${me}(myProtocolStatus) write $psc
+ trace add variable ${me}(myFrameStatus) write [list $me Writestatus]
+ $O(myMainFrame) configure -statusvar ${me}(myFrameStatus)
+ $O(myProtocol) configure -statusvar ${me}(myProtocolStatus)
+
+ # Link in the "home:" and "about:" scheme handlers (from hv3_home.tcl)
+ ::hv3::home_scheme_init [$O(myMainFrame) hv3] $O(myProtocol)
+ ::hv3::cookies_scheme_init $O(myProtocol)
+ ::hv3::download_scheme_init [$O(myMainFrame) hv3] $O(myProtocol)
+
+ # Configure the history sub-system. TODO: Is this obsolete?
+ $O(myHistory) configure -gotocmd [list $me goto]
+
+ $O(myMainFrame) configure -requestcmd [list $O(myProtocol) requestcmd]
+
+ # pack $O(myMainFrame) -expand true -fill both -side top
+ grid $O(myMainFrame) -sticky nsew
+ grid rowconfigure $O(win) 0 -weight 1
+ grid columnconfigure $O(win) 0 -weight 1
+
+ eval $me configure $args
+ }
+
+ proc destroy {me} {
+ upvar #0 $me O
+ if {$O(myProtocol) ne ""} { $O(myProtocol) destroy }
+ if {$O(myHistory) ne ""} { $O(myHistory) destroy }
+ }
+
+ proc statusvar {me} {
+ return ${me}(myStatusVar)
+ }
+ proc titlevar {me args} {
+ upvar #0 $me O
+ eval $O(myMainFrame) titlevar $args
+ }
+
+ # This method is called to activate the download-manager to download
+ # the specified URI ($uri) to the local file-system.
+ #
+ proc saveuri {me uri} {
+ upvar #0 $me O
+
+ set handle [::hv3::request %AUTO% \
+ -uri $uri \
+ -mimetype application/gzip \
+ ]
+ $handle configure \
+ -incrscript [list ::hv3::the_download_manager savehandle "" $handle] \
+ -finscript [list ::hv3::the_download_manager savehandle "" $handle]
+
+ $O(myProtocol) requestcmd $handle
+ }
+
+ # Interface used by code in class ::hv3::browser_frame for frame management.
+ #
+ proc add_frame {me frame} {
+ upvar #0 $me O
+
+ lappend O(myFrames) $frame
+ if {$O(myHistory) ne ""} {
+ $O(myHistory) add_hv3 [$frame hv3]
+ }
+ set HTML [[$frame hv3] html]
+ bind $HTML <1> [list focus %W]
+ bind $HTML <KeyPress-slash> [list $me Find]
+ bindtags $HTML [concat Hv3HotKeys $me [bindtags $HTML]]
+
+ set cmd [list ::hv3::the_download_manager savehandle $O(myProtocol)]
+ $frame configure -downloadcmd $cmd
+
+ catch {$::hv3::G(config) configureframe $frame}
+ }
+ proc del_frame {me frame} {
+ upvar #0 $me O
+ set idx [lsearch $O(myFrames) $frame]
+ if {$idx >= 0} {
+ set O(myFrames) [lreplace $O(myFrames) $idx $idx]
+ }
+ }
+ proc get_frames {me} {
+ upvar #0 $me O
+ return $O(myFrames)
+ }
+
+ # Return a list describing the current structure of the frameset
+ # displayed by this browser.
+ #
+ proc frames_tree {me {head {}}} {
+ upvar #0 $me O
+ set ret ""
+
+ array set A {}
+ foreach f [lsort $O(myFrames)] {
+ set p [$f parent_frame]
+ lappend A($p) $f
+ if {![info exists A($f)]} {set A($f) [list]}
+ }
+
+ foreach f [concat [lsort -decreasing $O(myFrames)] [list {}]] {
+ set new [list]
+ foreach child $A($f) {
+ lappend new [list $child $A($child)]
+ }
+ set A($f) $new
+ }
+
+ set A($head)
+ }
+
+ # This method is called by a [trace variable ... write] hook attached
+ # to the O(myProtocolStatus) variable. Set O(myStatusVar).
+ proc Writestatus {me args} {
+ upvar #0 $me O
+ set protocolstatus Done
+ if {[llength $O(myProtocolStatus)] > 0} {
+ foreach {nWaiting nProgress nPercent} $O(myProtocolStatus) break
+ set protocolstatus "$nWaiting waiting, $nProgress progress ($nPercent%)"
+ }
+ set O(myStatusVar) "$protocolstatus $O(myFrameStatus)"
+ }
+
+ proc ProtocolStatusChanged {me args} {
+ upvar #0 $me O
+ $me pendingcmd [llength $O(myProtocolStatus)]
+ $me Writestatus
+ }
+
+ proc set_frame_status {me text} {
+ upvar #0 $me O
+ set O(myFrameStatus) $text
+ }
+
+ proc pendingcmd {me isPending} {
+ upvar #0 $me O
+ if {$O(-stopbutton) ne "" && $O(myIsPending) != $isPending} {
+ if {$isPending} {
+ $O(hull) configure -cursor watch
+ $O(-stopbutton) configure \
+ -command [list $O(myMainFrame) stop] \
+ -image hv3_stopimg \
+ -tooltip "Stop Current Download"
+ } else {
+ $O(hull) configure -cursor ""
+ $O(-stopbutton) configure \
+ -command [list $me reload] \
+ -image hv3_reloadimg \
+ -tooltip "Reload Current Document"
+ }
+ }
+ set O(myIsPending) $isPending
+ }
+
+ proc configure-stopbutton {me} {
+ upvar #0 $me O
+ set val $O(myIsPending)
+ set O(myIsPending) -1
+ $me pendingcmd $val
+ }
+
+ # Escape --
+ #
+ # This method is called when the <Escape> key sequence is seen.
+ # Get rid of the "find-text" widget, if it is currently visible.
+ #
+ proc escape {me} {
+ upvar #0 $me O
+ catch { ::destroy $O(win).findwidget }
+ }
+
+ proc packwidget {me w {row 1}} {
+ upvar #0 $me O
+ grid $w -column 0 -row $row -sticky nsew
+ bind $w <Destroy> [list catch [list focus [[$O(myMainFrame) hv3] html]]]
+ }
+
+ # Find --
+ #
+ # This method is called when the "find-text" widget is summoned.
+ # Currently this can happen when the users:
+ #
+ # * Presses "control-f",
+ # * Presses "/", or
+ # * Selects the "Edit->Find Text" pull-down menu command.
+ #
+ proc Find {me } {
+ upvar #0 $me O
+
+ set fdname $O(win).findwidget
+ set initval ""
+ if {[llength [info commands $fdname]] > 0} {
+ set initval [${fdname}.entry get]
+ ::destroy $fdname
+ }
+
+ ::hv3::findwidget $fdname $me
+
+ $me packwidget $fdname
+ $fdname configure -borderwidth 1 -relief raised
+
+ # Bind up, down, next and prior key-press events to scroll the
+ # main hv3 widget. This means you can use the keyboard to scroll
+ # window (vertically) without shifting focus from the
+ # find-as-you-type box.
+ #
+ set hv3 [$me hv3]
+ bind ${fdname} <KeyPress-Up> [list $hv3 yview scroll -1 units]
+ bind ${fdname} <KeyPress-Down> [list $hv3 yview scroll 1 units]
+ bind ${fdname} <KeyPress-Next> [list $hv3 yview scroll 1 pages]
+ bind ${fdname} <KeyPress-Prior> [list $hv3 yview scroll -1 pages]
+
+ # When the findwidget is destroyed, return focus to the html widget.
+ bind ${fdname} <KeyPress-Escape> gui_escape
+
+ ${fdname}.entry insert 0 $initval
+ focus ${fdname}.entry
+ }
+
+ # ProtocolGui --
+ #
+ # This method is called when the "toggle-protocol-gui" control
+ # (implemented externally) is manipulated. The argument must
+ # be one of the following strings:
+ #
+ # "show" (display gui)
+ # "hide" (hide gui)
+ # "toggle" (display if hidden, hide if displayed)
+ #
+ proc ProtocolGui {me cmd} {
+ upvar #0 $me O
+ set name $O(win).protocolgui
+ set exists [winfo exists $name]
+
+ switch -- $cmd {
+ show {if {$exists} return}
+ hide {if {!$exists} return}
+ toggle {
+ set cmd "show"
+ if {$exists} {set cmd "hide"}
+ }
+
+ default { error "Bad arg" }
+ }
+
+ if {$cmd eq "hide"} {
+ ::destroy $name
+ } else {
+ $O(myProtocol) gui $name
+ $me packwidget $name 2
+ }
+ }
+
+ proc history {me } {
+ upvar #0 $me O
+ return $O(myHistory)
+ }
+
+ proc reload {me } {
+ upvar #0 $me O
+ $O(myHistory) reload
+ }
+
+ proc populate_history_menu {me args} {
+ upvar #0 $me O
+ eval $O(myHistory) populate_menu $args
+ }
+ proc populatehistorymenu {me args} {
+ upvar #0 $me O
+ eval $O(myHistory) populatehistorymenu $args
+ }
+ proc locationvar {me args} {
+ upvar #0 $me O
+ eval $O(myHistory) locationvar $args
+ }
+ proc debug_cookies {me args} {
+ upvar #0 $me O
+ eval $O(myProtocol) debug_cookies $args
+ }
+
+ set DelegateOption(-backbutton) myHistory
+ set DelegateOption(-forwardbutton) myHistory
+ set DelegateOption(-locationentry) myHistory
+ set DelegateOption(*) myMainFrame
+
+ proc unknown {method me args} {
+ # puts "UNKNOWN: $me $method $args"
+ upvar #0 $me O
+ uplevel 3 [list eval $O(myMainFrame) $method $args]
+ }
+ namespace unknown unknown
+}
+
+::hv3::make_constructor ::hv3::browser
+
+set ::hv3::maindir [file dirname [info script]]
+
diff --git a/hv/hv3_bugreport.tcl b/hv/hv3_bugreport.tcl
index 36e53fb..5df54a4 100644
--- a/hv/hv3_bugreport.tcl
+++ b/hv/hv3_bugreport.tcl
@@ -3,7 +3,7 @@ namespace eval ::hv3::bugreport {
proc init {hv3 uri} {
$hv3 reset 0
- $hv3 parse {
+ $hv3 html parse {
<HTML>
<HEAD>
@@ -120,19 +120,19 @@ namespace eval ::hv3::bugreport {
}
- set uri_field [[$hv3 search #uritext] replace]
+ set uri_field [[$hv3 html search #uritext] replace]
$uri_field dom_value $uri
- set caption_field [[$hv3 search {[name="t"]}] replace]
+ set caption_field [[$hv3 html search {[name="t"]}] replace]
$caption_field dom_focus
- set node [$hv3 search #submit_button]
+ set node [$hv3 html search #submit_button]
set button [::hv3::button [$hv3 html].document.submit \
-command [list ::hv3::bugreport::submitform submit $hv3] \
-text "Submit Report!"
]
$node replace $button -deletecmd [list destroy $button]
- set node [$hv3 search #preview_button]
+ set node [$hv3 html search #preview_button]
set button [::hv3::button [$hv3 html].document.preview \
-command [list ::hv3::bugreport::submitform preview $hv3] \
-text "Online Preview..."
@@ -141,7 +141,8 @@ namespace eval ::hv3::bugreport {
}
proc submitform {status hv3} {
- set caption_field [[$hv3 search {[name="t"]}] replace]
+ set caption_field [[$hv3 html search {[name="t"]}] replace]
+ set contact_field [[$hv3 html search {[name="c"]}] replace]
set v [$caption_field value]
if {[string length $v]>60 || [string length $v]==0} {
@@ -151,13 +152,18 @@ namespace eval ::hv3::bugreport {
return
}
- set uri [[[$hv3 search #uritext] replace] value]
+ set c [$contact_field value]
+ if {$c eq ""} {
+ $contact_field dom_value "Anonymous Hv3 User"
+ }
+
+ set uri [[[$hv3 html search #uritext] replace] value]
if {$uri ne ""} {
- set widget [[[$hv3 search {[name="d"]}] replace] get_text_widget]
+ set widget [[[$hv3 html search {[name="d"]}] replace] get_text_widget]
$widget insert 0.0 " URI: $uri\n\n"
}
- set trick [$hv3 search #trick_control]
+ set trick [$hv3 html search #trick_control]
$trick attribute name $status
$trick attribute value 1
diff --git a/hv/hv3_common.tcl b/hv/hv3_common.tcl
new file mode 100644
index 0000000..2536067
--- /dev/null
+++ b/hv/hv3_common.tcl
@@ -0,0 +1,49 @@
+
+###########################################################################
+# Some handy utilities used by the rest of the hv3 app. The public
+# interface to this file consists of the commands:
+#
+# swproc
+#
+
+# swproc --
+#
+# swproc NAME ARGS BODY
+#
+# [swproc] is very similar to the proc command, except any procedure
+# arguments with default values must be specified with switches instead
+# of on the command line. For example, the following are equivalent:
+#
+# proc abc {a {b hello} {c goodbye}} {...}
+# abc one two
+#
+# swproc swabc {a {b hello} {c goodbye}} {...}
+# swabc one -b two
+#
+# This means, in the above example, that it is possible to call [swabc]
+# and supply a value for parameter "c" but not "b". This is not
+# possible with commands created by regular Tcl [proc].
+#
+# Commands created with [swproc] may also accept switches that do not
+# take arguments. These should be specified as a list of three elements.
+# The first is the name of the switch (and variable). The second is the
+# default value of the variable (if the switch is not present), and the
+# third is the value if the switch is present. For example, the
+# following two blocks are equivalent:
+#
+# proc abc {a} {...}
+# abc b
+# abc c
+#
+# swproc abc {{a b c}} {...}
+# abc
+# abc -a
+#
+proc swproc {procname arguments script} {
+ uplevel [subst {
+ proc $procname {args} {
+ ::tkhtml::swproc_rt [list $arguments] \$args
+ $script
+ }
+ }]
+}
diff --git a/hv/hv3_console.tcl b/hv/hv3_console.tcl
new file mode 100644
index 0000000..127b924
--- /dev/null
+++ b/hv/hv3_console.tcl
@@ -0,0 +1,61 @@
+namespace eval hv3 { set {version($Id: hv3_console.tcl,v 1.2 2007/12/18 15:05:56 danielk1977 Exp $)} 1 }
+
+# -*- mode: tcl; tab-width: 8 -*-
+#
+# Make sure [::console show] is available.
+#
+
+return
+
+if {![catch {package require tclreadline}]} {
+ proc ::console method {
+ if {[info exists ::tclreadline::_in_loop]} return
+ set ::tclreadline::_in_loop 1
+ switch -- $method {
+ show {
+ after idle tclreadline::Loop
+ }
+ default {
+ error "Not implemented: console $method"
+ }
+ }
+ }
+} else {
+ namespace eval ::hv3::tinyconsole {
+ namespace export console
+
+ variable buffer ""
+ proc NS args { namespace code $args }
+ proc K {x y} { set x }
+
+ variable prompt "\n% "
+
+ proc prompt {} {
+ variable prompt
+ puts -nonewline stdout [subst $prompt]
+ }
+
+ proc console {method args} {
+ switch -- $method {
+ show {
+ prompt
+ set chan stdin
+ fileevent $chan readable [NS listener $chan]
+ }
+ default {
+ error "Not implemented: console $method"
+ }
+ }
+ }
+
+ proc listener chan {
+ append buffer [gets $chan]
+ if {[info complete $buffer]} {
+ puts -nonewline [uplevel #0 [K $buffer [set buffer ""]]]
+ prompt
+ }
+ }
+ }
+
+ namespace import ::hv3::tinyconsole::console
+}
diff --git a/hv/hv3_db.tcl b/hv/hv3_db.tcl
index 653e0d6..76dc824 100644
--- a/hv/hv3_db.tcl
+++ b/hv/hv3_db.tcl
@@ -1,4 +1,4 @@
-namespace eval hv3 { set {version($Id: hv3_db.tcl,v 1.19 2007/10/04 11:08:12 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3_db.tcl,v 1.23 2008/02/01 07:54:52 danielk1977 Exp $)} 1 }
# Class ::hv3::visiteddb
#
@@ -20,8 +20,6 @@ snit::type ::hv3::visiteddb {
# Constant: Maximum size of database.
constructor {} {
- if {![::hv3::have_sqlite3]} return
-
# Make sure the database table has been created.
catch {::hv3::sqlitedb eval "
CREATE TABLE visiteddb(
@@ -36,8 +34,6 @@ snit::type ::hv3::visiteddb {
# ::hv3::hv3 mega-widget. Argument $hv3 is the new mega-widget.
#
method init {hv3} {
- if {![::hv3::have_sqlite3]} return
-
$hv3 configure -storevisitedcmd [myproc LocationHandler $hv3]
$hv3 configure -isvisitedcmd [myproc LocationQuery]
}
@@ -83,7 +79,6 @@ snit::type ::hv3::visiteddb {
# $pattern is interpreted by the SQLite GLOB operator.
#
method keys {pattern} {
- if {![::hv3::have_sqlite3]} return
set sql {
SELECT uri FROM visiteddb
WHERE uri GLOB $pattern
@@ -123,8 +118,6 @@ snit::type ::hv3::cookiemanager {
variable EXPIRE_COOKIES_DELAY 30000
constructor {} {
- if {![::hv3::have_sqlite3]} return
-
# Make sure the database table has been created.
catch {::hv3::sqlitedb eval {
CREATE TABLE cookiesdb(
@@ -225,8 +218,6 @@ snit::type ::hv3::cookiemanager {
# Add a cookie to the cookies database.
#
method SetCookie {uri data} {
- if {![::hv3::have_sqlite3]} return
-
# Default values for "domain" and "path"
set obj [::tkhtml::uri $uri]
set v(domain) [$obj authority]
@@ -272,7 +263,7 @@ snit::type ::hv3::cookiemanager {
if {[info exists name]} {
set lastused [clock seconds]
set sql {REPLACE INTO cookiesdb VALUES(
- $v(domain), $v(flat), $v(path), $v(secure), $v(expires), $name,
+ $v(domain), $v(flag), $v(path), $v(secure), $v(expires), $name,
$value, $lastused)
}
::hv3::sqlitedb eval $sql
@@ -289,8 +280,6 @@ snit::type ::hv3::cookiemanager {
# "NAME1=OPAQUE_STRING1; NAME2=OPAQUE_STRING2 ..."
#
method Cookie {uri} {
- if {![::hv3::have_sqlite3]} return
-
set obj [::tkhtml::uri $uri]
set uri_domain [$obj authority]
set uri_path [$obj path]
@@ -322,8 +311,6 @@ snit::type ::hv3::cookiemanager {
}
method Report {} {
- if {![::hv3::have_sqlite3]} return
-
set Template {
<html><head>
<style>$Style</style>
@@ -379,41 +366,22 @@ snit::type ::hv3::cookiemanager {
}
}
-proc ::hv3::have_sqlite3 {} {
- return [expr {[info commands sqlite3] ne ""}]
- # return [expr [catch {package present sqlite3}] ? 0 : 1]
-}
-
proc ::hv3::cookies_scheme_init {protocol} {
$protocol schemehandler cookies {::hv3::the_cookie_manager cookies_request}
}
proc ::hv3::dbinit {} {
- if {"" eq [info commands ::hv3::the_cookie_manager]} {
- if {[::hv3::have_sqlite3]} {
- sqlite3 ::hv3::sqlitedb $::hv3::statefile
- ::hv3::profile::instrument ::hv3::sqlitedb
- ::hv3::sqlitedb eval {PRAGMA synchronous = OFF}
- ::hv3::sqlitedb timeout 2000
- ::hv3::sqlitedb function result_transform ::hv3::bookmarks::result_transform
- ::hv3::sqlitedb function html_to_text ::hv3::bookmarks::html_to_text
-
- # Test if fts3 is present. fts3 is used by the bookmarks app.
- #
- set ::hv3::have_fts3 [expr {![catch {::hv3::sqlitedb eval {
- CREATE VIRTUAL TABLE temp.fts3test USING fts3(a);
- DROP TABLE fts3test;
- }} msg]}]
- if {$::hv3::have_fts3 == 0} {
- puts "WARNING: fts3 not loaded ($msg)"
- set ::hv3::bookmarks::save_snapshot_variable 0
- }
- }
-
- ::hv3::cookiemanager ::hv3::the_cookie_manager
- ::hv3::visiteddb ::hv3::the_visited_db
-
- ::hv3::bookmarks::initialise_database
- }
+ if {[info commands ::hv3::sqlitedb] ne ""} return
+ if {![info exists ::hv3::statefile]} {set ::hv3::statefile ""}
+
+ sqlite3 ::hv3::sqlitedb $::hv3::statefile
+ catch {::hv3::profile::instrument ::hv3::sqlitedb}
+ ::hv3::sqlitedb eval {PRAGMA synchronous = OFF}
+ ::hv3::sqlitedb timeout 2000
+ ::hv3::sqlitedb function result_transform ::hv3::bookmarks::result_transform
+ ::hv3::sqlitedb function html_to_text ::hv3::bookmarks::html_to_text
+
+ ::hv3::cookiemanager ::hv3::the_cookie_manager
+ ::hv3::visiteddb ::hv3::the_visited_db
}
diff --git a/hv/hv3_debug.tcl b/hv/hv3_debug.tcl
new file mode 100644
index 0000000..2951ca0
--- /dev/null
+++ b/hv/hv3_debug.tcl
@@ -0,0 +1,799 @@
+namespace eval hv3 { set {version($Id: hv3_debug.tcl,v 1.17 2008/03/02 14:43:49 danielk1977 Exp $)} 1 }
+
+namespace eval ::hv3 {
+ ::snit::widget console {
+
+ # Entry field for typing commands (entry widget):
+ variable myEntryField
+
+ # Output window for output of typed commands (text widget):
+ variable myOutputWindow
+
+ # Viewer window for viewing HTML/CSS/Javascript code (text widget).
+ variable myCodeViewer
+
+ variable myLabel
+
+ # Current value of language selector widget. Always one of:
+ #
+ # "Tcl"
+ # "Javascript"
+ # "Search"
+ #
+ variable myLanguage
+
+ # An array of tags to delete from widget $myCodeViewer when it is
+ # next cleared.
+ variable myCodeViewerLinks [list]
+
+ # An array of tags to delete from widget $myOutputWindow when
+ # it is next cleared.
+ variable myOutputWindowLinks [list]
+
+ # Font size currently used in the two text widgets ($myOutputWindow and
+ # $myCodeViewer).
+ variable myFontSize 10
+
+ # Command line history state.
+ variable myHistory [list]
+ variable myHistoryIdx 0
+
+ variable myBreakpoints -array [list]
+
+ variable myPage ""
+ variable myPageId ""
+
+ constructor {args} {
+ set f [frame ${win}.f]
+
+ set myEntryField [::hv3::entry ${win}.f.entry_field]
+ set sel ${win}.f.select
+ set om [tk_optionMenu $sel [myvar myLanguage] Tcl Javascript Search]
+ $sel configure -width 9
+
+ $om configure -borderwidth 1 -activeborderwidth 1
+ $om configure -borderwidth 1
+ $sel configure -borderwidth 1
+ ::hv3::UseHv3Font $om
+ ::hv3::UseHv3Font $sel
+
+ pack ${win}.f.select -side left
+ pack $myEntryField -fill both -expand 1
+
+ set pan [panedwindow ${win}.pan -orient vertical -bd 0]
+
+ set myOutputWindow [::hv3::scrolled ::hv3::text ${win}.pan.output_window]
+ set myCodeViewer [::hv3::scrolled ::hv3::text ${win}.pan.code_viewer]
+
+ $myOutputWindow configure -height 200 -width 600 -bg white
+ $myCodeViewer configure -height 200 -bg white
+
+ $pan add $myCodeViewer
+ $pan add $myOutputWindow
+
+ set myCodeViewer [$myCodeViewer widget]
+
+ set b [frame ${win}.b]
+ ::hv3::button ${b}.viewindex \
+ -text "Application Index" \
+ -command [list $self Display index ""]
+ set myLabel [::hv3::label ${b}.label -anchor w]
+ pack ${b}.viewindex -side left
+
+ ::hv3::button ${b}.reorient -text Resize -command [list $self Reorient]
+ ::hv3::button ${b}.increasefont -text "+" -command [list $self font +2]
+ ::hv3::button ${b}.decreasefont -text "-" -command [list $self font -2]
+ pack ${b}.reorient -side right
+ pack ${b}.increasefont -side right
+ pack ${b}.decreasefont -side right
+
+ pack ${b}.label -side left -fill x
+
+ pack $b -side top -fill x
+ pack $f -side bottom -fill x
+ pack $pan -fill both -expand 1
+
+ bind $myEntryField <Return> [list $self Evaluate]
+
+ set boldfont [concat [$myOutputWindow cget -font] bold]
+
+ $myOutputWindow tag configure error -foreground red
+ $myOutputWindow tag configure tcl -background #DDDDDD
+ $myOutputWindow tag configure javascript -background #DDDDFF
+ $myOutputWindow tag configure search -background #DDFFDD
+
+ $myCodeViewer tag configure red -foreground red
+ $myCodeViewer tag configure linenumber -background #BBBBBB
+ $myCodeViewer tag configure wheat -background wheat
+ $myCodeViewer tag configure english -wrap word
+ $myCodeViewer tag configure breakpoint -background red
+
+ bind $myEntryField <Control-j> [list set [myvar myLanguage] Javascript]
+ bind $myEntryField <Control-t> [list set [myvar myLanguage] Tcl]
+ bind $myEntryField <Control-s> [list set [myvar myLanguage] Search]
+
+ bind $myEntryField <Up> [list $self History -1]
+ bind $myEntryField <Down> [list $self History +1]
+
+ $myCodeViewer tag bind linenumber <1> [list $self ClickLineNumber %x %y]
+ $myCodeViewer tag bind breakpoint <1> [list $self ClickLineNumber %x %y]
+
+ $myOutputWindow configure -state disabled
+ $myCodeViewer configure -state disabled
+ focus $myEntryField
+
+ $self font 0
+ $self Display index ""
+ }
+
+ method History {iDir} {
+ set iHistory [expr $myHistoryIdx + $iDir]
+ if {$iHistory < 0 || $iHistory > [llength $myHistory]} return
+
+ set myHistoryIdx $iHistory
+ $myEntryField delete 0 end
+ $myEntryField insert 0 [lindex $myHistory $myHistoryIdx 1]
+
+ set lang [lindex $myHistory $myHistoryIdx 0]
+ if {$lang ne ""} {set myLanguage $lang}
+ }
+
+ method font {incr} {
+ incr myFontSize $incr
+ $myOutputWindow configure -font [list monospace $myFontSize]
+ $myCodeViewer configure -font [list monospace $myFontSize]
+ $myEntryField configure -font [list monospace $myFontSize]
+ if {($myFontSize + $incr) < 6} {
+ ${win}.b.decreasefont configure -state disabled
+ } else {
+ ${win}.b.decreasefont configure -state normal
+ }
+ }
+
+ method Reorient {} {
+ set y [lindex [${win}.pan sash coord 0] 1]
+ set h [winfo height ${win}.pan]
+ if {$y > $h/2} {
+ set y [expr {int($h*0.1)}]
+ } else {
+ set y [expr {int($h*0.9)}]
+ }
+ ${win}.pan sash place 0 0 $y
+ }
+
+
+ # This method is called to evaluate a command typed into $myEntryField.
+ #
+ method Evaluate {} {
+ set cmd [$myEntryField get]
+ if {$cmd eq ""} return
+
+ lappend myHistory [list $myLanguage $cmd]
+ set myHistoryIdx [expr [llength $myHistory]]
+ $myEntryField delete 0 end
+
+ $myOutputWindow configure -state normal
+ switch -- $myLanguage {
+ Tcl {
+ set rc [catch [list \
+ namespace eval ::hv3::console_commands $cmd
+ ] result]
+ set result [string map {"\n" "\n "} $result]
+ $myOutputWindow insert end "\$ $cmd\n" tcl
+ if {$rc} {
+ $myOutputWindow insert end " $result\n" error
+ } else {
+ $myOutputWindow insert end " $result\n"
+ }
+ }
+
+ Javascript {
+ set isEnabled [gui_current cget -enablejavascript]
+ $myOutputWindow insert end "> $cmd\n" javascript
+ if {!$isEnabled} {
+ $myOutputWindow insert end " Javascript is not enabled\n" error
+ } else {
+ set dom [[gui_current hv3] dom]
+ set result [$dom javascript $cmd]
+ set result [string map {"\n" "\n "} $result]
+ if {[lindex $result 0] eq "JS_ERROR"} {
+ $myOutputWindow insert end " $result\n" error
+ } else {
+ $myOutputWindow insert end " $result\n"
+ }
+ }
+ }
+
+ Search {
+ set ignore_case 0
+ if {$cmd eq [string tolower $cmd]} {
+ set ignore_case 1
+ }
+ $myOutputWindow insert end "/ $cmd\n" search
+
+ # Search through all the javascript files for the string $cmd.
+ set dom [[gui_current hv3] dom]
+ set ii 0
+ foreach logscript [$dom GetLog] {
+ if {[$logscript cget -isevent]} continue
+
+ set iLine 1
+ foreach zLine [split [$logscript cget -script] "\n"] {
+ set zLine [string trim $zLine]
+ set zSearch $zLine
+ if {$ignore_case} {set zSearch [string tolower $zSearch]}
+ if {[set i [string first $cmd $zSearch]] >= 0} {
+ set c [list $self DisplayJavascriptError 0 $logscript $iLine]
+
+ set nLine [string length $zLine]
+
+ set iStart [expr $i-20]
+ set iEnd [expr $i+20]
+ if {$iEnd > $nLine} {
+ incr iStart [expr $nLine - $iEnd]
+ set iEnd $nLine
+ }
+ if {$iStart < 0} {
+ incr iEnd [expr 0 - $iStart]
+ set iStart 0
+ }
+ set match [string range $zLine $iStart $iEnd]
+
+ if {$iStart > 0} {
+ $myOutputWindow insert end "..."
+ } else {
+ $myOutputWindow insert end " "
+ }
+ $myOutputWindow insert end [format %-40s $match]
+ if {$iEnd < $nLine } {
+ $myOutputWindow insert end "... "
+ } else {
+ $myOutputWindow insert end " "
+ }
+
+ set z "Line $iLine, [$logscript cget -heading]"
+ $self OutputWindowLink $z $c
+ $myOutputWindow insert end "\n"
+ }
+ incr iLine
+ }
+ }
+ }
+ }
+
+ $myOutputWindow yview end
+ $myOutputWindow configure -state disabled
+ }
+
+ # This proc is called to display a page in the "code viewer" pane
+ # (the top one). Parameter $page must be one of the following:
+ #
+ # html
+ # index
+ # css
+ # javascript
+ #
+ method Display {page pageid} {
+ $myCodeViewer configure -state normal -cursor xterm
+
+ $myCodeViewer delete 0.0 end
+ foreach tag $myCodeViewerLinks {
+ $myCodeViewer tag delete $tag
+ }
+ set myCodeViewerLinks [list]
+
+ switch -- $page {
+ html {
+ set hv3 [$pageid hv3]
+ $myCodeViewer insert end [$hv3 log get html]
+ $myLabel configure -text "HTML Code: [$hv3 uri get]"
+ $myCodeViewer configure -wrap word
+ }
+
+ index {
+ $self DisplayIndex
+ $myLabel configure -text ""
+ $myCodeViewer configure -wrap none
+ }
+
+ css {
+ eval $self DisplayCss $pageid
+ $myLabel configure -text "CSS Code: [lindex $pageid 1]"
+ $myCodeViewer configure -wrap word
+ }
+
+ javascript {
+ eval $self DisplayJavascript $pageid
+ $myCodeViewer configure -wrap word
+ }
+
+ default {error "Internal error - bad page \"$page\""}
+ }
+ $myCodeViewer configure -state disabled
+
+ set myPage $page
+ set myPageId $pageid
+ }
+
+ method CreateCodeViewerLink {text command} {
+ set tag "link[expr rand()]"
+ lappend myCodeViewerLinks $tag
+ $myCodeViewer tag configure $tag -underline 1 -foreground darkblue
+ $myCodeViewer tag bind $tag <1> $command
+ $myCodeViewer tag bind $tag <Enter> "
+ $myCodeViewer configure -cursor hand2
+ $myCodeViewer tag configure $tag -background #d9d9d9
+ "
+ $myCodeViewer tag bind $tag <Leave> "
+ $myCodeViewer configure -cursor xterm
+ $myCodeViewer tag configure $tag -background white
+ "
+ $myCodeViewer insert end $text $tag
+ return $tag
+ }
+ method OutputWindowLink {text command} {
+ set tag "link[expr rand()]"
+ lappend myOutputWindowLinks $tag
+ set ow [$myOutputWindow widget]
+ $ow tag configure $tag -underline 1 -foreground darkblue
+ $ow tag bind $tag <1> $command
+ $ow tag bind $tag <Enter> [list $ow configure -cursor hand2]
+ $ow tag bind $tag <Leave> [list $ow configure -cursor xterm]
+ $ow insert end $text $tag
+ return $tag
+ }
+
+ proc getcss {frame id} {
+ set hv3 [$frame hv3]
+ foreach css [$hv3 log get css] {
+ if {[lindex $css 0] eq $id} {return $css}
+ }
+ return ""
+ }
+
+ method DisplayJavascriptError {idx logscript iLine} {
+ $self Display javascript [list $idx $logscript]
+ $myCodeViewer yview -pickplace "$iLine.0"
+ $myCodeViewer tag add wheat "$iLine.0" "$iLine.0 lineend"
+ }
+ method DisplayCssError {pageid iLine} {
+ $self Display css $pageid
+ $myCodeViewer yview -pickplace "$iLine.0"
+ }
+
+ proc getlogscript {name} {
+ foreach {dom idx} [split $name .] {}
+ foreach logscript [$dom GetLog] {
+ if {[$logscript cget -name] eq $name} {return $logscript}
+ }
+ return ""
+ }
+
+ method Errors {page pageid} {
+ $myOutputWindow configure -state normal
+ switch -- $page {
+ css {
+ foreach {id f data errors} [eval getcss $pageid] break
+ $myOutputWindow insert end "Errors from CSS: $f\n" error
+ foreach {i n} $errors {
+ # The offsets stored in the $errors array are
+ # byte-offsets. Transform these to character offsets
+ # before using them:
+ set i [::tkhtml::charoffset $data $i]
+ set n [::tkhtml::charoffset [string range $data $i end] $n]
+
+ $myOutputWindow insert end " "
+
+ set nLine [llength [split [string range $data 0 $i] "\n"]]
+ $self OutputWindowLink "Line $nLine (skipped $n characters)" [
+ list $self DisplayCssError $pageid $nLine
+ ]
+ $myOutputWindow insert end "\n"
+ }
+ }
+ javascript {
+ foreach {idx dom logscript} $pageid break
+ set f "$idx. [$logscript cget -heading]"
+ $myOutputWindow insert end "Javascript errors: $f\n" error
+
+ set r [$logscript cget -result]
+ $myOutputWindow insert end " "
+ $myOutputWindow insert end "Error Message: \"[lindex $r 1]\"\n"
+ if {[lindex $r 2] ne ""} {
+ $myOutputWindow insert end " "
+ $myOutputWindow insert end "[lindex $r 2]\n"
+ }
+
+ foreach {zFile iLine zType zName} [lrange $r 3 end] {
+ set target [getlogscript $zFile]
+ if {$target ne ""} {
+ $myOutputWindow insert end " "
+ set cmd [list $self DisplayJavascriptError $idx $target $iLine]
+ $self OutputWindowLink "Line $iLine, [$target cget -heading]" $cmd
+ if {$zType ne "" || $zName ne ""} {
+ $myOutputWindow insert end " ($zType $zName)"
+ }
+ $myOutputWindow insert end "\n"
+ }
+ }
+
+ $myOutputWindow insert end "\n"
+ }
+ }
+ $myOutputWindow yview end
+ $myOutputWindow configure -state disabled
+ }
+
+ method AddLineNumbers {{name ""}} {
+ set line 1
+ set nLine [lindex [split [$myCodeViewer index end] .] 0]
+ for {set line 1} {$line < $nLine} {incr line} {
+ set nDigit 7
+ if {[info exists myBreakpoints($name,$line)]} {
+ set nDigit 5
+ }
+ set num [format "% ${nDigit}d " $line]
+ $myCodeViewer insert "${line}.0" $num linenumber
+
+ if {$nDigit == 5} {
+ $myCodeViewer insert "${line}.0" " " breakpoint
+ }
+ }
+ }
+
+ method ClickLineNumber {x y} {
+ if {$myPage ne "javascript"} return
+ foreach {idx logscript} $myPageId break;
+ set iLine [lindex [split [$myCodeViewer index @$x,$y] .] 0]
+
+ set var myBreakpoints($logscript,$iLine)
+
+ $myCodeViewer configure -state normal
+ $myCodeViewer delete ${iLine}.0 ${iLine}.2
+ if {[info exists $var]} {
+ unset $var
+ $myCodeViewer insert ${iLine}.0 " " linenumber
+ } else {
+ set $var 1
+ $myCodeViewer insert ${iLine}.0 " " breakpoint
+ }
+ $myCodeViewer configure -state disabled
+ }
+
+ method DisplayCss {frame styleid} {
+ set hv3 [$frame hv3]
+ foreach css [$hv3 log get css] {
+ foreach {id f data errors} $css break
+ if {$id eq $styleid} {
+ set iCurrent 0
+ foreach {iStart nLen} $errors {
+ # The offsets stored in the $errors array are
+ # byte-offsets. Transform these to character offsets
+ # before using them:
+ set iStart [::tkhtml::charoffset $data $iStart]
+ set nLen [
+ ::tkhtml::charoffset [string range $data $iStart end] $nLen
+ ]
+ $myCodeViewer insert end [
+ string range $data $iCurrent [expr {$iStart-1}]
+ ]
+ $myCodeViewer insert end [
+ string range $data $iStart [expr {$iStart+$nLen-1}]
+ ] red
+ set iCurrent [expr {$iStart + $nLen}]
+ }
+ $myCodeViewer insert end [string range $data $iCurrent end]
+ $self AddLineNumbers
+ }
+ }
+ }
+
+ method DisplayJavascript {idx logscript} {
+ set data [$logscript cget -script]
+ $myCodeViewer insert end $data
+
+ set heading [$logscript cget -heading]
+ $myLabel configure -text "Javascript Code: [expr {$idx+1}] $heading"
+
+ $self AddLineNumbers $logscript
+ }
+
+ method DisplayIndex {} {
+ set top [gui_current top_frame]
+ if {"" eq [[$top hv3] log get html]} {
+ $myCodeViewer insert end [join {
+ {Source logging was not enabled when this document was loaded.}
+ {To browse the document source code, select a different option}
+ {from the "Debug->Application Source Logging" menu and reload}
+ {the document.}
+ }]
+ return
+ }
+ $self DisplayResources $top 2
+ }
+
+ method DisplayResources {frame iIndent} {
+ set hv3 [$frame hv3]
+
+ set zIndent [string repeat " " $iIndent]
+ set uri [$hv3 uri get]
+ $myCodeViewer insert end "${zIndent}Frame: $uri\n"
+
+ # Link for the HTML file.
+ #
+ $myCodeViewer insert end "${zIndent} "
+ set cmd1 [list $self Display html $frame]
+ set cmd2 [list ::HtmlDebug::browse $hv3 [$hv3 node]]
+ $self CreateCodeViewerLink "View Html" $cmd1
+ $myCodeViewer insert end " "
+ $self CreateCodeViewerLink "Open Tree Browser..." $cmd2
+ $myCodeViewer insert end "\n"
+
+ # Links for each loaded CSS document.
+ #
+ foreach css [$hv3 log get css] {
+ foreach {id filename data errors} $css break
+ $myCodeViewer insert end "${zIndent} "
+ set cmd [list $self Display css [list $frame $id]]
+ $self CreateCodeViewerLink "View CSS" $cmd
+ $myCodeViewer insert end ": $filename "
+ if {[llength $errors] > 0} {
+ set nErr [expr {[llength $errors]/2}]
+ set cmd [list $self Errors css [list $frame $id]]
+ set t [$self CreateCodeViewerLink "($nErr parse errors)" $cmd]
+ $myCodeViewer tag configure $t -foreground red
+ $myCodeViewer insert end " "
+ }
+ $myCodeViewer insert end "\n"
+ }
+
+ # Links for each javascript file.
+ #
+ set dom [$hv3 dom]
+ set ii 0
+ foreach logscript [$dom GetLog] {
+ if {[$logscript cget -isevent]} continue
+ incr ii
+ set cmd [list $self Display javascript [list $ii $logscript]]
+ set nLine [llength [split [$logscript cget -script] "\n"]]
+ $myCodeViewer insert end "$zIndent "
+ $self CreateCodeViewerLink "View Javascript" $cmd
+ $myCodeViewer insert end ": [$logscript cget -heading] "
+ if {[$logscript cget -rc]} {
+ set tag [$self CreateCodeViewerLink "(Failed) " [
+ list $self Errors javascript [list $ii $dom $logscript]
+ ]]
+ $myCodeViewer tag configure $tag -foreground red
+ } else {
+ $myCodeViewer insert end "(Ok) "
+ }
+ $myCodeViewer insert end "($nLine lines)\n"
+ }
+
+ $myCodeViewer insert end "\n"
+ foreach child [$frame child_frames] {
+ $self DisplayResources $child [expr {$iIndent+4}]
+ }
+ }
+ }
+
+ proc launch_console {} {
+ if {![winfo exists .console]} {
+ toplevel .console \
+ -height [expr [winfo height .] - 100] \
+ -width [expr [winfo width .] - 100]
+ ::hv3::console .console.console
+ pack .console.console -fill both -expand 1
+
+ set w [winfo reqwidth .console]
+ set h [winfo reqheight .console]
+ scan [wm geometry [winfo parent .console]] "%dx%d+%d+%d" pw ph px py
+ set geom "+[expr $px + $pw/2 - $w/2]+[expr $py + $ph/2 - $h/2]"
+ wm geometry .console $geom
+ }
+
+ wm state .console normal
+ raise .console
+ }
+}
+
+# This [namespace eval] block adds the special commands designed for
+# interactive use from the debugging console:
+#
+# primitives
+# breakpoints
+# heapdebug
+#
+namespace eval ::hv3::console_commands {
+
+ proc help {} {
+ return "
+ primitives
+ breakpoints
+ heapdebug
+ "
+ }
+
+ proc primitives {} {
+ set zRet ""
+ set iIndent 0
+ foreach primitive [hv3_html _primitives] {
+ set t [lindex $primitive 0]
+ if {$t eq "draw_origin_end"} {incr iIndent -4}
+ append zRet [string repeat " " $iIndent] $primitive "\n"
+ if {$t eq "draw_origin_start"} {incr iIndent 4}
+ incr hist($t)
+ }
+
+ append zRet "\n"
+ foreach {key value} [array get hist] {
+ append zRet $key ":" $value "\n"
+ }
+
+ set zRet
+ }
+
+ proc gimages {} {
+ images 1
+ }
+ proc images {{all_tabs 0}} {
+ set nPix 0
+ set nImg 0
+
+ if {$all_tabs} {
+ set data [list]
+ foreach browser [.notebook tabs] {
+ eval lappend data [[$browser hv3] html _images]
+ }
+ } else {
+ set data [hv3 html _images]
+ }
+
+ set header [list URL "Tk image" pixmap width height alpha references]
+ foreach record [concat [list $header] $data] {
+ foreach $header $record break
+ if {[string length $URL] > 15} {
+ set URL "...[string range $URL [expr [string length $URL]-12] end]"
+ }
+ if {$URL eq ""} {set alpha ""}
+ append ret [format "%-15s %7s %9s %6s %6s %8s %11s\n" \
+ $URL $pixmap ${Tk image} $width $height $alpha $references
+ ]
+ if {$width ne "width"} {
+ if {$pixmap eq "PIX"} {
+ incr nPix [expr $width * $height]
+ } else {
+ incr nImg [expr $width * $height]
+ }
+ }
+ }
+ append ret "\n"
+ append ret " total pixmap pixels: $nPix\n"
+ append ret " total image pixels: $nImg"
+ set ret
+ }
+
+ proc heapdebug {} {
+ pretty_print_heapdebug
+ }
+
+ proc breakpoints {} {
+ }
+
+ proc hv3 {args} {
+ set hv3 [gui_current hv3]
+ eval $hv3 $args
+ }
+
+ proc console {args} {
+ eval .console.console $args
+ }
+}
+
+
+proc pretty_print_heapdebug {} {
+ set data [lsort -index 2 -integer [::tkhtml::heapdebug]]
+ set ret ""
+ set nTotalS 0
+ set nTotalB 0
+ foreach type $data {
+ foreach {zStruct nStruct nByte} $type {}
+ incr nTotalB $nByte
+ incr nTotalS $nStruct
+ set avg [expr {$nByte/$nStruct}]
+ append ret [
+ format "% -30s % 10d % 10d %12s %10d\n" $zStruct $nStruct $nByte "($avg/alloc)" $nTotalB]
+ }
+ append ret [format "% -30s % 10d % 10d\n" "Totals" $nTotalS $nTotalB]
+ set ret
+}
+
+proc pretty_print_vars {} {
+ set ret ""
+ set nTotal 0
+ set nNamespace 0
+ foreach e [lsort -integer -index 1 [get_vars]] {
+ incr nTotal [lindex $e 1]
+ incr nNamespace 1
+ incr nArray [lindex $e 2]
+ append ret [format "% -50s %d (%d arrays)\n" [lindex $e 0] [lindex $e 1] [lindex $e 2]]
+ }
+ append ret [format "% -50s %d\n" TOTAL($nNamespace) $nTotal]
+ set ret
+}
+proc pretty_print_cmds {} {
+ set ret ""
+ set nTotal 0
+ set nNamespace 0
+ count_commands :: ::pretty_print_cmds_report
+ foreach e [lsort -integer -index 1 $::pretty_print_cmds_report] {
+ incr nTotal [lindex $e 1]
+ incr nNamespace 1
+ append ret [format "% -50s %d\n" [lindex $e 0] [lindex $e 1]]
+ }
+ unset ::pretty_print_cmds_report
+ append ret [format "% -50s %d\n" TOTAL($nNamespace) $nTotal]
+ set ret
+}
+
+proc tree_to_report {tree indent} {
+ set i [string repeat " " $indent]
+ set f [lindex $tree 0]
+
+ set name [$f cget -name]
+ set uri [[$f hv3] uri get]
+
+ append ret [format "% -40s %s\n" $i\"$name\" $uri]
+ foreach child [lindex $tree 1] {
+ append ret [tree_to_report $child [expr {$indent+4}]]
+ }
+ set ret
+}
+proc pretty_print_frames {} {
+ tree_to_report [lindex [gui_current frames_tree] 0] 0
+}
+
+proc get_vars {{ns ::}} {
+ set nVar 0
+ set nArray 0
+ set ret [list]
+ set vlist [info vars ${ns}::*]
+ foreach var $vlist {
+ if {[array exists $var]} {
+ incr nVar [llength [array names $var]]
+ incr nArray 1
+ } else {
+ incr nVar 1
+ }
+ }
+ lappend ret [list $ns $nVar $nArray]
+ foreach child [namespace children $ns] {
+ eval lappend ret [get_vars $child]
+ }
+ set ret
+}
+proc count_vars {{ns ::} {print 0}} {
+ set nVar 0
+ foreach entry [get_vars $ns] {
+ incr nVar [lindex $entry 1]
+ }
+ set nVar
+}
+proc count_commands {{ns ::} {reportvar ""}} {
+ set nCmd [llength [info commands ${ns}::*]]
+ if {$reportvar ne ""} {
+ uplevel #0 [list lappend $reportvar [list $ns $nCmd]]
+ }
+ foreach child [namespace children $ns] {
+ incr nCmd [count_commands $child $reportvar]
+ }
+ set nCmd
+}
+proc count_namespaces {{ns ::}} {
+ set nNs 1
+ foreach child [namespace children $ns] {
+ incr nNs [count_namespaces $child]
+ }
+ set nNs
+}
+
diff --git a/hv/hv3_doctype.tcl b/hv/hv3_doctype.tcl
index e23e101..0d0196c 100644
--- a/hv/hv3_doctype.tcl
+++ b/hv/hv3_doctype.tcl
@@ -1,178 +1,4 @@
-namespace eval hv3 { set {version($Id: hv3_doctype.tcl,v 1.7 2007/06/26 14:41:27 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3_doctype.tcl,v 1.9 2007/12/17 07:27:11 danielk1977 Exp $)} 1 }
namespace eval hv3 {}
-proc ::hv3::char {text idx} {
- return [string range $text $idx $idx]
-}
-
-proc ::hv3::next_word {text idx idx_out} {
-
- while {[char $text $idx] eq " "} { incr idx }
-
- set idx2 $idx
- set c [char $text $idx2]
-
- if {$c eq "\""} {
- # Quoted identifier
- incr idx2
- set c [char $text $idx2]
- while {$c ne "\"" && $c ne ""} {
- incr idx2
- set c [char $text $idx2]
- }
- incr idx2
- set word [string range $text [expr $idx+1] [expr $idx2 - 2]]
- } else {
- # Unquoted identifier
- while {$c ne ">" && $c ne " " && $c ne ""} {
- incr idx2
- set c [char $text $idx2]
- }
- set word [string range $text $idx [expr $idx2 - 1]]
- }
-
- uplevel [list set $idx_out $idx2]
- return $word
-}
-
-proc ::hv3::sniff_doctype {text pIsXhtml} {
- upvar $pIsXhtml isXHTML
- # <!DOCTYPE TopElement Availability "IDENTIFIER" "URL">
-
- set QuirksmodeIdentifiers [list \
- "-//w3c//dtd html 4.01 transitional//en" \
- "-//w3c//dtd html 4.01 frameset//en" \
- "-//w3c//dtd html 4.0 transitional//en" \
- "-//w3c//dtd html 4.0 frameset//en" \
- "-//softquad software//dtd hotmetal pro 6.0::19990601::extensions to html 4.0//en" \
- "-//softquad//dtd hotmetal pro 4.0::19971010::extensions to html 4.0//en" \
- "-//ietf//dtd html//en//3.0" \
- "-//w3o//dtd w3 html 3.0//en//" \
- "-//w3o//dtd w3 html 3.0//en" \
- "-//w3c//dtd html 3 1995-03-24//en" \
- "-//ietf//dtd html 3.0//en" \
- "-//ietf//dtd html 3.0//en//" \
- "-//ietf//dtd html 3//en" \
- "-//ietf//dtd html level 3//en" \
- "-//ietf//dtd html level 3//en//3.0" \
- "-//ietf//dtd html 3.2//en" \
- "-//as//dtd html 3.0 aswedit + extensions//en" \
- "-//advasoft ltd//dtd html 3.0 aswedit + extensions//en" \
- "-//ietf//dtd html strict//en//3.0" \
- "-//w3o//dtd w3 html strict 3.0//en//" \
- "-//ietf//dtd html strict level 3//en" \
- "-//ietf//dtd html strict level 3//en//3.0" \
- "html" \
- "-//ietf//dtd html//en" \
- "-//ietf//dtd html//en//2.0" \
- "-//ietf//dtd html 2.0//en" \
- "-//ietf//dtd html level 2//en" \
- "-//ietf//dtd html level 2//en//2.0" \
- "-//ietf//dtd html 2.0 level 2//en" \
- "-//ietf//dtd html level 1//en" \
- "-//ietf//dtd html level 1//en//2.0" \
- "-//ietf//dtd html 2.0 level 1//en" \
- "-//ietf//dtd html level 0//en" \
- "-//ietf//dtd html level 0//en//2.0" \
- "-//ietf//dtd html strict//en" \
- "-//ietf//dtd html strict//en//2.0" \
- "-//ietf//dtd html strict level 2//en" \
- "-//ietf//dtd html strict level 2//en//2.0" \
- "-//ietf//dtd html 2.0 strict//en" \
- "-//ietf//dtd html 2.0 strict level 2//en" \
- "-//ietf//dtd html strict level 1//en" \
- "-//ietf//dtd html strict level 1//en//2.0" \
- "-//ietf//dtd html 2.0 strict level 1//en" \
- "-//ietf//dtd html strict level 0//en" \
- "-//ietf//dtd html strict level 0//en//2.0" \
- "-//webtechs//dtd mozilla html//en" \
- "-//webtechs//dtd mozilla html 2.0//en" \
- "-//netscape comm. corp.//dtd html//en" \
- "-//netscape comm. corp.//dtd html//en" \
- "-//netscape comm. corp.//dtd strict html//en" \
- "-//microsoft//dtd internet explorer 2.0 html//en" \
- "-//microsoft//dtd internet explorer 2.0 html strict//en" \
- "-//microsoft//dtd internet explorer 2.0 tables//en" \
- "-//microsoft//dtd internet explorer 3.0 html//en" \
- "-//microsoft//dtd internet explorer 3.0 html strict//en" \
- "-//microsoft//dtd internet explorer 3.0 tables//en" \
- "-//sun microsystems corp.//dtd hotjava html//en" \
- "-//sun microsystems corp.//dtd hotjava strict html//en" \
- "-//ietf//dtd html 2.1e//en" \
- "-//o'reilly and associates//dtd html extended 1.0//en" \
- "-//o'reilly and associates//dtd html extended relaxed 1.0//en" \
- "-//o'reilly and associates//dtd html 2.0//en" \
- "-//sq//dtd html 2.0 hotmetal + extensions//en" \
- "-//spyglass//dtd html 2.0 extended//en" \
- "+//silmaril//dtd html pro v0r11 19970101//en" \
- "-//w3c//dtd html experimental 19960712//en" \
- "-//w3c//dtd html 3.2//en" \
- "-//w3c//dtd html 3.2 final//en" \
- "-//w3c//dtd html 3.2 draft//en" \
- "-//w3c//dtd html experimental 970421//en" \
- "-//w3c//dtd html 3.2s draft//en" \
- "-//w3c//dtd w3 html//en" \
- "-//metrius//dtd metrius presentational//en" \
- ]
-
- set isXHTML 0
- set idx [string first <!DOCTYPE $text]
- if {$idx < 0} { return "quirks" }
-
- # Try to parse the TopElement bit. No quotes allowed.
- incr idx [string length "<!DOCTYPE "]
- while {[string range $text $idx $idx] eq " "} { incr idx }
-
- set TopElement [string tolower [next_word $text $idx idx]]
- set Availability [string tolower [next_word $text $idx idx]]
- set Identifier [string tolower [next_word $text $idx idx]]
- set Url [next_word $text $idx idx]
-
-# foreach ii [list TopElement Availability Identifier Url] {
-# puts "$ii -> [set $ii]"
-# }
-
- # Figure out if this should be handled as XHTML
- #
- if {[string first xhtml $Identifier] >= 0} {
- set isXHTML 1
- }
-
-
- if {$Availability eq "public"} {
- set s [expr [string length $Url] > 0]
- if {
- $Identifier eq "-//w3c//dtd xhtml 1.0 transitional//en" ||
- $Identifier eq "-//w3c//dtd xhtml 1.0 frameset//en" ||
- ($s && $Identifier eq "-//w3c//dtd html 4.01 transitional//en") ||
- ($s && $Identifier eq "-//w3c//dtd html 4.01 frameset//en")
- } {
- return "almost standards"
- }
- if {[lsearch $QuirksmodeIdentifiers $Identifier] >= 0} {
- return "quirks"
- }
- }
-
- return "standards"
-}
-
-
-proc ::hv3::configure_doctype_mode {html text pIsXhtml} {
- upvar $pIsXhtml isXHTML
- set mode [sniff_doctype $text isXHTML]
-
- switch -- $mode {
- "quirks" { set defstyle [::tkhtml::htmlstyle -quirks] }
- "almost standards" { set defstyle [::tkhtml::htmlstyle] }
- "standards" { set defstyle [::tkhtml::htmlstyle]
- }
- }
-
- $html configure -defaultstyle $defstyle -mode $mode
-
-# puts "Using mode $mode"
- return $mode
-}
-
diff --git a/hv/hv3_dom.tcl b/hv/hv3_dom.tcl
index 6affbe8..74a54b2 100644
--- a/hv/hv3_dom.tcl
+++ b/hv/hv3_dom.tcl
@@ -1,16 +1,10 @@
-namespace eval hv3 { set {version($Id: hv3_dom.tcl,v 1.77 2007/09/28 16:33:32 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3_dom.tcl,v 1.96 2008/02/15 19:01:46 danielk1977 Exp $)} 1 }
#--------------------------------------------------------------------------
# Snit types in this file:
#
# ::hv3::dom -- One object per js interpreter.
-# ::hv3::dom::logdata -- Data for js debugger
-# ::hv3::dom::logwin -- Js debugger GUI
-#
-# Special widgets used in the ::hv3::dom::logwin GUI:
-#
-# ::hv3::dom::stacktrace -- Debugger "Stack" tab
-# ::hv3::dom::searchbox -- Debugger "Search" tab
+# ::hv3::dom::logscript -- Logging data for debugging.
#
package require snit
@@ -18,64 +12,63 @@ package require snit
#-------------------------------------------------------------------------
# Class ::hv3::dom
#
+# A single instance of this class is created for each javascript
+# enabled ::hv3::hv3 widget. The javascript module.
+#
+# SYNOPSYS
+#
# set dom [::hv3::dom %AUTO% $hv3]
#
-# $dom script HV3 ATTR SCRIPT
-# $dom noscript HV3 ATTR SCRIPT
+# $dom script ATTR SCRIPT
#
# $dom javascript SCRIPT
# $dom event EVENT NODE
+# $dom set_object_property {object property value}
# $dom reset
#
# $dom destroy
#
-# Debugging aids:
-# $dom javascriptlog
+# $dom javascriptlog ;# DEBUGGING ONLY.
+#
+# $dom configure -enable BOOLEAN
+#
+# DESCRIPTION
#
snit::type ::hv3::dom {
+
+ # Javascript interpreter.
variable mySee ""
- # Boolean option. Enable this DOM implementation or not.
- option -enable -default 0 -configuremethod SetEnable
+ # Instance of [::hv3::hv3] that contains the window used as the
+ # global object by this interpreter.
+ variable myHv3 ""
# Logging command.
option -logcmd -default "" -configuremethod ConfigureLogcmd
- # Instance of [::hv3::browser_toplevel] associated with this object.
- variable myBrowser ""
-
# Used to assign unique ids to each block of script evaluated.
# This is used by the script debugging gui.
variable myNextCodeblockNumber 1
- constructor {browser args} {
- set myBrowser $browser
- set myLogData [::hv3::dom::logdata %AUTO% $self]
+ constructor {hv3 args} {
+
+ # Call [::hv3::enable_javascript] to make sure the hv3_dom_XXX.tcl
+ # files have been loaded.
+ ::hv3::enable_javascript
+
+ set myHv3 $hv3
+ set mySee [::see::interp [list ::hv3::DOM::Window $self $hv3]]
+
$self configurelist $args
- }
- method SetEnable {option value} {
- set options($option) $value
- if {$value} ::hv3::enable_javascript
- if {$mySee ne "" && ![$self HaveScripting]} {
- foreach win [array names myWindows] {
- $mySee make_transient [list ::hv3::DOM::Window $self $win]
- }
- $mySee destroy
- set mySee ""
- }
- if {$mySee eq "" && [$self HaveScripting]} {
- set mySee [::see::interp]
- ::hv3::profile::instrument $mySee
- foreach win [array names myWindows] {
- $mySee window [list ::hv3::DOM::Window $self $win]
- }
+ set frame [$myHv3 cget -frame]
+ if {$frame ne ""} {
+ $frame update_parent_dom $mySee
}
}
destructor {
catch { $mySee destroy }
- catch { $myLogData destroy }
}
# Invoked to set the value of the -logcmd option
@@ -86,12 +79,6 @@ snit::type ::hv3::dom {
}
}
- # Return true if the Tclsee extension is available and
- # the user has foolishly enabled it.
- method HaveScripting {} {
- return [expr {$options(-enable) && [info commands ::see::interp] ne ""}]
- }
-
method InitWindowEvents {body} {
set script ""
foreach A {onload onunload} {
@@ -102,57 +89,11 @@ snit::type ::hv3::dom {
}]
}
}
- $mySee eval -window [$self node_to_window $body] -noresult $script
- }
-
- # Delete any allocated interpreter and objects. This is called in
- # two circumstances: when deleting this object and from within
- # the [reset] method.
- #
- method clear {} {
- # Delete the old interpreter and the various objects, if they exist.
- # They may not exist, if this is being called from within the
- # object constructor or scripting is disabled.
- # if {$mySee ne ""} {
- # $mySee make_transient [$self window]
- # $mySee destroy
- # set mySee ""
- # }
- }
-
- method reset {} {
-return
-
- $self clear
-
- if {[$self HaveScripting]} {
-
- # Set up the new interpreter with the global "Window" object.
- set mySee [::see::interp]
- $mySee window [$self window]
- set myWindowInitEvents 0
-
- $mySee log $options(-logcmd)
-
- # Reset the debugger.
- $self LogReset
- }
-
- # Reset the counter used to name blobs of code. This way, if
- # a page is reloaded the names are the same, which makes it
- # possible to set breakpoints in the debugger before reloading
- # a page.
- #
- # Of course, the network might deliver external scripts
- # in a different order. Maybe there should be a debugging option
- # to block while downloading all scripts, even if the "defer"
- # attribute is set.
- #
- set myNextCodeblockNumber 1
+ $mySee eval -noresult $script
}
method NewFilename {} {
- return "blob[incr myNextCodeblockNumber]"
+ return "$self.[incr myNextCodeblockNumber]"
}
# This method is called as a Tkhtml3 "script handler" for elements
@@ -164,83 +105,71 @@ return
# This is done externally, not by code within this type definition.
# If scripting is not enabled in this browser, this method is a no-op.
#
- method script {hv3 attr script} {
- if {$mySee ne ""} {
- $hv3 write wait
- array set a $attr
- if {[info exists a(src)]} {
- set fulluri [$hv3 resolve_uri $a(src)]
- set handle [::hv3::download %AUTO% \
- -uri $fulluri \
- -mimetype text/javascript \
- -cachecontrol normal \
- ]
- set fin [mymethod scriptCallback $hv3 $attr $handle]
- $handle configure -finscript $fin
- $hv3 makerequest $handle
- # $self Log "Dispatched script request - $handle" "" "" ""
- } else {
- return [$self scriptCallback $hv3 $attr "" $script]
+ method script {attr script} {
+ $myHv3 html write wait
+ array set a $attr
+ if {[info exists a(src)]} {
+ set fulluri [$myHv3 resolve_uri $a(src)]
+ set handle [::hv3::request %AUTO% \
+ -uri $fulluri \
+ -mimetype text/javascript \
+ -cachecontrol normal \
+ ]
+ if {[$myHv3 encoding] ne ""} {
+ $handle configure -encoding [$myHv3 encoding]
}
- }
- return ""
- }
-
- # Script handler for <noscript> elements. If javascript is enabled,
- # do nothing (meaning don't process the contents of the <noscript>
- # block). On the other hand, if js is disabled, feed the contents
- # of the <noscript> block back to the parser using the same
- # Tcl interface used for document.write().
- #
- method noscript {hv3 attr script} {
- if {$mySee ne ""} {
- return ""
+
+ set fin [mymethod ScriptCallback $attr $handle]
+ $handle configure -finscript $fin
+ $myHv3 makerequest $handle
} else {
- [$hv3 html] write text $script
+ return [$self ScriptCallback $attr "" $script]
}
+ return ""
}
# If a <SCRIPT> element has a "src" attribute, then the [script]
# method will have issued a GET request for it. This is the
# successful callback.
#
- method scriptCallback {hv3 attr downloadHandle script} {
-
+ method ScriptCallback {attr downloadHandle script} {
+ set title ""
if {$downloadHandle ne ""} {
# Handle an HTTP redirect or a Location header:
#
- if {[$hv3 HandleLocation $downloadHandle]} return
- $downloadHandle destroy
+ if {[$myHv3 HandleLocation $downloadHandle]} return
+ set title [$downloadHandle cget -uri]
+ $downloadHandle release
}
- if {$::hv3::dom::reformat_scripts_option} {
- set script [string map {"\r\n" "\n"} $script]
- set script [string map {"\r" "\n"} $script]
- set script [::see::format $script]
+ if {$title eq ""} {
+ set attributes ""
+ foreach {a v} $attr {
+ append attributes " [::hv3::string::htmlize $a]="
+ append attributes "\"[::hv3::string::htmlize $v]\""
+ }
+ set title "<script$attributes>"
}
- set name [$self NewFilename]
- set w [list ::hv3::DOM::Window $self $hv3]
- set rc [catch {$mySee eval -window $w -noresult -file $name $script} msg]
-
- set attributes ""
- foreach {a v} $attr {
- append attributes " [htmlize $a]=\"[htmlize $v]\""
+ if {[info exists ::hv3::reformat_scripts_option]} {
+ if {$::hv3::reformat_scripts_option} {
+ set script [string map {"\r\n" "\n"} $script]
+ set script [string map {"\r" "\n"} $script]
+ set script [::see::format $script]
+ }
}
- set title "<SCRIPT$attributes>"
- $myLogData Log $title $name $script $rc $msg
- $hv3 write continue
+ set name [$self NewFilename]
+ set rc [catch {$mySee eval -noresult -file $name $script} msg]
+ if {$rc} {puts "MSG: $msg"}
+
+ $self Log $title $name $script $rc $msg
+ $myHv3 html write continue
}
- method javascript {hv3 script} {
- set msg ""
- if {$mySee ne ""} {
- set name [$self NewFilename]
- if {$hv3 eq ""} {set hv3 [$myBrowser hv3]}
- set w [$self hv3_to_window $hv3]
- set rc [catch {$mySee eval -window $w -file $name $script} msg]
- }
+ method javascript {script} {
+ set name [$self NewFilename]
+ set rc [catch {$mySee eval -file $name $script} msg]
return $msg
}
@@ -275,7 +204,7 @@ return
}
$self InitWindowEvents $node
- set js_obj [$self node_to_window $node]
+ set js_obj [::hv3::DOM::node_to_window $node]
} else {
set js_obj [::hv3::dom::wrapWidgetNode $self $node]
}
@@ -289,8 +218,7 @@ return
#
if {$rc} {
set name [string map {blob error} [$self NewFilename]]
- $myLogData Log "$node $event event" $name "event-handler" $rc $msg
- $myLogData Popup
+ $self EventLog "$event $node" $name "" $rc $msg
set msg error
}
@@ -312,8 +240,7 @@ return
if {$rc} {
set objtype [lindex $js_obj 0]
set name [string map {blob error} [$self NewFilename]]
- $myLogData Log "$objtype $event event" $name "event-handler" $rc $msg
- $myLogData Popup
+ $self Log "$objtype $event event" $name "event-handler" $rc $msg
set msg ""
}
@@ -321,12 +248,16 @@ return
}
method DoFramesetLoadEvents {node} {
- set frame [$self node_to_frame $node]
+ set frame [[winfo parent [$node html]] me]
# If $frame is a replacement object for an <IFRAME> element,
# then fire the load event on the <IFRAME> element.
if {[$frame cget -iframe] ne ""} {
- $self DispatchHtmlEvent load [::hv3::dom::wrapWidgetNode $self [$frame cget -iframe]]
+ set iframe [$frame cget -iframe]
+ set hv3 [[winfo parent [$iframe html]] hv3 me]
+
+ set js_obj [::hv3::dom::wrapWidgetNode [$hv3 dom] $iframe]
+ $hv3 dom DispatchHtmlEvent load $js_obj
return
}
@@ -334,10 +265,12 @@ return
if {$p eq ""} return
foreach c [$p child_frames] {
- if {0 == [[$c hv3] onload_fired]} return
+ if {0 == [[$c hv3] onload_fired]} {
+ return
+ }
}
- set js_obj [$self hv3_to_window [$p hv3]]
+ set js_obj [::hv3::DOM::hv3_to_window [$p hv3]]
# Dispatch the event.
$self DispatchHtmlEvent load $js_obj
@@ -372,132 +305,48 @@ return
set Node [::hv3::dom::wrapWidgetNode $self $node]
set rc [catch {
+ $mySee node $Node
::hv3::dom::dispatchMouseEvent $self $event $Node $x $y $args
} msg]
if {$rc} {
set name [string map {blob error} [$self NewFilename]]
- $myLogData Log "$node $event event" $name "event-handler" $rc $msg
- $myLogData Popup
+ $self EventLog "$event $node" $name "" $rc $msg
set msg "prevent"
}
set msg
}
- #----------------------------------------------------------------
- # Given an html-widget node-handle, return the corresponding
- # ::hv3::DOM::HTMLDocument object. i.e. the thing needed for
- # the Node.ownerDocument javascript property of an HTMLElement or
- # Text Node.
- #
- method node_to_document {node} {
- lindex [eval [$self node_to_window $node] Get document] 1
- }
-
- #----------------------------------------------------------------
- # Given an html-widget node-handle, return the corresponding
- # ::hv3::hv3 object. i.e. the owner of the node-handle.
- #
- method node_to_hv3 {node} {
- set html [$node html]
- winfo parent [winfo parent $html]
- }
-
- method node_to_frame {node} {
- winfo parent [$self node_to_hv3 $node]
- }
-
- # Given a Tkhtml3 node-handle, return the javascript wrapper
- # for the containing window.
- #
- method node_to_window {node} {
- set hv3 [$self node_to_hv3 $node]
- list ::hv3::DOM::Window $self $hv3
- }
-
- method hv3_to_window {hv3} {
- list ::hv3::DOM::Window $self $hv3
- }
-
- # The following methods:
- #
- # [make_window]
- # [clear_window]
- # [delete_window]
- #
- # are used to manage the life-time of DOM Window objects.
- #
- method clear_window {hv3} {
- catch {$mySee clear [list ::hv3::DOM::Window $self $hv3]}
-
- # If javascript is enabled and Window object being cleared
- # is the top-level frame, delete and recreated the SEE interpreter.
- # This is necessary, in case the previous URI was in the
- # "home://" namespace.
- #
- # Also, reset the debugging gui here.
- #
- if {$mySee ne ""} {
- set frame [winfo parent $hv3]
- if {$frame eq [$frame top_frame]} {
- foreach win [array names myWindows] {
- $mySee make_transient [list ::hv3::DOM::Window $self $hv3]
- }
- $self LogReset
- $mySee destroy
- set mySee ""
-
- array unset myWindows
- set myWindows($hv3) 1
- if {[$self HaveScripting]} {
- set mySee [::see::interp]
- ::hv3::profile::instrument $mySee
- $mySee log $options(-logcmd)
- $mySee window [list ::hv3::DOM::Window $self $hv3]
- }
- }
- }
- }
- method make_window {hv3} {
- set myWindows($hv3) 1
- if {$mySee ne ""} {
- $mySee window [list ::hv3::DOM::Window $self $hv3]
- }
- }
- method delete_window {hv3} {
- catch { unset myWindows($hv3) }
- catch { $mySee clear [list ::hv3::DOM::Window $self $hv3] }
- catch { $mySee make_transient [list ::hv3::DOM::Window $self $hv3] }
- }
- variable myWindows -array [list]
-
- method see {} { return $mySee }
+ method see {} { return $mySee }
#------------------------------------------------------------------
# Logging system follows.
#
- variable myLogData
+ variable myLogList ""
- # This variable contains the current javascript debugging log in HTML
- # form. It is appended to by calls to [Log] and truncated to an
- # empty string by [LogReset]. If the debugging window is displayed,
- # the contents are identical to that of this variable.
- #
- variable myLogDocument ""
+ method GetLog {} {return $myLogList}
+
+ method Log {heading name script rc result} {
+ if {![info exists ::hv3::log_source_option]} return
+ if {!$::hv3::log_source_option} return
- method Log {heading script rc result} {
- $myLogData Log $heading $script $rc $result
- return
+ set obj [::hv3::dom::logscript %AUTO% \
+ -rc $rc -heading $heading -script $script -result $result -name $name
+ ]
+ lappend myLogList $obj
}
+ method EventLog {heading name script rc result} {
+ if {![info exists ::hv3::log_source_option]} return
+ if {!$::hv3::log_source_option} return
- method LogReset {} {
- $myLogData Reset
- return
- }
+ puts "error: $result"
+ set obj [::hv3::dom::logscript %AUTO% -isevent true \
+ -rc $rc -heading $heading -script $script -result $result -name $name
+ ]
+ lappend myLogList $obj
- method javascriptlog {} {
- $myLogData Popup
- return
+ ::hv3::launch_console
+ .console.console Errors javascript [list -1 $self $obj]
}
# Called by the tree-browser to get event-listener info for the
@@ -510,14 +359,10 @@ return
}
#-----------------------------------------------------------------------
-# ::hv3::dom::logdata
# ::hv3::dom::logscript
#
-# Javascript debugger state.
-#
-# ::hv3::dom::logwin
-#
-# Toplevel window widget that implements the javascript debugger.
+# An object type to store the results of executing a block of
+# javascript or firing a javascript event.
#
snit::type ::hv3::dom::logscript {
option -rc -default ""
@@ -525,741 +370,34 @@ snit::type ::hv3::dom::logscript {
option -script -default ""
option -result -default ""
option -name -default ""
+ option -isevent -default 0
}
-snit::type ::hv3::dom::logdata {
-
- # Handle for associated (owner) ::hv3::dom object.
- #
- variable myDom ""
-
- # Ordered list of ::hv3::dom::logscript objects. The scripts
- # that make up the application being debugged.
- #
- variable myLogScripts [list]
-
- # Name of top-level debugging GUI window. At any time, this window
- # may or may not exist. This object is responsible for creating
- # it when it is required.
- #
- variable myWindow ""
-
- # Array of breakpoints set in the script. The array key is
- # "${zFilename}:${iLine}". i.e. to test if there is a breakpoint
- # in file "blob4" line 10, do:
- #
- # if {[info exists myBreakpoints(blob4:10)]} {
- # ... breakpoint processing ...
- # }
- #
- variable myBreakpoints -array [list]
-
- variable myInReload 0
-
- constructor {dom} {
- set myDom $dom
- set myWindow ".[string map {: _} $self]_logwindow"
- }
-
- method Log {heading name script rc result} {
- set ls [::hv3::dom::logscript %AUTO% \
- -rc $rc -name $name -heading $heading -script $script -result $result
- ]
- lappend myLogScripts $ls
- }
-
- method dom {} {
- return $myDom
- }
-
- method Reset {} {
- foreach ls $myLogScripts {
- $ls destroy
- }
- set myLogScripts [list]
-
- if {$myInReload} {
- if {[llength [array names myBreakpoints]] > 0} {
- [$myDom see] trace [mymethod SeeTrace]
- }
- } else {
- array unset myBreakpoints
- }
- }
-
- method Popup {} {
- if {![winfo exists $myWindow]} {
- ::hv3::dom::logwin $myWindow $self
- }
- wm state $myWindow normal
- raise $myWindow
- $myWindow Populate
- }
-
- destructor {
- $self Reset
- }
-
-
- method GetList {} {
- return $myLogScripts
- }
-
- method Evaluate {script} {
- set res [$myDom javascript "" $script]
- return $res
- }
-
- method BrowseToNode {node} {
- set hv3 [winfo parent [winfo parent [$node html]]]
- ::HtmlDebug::browse $hv3 $node
- }
-
- method SeeTrace {eEvent zFilename iLine} {
- if {$eEvent eq "statement"} {
- if {[info exists myBreakpoints(${zFilename}:$iLine)]} {
- # There is a breakpoint set on this line. Pop up the
- # debugging GUI and set the breakpoint stack.
- $self Popup
- $myWindow Breakpoint $zFilename $iLine
- }
- }
- }
-
- method breakpoints {} {
- return [array names myBreakpoints]
- }
-
- method add_breakpoint {blobid lineno} {
- set myBreakpoints(${blobid}:${lineno}) 1
- [$myDom see] trace [mymethod SeeTrace]
- }
-
- method clear_breakpoint {blobid lineno} {
- unset -nocomplain myBreakpoints(${blobid}:${lineno})
- if {[llength [$self breakpoints]]==0} {
- [$myDom see] trace ""
- }
- }
-
- # Called by the GUI when the user issues a "reload" command.
- # The difference between this and clicking the reload button
- # in the GUI is that breakpoints are persistent when this
- # command is issued.
- #
- method reload {} {
- set myInReload 1
- gui_current reload
- set myInReload 0
- }
-}
-
-snit::widget ::hv3::dom::searchbox {
-
- variable myLogwin
-
- constructor {logwin} {
- ::hv3::label ${win}.label
- ::hv3::scrolled listbox ${win}.listbox
-
- set myLogwin $logwin
-
- pack ${win}.label -fill x
- pack ${win}.listbox -fill both -expand true
-
- ${win}.listbox configure -background white
- bind ${win}.listbox <<ListboxSelect>> [mymethod Select]
- }
-
- method Select {} {
- set idx [lindex [${win}.listbox curselection] 0]
- set link [${win}.listbox get $idx]
- set link [string range $link 0 [expr [string first : $link] -1]]
- $myLogwin GotoCmd -silent $link
- ${win}.listbox selection set $idx
- }
-
- method Search {str} {
- ${win}.listbox delete 0 end
-
- set nHit 0
- foreach ls [$myLogwin GetList] {
- set blobid [$ls cget -name]
- set iLine 0
- foreach line [split [$ls cget -script] "\n"] {
- incr iLine
- if {[string first $str $line]>=0} {
- ${win}.listbox insert end "$blobid $iLine: $line"
- incr nHit
- }
- }
- }
-
- return $nHit
- }
-}
-
-snit::widget ::hv3::dom::stacktrace {
-
- variable myLogwin ""
-
- constructor {logwin} {
- ::hv3::label ${win}.label
- ::hv3::scrolled listbox ${win}.listbox
-
- set myLogwin $logwin
-
- pack ${win}.label -fill x
- pack ${win}.listbox -fill both -expand true
-
- ${win}.listbox configure -background white
- bind ${win}.listbox <<ListboxSelect>> [mymethod Select]
- }
-
- method Select {} {
- set idx [lindex [${win}.listbox curselection] 0]
- set link [${win}.listbox get $idx]
- $myLogwin GotoCmd -silent $link
- ${win}.listbox selection set $idx
- }
-
- method Populate {title stacktrace} {
- ${win}.label configure -text $title
- ${win}.listbox delete 0 end
- foreach {blobid lineno calltype callname} $stacktrace {
- ${win}.listbox insert end "$blobid $lineno"
- }
- }
-}
-
-#-------------------------------------------------------------------------
-# ::hv3::dom::logwin --
-#
-# Top level widget for the debugger window.
-#
-snit::widget ::hv3::dom::logwin {
- hulltype toplevel
-
- # Internal widgets from left-hand pane:
- #
- variable myFileList "" ;# Listbox with file-list
- variable mySearchbox "" ;# Search results
- variable myStackList "" ;# Stack trace widget.
-
- # The text widget used to display code and the label displayed above it.
- #
- variable myCode ""
- variable myCodeTitle ""
-
- # The two text widgets: One for input and one for output.
- #
- variable myInput ""
- variable myOutput ""
-
- # ::hv3::dom::logdata object containing the debugging
- # data for the DOM environment being debugged.
- #
- variable myData
-
- # Index in [$myData GetList] of the currently displayed file:
- #
- variable myCurrentIdx 0
-
- # Current point in stack trace. Tag this line with "tracepoint"
- # in the $myCode widget.
- #
- variable myTraceFile ""
- variable myTraceLineno ""
-
- variable myStack ""
-
- constructor {data} {
-
- set myData $data
-
- panedwindow ${win}.pan -orient horizontal
- panedwindow ${win}.pan.right -orient vertical
-
- set nb [::hv3::tile_notebook ${win}.pan.left]
- set myFileList [::hv3::scrolled listbox ${win}.pan.left.files]
-
- set mySearchbox [::hv3::dom::searchbox ${win}.pan.left.search $self]
- set myStackList [::hv3::dom::stacktrace ${win}.pan.left.stack $self]
-
- $nb add $myFileList -text "Files"
- $nb add $mySearchbox -text "Search"
- $nb add $myStackList -text "Stack"
-
- $myFileList configure -bg white
- bind $myFileList <<ListboxSelect>> [mymethod PopulateText]
-
- frame ${win}.pan.right.top
- set myCode [::hv3::scrolled ::hv3::text ${win}.pan.right.top.code]
- set myCodeTitle [::hv3::label ${win}.pan.right.top.label -anchor w]
- pack $myCodeTitle -fill x
- pack $myCode -fill both -expand 1
- $myCode configure -bg white
-
- $myCode tag configure linenumber -foreground darkblue
- $myCode tag configure tracepoint -background skyblue
- $myCode tag configure stackline -background wheat
- $myCode tag configure breakpoint -background red
-
- $myCode tag bind linenumber <1> [mymethod ToggleBreakpoint %x %y]
-
- frame ${win}.pan.right.bottom
- set myOutput [::hv3::scrolled ::hv3::text ${win}.pan.right.bottom.output]
- set myInput [::hv3::text ${win}.pan.right.bottom.input -height 3]
- $myInput configure -bg white
- $myOutput configure -bg white -state disabled
- $myOutput tag configure commandtext -foreground darkblue
- $myOutput tag configure commandalert -foreground darkred
-
- # Set up key bindings for the input window:
- bind $myInput <Return> [list after idle [mymethod Evaluate]]
- bind $myInput <Up> [list after idle [mymethod HistoryBack]]
- bind $myInput <Down> [list after idle [mymethod HistoryForward]]
-
- pack $myInput -fill x -side bottom
- pack $myOutput -fill both -expand 1
-
- ${win}.pan add ${win}.pan.left -width 200
- ${win}.pan add ${win}.pan.right
-
- ${win}.pan.right add ${win}.pan.right.top -height 200 -width 600
- ${win}.pan.right add ${win}.pan.right.bottom -height 350
-
- pack ${win}.pan -fill both -expand 1
-
- bind ${win} <Escape> [list destroy ${win}]
-
- focus $myInput
- $myInput insert end "help"
- $self Evaluate
- }
-
- method GetList {} { return [$myData GetList] }
-
- method Populate {} {
- $myFileList delete 0 end
-
- # Populate the "Files" list-box.
- #
- foreach ls [$myData GetList] {
- set name [$ls cget -name]
- set heading [$ls cget -heading]
- set rc [$ls cget -rc]
-
- $myFileList insert end "$name - $heading"
-
- if {$name eq $myTraceFile} {
- $myFileList selection set end
- }
-
- if {$rc} {
- $myFileList itemconfigure end -foreground red -selectforeground red
- }
- }
- }
-
- method PopulateText {} {
- $myCode configure -state normal
- $myCode delete 0.0 end
- set idx [lindex [$myFileList curselection] 0]
- if {$idx ne ""} {
- set ls [lindex [$myData GetList] $idx]
- $myCodeTitle configure -text [$ls cget -heading]
-
- set name [$ls cget -name]
- set stacklines [list]
- foreach {n l X Y} $myStack {
- if {$n eq $name} { lappend stacklines $l }
- }
-
- set script [$ls cget -script]
- set N 1
- foreach line [split $script "\n"] {
- $myCode insert end [format "% 5d " $N] linenumber
- if {[$ls cget -name] eq $myTraceFile && $N == $myTraceLineno} {
- $myCode insert end "$line\n" tracepoint
- } elseif {[lsearch $stacklines $N] >= 0} {
- $myCode insert end "$line\n" stackline
- } else {
- $myCode insert end "$line\n"
- }
- incr N
- }
- set myCurrentIdx $idx
- }
-
- # The following line throws an error if no chars are tagged "tracepoint".
- catch { $myCode yview -pickplace tracepoint.first }
- $myCode configure -state disabled
- $self PopulateBreakpointTag
- }
-
- # This proc is called after either:
- #
- # * The contents of the code window change, or
- # * A breakpoint is added or cleared from the debugger.
- #
- # It ensures the "breakpoint" tag is set on the line-number
- # of any line that has a breakpoint set.
- #
- method PopulateBreakpointTag {} {
- set ls [lindex [$myData GetList] $myCurrentIdx]
- set blobid [$ls cget -name]
-
- $myCode tag remove breakpoint 0.0 end
- foreach key [$myData breakpoints] {
- foreach {b i} [split $key :] {}
- if {$b eq $blobid} {
- $myCode tag add breakpoint ${i}.0 ${i}.5
- }
- }
- }
-
- method ToggleBreakpoint {x y} {
- set ls [lindex [$myData GetList] $myCurrentIdx]
- set lineno [lindex [split [$myCode index @${x},${y}] .] 0]
- set blobid [$ls cget -name]
-
- if {[lsearch [$myData breakpoints] "${blobid}:${lineno}"]>=0} {
- $myData clear_breakpoint ${blobid} ${lineno}
- } else {
- $myData add_breakpoint ${blobid} ${lineno}
- }
- $self PopulateBreakpointTag
- }
-
- # This is called when the user issues a [result] command.
- #
- method ResultCmd {cmd} {
- # The (optional) argument is one of the blob names. If
- # it is not specified, use the currently displayed js blob
- # as a default.
- #
- set arg [lindex $cmd 0]
- if {$arg eq ""} {
- set idx $myCurrentIdx
- if {$idx eq ""} {set idx [llength [$myData GetList]]}
- } else {
- set idx 0
- foreach ls [$myData GetList] {
- if {[$ls cget -name] eq $arg} break
- incr idx
- }
- }
- set ls [lindex [$myData GetList] $idx]
- if {$ls eq ""} {
- error "No such file: \"$arg\""
- }
-
- # Echo the command to the output panel.
- #
- $myOutput insert end "result: [$ls cget -name]\n" commandtext
-
- $myOutput insert end " rc : " commandtext
- $myOutput insert end "[$ls cget -rc]\n"
- if {[$ls cget -rc] && [lindex [$ls cget -result] 0] eq "JS_ERROR"} {
- set res [$ls cget -result]
- set msg [lindex $res 1]
- set zErrorInfo [lindex $res 2]
- set stacktrace [lrange $res 3 end]
- set stack ""
- foreach {file lineno a b} $stacktrace {
- set stack "-> $file:$lineno $stack"
- }
- $myOutput insert end " result : " commandtext
- $myOutput insert end "$msg\n"
- $myOutput insert end " stack : " commandtext
- $myOutput insert end "[string range $stack 3 end]\n"
- $myOutput insert end " errorInfo: " commandtext
- $myOutput insert end "$zErrorInfo\n"
-
- set blobid ""
- set r [$ls cget -result]
- regexp {(blob[[:digit:]]*):([[:digit:]]*):} $r X blobid lineno
-
- if {$blobid ne ""} {
- set stacktrace [linsert $stacktrace 0 $blobid $lineno "" ""]
- }
-
- if {[llength $stacktrace] > 0} {
- set blobid [lindex $stacktrace 0]
- set lineno [lindex $stacktrace 1]
- set myStack $stacktrace
- $myStackList Populate "Result of [$ls cget -name]:" $stacktrace
- [winfo parent $myStackList] select $myStackList
- }
-
- if {$blobid ne ""} {
- $self GotoCmd -silent [list $blobid $lineno]
- }
-
- } else {
- $myOutput insert end " result: [$ls cget -result]\n"
- }
- }
-
- # This is called when the user issues a [clear] command.
- #
- method ClearCmd {cmd} {
- $myOutput delete 0.0 end
- }
-
- # This is called when the user issues a [javascript] command.
- #
- method JavascriptCmd {cmd} {
- set js [string trim $cmd]
- set res [$myData Evaluate $js]
- $myOutput insert end "javascript: $js\n" commandtext
- $myOutput insert end " [string trim $res]\n"
- }
-
- method GotoCmd {cmd {cmd2 ""}} {
- if {$cmd2 ne ""} {set cmd $cmd2}
- set blobid [lindex $cmd 0]
- set lineno [lindex $cmd 1]
- if {$lineno eq ""} {
- set lineno 1
- }
-
- if {$cmd2 eq ""} {
- $myOutput insert end "goto: $blobid $lineno\n" commandtext
- }
-
- set idx 0
- set ok 0
- foreach ls [$myData GetList] {
- if {[$ls cget -name] eq $blobid} {set ok 1 ; break}
- incr idx
- }
-
- if {!$ok} {
- $myOutput insert end " No such blob: $blobid"
- return
- }
-
- set myTraceFile $blobid
- set myTraceLineno $lineno
- if {$cmd2 eq ""} {
- $self Populate
- } else {
- $myFileList selection clear 0 end
- $myFileList selection set $idx
- }
- $self PopulateText
- }
-
- method ErrorCmd {cmd} {
- }
-
- method SearchCmd {cmd} {
- set n [$mySearchbox Search $cmd]
- ${win}.pan.left select $mySearchbox
- $myOutput insert end "search: $cmd\n" commandtext
- $myOutput insert end " $n hits.\n"
- }
-
- method TreeCmd {node} {
- $myOutput insert end "tree: $node\n" commandtext
- $myData BrowseToNode $node
- }
-
- method TclCmd {args} {
- $myOutput insert end "tcl: $args\n" commandtext
- set res [eval uplevel #0 $args]
- $myOutput insert end " $res\n"
- }
-
- method ReloadCmd {args} {
- $myData reload
- }
-
- method DebugCmd {args} {
- $myOutput insert end "debug: $args\n" commandtext
- set see [[$myData dom] see]
- switch -- [lindex $args 0] {
-
- alloc {
- set data [eval $see debug $args]
- foreach {key value} $data {
- set key [format " % -30s" $key]
- $myOutput insert end $key commandtext
- $myOutput insert end ": $value\n"
- }
- }
-
- default {
- set objlist [eval [[$myData dom] see] debug $args]
- foreach obj $objlist {
- $myOutput insert end " $obj\n"
- }
- }
- }
- }
-
- method Evaluate {} {
- set script [string trim [$myInput get 0.0 end]]
- $myInput delete 0.0 end
- $myInput mark set insert 0.0
-
- set idx [string first " " $script]
- if {$idx < 0} {
- set idx [string length $script]
- }
- set zWord [string range $script 0 [expr $idx-1]]
- set nWord [string length $zWord]
-
- $myOutput configure -state normal
-
- set cmdlist [list \
- clear 2 "" ClearCmd \
- cont 2 "" ContCmd \
- goto 1 "BLOBID ?LINE-NUMBER?" GotoCmd \
- js 1 "JAVASCRIPT..." JavascriptCmd \
- debug 1 "SUB-COMMAND" DebugCmd \
- reload 2 "" ReloadCmd \
- result 1 "BLOBID" ResultCmd \
- search 1 "STRING" SearchCmd \
- tree 2 "NODE" TreeCmd \
- tcl 2 "TCL-SCRIPT" TclCmd \
- ]
- set done 0
- foreach {cmd nMin NOTUSED method} $cmdlist {
- if {$nWord>=$nMin && [string first $zWord $cmd]==0} {
- $self $method [string trim [string range $script $nWord end]]
- set done 1
- break
- }
- }
-
- if {!$done} {
- # An unknown command (or "help"). Print a summary of debugger commands.
- #
- $myOutput insert end "help:\n" commandtext
- foreach {cmd NOTUSED help NOTUSED} $cmdlist {
- $myOutput insert end " $cmd $help\n"
- }
- set x "Unambiguous prefixes of the above commands are also accepted.\n"
- $myOutput insert end " $x"
- }
-
- $myOutput yview -pickplace end
- $myOutput insert end "\n"
- $myOutput configure -state disabled
-
- $self HistoryAdd $script
- }
-
-
- # History list for input box. Interface is:
- #
- # $self HistoryAdd $script (add command to end of history list)
- # $self HistoryBack (bind to <back> key>)
- # $self HistoryForward (bind to <forward> key)
- #
- variable myHistory [list]
- variable myHistoryIdx 0
- method HistoryAdd {script} {
- lappend myHistory $script
- set myHistoryIdx [llength $myHistory]
- }
- method HistoryBack {} {
- if {$myHistoryIdx==0} return
- incr myHistoryIdx -1
- $myInput delete 0.0 end
- $myInput insert end [lindex $myHistory $myHistoryIdx]
- }
- method HistoryForward {} {
- if {$myHistoryIdx==[llength $myHistory]} return
- incr myHistoryIdx
- $myInput delete 0.0 end
- $myInput insert end [lindex $myHistory $myHistoryIdx]
- }
- #
- # End of history list for input box.
-
-
- # Variable used for breakpoint code.
- variable myBreakpointVwait
- method ContCmd {args} {
- $myOutput insert end "cont:\n" commandtext
- set myBreakpointVwait 1
-
- set myTraceFile ""
- set myTraceLineno ""
- set myStack ""
- $myStackList Populate "" $myStack
- $myCode tag remove tracepoint 0.0 end
- $myCode tag remove stackline 0.0 end
- }
-
- # This is called when the SEE interpreter has been stopped at
- # a breakpoint. Js execution will continue after this method
- # returns.
- #
- method Breakpoint {zBlobid iLine} {
- set myBreakpointVwait 0
-
- set myStack [list $zBlobid $iLine "" ""]
- $myStackList Populate "Breakpoint $zBlobid $iLine" $myStack
- [winfo parent $myStackList] select $myStackList
- $self GotoCmd -silent [list $zBlobid $iLine]
-
- $myOutput configure -state normal
- $myOutput insert end "breakpoint: $zBlobid $iLine\n\n" commandalert
- $myOutput configure -state disabled
-
- vwait [myvar myBreakpointVwait]
- }
-}
-#-----------------------------------------------------------------------
-
#-----------------------------------------------------------------------
# Pull in the object definitions.
#
-proc ::hv3::dom_init {} {
- if {[info commands ::see::interp] eq ""} return
+proc ::hv3::dom_init {{init_docs 0}} {
+ set ::hv3::dom::CREATE_DOM_DOCS 0
+ if {$init_docs} {set ::hv3::dom::CREATE_DOM_DOCS 1}
+
+ if {
+ $::hv3::dom::CREATE_DOM_DOCS == 0 && [info commands ::see::interp] eq ""
+ } return
+
uplevel #0 {
- source [file join $::hv3::scriptdir hv3_dom_compiler.tcl]
-
foreach f [list \
+ hv3_dom_compiler.tcl \
hv3_dom_containers.tcl \
hv3_dom_core.tcl \
- hv3_dom_html.tcl \
hv3_dom_style.tcl \
- hv3_dom_ns.tcl \
hv3_dom_events.tcl \
+ hv3_dom_html.tcl \
+ hv3_dom_ns.tcl \
hv3_dom_xmlhttp.tcl \
] {
source [file join $::hv3::scriptdir $f]
}
- set classlist [concat \
- Implementation \
- HTMLCollectionC HTMLCollectionS \
- NodeListC NodeListS \
- HTMLElement HTMLDocument \
- [::hv3::dom::getHTMLElementClassList] \
- [::hv3::dom::getNSClassList] \
- Text NodePrototype \
- CSSStyleDeclaration \
- Event MouseEvent \
- XMLHttpRequest XMLHttpRequestEvent \
- FramesList \
- ]
- foreach c $classlist {
- eval [::hv3::dom2::compile $c]
- }
- #puts [::hv3::dom2::compile XMLHttpRequest]
-
- ::hv3::create_domref
- ::hv3::dom2::cleanup
-
- set ::hv3::dom::reformat_scripts_option 0
- #set ::hv3::dom::reformat_scripts_option 1
}
}
@@ -1275,6 +413,7 @@ proc ::hv3::dom_init {} {
# }
#
catch { load [file join tclsee0.1 libTclsee.so] }
+catch { load [file join tclsee0.1 libTclsee.dll] }
catch { package require Tclsee }
set ::hv3::scriptdir [file dirname [info script]]
@@ -1286,3 +425,24 @@ proc ::hv3::enable_javascript {} {
}
}
+namespace eval ::hv3::DOM {
+ # Given an html-widget node-handle, return the corresponding
+ # ::hv3::DOM::HTMLDocument object. i.e. the thing needed for
+ # the Node.ownerDocument javascript property of an HTMLElement or
+ # Text Node.
+ #
+ proc node_to_document {node} {
+ set hv3 [[winfo parent [$node html]] hv3 me]
+ list ::hv3::DOM::HTMLDocument [$hv3 dom] $hv3
+ }
+
+ proc node_to_window {node} {
+ set hv3 [[winfo parent [$node html]] hv3 me]
+ list ::hv3::DOM::Window [$hv3 dom] $hv3
+ }
+
+ proc hv3_to_window {hv3} {
+ list ::hv3::DOM::Window [$hv3 dom] $hv3
+ }
+}
+
diff --git a/hv/hv3_dom2.tcl b/hv/hv3_dom2.tcl
new file mode 100644
index 0000000..8c58eb3
--- /dev/null
+++ b/hv/hv3_dom2.tcl
@@ -0,0 +1,459 @@
+
+#
+# Contains the following:
+#
+# Procs:
+# ::hv3::dom::get_inner_html
+# ::hv3::dom::set_inner_html
+#
+# Types:
+# ::hv3::dom::HTMLDocument
+#
+# Widgets:
+#
+#
+
+#
+# Implemented subset of DOM Level 1:
+#
+# Node
+# +----- Document ---------- HTMLDocument
+# +----- CharacterData ----- Text
+# +----- Element ---------- HTMLElement
+# +------- HTMLInputElement
+# +------- HTMLTextAreaElement
+# +------- HTMLFormElement
+# +------- HTMLImageElement
+# +------- HTMLAnchorElement
+#
+# HTMLCollection
+#
+
+# Not implemented DOM Level 1:
+#
+# DOMException
+# ExceptionCode
+# DOMImplementation
+# DocumentFragment
+# Attr
+# Comment
+#
+# NodeList
+# NamedNodeMap
+#
+
+
+
+
+
+#------------------------------------------------------------------------
+# http://www.w3.org/TR/DOM-Level-2-HTML/html.html
+#
+#
+namespace eval ::hv3::dom {
+
+ #----------------------------------------------------------------------
+ # get_inner_html
+ #
+ # This is a helper function for HTMLElement. The "inner-html" of
+ # element node $node is returned.
+ #
+ proc get_inner_html {node} {
+ if {[$node tag] eq ""} {error "$node is not an HTMLElement"}
+
+ set ret ""
+ foreach child [$node children] {
+ append ret [NodeToHtml $child]
+ }
+ return $ret
+ }
+ proc NodeToHtml {node} {
+ set tag [$node tag]
+ if {$tag eq ""} {
+ return [$node text -pre]
+ } else {
+ set inner [get_inner_html $node]
+ return "<$tag>$node</$tag>"
+ }
+ }
+
+
+ #----------------------------------------------------------------------
+ # set_inner_html
+ #
+ # This is a helper function for HTMLElement. The "inner-html" of
+ # element node $node, owned by document frame $hv3, is set
+ # to $newHtml.
+ #
+ proc set_inner_html {hv3 node newHtml} {
+ if {[$node tag] eq ""} {error "$node is not an HTMLElement"}
+
+ # Destroy the existing children (and their descendants) of $node.
+ set children [$node children]
+ $node remove $children
+ foreach child $children {
+ $child destroy
+ }
+
+ # Insert the new descendants, created by parseing $newHtml.
+ set children [[$hv3 html] fragment $newHtml]
+ $node insert $children
+ }
+}
+
+
+#-------------------------------------------------------------------------
+# Snit class for the "document" object.
+#
+# DOM level 1 interface (- sign means it's missing) in Hv3.
+#
+# HTMLDocument.write(string)
+# HTMLDocument.writeln(string)
+# HTMLDocument.getElementById(string)
+# HTMLDocument.forms[]
+# HTMLDocument.anchors[]
+# HTMLDocument.links[]
+# HTMLDocument.applets[]
+# HTMLDocument.body[]
+# HTMLDocument.cookie
+#
+snit::type ::hv3::dom::HTMLDocument {
+
+ variable myHv3
+
+ js_init {dom hv3} {
+ set myHv3 $hv3
+ }
+
+ #-------------------------------------------------------------------------
+ # The HTMLDocument.write() and writeln() methods (DOM level 1)
+ #
+ js_scall write {THIS str} {
+ catch { [$myHv3 html] write text $str }
+ return ""
+ }
+ js_scall writeln {THIS str} {
+ $self call_write $THIS "$str\n"
+ }
+
+ #-------------------------------------------------------------------------
+ # HTMLDocument.getElementById() method. (DOM level 1)
+ #
+ # This returns a single object (or NULL if an object of the specified
+ # id cannot be found).
+ #
+ js_scall getElementById {THIS elementId} {
+ set node [lindex [$myHv3 search "#$elementId"] 0]
+ if {$node ne ""} {
+ return [list object [[$myHv3 dom] node_to_dom $node]]
+ }
+ return null
+ }
+
+ #-------------------------------------------------------------------------
+ # The document collections (DOM level 1)
+ #
+ # HTMLDocument.images[]
+ # HTMLDocument.forms[]
+ # HTMLDocument.anchors[]
+ # HTMLDocument.links[]
+ # HTMLDocument.applets[]
+ #
+ # TODO: applets[] is supposed to contain "all the OBJECT elements that
+ # include applets and APPLET (deprecated) elements in a document". Here
+ # only the APPLET elements are collected.
+ #
+ js_getobject images {
+ hv3::dom::HTMLCollection %AUTO% [$self dom] $myHv3 img
+ }
+ js_getobject forms {
+ hv3::dom::HTMLCollection %AUTO% [$self dom] $myHv3 form
+ }
+ js_getobject anchors {
+ hv3::dom::HTMLCollection %AUTO% [$self dom] $myHv3 {a[name]}
+ }
+ js_getobject links {
+ hv3::dom::HTMLCollection %AUTO% [$self dom] $myHv3 {area,a[href]}
+ }
+ js_getobject applets {
+ hv3::dom::HTMLCollection %AUTO% [$self dom] $myHv3 applet
+ }
+
+ js_scall getElementsByTagName {THIS tag} {
+ set obj [hv3::dom::HTMLCollection %AUTO% [$self dom] $myHv3 $tag]
+ $obj configure -finalizable 1
+ list object $obj
+ }
+
+ #-----------------------------------------------------------------------
+ # The HTMLDocument.cookie property (DOM level 1)
+ #
+ # The cookie property is a strange modeling. Getting and putting the
+ # property are not related in the usual way (the usual way: calling Get
+ # returns the value stored by Put).
+ #
+ # When setting the cookies property, at most a single cookie is added
+ # to the cookies database.
+ #
+ # The implementations of the following get and put methods interface
+ # directly with the ::hv3::the_cookie_manager object. Todo: Are there
+ # security implications here (in concert with the location property
+ # perhaps)?
+ #
+ js_get cookie {
+ list string [::hv3::the_cookie_manager Cookie [$myHv3 uri get]]
+ }
+ js_put cookie value {
+ set str [[$self see] tostring $value]
+ ::hv3::the_cookie_manager SetCookie [$myHv3 uri get] $str
+ }
+
+ #-----------------------------------------------------------------------
+ # The "location" property (Gecko compatibility)
+ #
+ # Setting the value of the document.location property is equivalent
+ # to calling "document.location.assign(VALUE)".
+ #
+ js_getobject location { ::hv3::dom::Location %AUTO% [$self dom] $myHv3 }
+ js_put location value {
+ set location [lindex [$self Get location] 1]
+ set assign [lindex [$location Get assign] 1]
+ $assign Call THIS $value
+ }
+
+ #-------------------------------------------------------------------------
+ # Handle unknown property requests.
+ #
+ # An unknown property may refer to certain types of document element
+ # by either the "name" or "id" HTML attribute.
+ #
+ # 1: Have to find some reference for this behaviour...
+ # 2: Maybe this is too inefficient. Maybe it should go to the
+ # document.images and document.forms collections.
+ #
+ js_get * {
+
+ # Allowable element types.
+ set tags [list form img]
+
+ # Selectors to use to find document nodes.
+ set nameselector [subst -nocommands {[name="$property"]}]
+ set idselector [subst -nocommands {[id="$property"]}]
+
+ foreach selector [list $nameselector $idselector] {
+ set node [lindex [$myHv3 search $selector] 0]
+ if {$node ne "" && [lsearch $tags [$node tag]] >= 0} {
+ return [list object [[$myHv3 dom] node_to_dom $node]]
+ }
+ }
+
+ return ""
+ }
+
+ js_finish {}
+}
+
+#-------------------------------------------------------------------------
+# ::hv3::dom::HTMLElement
+#
+# DOM class: (Node -> Element -> HTMLElement)
+#
+# Supports the following interface:
+#
+# Element.nodeName
+# Element.nodeValue
+# Element.nodeType
+# Element.parentNode
+# Element.childNodes
+# Element.firstChild
+# Element.lastChild
+# Element.previousSibling
+# Element.nextSibling
+# Element.attributes
+# Element.ownerDocument
+#
+# And the nonstandard:
+#
+# HTMLElement.innerHTML
+# HTMLElement.style
+#
+namespace eval ::hv3::dom {
+
+ proc snit_type {type args} {
+ uplevel ::snit::type $type [list [join $args]]
+ }
+
+ snit_type HTMLElement {
+ variable myNode ""
+ variable myHv3 ""
+
+ js_init {dom hv3 node} {
+ set myNode $node
+ set myHv3 $hv3
+ }
+
+ # Insert the event property code. Defined in file hv3_dom3.tcl.
+ #
+ } $DOM0Events_ElementCode {
+
+ js_get tagName {
+ list string [string toupper [$myNode tag]]
+ }
+
+ js_getobject style { ::hv3::dom::InlineStyle %AUTO% [$self dom] $myNode }
+
+ # Get/Put functions for the attributes of $myNode:
+ #
+ method GetBooleanAttribute {prop} {
+ set bool [$myNode attribute -default 0 $prop]
+ if {![catch {expr $bool}]} {
+ return [list boolean [expr {$bool ? 1 : 0}]]
+ } else {
+ return [list boolean 1]
+ }
+ }
+ method PutBooleanAttribute {prop value} {
+ $myNode attribute $prop [lindex $value 1]
+ }
+
+ #-------------------------------------------------------------------
+ # The following string attributes are common to all elements:
+ #
+ # HTMLElement.id
+ # HTMLElement.title
+ # HTMLElement.lang
+ # HTMLElement.dir
+ # HTMLElement.className
+ #
+ js_getput_attribute id id
+ js_getput_attribute title title
+ js_getput_attribute lang lang
+ js_getput_attribute dir dir
+ js_getput_attribute className class
+
+ js_get nodeType { list number 1 ;# 1 -> ELEMENT_NODE }
+
+ js_getobject childNodes { ::hv3::dom::NodeList %AUTO% [$self dom] $myNode }
+
+ #-------------------------------------------------------------------
+ # Get and set the innerHTML property. The implmenetation of this
+ # is in hv3_dom2.tcl.
+ #
+ js_get innerHTML { list string [::hv3::dom::get_inner_html $myNode] }
+ js_put innerHTML {value} {
+ set code [[$self see] tostring $value ]
+ ::hv3::dom::set_inner_html $myHv3 $myNode $code
+ }
+
+ js_finish {}
+
+ method node {} {return $myNode}
+ }
+}
+#-------------------------------------------------------------------------
+
+#-------------------------------------------------------------------------
+# ::hv3::dom::NodeList
+#
+namespace eval ::hv3::dom {
+ ::snit::type NodeList {
+ variable myParent ""
+
+ js_init {dom parent} {
+ set myParent $parent
+ }
+
+ js_get length {
+ list number [llength [$myParent children]]
+ }
+
+ js_scall item {THIS idx} {
+ set i [format %.0f $idx]
+ set child [lindex [$myParent children] $i]
+ list object [[$self dom] node_to_dom $child]
+ }
+
+ js_finish {}
+ }
+}
+#-------------------------------------------------------------------------
+
+#-------------------------------------------------------------------------
+# ::hv3::dom::XMLHttpRequest
+#
+# Hv3 will eventually feature a fully-featured XMLHttpRequest object,
+# similar to that described here:
+#
+# http://www.w3.org/TR/XMLHttpRequest/
+#
+# For now, this is a partial implementation to make the
+# tests/browsertest.tcl framework work.
+#
+namespace eval ::hv3::dom {
+ ::snit::type XMLHttpRequest {
+
+ variable myHv3
+
+ variable myUri ""
+ variable myRequestHandle ""
+
+ js_init {dom hv3} {
+ set myHv3 $hv3
+ }
+
+ #-------------------------------------------------------------------
+ # XMLHttpRequest.readyState
+ #
+ variable myReadyState Uninitialized
+ js_get readyState {
+ switch -- $myReadyState {
+ Uninitialized {list number 0}
+ Open {list number 1}
+ Sent {list number 2}
+ Receiving {list number 3}
+ Loaded {list number 4}
+ default {error "Bad myReadyState value: $myReadyState"}
+ }
+ }
+
+ js_scall open {THIS http_method uri args} {
+ if {$myReadyState ne "Uninitialized"} {
+ error "Cannot call XMLHttpRequest.open() in state $myReadyState"
+ }
+ set myUri [$myHv3 resolve_uri $uri]
+ set myReadyState Open
+ return ""
+ }
+
+ js_scall send {THIS args} {
+ if {$myReadyState ne "Open"} {
+ error "Cannot call XMLHttpRequest.open() in state $myReadyState"
+ }
+
+ set myRequestHandle [::hv3::download %AUTO%]
+ $myRequestHandle configure -uri $myUri
+ $myRequestHandle configure -finscript [mymethod RequestFinished]
+ $myHv3 makerequest $myRequestHandle
+
+ set myReadyState Sent
+ return ""
+ }
+
+ variable isFinalized 0
+ method Finalize {} {
+ set isFinalized 1
+ if {$myReadyState ne "Sent" && $myReadyState ne "Receiving"} {
+ $self destroy
+ }
+ }
+ method RequestFinished {data} {
+ if {$isFinalized} {$self destroy}
+ $myRequestHandle destroy
+ }
+
+ js_finish {
+ }
+ }
+}
+#-------------------------------------------------------------------------
+
diff --git a/hv/hv3_dom3.tcl b/hv/hv3_dom3.tcl
new file mode 100644
index 0000000..a889ce2
--- /dev/null
+++ b/hv/hv3_dom3.tcl
@@ -0,0 +1,117 @@
+package require snit
+
+namespace eval ::hv3::dom {
+ # This array is a map between the DOM name of a CSS property
+ # and the CSS name.
+ array set CSS_PROPERTY_MAP [list \
+ display display \
+ height height \
+ width width \
+ ]
+}
+
+#-----------------------------------------------------------------------
+# ::hv3::dom::InlineStyle
+#
+# This Snit type implements a javascript element.style object, used to
+# provide access to the "style" attribute of an HTML element.
+#
+set InlineStyleDefn {
+ js_init {dom node} {
+ set myNode $node
+ }
+}
+foreach p [array names ::hv3::dom::CSS_PROPERTY_MAP] {
+ append InlineStyleDefn [subst -nocommands {
+ js_get $p { [set self] GetStyleProp $p }
+ js_put $p v { [set self] PutStyleProp $p [set v] }
+ }]
+}
+append InlineStyleDefn {
+
+ variable myNode
+
+ method GetStyleProp {prop} {
+ list string [$myNode prop -inline $hv3::dom::CSS_PROPERTY_MAP($prop)]
+ }
+
+ method PutStyleProp {property js_value} {
+ set value [[$self see] tostring $js_value]
+
+ array set current [$myNode prop -inline]
+
+ if {$value ne ""} {
+ set current($::hv3::dom::CSS_PROPERTY_MAP($property)) $value
+ } else {
+ unset -nocomplain current($::hv3::dom::CSS_PROPERTY_MAP($property))
+ }
+
+ set style ""
+ foreach prop [array names current] {
+ append style "$prop : $current($prop); "
+ }
+
+ $myNode attribute style $style
+ }
+
+ js_finish {}
+}
+::snit::type ::hv3::dom::InlineStyle $InlineStyleDefn
+unset InlineStyleDefn
+#
+# End of DOM class InlineStyle.
+#-----------------------------------------------------------------------
+
+
+namespace eval ::hv3::dom {
+
+ # List of DOM Level 0 events.
+ #
+ set DOM0Events_EventList [list \
+ onclick ondblclick onmousedown onmouseup onmouseover \
+ onmousemove onmouseout onkeypress onkeydown onkeyup onfocus onblur \
+ onsubmit onreset onselect onchange \
+ ]
+
+ # Variable DOM0Events_ElementCode contains code to insert into the
+ # ::hv3::dom::HTMLElement type for DOM Level 0 event support.
+ #
+ set DOM0Events_ElementCode {
+ variable myEventFunctionsCompiled 0
+
+ # This method loops through all the DOM Level 0 event attributes of
+ # html widget node $myNode (onclick, onfocus etc.). For each defined
+ # attribute, compile the value of the attribute into the body of
+ # a javascript function object. Set the event property of the
+ # parent object to the compiled function object.
+ #
+ method CompileEventFunctions {} {
+ if {$myEventFunctionsCompiled} return
+ set see [$self see]
+ foreach event $::hv3::dom::DOM0Events_EventList {
+ set body [$myNode attr -default "" $event]
+ if {$body ne ""} {
+ set ref [$see function $body]
+ $myJavascriptParent Put $event [list object $ref]
+ eval $see $ref Finalize
+ }
+ }
+ set myEventFunctionsCompiled 1
+ }
+ }
+
+ foreach event $::hv3::dom::DOM0Events_EventList {
+ append DOM0Events_ElementCode [subst -nocommands {
+ js_get $event {
+ [set self] CompileEventFunctions
+ [set myJavascriptParent] Get $event
+ }
+ js_put $event value {
+ [set self] CompileEventFunctions
+ [set myJavascriptParent] Put $event [set value]
+ }
+ }]
+ }
+}
+
+
diff --git a/hv/hv3_dom_compiler.tcl b/hv/hv3_dom_compiler.tcl
index a83780c..3c0172e 100644
--- a/hv/hv3_dom_compiler.tcl
+++ b/hv/hv3_dom_compiler.tcl
@@ -1,4 +1,4 @@
-namespace eval hv3 { set {version($Id: hv3_dom_compiler.tcl,v 1.31 2007/08/05 06:54:47 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3_dom_compiler.tcl,v 1.38 2007/11/25 18:29:15 danielk1977 Exp $)} 1 }
#--------------------------------------------------------------------------
# This file implements infrastructure used to create the [proc] definitions
@@ -9,21 +9,8 @@ namespace eval hv3 { set {version($Id: hv3_dom_compiler.tcl,v 1.31 2007/08/05 06
# ::hv3::dom2::stateless TYPE-NAME BASE-TYPE-LIST BODY
#
-proc ::hv3::dom::ToString {pSee js_value} {
- switch -- [lindex $js_value 0] {
- undefined {return "undefined"}
- null {return "null"}
- object {
- return [$pSee tostring $js_value]
-# set val [eval [lindex $js_value 1] DefaultValue]
-# if {[lindex $val 1] eq "object"} {error "DefaultValue is object"}
-# return [::hv3::dom::ToString $pSee $val]
- }
- }
-
- # Handles "boolean", "number" and "string".
- return [lindex $js_value 1]
-}
+namespace eval ::hv3::dom::code {}
+namespace eval ::hv3::DOM::docs {}
# This proc is used in place of a full [dom_object] for callable
# functions. i.e. the object returned by a Get on "document.write".
@@ -47,7 +34,7 @@ proc ::hv3::dom::TclCallableProc {pSee isString zScript op args} {
if {$isString} {
set A [list]
foreach js_value [lrange $args 1 end] {
- lappend A [::hv3::dom::ToString $pSee $js_value]
+ lappend A [$pSee tostring $js_value]
}
} else {
set A [lrange $args 1 end]
@@ -100,39 +87,6 @@ proc ::hv3::dom::TclConstructable {pSee zScript op args} {
error "Unknown method: $op"
}
-proc Indent {iIndent str} {
- set in "\n[string repeat { } [expr {-1 * $iIndent}]]"
- set out "\n[string repeat { } $iIndent]"
- string map [list $in $out] $str
-}
-
-proc AutoIndent {iIndent str} {
-return $str
- set white 0
- regexp {\n( *)[^[:space:]]} $str DUMMY white
- set iIndent2 [expr $iIndent - [string length $white]]
- Indent $iIndent2 $str
-}
-
-namespace eval ::hv3::DOM {
- # Return the current javascript object command.
- #
- proc SELF {} {
- set values [info level -1]
- set procname [lindex $values 0]
-
- # Black magic so that [SELF] works in [dom_call] methods.
- #
- set idx [string first _call_ $procname]
- if {$idx > 0} {
- set level 2
- } else {
- set level 1
- }
-
- uplevel $level {set SELF}
- }
-}
#--------------------------------------------------------------------------
# Stateless DOM objects are defined using the following command:
@@ -150,14 +104,17 @@ namespace eval ::hv3::DOM {
# dom_parameter NAME
#
# dom_get PROPERTY CODE
-#
# dom_put ?-strings? PROPERTY ARG-NAME CODE
+#
# dom_call ?-strings? PROPERTY ARG-LIST CODE
+# dom_construct PROPERTY ARG-LIST CODE
#
# dom_todo PROPERTY
# dom_call_todo PROPERTY
#
# dom_default_value CODE
+# dom_events CODE
+# dom_scope CODE
#
#
namespace eval ::hv3::dom2 {
@@ -165,678 +122,479 @@ namespace eval ::hv3::dom2 {
::variable BaseArray
::variable TypeArray
::variable CurrentType
-
::variable DocBuffer
::variable Docs
+ ::variable ClassList ""
+
array set TypeArray ""
set CurrentType ""
- proc stateless {type_name base_list body} {
+ proc evalcode {code} {
+ #puts $code
+ eval $code
+ }
+
+ proc stateless {type_name args} {
+ set compiler2::parameter dummy
+ set compiler2::default_value error
+ set compiler2::finalize ""
+ set compiler2::events ""
+ set compiler2::scope ""
+ array unset compiler2::get_array
+ array unset compiler2::put_array
+ array unset compiler2::call_array
+
+ set mappings [list]
+ foreach v [info vars ::hv3::dom::code::*] {
+ set name [string range $v [expr [string last : $v]+1] end]
+ lappend mappings %${name}% [set $v]
+ }
+ set body ""
+ foreach a $args {
+ append body "\n"
+ append body [string map $mappings $a]
+ }
+
+ # Compile the documentation for this object. This step is optional.
+ if {$::hv3::dom::CREATE_DOM_DOCS} {
+ doccompiler::clean
+ namespace eval doccompiler $body
+ unset -nocomplain doccompiler::get_array(*)
+ set documentation [doccompiler::make $type_name]
+ evalcode [list \
+ proc ::hv3::DOM::docs::${type_name} {} [list return $documentation]
+ ]
+ } else {
+ namespace eval compiler2 $body
+
+ if {[info exists compiler2::get_array(*)]} {
+ set zDefaultGet $compiler2::get_array(*)
+ unset compiler2::get_array(*)
+ }
- ::variable TypeArray
- ::variable BaseArray
- ::variable CurrentType
+ set DYNAMICGET ""
+ if {[info exists compiler2::get_array(**)]} {
+ set zDynamicGet $compiler2::get_array(**)
+ unset compiler2::get_array(**)
+ set DYNAMICGET "
+ set property \[lindex \$args 0\]
+ set result \[eval {$zDynamicGet} \]
+ if {\$result ne {}} {return \$result}
+ unset result property
+ "
+ }
- if {![info exists TypeArray($type_name)]} {
- set TypeArray($type_name) [::hv3::dom2::typecompiler %AUTO% $type_name]
- set BaseArray($type_name) $base_list
- }
+ set SETSTATEARRAY ""
+ if {$compiler2::parameter eq "myStateArray"} {
+ set SETSTATEARRAY {upvar $myStateArray state}
+ }
+
+ set GET [array get compiler2::get_array]
+ set LIST [array names compiler2::get_array]
+
+ foreach {zProp val} [array get compiler2::call_array] {
+ foreach {isString call_args zCode} $val {}
+
+ set zCode "
+ $SETSTATEARRAY
+ $zCode
+ "
+
+ set procname ::hv3::DOM::${type_name}.${zProp}
+ set arglist [concat myDom $compiler2::parameter $call_args]
+ set proccode [list proc $procname $arglist $zCode]
+ evalcode $proccode
+
+ if {$isString < 0} {
+ set calltype TclConstructable
+ set isString ""
+ } else {
+ set calltype TclCallableProc
+ }
+
+ lappend GET $zProp [string map [list \
+ %CALLTYPE% $calltype \
+ %ISSTRING% $isString \
+ %PROCNAME% $procname \
+ %PARAM% $compiler2::parameter \
+ ] {
+ list cache transient [list \
+ ::hv3::dom::%CALLTYPE% \
+ [$myDom see] %ISSTRING% [list %PROCNAME% $myDom $%PARAM%]
+ ]
+ }]
+ }
+ if {[info exists zDefaultGet]} {
+ lappend GET default [join \
+ [list {set property [lindex $args 0]} $zDefaultGet] "\n"
+ ]
+ }
+
+ set PUT [list]
+ foreach {zProp val} [array get compiler2::put_array] {
+ foreach {isString zArg zCode} $val {}
+
+ if {$isString} {
+ set Template {
+ set %ARG% [[$myDom see] tostring [lindex $args 1]]
+ %CODE%
+ }
+ } else {
+ set Template {
+ set %ARG% [lindex $args 1]
+ %CODE%
+ }
+ }
+ lappend PUT $zProp [string map \
+ [list %ARG% $zArg %CODE% $zCode] \
+ $Template
+ ]
+ }
+ lappend PUT default {return "native"}
+
+ set hasproperty [string map [list \
+ %FUNC% ::hv3::DOM::$type_name \
+ %PARAM% $compiler2::parameter \
+ ] {
+ expr {[llength [%FUNC% $myDom $%PARAM% Get [lindex $args 0]]]>0}
+ }]
+
+ set arglist [list myDom $compiler2::parameter Method args]
+ set proccode [list \
+ proc ::hv3::DOM::$type_name $arglist [string map [list \
+ %DYNAMICGET% $DYNAMICGET \
+ %GET% $GET %PUT% $PUT \
+ %DEFAULTVALUE% $compiler2::default_value \
+ %FINALIZE% $compiler2::finalize \
+ %HASPROPERTY% $hasproperty \
+ %LIST% $LIST \
+ %SETSTATEARRAY% $SETSTATEARRAY \
+ %EVENTS% $compiler2::events \
+ %SCOPE% $compiler2::scope \
+ ] {
+ %SETSTATEARRAY%
+ switch -exact -- $Method {
+ Get {
+ %DYNAMICGET%
+ switch -exact -- [lindex $args 0] {
+ %GET%
+ }
+ }
+ Put {
+ switch -exact -- [lindex $args 0] { %PUT% }
+ }
+ HasProperty {
+ %HASPROPERTY%
+ }
+ DefaultValue {
+ %DEFAULTVALUE%
+ }
+ Finalize {
+ %FINALIZE%
+ }
+
+ Events {
+ %EVENTS%
+ }
+
+ Scope {
+ %SCOPE%
+ }
+
+ List { list %LIST% }
+ }
+ }
+ ]]
+
+ evalcode $proccode
- set CurrentType $TypeArray($type_name)
- namespace eval compiler $body
- set CurrentType ""
+ if {![info exists zDefaultGet] && ![info exists zDynamicGet]} {
+ set property_list [concat \
+ [array names compiler2::get_array] \
+ [array names compiler2::call_array] \
+ ]
+ evalcode [list ::see::class ::hv3::DOM::$type_name $property_list]
+ }
+ }
}
- namespace eval compiler {
+ namespace eval compiler2 {
- proc dom_todo {property} {
- set type [$::hv3::dom2::CurrentType name]
+ variable parameter
+ variable default_value
+ variable finalize
+ variable events
+ variable scope
- -- This property is not yet implemented. For the moment it is a
- -- placeholder that always contains null.
- dom_get $property [subst -nocommands {
- puts "TODO: $type.$property"
- list
- }]
- }
-
- proc dom_call_todo {property} {
- set type [$::hv3::dom2::CurrentType name]
+ variable get_array
+ variable put_array
+ variable call_array
- -- This method is not yet implemented. For the moment it is a
- -- placeholder that has no effect and always returns null.
- dom_call $property {args} [subst -nocommands {
- puts "TODO: $type.${property}()"
- list
- }]
+ proc dom_parameter {zParam} {
+ variable parameter
+ set parameter $zParam
}
- proc dom_parameter {name} {
- $::hv3::dom2::CurrentType add_parameter $name
+ proc dom_default_value {zDefault} {
+ variable default_value
+ set default_value $zDefault
}
- proc dom_default_value {code} {
- $::hv3::dom2::CurrentType add_default_value $code
+ proc dom_finalize {zScript} {
+ variable finalize
+ set finalize $zScript
}
- proc dom_get {property code} {
- FlushDocBuffer $property
- $::hv3::dom2::CurrentType add_get $property $code
- }
+ proc check_for_is_string {isStringVar argsVar} {
+ upvar $isStringVar isString
+ upvar $argsVar args
- proc dom_finalize {code} {
- $::hv3::dom2::CurrentType add_finalizer $code
+ set isString 0
+ if {[lindex $args 0] eq "-string"} {
+ set isString 1
+ set args [lrange $args 1 end]
+ }
}
- proc dom_events {code} {
- $::hv3::dom2::CurrentType add_events $code
- }
- proc dom_scope {code} {
- $::hv3::dom2::CurrentType add_scope $code
+ # dom_call ?-string? PROPERTY ARG-LIST CODE
+ #
+ proc dom_call {args} {
+ variable call_array
+ check_for_is_string isString args
+ if {[llength $args] != 3} {
+ set shouldbe "\"dom_call ?-string? PROPERTY ARG-NAME CODE\""
+ error "Invalid arguments to dom_call - should be: $shouldbe"
+ }
+ foreach {zMethod zArgs zCode} $args {}
+ set call_array($zMethod) [list $isString $zArgs $zCode]
}
- proc Ref {ref {text ""}} {
- if {$text eq ""} {set text $ref}
- subst {<A href="#${ref}">${text}</A>}
- }
+ proc dom_call_todo {zProc} {}
+ proc dom_todo {zAttr} {}
- proc FlushDocBuffer {{property {}}} {
- if {[info exists ::hv3::dom2::DocBuffer]} {
- if {[string range $::hv3::dom2::DocBuffer end-2 end] eq "<p>"} {
- set ::hv3::dom2::DocBuffer [
- string range $::hv3::dom2::DocBuffer 0 end-3
- ]
- }
- set name [$::hv3::dom2::CurrentType name]
- if {$property ne ""} {append name ".$property"}
- append ::hv3::dom2::Docs($name) $::hv3::dom2::DocBuffer
- unset ::hv3::dom2::DocBuffer
- }
- }
- proc -- {args} {
- if {[llength $args]==1
- && [string range [lindex $args 0] 0 4] eq "http:"
- } {
- set uri [lindex $args 0]
- append ::hv3::dom2::DocBuffer [subst {
- <DIV class=uri><A href="$uri">$uri</A></DIV>
- }]
- return
- } elseif {[llength $args]==0 || ![info exists ::hv3::dom2::DocBuffer]} {
- append ::hv3::dom2::DocBuffer <p>
- append ::hv3::dom2::DocBuffer [join $args]
- } else {
- append ::hv3::dom2::DocBuffer " "
- append ::hv3::dom2::DocBuffer [join $args]
+ # dom_construct PROPERTY ARG-LIST CODE
+ #
+ proc dom_construct {args} {
+ variable call_array
+ if {[llength $args] != 3} {
+ set shouldbe "\"dom_construct ?-string? PROPERTY ARG-NAME CODE\""
+ error "Invalid arguments to dom_construct - should be: $shouldbe"
}
+ foreach {zMethod zArgs zCode} $args {}
+ set call_array($zMethod) [list -1 $zArgs $zCode]
}
- proc noisy {args} {
- set code [lindex $args end]
- set code [subst -nocommands {
- puts "CALL: [info level 0]"
- set res [$code]
- puts "RETURN [set res]"
- set res
- }]
- lset args end $code
- eval $args
+ # dom_get PROPERTY CODE
+ #
+ proc dom_get {zProperty zScript} {
+ variable get_array
+ set get_array($zProperty) $zScript
}
# dom_put ?-string? PROPERTY ARG-NAME CODE
#
proc dom_put {args} {
- if {[llength $args] == 3} {
- set isString 0
- foreach {property arg_name code} $args {}
- } elseif {[llength $args] == 4 && [lindex $args 0] eq "-string"} {
- set isString 1
- foreach {dummy property arg_name code} $args {}
- } else {
- error "Invalid args to dom_put: $args"
- }
-
- $::hv3::dom2::CurrentType add_put $isString $property $arg_name $code
- }
-
- # dom_call ?-string? PROPERTY ARG-LIST CODE
- #
- proc dom_call {args} {
-
- # Process arguments.
- if {[llength $args] == 3} {
- set isString 0
- foreach {property arg_list code} $args {}
- } elseif {[llength $args] == 4 && [lindex $args 0] eq "-string"} {
- set isString 1
- foreach {dummy property arg_list code} $args {}
- } else {
- error "Invalid args to dom_call: $args"
+ variable put_array
+ check_for_is_string isString args
+ if {[llength $args] != 3} {
+ set shouldbe "\"dom_put ?-string? PROPERTY ARG-NAME CODE\""
+ error "Invalid arguments to dom_put - should be: $shouldbe"
}
-
- FlushDocBuffer $property
- $::hv3::dom2::CurrentType add_call $property $isString $arg_list $code
+ foreach {zProperty zArg zCode} $args {}
+ set put_array($zProperty) [list $isString $zArg $zCode]
}
- proc dom_construct {property arg_list code} {
- $::hv3::dom2::CurrentType add_construct $property $arg_list $code
+ proc dom_events {zCode} {
+ variable events
+ set events $zCode
}
- }
-
- proc reverse_foreach {var list body} {
- for {set ii [expr {[llength $list] - 1}]} {$ii >= 0} {incr ii -1} {
- uplevel [list set $var [lindex $list $ii]]
- uplevel $body
+ proc dom_scope {zCode} {
+ variable scope
+ set scope $zCode
}
- }
- # Figure out the base-class list for this type. The base-class list
- # should be in order from lowest to highest priority. i.e. if
- # constructing the following hierachy:
- #
- # Node
- # |
- # Element
- # |
- # HTMLElement
- #
- # the base class list for HTMLElement should be {Node Element}.
- #
- proc getBaseList {domtype} {
- ::variable TypeArray
- ::variable BaseArray
-
- if {![info exists TypeArray($domtype)]} {
- error "No such DOM type: $domtype"
- }
+ proc -- {args} {}
+ proc XX {args} {}
+ proc Ref {args} {}
- set base_list ""
- reverse_foreach base $BaseArray($domtype) {
- if {![info exists TypeArray($base)]} {
- error "No such DOM type: $base"
- }
-
- eval lappend base_list [getBaseList $base]
- lappend base_list $TypeArray($base)
+ proc Inherit {superclass code} {
+ eval $code
}
- return $base_list
}
- # Return the text for a Tcl [proc] implementing the object.
- #
- proc compile {domtype} {
- ::variable TypeArray
- set base_list [getBaseList $domtype]
+ namespace eval doccompiler {
- set ret ""
- append ret [$TypeArray($domtype) compile $base_list]
- append ret "\n"
+ variable get_array
+ variable put_array
+ variable call_array
- return $ret
- }
+ variable superclass
- # Return some HTML text describing the named object.
- #
- proc document {domtype} {
- ::variable TypeArray
- $TypeArray($domtype) document [getBaseList $domtype]
- }
+ variable current_xx ""
+ variable xx_array
- proc classlist {} {
- ::variable TypeArray
- array names TypeArray
- }
+ proc dom_parameter {args} {}
+ proc dom_default_value {args} {}
+ proc dom_finalize {args} {}
+ proc dom_call_todo {zProc} {}
+ proc dom_todo {zAttr} {}
+ proc dom_construct {args} {}
+ proc dom_events {args} {}
+ proc dom_scope {args} {}
- proc cleanup {} {
- ::variable TypeArray
- ::variable BaseArray
- ::variable CurrentType
- foreach {name type} [array get TypeArray] {
- $type destroy
+ proc Inherit {super code} {
+ variable superclass
+ set superclass $super
}
- unset -nocomplain TypeArray
- unset -nocomplain BaseArray
- unset -nocomplain CurrentType
- unset -nocomplain Docs
- unset -nocomplain DocBuffer
- }
-}
-# Each stateless object declaration
-#
-::snit::type ::hv3::dom2::typecompiler {
-
- # Map of properties configured with a [dom_get]
- #
- # property-name -> CODE
- #
- variable myGet -array [list]
-
- # Map of properties configured with a [dom_put]
- #
- # property-name -> [list IS-STRING ARG-NAME CODE]
- #
- # where IS-STRING is a boolean variable indicating whether or not
- # the -string switch was specified.
- #
- variable myPut -array [list]
-
- # Map of object methods. More accurately: Map of callable properties.
- #
- # property-name -> [list IS-CONSTRUCTOR IS-STRING ARG-LIST CODE]
- #
- # where IS-STRING is a boolean variable indicating whether or not
- # the -string switch was specified. IS-CONSTRUCTOR is true for a
- # constructor ([dom_construct]) and false for a regular method
- # ([dom_call]).
- #
- variable myCall -array [list]
-
- # List of snit blocks to add to the object definition
- #
- variable myFinalizer [list]
-
- # List of parameters that will be passed to the object proc.
- #
- variable myParam [list]
-
- # Code for the [DefaultValue] method.
- #
- variable myDefaultValue ""
-
- # List of [proc] declarations used for [dom_call].
- #
- variable myExtraCode ""
-
- # Code for the "Events" method.
- #
- variable myEvents ""
-
- # Code for the "Scope" method.
- #
- variable myScope ""
-
- # Name of this type - i.e. "HTMLDocument".
- #
- variable myName
- method name {} {set myName}
-
- constructor {name} {
- set myName $name
- }
+ proc dom_get {zProperty args} {
+ variable get_array
+ variable docbuffer
- method add_get {property code} {
- set myGet($property) $code
- }
- method add_put {isString property argname code} {
- set myPut($property) [list $isString $argname $code]
- }
- method add_snit {code} {
- lappend mySnit $code
- }
- method add_finalizer {code} {
- lappend myFinalizer $code
- }
- method add_parameter {parameter} {
- lappend myParam $parameter
- }
- method add_call {zName isString lArg zCode} {
- set myCall($zName) [list 0 $isString $lArg $zCode]
- }
- method add_construct {zName lArg zCode} {
- set myCall($zName) [list 1 0 $lArg $zCode]
- }
- method add_default_value {code} {
- set myDefaultValue $code
- }
- method add_events {code} {
- set myEvents $code
- }
- method add_scope {code} {
- set myScope $code
- }
-
- method call {} { return [array get myCall] }
- method get {} { return [array get myGet] }
- method put {} { return [array get myPut] }
- method snit {} { return $mySnit }
- method final {} { return $myFinalizer }
- method param {} { return $myParam }
- method events {} { return $myEvents }
- method scope {} { return $myScope }
-
- method CompilePut {mixins} {
- set Put {
- set value [lindex [set args] 1]
- switch -exact -- [lindex [set args] 0] {
- $SWITCHBODY
- default {
- $NATIVE
- }
- }
- }
-
- array set put_array ""
- foreach t [concat $mixins $self] {
- array set put_array [$t put]
+ set get_array($zProperty) $docbuffer
+ set docbuffer ""
}
- foreach t [concat $mixins $self] {
- foreach {k v} [$t get] {
- if {![info exists put_array($k)]} {
- set put_array($k) {0 value {error "Read-only property"}}
- }
- }
- }
-
- set SWITCHBODY ""
- foreach {name value} [array get put_array] {
- foreach {isString argname code} $value {}
- if {$isString} {
- set put_code "set $argname \[\[\$myDom see\] tostring \$value\]"
+ proc dom_put {args} {
+ variable put_array
+ if {[lindex $args 0] eq "-string"} {
+ set put_array([lindex $args 1]) 1
} else {
- set put_code "set $argname \$value\n"
+ set put_array([lindex $args 0]) 1
}
- append put_code "\n$code\n"
- append put_code return
- append SWITCHBODY "[list $name $put_code]\n "
}
- set NATIVE "return native"
-
- set Put [subst -nocommands $Put]
- return $Put
- }
-
- method CompileGet {mixins} {
- set Get [AutoIndent 0 {
- set property [lindex [set args] 0]
- set res [switch -exact -- [set property] {
- $SWITCHBODY
- default {
- list
- $DEFAULT
- }
- }]
- set res
- }]
-
- set SWITCHBODY ""
- foreach t [concat $mixins $self] {
- array set get_array [$t get]
- }
- foreach t [concat $mixins $self] {
- array set call_array [$t call]
- }
+ # dom_call -string method args ...
+ proc dom_call {args} {
+ variable call_array
+ variable docbuffer
- # Add [switch] cases for properties declared with [dom_get].
- #
- foreach {name code} [array get get_array] {
- if {$name ne "*"} {
- set code [string trim [AutoIndent 4 $code]]
- append SWITCHBODY [subst -nocommands [AutoIndent 2 {
- $name {
- $code
- }
- }]]
+ if {[lindex $args 0] eq "-string"} {
+ set args [lrange $args 1 end]
}
- }
+ set method [lindex $args 0]
+ set arglist [lindex $args 1]
- # Add [switch] cases for properties declared with [dom_call].
- #
- set param_list [$self ParamList $mixins]
- set SetStateVar ""
- if {[lsearch -exact $param_list myStateArray]>=0} {
- set SetStateVar {upvar #0 $myStateArray state}
+ set call_array($method) [list $docbuffer [lrange $arglist 1 end]]
+ set docbuffer ""
}
- foreach {name value} [array get call_array] {
- if {[info exists get_array($name)]} continue
- foreach {isConstructor isString lArg zBody} $value {}
-
- set zBody "\n${SetStateVar}\n${zBody}"
-
- set arglist [concat myDom $param_list $lArg]
- if {$isConstructor} {
- set procname ::hv3::DOM::${myName}_construct_${name}
- } else {
- set procname ::hv3::DOM::${myName}_call_${name}
- }
- lappend myExtraCode [list proc $procname $arglist $zBody]
-
- set SET_PARAMS ""
- foreach param $param_list {
- append SET_PARAMS " \$$param"
- }
-
- if {$isConstructor} {
- set code [subst -nocommands {
- list cache transient [list \
- ::hv3::dom::TclConstructable \
- [[set myDom] see] [list $procname [set myDom] $SET_PARAMS]
- ]
- }]
+ proc -- {args} {
+ variable docbuffer
+ if {[llength $args] == 0} {
+ append docbuffer <p>
} else {
- set code [subst -nocommands {
- list cache transient [list \
- ::hv3::dom::TclCallableProc \
- [[set myDom] see] $isString [list $procname [set myDom] $SET_PARAMS]
- ]
- }]
+ if {$docbuffer eq ""} {append docbuffer <p>}
+ append docbuffer [join $args " "]
+ append docbuffer "\n"
}
-
- set code [string trim [AutoIndent 2 $code]]
- append SWITCHBODY [AutoIndent 2 [subst -nocommands {
- $name {
- $code
- }
- }]]
+ return ""
}
+ proc XX {args} {
+ variable current_xx
+ variable xx_array
+ variable docbuffer
- set SWITCHBODY [string trim $SWITCHBODY]
-
- set DEFAULT ""
- if {[info exists myGet(*)]} {
- set DEFAULT $myGet(*)
- }
-
- set Get [subst -nocommands $Get]
- return $Get
- }
-
- method CompileHasProperty {mixins} {
- if {[info exists myGet(*)]} {
- return [subst -nocommands {
- return [expr {[eval [SELF] Get [set args]] ne ""}]
- }]
- } else {
-
- set l [list]
- foreach t [concat $mixins $self] {
- foreach {key code} [concat [$t call] [$t get]] {
- lappend l $key
- }
+ if {[llength $args] != 0} {
+ set current_xx [join $args " "]
}
- return [subst -nocommands {
- return [expr [lsearch {$l} [lindex [set args] 0]]>=0]
- }]
-
- }
- }
-
- method CompileEvents {mixins} {
- set L [concat $mixins $self]
- set code ""
- for {set ii [llength $L]} {$code eq "" && $ii > 0} {incr ii -1} {
- set C [lindex $L [expr {$ii-1}]]
- set code [$C events]
- }
- return $code
- }
- method CompileScope {mixins} {
- set L [concat $mixins $self]
- set code ""
- for {set ii [llength $L]} {$code eq "" && $ii > 0} {incr ii -1} {
- set C [lindex $L [expr {$ii-1}]]
- set code [$C scope]
- }
- return $code
- }
-
- method ParamList {mixins} {
- set ret [list]
- foreach t [concat $mixins $self] {
- set ret [concat $ret [$t param]]
- }
- set ret
- }
-
- method compile {mixins} {
-
- set Get [AutoIndent 6 [$self CompileGet $mixins]]
- set Put [AutoIndent 6 [$self CompilePut $mixins]]
- set HasProperty [AutoIndent 6 [$self CompileHasProperty $mixins]]
- set Events [AutoIndent 6 [$self CompileEvents $mixins]]
- set Scope [AutoIndent 6 [$self CompileScope $mixins]]
-
- set Final ""
- foreach t [concat $self $mixins] {
- append Finalizer [join [$t final] "\n"]
- append Finalizer "\n"
- }
-
- if {$myDefaultValue eq ""} {
- set myDefaultValue {list string [SELF]}
+ set xx_array($current_xx) $docbuffer
+ set docbuffer ""
}
-
- set param_list [$self ParamList $mixins]
-#puts "$myName has [llength $param_list] params: $param_list"
- set SetStateVar ""
- if {[lsearch -exact $param_list myStateArray]>=0} {
- set SetStateVar {upvar #0 $myStateArray state}
- }
-
- set selflist "list ::hv3::DOM::$myName \[set myDom\] "
- foreach param $param_list {
- append selflist [subst -nocommands {[set $param]}]
- append selflist " "
- }
-
- set arglist [concat myDom $param_list Method args]
- set Code [AutoIndent 0 {
- proc ::hv3::DOM::$myName {$arglist} {
- $SetStateVar
- set SELF [$selflist]
- switch -exact -- [set Method] {
- Get {
- $Get
- }
- Put {
- $Put
- }
- HasProperty {
- $HasProperty
- }
- DefaultValue {
- $myDefaultValue
- }
- Finalize {
- $Finalizer
- }
- Events {
- $Events
- }
- Scope {
- $Scope
- }
+ proc Ref {ref {text ""}} {
+ if {$text eq ""} {set text $ref}
+ subst {<A href="${ref}">${text}</A>}
+ }
+
+ proc clean {} {
+ variable get_array
+ variable put_array
+ variable call_array
+ variable docbuffer
+ variable superclass
+ variable current_xx
+ variable xx_array
+
+ set superclass ""
+ set docbuffer ""
+ set current_xx ""
+ array unset get_array
+ array unset put_array
+ array unset call_array
+ array unset xx_array
+ array set xx_array [list "" "<I>TODO: Class documentation</I>"]
+ }
+
+ proc make {classname} {
+ variable get_array
+ variable put_array
+ variable call_array
+ variable xx_array
+ variable superclass
+
+ set properties "<TR><TD colspan=3><H2>Properties</H2>"
+ set iStripe 0
+ foreach {zProp} [lsort [array names get_array]] {
+ set docs $get_array($zProp)
+ set readwrite ""
+ if {[info exists put_array($zProp)]} {
+ set readwrite "<I>r/w</I>"
}
+ append properties "<TR class=stripe${iStripe}>
+ <TD class=spacer>
+ <TD class=\"property\"><B>$zProp</B>
+ <TD>$readwrite
+ <TD width=100%>$docs
+ "
+ set iStripe [expr {($iStripe+1)%2}]
}
- }]
-
- set Code [subst -nocommands $Code]
- append Code "\n"
- append Code [join $myExtraCode "\n"]
- return $Code
- }
-
- method GetDocs {{property ""}} {
- set name [$self name]
- if {$property ne ""} {append name ".$property"}
- if {[info exists ::hv3::dom2::Docs($name)]} {
- return $::hv3::dom2::Docs($name)
- }
- if {$property eq ""} {return ""}
- return "<SPAN class=nodocs>No docs available.</SPAN>"
- }
-
- method document {mixins} {
- # Big heading: The name of the DOM class:
- #
- append ret "<A name=$myName><H1>$myName</H1></A>\n"
-
- set d [$self GetDocs]
- if {$d ne ""} { append ret "<P>$d</P>" }
-
- # The list of implemented interfaces:
- #
- if {[llength $mixins] > 0} {
- append ret "<H2>Inheritance</H2><UL>"
- foreach mixin $mixins {
- set name [$mixin name]
- append ret "<LI><A href=#${name}>${name}</A>"
+ set methods "<TR><TD colspan=3><H2>Methods</H2>"
+ set iStripe 0
+ foreach {zProp} [lsort [array names call_array]] {
+ set data $call_array($zProp)
+ foreach {docs arglist} $data {break}
+ set zArglist [join $arglist ", "]
+ append methods "<TR class=stripe${iStripe}>
+ <TD class=spacer>
+ <TD class=\"method\" colspan=2><B>${zProp}</B>(${zArglist})
+ <TD width=100%>$docs
+ "
+ set iStripe [expr {($iStripe+1)%2}]
}
- append ret "</UL>"
- }
- # The list of properties
- #
- array set property_array [$self get]
- array set put_array [$self put]
- set props [array names property_array]
- if {[llength $props] > 0} {
- append ret {<H2>Properties</H2><TABLE border=1>}
- foreach k [lsort -command ::hv3::dom2::DocSorter $props] {
- set mode read-only
- if {[info exists put_array($k)]} {set mode read/write}
- set docs [$self GetDocs $k]
- if {$k eq "*"} {set k {Other Properties} }
- append ret "<TR><TH>$k<TD class=mode><I>$mode</I><TD>$docs"
+ set super ""
+ if {$superclass ne ""} {
+ set super [string map [list %SUPER% $superclass] {
+ <P class=superclass>
+ This object type inherits from <A href="%SUPER%">%SUPER%</A>.
+ In addition to the properties and methods shown below, it has
+ all the properties and methods of the %SUPER% object.
+ </P>
+ }]
}
- append ret "</TABLE>"
- }
- # The list of methods
- #
- array set call_array [$self call]
- set calls [array names call_array]
- if {[llength $calls] > 0} {
- append ret {<H2>Methods</H2><TABLE border=1>}
- foreach k [lsort -command ::hv3::dom2::DocSorter $calls] {
- foreach {isConstructor isString lArg zBody} $call_array($k) {}
- set param_list [list]
- foreach param [lrange $lArg 1 end] {
- lappend param_list [lindex $param 0]
- }
- set params [join $param_list ", "]
- if {!$isConstructor} {
- set docs [$self GetDocs $k]
- append ret {<TR><TH>}
- append ret "${k}(${params})"
- append ret "<TD>$docs"
- }
- }
- append ret "</TABLE>"
- }
+ set Docs [string map [list \
+ %CLASSNAME% $classname \
+ %OVERVIEW% $xx_array() \
+ %PROPERTIES% $properties \
+ %METHODS% $methods \
+ %SUPERCLASS% $super \
+ ] {
+ <LINK rel="stylesheet" href="home://dom/style.css">
+ <TITLE>Class %CLASSNAME%</TITLE>
+ <H1>DOM Class %CLASSNAME%</H1>
+ <DIV class=overview> %OVERVIEW% </DIV>
+ %SUPERCLASS%
+ <TABLE>
+ %PROPERTIES%
+ %METHODS%
+ </TABLE>
+ }]
- set ret
+ return $Docs
+ }
}
}
-proc ::hv3::dom2::DocSorter {a b} {
- if {$a eq "*"} {return +1}
- if {$b eq "*"} {return -1}
- return [string compare $a $b]
-}
-
diff --git a/hv/hv3_dom_containers.tcl b/hv/hv3_dom_containers.tcl
index 0bbd6ff..bd96aa0 100644
--- a/hv/hv3_dom_containers.tcl
+++ b/hv/hv3_dom_containers.tcl
@@ -1,4 +1,4 @@
-namespace eval hv3 { set {version($Id: hv3_dom_containers.tcl,v 1.7 2007/07/23 07:15:41 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3_dom_containers.tcl,v 1.11 2008/02/15 18:23:37 danielk1977 Exp $)} 1 }
# This file contains the implementation of the two DOM specific
# container objects:
@@ -31,7 +31,7 @@ namespace eval hv3 { set {version($Id: hv3_dom_containers.tcl,v 1.7 2007/07/23 0
#
# work as expected.
#
-::hv3::dom2::stateless HTMLCollectionC {} {
+::hv3::dom2::stateless HTMLCollectionC {
# There are several variations on the role this object may play in
# DOM level 1 Html:
@@ -45,7 +45,6 @@ namespace eval hv3 { set {version($Id: hv3_dom_containers.tcl,v 1.7 2007/07/23 0
# HTMLDocument.anchors
#
# HTMLFormElement.elements
- # HTMLSelectElement.options
# HTMLMapElement.areas
#
# HTMLTableElement.rows
@@ -76,6 +75,24 @@ namespace eval hv3 { set {version($Id: hv3_dom_containers.tcl,v 1.7 2007/07/23 0
# Handle an attempt to retrieve an unknown property.
#
dom_get * {
+ HTMLCollectionC_getUnknownProperty $myDom $nodelistcmd $property
+ }
+}
+
+namespace eval ::hv3::DOM {
+ proc HTMLCollectionC_getNodeHandlesByName {supersetcmd name} {
+ set nodelist [eval $supersetcmd]
+ set ret [list]
+ foreach node $nodelist {
+ if {[$node attr -default "" id] eq $name ||
+ [$node attr -default "" name] eq $name} {
+ lappend ret $node
+ }
+ }
+ return $ret
+ }
+
+ proc HTMLCollectionC_getUnknownProperty {dom supersetcmd property} {
# If $property looks like a number, treat it as an index into the list
# of widget nodes.
@@ -86,41 +103,27 @@ namespace eval hv3 { set {version($Id: hv3_dom_containers.tcl,v 1.7 2007/07/23 0
# containing the matches is returned.
#
if {[string is double $property]} {
- set res [HTMLCollectionC_item $myDom $nodelistcmd $property]
+ set res [HTMLCollectionC_item $dom $supersetcmd $property]
} else {
set res [
- HTMLCollectionC_getNodeHandlesByName $nodelistcmd $property
+ HTMLCollectionC_getNodeHandlesByName $supersetcmd $property
]
set nRet [llength $res]
if {$nRet==0} {
set res ""
} elseif {$nRet==1} {
- set res [list object [::hv3::dom::wrapWidgetNode $myDom [lindex $res 0]]]
+ set res [list object [::hv3::dom::wrapWidgetNode $dom [lindex $res 0]]]
} else {
set getnodes [namespace code [list \
- HTMLCollectionC_getNodeHandlesByName $nodelistcmd $property
+ HTMLCollectionC_getNodeHandlesByName $supersetcmd $property
]]
- set obj [list ::hv3::DOM::NodeListC $myDom $getnodes]
+ set obj [list ::hv3::DOM::NodeListC $dom $getnodes]
set res [list object $obj]
}
}
return $res
}
-}
-
-namespace eval ::hv3::DOM {
- proc HTMLCollectionC_getNodeHandlesByName {supersetcmd name} {
- set nodelist [eval $supersetcmd]
- set ret [list]
- foreach node $nodelist {
- if {[$node attr -default "" id] eq $name ||
- [$node attr -default "" name] eq $name} {
- lappend ret $node
- }
- }
- return $ret
- }
proc HTMLCollectionC_item {dom nodelistcmd index} {
set idx [format %.0f $index]
@@ -153,27 +156,23 @@ namespace eval ::hv3::DOM {
}
}
-::hv3::dom2::stateless HTMLCollectionS {} {
+::hv3::dom2::stateless HTMLCollectionS {
- # Name of the tkhtml widget to evaluate [$myHtml search] with.
+ # This is set to a search command like ".html search p" (to find
+ # all <P> elements in the system).
#
- dom_parameter myHtml
-
- # The following option is set to a CSS Selector to return the
- # nodes in that make up the contents of this NodeList.
- #
- dom_parameter mySelector
+ dom_parameter mySearchCmd
# HTMLCollection.length
#
dom_get length {
- list number [$myHtml search $mySelector -length]
+ list number [eval $mySearchCmd -length]
}
# HTMLCollection.item()
#
dom_call -string item {THIS index} {
- set node [$myHtml search $mySelector -index [expr {int($index)}]]
+ set node [eval $mySearchCmd -index [expr {int($index)}]]
if {$node ne ""} {
list object [::hv3::dom::wrapWidgetNode $myDom $node]
} else {
@@ -187,15 +186,17 @@ namespace eval ::hv3::DOM {
# something. This is not dangerous - there is no scope for injection
# attacks.
dom_call -string namedItem {THIS name} {
+ set html [lindex $mySearchCmd 0]
+ set selector [lindex $mySearchCmd 2]
# First search for a match on the id attribute.
- set sel [format {%s[id="%s"]} $mySelector $name]
- set node [$myHtml search $sel -index 0]
+ set sel [format {%s[id="%s"]} $selector $name]
+ set node [$html search $sel -index 0]
# Next try to find a node with a matching name attribute.
if {$node eq ""} {
- set sel [format {%s[name="%s"]} $mySelector $name]
- set node [$myHtml search $sel -index 0]
+ set sel [format {%s[name="%s"]} $selector $name]
+ set node [$html search $sel -index 0]
}
# Return a Node object if successful, otherwise null.
@@ -219,21 +220,22 @@ namespace eval ::hv3::DOM {
# containing the matches is returned.
#
if {[string is double $property]} {
- set node [$myHtml search $mySelector -index [expr {int($property)}]]
+ set node [eval $mySearchCmd -index [expr {int($property)}]]
if {$node ne ""} {
list object [::hv3::dom::wrapWidgetNode $myDom $node]
}
} else {
set name $property
- set s $mySelector
+ set html [lindex $mySearchCmd 0]
+ set s [lindex $mySearchCmd 2]
set sel [format {%s[name="%s"],%s[id="%s"]} $s $name $s $name]
- set nNode [$myHtml search $sel -length]
+ set nNode [$html search $sel -length]
if {$nNode > 0} {
if {$nNode == 1} {
- list object [::hv3::dom::wrapWidgetNode $myDom [$myHtml search $sel]]
+ list object [::hv3::dom::wrapWidgetNode $myDom [$html search $sel]]
} else {
list object [list \
- ::hv3::DOM::NodeListC $myDom [list $myHtml search $sel]
+ ::hv3::DOM::NodeListC $myDom [list $html search $sel]
]
}
}
@@ -253,7 +255,7 @@ namespace eval ::hv3::DOM {
# * Element node (children based on html widget node-handle)
# * Text or Attribute node (no children)
#
-::hv3::dom2::stateless NodeListC {} {
+::hv3::dom2::stateless NodeListC {
# The following option is set to a command to return the html-widget nodes
# that comprise the contents of this list. i.e. for the value of
@@ -298,30 +300,21 @@ namespace eval ::hv3::DOM {
# returned by getElementsByTagName() and kin. It is a wrapper
# around [$html search].
#
-::hv3::dom2::stateless NodeListS {} {
+::hv3::dom2::stateless NodeListS {
# Name of the tkhtml widget to evaluate [$myHtml search] with.
#
- dom_parameter myHtml
-
- # The following option is set to the root-node of the sub-tree
- # to search with $mySelector. An empty string means search the
- # whole tree.
- #
- dom_parameter myRoot
-
- # The following option is set to a CSS Selector to return the
- # nodes in that make up the contents of this NodeList.
+ # Command like ".html search $selector -root $rootnode"
#
- dom_parameter mySelector
+ dom_parameter mySearchCmd
dom_call -string item {THIS index} {
if {![string is double $index]} { return null }
- NodeListS_item $myDom $myHtml $mySelector $myRoot [expr {int($index)}]
+ NodeListS_item $myDom $mySearchCmd [expr {int($index)}]
}
dom_get length {
- list number [$myHtml search $mySelector -length -root $myRoot]
+ list number [eval $mySearchCmd -length]
}
# Unknown property request. If the property name looks like a number,
@@ -329,14 +322,14 @@ namespace eval ::hv3::DOM {
#
dom_get * {
if {[string is integer $property]} {
- NodeListS_item $myDom $myHtml $mySelector $myRoot $property
+ NodeListS_item $myDom $mySearchCmd $property
}
}
}
namespace eval ::hv3::DOM {
- proc NodeListS_item {dom html selector root idx} {
- set N [$html search $selector -index $idx -root $root]
+ proc NodeListS_item {dom searchcmd idx} {
+ set N [eval $searchcmd -index $idx]
if {$N eq ""} {
list null
} else {
@@ -345,9 +338,14 @@ namespace eval ::hv3::DOM {
}
}
-::hv3::dom2::stateless FramesList {} {
+::hv3::dom2::stateless FramesList {
+ -- This class implements a container used for the
+ -- <code>window.frames</code> property in Hv3.
+ XX
+
dom_parameter myFrame
+ -- Return the number of items in this container.
dom_get length {
list number [llength [$myFrame child_frames]]
}
@@ -357,12 +355,12 @@ namespace eval ::hv3::DOM {
if {[string is integer $property]} {
set f [lindex $frames [expr {int($property)}]]
if {$f eq ""} return ""
- return [list object [$myDom hv3_to_window [$f hv3]]]
+ return [list bridge [[$f hv3 dom] see]]
}
foreach f $frames {
if {$property eq [$f cget -name]} {
- return [list object [$myDom hv3_to_window [$f hv3]]]
+ return [list bridge [[$f hv3 dom] see]]
}
}
@@ -370,3 +368,44 @@ namespace eval ::hv3::DOM {
}
}
+::hv3::dom2::stateless HTMLOptionsCollection {
+ dom_parameter mySelectNode
+
+ # HTMLCollection.length
+ #
+ dom_get length {
+ list number [llength [HTMLSelectElement_getOptions $mySelectNode]]
+ }
+
+ # HTMLCollection.item()
+ #
+ dom_call -string item {THIS index} {
+ set cmd [list HTMLSelectElement_getOptions $mySelectNode]
+ HTMLCollectionC_item $myDom $cmd $index
+ }
+
+ # HTMLCollection.namedItem()
+ #
+ dom_call -string namedItem {THIS name} {
+ set cmd [list HTMLSelectElement_getOptions $mySelectNode]
+ HTMLCollectionC_namedItem $myDom $cmd $name
+ }
+
+ # Handle an attempt to retrieve an unknown property.
+ #
+ dom_get * {
+ set cmd [list HTMLSelectElement_getOptions $mySelectNode]
+ HTMLCollectionC_getUnknownProperty $myDom $cmd $property
+ }
+
+ # The "selectedIndex" property of this collection is an alias for
+ # the "selectedIndex" property of the <SELECT> node.
+ dom_get selectedIndex {
+ list number [[$mySelectNode replace] dom_selectionIndex]
+ }
+ dom_put -string selectedIndex value {
+ [$mySelectNode replace] dom_setSelectionIndex $value
+ }
+}
+
+
diff --git a/hv/hv3_dom_core.tcl b/hv/hv3_dom_core.tcl
index 026367d..1785de4 100644
--- a/hv/hv3_dom_core.tcl
+++ b/hv/hv3_dom_core.tcl
@@ -1,4 +1,4 @@
-namespace eval hv3 { set {version($Id: hv3_dom_core.tcl,v 1.29 2007/08/04 17:15:25 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3_dom_core.tcl,v 1.40 2008/02/15 18:23:37 danielk1977 Exp $)} 1 }
#--------------------------------------------------------------------------
# DOM Level 1 Core
@@ -7,6 +7,20 @@ namespace eval hv3 { set {version($Id: hv3_dom_core.tcl,v 1.29 2007/08/04 17:15:
# possible, Hv3 tries hard to be compatible with W3C and Gecko. Gecko
# is pretty much a clean super-set of W3C for this module.
#
+# DOMImplementation
+# Document
+# Node
+# NodeList
+# CharacterData
+# Element
+# Text
+#
+# Not implemented:
+# Attr
+# Comment
+# NamedNodeMap
+# DocumentFragment
+#
#-------------------------------------------------------------------------
#--------------------------------------------------------------------------
@@ -22,29 +36,33 @@ namespace eval hv3 { set {version($Id: hv3_dom_core.tcl,v 1.29 2007/08/04 17:15:
# Probably also want to implement Document-fragment nodes at some
# stage. And Comment too, but I bet we can get away without it :)
#
-::hv3::dom2::stateless NodePrototype {} {
- # Required by XML and HTML applications:
- dom_get ELEMENT_NODE {list number 1}
- dom_get ATTRIBUTE_NODE {list number 2}
- dom_get TEXT_NODE {list number 3}
- dom_get COMMENT_NODE {list number 8}
- dom_get DOCUMENT_NODE {list number 9}
- dom_get DOCUMENT_FRAGMENT_NODE {list number 11}
-
- # Required by XML applications only:
- dom_get CDATA_SECTION_NODE {list number 4}
- dom_get ENTITY_REFERENCE_NODE {list number 5}
- dom_get ENTITY_NODE {list number 6}
- dom_get PROCESSING_INSTRUCTION_NODE {list number 7}
- dom_get DOCUMENT_TYPE_NODE {list number 10}
- dom_get NOTATION_NODE {list number 12}
+namespace eval ::hv3::dom::code {
+ set NODE_PROTOTYPE {
+ # Required by XML and HTML applications:
+ dom_get ELEMENT_NODE {list number 1}
+ dom_get ATTRIBUTE_NODE {list number 2}
+ dom_get TEXT_NODE {list number 3}
+ dom_get COMMENT_NODE {list number 8}
+ dom_get DOCUMENT_NODE {list number 9}
+ dom_get DOCUMENT_FRAGMENT_NODE {list number 11}
+
+ # Required by XML applications only:
+ dom_get CDATA_SECTION_NODE {list number 4}
+ dom_get ENTITY_REFERENCE_NODE {list number 5}
+ dom_get ENTITY_NODE {list number 6}
+ dom_get PROCESSING_INSTRUCTION_NODE {list number 7}
+ dom_get DOCUMENT_TYPE_NODE {list number 10}
+ dom_get NOTATION_NODE {list number 12}
+ }
+ ::hv3::dom2::stateless NodePrototype %NODE_PROTOTYPE%
+ set NODE_PROTOTYPE [list Inherit NodePrototype $NODE_PROTOTYPE]
}
#--------------------------------------------------------------------------
# This block contains default implementations of the methods and
# attributes in the Node interface (DOM Level 1 Core).
#
-::hv3::dom2::stateless Node {} {
+set ::hv3::dom::code::NODE {
# These must both be overridden.
dom_todo nodeName
@@ -65,10 +83,9 @@ namespace eval hv3 { set {version($Id: hv3_dom_core.tcl,v 1.29 2007/08/04 17:15:
dom_get previousSibling {list null}
dom_get nextSibling {list null}
- # Default implementations for nodes that are not allowed children.
- # i.e. those of type ATTRIBUTE and TEXT.
- #
- dom_get parentNode {list null}
+ -- Always null for this object.
+ dom_get parentNode {list cache null}
+
dom_get firstChild {list null}
dom_get lastChild {list null}
@@ -103,7 +120,7 @@ namespace eval hv3 { set {version($Id: hv3_dom_core.tcl,v 1.29 2007/08/04 17:15:
}
}
-::hv3::dom2::stateless Implementation {} {
+::hv3::dom2::stateless Implementation {
dom_call -string hasFeature {THIS feature version} {
set feature [string tolower $feature]
@@ -124,7 +141,7 @@ namespace eval hv3 { set {version($Id: hv3_dom_core.tcl,v 1.29 2007/08/04 17:15:
}
}
-::hv3::dom2::stateless Document {} {
+set ::hv3::dom::code::DOCUMENT {
# The ::hv3::hv3 widget containing the document this DOM object
# represents.
@@ -132,17 +149,14 @@ namespace eval hv3 { set {version($Id: hv3_dom_core.tcl,v 1.29 2007/08/04 17:15:
dom_parameter myHv3
-- Always Node.DOCUMENT_NODE (integer value 9).
- --
dom_get nodeType {list number 9}
-- Always the literal string \"#document\".
- --
dom_get nodeName {list string #document}
-- The Document node always has exactly one child: the <\;HTML>\; element
-- of the document tree. This property always contains a [Ref NodeList]
-- collection containing that element.
- --
dom_get childNodes {
set cmd [list $myHv3 node]
list object [list ::hv3::DOM::NodeListC $myDom $cmd]
@@ -150,21 +164,18 @@ namespace eval hv3 { set {version($Id: hv3_dom_core.tcl,v 1.29 2007/08/04 17:15:
-- Return the root element of the document tree (an object of class
-- [Ref HTMLHtmlElement]).
- --
dom_get firstChild {
list object [::hv3::dom::wrapWidgetNode $myDom [$myHv3 node]]
}
-- Return the root element of the document tree (an object of class
-- [Ref HTMLHtmlElement]).
- --
dom_get lastChild {
list object [::hv3::dom::wrapWidgetNode $myDom [$myHv3 node]]
}
-- The document node always has exactly one child node. So this property
-- is always set to true.
- --
dom_call hasChildNodes {THIS} {list boolean true}
dom_call_todo insertBefore
@@ -173,7 +184,6 @@ namespace eval hv3 { set {version($Id: hv3_dom_core.tcl,v 1.29 2007/08/04 17:15:
dom_call_todo appendChild
-- For a Document node, the ownerDocument is null.
- --
dom_get ownerDocument {list null}
# End of Node interface overrides.
@@ -182,14 +192,12 @@ namespace eval hv3 { set {version($Id: hv3_dom_core.tcl,v 1.29 2007/08/04 17:15:
dom_todo doctype
-- Reference to the [Ref Implementation] object.
- --
dom_get implementation {
list object [list ::hv3::DOM::Implementation $myDom]
}
-- This property is always set to the <\;HTML>\; element (an object of
-- class [Ref HTMLHtmlElement]).
- --
dom_get documentElement {
list object [::hv3::dom::wrapWidgetNode $myDom [$myHv3 node]]
}
@@ -204,7 +212,7 @@ namespace eval hv3 { set {version($Id: hv3_dom_core.tcl,v 1.29 2007/08/04 17:15:
# createEntityReference() (todo)
#
dom_call -string createElement {THIS tagname} {
- set node [$myHv3 fragment "<$tagname>"]
+ set node [$myHv3 html fragment "<$tagname>"]
if {$node eq ""} {error "DOMException NOT_SUPPORTED_ERR"}
list object [::hv3::dom::wrapWidgetNode $myDom $node]
}
@@ -213,11 +221,11 @@ namespace eval hv3 { set {version($Id: hv3_dom_core.tcl,v 1.29 2007/08/04 17:15:
# Special case - The [fragment] API usually parses an empty string
# to an empty fragment. So create a text node with text "X", then
# set the text to an empty string.
- set node [$myHv3 fragment X]
+ set node [$myHv3 html fragment X]
$node text set ""
} else {
set escaped [string map {< < > >} $data]
- set node [$myHv3 fragment $escaped]
+ set node [$myHv3 html fragment $escaped]
}
list object [::hv3::dom::wrapWidgetNode $myDom $node]
}
@@ -234,7 +242,9 @@ namespace eval hv3 { set {version($Id: hv3_dom_core.tcl,v 1.29 2007/08/04 17:15:
# someone is going to pass ".id" and wonder why all the elements with
# the "class" attribute set to "id" are returned.
#
- set nl [list ::hv3::DOM::NodeListS $myDom [$myHv3 html] "" $tag]
+ set html $myHv3
+ catch {set html [$myHv3 html]}
+ set nl [list ::hv3::DOM::NodeListS $myDom [list $html search $tag]]
list transient $nl
}
}
@@ -250,28 +260,24 @@ namespace eval hv3 { set {version($Id: hv3_dom_core.tcl,v 1.29 2007/08/04 17:15:
# Node.nextSibling
# Node.ownerDocument
#
-::hv3::dom2::stateless WidgetNode {} {
-
+set ::hv3::dom::code::WIDGET_NODE {
dom_parameter myNode
- # Retrieve the parent node.
- #
+ -- Retrieve the parent element. If this node is the root of the
+ -- document tree, return the associated window.document object.
+ -- Return null if there is no parent element (can happen if this
+ -- node has been removed from the document tree.
dom_get parentNode {
- set ret null
+ # Note that there is another version of this function in the
+ # implementation of HTMLHtmlElement. Since the root of the document
+ # tree is always an <HTML> element, we can deal with possibly having
+ # to return the HTMLDocument object there.
set parent [$myNode parent]
- if {$parent eq ""} {
- # This may be either the root node of the document, or an
- # orphan. The parent of the root node is the DOM HTMLDocument
- # object. The parent of an orphan node is null.
- #
- set root [[$myNode html] node]
- if {$root eq $myNode} {
- set ret [list object [$myDom node_to_document $myNode]]
- }
+ if {$parent ne ""} {
+ list node [::hv3::dom::wrapWidgetNode $myDom $parent]
} else {
- set ret [list object [::hv3::dom::wrapWidgetNode $myDom $parent]]
+ list null
}
- set ret
}
# Retrieve the left and right sibling nodes.
@@ -297,7 +303,7 @@ namespace eval hv3 { set {version($Id: hv3_dom_core.tcl,v 1.29 2007/08/04 17:15:
}
dom_get ownerDocument {
- list object [$myDom node_to_document $myNode]
+ list object [node_to_document $myNode]
}
}
namespace eval ::hv3::DOM {
@@ -350,9 +356,9 @@ namespace eval ::hv3::DOM {
# This object is never actually instantiated. HTMLElement (and other,
# element-specific types) are instantiated instead.
#
-set BaseList {ElementCSSInlineStyle WidgetNode Node NodePrototype}
-::hv3::dom2::stateless Element $BaseList {
-
+set BaseList {ElementCSSInlineStyle}
+set ::hv3::dom::code::ELEMENT {
+
# Override parts of the Node interface.
#
dom_get nodeType {list number 1} ;# Node.ELEMENT_NODE -> 1
@@ -465,14 +471,19 @@ set BaseList {ElementCSSInlineStyle WidgetNode Node NodePrototype}
Element_putAttributeString $myNode $attr $v
}
- dom_call_todo removeAttribute
+ dom_call -string removeAttribute {THIS attr} {
+ Element_putAttributeString $myNode $attr ""
+ }
+
dom_call_todo getAttributeNode
dom_call_todo setAttributeNode
dom_call_todo removeAttributeNode
dom_call -string getElementsByTagName {THIS tagname} {
- set hv3 [$myDom node_to_hv3 $myNode]
- set nl [list ::hv3::DOM::NodeListS $myDom [$hv3 html] $myNode $tagname]
+ set htmlwidget [$myNode html]
+ set nl [list ::hv3::DOM::NodeListS $myDom [
+ list $htmlwidget search $tagname -root $myNode
+ ]]
list transient $nl
}
@@ -494,6 +505,7 @@ set BaseList {ElementCSSInlineStyle WidgetNode Node NodePrototype}
list boolean [expr {$rc ? 0 : 1}]
}
}
+
namespace eval ::hv3::DOM {
proc Element_getAttributeString {node name def} {
list string [$node attribute -default $def $name]
@@ -582,45 +594,68 @@ namespace eval ::hv3::dom::compiler {
}
}
}
-namespace eval ::hv3::dom2::compiler {
- proc element_attr {name args} {
-
- set readonly 0
- set attribute $name
-
- # Process the arguments to [element_attr]:
- for {set ii 0} {$ii < [llength $args]} {incr ii} {
- set s [lindex $args $ii]
- switch -- $s {
- -attribute {
- incr ii
- set attribute [lindex $args $ii]
- }
- -readonly {
- set readonly 1
- }
- default {
- error "Bad option to element_attr: $s"
+foreach ns [list ::hv3::dom2::compiler2 ::hv3::dom2::doccompiler] {
+ namespace eval $ns {
+
+ proc element_attr {name args} {
+
+ set readonly 0
+ set attribute $name
+
+ # Process the arguments to [element_attr]:
+ for {set ii 0} {$ii < [llength $args]} {incr ii} {
+ set s [lindex $args $ii]
+ switch -- $s {
+ -attribute {
+ incr ii
+ set attribute [lindex $args $ii]
+ }
+ -readonly {
+ set readonly 1
+ }
+ default {
+ error "Bad option to element_attr: $s"
+ }
}
}
- }
-
- # The Get code.
- dom_get $name [subst -novariables {
- Element_getAttributeString $myNode [set attribute] ""
- }]
-
- # Create the Put method (unless the -readonly switch was passed).
- if {!$readonly} {
- dom_put -string $name val [subst -novariables {
- Element_putAttributeString $myNode [set attribute] $val
+
+ # The Get code.
+ dom_get $name [subst -novariables {
+ Element_getAttributeString $myNode [set attribute] ""
}]
+
+ # Create the Put method (unless the -readonly switch was passed).
+ if {!$readonly} {
+ dom_put -string $name val [subst -novariables {
+ Element_putAttributeString $myNode [set attribute] $val
+ }]
+ }
}
}
}
-::hv3::dom2::stateless CharacterData {} {
+namespace eval ::hv3::DOM {
+ proc CharacterData_replaceData {node offset count arg} {
+ set nOffset [expr {int($offset)}]
+ set nCount [expr {int($count)}]
+ set idx [expr {$nOffset + $nCount}]
+ set text [$node text -pre]
+ set out [string range $text 0 [expr {$nOffset-1}]]
+ append out $arg
+ append out [string range $text $idx end]
+ $node text set $out
+ }
+}
+
+#-------------------------------------------------------------------------
+# DOM Type Text (Node -> CharacterData -> Text)
+#
+::hv3::dom2::stateless Text {
+
+ %NODE%
+ %WIDGET_NODE%
+ %NODE_PROTOTYPE%
# The "data" property is a get/set on the contents of this text node.
#
@@ -661,25 +696,6 @@ namespace eval ::hv3::dom2::compiler {
dom_call -string replaceData {THIS offset count arg} {
CharacterData_replaceData $myNode $offset $count $arg
}
-}
-namespace eval ::hv3::DOM {
- proc CharacterData_replaceData {node offset count arg} {
- set nOffset [expr {int($offset)}]
- set nCount [expr {int($count)}]
- set idx [expr {$nOffset + $nCount}]
- set text [$node text -pre]
- set out [string range $text 0 [expr {$nOffset-1}]]
- append out $arg
- append out [string range $text $idx end]
- $node text set $out
- }
-}
-
-#-------------------------------------------------------------------------
-# DOM Type Text (Node -> CharacterData -> Text)
-#
-set BaseList {CharacterData WidgetNode Node NodePrototype}
-::hv3::dom2::stateless Text $BaseList {
# Override parts of the Node interface.
#
diff --git a/hv/hv3_dom_events.tcl b/hv/hv3_dom_events.tcl
index 66fa80a..bf75cd2 100644
--- a/hv/hv3_dom_events.tcl
+++ b/hv/hv3_dom_events.tcl
@@ -1,4 +1,4 @@
-namespace eval hv3 { set {version($Id: hv3_dom_events.tcl,v 1.27 2007/07/02 12:31:33 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3_dom_events.tcl,v 1.34 2007/11/25 18:29:15 danielk1977 Exp $)} 1 }
#-------------------------------------------------------------------------
# DOM Level 2 Events.
@@ -36,6 +36,210 @@ namespace eval hv3 { set {version($Id: hv3_dom_events.tcl,v 1.27 2007/07/02 12:3
#
#-------------------------------------------------------------------------
+############################################################################
+# DOCUMENTATION FOR EVENTS SUB-SYSTEM
+#
+if {$::hv3::dom::CREATE_DOM_DOCS} {
+ namespace eval ::hv3::DOM::macros {
+ proc ER {type target bubbles cancellable eventtype} {
+ return "
+ <TR><TD width=16ex>$type
+ <TD>$target
+ <TD width=1%>$bubbles
+ <TD width=1%>$cancellable
+ <TD width=1%><A href=$eventtype>$eventtype</A>
+ "
+ }
+ proc ::hv3::DOM::docs::eventoverview {} [subst -novar { return {
+ <HTML>
+ <HEAD>
+ <LINK rel=stylesheet href="home://dom/style.css">
+ <STYLE>
+ TABLE { margin: 0 1cm; width: 100% }
+ H1 { margin-left: auto; margin-right: auto }
+ TH { white-space: nowrap }
+ </STYLE>
+
+ <TITLE>Overview of Events</TITLE>
+ </HEAD>
+
+ <H1>Hv3 Events Reference</H1>
+ <P>
+ This document describes the way Hv3 dispatches events for handling
+ by javascript programs embedded in web-pages. It also describes the
+ <A>specific set of events supported by Hv3</A>.
+ <P>
+ In general, Hv3 supports those events specified by Chapter 18 of the
+ <A href="http://www.w3.org/TR/html401/">HTML 4.01 standard</A>.
+ The processing model for events is based on the W3C
+ <A href="http://www.w3.org/TR/DOM-Level-2-Events/">DOM Level 2 Events
+ </A> recomendation.
+
+ <H2>Event Processing in Hv3</H2>
+
+ <H2 name="types">Supported Event Types</H2>
+
+ <H3>Document Events</H3>
+
+ <TABLE border=1>
+ <TR><TH>Event<TH>Target<TH>Bubbles<TH>Cancellable<TH>Event Object Type
+ [ER Load Window 0 0 Event]
+ [ER Unload {} {} {} {}]
+ </TABLE>
+
+ <H3>Mouse Events</H3>
+ <TABLE border=1>
+ <TR><TH>Event<TH>Target<TH>Bubbles<TH>Cancellable<TH>Event Object Type
+ [ER Click {All elements and text} 1 1 MouseEvent]
+ [ER Dblclick {} {} {} {}]
+ [ER Mousedown {All HTMLElement, Text} 1 1 MouseEvent]
+ [ER Mouseup {All HTMLElement, Text} 1 1 MouseEvent]
+ [ER Mouseover {All HTMLElement, Text} 1 1 MouseEvent]
+ [ER Mousemove {All HTMLElement, Text} 1 0 MouseEvent]
+ [ER Mouseout {All HTMLElement, Text} 1 1 MouseEvent]
+ </TABLE>
+
+ <H3>HTML Forms Related Events</H3>
+ <TABLE border=1>
+ <TR><TH>Event<TH>Target<TH>Bubbles<TH>Cancellable<TH>Event Object Type
+ [ER Focus {Form controls that take the focus} 0 0 Event]
+ [ER Blur {Form controls that take the focus} 0 0 Event]
+ [ER Submit {FORM elements} 1 0 Event]
+ [ER Reset {FORM elements} 1 0 Event]
+ [ER Select {Form controls that generate text fields} 1 0 Event]
+ [ER Change {Form controls with state} 1 0 Event]
+ </TABLE>
+
+ <H3>Keyboard Events</H3>
+ <TABLE border=1>
+ <TR><TH>Event<TH>Target<TH>Bubbles<TH>Cancellable<TH>Event Object Type
+ [ER Keypress {} {} {} {}]
+ [ER Keydown {} {} {} {}]
+ [ER Keyup {} {} {} {}]
+ </TABLE>
+
+ </HTML>
+ }}]
+ }
+
+
+ ::hv3::dom2::stateless Event {
+
+ -- Constant value 1.
+ dom_get CAPTURING_PHASE {}
+ -- Constant value 2.
+ dom_get AT_TARGET {}
+ -- Constant value 3.
+ dom_get BUBBLING_PHASE {}
+
+ -- A string containing the type of the event. For example
+ -- <code>"click"</code> or <code>"load"</code>.
+ dom_get type {}
+
+ -- Boolean value. Set to true if the event bubbles. See
+ -- [Ref eventoverview {the event overview}] for a table describing
+ -- which events bubble and which do not.
+ dom_get bubbles {}
+
+ -- Boolean value. Set to true if the event is cancelable. See
+ -- [Ref eventoverview {the event overview}] for a table describing
+ -- which events are cancelable and which are not.
+ dom_get cancelable {}
+
+ -- This property is supposed to return a timestamp in milliseconds
+ -- from the epoch. But the DOM spec notes that this information is not
+ -- available on all systems, in which case the property should return 0.
+ -- Hv3 always returns 0.
+ dom_get timestamp {}
+
+ dom_call_todo initEvent
+ }
+
+ ::hv3::dom2::stateless UIEvent {
+ Inherit Event {}
+ dom_get view {}
+ dom_get detail {}
+ dom_call_todo initUIEvent
+ }
+ ::hv3::dom2::stateless MouseEvent {
+ Inherit UIEvent { }
+
+ dom_call_todo initMouseEvent
+
+ -- This attribute is populated for events of type 'mouseup', 'mousedown',
+ -- 'click' and 'dblclick' to indicate which mouse button the event
+ -- is related to. For mice configured for right-hand use, buttons are
+ -- numbered from right to left, starting with zero (left-click sets
+ -- this attribute to zero).
+ dom_get button {}
+
+ -- X coordinate where the event occurred relative to the top left
+ -- corner of the viewport.
+ dom_get clientX {}
+
+ -- Y coordinate where the event occurred relative to the top left
+ -- corner of the viewport.
+ dom_get clientY {}
+
+ -- X coordinate where the event occurred relative to the screen
+ -- coordinate system.
+ dom_get screenX {}
+
+ -- Y coordinate where the event occurred relative to the screen
+ -- coordinate system.
+ dom_get screenY {}
+
+ -- Boolean attribute. True if the 'ctrl' key was pressed when the
+ -- event was fired.
+ dom_get ctrlKey {}
+
+ -- Boolean attribute. True if the 'shift' key was pressed when the
+ -- event was fired.
+ dom_get shiftKey {}
+
+ -- Boolean attribute. True if the 'alt' key was pressed when the
+ -- event was fired.
+ dom_get altKey {}
+
+ -- Boolean attribute. True if the 'meta' key was pressed when the
+ -- event was fired.
+ dom_get metaKey {}
+
+ -- This attribute is populated for 'mouseover' and 'mouseout' events
+ -- only. For a 'mouseover' event, this property is set to the document
+ -- node that the pointer is exiting, if any. For 'mouseout', it is set to
+ -- the document node that the pointer is exiting (if any).
+ dom_get relatedTarget {}
+
+ -- This property is for Gecko compatibility only. It is always equal
+ -- to the value of the <I>button</I> property plus one.
+ dom_get which { }
+ }
+
+ ::hv3::dom2::stateless MutationEvent {
+ Inherit Event { }
+
+ dom_call_todo initMutationEvent
+
+ -- Constant value 1.
+ dom_get MODIFICATION {}
+ -- Constant value 2.
+ dom_get ADDITION {}
+ -- Constant value 3.
+ dom_get REMOVAL {}
+
+ dom_todo relatedNode
+ dom_todo prevValue
+ dom_todo newValue
+ dom_todo attrName
+ dom_todo attrChange
+ }
+
+ namespace delete ::hv3::DOM::macros
+}
+# END OF DOCUMENTATION
+############################################################################
+
# The $HTML_Events_List variable contains a list of HTML events
# handled by this module. This is used at runtime by HTMLElement
# objects. This list comes from chapter 18 ("Scripts") of HTML 4.01.
@@ -96,91 +300,6 @@ foreach E $::hv3::dom::HTML_Events_List {
set ::hv3::DOM::HTMLElement_EventAttrArray(on${E}) 1
}
-::hv3::dom2::stateless Event {} {
-
- # Need a state-array to accomadate initEvent().
- #
- dom_parameter myStateArray
-
- # Constants for Event.eventPhase (Definition group PhaseType)
- #
- dom_get CAPTURING_PHASE { list number 1 }
- dom_get AT_TARGET { list number 2 }
- dom_get BUBBLING_PHASE { list number 3 }
-
- # Read-only attributes to access the values set by initEvent().
- #
- dom_get type { list string $state(myEventType) }
- dom_get bubbles { list boolean $state(myCanBubble) }
- dom_get cancelable { list boolean $state(myCancelable) }
-
- # TODO: Timestamp is supposed to return a timestamp in milliseconds
- # from the epoch. But the DOM spec notes that this information is not
- # available on all systems, in which case the property should return 0.
- #
- dom_get timestamp { list number 0 }
-
- dom_call_todo initEvent
-
- dom_finalize {
- # puts "Unsetting event state $myStateArray"
- array unset state
- }
-}
-namespace eval ::hv3::DOM {
- proc Event_initEvent {myStateArray eventType canBubble cancelable} {
- upvar #0 $myStateArray state
- set state(myEventType) $eventType
- set state(myCanBubble) $canBubble
- set state(myCancelable) $cancelable
- }
-}
-
-::hv3::dom2::stateless MouseEvent {UIEvent} {
- dom_call_todo initMouseEvent
-
- dom_get button { list number $state(-button) }
-
- dom_get clientX { list number $state(-x) }
- dom_get clientY { list number $state(-y) }
-
- dom_get screenX { list number $state(-screenx) }
- dom_get screenY { list number $state(-screeny) }
-
- dom_get ctrlKey { list boolean $state(-ctrlkey) }
- dom_get shiftKey { list boolean $state(-shiftkey) }
- dom_get altKey { list boolean $state(-altkey) }
- dom_get metaKey { list boolean $state(-metakey) }
-
- dom_get relatedTarget { list object $state(-relatedtarget) }
-
- # Mozilla extensions:
- #
- dom_get which { list number [expr {$state(-button) + 1}]}
-}
-
-::hv3::dom2::stateless UIEvent {Event} {
- dom_call_todo initUIEvent
-
- dom_todo view
- dom_todo detail
- dom_call_todo initUIEvent
-}
-
-::hv3::dom2::stateless MutationEvent {Event} {
- dom_call_todo initMutationEvent
-
- dom_get MODIFICATION { list number 1 }
- dom_get ADDITION { list number 2 }
- dom_get REMOVAL { list number 3 }
-
- dom_todo relatedNode
- dom_todo prevValue
- dom_todo newValue
- dom_todo attrName
- dom_todo attrChange
-}
-
#-------------------------------------------------------------------------
# DocumentEvent (DOM Level 2 Events)
#
@@ -189,7 +308,7 @@ namespace eval ::hv3::DOM {
#
# createEvent()
#
-::hv3::dom2::stateless DocumentEvent {} {
+set ::hv3::dom::code::DOCUMENTEVENT {
# The DocumentEvent.createEvent() method. The argument (specified as
# type DOMString in the spec) should be one of the following:
@@ -241,6 +360,9 @@ set ::hv3::dom::HtmlEventType(keyup) [list 1 0]
set ::hv3::dom::HtmlEventType(keydown) [list 1 0]
set ::hv3::dom::HtmlEventType(keypress) [list 1 0]
+set ::hv3::dom::HtmlEventType(focus) [list 0 0]
+set ::hv3::dom::HtmlEventType(blur) [list 0 0]
+
namespace eval ::hv3::dom {
# dispatchMouseEvent --
@@ -250,36 +372,45 @@ namespace eval ::hv3::dom {
# $EventTarget -> The DOM object implementing the EventTarget interface
# $x, $y -> Widget coordinates for the event
#
- proc ::hv3::dom::dispatchMouseEvent {dom type js_obj x y extra} {
-
+ proc dispatchMouseEvent {dom type js_obj x y extra} {
set isCancelable $::hv3::dom::MouseEventType($type)
-
- # Create and initialise the event object for this event.
- set arrayvar "::hv3::DOM::ea[incr ::hv3::dom::next_array]"
- upvar #0 $arrayvar eventstate
- ::hv3::DOM::Event_initEvent $arrayvar $type 1 $isCancelable
- set eventstate(-x) $x
- set eventstate(-y) $y
- set eventstate(-button) 0
- set eventstate(-ctrlkey) 0
- set eventstate(-shiftkey) 0
- set eventstate(-altkey) 0
- set eventstate(-metakey) 0
-
- set event [list ::hv3::DOM::MouseEvent $dom $arrayvar]
- Dispatch [$dom see] $js_obj $event
+
+ # Dispatch an event of type MouseEvent. The properties are broken into
+ # the following blocks:
+ #
+ # DOM Event
+ # DOM UIEvent
+ # DOM MouseEvent
+ # Gecko compatibility
+ #
+ Dispatch [$dom see] $js_obj [list \
+ CAPTURING_PHASE {number 1} \
+ AT_TARGET {number 2} \
+ BUBBLING_PHASE {number 3} \
+ type [list string $type] \
+ bubbles {boolean 1} \
+ cancelable [list boolean $isCancelable] \
+ timestamp {number 0} \
+\
+ view undefined \
+ detail undefined \
+\
+ altKey [list boolean 0] \
+ button [list number 0] \
+ clientX [list number $x] \
+ clientY [list number $y] \
+ ctrlKey [list boolean 0] \
+ metaKey [list boolean 0] \
+ relatedTarget undefined \
+ screenX undefined \
+ screenY undefined \
+ shiftKey [list boolean 0] \
+\
+ which [list number 1] \
+ ]
}
- # Dispatch --
- #
- proc Dispatch {see js_obj event_obj} {
- foreach {isHandled isPrevented} [$see dispatch $js_obj $event_obj] {}
- if {$isPrevented} {return "prevent"}
- if {$isHandled} {return "handled"}
- return ""
- }
-
# dispatchHtmlEvent --
#
# $dom -> the ::hv3::dom object.
@@ -292,17 +423,27 @@ namespace eval ::hv3::dom {
# submit
# change
#
- set ::hv3::dom::next_array 1
proc ::hv3::dom::dispatchHtmlEvent {dom type js_obj} {
- set properties $::hv3::dom::HtmlEventType($type)
-
- # Create and initialise the event object for this event.
- set arrayvar "::hv3::DOM::ea[incr ::hv3::dom::next_array]"
- eval ::hv3::DOM::Event_initEvent $arrayvar $type $properties
-
- # Dispatch!
- set event [list ::hv3::DOM::Event $dom $arrayvar]
- Dispatch [$dom see] $js_obj $event
+ foreach {bubbles isCancelable} $::hv3::dom::HtmlEventType($type) {}
+
+ Dispatch [$dom see] $js_obj [list \
+ CAPTURING_PHASE {number 1} \
+ AT_TARGET {number 2} \
+ BUBBLING_PHASE {number 3} \
+ type [list string $type] \
+ bubbles [list boolean $bubbles] \
+ cancelable [list boolean $isCancelable] \
+ timestamp {number 0} \
+ ]
+ }
+
+ # Dispatch --
+ #
+ proc Dispatch {see js_obj event_obj} {
+ foreach {isHandled isPrevented} [$see dispatch $js_obj $event_obj] {}
+ if {$isPrevented} {return "prevent"}
+ if {$isHandled} {return "handled"}
+ return ""
}
}
diff --git a/hv/hv3_dom_html.tcl b/hv/hv3_dom_html.tcl
index 3234c83..c029d33 100644
--- a/hv/hv3_dom_html.tcl
+++ b/hv/hv3_dom_html.tcl
@@ -1,4 +1,4 @@
-namespace eval hv3 { set {version($Id: hv3_dom_html.tcl,v 1.33 2007/09/19 18:43:42 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3_dom_html.tcl,v 1.48 2008/02/15 18:23:37 danielk1977 Exp $)} 1 }
#--------------------------------------------------------------------------
# DOM Level 1 Html
@@ -32,8 +32,13 @@ namespace eval hv3 { set {version($Id: hv3_dom_html.tcl,v 1.33 2007/09/19 18:43:
# HTMLDocument.body
# HTMLDocument.cookie
#
-set BaseList {Document DocumentEvent Node NodePrototype}
-::hv3::dom2::stateless HTMLDocument $BaseList {
+set BaseList {DocumentEvent}
+::hv3::dom2::stateless HTMLDocument {
+
+ %NODE%
+ %NODE_PROTOTYPE%
+ %DOCUMENT%
+ %DOCUMENTEVENT%
# The "title" attribute is supposed to be read/write. But this one
# is only read-only for the meantime.
@@ -105,7 +110,7 @@ set BaseList {Document DocumentEvent Node NodePrototype}
dom_call -string getElementById {THIS elementId} {
set elementId [string map [list "\x22" "\x5C\x22"] $elementId]
set selector [subst -nocommands {[id="$elementId"]}]
- set node [$myHv3 search $selector -index 0]
+ set node [$myHv3 html search $selector -index 0]
if {$node ne ""} {
return [list object [::hv3::dom::wrapWidgetNode $myDom $node]]
}
@@ -122,7 +127,9 @@ set BaseList {Document DocumentEvent Node NodePrototype}
dom_call -string getElementsByName {THIS elementName} {
set name [string map [list "\x22" "\x5C\x22"] $elementName]
set selector [subst -nocommands {[name="$name"]}]
- set nl [list ::hv3::DOM::NodeListS $myDom [$myHv3 html] "" $selector]
+ set nl [list ::hv3::DOM::NodeListS $myDom [
+ list [$myHv3 html] search $selector
+ ]]
list transient $nl
}
@@ -183,9 +190,6 @@ set BaseList {Document DocumentEvent Node NodePrototype}
#
dom_get * {
- # Allowable element types.
- set tags [list form img]
-
# Selectors to use to find document nodes.
set nameselector [subst -nocommands {
form[name="$property"],img[name="$property"]
@@ -195,7 +199,7 @@ set BaseList {Document DocumentEvent Node NodePrototype}
}]
foreach selector [list $nameselector $idselector] {
- set node [$myHv3 search $selector -index 0]
+ set node [$myHv3 html search $selector -index 0]
if {$node ne ""} {
return [list object [::hv3::dom::wrapWidgetNode $myDom $node]]
}
@@ -206,15 +210,24 @@ set BaseList {Document DocumentEvent Node NodePrototype}
}
namespace eval ::hv3::DOM {
proc HTMLDocument_Collection {dom hv3 selector} {
- set cmd [list $hv3 search $selector]
- list object [list ::hv3::DOM::HTMLCollectionS $dom [$hv3 html] $selector]
+ set cmd [list [$hv3 html] search $selector]
+ list object [list ::hv3::DOM::HTMLCollectionS $dom $cmd]
}
}
#-------------------------------------------------------------------------
# DOM Type HTMLElement (Node -> Element -> HTMLElement)
#
-::hv3::dom2::stateless HTMLElement Element {
+set HTMLElement {
+ %NODE_PROTOTYPE%
+ %NODE%
+ %WIDGET_NODE%
+ %ELEMENT%
+ %HTMLELEMENT%
+ %ELEMENTCSSINLINESTYLE%
+}
+set ::hv3::dom::code::HTMLELEMENT {
+
element_attr id
element_attr title
element_attr lang
@@ -360,11 +373,12 @@ namespace eval ::hv3::DOM {
}
return $R
}
- dom_scope {
- list [$myDom node_to_window $myNode]
- }
}
+::hv3::dom2::stateless HTMLElement $HTMLElement
+
+set HTMLElement "Inherit HTMLElement { $HTMLElement }"
+
namespace eval ::hv3::DOM {
# Return the scrollable width and height of the window $html.
@@ -451,7 +465,7 @@ namespace eval ::hv3::DOM {
### }
# Insert the new descendants, created by parsing $newHtml.
- set htmlwidget [[$dom node_to_hv3 $node] html]
+ set htmlwidget [$node html]
set children [$htmlwidget fragment $newHtml]
$node insert $children
return ""
@@ -461,7 +475,7 @@ namespace eval ::hv3::DOM {
#-------------------------------------------------------------------------
# DOM Type HTMLFormElement (extends HTMLElement)
#
-::hv3::dom2::stateless HTMLFormElement HTMLElement {
+::hv3::dom2::stateless HTMLFormElement $HTMLElement {
# Various Get/Put string property/attributes.
#
@@ -472,6 +486,13 @@ namespace eval ::hv3::DOM {
element_attr acceptCharset -attribute acceptcharset
element_attr enctype
+ dom_get ** {
+ set superset [subst -nocommands {
+ lrange [::hv3::get_form_nodes $myNode] 1 end
+ }]
+ HTMLCollectionC_getUnknownProperty $myDom $superset $property
+ }
+
# The HTMLFormElement.elements array.
#
dom_get elements {
@@ -493,10 +514,10 @@ namespace eval ::hv3::DOM {
# Unknown property handler. Delegate any unknown property requests to
# the HTMLFormElement.elements object.
#
- dom_get * {
- set obj [lindex [eval [SELF] Get elements] 1]
- eval $obj Get $property
- }
+ #dom_get * {
+ #set obj [lindex [eval HTMLFormElement $myDom $myNode Get elements] 1]
+ #eval $obj Get $property
+ #}
}
# </HTMLFormElement>
#-------------------------------------------------------------------------
@@ -507,7 +528,7 @@ namespace eval ::hv3::DOM {
# <INPUT> elements. The really complex stuff for this object is
# handled by the forms manager code.
#
-::hv3::dom2::stateless HTMLInputElement HTMLElement {
+::hv3::dom2::stateless HTMLInputElement $HTMLElement {
dom_todo defaultValue
dom_todo readOnly
@@ -600,7 +621,7 @@ namespace eval ::hv3::DOM {
#-------------------------------------------------------------------------
# DOM Type HTMLSelectElement (extends HTMLElement)
#
-::hv3::dom2::stateless HTMLSelectElement HTMLElement {
+::hv3::dom2::stateless HTMLSelectElement $HTMLElement {
dom_get form { HTMLElement_get_form $myDom $myNode }
@@ -635,8 +656,7 @@ namespace eval ::hv3::DOM {
}
dom_get options {
- set cmd [list HTMLSelectElement_getOptions $myNode]
- list object [list ::hv3::DOM::HTMLCollectionC $myDom $cmd]
+ list object [list ::hv3::DOM::HTMLOptionsCollection $myDom $myNode]
}
dom_get multiple {
@@ -685,7 +705,7 @@ namespace eval ::hv3::DOM {
# Non-standard stuff starts here.
#
dom_get * {
- set obj [lindex [eval [SELF] Get options] 1]
+ set obj [lindex [HTMLSelectElement $myDom $myNode Get options] 1]
eval $obj Get $property
}
@@ -709,8 +729,9 @@ namespace eval ::hv3::DOM {
}
}
proc HTMLElement_control_scope {dom node} {
- set w [$dom node_to_window $node]
- set scope [list [::hv3::dom::wrapWidgetNode $dom $node] $w [$dom node_to_document $node]]
+ set scope [list \
+ [::hv3::dom::wrapWidgetNode $dom $node] [node_to_document $node]
+ ]
set f [lindex [::hv3::get_form_nodes $node] 0]
if {$f ne ""} {
@@ -728,7 +749,7 @@ namespace eval ::hv3::DOM {
#
# http://api.kde.org/cvs-api/kdelibs-apidocs/khtml/html/classDOM_1_1HTMLTextAreaElement.html
#
-::hv3::dom2::stateless HTMLTextAreaElement HTMLElement {
+::hv3::dom2::stateless HTMLTextAreaElement $HTMLElement {
dom_todo defaultValue;
dom_todo cols;
@@ -817,7 +838,8 @@ namespace eval ::hv3::DOM {
#-------------------------------------------------------------------------
# DOM Type HTMLButtonElement (extends HTMLElement)
#
-::hv3::dom2::stateless HTMLButtonElement HTMLElement {
+::hv3::dom2::stateless HTMLButtonElement $HTMLElement {
+
dom_todo disabled;
dom_get form { HTMLElement_get_form $myDom $myNode }
@@ -837,7 +859,7 @@ namespace eval ::hv3::DOM {
#-------------------------------------------------------------------------
# DOM Type HTMLOptGroupElement (extends HTMLElement)
#
-::hv3::dom2::stateless HTMLOptGroupElement HTMLElement {
+::hv3::dom2::stateless HTMLOptGroupElement $HTMLElement {
}
# </HTMLOptGroupElement>
#-------------------------------------------------------------------------
@@ -845,7 +867,7 @@ namespace eval ::hv3::DOM {
#-------------------------------------------------------------------------
# DOM Type HTMLOptionElement (extends HTMLElement)
#
-::hv3::dom2::stateless HTMLOptionElement HTMLElement {
+::hv3::dom2::stateless HTMLOptionElement $HTMLElement {
dom_todo defaultSelected
dom_todo index
@@ -878,7 +900,24 @@ namespace eval ::hv3::DOM {
$myNode attr label $v
}
- dom_todo selected
+ dom_get selected {
+ set select [HTMLOptionElement_getSelect $myNode]
+ set idx [lsearch [HTMLSelectElement_getOptions $select] $myNode]
+ if {$idx == [[$select replace] dom_selectionIndex]} {
+ list boolean true
+ } else {
+ list boolean false
+ }
+ }
+ dom_put -string selected v {
+ set select [HTMLOptionElement_getSelect $myNode]
+ set idx [lsearch [HTMLSelectElement_getOptions $select] $myNode]
+ if {$v} {
+ [$select replace] dom_setSelectionIndex $idx
+ } else {
+ [$select replace] dom_setSelectionIndex -1
+ }
+ }
dom_get value {
list string [HTMLOptionElement_getLabelOrValue $myNode value]
@@ -934,7 +973,7 @@ namespace eval ::hv3::DOM {
#-------------------------------------------------------------------------
# DOM Type HTMLLabelElement (extends HTMLElement)
#
-::hv3::dom2::stateless HTMLLabelElement HTMLElement {
+::hv3::dom2::stateless HTMLLabelElement $HTMLElement {
}
# </HTMLLabelElement>
#-------------------------------------------------------------------------
@@ -942,7 +981,7 @@ namespace eval ::hv3::DOM {
#-------------------------------------------------------------------------
# DOM Type HTMLFieldSetElement (extends HTMLElement)
#
-::hv3::dom2::stateless HTMLFieldSetElement HTMLElement {
+::hv3::dom2::stateless HTMLFieldSetElement $HTMLElement {
}
# </HTMLFieldSetElement>
#-------------------------------------------------------------------------
@@ -950,7 +989,7 @@ namespace eval ::hv3::DOM {
#-------------------------------------------------------------------------
# DOM Type HTMLLegendElement (extends HTMLElement)
#
-::hv3::dom2::stateless HTMLLegendElement HTMLElement {
+::hv3::dom2::stateless HTMLLegendElement $HTMLElement {
}
# </HTMLLegendElement>
#-------------------------------------------------------------------------
@@ -958,7 +997,8 @@ namespace eval ::hv3::DOM {
#-------------------------------------------------------------------------
# DOM Type HTMLTableElement (extends HTMLElement)
#
-::hv3::dom2::stateless HTMLTableElement HTMLElement {
+::hv3::dom2::stateless HTMLTableElement $HTMLElement {
+
dom_todo caption
dom_todo tHead
dom_todo tFoot
@@ -1005,7 +1045,7 @@ namespace eval ::hv3::DOM {
#
# This DOM type is used for HTML elements <TFOOT>, <THEAD> and <TBODY>.
#
-::hv3::dom2::stateless HTMLTableSectionElement HTMLElement {
+::hv3::dom2::stateless HTMLTableSectionElement $HTMLElement {
element_attr align
element_attr ch -attribute char
@@ -1038,7 +1078,7 @@ namespace eval ::hv3::DOM {
#
# This DOM type is used for HTML <TR> elements.
#
-::hv3::dom2::stateless HTMLTableRowElement HTMLElement {
+::hv3::dom2::stateless HTMLTableRowElement $HTMLElement {
dom_todo rowIndex
dom_todo sectionRowIndex
@@ -1075,7 +1115,8 @@ namespace eval ::hv3::DOM {
#
# This DOM type is used for HTML <A> elements.
#
-::hv3::dom2::stateless HTMLAnchorElement HTMLElement {
+::hv3::dom2::stateless HTMLAnchorElement $HTMLElement {
+
element_attr accessKey -attribute accesskey
element_attr charset
element_attr coords
@@ -1098,7 +1139,8 @@ namespace eval ::hv3::DOM {
# </HTMLAnchorElement>
#-------------------------------------------------------------------------
-::hv3::dom2::stateless HTMLImageElement HTMLElement {
+::hv3::dom2::stateless HTMLImageElement $HTMLElement {
+
element_attr lowSrc -attribute lowsrc
element_attr name
element_attr align
@@ -1108,7 +1150,7 @@ namespace eval ::hv3::DOM {
element_attr hspace
dom_get isMap { list boolean [::hv3::boolean_attr $myNode ismap false] }
- dom_put -string isMap val { ::hv3::put_boolean_attr $myNode ismap $val] }
+ dom_put -string isMap val { ::hv3::put_boolean_attr $myNode ismap $val }
element_attr longDesc -attribute longdesc;
element_attr src;
@@ -1117,7 +1159,8 @@ namespace eval ::hv3::DOM {
element_attr width;
};
-::hv3::dom2::stateless HTMLIFrameElement HTMLElement {
+::hv3::dom2::stateless HTMLIFrameElement $HTMLElement {
+
element_attr align
element_attr frameBorder -attribute frameborder
element_attr height
@@ -1130,43 +1173,55 @@ namespace eval ::hv3::DOM {
element_attr width
}
-::hv3::dom2::stateless HTMLUListElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLOListElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLDListElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLDirectoryElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLMenuElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLLIElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLDivElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLParagraphElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLHeadingElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLQuoteElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLPreElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLBRElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLBaseFontElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLFontElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLHRElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLModElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLObjectElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLParamElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLAppletElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLMapElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLAreaElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLScriptElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLFrameSetElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLFrameElement HTMLElement { #TODO }
-
-::hv3::dom2::stateless HTMLTableCaptionElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLTableColElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLTableCellElement HTMLElement { #TODO }
-
-::hv3::dom2::stateless HTMLHtmlElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLHeadElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLLinkElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLTitleElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLMetaElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLBaseElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLStyleElement HTMLElement { #TODO }
-::hv3::dom2::stateless HTMLBodyElement HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLUListElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLOListElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLDListElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLDirectoryElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLMenuElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLLIElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLDivElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLParagraphElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLHeadingElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLQuoteElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLPreElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLBRElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLBaseFontElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLFontElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLHRElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLModElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLObjectElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLParamElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLAppletElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLMapElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLAreaElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLScriptElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLFrameSetElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLFrameElement $HTMLElement { #TODO }
+
+::hv3::dom2::stateless HTMLTableCaptionElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLTableColElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLTableCellElement $HTMLElement { #TODO }
+
+::hv3::dom2::stateless HTMLHtmlElement $HTMLElement {
+ Inherit HTMLElement {
+ dom_get parentNode {
+ if {$myNode eq [[$myNode html] node]} {
+ # TODO: Maybe this is not quite cacheable... But caching it saves
+ # calling this code for every single event propagation....
+ list cache object [node_to_document $myNode]
+ } else {
+ list null
+ }
+ }
+ }
+}
+::hv3::dom2::stateless HTMLHeadElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLLinkElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLTitleElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLMetaElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLBaseElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLStyleElement $HTMLElement { #TODO }
+::hv3::dom2::stateless HTMLBodyElement $HTMLElement { #TODO }
#-------------------------------------------------------------------------
# Element/Text Node Factory:
@@ -1267,28 +1322,14 @@ namespace eval ::hv3::dom {
frame ::hv3::DOM::HTMLFrameElement
}
- proc getHTMLElementClassList {} {
- ::variable TagToNodeTypeMap
- set ret [list]
- foreach e [array names TagToNodeTypeMap] {
- lappend ret [string range $TagToNodeTypeMap($e) 12 end]
- }
- set ret
- }
-
# Create a DOM HTMLElement or Text object in DOM $dom (type ::hv3::dom)
# wrapped around the html-widget $node.
#
proc wrapWidgetNode {dom node} {
::variable TagToNodeTypeMap
-
set tag [$node tag]
-
set objtype ::hv3::DOM::HTMLElement
- catch {
- set objtype $TagToNodeTypeMap($tag)
- }
-
+ catch { set objtype $TagToNodeTypeMap($tag) }
list $objtype $dom $node
}
}
diff --git a/hv/hv3_dom_ns.tcl b/hv/hv3_dom_ns.tcl
index 93d88cb..96a7c3c 100644
--- a/hv/hv3_dom_ns.tcl
+++ b/hv/hv3_dom_ns.tcl
@@ -1,4 +1,4 @@
-namespace eval hv3 { set {version($Id: hv3_dom_ns.tcl,v 1.26 2007/09/19 18:43:42 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3_dom_ns.tcl,v 1.42 2008/02/15 18:23:37 danielk1977 Exp $)} 1 }
#---------------------------------
# List of DOM objects in this file:
@@ -9,19 +9,10 @@ namespace eval hv3 { set {version($Id: hv3_dom_ns.tcl,v 1.26 2007/09/19 18:43:42
# History
# Screen
#
-namespace eval ::hv3::dom {
- proc getNSClassList {} {
- list Navigator Location Window History Screen
- }
-}
#-------------------------------------------------------------------------
# "Navigator" DOM object.
#
-# Similar to the Gecko object documented here (some properties are missing):
-#
-# http://developer.mozilla.org/en/docs/DOM:window.navigator
-#
# Navigator.appCodeName
# Navigator.appName
# Navigator.appVersion
@@ -39,60 +30,79 @@ namespace eval ::hv3::dom {
#
# Navigator.javaEnabled()
#
-::hv3::dom2::stateless Navigator {} {
+::hv3::dom2::stateless Navigator {
+ -- Based on the Gecko object documented here (some properties are missing):
+ --
+ -- <P class=refs>
+ -- [Ref http://developer.mozilla.org/en/docs/DOM:window.navigator]
+ XX
- # Fairly obviously, this is an Hv3 specific property.
- dom_get hv3_version { list string [::hv3::hv3_version] }
+ dom_parameter dummy
- dom_get appCodeName { list string "Mozilla" }
- dom_get appName { list string "Netscape" }
- dom_get appVersion { list string "4.0 (Hv3)" }
+ -- Fairly obviously, this is an Hv3 specific property.
+ dom_get hv3_version { list string [::hv3::hv3_version] }
- dom_get product { list string "Hv3" }
- dom_get productSub { list string "alpha" }
- dom_get vendor { list string "tkhtml.tcl.tk" }
- dom_get vendorSub { list string "alpha" }
+ foreach {property string} {
+ appCodeName "Mozilla"
+ appName "Netscape"
+ appVersion "4.0 (Hv3)"
+ product "Hv3"
+ productSub "alpha"
+ vendor "tkhtml.tcl.tk"
+ vendorSub "alpha"
+ language "en-US"
+ securityPolicy ""
+ } {
+ -- The constant string <code>"${string}"</code>
+ dom_get $property [list list string $string]
+ }
+ -- Boolean value indicating whether or not cookies are enabled. In Hv3
+ -- this is always true.
dom_get cookieEnabled { list boolean 1 }
- dom_get language { list string en-US }
+
+ -- Boolean value indicating whether or not the browser is in {"online"}
+ -- mode. In Hv3 this is always true.
dom_get onLine { list boolean 1 }
- dom_get securityPolicy { list string "" }
+ -- Return the user-agent string sent with HTTP requests. Hv3 normally
+ -- sends a lying user-agent string that claims Hv3 uses Gecko.
dom_get userAgent {
# Use the user-agent that the http package is currently configured
# with so that HTTP requests match the value returned by this property.
list string [::http::config -useragent]
}
+ -- Return something like {"Linux i686".}
dom_get platform {
- # This will return something like "Linux i686".
list string "$::tcl_platform(os) $::tcl_platform(machine)"
}
- dom_get oscpu { eval [SELF] Get platform }
- # No. Absolutely not. Never going to happen.
+ -- Alias for the <I>platform</I> property.
+ dom_get oscpu {
+ list string "$::tcl_platform(os) $::tcl_platform(machine)"
+ }
+
+ -- Return true if java is enabled, false otherwise. Under Hv3 this is
+ -- always false (and always will be).
dom_call javaEnabled {THIS} { list boolean false }
- # I don't even know what this does. All I know is that if this method
- # is not implemented wikipedia thinks we are KHTML and serves up a
- # special stylesheet. The following page from wikipedia has some
- # good information on why that is a bad thing to do:
- #
- # http://en.wikipedia.org/wiki/Browser_sniffing
- #
- # On the other hand, if I don't know what "taint" is, it's probably
- # not enabled. Ok. All is forgiven wikipedia, we can be friends again.
- #
+ -- I don't even know what this does. All I knows is that if this method
+ -- is not implemented wikipedia thinks we are KHTML and serves up a
+ -- special stylesheet. The following page from wikipedia has some
+ -- good information on why that is a bad thing to do:
+ --
+ -- <P class=refs>
+ -- [Ref http://en.wikipedia.org/wiki/Browser_sniffing]
+ --
+ -- On the other hand, if I don't know what "taint" is, it's probably
+ -- not enabled. No problem.
dom_call taintEnabled {THIS} { list boolean false }
}
#-------------------------------------------------------------------------
# DOM class Location
#
-# This is not based on any standard, but on the Gecko class of
-# the same name. Primary use is as the HTMLDocument.location
-# and Window.location properties.
-#
# hash
# host
# hostname
@@ -109,40 +119,72 @@ namespace eval ::hv3::dom {
# http://developer.mozilla.org/en/docs/DOM:window.location
#
#
-::hv3::dom2::stateless Location {} {
+::hv3::dom2::stateless Location {
+ -- One location object is allocated for each [Ref Window] object in the
+ -- system. It contains the URI of the current document. Writing to
+ -- this object causes the window to load the new URI. The location
+ -- object is available via either of the following two global
+ -- references:
+ --
+ -- <PRE>
+ -- window.location
+ -- window.document.location
+ -- </PRE>
+ --
+ -- This is not based on any standard, but on the Gecko class of
+ -- the same name:
+ --
+ -- <P class=refs>
+ -- [Ref http://developer.mozilla.org/en/docs/DOM:window.location]
+ -- [Ref http://developer.mozilla.org/en/docs/DOM:document.location]
+ XX
dom_parameter myHv3
-
- dom_default_value {
- list string [$myHv3 location]
- }
+ dom_default_value { list string [$myHv3 uri get] }
#---------------------------------------------------------------------
# Properties:
#
# Todo: Writing to properties is not yet implemented.
#
+
+ -- The authority part of the URI, not including any
+ -- {<code>:<port-number></code>} section.
dom_get hostname {
set auth [$myHv3 uri authority]
set hostname ""
- regexp {^([^:]*)} -> hostname
+ regexp {^([^:]*)} $auth -> hostname
list string $hostname
}
+
+ -- The port-number specified as part of the URI authority, or an empty
+ -- string if no port-number was specified.
dom_get port {
set auth [$myHv3 uri authority]
set port ""
regexp {:(.*)$} -> port
list string $port
}
+
+ -- The URI authority.
dom_get host { list string [$myHv3 uri authority] }
+
+ -- The URI path.
dom_get pathname { list string [$myHv3 uri path] }
+
+ -- The URI scheme, including the colon following the scheme name. For
+ -- example, <code>"http:"</code> or <code>"https:"</code>.
dom_get protocol { list string [$myHv3 uri scheme]: }
+
+ -- The URI query, including the '?' character.
dom_get search {
set query [$myHv3 uri query]
set str ""
if {$query ne ""} {set str "?$query"}
list string $str
}
+
+ -- The URI fragment, including the '#' character.
dom_get hash {
set fragment [$myHv3 uri fragment]
set str ""
@@ -150,9 +192,8 @@ namespace eval ::hv3::dom {
list string $str
}
- dom_get href {
- list string [$myHv3 uri get]
- }
+ -- The entire URI as a string.
+ dom_get href { list string [$myHv3 uri get] }
dom_put -string href value {
Location_assign $myHv3 $value
}
@@ -160,19 +201,35 @@ namespace eval ::hv3::dom {
#---------------------------------------------------------------------
# Methods:
#
+
+ -- Set the location to the supplied URI. The window loads the document
+ -- at the specified URI.
dom_call -string assign {THIS uri} { Location_assign $myHv3 $uri }
+
+ -- Set the location to the supplied URI. The window loads the document
+ -- at the specified URI. The difference between this method and the
+ -- assign() method is that this method does not add a new entry to
+ -- the browser Back/Forward list - it replaces the current one.
dom_call -string replace {THIS uri} { $myHv3 goto $uri -nosave }
- dom_call -string reload {THIS force} {
+
+ -- Refresh the current URI. If the boolean <I>force</I> argument is true,
+ -- reload the document from the server, bypassing any caches. If <I>force</I>
+ -- is false, normal HTTP caching rules apply.
+ --
+ -- Note: In Hv3, this function always behaves as if <I>force</I> is true.
+ -- Documents are always reloaded from the origin server.
+ dom_call -string reload {THIS {force 0}} {
if {![string is boolean $force]} { error "Bad boolean arg: $force" }
- set cc normal
- if {$force} { set cc no-cache }
- $myHv3 goto [$myHv3 location] -nosave
+ $myHv3 goto [$myHv3 location] -nosave -cachecontrol no-cache
+ return ""
}
- dom_call toString {THIS} { eval [SELF] DefaultValue }
+
+ -- Returns the same value as reading the <I>href</I> property.
+ dom_call toString {THIS} { ::hv3::DOM::Location $myDom $myHv3 DefaultValue }
}
namespace eval ::hv3::DOM {
proc Location_assign {hv3 loc} {
- set f [winfo parent $hv3]
+ set f [$hv3 cget -frame]
# TODO: When assigning a URI from javascript, resolve it relative
# to the top-level document... This has got to be wrong... Maybe
@@ -189,19 +246,17 @@ namespace eval ::hv3::DOM {
#-------------------------------------------------------------------------
# "Window" DOM object.
#
-::hv3::dom2::stateless Window {} {
+::hv3::dom2::stateless Window {
dom_parameter myHv3
- dom_call_todo scrollBy
+ -- TODO. Right now this is a no-op.
+ dom_call -string scrollBy {args} { }
- #-----------------------------------------------------------------------
- # Property implementations:
- #
- # Window.document
- #
+ -- A reference to the [Ref HTMLDocument] object currently associated
+ -- with this window.
dom_get document {
- list object [list ::hv3::DOM::HTMLDocument $myDom $myHv3]
+ list cache object [list ::hv3::DOM::HTMLDocument $myDom $myHv3]
}
# The "Image" property object. This is so that scripts can
@@ -218,7 +273,7 @@ namespace eval ::hv3::DOM {
if {[llength $args] > 1} {
set h " height=[lindex $args 0 1]"
}
- set node [$myHv3 fragment "<img${w}${h}>"]
+ set node [$myHv3 html fragment "<img${w}${h}>"]
list object [::hv3::dom::wrapWidgetNode $myDom $node]
}
@@ -232,63 +287,71 @@ namespace eval ::hv3::DOM {
::hv3::dom::newXMLHttpRequest $myDom $myHv3
}
+ -- A reference to the [Ref NodePrototype] object.
dom_get Node {
- set obj [list ::hv3::DOM::Node $myDom]
+ set obj [list ::hv3::DOM::NodePrototype $myDom dummy]
list object $obj
}
- -- An alias for the document.location property (see [Ref HTMLDocument]).
+ -- Return the [Ref Location] object associated with this window. This
+ -- property can be set to the string representation of a URI, causing
+ -- the browser to load the document at the location specified. i.e.
--
+ -- <PRE>
+ -- window.location = {"http://tkhtml.tcl.tk/hv3.html"}
+ -- </PRE>
dom_get location {
- set document [lindex [eval [SELF] Get document] 1]
- eval $document Get location
+ list object [list ::hv3::DOM::Location $myDom $myHv3]
}
- dom_put location {value} {
- set document [lindex [eval [SELF] Get document] 1]
- eval $document Put location [list $value]
+ dom_put -string location {value} {
+ Location_assign $myHv3 $value
}
-- A reference to the [Ref Navigator] object.
- --
dom_get navigator {
- list cache transient [list ::hv3::DOM::Navigator $myDom]
+ list object [list ::hv3::DOM::Navigator $myDom dummy]
}
- #-----------------------------------------------------------------------
- # The "history" object.
- #
+ -- A reference to the [Ref History] object.
dom_get history {
list object [list ::hv3::DOM::History $myDom $myHv3]
}
- #-----------------------------------------------------------------------
- # The "screen" object.
- #
+ -- A reference to the [Ref Screen] object.
dom_get screen {
list object [list ::hv3::DOM::Screen $myDom $myHv3]
}
- -- Returns a reference to the parent of the current window or subframe.
- -- If the window does not have a parent, then a reference to the window
+ -- A reference to the parent of the current window or subframe. If the
+ -- window does not have a parent, then a reference to the window
-- itself is returned.
- --
dom_get parent {
- set frame [winfo parent $myHv3]
+ set frame [$myHv3 cget -frame]
set parent [$frame parent_frame]
if {$parent eq ""} {set parent $frame}
- list object [$myDom hv3_to_window [$parent hv3]]
+ set see [[$parent hv3 dom] see]
+ list bridge $see
}
+ -- A reference to the outermost window in the frameset. For ordinary
+ -- HTML documents (not framesets) this property is set to a reference
+ -- to this object (same as the <I>window</I> and <I>self</I> properties).
dom_get top {
- set frame [winfo parent $myHv3]
- set top [$frame top_frame]
- list object [$myDom hv3_to_window [$top hv3]]
+ set topframe [[$myHv3 cget -frame] top_frame]
+ set see [[$topframe hv3 dom] see]
+ list bridge $see
}
- dom_get self { return [list object [SELF]] }
- dom_get window { return [list object [SELF]] }
+ -- A reference to this object.
+ dom_get self { list object [list ::hv3::DOM::Window $myDom $myHv3] }
+
+ -- A reference to this object.
+ dom_get window { list object [list ::hv3::DOM::Window $myDom $myHv3] }
+
+ -- Set to a container of type [Ref FramesList] containing the sub-frames
+ -- of this window.
dom_get frames {
- list object [list ::hv3::DOM::FramesList $myDom [winfo parent $myHv3]]
+ list object [list ::hv3::DOM::FramesList $myDom [$myHv3 cget -frame]]
}
-- Pop up a modal dialog box with a single button - \"OK\". The <i>msg</i>
@@ -296,7 +359,6 @@ namespace eval ::hv3::DOM {
-- until the user dismisses the dialog.
--
-- Returns null.
- --
dom_call -string alert {THIS msg} {
tk_dialog .alert "Super Dialog Alert!" $msg "" 0 OK
return ""
@@ -309,7 +371,6 @@ namespace eval ::hv3::DOM {
--
-- If the user chooses the \"OK\" button, true is returned. If the
-- user chooses \"Cancel\", false is returned.
- --
dom_call -string confirm {THIS msg} {
set i [tk_dialog .alert "Super Dialog Alert!" $msg "" 0 OK Cancel]
list boolean [expr {$i ? 0 : 1}]
@@ -319,22 +380,42 @@ namespace eval ::hv3::DOM {
-- available for displaying HTML documents), including the horizontal
-- scrollbar if one is displayed.
--
- -- http://developer.mozilla.org/en/docs/DOM:window.innerWidth
- -- http://tkhtml.tcl.tk/cvstrac/tktview?tn=175
- -- http://www.howtocreate.co.uk/tutorials/javascript/browserwindow
- --
- dom_get innerHeight { list number [winfo height $myHv3] }
+ -- <P class=refs>
+ -- [Ref http://developer.mozilla.org/en/docs/DOM:window.innerHeight]
+ -- [Ref http://tkhtml.tcl.tk/cvstrac/tktview?tn=175]
+ -- [Ref http://www.howtocreate.co.uk/tutorials/javascript/browserwindow]
+ dom_get innerHeight { list number [winfo height [$myHv3 win]] }
-- The current width of the browser window in pixels (the area
-- available for displaying HTML documents), including the vertical
-- scrollbar if one is displayed.
--
- -- http://developer.mozilla.org/en/docs/DOM:window.innerHeight
- --
- dom_get innerWidth { list number [winfo width $myHv3] }
+ -- <P class=refs>
+ -- [Ref http://developer.mozilla.org/en/docs/DOM:window.innerWidth]
+ dom_get innerWidth { list number [winfo width [$myHv3 win]] }
dom_events { list }
+ -- Shift keyboard focus to this window. This is mainly useful in frameset
+ -- documents.
+ dom_call focus {THIS} {
+ focus [$myHv3 win]
+ }
+
+ -- This function is only available if the -unsafe option on the
+ -- {[::hv3::browser]} widget is set to true. This is <b>not</b> the
+ -- case in the Hv3 web browser, but may be in other applications.
+ -- The string passed as an argument is evaluated as a Tcl script
+ -- in the widget's interpreter.
+ dom_call -string tcl {THIS script} {
+ set browser [$myDom browser]
+ if {[$browser cget -unsafe]} {
+ uplevel #0 $script
+ } else {
+ error "This browser is not -unsafe. window.tcl() is disabled"
+ }
+ }
+
# Pass any request for an unknown property to the FramesList object.
#
# TODO: I don't know about this. It seems to be required for JsUnit,
@@ -355,32 +436,17 @@ if 0 {
puts $args
}
}
-
- # Access the very special hv3_bookmarks. We hard-code some security
- # here: The hv3_bookmarks object is only available if the toplevel
- # frame is from the home:// namespace.
- #
- dom_get hv3_bookmarks {
- set frame [winfo parent $myHv3]
- set top [$frame top_frame]
- if {[string first home: [[$frame hv3] uri get]] == 0} {
- set o [list ::hv3::DOM::Bookmarks $myDom ::hv3::the_bookmark_manager]
- list object $o
- } else {
- list
- }
- }
}
-#-------------------------------------------------------------------------
-# "History" DOM object.
-#
-# http://developer.mozilla.org/en/docs/DOM:window.history
-# http://www.w3schools.com/htmldom/dom_obj_history.asp
-#
-# Right now this is a placeholder. It does not work.
-#
-::hv3::dom2::stateless History {} {
+::hv3::dom2::stateless History {
+ -- Right now this is a placeholder. It does not work. Eventually, it
+ -- will be based on the objects described in these references:
+ --
+ -- <P class=refs>
+ -- [Ref http://developer.mozilla.org/en/docs/DOM:window.history]
+ -- [Ref http://www.w3schools.com/htmldom/dom_obj_history.asp]
+ XX
+
dom_parameter myHv3
dom_get length { list number 0 }
@@ -395,16 +461,16 @@ if 0 {
# http://developer.mozilla.org/en/docs/DOM:window.screen
#
#
-::hv3::dom2::stateless Screen {} {
+::hv3::dom2::stateless Screen {
dom_parameter myHv3
- dom_get colorDepth { list number [winfo screendepth $myHv3] }
- dom_get pixelDepth { list number [winfo screendepth $myHv3] }
+ dom_get colorDepth { list number [winfo screendepth [$myHv3 win]] }
+ dom_get pixelDepth { list number [winfo screendepth [$myHv3 win]] }
- dom_get width { list number [winfo screenwidth $myHv3] }
- dom_get height { list number [winfo screenheight $myHv3] }
- dom_get availWidth { list number [winfo screenwidth $myHv3] }
- dom_get availHeight { list number [winfo screenheight $myHv3] }
+ dom_get width { list number [winfo screenwidth [$myHv3 win]] }
+ dom_get height { list number [winfo screenheight [$myHv3 win]] }
+ dom_get availWidth { list number [winfo screenwidth [$myHv3 win]] }
+ dom_get availHeight { list number [winfo screenheight [$myHv3 win]] }
dom_get availTop { list number 0}
dom_get availLeft { list number 0}
diff --git a/hv/hv3_dom_style.tcl b/hv/hv3_dom_style.tcl
index 0bf17ef..ba8f991 100644
--- a/hv/hv3_dom_style.tcl
+++ b/hv/hv3_dom_style.tcl
@@ -1,4 +1,4 @@
-namespace eval hv3 { set {version($Id: hv3_dom_style.tcl,v 1.13 2007/08/04 17:15:25 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3_dom_style.tcl,v 1.15 2007/10/17 17:45:07 danielk1977 Exp $)} 1 }
#-------------------------------------------------------------------------
# DOM Level 2 Style.
@@ -14,7 +14,37 @@ namespace eval hv3 { set {version($Id: hv3_dom_style.tcl,v 1.13 2007/08/04 17:15
#
#
-::hv3::dom2::stateless ElementCSSInlineStyle {} {
+# Set up an array of known "simple" properties. This is used during
+# DOM compilation and at runtime.
+#
+set ::hv3::DOM::CSS2Properties_simple(width) width
+set ::hv3::DOM::CSS2Properties_simple(height) height
+set ::hv3::DOM::CSS2Properties_simple(display) display
+set ::hv3::DOM::CSS2Properties_simple(position) position
+set ::hv3::DOM::CSS2Properties_simple(top) top
+set ::hv3::DOM::CSS2Properties_simple(left) left
+set ::hv3::DOM::CSS2Properties_simple(bottom) bottom
+set ::hv3::DOM::CSS2Properties_simple(right) right
+set ::hv3::DOM::CSS2Properties_simple(z-index) zIndex
+set ::hv3::DOM::CSS2Properties_simple(cursor) cursor
+set ::hv3::DOM::CSS2Properties_simple(float) cssFloat
+set ::hv3::DOM::CSS2Properties_simple(font-size) fontSize
+set ::hv3::DOM::CSS2Properties_simple(clear) clear
+set ::hv3::DOM::CSS2Properties_simple(border-top-width) borderTopWidth
+set ::hv3::DOM::CSS2Properties_simple(border-right-width) borderRightWidth
+set ::hv3::DOM::CSS2Properties_simple(border-left-width) borderLeftWidth
+set ::hv3::DOM::CSS2Properties_simple(border-bottom-width) borderBottomWidth
+set ::hv3::DOM::CSS2Properties_simple(margin-top) marginTop
+set ::hv3::DOM::CSS2Properties_simple(margin-right) marginRight
+set ::hv3::DOM::CSS2Properties_simple(margin-left) marginLeft
+set ::hv3::DOM::CSS2Properties_simple(margin-bottom) marginBottom
+set ::hv3::DOM::CSS2Properties_simple(visibility) visibility
+
+set ::hv3::DOM::CSS2Properties_simple(background-color) backgroundColor
+set ::hv3::DOM::CSS2Properties_simple(background-image) backgroundImage
+
+
+set ::hv3::dom::code::ELEMENTCSSINLINESTYLE {
-- A reference to the [Ref CSSStyleDeclaration] object used to access
-- the HTML \"style\" attribute of this document element.
--
@@ -23,16 +53,44 @@ namespace eval hv3 { set {version($Id: hv3_dom_style.tcl,v 1.13 2007/08/04 17:15
}
}
-namespace eval ::hv3::dom2::compiler {
- proc style_property {css_prop {dom_prop ""}} {
- if {$dom_prop eq ""} {
- set dom_prop $css_prop
- }
- set getcmd "CSSStyleDeclaration_getStyleProperty \$myNode $css_prop"
- dom_get $dom_prop $getcmd
+set ::hv3::dom::code::CSS2PROPERTIES {
- set putcmd "CSSStyleDeclaration_setStyleProperty \$myNode $css_prop \$value"
- dom_put -string $dom_prop {value} $putcmd
+ dom_parameter myNode
+
+ foreach {k v} [array get ::hv3::DOM::CSS2Properties_simple] {
+ if {$v eq ""} { set v $k }
+ dom_get $v "
+ CSSStyleDeclaration.getStyleProperty \$myNode $k
+ "
+ dom_put -string $v value "
+ CSSStyleDeclaration.setStyleProperty \$myNode $k \$value
+ "
+ }
+ unset -nocomplain k
+ unset -nocomplain v
+
+ dom_put -string border value {
+ set style [$myNode attribute -default {} style]
+ if {$style ne ""} {append style ";"}
+ append style "border: $value"
+ $myNode attribute style $style
+ }
+
+ dom_put -string background value {
+ array set current [$myNode prop -inline]
+ unset -nocomplain current(background-color)
+ unset -nocomplain current(background-image)
+ unset -nocomplain current(background-repeat)
+ unset -nocomplain current(background-attachment)
+ unset -nocomplain current(background-position)
+ unset -nocomplain current(background-position-y)
+ unset -nocomplain current(background-position-x)
+
+ set style "background:$value;"
+ foreach prop [array names current] {
+ append style "$prop:$current($prop);"
+ }
+ $myNode attribute style $style
}
}
@@ -45,7 +103,8 @@ namespace eval ::hv3::dom2::compiler {
# * As part of the DOM representation of a parsed stylesheet
# document. Hv3 does not implement this function.
#
-::hv3::dom2::stateless CSSStyleDeclaration CSS2Properties {
+::hv3::dom2::stateless CSSStyleDeclaration {
+ %CSS2PROPERTIES%
# cssText attribute - access the text of the style declaration.
# TODO: Setting this to a value that does not parse is supposed to
@@ -75,7 +134,7 @@ namespace eval ::hv3::dom2::compiler {
# DOMString item(in unsigned long index);
#
dom_get length {
- list number [expr {[llength [$myNode prop -inline]]}/2]
+ list number [expr {[llength [$myNode prop -inline]]/2}]
}
dom_call -string item {THIS index} {
set idx [expr {2*int([lindex $index 1])}]
@@ -87,80 +146,15 @@ namespace eval ::hv3::dom2::compiler {
dom_get parentRule { list null }
}
-# Set up an array of known "simple" properties. This is used during
-# DOM compilation and at runtime.
-#
-set ::hv3::DOM::CSS2Properties_simple(width) width
-set ::hv3::DOM::CSS2Properties_simple(height) height
-set ::hv3::DOM::CSS2Properties_simple(display) display
-set ::hv3::DOM::CSS2Properties_simple(position) position
-set ::hv3::DOM::CSS2Properties_simple(top) top
-set ::hv3::DOM::CSS2Properties_simple(left) left
-set ::hv3::DOM::CSS2Properties_simple(bottom) bottom
-set ::hv3::DOM::CSS2Properties_simple(right) right
-set ::hv3::DOM::CSS2Properties_simple(z-index) zIndex
-set ::hv3::DOM::CSS2Properties_simple(cursor) cursor
-set ::hv3::DOM::CSS2Properties_simple(float) cssFloat
-set ::hv3::DOM::CSS2Properties_simple(font-size) fontSize
-set ::hv3::DOM::CSS2Properties_simple(clear) clear
-set ::hv3::DOM::CSS2Properties_simple(border-top-width) borderTopWidth
-set ::hv3::DOM::CSS2Properties_simple(border-right-width) borderRightWidth
-set ::hv3::DOM::CSS2Properties_simple(border-left-width) borderLeftWidth
-set ::hv3::DOM::CSS2Properties_simple(border-bottom-width) borderBottomWidth
-set ::hv3::DOM::CSS2Properties_simple(margin-top) marginTop
-set ::hv3::DOM::CSS2Properties_simple(margin-right) marginRight
-set ::hv3::DOM::CSS2Properties_simple(margin-left) marginLeft
-set ::hv3::DOM::CSS2Properties_simple(margin-bottom) marginBottom
-set ::hv3::DOM::CSS2Properties_simple(visibility) visibility
-
-set ::hv3::DOM::CSS2Properties_simple(background-color) backgroundColor
-
-::hv3::dom2::stateless CSS2Properties {} {
-
- dom_parameter myNode
-
- foreach {k v} [array get ::hv3::DOM::CSS2Properties_simple] {
- style_property $k $v
- }
- unset -nocomplain k
- unset -nocomplain v
-
- dom_put -string border value {
- set style [$myNode attribute -default {} style]
- if {$style ne ""} {append style ";"}
- append style "border: $value"
- $myNode attribute style $style
- }
-
- dom_put -string background value {
- array set current [$myNode prop -inline]
- unset -nocomplain current(background-color)
- unset -nocomplain current(background-image)
- unset -nocomplain current(background-repeat)
- unset -nocomplain current(background-attachment)
- unset -nocomplain current(background-position)
- unset -nocomplain current(background-position-y)
- unset -nocomplain current(background-position-x)
-
- set style "background:$value;"
- foreach prop [array names current] {
- append style "$prop:$current($prop);"
- }
- $myNode attribute style $style
- }
-}
-
namespace eval ::hv3::DOM {
- proc CSSStyleDeclaration_getStyleProperty {node css_property} {
+ proc CSSStyleDeclaration.getStyleProperty {node css_property} {
set val [$node property -inline $css_property]
list string $val
}
- proc CSSStyleDeclaration_setStyleProperty {node css_property value} {
+ proc CSSStyleDeclaration.setStyleProperty {node css_property value} {
array set current [$node prop -inline]
-# if {$value eq "NaNpx"} "error NAN"
-
if {$value ne ""} {
set current($css_property) $value
} else {
@@ -175,4 +169,3 @@ namespace eval ::hv3::DOM {
$node attribute style $style
}
}
-
diff --git a/hv/hv3_dom_xmlhttp.tcl b/hv/hv3_dom_xmlhttp.tcl
index 38f75fa..f442e2f 100644
--- a/hv/hv3_dom_xmlhttp.tcl
+++ b/hv/hv3_dom_xmlhttp.tcl
@@ -1,4 +1,10 @@
-namespace eval hv3 { set {version($Id: hv3_dom_xmlhttp.tcl,v 1.12 2007/09/01 14:21:28 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3_dom_xmlhttp.tcl,v 1.18 2008/02/15 18:23:37 danielk1977 Exp $)} 1 }
+
+::hv3::dom2::stateless Document {
+ %NODE%
+ %NODE_PROTOTYPE%
+ %DOCUMENT%
+}
#-------------------------------------------------------------------------
# ::hv3::dom::XMLHttpRequest
@@ -9,15 +15,14 @@ namespace eval hv3 { set {version($Id: hv3_dom_xmlhttp.tcl,v 1.12 2007/09/01 14:
# http://www.w3.org/TR/XMLHttpRequest/
#
#
-# TODO: Change to ::stateless
-#
-::hv3::dom2::stateless XMLHttpRequest {} {
+::hv3::dom2::stateless XMLHttpRequest {
# Magical state array. And the matching destructor. The
# "constructor" for the Tcl side of the XMLHttpRequest is the
# [::hv3::dom::newXMLHttpRequest] proc.
#
dom_parameter myStateArray
+
dom_finalize {
# Clean up the download handle, if it exists.
@@ -25,6 +30,10 @@ namespace eval hv3 { set {version($Id: hv3_dom_xmlhttp.tcl,v 1.12 2007/09/01 14:
$state(downloadHandle) destroy
}
+ if {$state(xml) ne ""} {
+ destroy $state(xml)
+ }
+
# Clean up the Tcl state for this XMLHttpRequest.
array unset state
}
@@ -46,7 +55,18 @@ namespace eval hv3 { set {version($Id: hv3_dom_xmlhttp.tcl,v 1.12 2007/09/01 14:
# created by parsing the retrieved data. But hv3 doesn't support
# script creation of Document objects at this time, so leave
# this as [dom_todo].
- dom_todo responseXML
+ dom_get responseXML {
+ if {$state(xml) eq "" && $state(readyState) eq "Loaded"} {
+ set state(xml) [html .xml_[string map {: _} $myStateArray]]
+
+ $state(xml) configure -parsemode xml -defaultstyle ""
+ $state(xml) parse -final $state(responseText)
+ }
+ if {$state(xml) ne ""} {
+ return [list object [list ::hv3::DOM::Document $myDom $state(xml)]]
+ }
+ return null
+ }
dom_get responseText {list string $state(responseText)}
dom_get status {list number $state(status)}
@@ -64,7 +84,7 @@ namespace eval hv3 { set {version($Id: hv3_dom_xmlhttp.tcl,v 1.12 2007/09/01 14:
if {$state(downloadHandle) ne ""} {
$state(downloadHandle) destroy
}
- set state(downloadHandle) [::hv3::download %AUTO%]
+ set state(downloadHandle) [::hv3::request %AUTO%]
# Configure the callback scripts "-finscript" and "-incrscript".
#
@@ -147,7 +167,7 @@ namespace eval hv3 { set {version($Id: hv3_dom_xmlhttp.tcl,v 1.12 2007/09/01 14:
# End of W3C interface. Below this point is non-standard stuff.
}
-::hv3::dom2::stateless XMLHttpRequestEvent {} {
+::hv3::dom2::stateless XMLHttpRequestEvent {
dom_parameter myXMLHttpRequest
# Constants for Event.eventPhase (Definition group PhaseType)
@@ -173,7 +193,7 @@ namespace eval hv3 { set {version($Id: hv3_dom_xmlhttp.tcl,v 1.12 2007/09/01 14:
namespace eval ::hv3::DOM {
- # Called as the ::hv3::download -incrscript callback for an
+ # Called as the ::hv3::request -incrscript callback for an
# XMLHttpRequest.
#
proc XMLHttpRequest_Incr {dom statevar data} {
@@ -187,7 +207,7 @@ namespace eval ::hv3::DOM {
XMLHttpRequest_SetState $dom $statevar Receiving
}
- # Called as the ::hv3::download -finscript callback for an
+ # Called as the ::hv3::request -finscript callback for an
# XMLHttpRequest.
#
proc XMLHttpRequest_Finished {dom statevar data} {
@@ -216,15 +236,31 @@ namespace eval ::hv3::DOM {
# a "readystatechange" event.
#
set this [list ::hv3::DOM::XMLHttpRequest $dom $statevar]
- set event [list ::hv3::DOM::XMLHttpRequestEvent $dom $this]
-
- [$dom see] dispatch $this $event
+ set event [list \
+ CAPTURING_PHASE {number 1} \
+ AT_TARGET {number 2} \
+ BUBBLING_PHASE {number 3} \
+ type {string readystatechange} \
+ bubbles {boolean 0} \
+ cancelable {boolean 0} \
+ timestamp {number 0} \
+ ]
+
+ set rc [catch {[$dom see] dispatch $this $event} msg]
+
+ # If an error occured, log it in the debugging window.
+ #
+ if {$rc} {
+ puts $msg
+ set objtype [lindex $js_obj 0]
+ set name [string map {blob error} [$myDom NewFilename]]
+ $myDom Log "XMLHttpRequest readystatechange" $name "event" $rc $msg
+ }
}
}
set ::hv3::dom::next_xmlhttp_id 0
proc ::hv3::dom::newXMLHttpRequest {dom hv3} {
- set see [$dom see]
# Name of the state-array for the new object.
set statevar "::hv3::DOM::xmlhttprequest_[incr ::hv3::dom::next_xmlhttp_id]"
@@ -240,6 +276,8 @@ proc ::hv3::dom::newXMLHttpRequest {dom hv3} {
set state(statusText) ""
set state(hv3) $hv3
+ set state(xml) ""
+
list object [list ::hv3::DOM::XMLHttpRequest $dom $statevar]
}
diff --git a/hv/hv3_download.tcl b/hv/hv3_download.tcl
new file mode 100644
index 0000000..7f31bfd
--- /dev/null
+++ b/hv/hv3_download.tcl
@@ -0,0 +1,539 @@
+namespace eval hv3 { set {version($Id: hv3_download.tcl,v 1.2 2008/02/04 04:42:10 danielk1977 Exp $)} 1 }
+
+# ::hv3::filedownload
+#
+# Each currently downloading file is managed by an instance of the
+# following object type. All instances in the application are managed
+# by the [::hv3::the_download_manager] object, an instance of
+# class ::hv3::downloadmanager (see below).
+#
+# SYNOPSIS:
+#
+# set obj [::hv3::filedownload %AUTO% ?OPTIONS?]
+#
+# $obj set_destination $PATH
+# $obj append $DATA
+# $obj finish
+#
+# Options are:
+#
+# Option Default Summary
+# -------------------------------------
+# -source "" Source of download (for display only)
+# -cancelcmd "" Script to invoke to cancel the download
+#
+namespace eval ::hv3::filedownload {
+
+ proc new {me args} {
+ upvar #0 $me O
+
+ # Variables used by fdgui:
+ set O(fdgui.status) ""
+ set O(fdgui.progress) ""
+ set O(fdgui.buttontext) Cancel
+
+ # The destination path (in the local filesystem) and the corresponding
+ # tcl channel (if it is open). These two variables also define the
+ # three states that this object can be in:
+ #
+ # INITIAL:
+ # No destination path has been provided yet. Both O(fdgui.destination)
+ # and O(myChannel) are set to an empty string.
+ #
+ # STREAMING:
+ # A destination path has been provided and the destination file is
+ # open. But the download is still in progress. Neither
+ # O(fdgui.destination) nor O(myChannel) are set to an empty string.
+ #
+ # FINISHED:
+ # A destination path is provided and the entire download has been
+ # saved into the file. We're just waiting for the user to dismiss
+ # the GUI. In this state, O(myChannel) is set to an empty string but
+ # O(fdgui.destination) is not.
+ #
+ set O(fdgui.destination) ""
+ set O(myChannel) ""
+
+ # Buffer for data while waiting for a file-name. This is used only in the
+ # state named INITIAL in the above description. The $O(myIsFinished) flag
+ # is set to true if the download is finished (i.e. [finish] has been
+ # called).
+ set O(myBuffer) ""
+ set O(myIsFinished) 0
+
+ set O(-source) ""
+ set O(-cancelcmd) ""
+
+ # Total bytes downloaded so far.
+ set O(myDownloaded) 0
+
+ # Total bytes expected (i.e. size of the download)
+ set O(myExpected) 0
+
+ set O(speed.afterid) ""
+ set O(speed.downloaded) 0
+ set O(speed.milliseconds) 0
+ set O(speed.speed) ""
+
+ eval $me configure $args
+
+ $me CalculateSpeed
+ }
+
+ proc destroy {me} {
+ upvar #0 $me O
+ catch { close $O(myChannel) }
+ catch { after cancel $O(speed.afterid) }
+ array unset $me
+ rename $me {}
+ }
+
+ proc CalculateSpeed {me} {
+ upvar #0 $me O
+
+ set time [clock milliseconds]
+
+ set bytes [expr {$O(myDownloaded)-$O(speed.downloaded)}]
+ set clicks [expr {$time-$O(speed.milliseconds)}]
+
+ set O(speed.speed) [
+ format "%.1f KB/sec" [expr {double($bytes)/double($clicks)}]
+ ]
+ set O(speed.downloaded) $O(myDownloaded)
+ set O(speed.milliseconds) $time
+
+ set O(speed.afterid) [after 2000 [list $me CalculateSpeed]]
+ $me Updategui
+ }
+
+ proc set_destination {me dest isFinished} {
+ upvar #0 $me O
+ if {$isFinished} {
+ set O(myIsFinished) 1
+ }
+
+ # It is an error if this method has been called before.
+ if {$O(fdgui.destination) ne ""} {
+ error "This ::hv3::filedownloader already has a destination!"
+ }
+
+ if {$dest eq ""} {
+ # Passing an empty string to this method cancels the download.
+ # This is for conveniance, because [tk_getSaveFile] returns an
+ # empty string when the user selects "Cancel".
+ $me Cancel
+ destroy $me
+ } else {
+ # Set the O(fdgui.destination) variable and open the channel to the
+ # file to write. Todo: An error could occur opening the file.
+ set O(fdgui.destination) $dest
+ set O(myChannel) [open $O(fdgui.destination) w]
+ fconfigure $O(myChannel) -encoding binary -translation binary
+
+ # If a buffer has accumulated, write it to the new channel.
+ puts -nonewline $O(myChannel) $O(myBuffer)
+ set O(myBuffer) ""
+
+ # If the O(myIsFinished) flag is set, then the entire download
+ # was already in the buffer. We're finished.
+ if {$O(myIsFinished)} {
+ $me finish {} {}
+ }
+
+ ::hv3::the_download_manager manage $me
+ }
+ }
+
+ # This internal method is called to cancel the download. When this
+ # returns the object will have been destroyed.
+ #
+ proc Cancel {me } {
+ upvar #0 $me O
+ # Evaluate the -cancelcmd script and destroy the object.
+ eval $O(-cancelcmd)
+ if {$O(fdgui.destination) ne ""} {
+ catch {close $O(myChannel)}
+ catch {file delete $O(fdgui.destination)}
+ }
+ }
+
+ # Update the GUI to match the internal state of this object.
+ #
+ proc Updategui {me } {
+ upvar #0 $me O
+
+ set bytes $O(myDownloaded)
+ if {$O(myIsFinished)} {
+ set O(fdgui.progress) 100
+ set O(fdgui.status) "Finished ($bytes bytes)"
+ set O(fdgui.buttontext) "Dismiss"
+ } else {
+ set speed $O(speed.speed)
+ set total $O(myExpected)
+ if {$total eq "" || $total == 0} {set total 1}
+ set progress "[expr {$bytes/1024}] of [expr {$total/1024}] KB"
+
+ set O(fdgui.progress) [expr {$bytes*100/$total}]
+ set O(fdgui.status) "$progress ($O(fdgui.progress)%) at $speed"
+ }
+ }
+
+ proc append {me handle data} {
+ upvar #0 $me O
+ set O(myExpected) [$handle cget -expectedsize]
+ if {$O(myChannel) ne ""} {
+ puts -nonewline $O(myChannel) $data
+ set O(myDownloaded) [file size $O(fdgui.destination)]
+ } else {
+ ::append O(myBuffer) $data
+ set O(myDownloaded) [string length $O(myBuffer)]
+ }
+ $me Updategui
+ }
+
+ # Called by the driver download-handle when the download is
+ # complete. All the data will have been already passed to [append].
+ #
+ proc finish {me handle data} {
+ upvar #0 $me O
+ if {$data ne ""} {
+ $me append $handle $data
+ }
+
+ # If the channel is open, close it.
+ if {$O(myChannel) ne ""} {
+ close $O(myChannel)
+ set O(myChannel) ""
+ }
+
+ # If O(myIsFinished) flag is not set, set it and then set O(myElapsed) to
+ # indicate the time taken by the download.
+ if {!$O(myIsFinished)} {
+ set O(myIsFinished) 1
+ }
+
+ # Update the GUI.
+ $me Updategui
+
+ # Delete the download request.
+ if {$handle ne ""} {
+ $handle destroy
+ }
+ }
+
+ # Query interface used by ::hv3::downloadmanager GUI. It cares about
+ # four things:
+ #
+ # * the percentage of the download has been completed, and
+ # * the state of the download (either "Downloading" or "Finished").
+ # * the source URI
+ # * the destination file
+ #
+ proc state {me } {
+ upvar #0 $me O
+ if {$O(myIsFinished)} {return "Finished"}
+ return "Downloading"
+ }
+ proc percentage {me } {
+ upvar #0 $me O
+ if {$O(myIsFinished)} {return 100}
+ if {$O(myExpected) eq "" || $O(myExpected) == 0} {
+ return [expr {$O(myDownloaded) > 0 ? 50 : 0}]
+ }
+ return [expr double($O(myDownloaded)) / double($O(myExpected)) * 100]
+ }
+ proc bytes {me} {
+ upvar #0 $me O
+ return $O(myDownloaded)
+ }
+ proc expected {me} {
+ upvar #0 $me O
+ return $O(myExpected)
+ }
+ proc destination {me} {
+ upvar #0 $me O
+ return $O(fdgui.destination)
+ }
+ proc speed {me} {
+ upvar #0 $me O
+ return $O(speed.speed)
+ }
+}
+::hv3::make_constructor ::hv3::filedownload
+
+namespace eval ::hv3::fdgui {
+
+ set DelegateOption(-command) myButton
+
+ proc new {me fd args} {
+ upvar #0 $me O
+
+ set f [frame $O(win).frame]
+ set spacer [frame $O(win).spacer -background #c3c3c3 -width 15]
+
+ ::hv3::label $f.label_source -text Source: -anchor w
+ ::hv3::label $f.label_dest -text Destination: -anchor w
+ ::hv3::label $f.label_status -text Status: -anchor w
+ ::hv3::label $f.label_progress -text Progress: -anchor w
+
+ ::hv3::label $f.source -textvar ${fd}(-source) -anchor w
+ ::hv3::label $f.dest -textvar ${fd}(fdgui.destination) -anchor w
+ ::hv3::label $f.status -textvar ${fd}(fdgui.status) -anchor w
+ ttk::progressbar $f.progress -variable ${fd}(fdgui.progress)
+
+ grid $f.label_source -column 0 -row 0 -sticky ew
+ grid $f.label_dest -column 0 -row 1 -sticky ew
+ grid $f.label_status -column 0 -row 2 -sticky ew
+ grid $f.label_progress -column 0 -row 3 -sticky ew
+
+ grid $f.source -column 1 -row 0 -sticky ew -padx 10
+ grid $f.dest -column 1 -row 1 -sticky ew -padx 10
+ grid $f.status -column 1 -row 2 -sticky ew -padx 10
+ grid $f.progress -column 1 -row 3 -sticky ew -padx 10
+
+ grid columnconfigure $f 1 -weight 1
+
+ ::hv3::button $O(win).command -textvar ${fd}(fdgui.buttontext) -width 7
+ set O(myButton) $O(win).command
+
+ grid $f $spacer $O(win).command -sticky nsew
+ grid columnconfigure $O(win) 0 -weight 1
+
+ $f configure -relief sunken -borderwidth 1
+
+ eval $me configure $args
+ }
+
+ proc destroy {me} {
+ array unset $me
+ rename $me {}
+ }
+
+}
+::hv3::make_constructor ::hv3::fdgui
+
+
+# ::hv3::downloadmanager
+#
+# SYNOPSIS
+#
+# set obj [::hv3::downloadmanager %AUTO%]
+#
+# $obj show
+# $obj manage FILE-DOWNLOAD
+#
+# destroy $obj
+#
+namespace eval ::hv3::downloadmanager {
+
+ proc new {me} {
+ upvar #0 $me O
+
+ # The set of ::hv3::filedownload objects.
+ set O(downloads) [list]
+
+ # All ::hv3::hv3 widgets in the system that (may) be
+ # displaying the downloads GUI.
+ set O(hv3_list) [list]
+ }
+ proc destroy {me} {
+ unset $me
+ rename $me ""
+ }
+
+ proc manage {me filedownload} {
+ upvar #0 $me O
+ set O(downloads) [linsert $O(downloads) 0 $filedownload]
+ $me ReloadAllGuis
+ }
+
+ proc ReloadAllGuis {me} {
+ upvar #0 $me O
+ $me CheckGuiList
+ foreach hv3 $O(hv3_list) {
+ $hv3 goto home://downloads/ -cachecontrol no-cache -nosave
+ }
+ }
+
+ # This is a helper proc for method [savehandle] to extract any
+ # filename-parameter from the value of an HTTP Content-Disposition
+ # header. If one exists, the value of the filename parameter is
+ # returned. Otherwise, an empty string.
+ #
+ # Refer to RFC1806 for the complete format of a Content-Disposition
+ # header. An example is:
+ #
+ # {inline ; filename="src.tar.gz"}
+ #
+ proc ParseContentDisposition {value} {
+ set tokens [::hv3::string::tokenise $value]
+
+ set filename ""
+ for {set ii 0} {$ii < [llength $tokens]} {incr ii} {
+ set t [lindex $tokens $ii]
+ set t2 [lindex $tokens [expr $ii+1]]
+
+ if {[string match -nocase $t "filename"] && $t2 eq "="} {
+ set filename [lindex $tokens [expr $ii+2]]
+ set filename [::hv3::string::dequote $filename]
+ break
+ }
+ }
+
+ return $filename
+ }
+
+ # Activate the download manager to save the resource targeted by the
+ # ::hv3::request passed as an argument ($handle) to the local
+ # file-system. It is the responsbility of the caller to configure
+ # the download-handle and pass it to the protocol object. The second
+ # argument, $data, contains an initial segment of the resource that has
+ # already been downloaded.
+ #
+ proc savehandle {me protocol handle data {isFinished 0}} {
+ upvar #0 $me O
+
+ # Remove the handle from the protocol's accounting system.
+ if {$protocol ne ""} {
+ $protocol FinishRequest $handle
+ }
+
+ # Create a GUI to handle this download
+ set dler [::hv3::filedownload %AUTO% \
+ -source [$handle cget -uri] \
+ -cancelcmd [list catch [list $handle destroy]] \
+ ]
+ ::hv3::the_download_manager show
+
+ # Redirect the -incrscript and -finscript commands to the download GUI.
+ $handle configure -finscript [list $dler finish $handle]
+ $handle configure -incrscript [list $dler append $handle]
+
+ $dler append $handle [$handle rawdata]
+ $handle set_rawmode
+
+ # Figure out a default file-name to suggest to the user. This
+ # is one of the following (in order of preference):
+ #
+ # 1. The "filename" field from a Content-Disposition header. The
+ # content disposition header is described in RFC 1806 (and
+ # later RFC 2183). A Content-Disposition header looks like
+ # this:
+ #
+ # 2. By extracting the tail of the URI.
+ #
+ set suggested ""
+ foreach {key value} [$handle cget -header] {
+ if {[string equal -nocase $key Content-Disposition]} {
+ set suggested [ParseContentDisposition $value]
+ }
+ }
+ if {$suggested eq ""} {
+ regexp {/([^/]*)$} [$handle cget -uri] -> suggested
+ }
+
+ # Pop up a GUI to select a "Save as..." filename. Schedule this as
+ # a background job to avoid any recursive entry to our event handles.
+ set cmd [subst -nocommands {
+ $dler set_destination [file normal [
+ tk_getSaveFile -initialfile {$suggested}
+ ]] $isFinished
+ }]
+ after idle $cmd
+ }
+
+ # Prune the list of hv3 widgets displaying the download GUI to
+ # those that actually are.
+ proc CheckGuiList {me } {
+ upvar #0 $me O
+ # Make sure the list of GUI's is up to date.
+ set newlist [list]
+ foreach hv3 $O(hv3_list) {
+ if {[info commands $hv3] eq ""} continue
+ set loc [$hv3 location]
+ if {[string match home://downloads* $loc] && [$hv3 pending] == 0} {
+ lappend newlist $hv3
+ }
+ }
+ set O(hv3_list) $newlist
+ }
+
+ proc UpdateGui {me hv3} {
+ upvar #0 $me O
+# puts "UPDATE $fdownload"
+
+ foreach node [$hv3 html search .fdgui] {
+ set filedownload [$node attr id]
+ set fdgui [$node replace]
+ if {$fdgui eq ""} {
+ set fdgui [::hv3::create_widget_name $node]
+ ::hv3::fdgui $fdgui $filedownload \
+ -command [list $me Pressbutton $filedownload]
+ $node replace $fdgui -deletecmd [list destroy $fdgui]
+ }
+ }
+ }
+
+ proc Pressbutton {me dl} {
+ upvar #0 $me O
+ set idx [lsearch $O(downloads) $dl]
+ set O(downloads) [lreplace $O(downloads) $idx $idx]
+ catch {
+ if {[$dl state] ne "Finished"} {
+ $dl Cancel
+ }
+ $dl destroy
+ }
+ $me ReloadAllGuis
+ }
+
+ proc request {me handle} {
+ upvar #0 $me O
+ set hv3 [$handle cget -hv3]
+
+ set document {
+ <head>
+ <title>Downloads</title>
+ <style>
+ .fdgui { width:90%; margin: 1em auto; }
+ body { background-color: #c3c3c3 }
+ </style>
+ </head>
+ <body>
+ <h1 align=center>Downloads</h1>
+ }
+ foreach download $O(downloads) {
+ append document "<div class=\"fdgui\" id=\"$download\"></div>"
+ }
+ if {[llength $O(downloads)] == 0} {
+ append document "<div align=center><i>There are currently no downloads."
+ }
+
+ if {[lsearch $O(hv3_list) $hv3] < 0} {
+ lappend O(hv3_list) $hv3
+ }
+
+ $handle append $document
+ $handle finish
+ after idle [list $me UpdateGui $hv3]
+ }
+
+ proc show {me } {
+ upvar #0 $me O
+ $me CheckGuiList
+ if {[llength $O(hv3_list)] > 0} {
+ set hv3 [lindex $O(hv3_list) 0]
+ set win [winfo parent [$hv3 win]]
+ .notebook select $win
+ } else {
+ .notebook add home://downloads/
+ }
+ }
+}
+::hv3::make_constructor ::hv3::downloadmanager
+
+proc ::hv3::download_scheme_init {hv3 protocol} {
+ $protocol schemehandler download [
+ list ::hv3::the_download_manager request
+ ]
+}
diff --git a/hv/hv3_encodings.tcl b/hv/hv3_encodings.tcl
index 4b712dc..f352d17 100644
--- a/hv/hv3_encodings.tcl
+++ b/hv/hv3_encodings.tcl
@@ -67,6 +67,28 @@ proc fconfigure {args} {
eval fconfigure_orig $argv
}
+namespace eval ::hv3 {
+
+ # The argument is an encoding name, which may or may not be known to Tcl.
+ # Return the name of the Tcl encoding that will be used by Hv3.
+ #
+ proc encoding_resolve {enc} {
+ set encoding [string tolower $enc]
+ if {[info exists ::Hv3EncodingMap($encoding)]} {
+ set ::Hv3EncodingMap($encoding)
+ } else {
+ encoding system
+ }
+ }
+
+ # The two arguments are encoding names. This proc returns true if the
+ # two encodings are handled identically by Hv3.
+ #
+ proc ::hv3::encoding_isequal {enc1 enc2} {
+ string equal [::hv3::encoding_resolve $enc1] [::hv3::encoding_resolve $enc2]
+ }
+}
+
##########################################################################
# Below this point is where new encoding alias' can be added. See
# the comment in the file header for instructions.
diff --git a/hv/hv3_file.tcl b/hv/hv3_file.tcl
index 4066c7b..de8aaf7 100644
--- a/hv/hv3_file.tcl
+++ b/hv/hv3_file.tcl
@@ -1,4 +1,4 @@
-namespace eval hv3 { set {version($Id: hv3_file.tcl,v 1.8 2007/09/28 14:14:56 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3_file.tcl,v 1.10 2007/10/28 06:07:30 danielk1977 Exp $)} 1 }
#
# This file contains Tcl code for loading file:// URIs in the hv3 web browser
@@ -204,10 +204,19 @@ proc request_file {downloadHandle} {
# Unless the expected mime-type begins with the string "text",
# configure the file-handle for binary mode.
+ # If $downloadHandle has -encoding, read data is converted by
+ # $downloadHandle itself.
+
set fd [open $filename]
+
+ # Always uses binary encoding.
+ # $download is responsible to convert it.
+ #
+ fconfigure $fd -encoding binary
+
if {![string match text* [$downloadHandle cget -mimetype]]} {
- fconfigure $fd -encoding binary -translation binary
- }
+ fconfigure $fd -translation binary
+ }
set data [read $fd]
close $fd
}
@@ -225,8 +234,7 @@ proc request_file {downloadHandle} {
#$downloadHandle fail "Unreadable path: $filename"
}
- $downloadHandle append $data
- $downloadHandle finish
+ $downloadHandle finish $data
}
};# End of [namespace eval hv3]
diff --git a/hv/hv3_form.tcl b/hv/hv3_form.tcl
index 5f99dfe..ba066aa 100644
--- a/hv/hv3_form.tcl
+++ b/hv/hv3_form.tcl
@@ -1,4 +1,4 @@
-namespace eval hv3 { set {version($Id: hv3_form.tcl,v 1.86 2007/10/07 11:09:02 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3_form.tcl,v 1.99 2008/03/03 10:29:00 danielk1977 Exp $)} 1 }
###########################################################################
# hv3_form.tcl --
@@ -407,7 +407,7 @@ proc ::hv3::control_to_form {node} {
# Reset the state of the control.
#
method reset {} {
- puts "TODO: ::hv3::forms::radio reset"
+ #puts "TODO: ::hv3::forms::radio reset"
}
# TODO: The sole purpose of this is to return a linebox offset...
@@ -432,6 +432,37 @@ proc ::hv3::control_to_form {node} {
$hull configure -highlightcolor $bg
}
}
+
+ #---------------------------------------------------------------------
+ # START OF DOM FUNCTIONALITY
+ #
+ # Below this point are some methods used by the DOM class
+ # HTMLInputElement. None of this is used unless scripting is enabled.
+ #
+
+ # Get/set on the DOM "checked" attribute.
+ #
+ method dom_checked {args} {
+ if {[llength $args] == 1} {
+ if {[lindex $args 0]} {
+ set $myVarname $myNode
+ } else {
+ set $myVarname ""
+ }
+ }
+ return [expr {[set $myVarname] eq $myNode}]
+ }
+
+ method dom_select {} { }
+ method dom_focus {} { }
+ method dom_blur {} { }
+
+ method dom_click {} {
+ set x [expr [winfo width $me]/2]
+ set y [expr [winfo height $me]/2]
+ event generate $me <ButtonPress-1> -x $x -y $y
+ event generate $me <ButtonRelease-1> -x $x -y $y
+ }
}
#--------------------------------------------------------------------------
@@ -442,93 +473,116 @@ proc ::hv3::control_to_form {node} {
# <INPUT type="text">
# <INPUT type="password">
#
-::snit::widget ::hv3::forms::entrycontrol {
- option -takefocus -default 0
+namespace eval ::hv3::forms::entrycontrol {
- variable myWidget ""
- variable myValue ""
- variable myNode ""
+ proc new {me node bindtag args} {
+ upvar #0 $me O
- constructor {node bindtag args} {
- set myNode $node
+ set O(-takefocus) 0
- set myWidget [entry ${win}.entry]
- $myWidget configure -highlightthickness 0 -borderwidth 0
- $myWidget configure -selectborderwidth 0
- $myWidget configure -textvar [myvar myValue]
- $myWidget configure -background white
+ set O(myValue) ""
- $myWidget configure -validatecommand [list $self Validate %P]
- $myWidget configure -validate key
+ set O(myNode) $node
- pack $myWidget -expand true -fill both
+ set O(myWidget) [entry $O(win).entry]
+
+ $O(myWidget) configure -highlightthickness 0 -borderwidth 0
+ $O(myWidget) configure -selectborderwidth 0
+ $O(myWidget) configure -textvar ${me}(myValue)
+ $O(myWidget) configure -background white
+
+ $O(myWidget) configure -validatecommand [list $me Validate %P]
+ $O(myWidget) configure -validate key
+
+ pack $O(myWidget) -expand true -fill both
# If this is a password entry field, obscure it's contents
set zType [string tolower [$node attr -default "" type]]
- if {$zType eq "password" } { $myWidget configure -show * }
+ if {$zType eq "password" } { $O(myWidget) configure -show * }
# Set the default width of the widget to 20 characters. Unless there
# is no size attribute and the CSS 'width' property is set to "auto",
# this will be overidden.
- $myWidget configure -width 20
+ $O(myWidget) configure -width 20
# Pressing enter in an entry widget submits the form.
- bind $myWidget <KeyPress-Return> [list $self Submit]
+ bind $O(myWidget) <KeyPress-Return> [list $me Submit]
- bind $myWidget <Tab> [list ::hv3::forms::tab [$myNode html]]
- bind $myWidget <Shift-Tab> [list ::hv3::forms::tab [$myNode html]]
+ bind $O(myWidget) <Tab> [list ::hv3::forms::tab [$O(myNode) html]]
+ bind $O(myWidget) <Shift-Tab> [list ::hv3::forms::tab [$O(myNode) html]]
- set tags [bindtags $myWidget]
- bindtags $myWidget [concat $tags $win]
+ set tags [bindtags $O(myWidget)]
+ bindtags $O(myWidget) [concat $tags $O(win)]
- $self reset
- $self configurelist $args
+ $me reset
+ eval $me configure $args
+ }
+
+ proc destroy {me} {
+ uplevel #0 [list unset $me]
+ rename $me {}
}
# Generate html for the "HTML Forms" tab of the tree-browser.
#
- method formsreport {} { return {<i color=red>TODO</i>} }
+ proc formsreport {me} { return {<i color=red>TODO</i>} }
# This method is called during form submission to determine the
# name of the control. It returns the value of the Html "name"
# attribute. Or, failing that, an empty string.
#
- method name {} { return [$myNode attr -default "" name] }
+ proc name {me} {
+ upvar #0 $me O
+ return [$O(myNode) attr -default "" name]
+ }
# This method is called during form submission to determine the
# value of the control. Return the current contents of the widget.
#
- method value {} { return $myValue }
+ proc value {me} {
+ upvar #0 $me O
+ return $O(myValue)
+ }
# True if the control is considered successful for the
# purposes of submitting this form.
#
- method success {} { return [expr {[$self name] ne ""}] }
+ proc success {me} {
+ upvar #0 $me O
+ return [expr {[$me name] ne ""}]
+ }
# Empty string. This method is only implemented by
# <INPUT type="file"> controls.
#
- method filename {} { return "" }
+ proc filename {me} {
+ upvar #0 $me O
+ return ""
+ }
# Reset the state of the control.
#
- method reset {} {
- set myValue [$myNode attr -default "" value]
+ proc reset {me} {
+ upvar #0 $me O
+ set O(myValue) [$O(myNode) attr -default "" value]
}
# TODO: The sole purpose of this is to return a linebox offset...
- method configurecmd {values} {
- ::hv3::forms::configurecmd $myWidget [$myWidget cget -font]
+ proc configurecmd {me values} {
+ upvar #0 $me O
+ ::hv3::forms::configurecmd $O(myWidget) [$O(myWidget) cget -font]
}
- method stylecmd {} {
- catch { $myWidget configure -font [$myNode property font] }
+ proc stylecmd {me} {
+ upvar #0 $me O
+ catch { $O(myWidget) configure -font [$O(myNode) property font] }
}
- method Submit {} {
- set form [::hv3::control_to_form $myNode]
+ proc Submit {me} {
+ upvar #0 $me O
+ set form [::hv3::control_to_form $O(myNode)]
if {$form ne ""} {
- [$form replace] submit $self
+ [$form replace] submit $me
}
}
@@ -536,8 +590,9 @@ proc ::hv3::control_to_form {node} {
# removed from the [entry] widget. To enforce the semantics of
# the HTML "maxlength" attribute.
#
- method Validate {newvalue} {
- set iLimit [$myNode attr -default -1 maxlength]
+ proc Validate {me newvalue} {
+ upvar #0 $me O
+ set iLimit [$O(myNode) attr -default -1 maxlength]
if {$iLimit >= 0 && [string length $newvalue] > $iLimit} {
return 0
}
@@ -554,22 +609,24 @@ proc ::hv3::control_to_form {node} {
# Get/set on the DOM "checked" attribute. This is always 0 for
# an entry widget.
#
- method dom_checked {args} { return 0 }
+ proc dom_checked {me args} { return 0 }
# HTMLInputElement.value is the current contents of the widget
# for this type of object.
#
- method dom_value {args} {
+ proc dom_value {me args} {
+ upvar #0 $me O
if {[llength $args]>0} {
- set myValue [lindex $args 0]
+ set O(myValue) [lindex $args 0]
}
- return $myValue
+ return $O(myValue)
}
# Select the text in this widget.
#
- method dom_select {} {
- $myWidget selection range 0 end
+ proc dom_select {me} {
+ upvar #0 $me O
+ $O(myWidget) selection range 0 end
}
# Methods [dom_focus] and [dom_blur] are used to implement the
@@ -581,20 +638,23 @@ proc ::hv3::control_to_form {node} {
# so that the focus is passed to the next control in tab-index order
# But tab-index is not supported yet. :(
#
- method dom_focus {} {
- focus $myWidget
+ proc dom_focus {me} {
+ upvar #0 $me O
+ focus $O(myWidget)
}
- method dom_blur {} {
+ proc dom_blur {me} {
+ upvar #0 $me O
set now [focus]
- if {$myWidget eq [focus]} {
+ if {$O(myWidget) eq [focus]} {
focus [winfo parent $win]
}
}
# This is a no-op for this type of <INPUT> element.
#
- method dom_click {} {}
+ proc dom_click {me} {}
}
+::hv3::make_constructor ::hv3::forms::entrycontrol
#--------------------------------------------------------------------------
# ::hv3::forms::textarea
@@ -796,7 +856,7 @@ snit::widgetadaptor ::hv3::forms::select {
focus [winfo parent $win]
# Fire the "onchange" dom event.
- [$myHv3 dom] event onchange $myNode
+ [$myHv3 dom] event change $myNode
}
# This is called by the DOM module whenever the tree-structure
@@ -878,10 +938,11 @@ snit::widgetadaptor ::hv3::forms::select {
#
method dom_selectionIndex {} {
- if {[$hull cget -state] eq "disabled"} {
- return -1
+ set idx [$hull curselection]
+ if {[$hull cget -state] eq "disabled" || $idx eq ""} {
+ set idx -1
}
- $hull curselection
+ set idx
}
method dom_setSelectionIndex {value} {
if {[$hull cget -state] ne "disabled"} {
@@ -1035,17 +1096,19 @@ snit::widget ::hv3::forms::fileselect {
# <input type=reset>
#
#
-::snit::type ::hv3::clickcontrol {
- variable myNode ""
+namespace eval ::hv3::clickcontrol {
- variable myClicked 0
- variable myClickX 0
- variable myClickY 0
-
- option -clickcmd -default ""
-
- constructor {node} {
- set myNode $node
+ proc new {me node} {
+ upvar #0 $me O
+ set O(myClicked) 0
+ set O(myClickX) 0
+ set O(myClickY) 0
+ set O(-clickcmd) ""
+ set O(myNode) $node
+ }
+ proc destroy {me} {
+ rename $me ""
+ uplevel #0 [list unset $me]
}
# This method is used by graphical-submit buttons only. Controls
@@ -1053,7 +1116,8 @@ snit::widget ::hv3::forms::fileselect {
#
# <INPUT type="image">
#
- method graphicalSubmit {} {
+ proc graphicalSubmit {me} {
+ upvar #0 $me O
set t [string tolower [$myNode attr -default "" type]]
set name [$myNode attr -default "" name]
if {$t ne "image" || $name eq ""} {return [list]}
@@ -1061,20 +1125,27 @@ snit::widget ::hv3::forms::fileselect {
list "${name}.x" $myClickX "${name}.y" $myClickY
}
- method value {} { return [$myNode attr -default "" value] }
- method name {} { return [$myNode attr -default "" name] }
+ proc value {me} {
+ upvar #0 $me O
+ return [$O(myNode) attr -default "" value]
+ }
+ proc name {me} {
+ upvar #0 $me O
+ return [$O(myNode) attr -default "" name]
+ }
- method success {} {
+ proc success {me} {
+ upvar #0 $me O
# Controls that are disabled cannot be succesful:
- if {[$myNode attr -default 0 disabled]} {return 0}
+ if {[$O(myNode) attr -default 0 disabled]} {return 0}
- if {[catch {$myNode attr name ; $myNode attr value}]} {
+ if {[catch {$O(myNode) attr name ; $O(myNode) attr value}]} {
return 0
}
- switch -- [string tolower [$myNode attr type]] {
+ switch -- [string tolower [$O(myNode) attr type]] {
hidden { return 1 }
- submit { return $myClicked }
+ submit { return $O(myClicked) }
image { return 0 }
button { return 0 }
reset { return 0 }
@@ -1089,61 +1160,49 @@ snit::widget ::hv3::forms::fileselect {
# This method is called externally when this widget is clicked
# on. If it is not "", evaluate the script configured as -clickcmd
#
- method click {{isSynthetic 1}} {
+ proc click {me {isSynthetic 1}} {
+ upvar #0 $me O
# Controls that are disabled cannot be activated:
#
- if {[$myNode attr -default 0 disabled]} return
+ if {[$O(myNode) attr -default 0 disabled]} return
- set cmd $options(-clickcmd)
- set formnode [::hv3::control_to_form $myNode]
+ set cmd $O(-clickcmd)
+ set formnode [::hv3::control_to_form $O(myNode)]
if {$cmd ne "" && $formnode ne ""} {
- set bbox [[$myNode html] bbox $myNode]
+ set bbox [[$O(myNode) html] bbox $O(myNode)]
foreach {x1 y1 x2 y2} $bbox {}
if {$isSynthetic} {
- set myClickX [expr {($x2-$x1)/2}]
- set myClickY [expr {($y2-$y1)/2}]
+ set O(myClickX) [expr {($x2-$x1)/2}]
+ set O(myClickY) [expr {($y2-$y1)/2}]
} else {
- foreach {px py} [winfo pointerxy [$myNode html]] {}
- set wx [winfo rootx [$myNode html]]
- set wy [winfo rooty [$myNode html]]
- set myClickX [expr $px - ($x1 + $wx)]
- set myClickY [expr $py - ($y1 + $wy)]
+ foreach {px py} [winfo pointerxy [$O(myNode) html]] {}
+ set wx [winfo rootx [$O(myNode) html]]
+ set wy [winfo rooty [$O(myNode) html]]
+ set O(myClickX) [expr $px - ($x1 + $wx)]
+ set O(myClickY) [expr $py - ($y1 + $wy)]
}
- set myClicked 1
- eval [[$formnode replace] $cmd $self]
+ set O(myClicked) 1
+ eval [[$formnode replace] $cmd $me]
catch {
# Catch these in case this object has been destroyed by the
# form method invoked above.
- set myClicked 0
- set myClickX 0
- set myClickY 0
+ set O(myClicked) 0
+ set O(myClickX) 0
+ set O(myClickY) 0
}
}
}
- method configurecmd {values} {}
- method stylecmd {} {}
+ proc configurecmd {me values} {}
+ proc stylecmd {me} {}
- # This method is called by the DOM when the HTMLInputElement.value
- # property is set. See also the ::hv3::control method of the same name.
- #
- # From the DOM Level 1 html module (about the HTMLInputElement.value
- # property):
- #
- # When the type attribute of the element has the value "Button",
- # "Hidden", "Submit", "Reset", "Image", "Checkbox" or "Radio", this
- # represents the HTML value attribute of the element.
- #
- method set_value {newValue} {
- $myNode attr value $newValue
- }
-
- method formsreport {} {
- set n [::hv3::control_to_form $myNode]
+ proc formsreport {me} {
+ upvar #0 $me O
+ set n [::hv3::control_to_form $O(myNode)]
set report "<p>"
if {$n eq ""} {
append report {<i>No associated form node.</i>}
@@ -1156,9 +1215,51 @@ snit::widget ::hv3::forms::fileselect {
return $report
}
- method reset {} { # no-op }
+ proc reset {me } { # no-op }
+
+ #---------------------------------------------------------------------
+ # START OF DOM FUNCTIONALITY
+ #
+ # Below this point are some methods used by the DOM class
+ # HTMLInputElement. None of this is used unless scripting is enabled.
+ #
+
+ # Get/set on the DOM "checked" attribute. This means the state
+ # of control (1==checked, 0==not checked) for this type of object.
+ #
+ proc dom_checked {me args} {
+ return 0
+ }
+
+ # DOM Implementation does not call this. HTMLInputElement.value is
+ # the "value" attribute of the HTML element for this type of object.
+ #
+ proc dom_value {me args} { error "N/A" }
+
+ # HTMLInputElement.select() is a no-op for this kind of object. It
+ # contains no text so there is nothing to select...
+ #
+ proc dom_select {me} {}
+
+ # Hv3 will not support keyboard access to checkboxes. Until
+ # this changes these can be no-ops :)
+ proc dom_focus {me} {}
+ proc dom_blur {me} {}
+
+ # Generate a synthetic click. This same trick can be used for <INPUT>
+ # elements with "type" set to "Button", "Radio", "Reset", or "Submit".
+ #
+ proc dom_click {me} {
+ upvar #0 $me O
+ set x [expr [winfo width $win]/2]
+ set y [expr [winfo height $win]/2]
+ event generate $win <ButtonPress-1> -x $x -y $y
+ event generate $win <ButtonRelease-1> -x $x -y $y
+ }
}
+::hv3::make_constructor ::hv3::clickcontrol
+
#-----------------------------------------------------------------------
# ::hv3::format_query
#
@@ -1193,11 +1294,11 @@ snit::widget ::hv3::forms::fileselect {
# So in a way both versions are correct. But some websites (yahoo.com)
# do not work unless we allow the extra characters through unescaped.
#
-proc ::hv3::format_query {args} {
+proc ::hv3::format_query {enc args} {
set result ""
set sep ""
foreach i $args {
- append result $sep [::hv3::escape_string $i]
+ append result $sep [::hv3::escape_string [encoding convertto $enc $i]]
if {$sep eq "="} {
set sep &
} else {
@@ -1267,6 +1368,12 @@ snit::type ::hv3::form {
variable myHv3
+ # When the onsubmit() event is fired, this boolean variable is set.
+ # If the event handler calls submit() on this form object, it is
+ # submitted immediately, without running the event handler.
+ #
+ variable myInSubmitEvent 0
+
option -getcmd -default ""
option -postcmd -default ""
@@ -1312,13 +1419,17 @@ snit::type ::hv3::form {
method submit {submitcontrol} {
- # Before doing anything, execute the onsubmit event
+ # Before doing anything, execute the onsubmit event
# handlers, if any. If the submit handler script returns
# false, do not submit the form. Otherwise, proceed.
#
- set rc [[$myHv3 dom] event onsubmit $myFormNode]
- if {$rc eq "prevent"} return
- if {$rc eq "error"} return
+ if {!$myInSubmitEvent} {
+ set myInSubmitEvent 1
+ set rc [[$myHv3 dom] event onsubmit $myFormNode]
+ if {$rc eq "prevent"} return
+ if {$rc eq "error"} return
+ set myInSubmitEvent 0
+ }
set SubmitControls [$self SubmitNodes]
set Controls [$self ControlNodes]
@@ -1344,6 +1455,7 @@ snit::type ::hv3::form {
foreach controlnode $Controls {
set control [$controlnode replace]
+ if {$control eq ""} continue
set success [$control success]
set name [$control name]
if {$success} {
@@ -1369,6 +1481,7 @@ snit::type ::hv3::form {
set CR "\r\n"
foreach controlnode $Controls {
set control [$controlnode replace]
+ if {$control eq ""} continue
if {[$control success]} {
set name [$control name]
@@ -1389,7 +1502,8 @@ snit::type ::hv3::form {
append querydata "--${bound}--$CR"
} else {
set querytype "application/x-www-form-urlencoded"
- set querydata [eval [linsert $data 0 ::hv3::format_query]]
+ set enc [$myHv3 encoding]
+ set querydata [eval [linsert $data 0 ::hv3::format_query $enc]]
}
set action [$myFormNode attr -default "" action]
@@ -1400,7 +1514,7 @@ snit::type ::hv3::form {
ISINDEX {
set script $options(-getcmd)
set control [[lindex $Controls 0] replace]
- set querydata [::hv3::format_query [$control value]]
+ set querydata [::hv3::format_query [$myHv3 encoding] [$control value]]
}
default { set script "" }
}
@@ -1428,21 +1542,21 @@ snit::type ::hv3::form {
set report [subst $Template]
foreach controlnode [lrange [::hv3::get_form_nodes $myFormNode] 1 end] {
-
set control [$controlnode replace]
+ if {$control eq ""} continue
set success [$control success]
set name [$control name]
set isSubmit [expr {([lsearch [$self SubmitNodes] $controlnode]>=0)}]
if {$success} {
- set value [htmlize [$control value]]
+ set value [::hv3::string::htmlize [$control value]]
} else {
set value "<i>N/A</i>"
}
append report "<tr><td>"
append report "<a href=\"$controlnode\">"
if {$name ne ""} {
- append report "[htmlize $name]"
+ append report "[::hv3::string::htmlize $name]"
} else {
append report "<i>$controlnode</i>"
}
@@ -1514,6 +1628,8 @@ snit::type ::hv3::formmanager {
method SetupKeyBindings {widget node} {
bind $widget <KeyPress> +[list $self WidgetKeyPress $widget $node]
bind $widget <KeyRelease> +[list $self WidgetKeyRelease $widget $node]
+ bind $widget <FocusIn> +[list $self WidgetFocus $widget $node]
+ bind $widget <FocusOut> +[list $self WidgetBlur $widget $node]
}
# Handler scripts for the <KeyPress> and <KeyRelease> events.
@@ -1530,6 +1646,12 @@ snit::type ::hv3::formmanager {
}
set myKeyPressNode ""
}
+ method WidgetFocus {widget node} {
+ [$myHv3 dom] event focus $node
+ }
+ method WidgetBlur {widget node} {
+ [$myHv3 dom] event blur $node
+ }
method control_handler {node} {
@@ -1546,13 +1668,11 @@ snit::type ::hv3::formmanager {
switch -- ${tag}.${type} {
select. {
- set hv3 [winfo parent [winfo parent $myHtml]]
- set control [::hv3::forms::select $zWinPath $node $hv3]
+ set control [::hv3::forms::select $zWinPath $node $myHv3]
}
textarea. {
- set hv3 [winfo parent [winfo parent $myHtml]]
- set control [::hv3::forms::textarea $zWinPath $node $hv3]
+ set control [::hv3::forms::textarea $zWinPath $node $myHv3]
}
input.image {
@@ -1636,7 +1756,7 @@ snit::type ::hv3::formmanager {
}
method dumpforms {} {
- foreach node [$myHv3 search form] {
+ foreach node [$myHv3 html search form] {
set form [$node replace]
puts [$form dump]
}
diff --git a/hv/hv3_frames.tcl b/hv/hv3_frames.tcl
new file mode 100644
index 0000000..622d7f4
--- /dev/null
+++ b/hv/hv3_frames.tcl
@@ -0,0 +1,201 @@
+
+package require snit
+package require Tk
+
+# The ::hv3::framepair widget is used to pack two other widgets into a
+# frame with a draggable seperator between them. Widgets may be stacked
+# horizontally or vertically.
+#
+snit::widget ::hv3::framepair {
+
+ variable myLeftWidget
+ variable myRightWidget
+ variable myHandle
+
+ option -fraction -default 0.5
+ option -orient -default "h" -readonly 1
+
+ constructor {left right args} {
+ $self configurelist $args
+
+ set options(-orient) [string range $options(-orient) 0 0]
+ if {$options(-orient) ne "h" && $options(-orient) ne "v"} {
+ error "Bad value for -orient: should be horizontal or vertical"
+ }
+
+ puts [linsert $right 1 ${win}.right]
+ set myLeftWidget [eval [linsert $left 1 ${win}.left]]
+ set myRightWidget [eval [linsert $right 1 ${win}.right]]
+
+ set myHandle [frame ${win}.handle]
+ $myHandle configure -borderwidth 2 -relief raised
+
+ bind $self <Configure> [mymethod place]
+
+ if {$options(-orient) eq "h"} {
+ bind $myHandle <B1-Motion> [mymethod drag %Y]
+ $myHandle configure -cursor sb_v_double_arrow
+ } else {
+ bind $myHandle <B1-Motion> [mymethod drag %X]
+ $myHandle configure -cursor sb_h_double_arrow
+ }
+ $self place
+ }
+
+ method drag {Y} {
+ if {$options(-orient) eq "h"} {
+ set H [winfo height $self]
+ set Y0 [winfo rooty $self]
+ } else {
+ set H [winfo width $self]
+ set Y0 [winfo rootx $self]
+ }
+
+ set options(-fraction) [expr {($Y-$Y0)/double($H)}]
+ $self place
+ }
+
+ method place {} {
+ if {$options(-fraction) < 0.01} {set options(-fraction) 0.01}
+ if {$options(-fraction) > 0.99} {set options(-fraction) 0.99}
+
+ set i [expr {1.0 - $options(-fraction)}]
+ set f $options(-fraction)
+ if {$options(-orient) eq "h"} {
+ place $myLeftWidget -relheight $f -relwidth 1 -x 0 -y 0 -anchor nw
+ place $myHandle -rely $f -x 0 -anchor w -relwidth 1 -height 4
+ place $myRightWidget -relheight $i -x 0 -rely 1 -anchor sw -relwidth 1
+ } else {
+ place $myLeftWidget -relwidth $f -relheight 1
+ place $myHandle -relx $f -rely 0 -anchor n -relheight 1 -width 4
+ place $myRightWidget -relwidth $i -anchor se -relx 1 -rely 1 -relheight 1
+ }
+ }
+
+ method left {} {return $myLeftWidget}
+ method right {} {return $myRightWidget}
+ method top {} {return $myLeftWidget}
+ method bottom {} {return $myRightWidget}
+
+ delegate option * to hull
+}
+
+snit::widget ::hv3::scrolled {
+ component myWidget
+ variable myVsb
+ variable myHsb
+
+ constructor {widget args} {
+ set myWidget [eval [linsert $widget 1 ${win}.widget]]
+ set myVsb [scrollbar ${win}.vsb -orient vertical]
+ set myHsb [scrollbar ${win}.hsb -orient horizontal]
+
+ grid configure $myWidget -column 0 -row 0 -sticky nsew
+ grid columnconfigure $win 0 -weight 1
+ grid rowconfigure $win 0 -weight 1
+
+ $self configurelist $args
+
+ $myWidget configure -yscrollcommand [mymethod scrollcallback $myVsb]
+ $myWidget configure -xscrollcommand [mymethod scrollcallback $myHsb]
+ $myVsb configure -command [mymethod yview]
+ $myHsb configure -command [mymethod xview]
+
+ bindtags $myWidget [concat [bindtags $myWidget] $win]
+ }
+
+ method scrollcallback {scrollbar first last} {
+ $scrollbar set $first $last
+ set ismapped [expr [winfo ismapped $scrollbar] ? 1 : 0]
+ set isrequired [expr ($first == 0.0 && $last == 1.0) ? 0 : 1]
+ if {$isrequired && !$ismapped} {
+ switch [$scrollbar cget -orient] {
+ vertical {grid configure $scrollbar -column 1 -row 0 -sticky ns}
+ horizontal {grid configure $scrollbar -column 0 -row 1 -sticky ew}
+ }
+ } elseif {$ismapped && !$isrequired} {
+ grid forget $scrollbar
+ }
+ }
+
+ method widget {} {return $myWidget}
+
+ delegate option -width to hull
+ delegate option -height to hull
+ delegate option * to myWidget
+ delegate method * to myWidget
+}
+
+# Example:
+#
+# frameset .frames \
+# hv3 -variable myTopWidget -side top -fraction 0.25 \
+# canvas -variable myTreeWidget -side left -fraction 0.4 \
+# hv3 -variable myReportWidget
+#
+proc frameset {win args} {
+ set idx 0
+ set frames [list]
+ while {$idx < [llength $args]} {
+ set cmd [lindex $args $idx]
+ incr idx
+
+ unset -nocomplain variable
+ set side left
+ set fraction 0.5
+
+ set options [list -variable -side -fraction]
+ while { \
+ $idx < ([llength $args]-1) && \
+ [set opt [lsearch $options [lindex $args $idx]]] >= 0 \
+ } {
+ incr idx
+ set [string range [lindex $options $opt] 1 end] [lindex $args $idx]
+ incr idx
+ }
+
+ if {![info exists variable]} {
+ error "No -variable option supplied for widget $cmd"
+ }
+ if {$side ne "top" && $side ne "left"} {
+ error "Bad value for -side option: should be \"left\" or \"top\""
+ }
+ if {0 == [string is double $fraction]} {
+ error "Bad value for -fraction option: expected double got \"$fraction\""
+ }
+
+ lappend frames [list $cmd $variable $side $fraction]
+ }
+
+ puts $frames
+
+ unset -nocomplain cmd
+ for {set ii [expr [llength $frames] - 1]} {$ii >= 0} {incr ii -1} {
+ foreach {wid variable side fraction} [lindex $frames $ii] {}
+ if {[info exists cmd]} {
+ switch -- $side {
+ top {set o horizontal}
+ left {set o vertical}
+ }
+ set cmd [list ::hv3::framepair $wid $cmd -fraction $fraction -orient $o]
+ } else {
+ set cmd $wid
+ }
+ }
+ puts $cmd
+ eval [linsert $cmd 1 $win]
+
+ set framepair $win
+ for {set ii 0} {$ii < [llength $frames]} {incr ii} {
+ foreach {wid variable side fraction} [lindex $frames $ii] {}
+ if {$ii == ([llength $frames]-1)} {
+ uplevel [list set $variable $framepair]
+ } else {
+ uplevel [list set $variable [$framepair left]]
+ set framepair [$framepair right]
+ }
+ }
+
+ return $win
+}
+
diff --git a/hv/hv3_frameset.tcl b/hv/hv3_frameset.tcl
index 1424dd1..ee10a63 100644
--- a/hv/hv3_frameset.tcl
+++ b/hv/hv3_frameset.tcl
@@ -1,4 +1,4 @@
-namespace eval hv3 { set {version($Id: hv3_frameset.tcl,v 1.15 2007/09/18 11:27:46 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3_frameset.tcl,v 1.19 2008/02/09 18:14:20 danielk1977 Exp $)} 1 }
# This file contains code for implementing HTML frameset documents in Hv3.
#
@@ -23,8 +23,8 @@ namespace eval hv3 {
# Create a window name to use for a replaced object for node $node.
# The first argument is the name of an ::hv3::browser_frame widget.
#
- proc create_widget_name {browser_frame node} {
- return [[$browser_frame hv3] html].[string map {: _} $node]
+ proc create_widget_name {node} {
+ return [$node html].[string map {: _} $node]
}
proc multilength_to_list {multilength} {
@@ -49,7 +49,7 @@ namespace eval hv3 {
if {[$N tag] eq "frameset"} return
}
- set win [create_widget_name $browser_frame $node]
+ set win [create_widget_name $node]
::hv3::frameset $win $browser_frame $node
# The 'display' property of <frameset> elements is set to "none" by
@@ -75,7 +75,7 @@ namespace eval hv3 {
set hv3 [$browser_frame hv3]
# Create an ::hv3::browser_frame to display the resource.
- set panel [create_widget_name $browser_frame $node]
+ set panel [create_widget_name $node]
::hv3::browser_frame $panel [$browser_frame browser]
[[$panel hv3] html] configure -shrink 1
@@ -96,7 +96,7 @@ namespace eval hv3 {
if {0 == [$history loadframe $panel]} {
# Retrieve the URI for the resource to display in this <IFRAME>
set src [$node attribute -default "" src]
- if {$src ne ""} {
+ if {$src ne "" && [string range $src 0 0] ne "#"} {
set uri [[$browser_frame hv3] resolve_uri $src]
$panel goto $uri
}
@@ -107,6 +107,12 @@ namespace eval hv3 {
if {![string is boolean $scrolling]} { set scrolling auto }
$hv3 configure -scrollbarpolicy $scrolling
}
+ proc iframe_attr_handler {browser_frame node attr value} {
+ if {$attr eq "src"} {
+ set uri [[$browser_frame hv3] resolve_uri $value]
+ [$node replace] goto $uri
+ }
+ }
# get_markup --
#
@@ -295,7 +301,7 @@ snit::widget ::hv3::frameset {
# For a frameset, we need to create the equivalent HTML document.
set doc "<html>[::hv3::get_markup $pnode]</html>"
$phv3 seturi [$myHv3 resolve_uri "internal"]
- $phv3 parse -final $doc
+ $phv3 html parse -final $doc
}
}
}
@@ -327,6 +333,7 @@ snit::widget ::hv3::frameset {
destructor {
$myHv3 configure -scrollbarpolicy auto
bind [$myHv3 html] <Configure> ""
+ after cancel [list $self Sizecallback]
}
method ApplyFrameAttrs {pan node} {
diff --git a/hv/hv3_history.tcl b/hv/hv3_history.tcl
index 144df26..99c7fe4 100644
--- a/hv/hv3_history.tcl
+++ b/hv/hv3_history.tcl
@@ -1,4 +1,4 @@
-namespace eval hv3 { set {version($Id: hv3_history.tcl,v 1.26 2007/10/03 10:06:38 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3_history.tcl,v 1.34 2008/02/09 18:14:20 danielk1977 Exp $)} 1 }
package require snit
@@ -17,14 +17,6 @@ snit::type ::hv3::history_state {
variable myUri ""
variable myTitle ""
- # Values to use with [pathName xscroll|yscroll moveto] to restore
- # the previous scrollbar positions. Currently only the main browser
- # window scrollbar positions are restored, not the scrollbars used
- # by any <frame> or "overflow:scroll" elements.
- #
- variable myXscroll ""
- variable myYscroll ""
-
# Object member $myUri stores the URI of the top-level document loaded
# into the applicable browser window. However if that document is a
# frameset document a URI is required for each frame in the (possibly
@@ -46,10 +38,8 @@ snit::type ::hv3::history_state {
return [set $var]
}
- method uri {args} { return [$self Getset myUri $args] }
- method title {args} { return [$self Getset myTitle $args] }
- method xscroll {args} { return [$self Getset myXscroll $args] }
- method yscroll {args} { return [$self Getset myYscroll $args] }
+ method uri {args} { return [$self Getset myUri $args] }
+ method title {args} { return [$self Getset myTitle $args] }
# Retrieve the URI associated with the frame $positionid.
#
@@ -60,6 +50,13 @@ snit::type ::hv3::history_state {
return ""
}
+ method get_framedoc {positionid} {
+ if {[info exists myFrameUri($positionid)]} {
+ return [lindex $myFrameUri($positionid) 3]
+ }
+ return ""
+ }
+
method get_frameyview {positionid} {
if {[info exists myFrameUri($positionid)]} {
return [lindex $myFrameUri($positionid) 2]
@@ -69,15 +66,37 @@ snit::type ::hv3::history_state {
# Set an entry in the $myFrameUri array.
#
- method set_framestate {positionid uri xscroll yscroll} {
- set myFrameUri($positionid) [list $uri $xscroll $yscroll]
+ method set_framestate {positionid uri xscroll yscroll handle} {
+ if {$handle ne ""} {
+ if {
+ ![string match -nocase http* [$handle cget -uri]] ||
+ ![$handle isFinished]
+ } {
+ set handle ""
+ } else {
+ $handle reference
+ }
+ }
+ set current_handle [$self get_framedoc $positionid]
+ if {$current_handle ne ""} {
+ $current_handle release
+ }
+ set myFrameUri($positionid) [list $uri $xscroll $yscroll $handle]
}
# Clear the $myFrameUri array.
#
method clear_frameurilist {} {
+ foreach {k v} [array get myFrameUri] {
+ set handle [lindex $v 3]
+ catch {$handle release}
+ }
array unset myFrameUri
}
+
+ destructor {
+ $self clear_frameurilist
+ }
}
# class ::hv3::history
@@ -97,7 +116,6 @@ snit::type ::hv3::history {
variable myTitleVarName ""
variable myHv3 ""
- variable myProtocol ""
variable myBrowser ""
# The following two variables store the history list
@@ -125,14 +143,12 @@ snit::type ::hv3::history {
# Events:
# <<Goto>>
- # <<Complete>>
# <<SaveState>>
# <<Location>>
#
# Also there is a trace on "titlevar" (set whenever a <title> node is
# parsed)
#
-
constructor {hv3 protocol browser args} {
$hv3 configure -locationvar [myvar myLocationVar]
$self configurelist $args
@@ -141,12 +157,9 @@ snit::type ::hv3::history {
set myTitleVarName [$hv3 titlevar]
set myHv3 $hv3
- set myProtocol $protocol
set myBrowser $browser
- # bind $hv3 <<Reset>> +[list $self ResetHandler]
- # bind $hv3 <<Complete>> +[list $self CompleteHandler]
- bind $hv3 <<Location>> +[list $self Locvarcmd]
+ bind [$hv3 win] <<Location>> +[list $self Locvarcmd]
$self add_hv3 $hv3
# Initialise the state-list to contain a single, unconfigured state.
@@ -162,8 +175,8 @@ snit::type ::hv3::history {
}
method add_hv3 {hv3} {
- bind $hv3 <<Goto>> +[list $self GotoHandler]
- bind $hv3 <<SaveState>> +[list $self SaveStateHandler $hv3]
+ bind [$hv3 win] <<Goto>> +[list $self GotoHandler]
+ bind [$hv3 win] <<SaveState>> +[list $self SaveStateHandler $hv3]
}
method loadframe {frame} {
@@ -195,19 +208,6 @@ snit::type ::hv3::history {
}
}
- # This method is bound to the <<Complete>> event of the ::hv3::hv3
- # widget associated with this history-list. If the <<Complete>> is
- # issued because a history-seek is complete, then scroll the widget
- # to the stored horizontal and vertical offsets.
- #
- method CompleteHandler {} {
- if {$myHistorySeek >= 0} {
- set state [lindex $myStateList $myStateIdx]
- after idle [list $myHv3 yview moveto [$state yscroll]]
- after idle [list $myHv3 xview moveto [$state xscroll]]
- }
- }
-
# Invoked whenever our hv3 widget is reset (i.e. just before a new
# document is loaded) or when moving to a different #fragment within
# the same document. The current state of the widget should be copied
@@ -217,18 +217,16 @@ snit::type ::hv3::history {
set state [lindex $myStateList $myStateIdx]
# Update the current history-state record:
- $state xscroll [lindex [$myHv3 xview] 0]
- $state yscroll [lindex [$myHv3 yview] 0]
-
if {$myHistorySeek != $myStateIdx} {
$state clear_frameurilist
foreach frame [$myBrowser get_frames] {
set fhv3 [$frame hv3]
- set pos [$frame positionid]
+ set pos [$frame positionid]
$state set_framestate $pos \
[$fhv3 uri get] \
[lindex [$fhv3 xview] 0] \
- [lindex [$fhv3 yview] 0]
+ [lindex [$fhv3 yview] 0] \
+ [$fhv3 documenthandle]
}
}
@@ -274,10 +272,11 @@ snit::type ::hv3::history {
set pos [$browser_frame positionid]
set zUri [$state get_frameuri $pos]
+ set handle [$state get_framedoc $pos]
set zUriNow [$hv3 uri get]
$hv3 seek_to_yview [$state get_frameyview $pos]
- $hv3 goto $zUri -cachecontrol $myCacheControl
+ $hv3 goto $zUri -cachecontrol $myCacheControl -history_handle $handle
if {$zUriNow eq [$hv3 uri get]} {
foreach frame [$myBrowser get_frames] {
@@ -461,7 +460,7 @@ snit::widget ::hv3::locationentry {
static unsigned char v_bits[] = { 0xff, 0x7e, 0x3c, 0x18 };
}]
set myButton [button ${win}.button -image $myButtonImage -width 12]
- $myButton configure -command [list $self ButtonPress]
+ $myButton configure -command [list $self ButtonPress] -takefocus 0
pack $myButton -side right -fill y
pack $myEntry -fill both -expand true
@@ -473,8 +472,10 @@ snit::widget ::hv3::locationentry {
# Create the listbox for the drop-down list. This is a child of
# the same top-level as the ::hv3::locationentry widget...
#
- set myListbox [winfo toplevel $win][string map {. _} ${win}]
- ::hv3::scrolledlistbox $myListbox
+ set top [winfo toplevel $win]
+ if {$top eq "."} {set top ""}
+ set myListbox $top.[string map {. _} ${win}]
+ ::hv3::scrolledlistbox $myListbox -takefocus 0
# Any button-press anywhere in the GUI folds up the drop-down menu.
bind [winfo toplevel $win] <ButtonPress> +[list $self AnyButtonPress %W]
@@ -482,6 +483,7 @@ snit::widget ::hv3::locationentry {
bind $myEntry <KeyPress> +[list $self KeyPress]
bind $myEntry <KeyPress-Return> +[list $self KeyPressReturn]
bind $myEntry <KeyPress-Down> +[list $self KeyPressDown]
+ bind $myEntry <KeyPress-Tab> +noop
bind $myEntry <KeyPress-Escape> gui_escape
$myListbox configure -listvariable [myvar myListboxVar]
@@ -632,3 +634,54 @@ snit::widget ::hv3::locationentry {
}
}
+namespace eval ::hv3::httpcache {
+ proc new {me} {
+ set O(handles) [list]
+ }
+ proc destroy {me} {
+ upvar #0 $me O
+ foreach h $O(handles) {
+ $h release
+ }
+ rename $me ""
+ unset $me
+ }
+ proc add {me handle} {
+ upvar #0 $me O
+ lappend O(handles) $handle
+
+ set key cache.[$handle cget -uri]
+ if {[info exists O($key)]} {
+ set idx [lsearch $O(handles) $O($key)]
+ set O(handles) [lreplace $O(handles) $idx $idx]
+ }
+ set O($key) $handle
+
+ $handle reference
+ if {[llength $O(handles)]>=25} {
+ foreach h [lrange $O(handles) 0 4] {
+ unset O(cache.[$h cget -uri])
+ $h release
+ }
+ set O(handles) [lrange $O(handles) 5 end]
+ }
+ }
+ proc query {me handle} {
+ upvar #0 $me O
+ set uri [$handle cget -uri]
+ if {[info exists O(cache.$uri)]} {
+ set h $O(cache.$uri)
+ set idx [lsearch $O(handles) $h]
+ set O(handles) [lreplace $O(handles) $idx $idx]
+ lappend O(handles) $h
+ $handle finish [$h rawdata]
+ return 1
+ }
+ return 0
+ }
+}
+::hv3::make_constructor ::hv3::httpcache
+::hv3::httpcache ::hv3::the_httpcache
+
+proc noop {args} {}
+
diff --git a/hv/hv3_home.tcl b/hv/hv3_home.tcl
index 70a78b5..d96aa73 100644
--- a/hv/hv3_home.tcl
+++ b/hv/hv3_home.tcl
@@ -1,4 +1,4 @@
-namespace eval hv3 { set {version($Id: hv3_home.tcl,v 1.31 2007/10/03 10:06:38 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3_home.tcl,v 1.41 2008/02/02 17:15:02 danielk1977 Exp $)} 1 }
# Register the home: scheme handler with ::hv3::protocol $protocol.
#
@@ -7,87 +7,6 @@ proc ::hv3::home_scheme_init {hv3 protocol} {
$protocol schemehandler home [list ::hv3::home_request $protocol $hv3 $dir]
}
-proc ::hv3::create_domref {} {
-
- append doctop {
- <H1 class=title>Hv3 DOM Object Reference</H1><DIV class="toc">
- }
- foreach c [lsort [::hv3::dom2::classlist]] {
- append docmain [::hv3::dom2::document $c]
- append doctop [subst {
- <DIV class="tocentry"><A href="#${c}">$c</A></DIV>
- }]
- }
- append doctop {
- </DIV>
- <STYLE>
- H1 {
- clear:both;
- }
- H2 {
- margin-left: 1cm;
- }
- TABLE {
- width: 90%;
- margin-left: 2cm;
- }
- TD {
- vertical-align: top;
- padding: 0 5px;
- width: 100%;
- }
- .mode {
- width: auto;
- }
- TH {
- vertical-align: top;
- text-align: left;
- padding: 0 5px;
- background-color: #d9d9d9;
- white-space: nowrap;
- }
- UL {
- list-style-type: none;
- }
- .tocentry {
- float: left;
- width: 32ex;
- }
- .toc {
- margin-left: 2cm;
- overflow: auto;
- }
- .title {
- text-align: center;
- }
- .uri {
- margin-left: 1cm;
- }
- .nodocs {
- color: silver;
- }
- </STYLE>
-
- <P>
- This document is a reference to Hv3's version of the Document Object
- Model (DOM). It is generated by the DOM implementation
- itself and augmented by comments in the DOM source code. It is always
- available from within Hv3 itself by selecting the
- "Debug->DOM Reference..." menu option. The intended audience for
- this document already has a strong grasp of cross-browser DOM
- principles.
- </P>
-
- <P>
- Any hyperlinked documents (except for internal references to other
- parts of this document) are for informational purposes only. They
- are not part of Hv3 documentation.
- </P>
- }
- set ::hv3::dom::Documentation $doctop
- append ::hv3::dom::Documentation $docmain
-}
-
# When a URI with the scheme "home:" is requested, this proc is invoked.
#
proc ::hv3::home_request {http hv3 dir downloadHandle} {
@@ -97,6 +16,8 @@ proc ::hv3::home_request {http hv3 dir downloadHandle} {
set path [$obj path]
$obj destroy
+ set data {}
+
switch -exact -- $authority {
blank { }
@@ -109,7 +30,7 @@ proc ::hv3::home_request {http hv3 dir downloadHandle} {
append hv3_version "$t\n"
}
- set html [subst {
+ set data [subst {
<html> <head> </head> <body>
<h1>Tkhtml Source Code Versions</h1>
<pre>$tkhtml_version</pre>
@@ -117,12 +38,6 @@ proc ::hv3::home_request {http hv3 dir downloadHandle} {
<pre>$hv3_version</pre>
</body> </html>
}]
-
- $downloadHandle append $html
- }
-
- domref {
- $downloadHandle append $::hv3::dom::Documentation
}
bug {
@@ -132,9 +47,43 @@ proc ::hv3::home_request {http hv3 dir downloadHandle} {
]
}
- bookmarks_left { }
- bookmarks_right { }
+ dom {
+ if {$path eq "/style.css"} {
+ $downloadHandle append {
+ .overview {
+ margin: 0 20px;
+ }
+ .spacer {
+ width: 3ex;
+ background-color: white;
+ }
+
+ .refs A[href] { display:block }
+ .refs { padding-left: 1.5cm }
+ .superclass { font-style: italic; padding: 0 1.5cm; }
+ PRE { margin: 0 1.5cm }
+
+ .property,.method {
+ font-family: monospace;
+ white-space: nowrap;
+ }
+ TD { padding: 0 1ex; vertical-align: top;}
+ .stripe0 {
+ background-color: #EEEEEE;
+ }
+ }
+ } else {
+ set obj [string range $path 1 end]
+ set data [::hv3::DOM::docs::${obj}]
+ }
+ }
+ downloads {
+ ::hv3::the_download_manager request $downloadHandle
+ return
+ }
+
+ bookmarks_left { }
bookmarks {
if {$path eq "" || $path eq "/"} {
$downloadHandle append {
@@ -142,14 +91,15 @@ proc ::hv3::home_request {http hv3 dir downloadHandle} {
<FRAME src="home://bookmarks_left">
<FRAME src="home://bookmarks/folder/0">
}
+ ::hv3::bookmarks::ensure_initialized
after idle [list ::hv3::bookmarks::init [$downloadHandle cget -hv3]]
} else {
- $downloadHandle append [::hv3::bookmarks::requestpage $path]
+ set data [::hv3::bookmarks::requestpage $path]
}
}
}
- $downloadHandle finish
+ $downloadHandle finish $data
}
proc ::hv3::hv3_version {} {
diff --git a/hv/hv3_http.tcl b/hv/hv3_http.tcl
index db5458a..0f99f02 100644
--- a/hv/hv3_http.tcl
+++ b/hv/hv3_http.tcl
@@ -1,4 +1,4 @@
-namespace eval hv3 { set {version($Id: hv3_http.tcl,v 1.54 2007/10/07 16:30:08 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3_http.tcl,v 1.66 2008/02/09 18:14:20 danielk1977 Exp $)} 1 }
#
# This file contains implementations of the -requestcmd script used with
@@ -13,7 +13,7 @@ namespace eval hv3 { set {version($Id: hv3_http.tcl,v 1.54 2007/10/07 16:30:08 d
package require snit
package require Tk
-package require http
+package require http 2.7
catch { package require tls }
source [sourcefile hv3_file.tcl]
@@ -33,38 +33,41 @@ source [sourcefile hv3_file.tcl]
#
# $protocol destroy
#
-snit::type ::hv3::protocol {
+namespace eval ::hv3::protocol {
- # Lists of waiting and in-progress http URI download-handles.
- variable myWaitingHandles [list]
- variable myInProgressHandles [list]
+ proc new {me args} {
+ upvar $me O
- variable myTokenMap -array [list]
-
- # If not set to an empty string, contains the name of a global
- # variable to set to a short string describing the state of
- # the object. The string is always of the form:
- #
- # "X1 waiting, X2 in progress"
- #
- # where X1 and X2 are integers. An http request is said to be "waiting"
- # until the header identifying the mimetype is received, and "in progress"
- # from that point on until the resource has been completely retrieved.
- #
- option -statusvar -default "" -configuremethod ConfigureStatusvar
- option -relaxtransparency -default 0
+ # Lists of waiting and in-progress http URI download-handles.
+ set O(myWaitingHandles) [list]
+ set O(myInProgressHandles) [list]
- # Instance of ::hv3::cookiemanager. Right now this is a global object.
- # But this may change in the future. Hence this variable.
- #
- variable myCookieManager ""
+ set O(myQueue) [list]
- # Both built-in ("http" and "file") and any configured scheme handlers
- # (i.e. "home:") are stored in this array.
- variable mySchemeHandlers -array [list]
+ # If not set to an empty string, contains the name of a global
+ # variable to set to a short string describing the state of
+ # the object. The string is always of the form:
+ #
+ # "X1 waiting, X2 in progress"
+ #
+ # where X1 and X2 are integers. An http request is said to be "waiting"
+ # until the header identifying the mimetype is received, and "in progress"
+ # from that point on until the resource has been completely retrieved.
+ #
+ set O(-statusvar) ""
+ set O(-relaxtransparency) 0
- constructor {args} {
- $self configurelist $args
+ # Instance of ::hv3::cookiemanager. Right now this is a global object.
+ # But this may change in the future. Hence this variable.
+ #
+ set O(myCookieManager) ""
+
+ set O(myBytesExpected) 0
+ set O(myBytesReceived) 0
+
+ set O(myGui) ""
+
+ eval configure $me $args
# It used to be that each ::hv3::protocol object would create it's
# own cookie-manager database. This has now changed so that the
@@ -74,43 +77,47 @@ snit::type ::hv3::protocol {
#
# The global cookie-manager object is named "::hv3::the_cookie_manager".
#
- set myCookieManager ::hv3::the_cookie_manager
- if {[info commands $myCookieManager] eq ""} {
- ::hv3::cookiemanager $myCookieManager
+ set O(myCookieManager) ::hv3::the_cookie_manager
+ if {[info commands $O(myCookieManager)] eq ""} {
+ ::hv3::cookiemanager $O(myCookieManager)
}
# Register the 4 basic types of URIs the ::hv3::protocol code knows about.
- $self schemehandler file ::hv3::request_file
- $self schemehandler http [list $self request_http]
- $self schemehandler data [list $self request_data]
- $self schemehandler blank [list $self request_blank]
- $self schemehandler about [list $self request_blank]
+ schemehandler $me file ::hv3::request_file
+ schemehandler $me http [list $me request_http]
+ schemehandler $me data [list $me request_data]
+ schemehandler $me blank [list $me request_blank]
+ schemehandler $me about [list $me request_blank]
# If the tls package is loaded, we can also support https.
if {[info commands ::tls::socket] ne ""} {
- $self schemehandler https [list $self request_https]
- ::http::register https 443 [list ::hv3::protocol SSocket]
+ schemehandler $me https [list $me request_https]
+ ::http::register https 443 ::hv3::protocol::SSocket
}
# Configure the Tcl http package to pretend to be Gecko.
# ::http::config -useragent {Mozilla/5.0 Gecko/20050513}
- ::http::config -useragent {Mozilla/5.1 (X11; U; Linux i686; en-US; rv:1.8.0.3) Gecko/20060425 SUSE/1.5.0.3-7 Firefox/1.5.0.3}
+ ::http::config -useragent {Mozilla/5.1 (X11; U; Linux i686; en-US; rv:1.8.0.3) Gecko/20060425 SUSE/1.5.0.3-7 Hv3/alpha}
set ::http::defaultCharset utf-8
}
- destructor {
+ proc destroy {me} {
# Nothing to do. We used to destroy the $myCookieManager object here,
# but that object is now global and exists for the lifetime of the
# application.
+ array unset $me
+ rename $me {}
}
# Register a custom scheme handler command (like "home:").
- method schemehandler {scheme handler} {
- set mySchemeHandlers($scheme) $handler
+ proc schemehandler {me scheme handler} {
+ upvar $me O
+ set O(scheme.$scheme) $handler
}
# This method is invoked as the -requestcmd script of an hv3 widget
- method requestcmd {downloadHandle} {
+ proc requestcmd {me downloadHandle} {
+ upvar $me O
# Extract the URI scheme to figure out what kind of URI we are
# dealing with. Currently supported are "file" and "http" (courtesy
@@ -125,8 +132,8 @@ snit::type ::hv3::protocol {
# Execute the scheme-handler, or raise an error if no scheme-handler
# can be found.
- if {[info exists mySchemeHandlers($uri_scheme)]} {
- eval [concat $mySchemeHandlers($uri_scheme) $downloadHandle]
+ if {[info exists O(scheme.$uri_scheme)]} {
+ eval [concat $O(scheme.$uri_scheme) $downloadHandle]
} else {
error "Unknown URI scheme: \"$uri_scheme\""
}
@@ -134,23 +141,28 @@ snit::type ::hv3::protocol {
# Handle an http:// URI.
#
- method request_http {downloadHandle} {
+ proc request_http {me downloadHandle} {
+ upvar $me O
+ #puts "REQUEST: [$downloadHandle cget -uri]"
+
#$downloadHandle finish
#return
set uri [$downloadHandle cget -uri]
set postdata [$downloadHandle cget -postdata]
set enctype [$downloadHandle cget -enctype]
- set authority [$downloadHandle authority]
- # Knock any #fragment off the end of the URI.
- set obj [::tkhtml::uri $uri]
- set uri [$obj get_no_fragment]
- $obj destroy
+ if {[$downloadHandle cget -cachecontrol] eq "relax-transparency"
+ && [$downloadHandle cget -cacheable]
+ } {
+ if {[::hv3::the_httpcache query $downloadHandle]} {
+ return
+ }
+ }
# Store the HTTP header containing the cookies in variable $headers
set headers [$downloadHandle cget -requestheader]
- set cookies [$myCookieManager Cookie $uri]
+ set cookies [$O(myCookieManager) Cookie $uri]
if {$cookies ne ""} {
lappend headers Cookie $cookies
}
@@ -178,15 +190,29 @@ snit::type ::hv3::protocol {
default {
}
}
- if {$options(-relaxtransparency)} {
+ if {$O(-relaxtransparency)} {
lappend headers Cache-Control relax-transparency=1
}
+ # if {0 || ($::hv3::polipo::g(binary) ne ""
+ # && $postdata eq ""
+ # && ![string match -nocase https* $uri])
+ # } {
+ # $me AddToWaitingList $downloadHandle
+ # set p [::hv3::polipoclient %AUTO%]
+ # $downloadHandle finish_hook [list $p destroy]
+ # $downloadHandle finish_hook [list $me FinishRequest $downloadHandle]
+ # $p GET $me $downloadHandle
+ # return
+ # }
+
# Fire off a request via the http package.
+ # Always uses -binary mode.
set geturl [list ::http::geturl $uri \
- -command [list $self _DownloadCallback $downloadHandle] \
- -handler [list $self _AppendCallback $downloadHandle] \
+ -command [list $me _DownloadCallback $downloadHandle] \
+ -handler [list $me _AppendCallback $downloadHandle] \
-headers $headers \
+ -binary 1 \
]
if {$postdata ne ""} {
lappend geturl -query $postdata
@@ -195,29 +221,47 @@ snit::type ::hv3::protocol {
}
}
- set mimetype [$downloadHandle cget -mimetype]
- if {$mimetype ne "" && ![string match text* $mimetype]} {
- lappend geturl -binary 1
- }
-
-
set token [eval $geturl]
- $self AddToWaitingList $downloadHandle
- set myTokenMap($downloadHandle) $token
+ $me AddToWaitingList $downloadHandle
+ $downloadHandle finish_hook [list ::http::reset $token]
#puts "REQUEST $geturl -> $token"
}
- method AddToWaitingList {downloadHandle} {
- if {[lsearch -exact $myWaitingHandles $downloadHandle] >= 0} return
+ proc BytesReceived {me downloadHandle nByte} {
+ upvar $me O
+ set nExpected [$downloadHandle cget -expectedsize]
+ if {$nExpected ne ""} {
+ incr O(myBytesReceived) $nByte
+ }
+ $me Updatestatusvar
+ }
+ proc AddToProgressList {me downloadHandle} {
+ upvar $me O
+ set i [lsearch $O(myWaitingHandles) $downloadHandle]
+ set O(myWaitingHandles) [lreplace $O(myWaitingHandles) $i $i]
+ lappend O(myInProgressHandles) $downloadHandle
+
+ set nExpected [$downloadHandle cget -expectedsize]
+ if {$nExpected ne ""} {
+ incr O(myBytesExpected) $nExpected
+ }
+
+ $me Updatestatusvar
+ }
+
+ proc AddToWaitingList {me downloadHandle} {
+ upvar $me O
+
+ if {[lsearch -exact $O(myWaitingHandles) $downloadHandle] >= 0} return
# Add this handle the the waiting-handles list. Also add a callback
# to the -failscript and -finscript of the object so that it
# automatically removes itself from our lists (myWaitingHandles and
# myInProgressHandles) after the retrieval is complete.
#
- lappend myWaitingHandles $downloadHandle
- $downloadHandle destroy_hook [list $self FinishRequest $downloadHandle]
- $self Updatestatusvar
+ lappend O(myWaitingHandles) $downloadHandle
+ $downloadHandle finish_hook [list $me FinishRequest $downloadHandle]
+ $me Updatestatusvar
}
# The following methods:
@@ -230,7 +274,9 @@ snit::type ::hv3::protocol {
# along with the type variable $theWaitingSocket, are part of the
# https:// support implementation.
#
- method request_https {downloadHandle} {
+ proc request_https {me downloadHandle} {
+ upvar $me O
+
set obj [::tkhtml::uri [$downloadHandle cget -uri]]
set host [$obj authority]
$obj destroy
@@ -241,24 +287,28 @@ snit::type ::hv3::protocol {
set proxyhost [::http::config -proxyhost]
set proxyport [::http::config -proxyport]
- $self AddToWaitingList $downloadHandle
+ AddToWaitingList $me $downloadHandle
if {$proxyhost eq ""} {
set fd [socket -async $host $port]
- fileevent $fd writable [list $self SSocketReady $fd $downloadHandle]
+ fileevent $fd writable [list $me SSocketReady $fd $downloadHandle]
} else {
set fd [socket $proxyhost $proxyport]
fconfigure $fd -blocking 0 -buffering full
puts $fd "CONNECT $host:$port HTTP/1.1"
puts $fd ""
flush $fd
- fileevent $fd readable [list $self SSocketProxyReady $fd $downloadHandle]
+ fileevent $fd readable [list $me SSocketProxyReady $fd $downloadHandle]
}
}
- method SSocketReady {fd downloadHandle} {
+
+ proc SSocketReady {me fd downloadHandle} {
+ upvar $me O
+ ::variable theWaitingSocket
+
# There is now a tcp/ip socket connection to the https server ready
# to use. Invoke ::tls::import to add an SSL layer to the channel
- # stack. Then call [$self request_http] to format the HTTP request
+ # stack. Then call [$me request_http] to format the HTTP request
# as for a normal http server.
fileevent $fd writable ""
fileevent $fd readable ""
@@ -268,29 +318,52 @@ snit::type ::hv3::protocol {
# waiting for the SSL connection to be established.
close $fd
} else {
- set theWaitingSocket [::tls::import $fd]
- $self request_http $downloadHandle
+ set theWaitingSocket $fd
+ $me request_http $downloadHandle
}
}
- method SSocketProxyReady {fd downloadHandle} {
+ proc SSocketProxyReady {me fd downloadHandle} {
+ upvar $me O
+ fileevent $fd readable ""
+
set str [gets $fd line]
if {$line ne ""} {
if {! [regexp {^HTTP/.* 200} $line]} {
puts "ERRRORR!: $line"
close $fd
+ $downloadHandle finish [::hv3::string::htmlize $line]
return
}
while {[gets $fd r] > 0} {}
- $self SSocketReady $fd $downloadHandle
+ set fd [::tls::import $fd]
+ fconfigure $fd -blocking 0
+
+ set cmd [list $me SSocketReady $fd $downloadHandle]
+ SIfHandshake $fd $downloadHandle $cmd
+ # $me SSocketReady $fd $downloadHandle
+ }
+ }
+ proc SIfHandshake {fd downloadHandle script} {
+ if {[ catch { set done [::tls::handshake $fd] } msg]} {
+ $downloadHandle finish [::hv3::string::htmlize $msg]
+ return
+ }
+ if {$done} {
+ eval $script
+ } else {
+ after 100 [list ::hv3::protocol::SIfHandshake $fd $downloadHandle $script]
}
}
- typevariable theWaitingSocket ""
- typemethod SSocket {host port} {
+ # Namespace variable and proc.
+ ::variable theWaitingSocket ""
+ proc SSocket {host port} {
+ ::variable theWaitingSocket
set ss $theWaitingSocket
set theWaitingSocket ""
return $ss
}
+
# End of code for https://
#-------------------------
@@ -303,7 +376,9 @@ snit::type ::hv3::protocol {
# data := *urlchar
# parameter := attribute "=" value
#
- method request_data {downloadHandle} {
+ proc request_data {me downloadHandle} {
+ upvar $me O
+
set uri [$downloadHandle cget -uri]
set iData [expr [string first , $uri] + 1]
@@ -324,7 +399,9 @@ snit::type ::hv3::protocol {
$downloadHandle finish
}
- method request_blank {downloadHandle} {
+ # Namespace proc.
+ proc request_blank {me downloadHandle} {
+ upvar $me O
# Special case: blank://
if {[string first blank: [$downloadHandle cget -uri]] == 0} {
$downloadHandle append ""
@@ -333,88 +410,123 @@ snit::type ::hv3::protocol {
}
}
- method FinishRequest {downloadHandle} {
- if {[set idx [lsearch $myInProgressHandles $downloadHandle]] >= 0} {
- set myInProgressHandles [lreplace $myInProgressHandles $idx $idx]
+ proc FinishRequest {me downloadHandle} {
+ upvar $me O
+
+ if {[set idx [lsearch $O(myInProgressHandles) $downloadHandle]] >= 0} {
+ set O(myInProgressHandles) [lreplace $O(myInProgressHandles) $idx $idx]
+ }
+ if {[set idx [lsearch $O(myWaitingHandles) $downloadHandle]] >= 0} {
+ set O(myWaitingHandles) [lreplace $O(myWaitingHandles) $idx $idx]
}
- if {[set idx [lsearch $myWaitingHandles $downloadHandle]] >= 0} {
- set myWaitingHandles [lreplace $myWaitingHandles $idx $idx]
+ if {[set idx [lsearch $O(myQueue) $downloadHandle]] >= 0} {
+ set O(myQueue) [lreplace $O(myQueue) $idx $idx]
}
- if {[info exists myTokenMap($downloadHandle)]} {
- ::http::reset $myTokenMap($downloadHandle);
- unset myTokenMap($downloadHandle)
+ if {[llength $O(myWaitingHandles)]==0 && [llength $O(myInProgressHandles)]==0} {
+ set O(myBytesExpected) 0
+ set O(myBytesReceived) 0
}
- $self Updatestatusvar
+ $me Updatestatusvar
}
# Update the value of the -statusvar variable, if the -statusvar
# option is not set to an empty string.
- method Updatestatusvar {} {
- if {$options(-statusvar) ne ""} {
- set value "[llength $myWaitingHandles] waiting, "
- append value "[llength $myInProgressHandles] in progress"
- uplevel #0 [list set $options(-statusvar) $value]
+ proc Updatestatusvar {me} {
+ upvar $me O
+
+ if {$O(-statusvar) ne ""} {
+ set nWait [llength $O(myWaitingHandles)]
+ set nProgress [llength $O(myInProgressHandles)]
+ if {$nWait > 0 || $nProgress > 0} {
+ set f ?
+ if {$O(myBytesExpected) > 0} {
+ set f [expr {$O(myBytesReceived)*100/$O(myBytesExpected)}]
+ }
+ set value [list $nWait $nProgress $f]
+ } else {
+ set value [list]
+ }
+
+ uplevel #0 [list set $O(-statusvar) $value]
}
- catch {$myGui populate}
+ catch {$O(myGui) populate}
}
- method busy {} {
- return [expr [llength $myWaitingHandles] + [llength $myInProgressHandles]]
+ proc busy {me} {
+ upvar $me O
+ return [expr [llength $O(myWaitingHandles)] + [llength $O(myInProgressHandles)]]
}
# Invoked to set the value of the -statusvar option
- method ConfigureStatusvar {option value} {
- set options($option) $value
- $self Updatestatusvar
+ proc configure-statusvar {me} {
+ Updatestatusvar $me
}
# Invoked when data is available from an http request. Pass the data
# along to hv3 via the downloadHandle.
#
- method _AppendCallback {downloadHandle socket token} {
+ proc _AppendCallback {me downloadHandle socket token} {
+ upvar $me O
+
upvar \#0 $token state
# If this download-handle is still in the myWaitingHandles list,
# process the http header and move it to the in-progress list.
- if {0 <= [set idx [lsearch $myWaitingHandles $downloadHandle]]} {
+ if {0 <= [set idx [lsearch $O(myWaitingHandles) $downloadHandle]]} {
# Remove the entry from myWaitingHandles.
- set myWaitingHandles [lreplace $myWaitingHandles $idx $idx]
+ set O(myWaitingHandles) [lreplace $O(myWaitingHandles) $idx $idx]
# Copy the HTTP header to the -header option of the download handle.
$downloadHandle configure -header $state(meta)
# Add the handle to the myInProgressHandles list and update the
# status report variable.
- lappend myInProgressHandles $downloadHandle
- $self Updatestatusvar
+ lappend O(myInProgressHandles) $downloadHandle
+
+ set nExpected [$downloadHandle cget -expectedsize]
+ if {$nExpected ne ""} {
+ incr O(myBytesExpected) $nExpected
+ }
}
- set data [read $socket 2048]
+ set data [read $socket]
set rc [catch [list $downloadHandle append $data] msg]
if {$rc} { puts "Error: $msg $::errorInfo" }
set nbytes [string length $data]
+
+ set nExpected [$downloadHandle cget -expectedsize]
+ if {$nExpected ne ""} {
+ incr O(myBytesReceived) $nbytes
+ }
+
+ $me Updatestatusvar
+
return $nbytes
}
# Invoked when an http request has concluded.
#
- method _DownloadCallback {downloadHandle token} {
-#puts "FINISH [$downloadHandle uri]"
+ proc _DownloadCallback {me downloadHandle token} {
+ upvar $me O
if {
- [lsearch $myInProgressHandles $downloadHandle] >= 0 ||
- [lsearch $myWaitingHandles $downloadHandle] >= 0
+ [lsearch $O(myInProgressHandles) $downloadHandle] >= 0 ||
+ [lsearch $O(myWaitingHandles) $downloadHandle] >= 0
} {
- catch {$myGui uri_done [$downloadHandle cget -uri]}
- $downloadHandle finish
+ catch {$O(myGui) uri_done [$downloadHandle cget -uri]}
+ if {[$downloadHandle cget -cacheable]} {
+ ::hv3::the_httpcache add $downloadHandle
+ }
}
+ catch { $downloadHandle finish }
::http::cleanup $token
}
- method debug_cookies {} {
- $myCookieManager debug
+ proc debug_cookies {me} {
+ upvar $me O
+ $O(myCookieManager) debug
}
# gui --
@@ -424,21 +536,25 @@ snit::type ::hv3::protocol {
# window named $name suitable to [pack] in with the main browser
# window.
#
- variable myGui ""
- method gui {name} {
- catch {destroy $myGui}
- ::hv3::protocol_gui $name $self
- set myGui $name
+ proc gui {me name} {
+ upvar $me O
+ catch {destroy $O(myGui)}
+ ::hv3::protocol_gui $name $me
+ set O(myGui) $name
}
- method waiting_handles {} {
- return $myWaitingHandles
+ proc waiting_handles {me} {
+ upvar $me O
+ return $O(myWaitingHandles)
}
- method inprogress_handles {} {
- return $myInProgressHandles
+ proc inprogress_handles {me} {
+ upvar $me O
+ return $O(myInProgressHandles)
}
}
+::hv3::make_constructor ::hv3::protocol
+
snit::widget ::hv3::protocol_gui {
variable myProtocol ""
@@ -489,497 +605,35 @@ snit::widget ::hv3::protocol_gui {
}
}
+#-----------------------------------------------------------------------
+# Work around a bug in http::Finish
#
-# ::hv3::filedownload
-#
-# Each currently downloading file is managed by an instance of the
-# following object type. All instances in the application are managed
-# by the [::hv3::the_download_manager] object, an instance of
-# class ::hv3::downloadmanager (see below).
-#
-# SYNOPSIS:
-#
-# set obj [::hv3::filedownload %AUTO% ?OPTIONS?]
-#
-# $obj set_destination $PATH
-# $obj append $DATA
-# $obj finish
-#
-# Options are:
-#
-# Option Default Summary
-# -------------------------------------
-# -source "" Source of download (for display only)
-# -cancelcmd "" Script to invoke to cancel the download
-#
-snit::type ::hv3::filedownload {
-
- # The destination path (in the local filesystem) and the corresponding
- # tcl channel (if it is open). These two variables also define the
- # three states that this object can be in:
- #
- # INITIAL:
- # No destination path has been provided yet. Both myDestination and
- # myChannel are set to an empty string.
- #
- # STREAMING:
- # A destination path has been provided and the destination file is
- # open. But the download is still in progress. Neither myDestination
- # nor myChannel are set to an empty string.
- #
- # FINISHED:
- # A destination path is provided and the entire download has been
- # saved into the file. We're just waiting for the user to dismiss
- # the GUI. In this state, myChannel is set to an empty string but
- # myDestination is not.
- #
- variable myDestination ""
- variable myChannel ""
-
- # Buffer for data while waiting for a file-name. This is used only in the
- # state named INITIAL in the above description. The $myIsFinished flag
- # is set to true if the download is finished (i.e. [finish] has been
- # called).
- variable myBuffer ""
- variable myIsFinished 0
-
- option -source -default ""
- option -cancelcmd -default ""
- option -updateguicmd -default ""
-
- # Total bytes downloaded so far.
- variable myDownloaded 0
-
- # Total bytes expected (i.e. size of the download)
- variable myExpected 0
-
- constructor {args} {
- $self configurelist $args
- }
-
- method set_destination {dest isFinished} {
- if {$isFinished} {
- set myIsFinished 1
- }
-
- # It is an error if this method has been called before.
- if {$myDestination ne ""} {
- error "This ::hv3::filedownloader already has a destination!"
- }
-
- if {$dest eq ""} {
- # Passing an empty string to this method cancels the download.
- # This is for conveniance, because [tk_getSaveFile] returns an
- # empty string when the user selects "Cancel".
- $self Cancel
- destroy $self
- } else {
- # Set the myDestination variable and open the channel to the
- # file to write. Todo: An error could occur opening the file.
- set myDestination $dest
- set myChannel [open $myDestination w]
- fconfigure $myChannel -encoding binary -translation binary
-
- # If a buffer has accumulated, write it to the new channel.
- puts -nonewline $myChannel $myBuffer
- set myBuffer ""
-
- # If the myIsFinished flag is set, then the entire download
- # was already in the buffer. We're finished.
- if {$myIsFinished} {
- $self finish {} {}
- }
-
- ::hv3::the_download_manager manage $self
- }
- }
-
- # This internal method is called to cancel the download. When this
- # returns the object will have been destroyed.
- #
- method Cancel {} {
- # Evaluate the -cancelcmd script and destroy the object.
- eval $options(-cancelcmd)
- if {$myDestination ne ""} {
- catch {close $myChannel}
- catch {file delete $myDestination}
- }
- }
-
- # Update the GUI to match the internal state of this object.
- #
- method Updategui {} {
- if {$options(-updateguicmd) ne ""} {
- eval $options(-updateguicmd)
- }
- }
-
- method append {handle data} {
- set myExpected [$handle cget -expectedsize]
- if {$myChannel ne ""} {
- puts -nonewline $myChannel $data
- set myDownloaded [file size $myDestination]
- } else {
- append myBuffer $data
- set myDownloaded [string length $myBuffer]
- }
- $self Updategui
- }
- # Called by the driver download-handle when the download is
- # complete. All the data will have been already passed to [append].
- #
- method finish {handle data} {
- if {$data ne ""} {
- $self append $handle $data
- }
-
- # If the channel is open, close it. Also set the button to say "Ok".
- if {$myChannel ne ""} {
- close $myChannel
- set myChannel ""
- }
-
- # If myIsFinished flag is not set, set it and then set myElapsed to
- # indicate the time taken by the download.
- if {!$myIsFinished} {
- set myIsFinished 1
- }
-
- # Update the GUI.
- $self Updategui
-
- # Delete the download request.
- if {$handle ne ""} {
- $handle destroy
- }
- }
-
- destructor {
- catch { close $myChannel }
- }
-
- # Query interface used by ::hv3::downloadmanager GUI. It cares about
- # four things:
- #
- # * the percentage of the download has been completed, and
- # * the state of the download (either "Downloading" or "Finished").
- # * the source URI
- # * the destination file
- #
- method state {} {
- if {$myIsFinished} {return "Finished"}
- return "Downloading"
- }
- method percentage {} {
- if {$myIsFinished} {return 100}
- if {$myExpected eq "" || $myExpected == 0} {
- return [expr {$myDownloaded > 0 ? 50 : 0}]
- }
- return [expr double($myDownloaded) / double($myExpected) * 100]
- }
- method bytes {} {
- return $myDownloaded
- }
- method source {} {
- return $options(-source)
- }
- method destination {} {
- return $myDestination
- }
-}
-
-# ::hv3::downloadmanager
-#
-# SYNOPSIS
+# UPDATE: This bug was a leaking file-descriptor. However, it seems to
+# have been fixed somewhere around version 2.7. So the [package require]
+# at the top of this file has been changed to require at least version
+# 2.7 and the workaround code commented out.
#
-# set obj [::hv3::downloadmanager %AUTO%]
-#
-# $obj show
-# $obj manage FILE-DOWNLOAD
-#
-# destroy $obj
-#
-snit::type ::hv3::downloadmanager {
- variable myDownloads [list]
- variable myHv3List [list]
-
- method manage {filedownload} {
- $filedownload configure -updateguicmd [list $self UpdateGui $filedownload]
- lappend myDownloads $filedownload
- $self CheckGuiList
- foreach hv3 $myHv3List {
- $hv3 goto download: -cachecontrol no-cache
- }
- }
-
- # This is a helper proc for method [savehandle] to extract any
- # filename-parameter from the value of an HTTP Content-Disposition
- # header. If one exists, the value of the filename parameter is
- # returned. Otherwise, an empty string.
- #
- # Refer to RFC1806 for the complete format of a Content-Disposition
- # header. An example is:
- #
- # {inline ; filename="src.tar.gz"}
- #
- proc ParseContentDisposition {value} {
- set tokens [::hv3::string::tokenise $value]
-
- set filename ""
- for {set ii 0} {$ii < [llength $tokens]} {incr ii} {
- set t [lindex $tokens $ii]
- set t2 [lindex $tokens [expr $ii+1]]
-
- if {[string match -nocase $t "filename"] && $t2 eq "="} {
- set filename [lindex $tokens [expr $ii+2]]
- set filename [::hv3::string::dequote $filename]
- break
- }
- }
-
- return $filename
- }
-
- # Activate the download manager to save the resource targeted by the
- # ::hv3::download passed as an argument ($handle) to the local
- # file-system. It is the responsbility of the caller to configure
- # the download-handle and pass it to the protocol object. The second
- # argument, $data, contains an initial segment of the resource that has
- # already been downloaded.
- #
- method savehandle {handle data {isFinished 0}} {
-
- # Create a GUI to handle this download
- set dler [::hv3::filedownload %AUTO% \
- -source [$handle cget -uri] \
- -cancelcmd [list catch [list $handle destroy]] \
- ]
- ::hv3::the_download_manager show
-
- # Redirect the -incrscript and -finscript commands to the download GUI.
- $handle configure -finscript [list $dler finish $handle]
- $handle configure -incrscript [list $dler append $handle]
- $dler append $handle $data
-
- # Figure out a default file-name to suggest to the user. This
- # is one of the following (in order of preference):
- #
- # 1. The "filename" field from a Content-Disposition header. The
- # content disposition header is described in RFC 1806 (and
- # later RFC 2183). A Content-Disposition header looks like
- # this:
- #
- # 2. By extracting the tail of the URI.
- #
- set suggested ""
- foreach {key value} [$handle cget -header] {
- if {[string equal -nocase $key Content-Disposition]} {
- set suggested [ParseContentDisposition $value]
- }
- }
- if {$suggested eq ""} {
- regexp {/([^/]*)$} [$handle cget -uri] -> suggested
- }
-
- # Pop up a GUI to select a "Save as..." filename. Schedule this as
- # a background job to avoid any recursive entry to our event handles.
- set cmd [subst -nocommands {
- $dler set_destination [file normal [
- tk_getSaveFile -initialfile {$suggested}
- ]] $isFinished
- }]
- after idle $cmd
- }
-
- method CheckGuiList {} {
- # Make sure the list of GUI's is up to date.
- set newlist [list]
- foreach hv3 $myHv3List {
- if {[info commands $hv3] eq ""} continue
- if {[string match download* [$hv3 location]] && [$hv3 pending] == 0} {
- lappend newlist $hv3
- }
- }
- set myHv3List $newlist
- }
-
- method UpdateGui {{fdownload ""}} {
-# puts "UPDATE $fdownload"
-
- $self CheckGuiList
-
- set dl_list $fdownload
- if {[llength $dl_list] == 0} {
- set dl_list $myDownloads
- }
- foreach filedownload $dl_list {
- set id [string map {: _} $filedownload]
- foreach hv3 $myHv3List {
-
- set search "#$id .progressbar"
- foreach N [$hv3 search $search] {
- $N override [list width [$filedownload percentage]%]
- }
- set search "#$id .downloading"
- set val visible
- if {[$filedownload state] eq "Finished"} {
- set val hidden
- }
- foreach N [$hv3 search $search] {
- $N override [list visibility $val]
- }
-
- set val hidden
- if {[$filedownload state] eq "Finished"} {
- set val visible
- }
- set search "#$id .finished"
- foreach N [$hv3 search $search] {
- $N override [list visibility $val]
- }
-
- set search "#$id .button"
- foreach N [$hv3 search $search] {
- set a(Finished) Dismiss
- set a(Downloading) Cancel
- $N attr value $a([$filedownload state])
- }
-
- set search "#$id .status span"
- foreach N [$hv3 search $search] {
- set percent [format %.2f%s [$filedownload percentage] %]
- set bytes [$filedownload bytes]
- switch -- [$filedownload state] {
- Downloading { set status "Downloaded $bytes bytes ($percent)" }
- Finished { set status "Finished ($bytes bytes)" }
- }
- $N attr spancontent $status
- }
- }
- }
- }
-
- method request {hv3 handle} {
-
- set uri [$handle cget -uri]
- if {[regexp {.*delete=([^=&]*)} $uri -> delete]} {
- set dl [string map {__ ::} $delete]
- set newlist [list]
- foreach download $myDownloads {
- if {$download ne $dl} {lappend newlist $download}
- }
- set myDownloads $newlist
- catch {
- if {[$dl state] ne "Finished"} {
- $dl Cancel
- }
- $dl destroy
- }
- $handle append ""
- $handle finish
- $self CheckGuiList
- foreach hv3 $myHv3List {
- after idle [list $hv3 goto download: -cachecontrol no-cache]
- }
- return
- }
-
- set document {
- <html><head>
- <style>
- .download { border:solid black 1px; width:90%; margin: 1em auto; }
- .download td { padding: 0px 5px; }
- .source { width:99%; }
- .progress .progressbarwrapper { border:solid black 1px; width:100%; }
- .progress .progressbar { background-color: navy; height: 1em; }
- .buttons { display:block;width:12ex }
- input { float:right; }
- </style>
- <title>Downloads</title>
- </head>
- <body>
- <h1 align=center>Downloads</h1>
- }
-
- append document "<p>There are [llength $myDownloads] downloads.</p>"
-
- foreach download $myDownloads {
- set id [string map {: _} $download]
- append document [subst {
- <table class="download" id="$id">
- <tr><td>Source:
- <td class="source">[$download source]
- <td rowspan=4 valign=bottom>
- <div class="buttons">
- <form method=get action=download:///>
- <input class="button" type=submit value=Cancel>
- <input name="delete" type=hidden value=$id>
- </form>
- <tr><td>Destination:
- <td class="destination">[$download destination]
- <tr><td>Status:
- <td class="status">
- <span spancontent="Waiting (0%)">
- </td>
- <tr><td>Progress:
- <td class="progress">
- <div class="progressbarwrapper">
- <div class="progressbar">
- </table>
- }]
- }
-
- if {[lsearch $myHv3List $hv3] < 0} {
- lappend myHv3List $hv3
- }
-
- $handle append $document
- $handle finish
-
- after idle [list $self UpdateGui]
- }
-
- method show {} {
- $self CheckGuiList
- if {[llength $myHv3List] > 0} {
- set hv3 [lindex $myHv3List 0]
- set win [winfo parent [winfo parent $hv3]]
- .notebook.notebook select $win
- } else {
- .notebook add download:
+if 0 {
+ # First, make sure the http package is actually loaded. Do this by
+ # invoking ::http::geturl. The call will fail, since the arguments (none)
+ # passed to ::http::geturl are invalid.
+ catch {::http::geturl}
+
+ # Declare a wrapper around ::http::Finish
+ proc ::hv3::HttpFinish {token args} {
+ upvar 0 $token state
+ catch {
+ close $state(sock)
+ unset state(sock)
}
+ eval [linsert $args 0 ::http::FinishReal $token]
}
+
+ # Install the wrapper.
+ rename ::http::Finish ::http::FinishReal
+ rename ::hv3::HttpFinish ::http::Finish
}
-
-proc ::hv3::download_scheme_init {hv3 protocol} {
- $protocol schemehandler download [
- list ::hv3::the_download_manager request $hv3
- ]
-}
-
-#-----------------------------------------------------------------------
-# Work around a bug in http::Finish
-#
-
-# First, make sure the http package is actually loaded. Do this by
-# invoking ::http::geturl. The call will fail, since the arguments (none)
-# passed to ::http::geturl are invalid.
-catch {::http::geturl}
-
-# Declare a wrapper around ::http::Finish
-proc ::hv3::HttpFinish {token args} {
- upvar 0 $token state
- catch {
- close $state(sock)
- unset state(sock)
- }
- eval [linsert $args 0 ::http::FinishReal $token]
-}
-
-# Install the wrapper.
-rename ::http::Finish ::http::FinishReal
-rename ::hv3::HttpFinish ::http::Finish
#-----------------------------------------------------------------------
diff --git a/hv/hv3_icons.tcl b/hv/hv3_icons.tcl
index 60feec5..52ada5e 100644
--- a/hv/hv3_icons.tcl
+++ b/hv/hv3_icons.tcl
@@ -1,6 +1,23 @@
-namespace eval hv3 { set {version($Id: hv3_icons.tcl,v 1.5 2007/09/17 14:22:39 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3_icons.tcl,v 1.8 2008/02/09 18:14:20 danielk1977 Exp $)} 1 }
-set ::hv3::back_icon {
+# Define the icons used for tool-buttons:
+#
+# hv3_previmg
+# hv3_nextimg
+# hv3_stopimg
+# hv3_newimg
+# hv3_homeimg
+# hv3_reloadimg
+# hv3_bugimg
+#
+
+namespace eval ::hv3 {
+ proc default_icons {} {
+ if {[catch color_icons32]} grey_icons
+ }
+ proc grey_icons {} {
+
+ image create photo hv3_previmg -data {
R0lGODlhHgAeANUzAOHh4eLi4uTk5PDw8N3d3dDQ0NfX1+Dg4Ofn5/Hx8fT0
9PLy8tvb29TU1NXV1eXl5e3t7e/v7+Pj4+bm5u7u7tra2t7e3tLS0vf39+jo
6N/f39PT09zc3Orq6tnZ2dbW1tjY2Ovr6/b29vX19fj4+Pn5+ezs7Onp6fr6
@@ -17,7 +34,7 @@ g1at069gw6KhSkmZBxgu7LJt6zZmob7yDPRb+5RwYTST5CYW3Dhv3kQwEFvb
2rWy5RZ3Yr4YTbq06dOnYczYx7q161UzggAAOw==
}
-set ::hv3::forward_icon {
+ image create photo hv3_nextimg -data {
R0lGODlhHgAeANUzAN3d3eHh4eLi4tzc3Nvb29PT09DQ0PHx8fDw8Nra2ufn
5+Tk5PT09PLy8uzs7NLS0uvr6+rq6t7e3uPj49nZ2ebm5u3t7ff399/f3+Dg
4OXl5djY2O/v79fX1+jo6O7u7vX19dbW1unp6fb29vj4+Pn5+dXV1dTU1Pr6
@@ -34,7 +51,7 @@ qRYoW7ESC8VV1wEh07t40UySyhfhiboGAAdOs7de34SIFbe4I/GF5cuYM2vW
DGMGv8+gQ7OaEQQAOw==
}
-set ::hv3::stop_icon {
+ image create photo hv3_stopimg -data {
R0lGODlhHgAeANUzAOrq6tra2tnZ2ejo6NDQ0NTU1NfX19jY2Ovr6+3t7efn
59vb29bW1vf399HR0dXV1e7u7uLi4vHx8enp6fDw8NPT0+Hh4eDg4Ozs7Pb2
9u/v793d3fLy8vT09OPj4/X19dLS0vj4+Pn5+d7e3tzc3Obm5uTk5Pr6+vv7
@@ -51,7 +68,7 @@ WmkEsLLzOtqc+zWWXVp44Zp0kLaF4cN3EL5YzLix48ePYcyAQbmy5cuYM88I
AgA7
}
-set ::hv3::new_icon {
+ image create photo hv3_newimg -data {
R0lGODlhHgAeAOZWANra2urq6uPj4+Dg4OLi4tbW1tvb26+vr+fn59XV1dLS
0tzc3NnZ2evr6+3t7fDw8NjY2N7e3ujo6NDQ0NPT0/Hx8eXl5fLy8vT09O/v
7+bm5uzs7O7u7t/f3/f39+np6fPz83t7e4eHh/b29vX19fj4+JiYmPn5+fr6
@@ -74,7 +91,7 @@ v0tLfGiF5imj964+WSj3GSebna++/t1axrw3lXzNTUCff6gUQ41U+nHn3IEI
VjGNgA3OB2GEVCwI03kFXhjFLXdJIeKIJJZooolUWEHFiiy26OKLMFoRCAA7
}
-set ::hv3::home_icon {
+ image create photo hv3_homeimg -data {
R0lGODlhHgAeANUzAOTk5OHh4ePj4+bm5urq6uDg4OXl5efn593d3dTU1OLi
4vDw8PHx8dHR0d/f397e3unp6fT09Nra2ujo6PLy8u/v79zc3Nvb2/f399XV
1fPz89fX19PT09nZ2djY2NbW1tLS0vb29uvr6/X19e7u7vj4+O3t7dDQ0Pn5
@@ -92,35 +109,407 @@ wllGY7toKD3o3PlzIhiVqLGMu/RE4M93Kr6YTbu27du3YcyAwbu379/Ag88I
AgA7
}
-set ::hv3::reload_icon {
-R0lGODlhHgAeANUzAObm5uLi4uPj4+fn593d3eXl5eHh4dzc3ODg4PHx8dPT
-09DQ0Ojo6PT09NLS0t7e3vLy8t/f3/f39+rq6tra2vDw8PPz89XV1dbW1u3t
-7evr69vb29nZ2dfX1/X19e7u7tjY2Onp6fb29uzs7Pj4+Pn5+fr6+u/v7/v7
-+/39/fz8/OTk5NTU1NHR0c/Pz8HBwX9/f////5ubm////wAAAAAAAAAAAAAA
-AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAADMALAAAAAAeAB4AAAb/
-wJlsSCwaj0hhLKVCmUokicjTsEASlU9mpJkwBoCVIGB4wWQxmBMqpVqxWq4X
-LCbDzOh1dFq9ZrddXwAFYwYID3gxT3tufnGBYIRkhwSJbHxvFSeAc4MrkxEE
-B4lREo1YRJCeoKIbiRKmfQlGEyGRn4ahBxsUryKyR7arQ7q8HIm/b0i3AUW7
-FBwgiQ0NV8vDRtAgHdN+RsIFYkgy2xiJ3kXg4uMyGBeJWCdGDJ4C7EQsiZof
-RfThArkeECjSwR2LfGdinNBSpF5AUUUMslCQSIsGI2IeHjBy4aACB4kydDEy
-BkEEgQcoGPHooEWiEbUYGDGJUmURli1cJow5AAnEcSMTW7ZYkCjEl3D3bn7M
-ucBFoqN1ksoIytSF04R0CkW4R3Wo1atowmhFeaTjUq9fE9UxhNJYObNCFzRN
-m7AQpWfRCsJlOpcumklttentKver3zR33Q4+W9iwizsJX0ieTLmyZcswZsDY
-zLmz58+gZwQBADs=
-}
-
-set ::hv3::bug_icon {
-R0lGODlhHQAdANUvAPX19fT09PLy8vb29vDw8O7u7t/f3/f39+/v7/Hx8fj4
-+Orq6uTk5Nra2uHh4fn5+ePj4+np6ejo6Ozs7OLi4u3t7dvb29jY2NXV1dzc
-3OXl5dnZ2ebm5t7e3tPT0+vr69TU1ODg4Ofn59bW1tfX19HR0dLS0tDQ0M/P
-z/r6+vPz893d3Zubm39/f////////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
-AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAC8ALAAAAAAdAB0AAAb/
-wJdwSByyWsWkcvk6Mp9KVuqBhFqbD0X1ypQqDoMtN8nKDgDisTF7AAQEaXUZ
-HFAl4tyy4qwSEAp4Vixfbn4IFYFPLC57LY4tKhMLiUuLbS0smSofEZRkLnSY
-mgsSHJ5Ei3yiLCoRIhqnQpaFqyqvDBSxqXV3mawcDBAOp6kAfQS1GsIGHZ6L
-hQQItbghBistK10uA7wIgL4qyysZDYnPxwWI4BQhHRkWG9hR228Jhx+kwOzW
-Fg0XI3jOJfgjyZUyB8zIbSCBQR4qF9DScXoEqcMKeP8weEizqFsBSRJqXfTH
-EMTGbLIgoiv4apm7BgtHmDRRYktHQxU4laLGb0NGKBA0T8hr4cKFHW8ggYkj
-d6GkhxInUKDARrGq1atWUa7YyrWr169fgwAAOw==
+ image create photo hv3_reloadimg -data {
+ R0lGODlhHgAeANUzAObm5uLi4uPj4+fn593d3eXl5eHh4dzc3ODg4PHx8dPT
+ 09DQ0Ojo6PT09NLS0t7e3vLy8t/f3/f39+rq6tra2vDw8PPz89XV1dbW1u3t
+ 7evr69vb29nZ2dfX1/X19e7u7tjY2Onp6fb29uzs7Pj4+Pn5+fr6+u/v7/v7
+ +/39/fz8/OTk5NTU1NHR0c/Pz8HBwX9/f////5ubm////wAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAADMALAAAAAAeAB4AAAb/
+ wJlsSCwaj0hhLKVCmUokicjTsEASlU9mpJkwBoCVIGB4wWQxmBMqpVqxWq4X
+ LCbDzOh1dFq9ZrddXwAFYwYID3gxT3tufnGBYIRkhwSJbHxvFSeAc4MrkxEE
+ B4lREo1YRJCeoKIbiRKmfQlGEyGRn4ahBxsUryKyR7arQ7q8HIm/b0i3AUW7
+ FBwgiQ0NV8vDRtAgHdN+RsIFYkgy2xiJ3kXg4uMyGBeJWCdGDJ4C7EQsiZof
+ RfThArkeECjSwR2LfGdinNBSpF5AUUUMslCQSIsGI2IeHjBy4aACB4kydDEy
+ BkEEgQcoGPHooEWiEbUYGDGJUmURli1cJow5AAnEcSMTW7ZYkCjEl3D3bn7M
+ ucBFoqN1ksoIytSF04R0CkW4R3Wo1atowmhFeaTjUq9fE9UxhNJYObNCFzRN
+ m7AQpWfRCsJlOpcumklttentKver3zR33Q4+W9iwizsJX0ieTLmyZcswZsDY
+ zLmz58+gZwQBADs=
+ }
+
+ image create photo hv3_bugimg -data {
+ R0lGODlhHQAdANUvAPX19fT09PLy8vb29vDw8O7u7t/f3/f39+/v7/Hx8fj4
+ +Orq6uTk5Nra2uHh4fn5+ePj4+np6ejo6Ozs7OLi4u3t7dvb29jY2NXV1dzc
+ 3OXl5dnZ2ebm5t7e3tPT0+vr69TU1ODg4Ofn59bW1tfX19HR0dLS0tDQ0M/P
+ z/r6+vPz893d3Zubm39/f////////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAC8ALAAAAAAdAB0AAAb/
+ wJdwSByyWsWkcvk6Mp9KVuqBhFqbD0X1ypQqDoMtN8nKDgDisTF7AAQEaXUZ
+ HFAl4tyy4qwSEAp4Vixfbn4IFYFPLC57LY4tKhMLiUuLbS0smSofEZRkLnSY
+ mgsSHJ5Ei3yiLCoRIhqnQpaFqyqvDBSxqXV3mawcDBAOp6kAfQS1GsIGHZ6L
+ hQQItbghBistK10uA7wIgL4qyysZDYnPxwWI4BQhHRkWG9hR228Jhx+kwOzW
+ Fg0XI3jOJfgjyZUyB8zIbSCBQR4qF9DScXoEqcMKeP8weEizqFsBSRJqXfTH
+ EMTGbLIgoiv4apm7BgtHmDRRYktHQxU4laLGb0NGKBA0T8hr4cKFHW8ggYkj
+ d6GkhxInUKDARrGq1atWUa7YyrWr169fgwAAOw==
+ }
+
+ }
+
+
+proc color_icons22 {} {
+image create photo hv3_reloadimg -data {
+iVBORw0KGgoAAAANSUhEUgAAABYAAAAWCAYAAADEtGw7AAAABHNCSVQICAgIfAhkiAAAABl0RVh0
+U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAATmSURBVDiNtZVpTBRnGMf/7zszO7uzSzmW
+W+QQa5GgFkWoaBuPmiatMWnaEIKamKYC1k+2TROTJv3SNDE1adJaFCQ1toCkNGm1sUdiPEqtCgRB
+WwVCPRAWAXGBved4n35gIRx+8Esn+WeSmWd+85tnnpmXERH+j40/S1FZWYv0LHUb9jdnl77bkgAA
+7GnGJZXfrlAU9SMwbDVNK00QFIkzP+ds1BJ0QZBoERT4o6O20pi55qV9p1MEp79MC1s76ysezAMz
+Blb6XnM9wMpffnGpbWVOsuxyquCcQdcNBEIGHjyatG70egIj4wGJMRz2c+ULl6Rz6LzdEmIFMZHV
+UbtnYB5444Hmk9lpcWV7Xl+tRQwLE/4wYjQVmqpA4gDjDKBpA38wgkud98PX/x7SScCzqTBr2a3+
+EWNyIph37cSuQXkGWlT1XUmCS3t7e/Ey7euWdjHmDXLOAWEREYOZ6naFSgoynIUvpEpEQMggbF2f
+ay/Kz7D3P3wS82pRFuvqHTZ1IYl5L88uK9XPuVRn/ZlOmgoYzGFXwpYQ31+rreAhjhTPiH/7uda+
+Hz79pjXY1jNMTlXC0HgITwIm1uenM0XmsCwB2R6eDwbDawPDk8wdF+Ndnp16Q9dNLyA+B4CbNRXe
+9vqKtis15eWGbm38/Upf+4kfO4LxDo7MJA2Xbo1CkTgsIVhkoTEJqJpDHcrMSK6N1ewNYLzPIpt3
+4cS01VV06YZ5aCqgSzEOBUPjIQgAdoXDsogpQhYAMNtjS4hgosvxZYzD/rOuq48pwk7FLE2eWggu
+qmpcpcjS2eq3itSkeA1piU5sLkiGqkgwBTGbtQDsSEvPOYvL4szeNwQAoHLFovkuqmpIY8R/syzS
+jra0R0gQiADC9F4IsulWQABzPpDiqqYxBrgW0QAQwce42P7E5u5x+UYcT6sBAIWgtp/aO0oEkucc
+j2v4ZIdskzkABsaAsG7i47rWyP2RyfevH9/dHa2LTNvXKUC8VlpQGHbH6PHd/z4sHRx9XEeExHmt
+ABGz22RcuDUCBkJpXhKazt+JDIz6jrYd39Ww0E4WzhRJFcdUh++nybBImvD7q2yybM2cnzNu05aG
+KZCR6AQD0N0/RpyxVcXvNC9d9NwSnrMssWHSF9x9+97gh75AOJtx3J298awwiDEAa3LiMDgexJCX
+48iBLfam8z3bzl3p7ympbvpKWNQBYgNcsWQi6YhDVeJ67g5ttikSuWM1wzsRql8EnpZmCIZ05C+J
+RcS00HnPi1cKM6Xi/HSt487wB57HvrBnzMfGJ4JOycaQ4taQl5OMxDgna/ylK6yZeuMiMGeM3X80
+hUM1lyY4A9+xablty7osuzdgwiKgMC9NLrBSXYxN988QBNMUmPBH0PjrDb9lGAcvntwbnpUkIjDG
+pPWVDUas0xbo77q4w9Nx5lHulsqd7iW51aufT8vIz01RMlNjmdNhQ8QQMEwLkwEdXb0ecfXmQz04
+MXK4+/TBGgBhAGEi0mfA9nX7Grx+z+2y3nOf/QPAEY09fe3ONSkrt5UrWvxacKY6VcUIRkyJCBAR
+35+jfa3HBq42dQMIRRMkouAMmK3efezNmw37LwOwA1DnRIlGkpxuJSGjICHoHfYGRvu8APToXEei
+UB+ACBHRoqWJMSbNgc1EBiBh+jdvRWNEowMwiciay/kPKWlcmnLc32AAAAAASUVORK5CYII=
+
+}
+image create photo hv3_nextimg -data {
+iVBORw0KGgoAAAANSUhEUgAAABYAAAAWCAYAAADEtGw7AAAABHNCSVQICAgIfAhkiAAAABl0RVh0
+U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAAM0SURBVDiNtZVbaB1VFIa/NbPn5GLtRSkp
+KNYnb+2DhQo1idCCVgRBRa36IlKlFHxpSUkLgqJgUaQ+9EVQS2nMQ4haCiliSzSGJqYqmhY1NMZL
+1KSxxgTTk+TMZc9ePpw5dZI20Yd0wc/MhjXf2v/ai9miqlyN8K4K9f+CG5uDrvom8+CSg9WxeW3d
+Le83Nhd2LykYYMfDL1Svu3njq/fsNW9v2yb+koF9P+CRzdtrNq27/+nza03nludl2WL5Jr9oaA7+
+wFF3WXUjoXO2+sz5Tho3bK1asWxVw8d9bf2b9sqW06/ryJXAkh+3hj2B7t/ZMidB1aEoTh1dQ60I
+HnesaWBsfNQd62r521p77+cH4v7/BL+y411O/dSeQRXFkboUpw6nltRZUrXcVnc3Gnsc/eTwTCks
+PnXqDdsxx+X8SqmzRLZEZEvEaUhkQ5I0IklDYhsSpyGxLfHN7ye4mI7x5AM7r1lx7eq2hj1B06Jg
+6xJKSZHJ2TEuFIcZn/6NqdKfhLZIQkgqEU5inMQMXOhhaOILHrvvmdob6256ubHZHKxwzHxwMZxk
+eOJblHKLxAM/8PCd4Ac+BVPAMz7iBCcpaqLyUxBEblgQnLhoDjSo8jCFsjwjeL4FLM4pt66sZ03h
+dj48cWR2anriUG9tumtBcD78wMMPPEyVd6mAZwRPPNav2oo/u5y2jsOz01Mz+04fTN8B4KV5YBEJ
+6pvKy8c37EMAz0gZbgTfCCfH3qS2poY7r3+I8ZEpPXa8ZWbyl+jZ79pdN1ALGBGJVDUxGdQABYXx
+t9r2r75s50bi3c+9WKj2l7Pxukc59/25tPOzkxPDvbp9tM8NATX8OwgqImllxz7g9x2w64GqTNWV
+9/om0+tS5a6VT9DT3RN/ffbLnwc+sLsujvAXUAAckGaygFm0x/kISyEffdoRDw4O9pw54l5LI2YW
+SXcVcL6anykGBMoj0n68Nf71h9FDZ99zrVlukinOvsur3ApVtSJCBiJnzQImTfSrH/tHWgaOuu6s
+kMtBKvAEKAGhquqcf4WU6UHW24Dy1FQcSM6BznMZAZGq2kushS5TEfEpn7SfU8VN/rBSvQLkHy0n
+h7/z4dY0AAAAAElFTkSuQmCC
+
+}
+image create photo hv3_homeimg -data {
+iVBORw0KGgoAAAANSUhEUgAAABYAAAAWCAYAAADEtGw7AAAABmJLR0QA/wD/AP+gvaeTAAAACXBI
+WXMAAA3XAAAN1wFCKJt4AAAAB3RJTUUH1QoOFCMCb8BVTwAAAyVJREFUOMullcFvG0UUh7+Z7Dq1
+G+NtnEBdRG0hVTSiqkAoNFIvHCCgKmotWVUiCMpf4FO1FQKVf2CFVEgFJyCIHIKg0jpSLz330AMH
+GkI5EEEPkRM1iZ1CXLvx7gyHXa/WTZ1E6kij3Z2Z9703v3lvVnCINg85oBp+vjkNv/G8bR7emge9
+Y9t6x7b1POjQ0b5NHAQFfi3adte46zgAJ6ZhrZetPAz00Z070XhtcZHQUXW/yOVB0Na9ewxks13z
+h4GL/aDeygrSMJCFQmf7FG2bzUoFKQSDFy/2lEX2gupqFZlOR9A/Jy6w+uEUruMwdOkSntb7Ri5i
+0Gngx6Jto+v1YPLYMVzHofHxR2ycfo2XXjzOqfo2q1evUrRt1isVEj0ij4N10bah2YTdXchkcB2H
+J/YV/n35BCMjr5NKJmm1WqTW1nkwMxPAXZeElBF8OmQaIfRIx4FuNhGDg7iOg/7CQWazvJEvkM/n
+g3kNu6+cxLx1i4VSialymXXX3XN4RvhMRdqE0L7vv8UzTM6fG8OyrMhAaw2AZVlk795lYWyMqXL5
+4HS7fvMX/LnvaBsGo6NvMzAwgO/7Xb3dbuP7Pv3ZLOP377MwOxtPANml8e2zZ2ceLi3NnVv5i08/
++2RPBDe++hqlFNe/nEWLPrTXQhhH0P4TPr92jUo6zdCZM+UPlpdvxKVgfGnph8uTpbkLg0ExjIyc
+RgiBEIFv3/fRWqOFpK8wjreyiMi/h35wG601lckShZOvfsPy8rOl6GiYSCQwTRPDMDBNE6VUBK9u
+7QDw+9+b+L6KbBzH0c/S2IiDpZRIKUnIVQxRQymFUgqPBH/8swXAw/pjPNEf2RBkl4hL0QccjYM7
+EihyNFsBNJfL8c75Ud5PHkXq47wrTTbWiIOzBAXiGaEHoxcY+kkmQSkFwKP6JmJ7q/tSqtX2VLIR
+G5AdbS3LIpPJIJAEfMHw8DCNRoOJiYk9GZNKRWXQAHQHKEIp0pcnS7Xn+dv8/NNNE/DioXfk6A8P
+4IVQryEgGc754dqd8L0NbAP/ARvA49iarvtYPCWLAMzYrogZ6rD7YddPR/8/aWZWKFzoJj8AAAAA
+SUVORK5CYII=
+
+}
+image create photo hv3_previmg -data {
+iVBORw0KGgoAAAANSUhEUgAAABYAAAAWCAYAAADEtGw7AAAABHNCSVQICAgIfAhkiAAAABl0RVh0
+U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAANNSURBVDiNtZVNaFxVGIaf75xz782fUvsj
+GI00BY2IoILGmJks2igRqcH6H4pdSOmmK2sToS6iiBsRhIouTDetYnVRjSJCLbYbFSKdKiiIQZRY
+04ihNmnoZGbuufdzMXeSMaZjXPTAyzmLj+d7v5d77hFV5Uosc0WogPs/xb37gwERDoRtvv/UqPpG
+tWt23DcS7r1+U+eHRmzfWgz9J1heEpMbdm/e3HH7q3sGD7RY49K1GGnYeWBYWnPixrtv3Zq/r/vR
+psCFa2E2Buefl3bBneq/e0fnnV33Bt9Of07P5kGMo1JecIu5/cE/6sUwG7T69lr2q4JzI+Ed1jSd
+GNy285rrNt1gJ6Y+BZQkTXhh11vNRgyCILKc5OjY7vXgHbA6uPc5t721ue3ow1ufbjORMjH1CUYs
+1gR8MXkYIw4jBmssgkFEyG95vHEUueFg37qrN7y8o39Xy/nFKX4+ewZrApwJSDUlTROscRix+NRg
+MsdJGqMosho4P+IOtm/seGYg/1jL5PlvmJ77aRmoCYGkpLZCRTyJxqDgCInsVXiNWXmDlx0b2jGI
+khD7EmVfJBaLotgQwGNQjBXEVL1pqmgJiumFf0WxlP5XzckT5/78/dBHJ9+9dNOGbrquvYeyL5Ka
+EtgKLoKw2RK1WJpaLVFr9Rw0G1KpXB6so5p+/Zrf99fsheFjxw8X14cd9HQ+RBAE2MDgQkMQmSp8
+CWpxkcFYQYGFc8u8pShEJACiiTf8B7c9VZwZT947cn/v9ra+zielMPsxaio8uOVZnHPYwKCqpF5J
+fHVHYOYMLSISq2rsMqgDwkzRD+8n392Y55Hjfvyd3F3bNuZv2elOzx5DU3j90CvlcjGOVo4uMDd/
+FgOEIpLUHNtMrqbfvkz+mP+VocSfPDh/cb4r1zMUaiLEZQ0KY/6B8kUWgHKmUrbXWK7hT2h+moXC
+28neQuH0yc9OjJcXi6VG5fUrrTlOMvk69xVAfAktjKUvVoZ+mbxUPLKHNI3EUMxcxlmdX6FqFKrq
+RSSLqtqxrpED3PdHk7HK4MyP6zbL7iRmLhvd18FjYBEoqapK/Y2RKj0Aomx3dRNIJs1UP2UZKKsu
+vypyucdURCzV79zWqTZNbaIESHQVyN9x5li6vCTOrQAAAABJRU5ErkJggg==
+
+}
+image create photo hv3_bugimg -data {
+iVBORw0KGgoAAAANSUhEUgAAABYAAAAWCAYAAADEtGw7AAAABmJLR0QA/wD/AP+gvaeTAAAACXBI
+WXMAAA3XAAAN1wFCKJt4AAAAB3RJTUUH1QsDFw0cU4QuNAAAAz9JREFUOMu91E9MHFUcwPHv7Awz
+o2vdWbYwhYSoLYXaxEgRYtQGjR5MrBi1avRkvJsmJkUMXqWh0MR46tFzD2qwejImpn+wXds0/msK
+FWopwnbZoOwOzM7OzHseurPuP+ihib/kHd57eZ/3e+/3ZhS2iYnJ8ZeB002mhj/68ONvtlurbIO+
+umd391dvHH6rYe741DGA4aPvpr8FWgBfs6flXeGJyfHXgC9HR8ZYW1sDQAiBEAIpJbZtM3XiE/p6
+s0eef3LRA3TgCnBFs6c3m8ITk+OvA19EaASGYViF+3TtKnDt55N0Pdy1rqo7hCZmbyoi86lCeEqz
+pz2tDh2O0Fwu1wDe6Qeo/MV69gd2d+8nUF9JoO2UgX/W1Eqn3lHkP5eB37W6Qn09OjJGNpttit4Z
+81BjeZBF/DCBarQBiiKlrkJ4P5AA0KqrPzoyRiaTqYPqMxYoiknWUUjs+IW42oba8ijuxkV93RGF
+9iRrALFywqdHR8ZI/5QmCAKCIMD3fXzfr/QXbswzNzfLai6HW7J4ZN97JFJPkc9+z0buc6wHbb6b
+eegQsFzJOApNU1lcvIlt72Jp6RaO42AYBpZl8ezQc+i6/t8ppEAxkuQ2dVTXJdX1Aqt/nwQoNMBt
+7e0s/DHP7dsZBgYGMU0TKWXlOjzPQ0pZ1XTiif2Yxn0QayUIVaL3XAOnkik2OzdRUIjFYk2g2ra0
+dAspIWm1oiixmmdbAwsh6LA7mLlwHkPXsaxkBQFq0JWVZVRNpW1nO0KIho+sAQY40NfP2fNn6Onu
+wXXdyryUEiSs5lbx/RIHnxmq2fiusN6i09/3BJcupbnx50LDIsMwePPw21uiW8JSSlYyyxBTOPL+
+Bwghap5h+vJFZi6c4+DTQ1vCsXpYCMFvV3/FNE1eevEQ+Xwex3FwXZdSqYSUkoEDg7S2pjj345nK
+mm0zllJyfX6Ogf5BisUijuPUFK66gL1791H0isxev0ZPd29TuCPq+IHP44/1USgUmoLV1wVg6AZ7
+9/TglbxqsxNY1gCnMtLRCUA8HuceIh9l7Pi+f+L41LGj3FushGH4WZRo/Y9eBazyhg8A8XIzozIA
+HiCAjXJ2+fL4Ov9H/AsSkxbhTKqTYgAAAABJRU5ErkJggg==
+
+}
+image create photo hv3_newimg -data {
+iVBORw0KGgoAAAANSUhEUgAAABYAAAAWCAYAAADEtGw7AAAABmJLR0QAAAAAAAD5Q7t/AAAACXBI
+WXMAAA3XAAAN1wFCKJt4AAAAB3RJTUUH1QodFgchfWfphAAAAgNJREFUOMvtlL9rFEEUx79vZvZ2
+ZU3wR/aiSc4mwqFoo4WFVmKvqPhHiAQtrEQEIRIvEGxCIBiC2IqxELUUBLUIaGohEMIdLHrR2/u1
+Oz92LGKil8tp9GIh+G1n3mfe+755D/jXRN0CbPlgL3gSwEGT/OXStoBt48ApgJ1EaodAVAPhPWL2
+hPYsJuLHi2OF0bcATmwFeii/8nBxaeHwvqA0LJwh4fAwIvslD09LAHPrGd8t3JnPZvuPnTt7/pdV
+SCnB7Av0eI/hZIZB4jS0+qAdTIdImzPYqW+vZ2xhj1+8cAmVSgXFYrG1ZGvb4H27P2KHqII7veA8
+D24bIlW7HMaaHhrctlihlEIYhhBCdPb12yPG9CFRA8i48zCxBOETlCxXPde+IX8pbSEQETjnW2pc
+rI6g3lwBYQEZ5x2I9aBcDl7l9peeAUAb+GfZtkogapxBrI5CsM/gziDmnr9+dHXkuuwSvKrU5iBN
+DsHeAHH88unaF/5t8GaNBABnQ9y2gTfOmpi4Nz4ppbzcLZiI1obMuq47RWOFUTty5RrSNIW1FlEU
+/dF4e54HpRQ455iZnV61QkqJer3e1TKK47jd4yRJwBjrWGZnX9vPjDHfwbMP7v/9fXzz1o3BWq3K
+OeMDAPpByBptmDZa2BTEOdPapOVMRmhjTKiVLvm+b8YLE8v4r830FVzc2X3Fz6VyAAAAAElFTkSu
+QmCC
+
+}
+image create photo hv3_stopimg -data {
+iVBORw0KGgoAAAANSUhEUgAAABYAAAAWCAYAAADEtGw7AAAABmJLR0QAAAAAAAD5Q7t/AAAACXBI
+WXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1QoRFysAQytH+wAABIVJREFUOMuNlVtoVEcYx39zzm72
+kmziDbW1akhbTQ0W3GbFGA0WlVIKgb5ExAaUtthCKbZUi9EHlcR6gfrQh0L7FqFQQRCprbYJpSja
+gqYYc9G0SZvburtJ3N3s2es5c6YPu67GROnAxzzMzG+++S7/ETxjHIclgHjGlkgL2HMtPPXQSfhC
+wacC5FzrCjQB5yW80wLqf4FPwunqhoaPtjY1uXWXC5QqmrJtsCysVIqf29szg31930vY8yR8FvgE
+nKmur/9g286d7nhfH6nxcbBtsO08VEqUlLgXLWL+mjVcOXcuM9Tb+93n8O7jHP0J6FfVdXXvb9u1
+yxPv6yMdCiFE4W6lHs1KYRkGlmFQU1/viMbj1a+Fw8s74IdZ4BPw9epAYM/25mZPrKeHdCRCzONB
+KoXLtmeEwxCC6ZISHLEYZjLJmvXrnVOxWE3txMTSDvipCD4B3672+5u3797tid6+TToSIep2I6qq
+yJgmdjZbhCeEIOHz4V27lng4jCMWw0qleMXvd0YTibW1ExMLO+CKBiAcjve2Nzd7ol1dZEIhckqR
+tSwW7NjB0n37SPl8TAuBoWkYZWWsam1lxd69mEKQVgojEuHB4CBbt2zxaB7PJwAagK7raEKQvn8f
+Ck/3WhahM2cQQrDswAFS5eUYpaW83NqKs7SUvw4dwm2auAClFEY4jK5pqEIuHMW6VCqfeSFAKSps
+m/jUFMHTp1lx8CAvHj+OrmloSjFw+DAEg/hyOZRSKKWwlQIpi0nWHlW8KpbTw5Iqz+VgcpKpCxdw
+ejw4vV4iFy9ijY0VobZtYz+Ey0e95HgcjG3nPdfy9yV0Hel2s7ixEU0INOC5xkbit25hSYnq7kaa
+JrZpojQNSkryzs3yWMp8M0hJAjA8Hl46dgxnWRn/nDpF3/79aEJQc/QoU+PjxKUk2dND8t49jP5+
+5PAwtmnOBD+EKinJSEly3jxWtbWhe7383dZGpquL6Nmz9B85gtPlYmN7OxmXixR5FXIsXozy+WaG
+QkqJOTiImJoiFQximSZs2kTi5k3uX7pE7vp1SkdHKQcSly/TrWm80NSEq6ICKy9I6C4XYunSmS29
+zbatseHhunUNDc5cJEJuYgJnIsGDcBg1MoJnYAC7ANCmp4neuUMumcQVjZIbGcGzciVVgQA9N26Y
+ocnJ2x3wjQ7QAVfrUik1Oja2cd3mzc6cYZAJBtGGhtBDoSLULphTSnK9vWRHRiitrKQyEOBOb6/5
+5927f9jweidYRa3ogKsb02k5Oj5e76+vd+aSSbLxeBGm5pjLKitZWVvL752d2f6xsV9teLMFsrPU
+rQOu1WUy5mgwuMkfCDhzmQzZdBp0HaXroGmogpVXVbHc7+faL79khmKxH214uwWsp+mxE1jyMXxW
+4/N9+NaGDSXO+fMRZWX54i9ospIS5fXSef682R2P//YlHLIhAoSB9JPgUmA58DywrAl2vApvAELl
+9wkFQuSjoASoAehvh3PAOBAE/gUGAVPM8VV5AR9QASwEFgCLgHmFFxlAHHhQsCgwDcQoxBfgP5iX
+ZPCieQjzAAAAAElFTkSuQmCC
+
+}
}
+
+proc color_icons32 {} {
+image create photo hv3_reloadimg -data {
+iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABHNCSVQICAgIfAhkiAAAB59JREFU
+WIXFl2lsVNcVx//33rfM5hkPttlxDWlqhKEsBlw15AMoJSVRi0IVWuOAmhTjpooUtVKUlrZS+6H5
+UKmt1EZFoSxpsEkFocrSqgkRcUMJTQBjlhoSiLENeLdns2fmrff0w8zQ5wXb33qkqzf3zbnn/zt3
+zj3vDfB/NjYTp9VPNy7z+dXvKByPOw5VOK5bxDlzGFiWC9Zuu/Ij13XeMZO+M23Ht1tTxVpbf+Rb
+F/6088SMANbVH63SNX4wEvIt3bCyPFQ+r1iEgxp0TYEjJUzDxnDKQM9gyr18cyB9tz9FjNNB06Lf
+tx6s6xofr/qZxs3geK/lwFP3dO8LsK6+6bt+XfnD9q9VBZcuLmVEgCQCSYJLBClzfgSAM0DhDKmM
+jdYbffbp8522Q26TI7G3Zf+OIQBY+73GhxRFnLRdNzAtwLqGpm0BXT3y/LdrAsVhH2RekEAgmQNx
+JIGIICVBEiApB6KrHK4kfHTptn26pdNwgAYm6boQ/F9bN1WF3jh5BV4AZbz4+l1/LuGMH2p4ojow
+K+KDSwTDchBLZGFYDhQhUBTUEAnpIAJsV8JyJEgSbEkwbReCMzy8ukKtrChT/3LyyoF4Mht4YtMy
+Wjg3PCHZCQAUUOvXL5+vzysrwtX2AXr/41tyMJHhjIERUc6HSArO7MXzo+aqpfNDlRUl3KcypE0X
+GdNGMmMhlUkhqCvYsWVVIGvY0HSVuZKmB9AF31NTtcB36O2L7q27CTiShODctCynm7i7o2X/rk8A
+oHrPscj1W0M17d3x3YB8fE3lAraicp4fXCBtuHAlEE/bGDVdzInoaO8bxbKFE3dgTA1U73kl4FeK
+B1dWztEuftqHaDioKApH31AiLhz1i/8+uD02Wc2seLYp6nf5s4Kzn3xl5SLfysp5ymDSRDxjQ0pC
+IfO1D0Tx61fPUMuBOl5Yy72BOBUtJlDg0me94gsLSlhJNBgTQvSDWNv9xAHg6r66+Ln9tS8ZFlWe
+vdx18tU3L6AkpKC8NACiXLECAOcMnMEco+mdSCa5YTnQfL7hkN/3QUDXP3Ac5yaRO+FMT2ath2p7
+APpYUbilKArioxaIACKAMYCziYduTA0oNlxHALOjoX8EA/o1xnmyOBIMDA2PzKhjVtc3fj/s139c
++9gqrT9pIJG2IJHrFYUdmBIg68guVXCMZrIf9nc77bYiRpPZhOm69uh04jUNTVt9uvbbXd9Y7dd1
+FUGfhvLSAMAABgZVcAgGD07OJiCte/r1RecP196ZScYFW7P7tU0M/NRM/afshNW7G0lwli3MJZFC
+BHWyQNLVZrce3j44U+EnnzwmuiJG+bkDuzoK9yb0AQB4+YWv+4Fc8Ugi2K6ElLlC6uhNYt+J8ynb
+cqunE29u7vBt3LjYKMzbi61vMuJ/hSdxPtlCSYTLnQm0dsRxuTOBa3dSiI2aGIhncODNlrTjOpsv
+Htz5+ZTpEjE3qpY3tw3M/Z8YuUCuiU0JMN5mhTSoguGPx85Jw3brCt1wKvvFL8Gu380+LCCrTl3t
+f6C5uVlRVW1r7ltjGgBPoTIGlBRpyGRtAMQFeG31nqOl0wF0Ri6F42n3qwBfpnCqaovP2UgkdzAG
+WEKMTAngfWYQATd7RyA5xw93PoQNa8q3CY72dfVHnq+pa5zY3POWlvajqsKqOKNlibS19vjp601F
+4SLBOR+5uq8uXvCbtAglEThjmF/qR08sC9slxEYsxEaAJYvK1FnRIvXyp70vdXYP/Wp9w9ETtiNf
+0wyc/6TpqVT1i+9HioTvudG08+LyilDq7bN35p651LEgEPCRL+BTE4nUBa/WpMfwdz/ajKzlIpHK
+Ihzyoy+RRfdwFv0JE66U0FWBaFCFlISunph7tyeWjo9kdCEUnXEFlH92S8dBIKi70WhY0QN+3Onq
+Gcma5g8uvrKjccodIAJu3knIw2+18AfLS7JbNjzoVwQHYwQCkDEdpA0HQjBEo2ExuywSJgmMpA2k
+DRuOS+CcMa5ocEkqjgukkmlYhjFqxtVjXq3xAAwAbvUm0Pj31pHh2+cftVMVmzp6Yj9fs3ShuqRi
+tpJM24ilLdgOwXIkTFtCEt1bzjUdQub6huW6ADFkMlkM9vVnjUTPrrbjLzDkak8CgPCIcwD6gupt
+P7tyoz89dPtS7a13f3Orv+29z8xs8m8jfPa8z2/HF/p1BXOiIe7XFTCG/HshQDJ3lSTzeeR2Kz6c
+lAO9g5nMYHtD24m9Z/M6OQdAsnvogAZAq97dmMombj9z7Y29zYV7hVFa9ciS+csfq/VFSh8pDgdl
+aWnUHwz4mKapAGNwJGCaNtKGhWQy7SZjiaxtZv7TffGtn/ZfeacDgDVumMyTvQZA/3Lty3uuvP7c
+UQD6OIB7c80fKSpbvmVl8cIVNXpR2Ze4ppeBuEKMCQY5Kh2z14j3fTh045/vDlw/1VkQ8wrnr4b3
+FEwqlh/quM9qvn6EdzsBOABszxif8ZjsAZjeIrQx9lgWgrr5wE5+YUFYYGwjo7yv19/2rPNCGfnr
+pH9MCj+HirHZjhcuFFMhRgG4AD0ZSEH4Xq+d7lVL5IULENwD4BUvAHghvMJO/t4Em9G73iRrvKMg
+7oWY+A/kPvZfhD3CiG0yc3YAAAAASUVORK5CYII=
+
+}
+image create photo hv3_nextimg -data {
+iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABHNCSVQICAgIfAhkiAAABHpJREFU
+WIXtln9oVWUYxz/ve85x3mTqps4UM1MLin6XLucoKhMtCcv6Q4oyIygMQjcjCcKgosj+kUQjLITl
+D6SFGGWsabM23HIq5q/QzZlTN5vatru7e36879sf95x5d93mnOBfe+C5z8s953m+3/N9nvO+BwZt
+0AZoBUW2mVFsPXe9deT1JE8ee+fGwmJ7JSAGWsMaaOItBXLlh699a8eTrY8wtW563my97dxv+Nda
+57oUkFIwv3Dx0AWPvTEnlnD25b/LhBtKwFMuR5uruGdqvvP6vPdvH2ZlHywotmfcMAJaBySDOEeb
+Khk5Yrh8+4WPckYNH1tesMxa1N8aPQ5PQZFtEHT2mWmIffrWdxxoLMNTLsZoxmRPZExsEpvL1iTr
+mw5/Pb5BLd26FTUgAh8sXotlOUgkQggEAqIYZkph8+epH/G1i9YKgyY7azRTRj9IeU1psvrozj1J
+Gcyv/YzW3gjYvVMz7D6xCSmsLhdCpJG5LIXWGm0M2ihaOk7TnrzAow/NHToqZ2zhz1Wb/8pfLp+s
+/tw93hNMrzOgjMJXHr72CLSHr118lVoHeCg8dBiV8FDCRZG63u5eoObUdiZOuM1+ac6SCcOcrNqZ
+RfZT10TAGJ0CUx6+cvG1G4KELnwC4aGEjxY+Cpe438LFZCPnO05yrq2O3cc34Vlx8eq8d7JzRuRt
+m7ncWdrvFmitCLSHQCKlxBZWiq+UYf8FygR0eJdoS7aQ8NvRSqGVSXNo/ruBO/Km8/LcJbFtFSUf
+U3x8VuWq4JmrEvC1S8Jrw5I2juMQaIMJFEYFBMbF1XE8lcAIAIO0CWcEUj8aYwxGQ6A9PO2iTSCA
+Kf1SIOG109RWj5BgORLLFli2QNoCaQmkBOmk3gmDwGiDjsCFASPACO4e/wR5scls2bGus7X94urK
+VcGKqxHoNhfSEkgrjLbACqOUAhHeaQwYHSlgAIMtYjw86Vn8uDbfl23oTHR0vlm9Wm0CTF8ERPp/
+Qqb2eynDp47Au1QQIQGD0eGTA8OcXKbd/Dz1J+uCipqyttZGs+DQZlVL6vBT6SQyCch0BV58YEUX
+UKSCkCn5hUz1u+zMl/iBi1apmmNiE7k392kq9+72Dh6prTv1R7DwTA1nw7rhJF/eHXtqgQBYu+WT
+Hi51t+IlK7AcgQ6H79bs+5gUy2f7L6XJhtMNO49sVMvaW4in1yVj980kYABd9UUwHBgCOKGnrx3A
+KSy2KxBkWZZAG4u7Rj5OzB1HSekG999/Lq6p/UatA/ywZrp3OxsyCejQFRCEbCPvIthVRAiGZt3E
+/bmzuHS205T8tD5x7lhy6bEf1K4wP3KVtu5zCEkDvkKZtEIWgC2GMC1nIfv37wt2/f5rS+M+/crJ
+cnUiA9xPi1d8MfVEwABeCBgBB+G9FtEgCYzyoayi3D1wZO/B+h3+oqbD/JdBNIou9Hws9+dj0r4C
+HGRBkX0hL3ec33T+bMmh9eq9eJyAyy2MSPu9AfelQKZFUkaz0PWqNjc3Ld+zWn1F9wGLVBu0QeuX
+/Q/MEx4pyYpYiQAAAABJRU5ErkJggg==
+
+}
+image create photo hv3_homeimg -data {
+iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABHNCSVQICAgIfAhkiAAABqVJREFU
+WIXVl2lsVNcVx393eW82j8dgx3YweAy4yBQIu9oiRwi6OGpQpaIqtGmKhJSoSiJBVAWp39pK+ZRP
+EVGVLhIEulBWKWkrlQYVNQSJuA2ECJpAYuJiMNhgPNhjz/buvf0wC16GVcqHHulKd94975z/Oed/
+ztwH/8+yT8qX/yDErb0w52FtiId5aT/4KLWnsaHhiZaamtrTvb39gTHfeBo++cIB7IHGiNbvLJg3
+b0HbrFnh3NAQI+k0p/v6BvJB8J0fQveD2JMPovw7WBELhU6vWr58cVtbWxgpcUDE91ne2toU9ry/
+/hG++YUA2K/Uj2prav7e2dk5q76xUSIlKAVC4ICQ57EsmWwI+f6f9in1g/u1e88S/BzkQqVeb2hq
+enrFqlV1SkowBqzFplLY4WEyxmAABwTWcu7y5ZuZXO4Xm6zdcS/76q5RQ+IRrY+2d3Q8sWT16lqp
+SupCYIeGcMPDFIwhpBTGOYxzIAT1tbWRkVzuq9+1tvaAtf94qAzshgUxzzuybM2a2U2trRprwRhc
+EGAvXSK4dYszw0NcHbzBymSS5miUcWvJOocDLHBxYGBkNJ0++D1jnhXFBE2TqhzYq9STtTU173Vu
+2NDW1N6uUQqkxBmDvXiR8Zs3eX9okMRL21h16hT/TcToSY8SlZJwiRM4x9zGxtqZicRTB7R+6xjo
++8rAAa1/Fm9o2PaVrq4ZXiRSjNpa3MgI5vx5bo6Oci6TJvnLN4gseQxjDMJarv30ZdSpMyyK15ID
+RozBUQx7IJXKDA4PfzAcBF0/hvGqAHZBOKbUoTkLFjy+eP36uJhItoEBzIULXEqnuRIJM//N3cj6
+eoIgQEqJlBJrLUO/eoP03r0sT9RhhCBlDBZwzpFKp3P9N26cTwfB2i2QKvtVAL+H2VGtTyzt7Fz5
+pbVro+X2Qghsby/BhQucS6dJf3kh7bv3IONxjDFEIhFmzpxJLBbDGEN4xUq81jl8fOQIzdojqjVZ
+57CA7/s66vv12fHxp77t3IG3IF3JwD4p+x/fuLE5MX9+MSPW4oIA89FHZPv6+HB0lBmbN9P0wgsY
+Y7DWEovFCIfDk8qXyWTIZDJkz56l5/nnWRIKURMKcd0YCiVy5rNZ23v16hVrzLrvQ48E0ErlEu3t
+AqVAKZwxBN3djHz+Od0jI8x+9VWaX3wR5xxKKRKJBL7vY62tLGMMvu9TU1NDbOlSOg4d4qyU3Mhk
+aNQav0ROHQrJuS0tc6RS/5zcBaXJ5sbGCN59l2uXL/OhtSw6eJDEunU459BaE41GS0ma7Ly8F0IQ
+iUQIt7Sw+O23udTYSO/YGI1aEymBkJ6HVspNa0M3MEDh2DEuDA5y6dFHWX7kCOF58wDwPA/P8yY5
+nup84vI8Dy+RYOH+/YytXs1/Rkd5RCniUiLF7earADCffUbu+HFO9vcTrF/PY4cPI+NxnHNIKRFC
+3JfzqdmQnse8114j/MwzvD80xAwpmSFvx60BAmPC106e5HwqNTq+aVNsxSuvSGstuOLwcs7h3ORB
+Vv4thEBrjRBimk5ZzxhDy9atHO/pKQRHjwYd8XgkHwQ1FQA5a9f/u6/vxNwtW35yuK5u19eVIggC
+jh59h7HxsYqjqRKNxOjq6mLHjtfJ53PTzgE8P8RL27aSz+cZnD8/aDtx4lsf9Pf/pWDtmgqAzfAx
+zs1k5062b9++q8LqkM+nPecnGRRCVMAs7FiEc458PodJPonvKTwtMcaSL1hyhQCu/A3nHIVCAaVU
+ZmN//3tA3TQOTJRyDVvntKK1rhDQ9/3K3vM8kq1JrLUlYCAFKCGKJJuQsHIZrLXTalT1D8I5h7WW
+ZDKJ1lVVAGhoaKgAGM8G5PKG8VzArbEcI2M5MjnD16LFgEpjO/9AAJTWlUhEaSMZR4te8q4DBBUA
+//rkWnWUUSZ2RWHq8V1LUHYsKKVUgCc+ZcOaP6PEKFCd+dXEGINzLpj6/I4ZMMaAc5PZLyDPMg4c
+X1wpTXHo+KyrO1PVsfaKI7tQKCClzD4QAO15FIOf3IKe5xXxCMhmszz33LNV27RsK5fLlct6zwyE
+ylFZa5FCVjU8EVA+nyefv82taiWRUlIoFAiCwAINFO8DwVQAPlAvhAiy2ayOx+OTev5OEo/H73pe
+BnT9+nUKhYIBmkt+BwE7EYAG/FQq9ebOnTu3OOfuemMG+M2vf3svlYoIIbLd3d17gTDFYAVMvhMK
+oL60aktKdx4CDyZ5irevDHALuAxkpwIoiwdESkgf6uO1ijigUHKaZcIV/X9F/F/h7eNregAAAABJ
+RU5ErkJggg==
+
+}
+image create photo hv3_previmg -data {
+iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABHNCSVQICAgIfAhkiAAABGdJREFU
+WIXtlm1o1VUcxz/nnP9/u87MihykIsO0FREUWbPdqWVWm9mDSgsCUxJNe5HY5l7GIKReqEFB0BPM
+N0VNyjDwRUqW6EUDiQXqFmXqfNp13j3eu3vveejF/7/bvdet9kDv9oUfvz/nz/n9vuf3dA5MYQqT
+xOJGVV/d4LmJ7peT8C2iO7ydC+66f6/vlU7YyIQIPN3I9Jom78Di+1a89foLb0c85U+YgDfeDVVN
+zE3iH1qzdNP8Rfcu85VUE3YO44xAdaP32HTv1rY3Vr+z8OHKJX5710ms05MiMOYIRBvU+lkzZ3+0
+9cXmMuUrOrpOkjFpHCDA/H8EmpHRpLe7cs5DWzbU7Yj0ZeKc7/4dYzXOWXAOB2osnXB8txbjIhBt
+YgaD3v6aB+qqn4tuiFzqaSeRuop1BmsNxmmkkDS/9gnWWRwG62woBhdqYw3vtrw5NK4I1GyPzHfC
+HF67bOOcRZVP+B1dJ0hm+nC4nGHrDLG/vsVYjbEaHWpjs2ibzenl97w66iFHJFDT6D1e4vvfravb
+MWP2nfNE2+UfyZp0+NfhsCAcFoPF4KTGonEu0MPkrDM4LM6Nnp2bCEQb/C13zCzfs652+zTpQ9vl
+I0GuhUAIEBIQABYrDBYbkBAaJw3kpScIvwYsDkbs1wIC0Sb/q4ryyufXr2yMXOo7S2f3WQQCIQRS
+BloAQhCcDEvK9JPM9DKkk2iTxhqHcArpfBQlYW1YcIw4rQoIWGurhQeDmQR9Q9fRJgMEzpUQARkc
+g5ke+jNx+rPXydhU0AkOnAVrHVY7rHEY7fCIkNapsaVg7nlTcY6zuz7ev3Pzs0tfKlPS58y1GKUl
+PtIDQxot0iANUgmEFHhS4BDgHNaCMGGGAOcgm03lE1AUzYyCSdjaijm2S2/v7Uts3ffD3qRvytyj
+FXWk7SAD2W4yDCKURXkS5YlAfIHni3/WlEB6AqkEUoFUBa3vU1QLI41iGdtjvu6/kqn9/qd9iStX
+r+onF67ntrJZodHAgfIkyhcoX6J8ifRDxznnQeqC2imIeEHUR2pDCchTLbpt3hKWHLOHW28kuu5e
+WvVK6W/dB4mn/0TlOVlZ0QCOsAaCNATaYXVYE8YV2A7FjkYghwtHifd26FW6vm1PT1+idtVTayOd
+Q79yfvCXgIQX1MF7HzT/m5l8jGkUu5CdA2zvNYZOfGi2ZTd2bv5ioKVhzar6yO3l5ZzuP4RQJpfj
+47t1FNChZPMkk/dt8+znQlIMUyQa0Kc+1592nu7Z9OU3LQODceeqyuuZ5t8SDKYASWAISBc51Xli
+wrUcRntNuBG+XfyMuyAVBy+nzqyIqLKyRxY8o0pUKUdjR7gYs+8XnbiYRDYkV9CGo9WACw3YPNGA
+d+5n3T5wieXOHv2sqztetbq2PpIXgeHwFkdwmNBNl8J/vaeGHZtwswF0MkHqYsy2li64Mb3jj/YH
+k0MD3sWY3Vl08nSeTO7ZVAQREvcAf/E29XL4GPHDtdx1NYUpjAV/A41jRqaMmBkaAAAAAElFTkSu
+QmCC
+
+}
+image create photo hv3_bugimg -data {
+iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABHNCSVQICAgIfAhkiAAABfxJREFU
+WIXll11sHFcVx3/3zu7sej/s9XrX6/VHIi1Jt0qcthEIVUhISEUCUdE2iSJKWyHxADzyxjMSQWoE
+oSKRKvIASKgIJB54Bgl4qCxKJEoV0gQndj6cul5sZ+39nJmdmXN5cLzsetdOIpB44EhHM3O//r9z
+7r1zZ+B/bOpJGp87d24mlYz91Pe9TxtjjIRCKAZjhDAUtKWXGo3a185/48d3yVFERbOIGdlRUm3w
+t1hmVX0K/4kBLrx57jMj6dRvX3/j65OpVAoAY0xfG8dp86t3ztdKc3/63gufvboK5FBWcqdx2MKw
+gXbv0wpuqSIbjw1w4cL3X8jni7959dU3xoMgwHEcRAQRwRjTvaZTing8wl///B13bnrh9zPFWgul
+0oDBmAYmqGA6dzDBP1Du+2qM6iMB3nrrzReLheI7Z86+lnFdF9d1B4RFBCMuUX2VZFIxkpynuvqt
+YGzsXjUWH+nsZKDhY/wV8BcR9+8o933SwXvWQeJvX/rhKzOzh35x6vRXMu12uys+zBWrRK3baHMF
+S6+Qyn5bh/5qAl3S2jqkUOkIyhnDdDTgIKpJ0FnfF+Dtiz/4/OT09C9ffvlsptVqHSguIlhqhah1
+l6i1gm29B2oMFfumwihb6WmldByMD6wnQLbBrxKwERkmfunSj06MT2R//dJLZzPNZnMg7cOmIEIb
+cHYWu4qDLKH1fSTyJWXUxwljlFGqEqLSUfDSKCuJkVG9V/zixfOzY6Op350+89UJx3FwHIcwDPtc
+RIaWiUjfWIqVnWybPL4vCWPQ3SqAiPL7MnD58uWEHTF/OHPmtaLneTQajQOj7r0PtU0YRgmCGCba
+xrCJ4S7a+iOBeQ4oKsfZGB2JNupKmcbOttTVPoCYrS5+4YtfPqK0pra19ci0796HYUjd1dTDkKnJ
+FImRSexIBaVt/GAdS/2NjnkdK5KxHlRHdC7bXAM2cb1KH4CEwel8flKvra1107ofgOM4VKtVbNtm
+ZmaG4tTnSMQKIFcxsgjmHiZcxFJxfN/H4iYd9V11Z+VaLje+egfxbqgpWn0ABqOUUt2oekWDIKBa
+reJ5HsVikVKpxMmTJ1FKdQE7wSGQGpoARRzMBFo7NJpVtE4QSY6xVkkHnAiukvGvAQzsAqUUgQQY
+Y6jVamxvb5PNZpmenqZcLhOJRLqLsNPpYIzpOmRBjqOJgcmgeIAyHvGET7MZEiHO7TuTPhl3QSnC
+oQAAhXyBDxc/5NjTx0gmk92M9IoCPcL0XDMY8xyKORSbIHX+ub7FRO4oYpKsfJzzd8X3BRARyp8o
+c+PmDcpHymit9xEz+9wDTCAyzvLyMnNzJwiNDTKo1fce6B1MKcXh2cMsXFnA87yBfR8EwUDZXr91
+6xa5XI5oNNoHuC9AbyQigm3bHC8f592/vIvjOHQ6HTzPw/d9fN/vQgyDWVpaIp1Ok06nu+MNs32n
+YBcmlUxRPlJm4coCzx57FthZqHuj6S2rVCpYlkU+n9838gMB9s51PptndmaWD65/wOTEJMv3lvs7
+KFAoDIaoFaUwXmB+fn7ounlsgL0dS4dKVNYrPNh+wKkXT5FKprpT0Ts1H619xNrGGm23TdyODwT1
+SIDeQ2W3k4hwbfEas9OzzD89T6PRYHNzs6+NUgrbtikdLpGbyHH95nWeKj1FciR5YBaGAvR28Doe
+y/eWeeb4M8TtOFtbW0MH7C1LJVLMl+e5ff82U7kp0sl0t10ogd2rN7ALdgcRERrNBtValec/+TwI
+NJvNLmCvDzuoLG1x9PBRWk6LerPeE6Dp0xzIwO4ALbdFMpWkMFkYGvV+1702lZui2W7SclokEomB
++qEAHb9DIV/AdVzq9foTi+61VCKFH/iIGXwX9AKMihittSafyyMixONxYrHYwOu2/wB6fBCtNUpp
+DUwDTaC+CzAKZMMwGP35z37SDCVURv79HSDG0PtsjCBiEAmR7p/Rw3ojGNmtN3ueBdd1RoEpoAqY
+3f8CG5gAMkAaiD70/6Z1AAvwgAawDmzt/TGJ9vjQHfIfmAAh4D/04YfD/539C6isxdMMVl08AAAA
+AElFTkSuQmCC
+
+}
+image create photo hv3_newimg -data {
+iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABHNCSVQICAgIfAhkiAAAAtNJREFU
+WIXtlsuPFEUcxz+/qn7M7LyWgMGFNeBexAcPIRplOfgveORPMEaNHDzvhUSN0USjcvbqmRMHox7g
+YETFGHGULIsriFmzs6GZ6e6q+nFgB0fZJcwwI5f9JJ1OPbq+n65HUrDFQ0YmObiu0MSmj2A1xUuO
+z/+S7az9LwJ6IzmAJvvAPIrYKdAu6q4i+UWpl9/3+0UTCc/iI4TKC1A5iER7EamhehPKRdTs1IxY
+auU3ExHQjF1o5Rmk8hxUX8TsbSDTFu0EwqU9IAleb6iWbRE6dwksLCxU6s3qKdXwsvehOazAZ58v
+M7fnMnOPXaM1vZsoOYKxu1S4mkemKoQL+xC3yN/JLBR3C9SbUx88e+jw8fmjx5I0TYefAv8V+DPg
+vwb7OJhDYJ4XV5yreF0urf60A5EWVduADZZAQzg+f/RY0m63ybJs6PzG1M9sa/7JdKMgSjJM1MFE
+V7CmS94tp2yEA3UEn20sgKZJktDr9TDGDC0QtIXzLUq3jSheQsO3hHIJazu48pIlKpfAXycUf2wo
+ACAiI4UDOD9LUV6jm69hzCJpchalhqVkdbVLvVpcAHdemqxsKgBgrR1JAOrk7imiQoEaRbmCMT2m
+0xku//4rszsvfsGV7Mt+7wkIQNAZsl4T52eI7HWMKWhtf5Iff4mZf+n0aXmaMFEBVQUa5G4/uVMA
+PE+w2vkOkX/CNxUIIdxT4HbAcIQQNqy/b4FRQh9IYNRTsBmb/cBISzB2gffef+c359xcP1xVxy7Q
+5+13TypAEsc/nHjzrYMRgIjMvfHaiX/Zioz3qqCqvPrK63fKH3/64QEYWALvPZ1OZ6yhg/THFhFq
+tdqdetO3e9BdPgwDWTYCkn5lo9G4n4+Gbv9v20C5GQFRCGH5k1Mf7b6393gRMW0gFSAG6utPldsz
+Ek8o162/C+AmsNbf6gKk6wIxE7qsrgsEIAe6A0JbbPHwuAV9KDek5Yk7vgAAAABJRU5ErkJggg==
+
+}
+image create photo hv3_stopimg -data {
+iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABHNCSVQICAgIfAhkiAAABz5JREFU
+WIWdl2lsVNcVx39vG3fGNgbvQBBJsA1G2MauscMUCcVVlQ+pGkFFaSs1IUrVqhJrEQQVVRWtWuGI
+hpAUGin5gJVECfkSVapUtTioaVRaiKFqlVBk7GEW2+NN9jDbmzdv64d5b8Zjj2u3Vzp625n7+99z
+zl1GYBXtl/B9Ad5aja/bJPjNy3BkJT9hJYdX4AdVtbWvfffUKa/s8y11sG2wLLBtbNMEy8I2TX73
+5pvqWCh0+TSc+r8FnIcfraur+/W3jx71psNh4g8eLIUDtm3n7h3zNjSwdvt2fn/1qhoZG7t4Bs4u
+x5CW+9APh2vq6y8cPHbMm45EiI+OgiAUDPLXxaMwkkkMVaX96aeVyUCguyeR8AzCn1ctoB+OVtfX
+9x88dsybCoVIBAIgCAiiiLAI7rZSIsxMhra9e5VoINDTm0zag/DpigJegRO1jY2/+tbRo75kMEjy
+4UMEB+6OXhCEkrnLv3NSYySTmJpG2549ylgg4PenUplB+NuyAvrhZF1j4y8OHDniSwQCpILBHFQU
+c7Yw/CVG7YILjzZ6Momp63T4/UokENjzlXQ6dR1uLRHQD6ca1q//+TePHPElRkdJhkK5cDsCymWZ
+jR4PCdPELqYUQWsUhTpF4ZFhYNs2NpBNJrFMk/beXiUcCOz1q+rcIAzlBZyHM40bNvxs/+HDvvjw
+MKlwOB9qBIFyWaa2oYH0vn2sGxkhmc0WRCwQsM7jobylBb2nhzXhMHHHzwY0R8SO7m4lHAj0PaVp
+UzfgrgTQB5++dO6cEvv88xzcDbEDr6mvZ+7sWfQtW6C+nup790hqWm76Oa26rIyK5mZip0+TbWtD
+Nk3WhsM80rS8TyaZBNuma/du5c6dO9/4GM6JeZgskwyFikZk2zYNQPrZZ7F9PgRBQNu1i8yLL7Kx
+shLRmffVXi/lra3Ez5xB9HgQRRH1mWeoBMokCQuwnH7jU1OIipJnyIvraHFYg7rOY9euQUUF2a4u
+BEFA7+1FkGU2DgyQSqcpb20lefx4bqbYNmI6TdWFCwSzWdILasF2BoVlLSPAcVw4nUxBIBKLsend
+dxFlmezOnQiCgLFrF6IkUXnjBokTJ0AUEQEhlaLy4kUmQiHiqloEzgspKcBdSp0fYNv5RccyTSLR
+KJvefx9RUdDb23MiursxurvJ5zGVovz115kYHSWeSBSg/0sEsO38fF8oxLJtIsEgj127higI6B0d
+hVURQFXxXbnC+P37xGOxIril61iGgeWmI5stHQHbsoo7dcS41W5aFul4nMqbNzE7O4t8pclJpEyG
+5Pw82ZkZjHgcM5XCUFVsyypEADDq6pZPQb4G3Ei4BSkIVG/eTEVPD5nnn0cURee1k6amJtTnnuOJ
+cJh/DQ2h63oR1DULilKQT5/t7OlYVk6xExH3ffWTT1Ll95N94QUEWUYURSRdR5qacvTbmJ2d2IcP
+037wIJLHswRsuc8la8CycuaG1Y0AUN3cTNWePWgHDiBIEqIoImazSG+8gTQxgX7oEGZ7O5ZlYXV1
+IcoyHT4f/xgYQNe0ApgFhVhKgG3bS8Jf29ZGpd9PZv/+AlzTEC9dYuS994hHIrQpCrKiYLS25mql
+rQ3x0CG6Kir47PJlTE0rElAyBZZpUr5hw5LwVzz+OObmzeCeBVQV8coVRj/4gLmREXRN459vv43x
+4YdIw8O5rVoQsNavx9fYiLJmTRFcEMWiFEgAX4Oa6WCwY0dfn2ym0+jxeL4g54eHqfR4kGUZs7oa
+z8AAo++8w9z9+/lOTcNg6u5d6mtrERsbQZLwfPQRQ6++SnJysgj+RFMTc4mEPRqLCR/DOQlgEP7Q
+Oz9fPz0+3rGjt1c2ZmdRx8bQZ2fRIhFmPvmEtVVVVI2NMXz1KnNffLGkug3DYPL2bTZs2oQ3FGLo
+/HkS4+P576IksaWlhVgmY90Ih2MifHkQZovOFP1wsaGm5odf7+vzTt++TSIUKuRNkvDU1KBOTy+p
+7oXPkteLWFZGJhYrwGWZLc3NzKRS1l/C4Zks7P4pPMynwG2D8Mfdqlo9EY3u7PD7FSOVQnv0KF+5
+eir1X+FuOoxMpiBIltnS0kI0kTD/GolMAL0/gfyev+RMOAh/8mcya8ei0c7O3l7FTKfJxOMrgkuZ
+rCg0bd1KOBYz/j4+/lCEp05DdCGv5Kn4OlzflclURycnd+7s7lYMVc2LWC1c8Xho2raNkdlZ47No
+9MEd+OprMLmYtdz/gvIbMLRd09bNTE7u6OzqkvVMBjWRWB28rIymbdv49/S0cWtqavgt+N5NSJNb
+5bMLQcudritdOwkvb62o+M6+vXvLBHdptiwsd+VcYO4727K4Ewzqt2dm7v0Wjs/CLJAA4kDM0bms
+ADcya4AKoOLHcLIWXlrGt2RLw61LcCoB80CK3DWOsx+tJGChkC+5Qpx7j2MKuZXU7cMCDHIhzuY0
+kACSQGYxeLUCSvmLjjAXLlA8QUwKtbpi+w9DKwnvvVH2bAAAAABJRU5ErkJggg==
+
+}
+}
+
+}
+
+
+
diff --git a/hv/hv3_image.tcl b/hv/hv3_image.tcl
new file mode 100644
index 0000000..aad6570
--- /dev/null
+++ b/hv/hv3_image.tcl
@@ -0,0 +1,125 @@
+
+###########################################################################
+# hv3_image.tcl --
+#
+# This file contains code to add image capabilities to the widget.
+# The public interface to this file are the commands:
+#
+# image_init HTML
+#
+
+
+#--------------------------------------------------------------------------
+# Global variables section
+set ::hv3_image_name 0
+
+#--------------------------------------------------------------------------
+
+# imageCallback --
+#
+# imageCmd IMAGE-NAME DATA
+#
+# This proc is called when an image requested by the -imagecmd callback
+# ([imageCmd]) has finished downloading. The first argument is the name of
+# a Tk image. The second argument is the downloaded data (presumably a
+# binary image format like gif). This proc sets the named Tk image to
+# contain the downloaded data.
+#
+proc imageCallback {name data} {
+ if {[info commands $name] == ""} return
+ $name put $data
+}
+
+# imageCmd --
+#
+# imageCmd HTML URL
+#
+# This proc is registered as the -imagecmd script for the Html widget.
+#
+proc imageCmd {HTML url} {
+ set name hv3_image[incr ::hv3_image_name]
+ image create photo $name
+
+ set fullurl [url_resolve [$HTML var url] $url]
+ url_fetch $fullurl -script [list imageCallback $name] -binary -type Image
+
+ return [list $name [list image delete $name]]
+}
+
+
+set ::html_image_format jpeg
+
+proc image_to_serial {img} {
+ return [$img data -format $::html_image_format]
+}
+
+proc image_savefile {HTML} {
+ set t [time {set img [$HTML image]}]
+ # puts "IMAGE-TIME: $t"
+ $img write tkhtml.$::html_image_format -format $::html_image_format
+ image delete $img
+}
+
+proc image_savetest {HTML} {
+ set url [$HTML var url]
+ puts "SAVING $url..."
+
+ catch {
+ [.html var cache] eval {CREATE TABLE tests(url PRIMARY KEY, data BLOB);}
+ }
+ set t [time {set img [$HTML image]}]
+ # puts "IMAGE-TIME: $t"
+
+ set data [image_to_serial $img]
+ [$HTML var cache] eval {REPLACE INTO tests VALUES($url, $data);}
+ image delete $img
+ puts "DONE"
+}
+
+proc image_runtests {HTML} {
+ image_800x600
+ set db [.html var cache]
+ set runtime [time {
+ $db eval {SELECT oid as id, url, data FROM tests order by url} v {
+ gui_goto $v(url)
+
+ #after 100 {set ::hv3_runtests_var 0}
+ #vwait ::hv3_runtests_var
+
+ set t [time {set img [$HTML image]}]
+ # puts "IMAGE-TIME: ($url) $t"
+ set newdata [image_to_serial $img]
+
+ if {$v(data) != $newdata} {
+ puts "TEST FAILURE: ($v(url)) -> $v(id).$::html_image_format"
+ $img write $v(id)_2.$::html_image_format -format $::html_image_format
+ } else {
+ puts "TEST SUCCESSFUL: ($v(url)) $v(id)"
+ }
+ image delete $img
+ }
+ }]
+
+ puts "RUNTESTS FINISHED - $runtime"
+}
+
+proc image_800x600 {} {
+ wm geometry . 800x600
+ update
+}
+
+proc image_init {HTML} {
+ .m add cascade -label {Image Tests} -menu [menu .m.image]
+ if {0 == [catch {uplevel #0 {package require Img}}]} {
+ .m.image add command -label {800x600} -command "image_800x600"
+ .m.image add separator
+ .m.image add command -label {Save file...} -command "image_savefile $HTML"
+ .m.image add command -label {Save test case} -command "image_savetest $HTML"
+ .m.image add separator
+ .m.image add command -label {Run all tests} -command "image_runtests $HTML"
+ } else {
+ .m add command -label "Image tests require Tcl package Img"
+ }
+
+ $HTML configure -imagecmd [list imageCmd $HTML]
+}
diff --git a/hv/hv3_main.tcl b/hv/hv3_main.tcl
index ddfbdf5..c1521ba 100644
--- a/hv/hv3_main.tcl
+++ b/hv/hv3_main.tcl
@@ -1,4 +1,4 @@
-namespace eval hv3 { set {version($Id: hv3_main.tcl,v 1.159 2007/10/07 16:30:08 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3_main.tcl,v 1.190 2008/03/02 14:43:49 danielk1977 Exp $)} 1 }
catch {memory init on}
@@ -8,7 +8,6 @@ proc sourcefile {file} [string map \
return [file join {%HV3_DIR%} $file]
}]
-
# Before doing anything else, set up profiling if it is requested.
# Profiling is only used if the "-profile" option was passed on
# the command line.
@@ -16,792 +15,115 @@ source [sourcefile hv3_profile.tcl]
::hv3::profile::init $argv
package require Tk
+tk scaling 1.33333
package require Tkhtml 3.0
-# option add *TButton.compound left
-
# If possible, load package "Img". Without it the script can still run,
-# but won't be able to load many image formats. Similarly, try to load
-# sqlite3. If sqlite3 is present cookies, auto-completion and
-# coloring of visited URIs work.
+# but won't be able to load many image formats.
#
if {[catch { package require Img } errmsg]} {
puts stderr "WARNING: $errmsg (most image types will fail to load)"
}
-if {[catch { package require sqlite3 } errmsg]} {
- puts stderr "WARNING: $errmsg"
-}
-proc htmlize {zIn} {
- string map [list "<" "<" ">" ">" "&" "&" "\"" ""e;"] $zIn
-}
+source [sourcefile hv3_browser.tcl]
-# Source the other script files that are part of this application.
-#
-if {[package vsatisfies [package provide Tcl] 8.5]} {
- # FIXME: Disabling snit2.tcl for now as it seems to be incompatible with
- # tcl 8.5b1.
- source [sourcefile snit.tcl]
-} else {
- source [sourcefile snit.tcl]
+namespace eval ::hv3 {
+ set log_source_option 0
+ set reformat_scripts_option 0
}
-source [sourcefile hv3_widgets.tcl]
-source [sourcefile hv3_encodings.tcl]
-source [sourcefile hv3_db.tcl]
-source [sourcefile hv3_home.tcl]
-source [sourcefile hv3.tcl]
-source [sourcefile hv3_prop.tcl]
-source [sourcefile hv3_log.tcl]
-source [sourcefile hv3_http.tcl]
-source [sourcefile hv3_frameset.tcl]
-source [sourcefile hv3_polipo.tcl]
-source [sourcefile hv3_icons.tcl]
-source [sourcefile hv3_history.tcl]
-source [sourcefile hv3_string.tcl]
-source [sourcefile hv3_bookmarks.tcl]
-source [sourcefile hv3_bugreport.tcl]
-
-#--------------------------------------------------------------------------
-# Widget ::hv3::browser_frame
-#
-# This mega widget is instantiated for each browser frame (a regular
-# html document has one frame, a <frameset> document may have more
-# than one). This widget is not considered reusable - it is designed
-# for the web browser only. The following application-specific
-# functionality is added to ::hv3::hv3:
+# This class is used to create toplevel "sub-window" widgets. Sub-windows
+# are toplevel windows that contain a single [::hv3::browser] object.
#
-# * The -statusvar option
-# * The right-click menu
-# * Overrides the default -targetcmd supplied by ::hv3::hv3
-# to respect the "target" attribute of <a> and <form> elements.
+# Sub-windows are different from the main window in several ways:
#
-# For more detail on handling the "target" attribute, see HTML 4.01.
-# In particular the following from appendix B.8:
-#
-# 1. If the target name is a reserved word as described in the
-# normative text, apply it as described.
-# 2. Otherwise, perform a depth-first search of the frame hierarchy
-# in the window that contained the link. Use the first frame whose
-# name is an exact match.
-# 3. If no such frame was found in (2), apply step 2 to each window,
-# in a front-to-back ordering. Stop as soon as you encounter a frame
-# with exactly the same name.
-# 4. If no such frame was found in (3), create a new window and
-# assign it the target name.
+# * There is no menubar.
+# * There is no "new tab", "home" or "bug report button on the toolbar.
+# * It is not possible to open new tabs in a sub-window.
#
-# Hv3 currently only implements steps 1 and 2.
+# These restrictions are because Hv3 is a tabbed browser. New views are
+# supposed to live in tabs, not separate toplevel windows. If the user
+# really wants more than one window, more than one copy of the browser
+# should be started. Sub-windows are provided purely for the benefit of
+# those javascript applications that have UIs that require multiple
+# windows.
#
-snit::widget ::hv3::browser_frame {
-
- component myHv3
-
- variable myNodeList "" ;# Current nodes under the pointer
- variable myX 0 ;# Current location of pointer
- variable myY 0 ;# Current location of pointer
-
- variable myBrowser "" ;# ::hv3::browser_toplevel widget
- variable myPositionId "" ;# See sub-command [positionid]
-
- # If "Copy Link Location" has been selected, store the selected text
- # (a URI) in variable $myCopiedLinkLocation.
- variable myCopiedLinkLocation ""
-
- constructor {browser args} {
- set myBrowser $browser
- $self configurelist $args
-
- set myHv3 [::hv3::hv3 $win.hv3]
- pack $myHv3 -expand true -fill both
-
- ::hv3::the_visited_db init $myHv3
-
- catch {$myHv3 configure -fonttable $::hv3::fontsize_table}
- # $myHv3 configure -downloadcmd [list $myBrowser savehandle]
- $myHv3 configure -downloadcmd [list ::hv3::the_download_manager savehandle]
-
- # Create bindings for motion, right-click and middle-click.
- $myHv3 Subscribe motion [list $self motion]
- bind $myHv3 <3> [list $self rightclick %x %y %X %Y]
- bind $myHv3 <2> [list $self goto_selection]
-
- # When the hyperlink menu "owns" the selection (happens after
- # "Copy Link Location" is selected), invoke method
- # [GetCopiedLinkLocation] with no arguments to retrieve it.
-
- # Register a handler command to handle <frameset>.
- set html [$myHv3 html]
- $html handler node frameset [list ::hv3::frameset_handler $self]
- $html handler node iframe [list ::hv3::iframe_handler $self]
-
- # Add this object to the browsers frames list. It will be removed by
- # the destructor proc. Also override the default -targetcmd
- # option of the ::hv3::hv3 widget with our own version.
- $myBrowser add_frame $self
- $myHv3 configure -targetcmd [list $self Targetcmd]
-
- ::hv3::menu ${win}.hyperlinkmenu
- selection handle ${win}.hyperlinkmenu [list $self GetCopiedLinkLocation]
- }
-
- # The name of this frame (as specified by the "name" attribute of
- # the <frame> element).
- option -name -default ""
-
- # If this [::hv3::browser_frame] is used as a replacement object
- # for an <iframe> element, then this option is set to the Tkhtml3
- # node-handle for that <iframe> element.
- #
- option -iframe -default ""
-
- method Targetcmd {node} {
- set target [$node attr -default "" target]
- if {$target eq ""} {
- # If there is no target frame specified, see if a default
- # target was specified in a <base> tag i.e. <base target="_top">.
- set n [lindex [[$myHv3 html] search base] 0]
- if {$n ne ""} { set target [$n attr -default "" target] }
- }
-
- set theTopFrame [[lindex [$myBrowser get_frames] 0] hv3]
-
- # Find the target frame widget.
- set widget $myHv3
- switch -- $target {
- "" { set widget $myHv3 }
- "_self" { set widget $myHv3 }
- "_top" { set widget $theTopFrame }
-
- "_parent" {
- set w [winfo parent $myHv3]
- while {$w ne "" && [lsearch [$myBrowser get_frames] $w] < 0} {
- set w [winfo parent $w]
- }
- if {$w ne ""} {
- set widget [$w hv3]
- } else {
- set widget $theTopFrame
- }
- }
-
- # This is incorrect. The correct behaviour is to open a new
- # top-level window. But hv3 doesn't support this (and because
- # reasonable people don't like new top-level windows) we load
- # the resource into the "_top" frame instead.
- "_blank" { set widget $theTopFrame }
-
- default {
- # In html 4.01, an unknown frame should be handled the same
- # way as "_blank". So this next line of code implements the
- # same bug as described for "_blank" above.
- set widget $theTopFrame
-
- # TODO: The following should be a depth first search through the
- # frames in the list returned by [get_frames].
- #
- foreach f [$myBrowser get_frames] {
- set n [$f cget -name]
- if {$n eq $target} {
- set widget [$f hv3]
- break
- }
- }
- }
- }
-
- return $widget
- }
-
- method parent_frame {} {
- set frames [$myBrowser get_frames]
- set w [winfo parent $self]
- while {$w ne "" && [lsearch $frames $w] < 0} {
- set w [winfo parent $w]
- }
- return $w
- }
- method top_frame {} {
- lindex [$myBrowser get_frames] 0
- }
- method child_frames {} {
- set ret [list]
- foreach c [$myBrowser frames_tree $self] {
- lappend ret [lindex $c 0]
- }
- set ret
- }
-
- # This method returns the "position-id" of a frame, an id that is
- # used by the history sub-system when loading a historical state of
- # a frameset document.
- #
- method positionid {} {
- if {$myPositionId eq ""} {
- set w $win
- while {[set p [winfo parent $w]] ne ""} {
- set class [winfo class $p]
- if {$class eq "Panedwindow"} {
- set a [lsearch [$p panes] $w]
- set w $p
- set p [winfo parent $p]
- set b [lsearch [$p panes] $w]
-
- set myPositionId [linsert $myPositionId 0 "${b}.${a}"]
- }
- if {$class eq "Hv3" && $myPositionId eq ""} {
- set node $options(-iframe)
- set idx [lsearch [$p search iframe] $node]
- set myPositionId [linsert $myPositionId 0 iframe.${idx}]
- }
- set w $p
- }
- set myPositionId [linsert $myPositionId 0 0]
- }
- return $myPositionId
- }
-
- destructor {
- # Remove this object from the $theFrames list.
- catch {$myBrowser del_frame $self}
- catch {destroy ${win}.hyperlinkmenu}
- }
-
- # This callback is invoked when the user right-clicks on this
- # widget. If the mouse cursor is currently hovering over a hyperlink,
- # popup the hyperlink menu. Otherwise launch the tree browser.
- #
- # Arguments $x and $y are the the current cursor position relative to
- # this widget's window. $X and $Y are the same position relative to
- # the root window.
- #
- method rightclick {x y X Y} {
-
- set m ${win}.hyperlinkmenu
- $m delete 0 end
-
- set nodelist [$myHv3 node $x $y]
-
- set a_href ""
- set img_src ""
- set select [$myHv3 selected]
- set leaf ""
-
- foreach leaf $nodelist {
- for {set N $leaf} {$N ne ""} {set N [$N parent]} {
- set tag [$N tag]
-
- if {$a_href eq "" && $tag eq "a"} {
- set a_href [$N attr -default "" href]
- }
- if {$img_src eq "" && $tag eq "img"} {
- set img_src [$N attr -default "" src]
- }
-
- }
- }
-
- if {$a_href ne ""} {set a_href [$myHv3 resolve_uri $a_href]}
- if {$img_src ne ""} {set img_src [$myHv3 resolve_uri $img_src]}
-
- set MENU [list \
- a_href "Open Link" [list $self menu_select open $a_href] \
- a_href "Open Link in Bg Tab" [list $self menu_select opentab $a_href] \
- a_href "Download Link" [list $self menu_select download $a_href] \
- a_href "Copy Link Location" [list $self menu_select copy $a_href] \
- a_href -- "" \
- img_src "View Image" [list $self menu_select open $img_src] \
- img_src "View Image in Bg Tab" [list $self menu_select opentab $img_src] \
- img_src "Download Image" [list $self menu_select download $img_src]\
- img_src "Copy Image Location" [list $self menu_select copy $img_src] \
- img_src -- "" \
- select "Copy Selected Text" [list $self menu_select copy $select] \
- select -- "" \
- leaf "Open Tree browser..." [list ::HtmlDebug::browse $myHv3 $leaf] \
- ]
-
- foreach {var label cmd} $MENU {
- if {$var eq "" || [set $var] ne ""} {
- if {$label eq "--"} {
- $m add separator
- } else {
- $m add command -label $label -command $cmd
- }
- }
- }
-
- $::hv3::G(config) populate_hidegui_entry $m
- $m add separator
-
- # Add the "File", "Search", "View" and "Debug" menus.
- foreach sub [list File Search Options Debug History] {
- catch {
- set menu_widget $m.[string tolower $sub]
- gui_populate_menu $sub [::hv3::menu $menu_widget]
- }
- $m add cascade -label $sub -menu $menu_widget -underline 0
- }
-
- tk_popup $m $X $Y
- }
-
- # Called when an option has been selected on the hyper-link menu. The
- # argument identifies the specific option. May be one of:
- #
- # open
- # opentab
- # download
- # copy
- #
- method menu_select {option uri} {
- switch -- $option {
- open {
- set top_frame [lindex [$myBrowser get_frames] 0]
- $top_frame goto $uri
- }
- opentab { set new [.notebook addbg $uri] }
- download { $myBrowser saveuri $uri }
- copy {
- set myCopiedLinkLocation $uri
- selection own ${win}.hyperlinkmenu
- clipboard clear
- clipboard append $uri
- }
-
- default {
- error "Internal error"
- }
- }
- }
-
- method GetCopiedLinkLocation {args} {
- return $myCopiedLinkLocation
- }
-
- # Called when the user middle-clicks on the widget
- method goto_selection {} {
- set theTopFrame [lindex [$myBrowser get_frames] 0]
- $theTopFrame goto [selection get]
- }
-
- method motion {N x y} {
- set myX $x
- set myY $y
- set myNodeList $N
- $self update_statusvar
- }
-
- method node_to_string {node {hyperlink 1}} {
- set value ""
- for {set n $node} {$n ne ""} {set n [$n parent]} {
- if {[info commands $n] eq ""} break
- set tag [$n tag]
- if {$tag eq ""} {
- set value [$n text]
- } elseif {$hyperlink && $tag eq "a" && [$n attr -default "" href] ne ""} {
- set value "hyper-link: [string trim [$n attr href]]"
- break
- } elseif {[set nid [$n attr -default "" id]] ne ""} {
- set value "<$tag id=$nid>$value"
- } else {
- set value "<$tag>$value"
- }
- }
- return $value
- }
-
- method update_statusvar {} {
- if {$options(-statusvar) ne ""} {
- global $options(-statusvar)
- set str ""
- switch -- $::hv3::G(status_mode) {
- browser-tree {
- set value [$self node_to_string [lindex $myNodeList end]]
- set str "($myX $myY) $value"
- }
- browser {
- for {set n [lindex $myNodeList end]} {$n ne ""} {set n [$n parent]} {
- if {[$n tag] eq "a" && [$n attr -default "" href] ne ""} {
- set str "hyper-link: [string trim [$n attr href]]"
- break
- }
- }
- }
- }
-
- if {$options(-statusvar) ne $str} {
- set $options(-statusvar) $str
- }
- }
- }
-
- #--------------------------------------------------------------------------
- # PUBLIC INTERFACE
- #--------------------------------------------------------------------------
-
- method goto {args} {
- eval [concat $myHv3 goto $args]
- set myNodeList ""
- $self update_statusvar
- }
-
- # Launch the tree browser
- method browse {} {
- ::HtmlDebug::browse $myHv3 [$myHv3 node]
- }
-
- method hv3 {} { return $myHv3 }
- method browser {} { return $myBrowser }
-
- # The [isframeset] method returns true if this widget instance has
- # been used to parse a frameset document (widget instances may parse
- # either frameset or regular HTML documents).
- #
- method isframeset {} {
- # When a <FRAMESET> tag is parsed, a node-handler in hv3_frameset.tcl
- # creates a widget to manage the frames and then uses [place] to
- # map it on top of the html widget created by this ::hv3::browser_frame
- # widget. Todo: It would be better if this code was in the same file
- # as the node-handler, otherwise this test is a bit obscure.
- #
- set html [[$self hv3] html]
- set slaves [place slaves $html]
- set isFrameset 0
- if {[llength $slaves]>0} {
- set isFrameset [expr {[winfo class [lindex $slaves 0]] eq "Frameset"}]
- }
- return $isFrameset
- }
-
- option -statusvar -default ""
-
- delegate option -forcefontmetrics to myHv3
- delegate option -fonttable to myHv3
- delegate option -fontscale to myHv3
- delegate option -zoom to myHv3
- delegate option -enableimages to myHv3
- delegate option -dom to myHv3
-
- delegate method dumpforms to myHv3
-
- delegate option -width to myHv3
- delegate option -height to myHv3
-
- delegate option -requestcmd to myHv3
- delegate option -resetcmd to myHv3
- delegate option -pendingcmd to myHv3
-
- delegate method stop to myHv3
- delegate method titlevar to myHv3
- delegate method javascriptlog to myHv3
-}
-
-# An instance of this widget represents a top-level browser frame (not
-# a toplevel window - an html frame not contained in any frameset
-# document). These are the things managed by the notebook widget.
-#
-snit::widget ::hv3::browser_toplevel {
-
- component myHistory ;# The back/forward system
- component myProtocol ;# The ::hv3::protocol
- component myMainFrame ;# The browser_frame widget
- component myDom ;# The ::hv3::dom object
-
- # Variables passed to [$myProtocol configure -statusvar] and
- # the same option of $myMainFrame. Used to create the value for
- # $myStatusVar.
- variable myProtocolStatus ""
- variable myFrameStatus ""
+namespace eval ::hv3::subwindow {
- variable myStatusVar ""
- variable myLocationVar ""
+ set counter 1
- # List of all ::hv3::browser_frame objects using this object as
- # their toplevel browser.
- variable myFrames [list]
+ proc new {me args} {
+ upvar #0 $me O
- method statusvar {} {return [myvar myStatusVar]}
- delegate method titlevar to myMainFrame
+ set O(browser) [::hv3::browser $O(win).browser]
+ set O(label) [::hv3::label $O(win).label -anchor w -width 1]
+ set O(location) [::hv3::locationentry $O(win).location]
- constructor {args} {
- set myDom [::hv3::dom %AUTO% $self]
+ set O(stop_button) $O(win).stop
+ set O(back_button) $O(win).back
+ set O(next_button) $O(win).next
- # Create the main browser frame (always present)
- set myMainFrame [::hv3::browser_frame $win.browser_frame $self]
- pack $myMainFrame -expand true -fill both -side top
+ ::hv3::toolbutton $O(stop_button) -text {Stop} -tooltip "Stop"
+ ::hv3::toolbutton $O(next_button) -text {Forward} -tooltip "Go Forward"
+ ::hv3::toolbutton $O(back_button) -text {Back} -tooltip "Go Back"
+
+ grid $O(back_button) $O(next_button) $O(stop_button)
+ grid $O(location) -column 3 -row 0 -sticky ew
+ grid $O(browser) -column 0 -row 1 -sticky nsew -columnspan 4
+ grid $O(label) -column 0 -row 2 -sticky nsew -columnspan 4
- # Create the protocol
- set myProtocol [::hv3::protocol %AUTO%]
- $myMainFrame configure -requestcmd [list $myProtocol requestcmd]
- $myMainFrame configure -pendingcmd [list $self pendingcmd]
+ grid columnconfigure $O(win) 3 -weight 1
+ grid rowconfigure $O(win) 1 -weight 1
- trace add variable [myvar myProtocolStatus] write [list $self Writestatus]
- trace add variable [myvar myFrameStatus] write [list $self Writestatus]
- $myMainFrame configure -statusvar [myvar myFrameStatus]
- $myProtocol configure -statusvar [myvar myProtocolStatus]
+ $O(back_button) configure -image hv3_previmg
+ $O(next_button) configure -image hv3_nextimg
+ $O(stop_button) configure -image hv3_reloadimg
- # Link in the "home:" and "about:" scheme handlers (from hv3_home.tcl)
- ::hv3::home_scheme_init [$myMainFrame hv3] $myProtocol
- ::hv3::cookies_scheme_init $myProtocol
- ::hv3::download_scheme_init [$myMainFrame hv3] $myProtocol
+ $O(label) configure -textvar [$O(browser) statusvar]
+ $O(browser) configure -stopbutton $O(stop_button)
+ $O(browser) configure -forwardbutton $O(next_button)
+ $O(browser) configure -backbutton $O(back_button)
+ $O(browser) configure -locationentry $O(location)
+ $O(location) configure -command [list $me GotoLocation]
- # Create the history sub-system
- set myHistory [::hv3::history %AUTO% [$myMainFrame hv3] $myProtocol $self]
- $myHistory configure -gotocmd [list $self goto]
+ $O(browser) configure -width 600 -height 400
- $self configurelist $args
- }
-
- destructor {
- if {$myProtocol ne ""} { $myProtocol destroy }
- if {$myHistory ne ""} { $myHistory destroy }
- if {$myDom ne ""} { $myDom destroy }
- }
-
- # This method is called to activate the download-manager to download
- # the specified URI ($uri) to the local file-system.
- #
- method saveuri {uri} {
- set handle [::hv3::download %AUTO% \
- -uri $uri \
- -mimetype application/gzip \
- ]
- $handle configure \
- -incrscript [list ::hv3::the_download_manager savehandle $handle] \
- -finscript [list ::hv3::the_download_manager savehandle $handle]
-
- $myProtocol requestcmd $handle
- }
-
- # Interface used by code in class ::hv3::browser_frame for frame management.
- #
- method add_frame {frame} {
- lappend myFrames $frame
- if {$myHistory ne ""} {
- $myHistory add_hv3 [$frame hv3]
- }
- set HTML [[$frame hv3] html]
- bind $HTML <1> [list focus %W]
- bind $HTML <KeyPress-slash> [list $self Find]
- bindtags $HTML [concat Hv3HotKeys $self [bindtags $HTML]]
- if {[$myDom cget -enable]} {
- $frame configure -dom $myDom
- }
- $::hv3::G(config) configureframe $frame
- }
- method del_frame {frame} {
- set idx [lsearch $myFrames $frame]
- if {$idx >= 0} {
- set myFrames [lreplace $myFrames $idx $idx]
- }
- }
- method get_frames {} {return $myFrames}
-
- # Return a list describing the current structure of the frameset
- # displayed by this browser.
- #
- method frames_tree {{head {}}} {
- set ret ""
-
- array set A {}
- foreach f [lsort $myFrames] {
- set p [$f parent_frame]
- lappend A($p) $f
- if {![info exists A($f)]} {set A($f) [list]}
- }
-
- foreach f [concat [lsort -decreasing $myFrames] [list {}]] {
- set new [list]
- foreach child $A($f) {
- lappend new [list $child $A($child)]
- }
- set A($f) $new
- }
-
- set A($head)
- }
+ set O(titlevarname) [$O(browser) titlevar]
+ set O(locationvarname) [$O(browser) locationvar]
- # This method is called by a [trace variable ... write] hook attached
- # to the myProtocolStatus variable. Set myStatusVar.
- method Writestatus {args} {
- set myStatusVar "$myProtocolStatus $myFrameStatus"
- }
-
- method set_frame_status {text} {
- set myFrameStatus $text
- }
-
- # The widget may be in one of two states - "pending" or "not pending".
- # "pending" state is when the browser is still waiting for one or more
- # downloads to finish before the document is correctly displayed. In
- # this mode the default cursor is an hourglass and the stop-button
- # widget is in normal state (stop button is clickable).
- #
- # Otherwise the default cursor is "" (system default) and the stop-button
- # widget is disabled.
- #
- variable myIsPending 0
- variable myPendingPending ""
-
- method pendingcmd {isPending} {
- if {$myPendingPending eq ""} {
- after idle [list $self do_pendingcmd]
- }
- set myPendingPending [expr {$isPending>0}]
+ # Set up traces on the browser title and location. Use these to
+ # set the title of the toplevel window.
+ trace add variable $O(titlevarname) write [list $me SetTitle]
+ trace add variable $O(locationvarname) write [list $me SetTitle]
}
- method do_pendingcmd {} {
- if {$options(-stopbutton) ne "" && $myIsPending != $myPendingPending} {
- if {$myPendingPending} {
- $options(-stopbutton) configure -state normal
- $hull configure -cursor watch
- } else {
- $options(-stopbutton) configure -state disabled
- $hull configure -cursor ""
- }
- $options(-stopbutton) configure -command [list $myMainFrame stop]
- set myIsPending $myPendingPending
+ proc SetTitle {me args} {
+ upvar #0 $me O
+ set T [set [$O(browser) titlevar]]
+ if {$T eq ""} {
+ set T [set [$O(browser) locationvar]]
}
- set myPendingPending ""
- }
-
- method Configurestopbutton {option value} {
- set options(-stopbutton) $value
- set val $myIsPending
- set myIsPending -1
- $self pendingcmd $val
+ wm title $O(win) $T
}
- # Escape --
- #
- # This method is called when the <Escape> key sequence is seen.
- # Get rid of the "find-text" widget, if it is currently visible.
- #
- method escape {} {
- catch {
- destroy ${win}.findwidget
- }
+ proc destroy {me} {
+ upvar #0 $me O
+ trace remove variable $O(titlevarname) write [list $me SetTitle]
+ trace remove variable $O(locationvarname) write [list $me SetTitle]
}
- method packwidget {w} {
- pack $w -before $myMainFrame -side bottom -fill x -expand false
- bind $w <Destroy> [list catch [list focus [[$myMainFrame hv3] html]]]
+ proc goto {me uri} {
+ upvar #0 $me O
+ $O(browser) goto $uri
}
- # Find --
- #
- # This method is called when the "find-text" widget is summoned.
- # Currently this can happen when the users:
- #
- # * Presses "control-f",
- # * Presses "/", or
- # * Selects the "Edit->Find Text" pull-down menu command.
- #
- method Find {} {
-
- set fdname ${win}.findwidget
- set initval ""
- if {[llength [info commands $fdname]] > 0} {
- set initval [${fdname}.entry get]
- destroy $fdname
- }
-
- ::hv3::findwidget $fdname $self
-
- $self packwidget $fdname
- $fdname configure -borderwidth 1 -relief raised
-
- # Bind up, down, next and prior key-press events to scroll the
- # main hv3 widget. This means you can use the keyboard to scroll
- # window (vertically) without shifting focus from the
- # find-as-you-type box.
- #
- set hv3 [$self hv3]
- bind ${fdname} <KeyPress-Up> [list $hv3 yview scroll -1 units]
- bind ${fdname} <KeyPress-Down> [list $hv3 yview scroll 1 units]
- bind ${fdname} <KeyPress-Next> [list $hv3 yview scroll 1 pages]
- bind ${fdname} <KeyPress-Prior> [list $hv3 yview scroll -1 pages]
-
- # When the findwidget is destroyed, return focus to the html widget.
- bind ${fdname} <KeyPress-Escape> gui_escape
-
- ${fdname}.entry insert 0 $initval
- focus ${fdname}.entry
+ proc GotoLocation {me} {
+ upvar #0 $me O
+ set uri [$O(location) get]
+ $O(browser) goto $uri
}
-
- # ProtocolGui --
- #
- # This method is called when the "toggle-protocol-gui" control
- # (implemented externally) is manipulated. The argument must
- # be one of the following strings:
- #
- # "show" (display gui)
- # "hide" (hide gui)
- # "toggle" (display if hidden, hide if displayed)
- #
- method ProtocolGui {cmd} {
- set name ${win}.protocolgui
- set exists [winfo exists $name]
-
- switch -- $cmd {
- show {if {$exists} return}
- hide {if {!$exists} return}
- toggle {
- set cmd "show"
- if {$exists} {set cmd "hide"}
- }
-
- default { error "Bad arg" }
- }
-
- if {$cmd eq "hide"} {
- destroy $name
- } else {
- $myProtocol gui $name
- $self packwidget $name
- }
- }
-
- method history {} {
- return $myHistory
- }
-
- method reload {} {
- $myHistory reload
- }
-
- option -enablejavascript \
- -default 0 \
- -configuremethod ConfigureEnableJavascript \
- -cgetmethod CgetEnableJavascript
-
- method ConfigureEnableJavascript {option value} {
- $myDom configure -enable $value
- set dom ""
- if {$value} { set dom $myDom }
- foreach f $myFrames {
- $f configure -dom $dom
- }
- }
- method CgetEnableJavascript {option} {
- $myDom cget -enable
- }
-
- delegate method populate_history_menu to myHistory as populate_menu
-
- option -stopbutton -default "" -configuremethod Configurestopbutton
-
- delegate option -backbutton to myHistory
- delegate option -forwardbutton to myHistory
- delegate option -locationentry to myHistory
-
- delegate method locationvar to myHistory
- delegate method populatehistorymenu to myHistory
-
- delegate method debug_cookies to myProtocol
-
- delegate option * to myMainFrame
- delegate method * to myMainFrame
}
+::hv3::make_constructor ::hv3::subwindow toplevel
# ::hv3::config
#
@@ -825,6 +147,8 @@ snit::type ::hv3::config {
-zoom 1.0 Double \
-fontscale 1.0 Double \
-guifont 11 Integer \
+ -icons default_icons Icons \
+ -debuglevel 0 Integer \
-fonttable [list 8 9 10 11 13 15 17] SevenIntegers \
] {
option $opt -default $def -validatemethod $type -configuremethod SetOption
@@ -833,6 +157,7 @@ snit::type ::hv3::config {
constructor {db args} {
set myDb $db
+
$myDb transaction {
set rc [catch {
$myDb eval {
@@ -843,6 +168,9 @@ snit::type ::hv3::config {
foreach {n v} [array get options] {
$myDb eval {INSERT INTO cfg_options1 VALUES($n, $v)}
}
+ if {[llength [info commands ::tkhtml::heapdebug]] > 0} {
+ $self configure -debuglevel 1
+ }
} else {
$myDb eval {SELECT name, value FROM cfg_options1} {
set options($name) $value
@@ -853,6 +181,8 @@ snit::type ::hv3::config {
}
}
+ ::hv3::$options(-icons)
+
$self configurelist $args
after 2000 [list $self PollConfiguration]
}
@@ -861,9 +191,10 @@ snit::type ::hv3::config {
set myPollActive 1
$myDb transaction {
foreach n [array names options] {
- set v [$myDb one { SELECT value FROM cfg_options1 WHERE name = $n }]
- if {$options($n) ne $v} {
- $self configure $n $v
+ $myDb eval { SELECT value AS v FROM cfg_options1 WHERE name = $n } {
+ if {$options($n) ne $v} {
+ $self configure $n $v
+ }
}
}
}
@@ -886,6 +217,15 @@ snit::type ::hv3::config {
]
$path add cascade -label {Gui Font} -menu ${path}.guifont
+ # Add the 'Icons' menu
+ ::hv3::menu ${path}.icons
+ $self PopulateRadioMenu ${path}.icons -icons [list \
+ grey_icons "Great looking classy grey icons" \
+ color_icons22 "22x22 Tango icons" \
+ color_icons32 "32x32 Tango icons" \
+ ]
+ $path add cascade -label {Gui Icons} -menu ${path}.icons
+
$self populate_hidegui_entry $path
$path add separator
@@ -975,6 +315,9 @@ snit::type ::hv3::config {
method Integer {option value} {
if {![string is integer $value]} { error "Bad integer value: $value" }
}
+ method Icons {option value} {
+ if {[info commands ::hv3::$value] eq ""} { error "Bad icon scheme: $value" }
+ }
method SevenIntegers {option value} {
set len [llength $value]
if {$len != 7} { error "Bad seven-integers value: $value" }
@@ -1006,6 +349,25 @@ snit::type ::hv3::config {
-guifont {
::hv3::SetFont [list -size $options(-guifont)]
}
+ -icons {
+ ::hv3::$options(-icons)
+ }
+ -debuglevel {
+ switch -- $value {
+ 0 {
+ set ::hv3::reformat_scripts_option 0
+ set ::hv3::log_source_option 0
+ }
+ 1 {
+ set ::hv3::reformat_scripts_option 0
+ set ::hv3::log_source_option 1
+ }
+ 2 {
+ set ::hv3::reformat_scripts_option 1
+ set ::hv3::log_source_option 1
+ }
+ }
+ }
default {
$self configurebrowser [.notebook current]
}
@@ -1018,6 +380,7 @@ snit::type ::hv3::config {
}
method configurebrowser {b} {
+ if {$b eq ""} return
foreach {option var} [list \
-fonttable options(-fonttable) \
-fontscale options(-fontscale) \
@@ -1043,6 +406,7 @@ snit::type ::hv3::config {
-zoom options(-zoom) \
-forcefontmetrics options(-forcefontmetrics) \
-enableimages options(-enableimages) \
+ -enablejavascript options(-enablejavascript) \
] {
if {[$b cget $option] ne [set $var]} {
$b configure $option [set $var]
@@ -1108,7 +472,7 @@ snit::type ::hv3::search {
method search {{default ""}} {
if {$default eq ""} {set default $myDefaultEngine}
- # The currently visible ::hv3::browser_toplevel widget.
+ # The currently visible ::hv3::browser widget.
set btl [.notebook current]
set fdname ${btl}.findwidget
@@ -1151,9 +515,10 @@ snit::type ::hv3::file_menu {
"Open Tab" [list $::hv3::G(notebook) add] t \
"Open Location" [list gui_openlocation $::hv3::G(location_entry)] l \
"-----" "" "" \
- "Bookmark Page" [list ::hv3::gui_bookmark] b \
+ "Bookmark This Page" [list ::hv3::gui_bookmark] b \
"-----" "" "" \
"Downloads..." [list ::hv3::the_download_manager show] "" \
+ "Bookmarks..." [list gui_current goto home://bookmarks/] "" \
"-----" "" "" \
"Close Tab" [list $::hv3::G(notebook) close] "" \
"Exit" exit q \
@@ -1199,7 +564,12 @@ snit::type ::hv3::debug_menu {
variable MENU
- constructor {} {
+ variable myDebugLevel
+ variable myHv3Options
+
+ constructor {hv3_options} {
+ set myHv3Options $hv3_options
+ set myDebugLevel [$hv3_options cget -debuglevel]
set MENU [list \
"Cookies" [list $::hv3::G(notebook) add cookies:] "" \
"About" [list $::hv3::G(notebook) add home://about] "" \
@@ -1207,9 +577,9 @@ snit::type ::hv3::debug_menu {
"Events..." [list gui_log_window $::hv3::G(notebook)] "" \
"-----" [list] "" \
"Tree Browser..." [list gui_current browse] "" \
- "Javascript Debugger..." [list gui_current javascriptlog] j \
- "DOM Reference..." [list $::hv3::G(notebook) add home://domref] "" \
+ "Debugging Console..." [list ::hv3::launch_console] d \
"-----" [list] "" \
+ "Sub-Window..." gui_subwindow "" \
"Exec firefox -remote" [list gui_firefox_remote] "" \
"-----" [list] "" \
"Reset Profiling Data..." [list ::hv3::profile::zero] "" \
@@ -1219,6 +589,24 @@ snit::type ::hv3::debug_menu {
method populate_menu {path} {
$path delete 0 end
+
+ set m [::hv3::menu ${path}.debuglevel]
+ $m add radiobutton \
+ -variable [myvar myDebugLevel] \
+ -value 0 \
+ -command [list $self SetDebugLevel] \
+ -label "No logging"
+ $m add radiobutton \
+ -variable [myvar myDebugLevel] \
+ -value 1 \
+ -command [list $self SetDebugLevel] \
+ -label "Log source"
+ $m add radiobutton \
+ -variable [myvar myDebugLevel] \
+ -value 2 \
+ -command [list $self SetDebugLevel] \
+ -label "Reformat and log source (buggy)"
+
foreach {label command key} $MENU {
if {[string match ---* $label]} {
$path add separator
@@ -1229,12 +617,21 @@ snit::type ::hv3::debug_menu {
set acc "(Ctrl-[string toupper $key])"
$path entryconfigure end -accelerator $acc
}
+ if {$key eq "d"} {
+ $path add cascade -menu $m -label "Application Source Logging"
+ }
}
if {0 == [hv3::profile::enabled]} {
$path entryconfigure end -state disabled
$path entryconfigure [expr [$path index end] - 1] -state disabled
}
+
+ $self SetDebugLevel
+ }
+
+ method SetDebugLevel {} {
+ $myHv3Options configure -debuglevel $myDebugLevel
}
method setup_hotkeys {} {
@@ -1255,7 +652,6 @@ snit::type ::hv3::debug_menu {
#
# gui_build
# gui_menu
-# gui_load_tkcon
# create_fontsize_menu
# create_fontscale_menu
#
@@ -1276,7 +672,7 @@ snit::type ::hv3::debug_menu {
# back_button The "back" button
# forward_button The "forward" button
# location_entry The location bar
-# notebook The ::hv3::notebook instance
+# notebook The ::hv3::tabset instance
# status_label The label used for a status bar
# history_menu The pulldown menu used for history
#
@@ -1296,35 +692,16 @@ proc gui_build {widget_array} {
::hv3::toolbutton .toolbar.b.home -text Home -command [list \
gui_current goto $::hv3::homeuri
]
- ::hv3::toolbutton .toolbar.b.reload -text Reload -command {gui_current reload}
::hv3::toolbutton .toolbar.bug -text {Report Bug} -command gui_report_bug
.toolbar.b.new configure -tooltip "Open New Tab"
- .toolbar.b.home configure -tooltip "Go Home"
- .toolbar.b.reload configure -tooltip "Reload Current Document"
+ .toolbar.b.home configure -tooltip "Go to Bookmarks Manager"
.toolbar.bug configure -tooltip "Bug Report"
- catch {
- set backimg [image create photo -data $::hv3::back_icon]
- .toolbar.b.back configure -image $backimg
- set forwardimg [image create photo -data $::hv3::forward_icon]
- .toolbar.b.forward configure -image $forwardimg
- set stopimg [image create photo -data $::hv3::stop_icon]
- .toolbar.b.stop configure -image $stopimg
- set newimg [image create photo -data $::hv3::new_icon]
- .toolbar.b.new configure -image $newimg
- set homeimg [image create photo -data $::hv3::home_icon]
- .toolbar.b.home configure -image $homeimg
- set reloadimg [image create photo -data $::hv3::reload_icon]
- .toolbar.b.reload configure -image $reloadimg
- set bugimg [image create photo -data $::hv3::bug_icon]
- .toolbar.bug configure -image $bugimg
- }
-
# Create the middle bit - the browser window
#
- ::hv3::notebook .notebook \
+ ::hv3::tabset .notebook \
-newcmd gui_new \
-switchcmd gui_switch
@@ -1342,7 +719,6 @@ proc gui_build {widget_array} {
set G(back_button) .toolbar.b.back
set G(forward_button) .toolbar.b.forward
set G(home_button) .toolbar.b.home
- set G(reload_button) .toolbar.b.reload
set G(location_entry) .toolbar.entry
set G(notebook) .notebook
set G(status_label) .status
@@ -1364,7 +740,6 @@ proc gui_build {widget_array} {
pack .toolbar.b.new -side left
pack .toolbar.b.back -side left
pack .toolbar.b.forward -side left
- pack .toolbar.b.reload -side left
pack .toolbar.b.stop -side left
pack .toolbar.b.home -side left
pack [frame .toolbar.b.spacer -width 2 -height 1] -side left
@@ -1386,26 +761,6 @@ proc goto_gui_location {browser entry args} {
$browser goto $location
}
-# A helper function for gui_menu.
-#
-# This procedure attempts to load the tkcon package. An error is raised
-# if the package cannot be loaded. On success, an empty string is returned.
-#
-proc gui_load_tkcon {} {
- foreach f [list \
- [file join $::tcl_library .. .. bin tkcon] \
- [file join $::tcl_library .. .. bin tkcon.tcl]
- ] {
- if {[file exists $f]} {
- uplevel #0 "source $f"
- package require tkcon
- return
- }
- }
- error "Failed to load Tkcon"
- return ""
-}
-
proc gui_openlocation {location_entry} {
$location_entry selection range 0 end
$location_entry OpenDropdown *
@@ -1448,10 +803,10 @@ proc gui_menu {widget_array} {
# Attach a menu widget - .m - to the toplevel application window.
. config -menu [::hv3::menu .m]
+ set G(config) [::hv3::config %AUTO% ::hv3::sqlitedb]
set G(file_menu) [::hv3::file_menu %AUTO%]
- set G(debug_menu) [::hv3::debug_menu %AUTO%]
set G(search) [::hv3::search %AUTO%]
- set G(config) [::hv3::config %AUTO% ::hv3::sqlitedb]
+ set G(debug_menu) [::hv3::debug_menu %AUTO% $G(config)]
# Add the "File", "Search" and "View" menus.
foreach m [list File Search Options Debug History] {
@@ -1462,6 +817,15 @@ proc gui_menu {widget_array} {
$G(file_menu) setup_hotkeys
$G(debug_menu) setup_hotkeys
+
+ catch {
+ .toolbar.b.back configure -image hv3_previmg
+ .toolbar.b.forward configure -image hv3_nextimg
+ .toolbar.b.stop configure -image hv3_stopimg
+ .toolbar.b.new configure -image hv3_newimg
+ .toolbar.b.home configure -image hv3_homeimg
+ .toolbar.bug configure -image hv3_bugimg
+ }
}
#--------------------------------------------------------------------------
@@ -1496,6 +860,7 @@ proc gui_switch {new} {
$new configure -stopbutton $G(stop_button)
$new configure -forwardbutton $G(forward_button)
$new configure -locationentry $G(location_entry)
+ $new populatehistorymenu
# Attach some other GUI elements to the new current tab.
#
@@ -1518,7 +883,7 @@ proc gui_switch {new} {
}
proc gui_new {path args} {
- set new [::hv3::browser_toplevel $path]
+ set new [::hv3::browser $path]
$::hv3::G(config) configurebrowser $new
set var [$new titlevar]
@@ -1528,7 +893,7 @@ proc gui_new {path args} {
trace add variable $var write [list gui_settitle $new $var]
if {[llength $args] == 0} {
- $new goto $::hv3::homeuri
+ $new goto $::hv3::newuri
} else {
$new goto [lindex $args 0]
}
@@ -1539,8 +904,9 @@ proc gui_new {path args} {
# events are not generated until the window is mapped. So generate
# an extra <<Location>> when the window is mapped.
#
- bind [$new hv3] <Map> [list event generate [$new hv3] <<Location>>]
- bind [$new hv3] <Map> +[list bind <Map> [$new hv3] ""]
+ set w [[$new hv3] win]
+ bind $w <Map> [list event generate $w <<Location>>]
+ bind $w <Map> +[list bind <Map> $w ""]
# [[$new hv3] html] configure -logcmd print
@@ -1581,7 +947,7 @@ proc gui_log_window {notebook} {
proc gui_report_bug {} {
upvar ::hv3::G G
set uri [[[$G(notebook) current] hv3] uri get]
- .notebook add "home://bug/[::hv3::format_query $uri]"
+ .notebook add "home://bug/[::hv3::format_query [encoding system] $uri]"
set cookie "tkhtml_captcha=[expr [clock seconds]+86399]; Path=/; Version=1"
::hv3::the_cookie_manager SetCookie http://tkhtml.tcl.tk/ $cookie
@@ -1672,6 +1038,17 @@ proc gui_set_memstatus {widget_array} {
}
}
+# Launch a new sub-window.
+#
+proc gui_subwindow {{uri ""}} {
+ set name ".subwindow_[incr ::hv3::subwindow::counter]"
+ ::hv3::subwindow $name
+ if {$uri eq ""} {
+ set uri [[gui_current hv3] uri get]
+ }
+ $name goto $uri
+}
+
# Override the [exit] command to check if the widget code leaked memory
# or not before exiting.
#
@@ -1683,11 +1060,6 @@ proc exit {args} {
eval [concat tcl_exit $args]
}
-proc JS {args} {
- set script [join $args " "]
- [[gui_current hv3] dom] javascript $script
-}
-
#--------------------------------------------------------------------------
# main URI
#
@@ -1710,6 +1082,9 @@ proc main {args} {
# Ignore this here. If the -profile option is present it will
# have been handled already.
}
+ -enablejavascript {
+ set enablejavascript 1
+ }
default {
set uri [::tkhtml::uri file:///[pwd]/]
lappend docs [$uri resolve $val]
@@ -1721,13 +1096,17 @@ proc main {args} {
::hv3::dbinit
if {[llength $docs] == 0} {set docs [list home://bookmarks/]}
- # set ::hv3::homeuri [lindex $docs 0]
+ set ::hv3::newuri [lindex $docs 0]
set ::hv3::homeuri home://bookmarks/
# Build the GUI
gui_build ::hv3::G
gui_menu ::hv3::G
+ if {[info exists enablejavascript]} {
+ $::hv3::G(config) configure -enablejavascript 1
+ }
+
::hv3::downloadmanager ::hv3::the_download_manager
# After the event loop has run to create the GUI, run [main2]
diff --git a/hv/hv3_nav.tcl b/hv/hv3_nav.tcl
new file mode 100644
index 0000000..9a93d34
--- /dev/null
+++ b/hv/hv3_nav.tcl
@@ -0,0 +1,78 @@
+
+###########################################################################
+# hv3_nav.tcl --
+#
+# The public interface to this file is the commands:
+#
+# nav_init HTML
+# nav_add HTML URL
+#
+
+#--------------------------------------------------------------------------
+# Global variables section
+set ::html_nav_doclist [list]
+set ::html_nav_where -1
+
+#--------------------------------------------------------------------------
+
+proc nav_init {HTML} {
+ .m add cascade -label {Navigation} -menu [menu .m.nav]
+ .m.nav add command -label {Forward} -command [list navForward $HTML]
+ .m.nav add command -label {Back} -command [list navBack $HTML]
+ .m.nav add separator
+
+ set ::html_nav_doclist [list]
+ navEnableDisable
+}
+
+proc nav_add {HTML url} {
+ if {$url == [lindex $::html_nav_doclist $::html_nav_where]} return
+
+ if {$url != [lindex $::html_nav_doclist [expr $::html_nav_where + 1]]} {
+ set ::html_nav_doclist [lrange $::html_nav_doclist 0 $::html_nav_where]
+ lappend ::html_nav_doclist $url
+ }
+ incr ::html_nav_where
+ navEnableDisable
+}
+
+proc navForward {HTML} {
+ navGoto [expr $::html_nav_where + 1]
+}
+
+proc navBack {HTML} {
+ navGoto [expr $::html_nav_where - 1]
+}
+
+proc navGoto {where} {
+ set ::html_nav_where $where
+ gui_goto [lindex $::html_nav_doclist $::html_nav_where]
+ navEnableDisable
+}
+
+proc navEnableDisable {} {
+ if {$::html_nav_where < 1} {
+ .m.nav entryconfigure Back -state disabled
+ } else {
+ .m.nav entryconfigure Back -state normal
+ }
+ if {$::html_nav_where == ([llength $::html_nav_doclist] - 1)} {
+ .m.nav entryconfigure Forward -state disabled
+ } else {
+ .m.nav entryconfigure Forward -state normal
+ }
+
+ if {[.m.nav index end] > 3} {
+ .m.nav delete 4 end
+ }
+ for {set ii 0} {$ii < [llength $::html_nav_doclist]} {incr ii} {
+ set doc [lindex $::html_nav_doclist $ii]
+ .m.nav add command -label $doc -command [list navGoto $ii]
+ }
+
+ if {[.m.nav index end] > 3} {
+ set idx [expr $::html_nav_where + 4]
+ .m.nav entryconfigure $idx -background white -state disabled
+ }
+}
+
diff --git a/hv/hv3_notebook.tcl b/hv/hv3_notebook.tcl
new file mode 100644
index 0000000..28eae13
--- /dev/null
+++ b/hv/hv3_notebook.tcl
@@ -0,0 +1,511 @@
+namespace eval hv3 { set {version($Id: hv3_notebook.tcl,v 1.12 2008/03/02 14:43:49 danielk1977 Exp $)} 1 }
+
+# This file contains the implementation of three snit widgets:
+#
+# ::hv3::notebook_header
+# ::hv3::notebook
+# ::hv3::tabset
+#
+# ::hv3::notebook_header is only used directly by code in this file.
+#
+
+
+
+#-------------------------------------------------------------------------
+#
+# ::hv3::notebook_header
+#
+# This widget creates the notebook tabs. It does not manage any child
+# windows, all it does is draw the tabs.
+#
+# OPTIONS:
+#
+# -selectcmd SCRIPT
+# -closecmd SCRIPT
+#
+# SUB-COMMANDS:
+#
+# add_tab IDENTIFIER
+# del_tab IDENTIFIER
+# title IDENTIFIER ?TITLE?
+# select IDENTIFIER
+#
+snit::widget ::hv3::notebook_header {
+
+ option -selectcmd -default [list] -configuremethod SetOption
+ option -closecmd -default [list] -configuremethod SetOption
+
+ # The identifier of the currently selected tab (the value most recently
+ # passed to the [select] method).
+ variable myCurrent ""
+
+ # List of identifiers in display order from left to right.
+ variable myIdList ""
+
+ # Map from current identifiers to display titles.
+ variable myIdMap -array [list]
+
+ proc init_bitmaps {} {
+
+ # Set up the two images used for the "close tab" buttons positioned
+ # on the tabs themselves. The image data was created by me using an
+ # archaic tool called "bitmap" that was installed with fedora.
+ #
+ set BitmapData {
+ #define closetab_width 14
+ #define closetab_height 14
+ static unsigned char closetab_bits[] = {
+ 0xff, 0x3f, 0x01, 0x20, 0x0d, 0x2c, 0x1d, 0x2e, 0x39, 0x27, 0xf1, 0x23,
+ 0xe1, 0x21, 0xe1, 0x21, 0xf1, 0x23, 0x39, 0x27, 0x1d, 0x2e, 0x0d, 0x2c,
+ 0x01, 0x20, 0xff, 0x3f
+ };
+ }
+ image create bitmap notebook_close_img -data $BitmapData -background ""
+ image create bitmap notebook_close_img2 -data $BitmapData -background red
+ }
+
+ constructor {args} {
+ canvas ${win}.tabs
+ ${win}.tabs configure -borderwidth 0
+ ${win}.tabs configure -highlightthickness 0
+ ${win}.tabs configure -selectborderwidth 0
+
+ init_bitmaps
+
+ $self configurelist $args
+
+ bind ${win}.tabs <Configure> [list $self Redraw]
+ place ${win}.tabs -relwidth 1.0 -relheight 1.0
+ $hull configure -height 0
+ }
+
+ method add_tab {id} {
+ if {[info exists myIdMap($id)]} { error "Already added id $id" }
+ lappend myIdList $id
+ set myIdMap($id) ""
+ $self Redraw
+ }
+
+ method del_tab {id} {
+ if {![info exists myIdMap($id)]} { error "No nothing about id $id" }
+ unset myIdMap($id)
+ set idx [lsearch $myIdList $id]
+ set myIdList [lreplace $myIdList $idx $idx]
+ if {$myCurrent eq $id} { set myCurrent "" }
+ $self Redraw
+ }
+
+ method title {id args} {
+ if {![info exists myIdMap($id)]} { error "No nothing about id $id" }
+ if {[llength $args] > 1} { error "Wrong args to notebook_header.title" }
+ if {[llength $args] == 1} {
+ set zTitle [lindex $args 0]
+ set myIdMap($id) $zTitle
+ foreach {polygon text line} [${win}.tabs find withtag $id] break
+ if {[info exists text]} {
+ set bbox [${win}.tabs bbox $polygon]
+ set font Hv3DefaultFont
+ set iTextWidth [expr {
+ [lindex $bbox 2] - [lindex $bbox 0] - 25 - [font measure $font ...]
+ }]
+ for {set n 0} {$n <= [string length $zTitle]} {incr n} {
+ if {[font measure $font [string range $zTitle 0 $n]] > $iTextWidth} {
+ break;
+ }
+ }
+
+ set newtext [string range $zTitle 0 $n]
+ if {$n+1 < [string length $zTitle]} {append newtext ...}
+ ${win}.tabs itemconfigure $text -text $newtext
+ }
+ }
+ return $myIdMap($id)
+ }
+
+ method select {id} {
+ set myCurrent $id
+
+ # Optimization: When there is only one tab in the list, do not bother
+ # to configure any bindings or colors.
+ if {[array size myIdMap]<=1} return
+
+ if {$id ne "" && ![info exists myIdMap($id)]} {
+ error "Know nothing about id $id"
+ }
+ foreach ident $myIdList {
+ foreach {polygon text line} [${win}.tabs find withtag $ident] break
+ if {![info exists polygon]} return
+ set entercmd ""
+ set leavecmd ""
+ set clickcmd ""
+ if {$ident eq $myCurrent} {
+ ${win}.tabs itemconfigure $polygon -fill #d9d9d9
+ ${win}.tabs itemconfigure $text -fill darkblue
+ ${win}.tabs itemconfigure $line -fill #d9d9d9
+ } else {
+ ${win}.tabs itemconfigure $polygon -fill #c3c3c3
+ ${win}.tabs itemconfigure $text -fill black
+ ${win}.tabs itemconfigure $line -fill white
+ set entercmd [list ${win}.tabs itemconfigure $polygon -fill #ececec]
+ set leavecmd [list ${win}.tabs itemconfigure $polygon -fill #c3c3c3]
+ set clickcmd [list $self Select $ident]
+ }
+ foreach i [list $polygon $text] {
+ ${win}.tabs bind $i <Enter> $entercmd
+ ${win}.tabs bind $i <Leave> $leavecmd
+ ${win}.tabs bind $i <1> $clickcmd
+ }
+ }
+ }
+
+ destructor {
+ after cancel [list $self RedrawCallback]
+ }
+
+ method Redraw {} {
+ after cancel [list $self RedrawCallback]
+ after idle [list $self RedrawCallback]
+ }
+
+ method RedrawCallback {} {
+ # Optimization: When there is only one tab in the list, do not bother
+ # to draw anything. It won't be visible anyway.
+ if {[array size myIdMap]<=1} {
+ $hull configure -height 1
+ return
+ }
+
+ set tab_height [expr [font metrics Hv3DefaultFont -linespace] * 1.5]
+ $hull configure -height $tab_height
+
+ set font Hv3DefaultFont
+
+ set iPadding 2
+ set iDiagonal 2
+ set iButton 14
+ set iCanvasWidth [expr [winfo width ${win}.tabs] - 2]
+ set iThreeDots [font measure $font "..."]
+
+ # Delete the existing canvas items. This proc draws everything
+ # from scratch.
+ ${win}.tabs delete all
+
+ # If the myIdList is empty, there are no tabs to draw.
+ set myRedrawScheduled 0
+ if {[llength $myIdList] == 0} return
+
+ set iRemainingTabs [llength $myIdList]
+ set iRemainingPixels $iCanvasWidth
+
+ set yt [expr 0.5 * ($tab_height + [font metrics $font -linespace])]
+ set x 1
+ foreach ident $myIdList {
+
+ set zTitle $myIdMap($ident)
+
+ set iTabWidth [expr $iRemainingPixels / $iRemainingTabs]
+ incr iRemainingTabs -1
+ incr iRemainingPixels [expr $iTabWidth * -1]
+
+ set iTextWidth [expr \
+ $iTabWidth - $iButton - $iDiagonal * 2 - $iPadding * 2 - 1 \
+ - $iThreeDots
+ ]
+ for {set n 0} {$n <= [string length $zTitle]} {incr n} {
+ if {[font measure $font [string range $zTitle 0 $n]] > $iTextWidth} {
+ break;
+ }
+ }
+ if {$n <= [string length $zTitle]} {
+ set zTitle "[string range $zTitle 0 [expr $n - 1]]..."
+ }
+
+ set x2 [expr $x + $iDiagonal]
+ set x3 [expr $x + $iTabWidth - $iDiagonal - 1]
+ set x4 [expr $x + $iTabWidth - 1]
+
+ set y1 [expr $tab_height - 0]
+ set y2 [expr $iDiagonal + 1]
+ set y3 1
+
+ set ximg [expr $x + $iTabWidth - $iDiagonal - $iButton - 1]
+ set yimg [expr 1 + ($tab_height - $iButton) / 2]
+
+ ${win}.tabs create polygon \
+ $x $y1 $x $y2 $x2 $y3 $x3 $y3 $x4 $y2 $x4 $y1 -tags $ident
+
+ ${win}.tabs create text [expr $x2 + $iPadding] $yt \
+ -anchor sw -text $zTitle -font $font -tags $ident
+
+ if {$options(-closecmd) ne ""} {
+ $self CreateButton $ident $ximg $yimg $iButton
+ }
+
+ ${win}.tabs create line $x $y1 $x $y2 $x2 $y3 $x3 $y3 -fill white
+ ${win}.tabs create line $x3 $y3 $x4 $y2 $x4 $y1 -fill black
+
+ set yb [expr $y1 - 1]
+ ${win}.tabs create line $x $yb [expr $x+$iTabWidth] $yb -tags $ident
+
+ incr x $iTabWidth
+ }
+
+ $win select $myCurrent
+ }
+
+ method ButtonRelease {tag idx x y} {
+ foreach {x1 y1 x2 y2} [${win}.tabs bbox $tag] {}
+ if {$x1 <= $x && $x2 >= $x && $y1 <= $y && $y2 >= $y} {
+ eval $options(-closecmd) $idx
+ }
+ }
+
+ method CreateButton {idx x y size} {
+ set c ${win}.tabs ;# Canvas widget to draw on
+ set tag [$c create image $x $y -anchor nw]
+ $c itemconfigure $tag -image notebook_close_img
+ $c bind $tag <Enter> [list $c itemconfigure $tag -image notebook_close_img2]
+ $c bind $tag <Leave> [list $c itemconfigure $tag -image notebook_close_img]
+ $c bind $tag <ButtonRelease-1> [list $self ButtonRelease $tag $idx %x %y]
+ }
+
+ method Select {idx} {
+ if {$options(-selectcmd) ne ""} {
+ eval $options(-selectcmd) $idx
+ }
+ }
+
+ method SetOption {option value} {
+ set options($option) $value
+ $self Redraw
+ }
+}
+
+#---------------------------------------------------------------------------
+#
+# ::hv3::notebook
+#
+# Generic notebook widget.
+#
+# OPTIONS
+#
+# -closecmd
+#
+# WIDGET COMMAND
+#
+# $notebook add WIDGET ?TITLE? ?UPDATE?
+# $notebook select ?WIDGET?
+# $notebook tabs
+# $notebook title WIDGET ?NEW-TITLE?
+#
+# <<NotebookTabChanged>>
+#
+snit::widget ::hv3::notebook {
+
+ variable myWidgets [list]
+ variable myCurrent -1
+
+ delegate option * to hull
+
+ component myHeader
+ delegate option -closecmd to myHeader
+ delegate method title to myHeader
+
+ constructor {args} {
+
+ # Create a tabs header to paint the tab control in.
+ #
+ set myHeader [::hv3::notebook_header ${win}.header]
+ $myHeader configure -selectcmd [mymethod select]
+
+ grid columnconfigure $win 0 -weight 1
+ grid rowconfigure $win 1 -weight 1
+ grid propagate $win 0
+ grid $myHeader -row 0 -column 0 -sticky ew
+
+ $self configurelist $args
+ }
+
+ destructor {
+ after cancel [list event generate $win <<NotebookTabChanged>>]
+ }
+
+ # add WIDGET ?TITLE? ?UPDATE?
+ #
+ # Add a new widget to the set of tabbed windows.
+ #
+ method add {widget {zTitle ""} {update false}} {
+
+ lappend myWidgets $widget
+
+ bind $widget <Destroy> [list $self HandleDestroy $widget %W]
+
+ if {$update} update
+ $myHeader add_tab $widget
+ $myHeader title $widget $zTitle
+ if {[llength $myWidgets] == 1} {
+ $myHeader select $widget
+ $self Place $widget
+ }
+ }
+
+ method Place {w} {
+ lower $w
+ grid $w -row 1 -column 0 -sticky nsew
+ update
+ update
+ update
+ foreach slave [grid slaves $win -row 1 -column 0] {
+ if {$w eq $slave} continue
+ grid forget $slave
+ }
+ }
+
+ method HandleDestroy {widget w} {
+ catch {
+ if {$widget eq $w} {$self Remove $widget}
+ }
+ }
+
+ # Remove $widget from the set of tabbed windows. Regardless of
+ # whether or not $widget is the current tab, a <<NotebookTabChanged>>
+ # event is generated.
+ #
+ method Remove {widget} {
+
+ set idx [lsearch $myWidgets $widget]
+ if {$idx < 0} { error "$widget is not managed by $self" }
+
+ grid forget $widget
+ bind $widget <Destroy> ""
+
+ set myWidgets [lreplace $myWidgets $idx $idx]
+ $myHeader del_tab $widget
+
+ if {$idx < $myCurrent || $myCurrent == [llength $myWidgets]} {
+ incr myCurrent -1
+ }
+ if {$myCurrent >= 0} {
+ set w [lindex $myWidgets $myCurrent]
+ $self Place $w
+ $myHeader select $w
+ }
+
+ after cancel [list event generate $win <<NotebookTabChanged>>]
+ after idle [list event generate $win <<NotebookTabChanged>>]
+ }
+
+ # select ?WIDGET?
+ #
+ # If an argument is provided, make that widget the current tab.
+ # Return the current tab widget (a copy of the argument if one
+ # was provided).
+ #
+ method select {{widget ""}} {
+ if {$widget ne ""} {
+ set idx [lsearch $myWidgets $widget]
+ if {$idx < 0} { error "$widget is not managed by $self" }
+ if {$myCurrent != $idx} {
+ set myCurrent $idx
+ $myHeader select $widget
+ after cancel [list event generate $win <<NotebookTabChanged>>]
+ after idle [list event generate $win <<NotebookTabChanged>>]
+ # raise $widget
+ $self Place $widget
+ }
+ }
+ return [lindex $myWidgets $myCurrent]
+ }
+
+ method tabs {} {
+ return $myWidgets
+ }
+}
+
+#---------------------------------------------------------------------------
+#
+# ::hv3::tabset
+#
+# Main tabset widget for hv3 web browser.
+#
+# OPTIONS
+#
+# -newcmd
+# -switchcmd
+#
+# WIDGET COMMAND
+#
+# $notebook add ARGS
+# $notebook addbg ARGS
+# $notebook close
+# $notebook current
+# $notebook set_title WIDGET TITLE
+# $notebook get_title WIDGET
+# $notebook tabs
+#
+snit::widgetadaptor ::hv3::tabset {
+
+ option -newcmd -default ""
+ option -switchcmd -default ""
+
+ variable myNextId 0
+ variable myPendingTitle ""
+
+ method Switchcmd {} {
+ if {$options(-switchcmd) ne ""} {
+ eval [linsert $options(-switchcmd) end [$self current]]
+ }
+ }
+
+ method close {} {
+ destroy [$self current]
+ }
+
+ constructor {args} {
+ installhull [::hv3::notebook $win -width 700 -height 500]
+ $self configurelist $args
+ $hull configure -closecmd destroy
+ bind $win <<NotebookTabChanged>> [list $self Switchcmd]
+ }
+
+ method Addcommon {switchto args} {
+ set widget ${win}.tab_[incr myNextId]
+
+ set myPendingTitle Blank
+ eval [concat [linsert $options(-newcmd) 1 $widget] $args]
+ $hull add $widget $myPendingTitle 1
+
+ if {$switchto} {
+ $hull select $widget
+ $self Switchcmd
+ }
+
+ return $widget
+ }
+
+ method addbg {args} {
+ eval [concat $self Addcommon 0 $args]
+ }
+
+ method add {args} {
+ eval [concat $self Addcommon 1 $args]
+ }
+
+ method set_title {widget title} {
+ if {[catch {$hull title $widget $title}]} {
+ set myPendingTitle $title
+ }
+ }
+
+ method get_title {widget} {
+ if {[catch {set title [$hull title $widget]}]} {
+ set title $myPendingTitle
+ }
+ return $title
+ }
+
+ method current {} { $hull select }
+ method tabs {} { $hull tabs }
+
+ delegate method select to hull
+}
diff --git a/hv/hv3_object.tcl b/hv/hv3_object.tcl
index 31f6b63..565f2f8 100644
--- a/hv/hv3_object.tcl
+++ b/hv/hv3_object.tcl
@@ -1,4 +1,4 @@
-namespace eval hv3 { set {version($Id: hv3_object.tcl,v 1.10 2007/09/28 14:14:56 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3_object.tcl,v 1.12 2007/12/17 04:43:07 danielk1977 Exp $)} 1 }
#
# The code in this file handles <object> elements for the hv3 mini-browser.
@@ -17,6 +17,7 @@ proc hv3_ext_to_mime {extension} {
html {set mime text/html}
htm {set mime text/html}
tcl {set mime application/x-tcl}
+ png {set mime image/png}
default {
set mime ""
@@ -105,9 +106,9 @@ proc hv3_object_handler {hv3 node} {
$node replace $standby_widget
}
- # Download the data for this object. To do this, create an ::hv3::download
+ # Download the data for this object. To do this, create an ::hv3::request
# object and pass it to the hv3 widget's -getcmd script.
- set handle [::hv3::download %AUTO%]
+ set handle [::hv3::request %AUTO%]
$handle configure \
-uri $data \
-finscript [list hv3_object_data_handler $hv3 $node $params $handle] \
diff --git a/hv/hv3_polipo.tcl b/hv/hv3_polipo.tcl
index 3d42a29..7372af5 100644
--- a/hv/hv3_polipo.tcl
+++ b/hv/hv3_polipo.tcl
@@ -1,5 +1,5 @@
-namespace eval hv3 { set {version($Id: hv3_polipo.tcl,v 1.15 2007/09/18 08:56:53 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3_polipo.tcl,v 1.17 2008/02/09 18:14:20 danielk1977 Exp $)} 1 }
# This file contains code to control a single instance of the
# external program "hv3_polipo" that may be optionally used by
@@ -229,6 +229,9 @@ namespace eval ::hv3::polipo {
# Kick off polipo.
set cmd "|{$g(binary)} dontCacheRedirects=true dontCacheCookies=true"
append cmd " allowedPorts=1-65535"
+ if {[info exists ::env(http_proxy)]} {
+ append cmd " parentProxy=$::env(http_proxy)"
+ }
if {$::tcl_platform(platform) eq "unix"} {
append cmd " |& cat"
# set cmd "|{$g(binary)} diskCacheRoot=/home/dan/cache |& cat"
@@ -255,6 +258,116 @@ namespace eval ::hv3::polipo {
}
}
+namespace eval ::hv3::polipoclient {
+
+ set N 0
+
+ proc new {me args} {
+ upvar #0 $me O
+
+ set O(socket) [socket localhost [::http::config -proxyport]]
+
+ fconfigure $O(socket) \
+ -blocking 0 \
+ -encoding binary \
+ -translation binary \
+ -buffering full \
+ -buffersize 8192
+
+ fileevent $O(socket) readable [list $me ReadEvent]
+
+ # State is always one of:
+ #
+ # "ready"
+ # "waiting"
+ # "progress"
+ # "finished"
+ #
+ set O(state) ready
+
+ set O(requesthandle) ""
+ set O(protocol) ""
+
+ set O(response) ""
+ set O(headers) ""
+ set O(data) ""
+
+ incr ::hv3::polipoclient::N
+ #puts "$::hv3::polipoclient::N requests outstanding"
+ }
+
+ proc destroy {me} {
+ upvar #0 $me O
+ catch {close $O(socket)}
+ unset $me
+ rename $me {}
+ incr ::hv3::polipoclient::N -1
+ #puts "$::hv3::polipoclient::N requests outstanding"
+ }
+
+ proc GET {me protocol requesthandle} {
+ upvar #0 $me O
+ if {$O(state) ne "ready"} { error "polipoclient state error" }
+
+ set R $requesthandle
+ set O(requesthandle) $R
+ set O(protocol) $protocol
+
+ # Make the GET request:
+ #
+ puts $O(socket) "GET [$R cget -uri] HTTP/1.0"
+ puts $O(socket) "Accept: */*"
+ puts $O(socket) "User-Agent: [::http::config -useragent]"
+ foreach {k v} [$R cget -requestheader] {
+ puts $O(socket) "$k: $v"
+ }
+ puts $O(socket) ""
+
+ set O(state) "waiting"
+ flush $O(socket)
+ }
+
+ proc ReadEvent {me args} {
+ upvar #0 $me O
+
+ append data [read $O(socket)]
+
+ if {$O(state) eq "waiting"} {
+ set iStart [expr { [string first "\x0D\x0A" $data] + 2}]
+ set iEnd [expr { [string first "\x0D\x0A\x0D\x0A" $data] - 1}]
+ if {$iStart>=0} {
+ set O(response) [string range $data 0 [expr {$iStart - 3}]]
+ }
+ if {$iEnd>=0} {
+ set O(state) progress
+ set header ""
+ foreach line [split [string range $data $iStart $iEnd] "\x0D\x0A"] {
+ if {$line eq ""} continue
+ set i [string first : $line]
+ if {$i>=0} {
+ lappend header [string trim [string range $line 0 [expr {$i-1}]]]
+ lappend header [string trim [string range $line [expr {$i+1}] end]]
+ }
+ }
+ $O(requesthandle) configure -header $header
+ $O(protocol) AddToProgressList $O(requesthandle)
+
+ set data [string range $data $iEnd+5 end]
+ }
+ }
+
+ $O(requesthandle) append $data
+ $O(protocol) BytesReceived $O(requesthandle) [string length $data]
+
+ #puts "read [string length [read $O(socket)]] bytes"
+ if {[eof $O(socket)]} {
+ close $O(socket)
+ $O(requesthandle) finish $data
+ }
+ }
+}
+::hv3::make_constructor ::hv3::polipoclient
+
::hv3::polipo::init
::hv3::polipo::restart
#::hv3::polipo::popup
diff --git a/hv/hv3_prop.tcl b/hv/hv3_prop.tcl
index 9c769f7..47cf372 100644
--- a/hv/hv3_prop.tcl
+++ b/hv/hv3_prop.tcl
@@ -1,4 +1,4 @@
-namespace eval hv3 { set {version($Id: hv3_prop.tcl,v 1.62 2007/10/03 10:06:38 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3_prop.tcl,v 1.67 2008/02/01 08:35:30 danielk1977 Exp $)} 1 }
###########################################################################
# hv3_prop.tcl --
@@ -25,10 +25,10 @@ package require Tk
# related to it.
#
namespace eval ::HtmlDebug {
- proc browse {HTML {node ""}} {
- set name ${HTML}.debug
+ proc browse {hv3 {node ""}} {
+ set name [$hv3 html].debug
if {![winfo exists $name]} {
- HtmlDebug $name $HTML
+ HtmlDebug $name $hv3
}
return [$name browseNode $node]
}
@@ -132,7 +132,7 @@ snit::widget ::hv3::debug::tree {
} elseif {[regexp {::tkhtml::node([1234567890]+)} $selector X int]} {
set mySearchResults [list "::tkhtml::node${int}"]
} elseif {$selector ne ""} {
- set mySearchResults [$myHtml search $selector]
+ set mySearchResults [$myHtml html search $selector]
}
if {[llength $mySearchResults] > 0} {
@@ -228,7 +228,7 @@ snit::widget ::hv3::debug::tree {
set XINCR [expr $IWIDTH + 2]
set YINCR [expr $IHEIGHT + 5]
- set tree $myCanvas
+ set tree [$myCanvas widget]
set label [prop_nodeToLabel $node]
if {$label == ""} {return 0}
@@ -356,7 +356,10 @@ snit::widget ::hv3::debug::FormReport {
variable myCurrentHv3 ""
variable myCurrentNode ""
- constructor {} {
+ component myHv3
+ delegate option -fonttable to myHv3
+
+ constructor {args} {
# Button at the bottom of the frame to regenerate this report.
# The point of regenerating it is that it will read new control
@@ -365,12 +368,15 @@ snit::widget ::hv3::debug::FormReport {
::hv3::button ${win}.button -text "Regenerate Report"
${win}.button configure -command [mymethod Regenerate]
+ set myHv3 ${win}.hv3
::hv3::hv3 ${win}.hv3
${win}.hv3 configure -requestcmd [mymethod GetReport]
${win}.hv3 configure -targetcmd [mymethod ReturnSelf]
pack ${win}.button -fill x -side bottom
pack ${win}.hv3 -fill both -expand 1
+
+ $self configurelist $args
}
method Regenerate {} {
@@ -408,10 +414,14 @@ snit::widget ::hv3::debug::LogReport {
option -title ""
+ component myHv3
+ delegate option -fonttable to myHv3
+
constructor {htmldebug args} {
::hv3::button ${win}.button -text "Re-render Document With Logging"
${win}.button configure -command [list $htmldebug rerender]
+ set myHv3 ${win}.hv3
::hv3::hv3 ${win}.hv3
${win}.hv3 configure -requestcmd [mymethod GetReport]
@@ -449,15 +459,15 @@ snit::widget ::hv3::debug::LogReport {
append Tbl " <tr><td>"
if {[regexp $pattern1 $entry DUMMY zSelector zFrom]} {
- set zFrom [htmlize $zFrom]
- set zSelector [htmlize $zSelector]
+ set zFrom [::hv3::string::htmlize $zFrom]
+ set zSelector [::hv3::string::htmlize $zSelector]
append Tbl "<i style=color:green>match </i>"
append Tbl "<span style=font-family:fixed>$zSelector</span> "
append Tbl "<i style=color:green>from $zFrom</i>\n"
} \
elseif {[regexp $pattern2 $entry DUMMY zSelector zFrom]} {
- set zFrom [htmlize $zFrom]
- set zSelector [htmlize $zSelector]
+ set zFrom [::hv3::string::htmlize $zFrom]
+ set zSelector [::hv3::string::htmlize $zSelector]
append Tbl "<i style=color:red>nomatch </i>"
append Tbl "<span style=font-family:fixed>$zSelector</span> "
append Tbl "<i style=color:red>from $zFrom</i>\n"
@@ -506,7 +516,7 @@ proc ::hv3::debug::EventsReport {hv3 node} {
if {$dom ne ""} {
foreach evt [$dom eventdump $node] {
foreach {e l j} $evt {}
- set fj [htmlize [::see::format $j]]
+ set fj [::hv3::string::htmlize [::see::format $j]]
append Tbl "<tr><td>$e<td>$l<td><pre>$fj</pre>"
}
}
@@ -686,10 +696,11 @@ snit::widget HtmlDebug {
variable myStyleReport ;# The style engine report.
variable myFormsReport ;# The forms engine report.
- variable myReports ;# The ::hv3::tile_notebook widget.
+ variable myReports ;# The ::hv3::notebook widget.
constructor {HTML} {
set myHtml $HTML
+ set fonttable [$HTML cget -fonttable]
# Top level window bindings.
bind $win <Escape> [list destroy $win]
@@ -710,18 +721,22 @@ snit::widget HtmlDebug {
::hv3::debug::tree $myTree $HTML
# The tabs in the right-hand pane:
- ::hv3::tile_notebook $myReports -width 600
- ::hv3::debug::report $myEventsReport -reportcmd ::hv3::debug::EventsReport
- ::hv3::debug::report $myHtmlReport -reportcmd ::hv3::debug::TkhtmlReport
- ::hv3::debug::LogReport $myLayoutReport $self -title "Layout Engine Log"
- ::hv3::debug::LogReport $myStyleReport $self -title "Style Engine Log"
- ::hv3::debug::FormReport $myFormsReport
-
- $myReports add $myHtmlReport -text "Tkhtml"
- $myReports add $myLayoutReport -text "Layout Engine"
- $myReports add $myStyleReport -text "Style Engine"
- $myReports add $myEventsReport -text "DOM Event Listeners"
- $myReports add $myFormsReport -text "HTML Forms"
+ ::hv3::notebook $myReports -width 600
+ ::hv3::debug::report $myEventsReport \
+ -reportcmd ::hv3::debug::EventsReport -fonttable $fonttable
+ ::hv3::debug::report $myHtmlReport \
+ -reportcmd ::hv3::debug::TkhtmlReport -fonttable $fonttable
+ ::hv3::debug::LogReport $myLayoutReport $self \
+ -title "Layout Engine Log" -fonttable $fonttable
+ ::hv3::debug::LogReport $myStyleReport $self \
+ -title "Style Engine Log" -fonttable $fonttable
+ ::hv3::debug::FormReport $myFormsReport -fonttable $fonttable
+
+ $myReports add $myHtmlReport "Tkhtml"
+ $myReports add $myLayoutReport "Layout Engine"
+ $myReports add $myStyleReport "Style Engine"
+ $myReports add $myEventsReport "DOM Event Listeners"
+ $myReports add $myFormsReport "HTML Forms"
$win.hpan add $win.hpan.vpan
$win.hpan.vpan add $myTree
@@ -865,6 +880,7 @@ proc prop_nodeToLabel {node} {
}
set d "<[$node tag]"
foreach {a v} [$node attr] {
+ set v [string map [list "\n" " "] $v]
append d " $a=\"$v\""
}
append d ">"
diff --git a/hv/hv3_request.tcl b/hv/hv3_request.tcl
index 212e238..2ce1ddf 100644
--- a/hv/hv3_request.tcl
+++ b/hv/hv3_request.tcl
@@ -1,19 +1,68 @@
-namespace eval hv3 { set {version($Id: hv3_request.tcl,v 1.11 2007/10/07 16:30:08 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3_request.tcl,v 1.28 2008/02/03 06:29:39 danielk1977 Exp $)} 1 }
#--------------------------------------------------------------------------
# This file contains the implementation of two types used by hv3:
#
-# ::hv3::download
-# ::hv3::uri
+# ::hv3::request
#
-
#--------------------------------------------------------------------------
# Class ::hv3::request
#
# Instances of this class are used to interface between the protocol
# implementation and the hv3 widget.
#
+# OVERVIEW:
+#
+# HOW CHARSETS ARE HANDLED:
+#
+# The protocol implementation (the thing that calls [$download append]
+# and [$download finish]) passes binary data to this object. This
+# object converts the binary data to utf-8 text, based on the encoding
+# assigned to the request. An encoding may be assigned either by an
+# http header or a <meta> tag.
+#
+# Assuming the source of the data is http (or https), then the
+# encoding may be specified by way of a Content-Type HTTP header.
+# In this case, when the protocol configures the -header option
+# (which it does before calling [append] for the first time) the
+# -encoding option will be automatically set.
+#
+#
+# OPTIONS:
+#
+# The following options are set only by the requestor (the Hv3 widget)
+# for the protocol to use as request parameters:
+#
+# -cachecontrol
+# -uri
+# -postdata
+# -requestheader
+# -enctype
+# -encoding
+#
+# This is set by the requestor also to show the origin of the request:
+#
+# -hv3
+#
+# These are set by the requestor before the request is made to
+# configure callbacks invoked by this object when requested data
+# is available:
+#
+# -incrscript
+# -finscript
+#
+# This is initially set by the requestor. It may be modified by the
+# protocol implementation before the first invocation of -incrscript
+# or -finscript is made.
+#
+# -mimetype
+#
+# The protocol implementation also sets:
+#
+# -header
+# -expectedsize
+#
# METHODS:
#
# Methods used by the protocol implementation:
@@ -23,142 +72,318 @@ namespace eval hv3 { set {version($Id: hv3_request.tcl,v 1.11 2007/10/07 16:30:0
# fail
# authority (return the authority part of the -uri option)
#
-# destroy_hook SCRIPT
+# finish_hook SCRIPT
# Configure the object with a script to be invoked just before
# the object is about to be destroyed. If more than one of
# these is configured, then the scripts are called in the
# same order as they are configured in (i.e. most recently
# configured is invoked last).
#
-snit::type ::hv3::download {
+# reference
+# release
+#
+# data
+# encoding
+#
- # The requestor (i.e. the creator of the ::hv3::download object) sets the
- # following configuration options. The protocol implementation may set the
- # -mimetype option before returning.
- #
- # The -cachecontrol option may be set to the following values:
- #
- # * normal (try to be clever about caching)
- # * no-cache (never return cached resources)
- # * relax-transparency (return cached resources even if stale)
- #
- option -cachecontrol -default normal
- option -uri -default ""
- option -postdata -default ""
- option -mimetype -default ""
- option -enctype -default ""
-
- # The hv3 widget that issued this request. This is only used by the
- # handler for home:// uris.
- #
- option -hv3 -default ""
+namespace eval ::hv3::request {
- # The protocol implementation sets this option to contain the
- # HTTP header (or it's equivalent). The format is a serialised array.
- # Example:
- #
- # {Set-Cookie safe-search=on Location http://www.google.com}
- #
- # The following http-header types are handled locally by the ConfigureHeader
- # method, as soon as the -header option is set:
- #
- # Set-Cookie (Call ::hv3::the_cookie_manager method)
- # Content-Type (Set the -mimetype option)
- # Content-Length (Set the -expectedsize option)
- #
- option -header -default "" -configuremethod ConfigureHeader
+ proc new {me args} {
- option -requestheader -default ""
+ upvar $me O
- # Expected size of the resource being requested. This is used
- # for displaying a progress bar when saving remote resources
- # to the local filesystem (aka downloadin').
- #
- option -expectedsize -default ""
+ # The requestor (i.e. the creator of the ::hv3::request object) sets the
+ # following configuration options. The protocol implementation may set the
+ # -mimetype option before returning.
+ #
+ # The -cachecontrol option may be set to the following values:
+ #
+ # * normal (try to be clever about caching)
+ # * no-cache (never return cached resources)
+ # * relax-transparency (return cached resources even if stale)
+ #
+ set O(-cachecontrol) normal
+ set O(-uri) ""
+ set O(-postdata) ""
+ set O(-mimetype) ""
+ set O(-enctype) ""
- # Callbacks configured by the requestor.
- #
- option -incrscript -default ""
- option -finscript -default ""
+ set O(-cacheable) 0
+
+ # The hv3 widget that issued this request. This is used
+ # (a) to notify destruction of root request,
+ # (b) by the handler for home:// uris and
+ # (c) to call [$myHtml reset] in restartCallback.
+ #
+ set O(-hv3) ""
+ # The protocol implementation sets this option to contain the
+ # HTTP header (or it's equivalent). The format is a serialised array.
+ # Example:
+ #
+ # {Set-Cookie safe-search=on Location http://www.google.com}
+ #
+ # The following http-header types are handled locally by the
+ # configure-header method, as soon as the -header option is set:
+ #
+ # Set-Cookie (Call ::hv3::the_cookie_manager method)
+ # Content-Type (Set the -mimetype option)
+ # Content-Length (Set the -expectedsize option)
+ #
+ set O(-header) ""
+
+ set O(-requestheader) ""
+
+ # Expected size of the resource being requested. This is used
+ # for displaying a progress bar when saving remote resources
+ # to the local filesystem (aka downloadin').
+ #
+ set O(-expectedsize) ""
+
+ # Callbacks configured by the requestor.
+ #
+ set O(-incrscript) ""
+ set O(-finscript) ""
+
+ # This -encoding option is used to specify explicit conversion of
+ # incoming http/file data.
+ # When this option is set, [http::geturl -binary] is used.
+ # Then [$self append] will call [encoding convertfrom].
+ #
+ # See also [encoding] and [suggestedEncoding] methods.
+ #
+ set O(-encoding) ""
+
+ # True if the -encoding option has been set by the transport layer.
+ # If this is true, then any encoding specified via a <meta> element
+ # in the main document is ignored.
+ #
+ set O(-hastransportencoding) 0
- # END OF OPTIONS
- #----------------------------
+ # END OF OPTIONS
+ #----------------------------
- variable myData ""
- variable myChunksize 2048
+ set O(chunksize) 2048
+
+ # The binary data returned by the protocol implementation is
+ # accumulated in this variable.
+ set O(myRaw) {}
+ set O(myRawMode) 0
+
+ # If this variable is non-zero, then the first $myRawPos bytes of
+ # $myRaw have already been passed to Hv3 via the -incrscript
+ # callback.
+ set O(myRawPos) 0
+
+ # These objects are referenced counted. Initially the reference count
+ # is 1. It is increased by calls to the [reference] method and decreased
+ # by the [release] method. The object is deleted when the ref-count
+ # reaches zero.
+ set O(myRefCount) 1
+
+ set O(myIsText) 1; # Whether mimetype is text/* or not.
+
+ # Make sure finish is processed only once.
+ set O(myIsFinished) 0
+
+ # Destroy-hook scripts configured using the [finish_hook] method.
+ set O(myFinishHookList) [list]
- # Destroy-hook scripts configured using the [destroy_hook] method.
- variable myDestroyHookList [list]
+ set O(myDestroying) 0
- # Constructor and destructor
- constructor {args} {
- $self configurelist $args
+ eval configure $me $args
}
- destructor {
- foreach hook $myDestroyHookList {
- eval $hook
+ proc destroy {me} {
+ upvar $me O
+ set O(myDestroying) 1
+ foreach hook $O(myFinishHookList) {
+ eval $hook
+ }
+ rename $me {}
+ array unset $me
+ }
+
+ proc data {me} {
+ upvar $me O
+ set raw [string range $O(myRaw) 0 [expr {$O(myRawPos)-1}]]
+ if {$O(myIsText)} {
+ return [::encoding convertfrom [encoding $me] $raw]
+ }
+ return $raw
+ }
+ proc rawdata {me} {
+ upvar $me O
+ return $O(myRaw)
+ }
+ proc set_rawmode {me} {
+ upvar $me O
+ set O(myRawMode) 1
+ set O(myRaw) ""
+ }
+
+ # Increment the object refcount.
+ #
+ proc reference {me} {
+ upvar $me O
+ incr O(myRefCount)
+ }
+
+ # Decrement the object refcount.
+ #
+ proc release {me} {
+ upvar $me O
+ incr O(myRefCount) -1
+ if {$O(myRefCount) == 0} {
+ $me destroy
}
}
# Add a script to be called just before the object is destroyed. See
# description above.
#
- method destroy_hook {script} {
- lappend myDestroyHookList $script
+ proc finish_hook {me script} {
+ upvar $me O
+ lappend O(myFinishHookList) $script
}
# This method is called each time the -header option is set. This
# is where the locally handled HTTP headers (see comments above the
# -header option) are handled.
#
- method ConfigureHeader {name option_value} {
- set options($name) $option_value
- foreach {name value} $option_value {
+ proc configure-header {me} {
+ upvar $me O
+ foreach {name value} $O(-header) {
switch -- [string tolower $name] {
set-cookie {
- ::hv3::the_cookie_manager SetCookie $options(-uri) $value
+ catch {
+ ::hv3::the_cookie_manager SetCookie $O(-uri) $value
+ }
}
content-type {
- if {[set idx [string first ";" $value]] >= 0} {
- set options(-mimetype) [string range $value 0 [expr $idx-1]]
+ set parsed [hv3::string::parseContentType $value]
+ foreach {major minor charset} $parsed break
+ set O(-mimetype) $major/$minor
+ if {$charset ne ""} {
+ set O(-hastransportencoding) 1
+ set O(-encoding) [::hv3::encoding_resolve $charset]
}
}
content-length {
- set options(-expectedsize) $value
+ set O(-expectedsize) $value
}
}
}
}
+ proc configure-mimetype {me} {
+ upvar $me O
+ set O(myIsText) [string match text* $O(-mimetype)]
+ }
+
+ proc configure-encoding {me} {
+ upvar $me O
+ set O(-encoding) [::hv3::encoding_resolve $O(-encoding)]
+ }
+
# Return the "authority" part of the URI configured as the -uri option.
#
- method authority {} {
- set obj [::tkhtml::uri $options(-uri)]
+ proc authority {me} {
+ upvar $me O
+ set obj [::tkhtml::uri $O(-uri)]
set authority [$obj authority]
$obj destroy
return $authority
}
# Interface for returning data.
- method append {data} {
- ::append myData $data
- set nData [string length $myData]
- if {$options(-incrscript) != "" && $nData >= $myChunksize} {
- eval [linsert $options(-incrscript) end $myData]
- set myData {}
- if {$myChunksize < 30000} {
- set myChunksize [expr $myChunksize * 2]
+ proc append {me raw} {
+ upvar $me O
+
+ if {$O(myDestroying)} {return}
+ if {$O(myRawMode)} {
+ eval [linsert $O(-incrscript) end $raw]
+ return
+ }
+
+ ::append O(myRaw) $raw
+
+ if {$O(-incrscript) != ""} {
+ # There is an -incrscript callback configured. If enough data is
+ # available, invoke it.
+
+ set nLast 0
+ foreach zWhite [list " " "\n" "\t"] {
+ set n [string last $zWhite $O(myRaw)]
+ if {$n>$nLast} {set nLast $n ; break}
+ }
+ set nAvailable [expr {$nLast-$O(myRawPos)}]
+ if {$nAvailable > $O(chunksize)} {
+
+ set zDecoded [string range $O(myRaw) $O(myRawPos) $nLast]
+ if {$O(myIsText)} {
+ set zDecoded [::encoding convertfrom [encoding $me] $zDecoded]
+ }
+ set O(myRawPos) [expr {$nLast+1}]
+ if {$O(chunksize) < 30000} {
+ set O(chunksize) [expr $O(chunksize) * 2]
+ }
+
+ eval [linsert $O(-incrscript) end $zDecoded]
}
}
}
# Called after all data has been passed to [append].
- method finish {} {
- eval [linsert $options(-finscript) end $myData]
+ #
+ proc finish {me {raw ""}} {
+ upvar $me O
+
+ if {$O(myDestroying)} {return}
+ if {$O(myIsFinished)} {error "finish called twice on $me"}
+ set O(myIsFinished) 1
+
+ if {$O(myRawMode)} {
+ foreach hook $O(myFinishHookList) {
+ eval $hook
+ }
+ eval [linsert $O(-finscript) end $raw]
+ return
+ }
+
+ ::append O(myRaw) $raw
+
+ set zDecoded [string range $O(myRaw) $O(myRawPos) end]
+ if {$O(myIsText)} {
+ set zDecoded [::encoding convertfrom [encoding $me] $zDecoded]
+ }
+
+ foreach hook $O(myFinishHookList) {
+ eval $hook
+ }
+ set O(myFinishHookList) [list]
+ set O(myRawPos) [string length $O(myRaw)]
+ eval [linsert $O(-finscript) end $zDecoded]
+ }
+
+ proc isFinished {me} {
+ upvar $me O
+ set O(myIsFinished)
}
- method fail {} {puts FAIL}
+ proc fail {me} {
+ upvar $me O
+ # TODO: Need to do something here...
+ puts FAIL
+ }
+
+ proc encoding {me} {
+ upvar $me O
+ set ret $O(-encoding)
+ if {$ret eq ""} {set ret [::encoding system]}
+ return $ret
+ }
}
+::hv3::make_constructor ::hv3::request
+
diff --git a/hv/hv3_string.tcl b/hv/hv3_string.tcl
index 364d590..438ec1b 100644
--- a/hv/hv3_string.tcl
+++ b/hv/hv3_string.tcl
@@ -1,172 +1,3 @@
-namespace eval hv3 { set {version($Id: hv3_string.tcl,v 1.7 2007/09/10 03:57:41 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3_string.tcl,v 1.9 2007/12/17 07:27:11 danielk1977 Exp $)} 1 }
-namespace eval ::hv3::string {
-
- # A generic tokeniser procedure for strings. This proc splits the
- # input string $input into a list of tokens, where each token is either:
- #
- # * A continuous set of alpha-numeric characters, or
- # * A quoted string (quoted by " or '), or
- # * Any single character.
- #
- # White-space characters are not returned in the list of tokens.
- #
- proc tokenise {input} {
- set tokens [list]
- set zIn [string trim $input]
-
- while {[string length $zIn] > 0} {
-
- if {[ regexp {^([[:alnum:]_.-]+)(.*)$} $zIn -> zToken zIn ]} {
- # Contiguous alpha-numeric characters
- lappend tokens $zToken
-
- } elseif {[ regexp {^(["'])} $zIn -> zQuote]} { #;'"
- # Quoted string
-
- set nEsc 0
- for {set nToken 1} {$nToken < [string length $zIn]} {incr nToken} {
- set c [string range $zIn $nToken $nToken]
- if {$c eq $zQuote && 0 == ($nEsc%2)} break
- set nEsc [expr {($c eq "\\") ? $nEsc+1 : 0}]
- }
- set zToken [string range $zIn 0 $nToken]
- set zIn [string range $zIn [expr {$nToken+1}] end]
-
- lappend tokens $zToken
-
- } else {
- lappend tokens [string range $zIn 0 0]
- set zIn [string range $zIn 1 end]
- }
-
- set zIn [string trimleft $zIn]
- }
-
- return $tokens
- }
-
- # Dequote $input, if it appears to be a quoted string (starts with
- # a single or double quote character).
- #
- proc dequote {input} {
- set zIn $input
- set zQuote [string range $zIn 0 0]
- if {$zQuote eq "\"" || $zQuote eq "\'"} {
- set zIn [string range $zIn 1 end]
- if {[string range $zIn end end] eq $zQuote} {
- set zIn [string range $zIn 0 end-1]
- }
- set zIn [regsub {\\(.)} $zIn {\1}]
- }
- return $zIn
- }
-
-
- # A procedure to parse an HTTP content-type (media type). See section
- # 3.7 of the http 1.1 specification.
- #
- # A list of exactly three elements is returned. These are the type,
- # subtype and charset as specified in the parsed content-type. Any or
- # all of the fields may be empty strings, if they are not present in
- # the input or a parse error occurs.
- #
- proc parseContentType {contenttype} {
- set tokens [::hv3::string::tokenise $contenttype]
-
- set type [lindex $tokens 0]
- set subtype [lindex $tokens 2]
-
- set enc ""
- foreach idx [lsearch -regexp -all $tokens (?i)charset] {
- if {[lindex $tokens [expr {$idx+1}]] eq "="} {
- set enc [::hv3::string::dequote [lindex $tokens [expr {$idx+2}]]]
- break
- }
- }
-
- return [list $type $subtype $enc]
- }
-
-}
-
-proc pretty_print_heapdebug {} {
- set data [lsort -index 2 -integer [::tkhtml::heapdebug]]
- set ret ""
- set nTotalS 0
- set nTotalB 0
- foreach type $data {
- foreach {zStruct nStruct nByte} $type {}
- append ret [format "% -30s % 10d % 10d\n" $zStruct $nStruct $nByte]
- incr nTotalB $nByte
- incr nTotalS $nStruct
- }
- append ret [format "% -30s % 10d % 10d\n" "Totals" $nTotalS $nTotalB]
- set ret
-}
-
-proc pretty_print_vars {} {
- set ret ""
- foreach e [lsort -integer -index 1 [get_vars]] {
- append ret [format "% -50s %d\n" [lindex $e 0] [lindex $e 1]]
- }
- set ret
-}
-
-proc tree_to_report {tree indent} {
- set i [string repeat " " $indent]
- set f [lindex $tree 0]
-
- set name [$f cget -name]
- set uri [[$f hv3] uri get]
-
- append ret [format "% -40s %s\n" $i\"$name\" $uri]
- foreach child [lindex $tree 1] {
- append ret [tree_to_report $child [expr {$indent+4}]]
- }
- set ret
-}
-proc pretty_print_frames {} {
- tree_to_report [lindex [gui_current frames_tree] 0] 0
-}
-
-proc get_vars {{ns ::}} {
- set nVar 0
- set ret [list]
- set vlist [info vars ${ns}::*]
- foreach var $vlist {
- if {[array exists $var]} {
- incr nVar [llength [array names $var]]
- } else {
- incr nVar 1
- }
- }
- lappend ret [list $ns $nVar]
- foreach child [namespace children $ns] {
- eval lappend ret [get_vars $child]
- }
- set ret
-}
-proc count_vars {{ns ::} {print 0}} {
- set nVar 0
- foreach entry [get_vars $ns] {
- incr nVar [lindex $entry 1]
- }
- set nVar
-}
-proc count_commands {{ns ::}} {
- set nCmd [llength [info commands ${ns}::*]]
- foreach child [namespace children $ns] {
- incr nCmd [count_commands $child]
- }
- set nCmd
-}
-proc count_namespaces {{ns ::}} {
- set nNs 1
- foreach child [namespace children $ns] {
- incr nNs [count_namespaces $child]
- }
- set nNs
-}
-
diff --git a/hv/hv3_style.tcl b/hv/hv3_style.tcl
new file mode 100644
index 0000000..823f838
--- /dev/null
+++ b/hv/hv3_style.tcl
@@ -0,0 +1,95 @@
+
+###########################################################################
+# hv3_style.tcl --
+#
+# This file contains code to implement stylesheet functionality.
+# The public interface to this file are the commands:
+#
+# style_init HTML
+# style_newdocument HTML
+#
+
+#--------------------------------------------------------------------------
+# Global variables section
+set ::hv3_style_count 0
+
+#--------------------------------------------------------------------------
+
+# style_init --
+#
+# style_init HTML
+#
+# This is called just after the html widget ($HTML) is created. The two
+# handler commands are registered.
+#
+proc style_init {HTML} {
+ $HTML handler node link "styleHandleLink $HTML"
+ $HTML handler script style "styleHandleStyle $HTML"
+}
+
+# style_newdocument --
+#
+# style_newdocument HTML
+#
+# This should be called before each new document begins loading (i.e. from
+# [gui_goto]).
+#
+proc style_newdocument {HTML} {
+ set ::hv3_style_count 0
+}
+
+# styleHandleStyle --
+#
+# styleHandleStyle HTML SCRIPT
+#
+proc styleHandleStyle {HTML script} {
+ set id author.[format %.4d [incr ::hv3_style_count]]
+ styleCallback $HTML [$HTML var url] $id $script
+}
+
+# styleUrl --
+#
+# styleUrl BASE-URL URL
+#
+proc styleUrl {baseurl url} {
+ return [url_resolve $baseurl $url]
+}
+
+# styleCallback --
+#
+# styleCallback HTML URL ID STYLE-TEXT
+#
+proc styleCallback {HTML url id style} {
+ $HTML style \
+ -id $id \
+ -importcmd [list styleImport $HTML $id] \
+ -urlcmd [list styleUrl $url] \
+ $style
+}
+
+# styleImport --
+#
+# styleImport HTML PARENTID URL
+#
+proc styleImport {HTML parentid url} {
+ set id ${parentid}.[format %.4d [incr ::hv3_style_count]]
+ url_fetch $url -script [list styleCallback $HTML $url $id] -type Stylesheet
+}
+
+# styleHandleLink --
+#
+# styleHandleLink HTML NODE
+#
+proc styleHandleLink {HTML node} {
+ if {[$node attr rel] == "stylesheet"} {
+ # Check if the media is Ok. If so, download and apply the style.
+ set media [$node attr -default "" media]
+ if {$media == "" || [regexp all $media] || [regexp screen $media]} {
+ set id author.[format %.4d [incr ::hv3_style_count]]
+ set url [url_resolve [$HTML var url] [$node attr href]]
+ set cmd [list styleCallback $HTML $url $id]
+ url_fetch $url -script $cmd -type Stylesheet
+ }
+ }
+}
+
diff --git a/hv/hv3_url.tcl b/hv/hv3_url.tcl
new file mode 100644
index 0000000..91570fa
--- /dev/null
+++ b/hv/hv3_url.tcl
@@ -0,0 +1,408 @@
+###########################################################################
+# hv3_url.tcl --
+#
+# This file contains code to manipulate and download data from URI's.
+#
+# Public interface:
+#
+# String manipulation: [url_resolve] [url_get]
+# Networking: [url_fetch] [url_cancel]
+#
+# Additionally, the variable ::hv3_url_status is sometimes set to indicate
+# the status of network activities (is suitable for display in web-browser
+# "status" bar).
+#
+
+#--------------------------------------------------------------------------
+# Global variables section
+array unset url_g_scripts
+set http_current_socket -1
+array unset http_name_cache
+
+array unset ::hv3_url_status_info
+set ::hv3_url_status {}
+array unset ::hv3_url_tokens
+#--------------------------------------------------------------------------
+
+proc urlSetStatus {} {
+ set newval {}
+ foreach k [array names ::hv3_url_status_info] {
+ append newval "${k}s: [join $::hv3_url_status_info($k) /] "
+ }
+ set ::hv3_url_status $newval
+}
+proc urlStart {type} {
+ if {![info exists ::hv3_url_status_info($type)]} {
+ set ::hv3_url_status_info($type) [list 0 0]
+ }
+ lset ::hv3_url_status_info($type) 1 [
+ expr [lindex $::hv3_url_status_info($type) 1] + 1
+ ]
+ urlSetStatus
+}
+proc urlFinish {type} {
+ lset ::hv3_url_status_info($type) 0 [
+ expr [lindex $::hv3_url_status_info($type) 0] + 1
+ ]
+ urlSetStatus
+}
+
+# The url procedures use the following global variables:
+#
+# url_g_scripts
+# http_current_socket
+# http_name_cache
+#
+# And the following internal procedures:
+#
+# url_callback
+# http_get_socket
+# http_get_url
+#
+
+#--------------------------------------------------------------------------
+# urlNormalize --
+#
+# urlNormalize PATH
+#
+# The argument is expected to be the path component of a URL (i.e. similar
+# to a unix file system path). ".." and "." components are removed and the
+# result returned.
+#
+proc urlNormalize {path} {
+ set ret [list]
+ foreach c [split $path /] {
+ if {$c == ".."} {
+ set ret [lrange $ret 0 end-1]
+ } elseif {$c == "."} {
+ # Do nothing...
+ } else {
+ lappend ret $c
+ }
+ }
+ return [join $ret /]
+}
+
+#--------------------------------------------------------------------------
+# urlSplit --
+#
+# urlSplit URL
+#
+# Form of URL parsed:
+# <scheme>://<host>:<port>/<path>?<query>#<fragment>
+#
+proc urlSplit {url} {
+ set re_scheme {((?:[a-z]+:)?)}
+ set re_host {((?://[A-Za-z0-9.]*)?)}
+ set re_port {((?::[0-9]*)?)}
+ set re_path {((?:[^#?]*)?)}
+ set re_query {((?:\?[^?]*)?)}
+ set re_fragment {((?:#.*)?)}
+
+ set re "${re_scheme}${re_host}${re_port}${re_path}${re_query}${re_fragment}"
+
+ if {![regexp $re $url X \
+ u(scheme) \
+ u(host) \
+ u(port) \
+ u(path) \
+ u(query) \
+ u(fragment)
+ ]} {
+ error "Bad URL: $url"
+ }
+
+ return [array get u]
+}
+
+#--------------------------------------------------------------------------
+# url_resolve --
+#
+# This command is used to transform a (possibly) relative URL into an
+# absolute URL. Example:
+#
+# $ url_resolve http://host.com/dir1/dir2/doc.html ../dir3/doc2.html
+# http://host.com/dir1/dir3/doc2.html
+#
+# This is purely a string manipulation procedure.
+#
+proc url_resolve {baseurl url} {
+
+ array set u [urlSplit $url]
+ array set b [urlSplit $baseurl]
+
+ set ret {}
+ foreach part [list scheme host port] {
+ if {$u($part) != ""} {
+ append ret $u($part)
+ } else {
+ append ret $b($part)
+ }
+ }
+
+ if {$b(path) == ""} {set b(path) "/"}
+
+ if {[regexp {^/} $u(path)] || $u(host) != ""} {
+ set path $u(path)
+ } else {
+ if {$u(path) == ""} {
+ set path $b(path)
+ } else {
+ regexp {.*/} $b(path) path
+ append path $u(path)
+ }
+ }
+
+ append ret [urlNormalize $path]
+ append ret $u(query)
+ append ret $u(fragment)
+
+ # puts "$baseurl + $url -> $ret"
+ return $ret
+}
+
+#--------------------------------------------------------------------------
+# url_get --
+#
+# This is a high-level string manipulation procedure to extract components
+# from a URL.
+#
+# -fragment
+# -prefragment
+# -port
+# -host
+#
+swproc url_get {url {fragment ""} {prefragment ""} {port ""} {host ""}} {
+ array set u [urlSplit $url]
+
+ if {$fragment != ""} {
+ uplevel [subst {
+ set $fragment "[string range $u(fragment) 1 end]"
+ }]
+ }
+
+ if {$prefragment != ""} {
+ uplevel [subst {
+ set $prefragment "$u(scheme)$u(host)$u(port)$u(path)$u(query)"
+ }]
+ }
+
+ if {$host != ""} {
+ uplevel [subst {
+ set $host "[string range $u(host) 2 end]"
+ }]
+ }
+
+ if {$port != ""} {
+ uplevel [subst {
+ set $port "[string range $u(port) 1 end]"
+ }]
+ }
+}
+
+#--------------------------------------------------------------------------
+# cache_init, cache_store, cache_query, cache_fetch --
+#
+# cache_init
+# cache_store URL DATA
+# cache_query URL
+# cache_fetch URL
+#
+# A tiny API to implement a primitive web cache.
+#
+proc cache_init {file} {
+ sqlite3 dbcache $file
+ .html var cache dbcache
+ catch {
+ [.html var cache] eval {CREATE TABLE cache(url PRIMARY KEY, data BLOB);}
+ }
+}
+proc cache_store {url data} {
+ set sql {REPLACE INTO cache(url, data) VALUES($url, $data);}
+ [.html var cache] eval $sql
+}
+proc cache_query {url} {
+ set sql {SELECT count(*) FROM cache WHERE url = $url}
+ return [[.html var cache] one $sql]
+}
+proc cache_fetch {url} {
+ set sql {SELECT data FROM cache WHERE url = $url}
+ return [[.html var cache] one $sql]
+}
+#
+#--------------------------------------------------------------------------
+
+#--------------------------------------------------------------------------
+# Enhancement to the http package - asychronous socket connection
+#
+# The tcllib http package does not support asynchronous connections
+# (although asynchronous IO is supported after the connection is
+# established). The following code is a hack to work around that.
+#
+# Note: Asynchronous dns lookup is required too!
+#
+set UA "Mozilla/5.0 (compatible; Konqueror/3.3; Linux) (KHTML, like Gecko)"
+::http::register http 80 http_get_socket
+::http::config -useragent $UA
+
+set http_current_socket -1
+array set http_name_cache [list]
+
+proc http_get_socket {args} {
+ set ret $::http_current_socket
+ set ::http_current_socket -1
+ return $ret
+}
+
+proc http_socket_ready {url args} {
+ set ::hv3_url_tokens([eval [concat ::http::geturl $url $args]]) 1
+}
+
+proc http_get_url {url args} {
+ url_get $url -port port -host server
+ if {$port == ""} {
+ set port 80
+ }
+
+ if {![info exists ::http_name_cache($server)]} {
+ set ::http_name_cache($server) [::tk::htmlresolve $server]
+ }
+ set server_ip $::http_name_cache($server)
+
+ # set script [concat [list ::http::geturl $url] $args]
+ set script [concat [list http_socket_ready $url] $args]
+ set s [socket -async $server_ip $port]
+ fileevent $s writable [subst -nocommands {
+ set ::http_current_socket $s
+ $script
+ if {[http_get_socket] != -1} {error "assert()"}
+ }]
+}
+#--------------------------------------------------------------------------
+
+#--------------------------------------------------------------------------
+# url_fetch --
+#
+# url_fetch URL ?-switches ...?
+#
+# -script (default {})
+# -cache (default {})
+# -type (default Document)
+# -binary
+#
+# This procedure is used to retrieve remote files. Argument -url is the
+# url to retrieve. When it has been retrieved, the data is appended to
+# the script -script (if any) and the result invoked.
+#
+swproc url_fetch {url {script {}} {cache {}} {type Document} {binary 0 1}} {
+
+ # Check the cache before doing anything else. If we can find the data in
+ # the cache then invoke the script immediately.
+ if {[cache_query $url]} {
+ if {$script != ""} {
+ set data [cache_fetch $url]
+ lappend script $data
+ eval $script
+ }
+ return
+ }
+
+ switch -regexp -- $url {
+
+ {^file://} {
+ # Handle file:// URLs by loading the contents of the specified file
+ # system entry. Invoke any -script directly.
+ set rc [catch {
+ set fname [string range $url 7 end]
+ set f [open $fname]
+ if {$binary} {
+ fconfigure $f -encoding binary -translation binary
+ }
+ set data [read $f]
+ close $f
+ if {$script != ""} {
+ lappend script $data
+ eval $script
+ }
+ } msg]
+ }
+
+ {^http://} {
+ if {0 == [info exists ::url_g_scripts($url)]} {
+ set cmd [list url_callback -type $type]
+ set rc [catch {
+ http_get_url $url -command $cmd -timeout 120000
+ } msg]
+ set ::url_g_scripts($url) [list]
+ urlStart $type
+ gui_log "DOWNLOAD Start: \"$url\""
+ }
+ if {$script != ""} {
+ lappend ::url_g_scripts($url) $script
+ }
+ }
+
+ default {
+ # Any other kind of URL is an error
+ set rc 1
+ set msg {}
+ }
+ }
+}
+
+# url_cancel --
+#
+# url_cancel
+#
+# Cancel all currently executing downloads. Do not invoke any -script
+# scripts passed to url_fetch.
+#
+proc url_cancel {} {
+ array unset ::hv3_url_status_info
+ urlSetStatus
+ foreach k [array names ::hv3_url_tokens] {
+ ::http::reset $k
+ }
+ array unset ::hv3_url_tokens
+}
+
+# url_callback --
+#
+# url_callback SCRIPT TOKEN
+#
+# This callback is made by the http package when the response to an
+# http request has been received.
+#
+swproc url_callback {{type Document} token} {
+ # The following line is a trick of the http package. $token is the name
+ # of a Tcl array in the global context that contains the downloaded
+ # information. The [upvar] command makes "state" a local alias for that
+ # array variable.
+ upvar #0 $token state
+
+ unset ::hv3_url_tokens($token)
+ urlFinish $type
+ gui_log "DOWNLOAD Finished: \"$state(url)\""
+ cache_store $state(url) $state(body)
+
+ # Check if this is a redirect. If so, do not invoke $script, just fetch
+ # the URL we are redirected to. TODO: Need to the -id and -cache options
+ # to [url_fetch] here.
+ foreach {n v} $state(meta) {
+ if {[regexp -nocase ^location$ $n]} {
+ foreach script $::url_g_scripts($state(url)) {
+ url_fetch [string trim $v] -script $script -type $type
+ }
+ url_fetch [string trim $v] -type $type
+ return
+ }
+ }
+
+ foreach script $::url_g_scripts($state(url)) {
+ lappend script $state(body)
+ eval $script
+ }
+
+ # Cleanup the record of the download.
+ ::http::cleanup $token
+}
diff --git a/hv/hv3_util.tcl b/hv/hv3_util.tcl
new file mode 100644
index 0000000..581d794
--- /dev/null
+++ b/hv/hv3_util.tcl
@@ -0,0 +1,559 @@
+namespace eval hv3 { set {version($Id: hv3_util.tcl,v 1.9 2008/02/02 17:15:02 danielk1977 Exp $)} 1 }
+
+
+namespace eval hv3 {
+
+ proc ReturnWithArgs {retval args} {
+ return $retval
+ }
+
+ proc scrollbar {args} {
+ set w [eval [linsert $args 0 ::scrollbar]]
+ $w configure -highlightthickness 0
+ $w configure -borderwidth 1
+ return $w
+ }
+
+ # scrolledwidget
+ #
+ # Widget to add automatic scrollbars to a widget supporting the
+ # [xview], [yview], -xscrollcommand and -yscrollcommand interface (e.g.
+ # html, canvas or text).
+ #
+ namespace eval scrolledwidget {
+
+ proc new {me widget args} {
+ upvar #0 $me O
+ set w $O(win)
+
+ set O(-propagate) 0
+ set O(-scrollbarpolicy) auto
+ set O(-takefocus) 0
+
+ set O(myTakeControlCb) ""
+
+ # Create the three widgets - one user widget and two scrollbars.
+ set O(myWidget) [eval [linsert $widget 1 ${w}.widget]]
+ set O(myVsb) [::hv3::scrollbar ${w}.vsb -orient vertical -takefocus 0]
+ set O(myHsb) [::hv3::scrollbar ${w}.hsb -orient horizontal -takefocus 0]
+
+ set wid $O(myWidget)
+ bind $w <KeyPress-Up> [list $me scrollme $wid yview scroll -1 units]
+ bind $w <KeyPress-Down> [list $me scrollme $wid yview scroll 1 units]
+ bind $w <KeyPress-Return> [list $me scrollme $wid yview scroll 1 units]
+ bind $w <KeyPress-Right> [list $me scrollme $wid xview scroll 1 units]
+ bind $w <KeyPress-Left> [list $me scrollme $wid xview scroll -1 units]
+ bind $w <KeyPress-Next> [list $me scrollme $wid yview scroll 1 pages]
+ bind $w <KeyPress-space> [list $me scrollme $wid yview scroll 1 pages]
+ bind $w <KeyPress-Prior> [list $me scrollme $wid yview scroll -1 pages]
+
+ $O(myVsb) configure -cursor "top_left_arrow"
+ $O(myHsb) configure -cursor "top_left_arrow"
+
+ grid configure $O(myWidget) -column 0 -row 1 -sticky nsew
+ grid columnconfigure $w 0 -weight 1
+ grid rowconfigure $w 1 -weight 1
+ grid propagate $w $O(-propagate)
+
+ # First, set the values of -width and -height to the defaults for
+ # the scrolled widget class. Then configure this widget with the
+ # arguments provided.
+ $me configure -width [$O(myWidget) cget -width]
+ $me configure -height [$O(myWidget) cget -height]
+ eval $me configure $args
+
+ # Wire up the scrollbars using the standard Tk idiom.
+ $O(myWidget) configure -yscrollcommand [list $me scrollcallback $O(myVsb)]
+ $O(myWidget) configure -xscrollcommand [list $me scrollcallback $O(myHsb)]
+ $O(myVsb) configure -command [list $me scrollme $O(myWidget) yview]
+ $O(myHsb) configure -command [list $me scrollme $O(myWidget) xview]
+
+ # Propagate events from the scrolled widget to this one.
+ bindtags $O(myWidget) [concat [bindtags $O(myWidget)] $O(win)]
+ }
+
+ proc destroy {me} {
+ uplevel #0 [list unset $me]
+ rename $me ""
+ }
+
+ proc configure-propagate {me} {
+ upvar #0 $me O
+ grid propagate $O(win) $O(-propagate)
+ }
+
+ proc take_control {me callback} {
+ upvar #0 $me O
+ if {$O(myTakeControlCb) ne ""} {
+ uplevel #0 $O(myTakeControlCb)
+ }
+ set O(myTakeControlCb) $callback
+ }
+
+ proc scrollme {me args} {
+ upvar #0 $me O
+ if {$O(myTakeControlCb) ne ""} {
+ uplevel #0 $O(myTakeControlCb)
+ set O(myTakeControlCb) ""
+ }
+ eval $args
+ }
+
+ proc scrollcallback {me scrollbar first last} {
+ upvar #0 $me O
+
+ $scrollbar set $first $last
+ set ismapped [expr [winfo ismapped $scrollbar] ? 1 : 0]
+
+ if {$O(-scrollbarpolicy) eq "auto"} {
+ set isrequired [expr ($first == 0.0 && $last == 1.0) ? 0 : 1]
+ } else {
+ set isrequired $O(-scrollbarpolicy)
+ }
+
+ if {$isrequired && !$ismapped} {
+ switch [$scrollbar cget -orient] {
+ vertical {grid configure $scrollbar -column 1 -row 1 -sticky ns}
+ horizontal {grid configure $scrollbar -column 0 -row 2 -sticky ew}
+ }
+ } elseif {$ismapped && !$isrequired} {
+ grid forget $scrollbar
+ }
+ }
+
+ proc configure-scrollbarpolicy {me} {
+ upvar #0 $me O
+ eval $me scrollcallback $O(myHsb) [$O(myWidget) xview]
+ eval $me scrollcallback $O(myVsb) [$O(myWidget) yview]
+ }
+
+ proc widget {me} {
+ upvar #0 $me O
+ return $O(myWidget)
+ }
+
+ proc unknown {method me args} {
+ # puts "UNKNOWN: $me $method $args"
+ upvar #0 $me O
+ uplevel 3 [list eval $O(myWidget) $method $args]
+ }
+ namespace unknown unknown
+
+ set DelegateOption(-width) hull
+ set DelegateOption(-height) hull
+ set DelegateOption(-cursor) hull
+ set DelegateOption(*) myWidget
+ }
+
+ # Wrapper around the ::hv3::scrolledwidget constructor.
+ #
+ # Example usage to create a 400x400 canvas widget named ".c" with
+ # automatic scrollbars:
+ #
+ # ::hv3::scrolled canvas .c -width 400 -height 400
+ #
+ proc scrolled {widget name args} {
+ return [eval [concat ::hv3::scrolledwidget $name $widget $args]]
+ }
+
+ proc Expand {template args} {
+ return [string map $args $template]
+ }
+}
+
+namespace eval ::hv3::string {
+
+ # A generic tokeniser procedure for strings. This proc splits the
+ # input string $input into a list of tokens, where each token is either:
+ #
+ # * A continuous set of alpha-numeric characters, or
+ # * A quoted string (quoted by " or '), or
+ # * Any single character.
+ #
+ # White-space characters are not returned in the list of tokens.
+ #
+ proc tokenise {input} {
+ set tokens [list]
+ set zIn [string trim $input]
+
+ while {[string length $zIn] > 0} {
+
+ if {[ regexp {^([[:alnum:]_.-]+)(.*)$} $zIn -> zToken zIn ]} {
+ # Contiguous alpha-numeric characters
+ lappend tokens $zToken
+
+ } elseif {[ regexp {^(["'])} $zIn -> zQuote]} { #;'"
+ # Quoted string
+
+ set nEsc 0
+ for {set nToken 1} {$nToken < [string length $zIn]} {incr nToken} {
+ set c [string range $zIn $nToken $nToken]
+ if {$c eq $zQuote && 0 == ($nEsc%2)} break
+ set nEsc [expr {($c eq "\\") ? $nEsc+1 : 0}]
+ }
+ set zToken [string range $zIn 0 $nToken]
+ set zIn [string range $zIn [expr {$nToken+1}] end]
+
+ lappend tokens $zToken
+
+ } else {
+ lappend tokens [string range $zIn 0 0]
+ set zIn [string range $zIn 1 end]
+ }
+
+ set zIn [string trimleft $zIn]
+ }
+
+ return $tokens
+ }
+
+ # Dequote $input, if it appears to be a quoted string (starts with
+ # a single or double quote character).
+ #
+ proc dequote {input} {
+ set zIn $input
+ set zQuote [string range $zIn 0 0]
+ if {$zQuote eq "\"" || $zQuote eq "\'"} {
+ set zIn [string range $zIn 1 end]
+ if {[string range $zIn end end] eq $zQuote} {
+ set zIn [string range $zIn 0 end-1]
+ }
+ set zIn [regsub {\\(.)} $zIn {\1}]
+ }
+ return $zIn
+ }
+
+
+ # A procedure to parse an HTTP content-type (media type). See section
+ # 3.7 of the http 1.1 specification.
+ #
+ # A list of exactly three elements is returned. These are the type,
+ # subtype and charset as specified in the parsed content-type. Any or
+ # all of the fields may be empty strings, if they are not present in
+ # the input or a parse error occurs.
+ #
+ proc parseContentType {contenttype} {
+ set tokens [::hv3::string::tokenise $contenttype]
+
+ set type [lindex $tokens 0]
+ set subtype [lindex $tokens 2]
+
+ set enc ""
+ foreach idx [lsearch -regexp -all $tokens (?i)charset] {
+ if {[lindex $tokens [expr {$idx+1}]] eq "="} {
+ set enc [::hv3::string::dequote [lindex $tokens [expr {$idx+2}]]]
+ break
+ }
+ }
+
+ return [list $type $subtype $enc]
+ }
+
+ proc htmlize {zIn} {
+ string map [list "<" "<" ">" ">" "&" "&" "\"" ""e;"] $zIn
+ }
+
+}
+
+
+proc ::hv3::char {text idx} {
+ return [string range $text $idx $idx]
+}
+
+proc ::hv3::next_word {text idx idx_out} {
+
+ while {[char $text $idx] eq " "} { incr idx }
+
+ set idx2 $idx
+ set c [char $text $idx2]
+
+ if {$c eq "\""} {
+ # Quoted identifier
+ incr idx2
+ set c [char $text $idx2]
+ while {$c ne "\"" && $c ne ""} {
+ incr idx2
+ set c [char $text $idx2]
+ }
+ incr idx2
+ set word [string range $text [expr $idx+1] [expr $idx2 - 2]]
+ } else {
+ # Unquoted identifier
+ while {$c ne ">" && $c ne " " && $c ne ""} {
+ incr idx2
+ set c [char $text $idx2]
+ }
+ set word [string range $text $idx [expr $idx2 - 1]]
+ }
+
+ uplevel [list set $idx_out $idx2]
+ return $word
+}
+
+proc ::hv3::sniff_doctype {text pIsXhtml} {
+ upvar $pIsXhtml isXHTML
+ # <!DOCTYPE TopElement Availability "IDENTIFIER" "URL">
+
+ set QuirksmodeIdentifiers [list \
+ "-//w3c//dtd html 4.01 transitional//en" \
+ "-//w3c//dtd html 4.01 frameset//en" \
+ "-//w3c//dtd html 4.0 transitional//en" \
+ "-//w3c//dtd html 4.0 frameset//en" \
+ "-//softquad software//dtd hotmetal pro 6.0::19990601::extensions to html 4.0//en" \
+ "-//softquad//dtd hotmetal pro 4.0::19971010::extensions to html 4.0//en" \
+ "-//ietf//dtd html//en//3.0" \
+ "-//w3o//dtd w3 html 3.0//en//" \
+ "-//w3o//dtd w3 html 3.0//en" \
+ "-//w3c//dtd html 3 1995-03-24//en" \
+ "-//ietf//dtd html 3.0//en" \
+ "-//ietf//dtd html 3.0//en//" \
+ "-//ietf//dtd html 3//en" \
+ "-//ietf//dtd html level 3//en" \
+ "-//ietf//dtd html level 3//en//3.0" \
+ "-//ietf//dtd html 3.2//en" \
+ "-//as//dtd html 3.0 aswedit + extensions//en" \
+ "-//advasoft ltd//dtd html 3.0 aswedit + extensions//en" \
+ "-//ietf//dtd html strict//en//3.0" \
+ "-//w3o//dtd w3 html strict 3.0//en//" \
+ "-//ietf//dtd html strict level 3//en" \
+ "-//ietf//dtd html strict level 3//en//3.0" \
+ "html" \
+ "-//ietf//dtd html//en" \
+ "-//ietf//dtd html//en//2.0" \
+ "-//ietf//dtd html 2.0//en" \
+ "-//ietf//dtd html level 2//en" \
+ "-//ietf//dtd html level 2//en//2.0" \
+ "-//ietf//dtd html 2.0 level 2//en" \
+ "-//ietf//dtd html level 1//en" \
+ "-//ietf//dtd html level 1//en//2.0" \
+ "-//ietf//dtd html 2.0 level 1//en" \
+ "-//ietf//dtd html level 0//en" \
+ "-//ietf//dtd html level 0//en//2.0" \
+ "-//ietf//dtd html strict//en" \
+ "-//ietf//dtd html strict//en//2.0" \
+ "-//ietf//dtd html strict level 2//en" \
+ "-//ietf//dtd html strict level 2//en//2.0" \
+ "-//ietf//dtd html 2.0 strict//en" \
+ "-//ietf//dtd html 2.0 strict level 2//en" \
+ "-//ietf//dtd html strict level 1//en" \
+ "-//ietf//dtd html strict level 1//en//2.0" \
+ "-//ietf//dtd html 2.0 strict level 1//en" \
+ "-//ietf//dtd html strict level 0//en" \
+ "-//ietf//dtd html strict level 0//en//2.0" \
+ "-//webtechs//dtd mozilla html//en" \
+ "-//webtechs//dtd mozilla html 2.0//en" \
+ "-//netscape comm. corp.//dtd html//en" \
+ "-//netscape comm. corp.//dtd html//en" \
+ "-//netscape comm. corp.//dtd strict html//en" \
+ "-//microsoft//dtd internet explorer 2.0 html//en" \
+ "-//microsoft//dtd internet explorer 2.0 html strict//en" \
+ "-//microsoft//dtd internet explorer 2.0 tables//en" \
+ "-//microsoft//dtd internet explorer 3.0 html//en" \
+ "-//microsoft//dtd internet explorer 3.0 html strict//en" \
+ "-//microsoft//dtd internet explorer 3.0 tables//en" \
+ "-//sun microsystems corp.//dtd hotjava html//en" \
+ "-//sun microsystems corp.//dtd hotjava strict html//en" \
+ "-//ietf//dtd html 2.1e//en" \
+ "-//o'reilly and associates//dtd html extended 1.0//en" \
+ "-//o'reilly and associates//dtd html extended relaxed 1.0//en" \
+ "-//o'reilly and associates//dtd html 2.0//en" \
+ "-//sq//dtd html 2.0 hotmetal + extensions//en" \
+ "-//spyglass//dtd html 2.0 extended//en" \
+ "+//silmaril//dtd html pro v0r11 19970101//en" \
+ "-//w3c//dtd html experimental 19960712//en" \
+ "-//w3c//dtd html 3.2//en" \
+ "-//w3c//dtd html 3.2 final//en" \
+ "-//w3c//dtd html 3.2 draft//en" \
+ "-//w3c//dtd html experimental 970421//en" \
+ "-//w3c//dtd html 3.2s draft//en" \
+ "-//w3c//dtd w3 html//en" \
+ "-//metrius//dtd metrius presentational//en" \
+ ]
+
+ set isXHTML 0
+ set idx [string first <!DOCTYPE $text]
+ if {$idx < 0} { return "quirks" }
+
+ # Try to parse the TopElement bit. No quotes allowed.
+ incr idx [string length "<!DOCTYPE "]
+ while {[string range $text $idx $idx] eq " "} { incr idx }
+
+ set TopElement [string tolower [next_word $text $idx idx]]
+ set Availability [string tolower [next_word $text $idx idx]]
+ set Identifier [string tolower [next_word $text $idx idx]]
+ set Url [next_word $text $idx idx]
+
+# foreach ii [list TopElement Availability Identifier Url] {
+# puts "$ii -> [set $ii]"
+# }
+
+ # Figure out if this should be handled as XHTML
+ #
+ if {[string first xhtml $Identifier] >= 0} {
+ set isXHTML 1
+ }
+ if {$Availability eq "public"} {
+ set s [expr [string length $Url] > 0]
+ if {
+ $Identifier eq "-//w3c//dtd xhtml 1.0 transitional//en" ||
+ $Identifier eq "-//w3c//dtd xhtml 1.0 frameset//en" ||
+ ($s && $Identifier eq "-//w3c//dtd html 4.01 transitional//en") ||
+ ($s && $Identifier eq "-//w3c//dtd html 4.01 frameset//en")
+ } {
+ return "almost standards"
+ }
+ if {[lsearch $QuirksmodeIdentifiers $Identifier] >= 0} {
+ return "quirks"
+ }
+ }
+
+ return "standards"
+}
+
+
+proc ::hv3::configure_doctype_mode {html text pIsXhtml} {
+ upvar $pIsXhtml isXHTML
+ set mode [sniff_doctype $text isXHTML]
+
+ switch -- $mode {
+ "quirks" { set defstyle [::tkhtml::htmlstyle -quirks] }
+ "almost standards" { set defstyle [::tkhtml::htmlstyle] }
+ "standards" { set defstyle [::tkhtml::htmlstyle]
+ }
+ }
+
+ $html configure -defaultstyle $defstyle -mode $mode
+
+ return $mode
+}
+
+namespace eval ::hv3 {
+
+ variable Counter 1
+
+ proc handle_destroy {me obj win} {
+ if {$obj eq $win} {
+ upvar #0 $me O
+ set cmd $O(cmd)
+ $me destroy
+ rename $cmd ""
+ }
+ }
+ proc handle_rename {me oldname newname op} {
+ upvar #0 $me O
+ set O(cmd) $newname
+ }
+
+ proc construct_object {ns obj arglist} {
+
+ set PROC proc
+ if {[info commands real_proc] ne ""} {
+ set PROC real_proc
+ }
+
+ set isWidget [expr {[string range $obj 0 0] eq "."}]
+
+ # The name of the array to use for this object.
+ set arrayname $obj
+ if {$arrayname eq "%AUTO%" || $isWidget} {
+ set arrayname ${ns}::inst[incr ${ns}::_OBJ_COUNTER]
+ }
+
+ # Create the object command.
+ set body "namespace eval $ns \$m $arrayname \$args"
+ namespace eval :: [list $PROC $arrayname {m args} $body]
+
+ # If the first character of the new command name is ".", then
+ # this is a new widget. Populate the state array with the following
+ # special variables:
+ #
+ # O(win) Window path.
+ # O(hull) Window command.
+ #
+ if {[string range $obj 0 0] eq "."} {
+ variable HullType
+ variable Counter
+ upvar #0 $arrayname O
+
+ set O(hull) ${obj}_win[incr Counter]
+ set O(win) $obj
+ eval $HullType($ns) $O(win)
+ namespace eval :: rename $O(win) $O(hull)
+
+ bind $obj <Destroy> +[list ::hv3::handle_destroy $arrayname $obj %W]
+
+ namespace eval :: [list $PROC $O(win) {m args} $body]
+ set O(cmd) $O(win)
+ trace add command $O(win) rename [list ::hv3::handle_rename $arrayname]
+ }
+
+ # Call the object constructor.
+ namespace eval $ns new $arrayname $arglist
+ return [expr {$isWidget ? $obj : $arrayname}]
+ }
+
+ proc make_constructor {ns {hulltype frame}} {
+ variable HullType
+
+ if {[info commands ${ns}::destroy] eq ""} {
+ error "Object class has no destructor: $ns"
+ }
+ set HullType($ns) $hulltype
+
+ # Create the constructor
+ #
+ proc $ns {obj args} "::hv3::construct_object $ns \$obj \$args"
+
+ # Create the [cget] method.
+ #
+ namespace eval $ns "
+ proc cget {me option} {
+ upvar \$me O
+ if {!\[info exists O(\$option)\]} {
+ variable DelegateOption
+ if {\[info exists DelegateOption(\$option)\]} {
+ return \[
+ eval \$O(\$DelegateOption(\$option)) [list cget \$option]
+ \]
+ return
+ } elseif {\[info exists DelegateOption(*)\]} {
+ return \[eval \$O(\$DelegateOption(*)) [list cget \$option ]\]
+ }
+ error \"unknown option: \$option\"
+ }
+ return \$O(\$option)
+ }
+ "
+ # Create the [configure] method.
+ #
+ set cc ""
+ foreach cmd [info commands ${ns}::configure*] {
+ set key [string range $cmd [string length ${ns}::configure] end]
+ append cc "if {\$option eq {$key}} {configure$key \$me}\n"
+ }
+ namespace eval $ns "
+ proc configure {me args} {
+ upvar \$me O
+ foreach {option value} \$args {
+ if {!\[info exists O(\$option)\]} {
+ variable DelegateOption
+ if {\[info exists DelegateOption(\$option)\]} {
+ eval \$O(\$DelegateOption(\$option)) [list configure \$option \$value]
+ } elseif {\[info exists DelegateOption(*)\]} {
+ eval \$O(\$DelegateOption(*)) [list configure \$option \$value]
+ } else {
+ error \"unknown option: \$option\"
+ }
+ } elseif {\$O(\$option) != \$value} {
+ set O(\$option) \$value
+ $cc
+ }
+ }
+ }
+ "
+ }
+}
+
+::hv3::make_constructor ::hv3::scrolledwidget
+
+
diff --git a/hv/hv3_widgets.tcl b/hv/hv3_widgets.tcl
index 8661d1b..87f9fd3 100644
--- a/hv/hv3_widgets.tcl
+++ b/hv/hv3_widgets.tcl
@@ -1,4 +1,4 @@
-namespace eval hv3 { set {version($Id: hv3_widgets.tcl,v 1.52 2007/10/06 14:58:22 danielk1977 Exp $)} 1 }
+namespace eval hv3 { set {version($Id: hv3_widgets.tcl,v 1.59 2008/02/03 17:53:26 danielk1977 Exp $)} 1 }
package require snit
package require Tk
@@ -45,7 +45,7 @@ namespace eval ::hv3 {
# WARNING: Horrible, horrible action at a distance...
- catch {.notebook.notebook Redraw}
+ catch {.notebook.header Redraw}
}
SetFont {-size 10}
@@ -61,16 +61,6 @@ namespace eval ::hv3 {
}
return $w
}
- proc scrollbar {args} {
- if {$::hv3::toolkit eq "Tile"} {
- set w [eval [linsert $args 0 ::ttk::scrollbar]]
- } else {
- set w [eval [linsert $args 0 ::scrollbar]]
- $w configure -highlightthickness 0
- $w configure -borderwidth 1
- }
- return $w
- }
proc entry {args} {
if {$::hv3::toolkit eq "Tile"} {
set w [eval [linsert $args 0 ::ttk::entry]]
@@ -100,138 +90,8 @@ namespace eval ::hv3 {
return $w
}
-
- # scrolledwidget
- #
- # Widget to add automatic scrollbars to a widget supporting the
- # [xview], [yview], -xscrollcommand and -yscrollcommand interface (e.g.
- # html, canvas or text).
- #
- ::snit::widget scrolledwidget {
- component myWidget
- variable myVsb
- variable myHsb
-
- option -propagate -default 0 -configuremethod set_propagate
- option -scrollbarpolicy -default auto -configuremethod set_policy
- option -takefocus -default 0
-
- method set_propagate {option value} {
- grid propagate $win $value
- set options(-propagate) $value
- }
-
- variable myTakeControlCb ""
- method take_control {callback} {
- if {$myTakeControlCb ne ""} {
- uplevel #0 $myTakeControlCb
- }
- set myTakeControlCb $callback
- }
-
- proc scrollme {var args} {
- if {[set $var] ne ""} {
- uplevel #0 [set $var]
- set $var ""
- }
- eval $args
- }
-
- constructor {widget args} {
- # Create the three widgets - one user widget and two scrollbars.
- set myWidget [eval [linsert $widget 1 ${win}.widget]]
-
- set v [myvar myTakeControlCb]
- set w $myWidget
- set scrollme [myproc scrollme]
- bind $w <KeyPress-Up> [list $scrollme $v $w yview scroll -1 units]
- bind $w <KeyPress-Down> [list $scrollme $v $w yview scroll 1 units]
- bind $w <KeyPress-Return> [list $scrollme $v $w yview scroll 1 units]
- bind $w <KeyPress-Right> [list $scrollme $v $w xview scroll 1 units]
- bind $w <KeyPress-Left> [list $scrollme $v $w xview scroll -1 units]
- bind $w <KeyPress-Next> [list $scrollme $v $w yview scroll 1 pages]
- bind $w <KeyPress-space> [list $scrollme $v $w yview scroll 1 pages]
- bind $w <KeyPress-Prior> [list $scrollme $v $w yview scroll -1 pages]
-
- set myVsb [::hv3::scrollbar ${win}.vsb -orient vertical]
- set myHsb [::hv3::scrollbar ${win}.hsb -orient horizontal]
-
- $myVsb configure -cursor "top_left_arrow"
- $myHsb configure -cursor "top_left_arrow"
-
- grid configure $myWidget -column 0 -row 0 -sticky nsew
- grid columnconfigure $win 0 -weight 1
- grid rowconfigure $win 0 -weight 1
- grid propagate $win $options(-propagate)
-
- # First, set the values of -width and -height to the defaults for
- # the scrolled widget class. Then configure this widget with the
- # arguments provided.
- $self configure -width [$myWidget cget -width]
- $self configure -height [$myWidget cget -height]
- $self configurelist $args
-
- # Wire up the scrollbars using the standard Tk idiom.
- $myWidget configure -yscrollcommand [list $self scrollcallback $myVsb]
- $myWidget configure -xscrollcommand [list $self scrollcallback $myHsb]
- set v [myvar myTakeControlCb]
- $myVsb configure -command [list [myproc scrollme] $v $myWidget yview]
- $myHsb configure -command [list [myproc scrollme] $v $myWidget xview]
-
- # Propagate events from the scrolled widget to this one.
- bindtags $myWidget [concat [bindtags $myWidget] $win]
- }
-
- method scrollcallback {scrollbar first last} {
- $scrollbar set $first $last
- set ismapped [expr [winfo ismapped $scrollbar] ? 1 : 0]
-
- if {$options(-scrollbarpolicy) eq "auto"} {
- set isrequired [expr ($first == 0.0 && $last == 1.0) ? 0 : 1]
- } else {
- set isrequired $options(-scrollbarpolicy)
- }
-
- if {$isrequired && !$ismapped} {
- switch [$scrollbar cget -orient] {
- vertical {grid configure $scrollbar -column 1 -row 0 -sticky ns}
- horizontal {grid configure $scrollbar -column 0 -row 1 -sticky ew}
- }
- } elseif {$ismapped && !$isrequired} {
- grid forget $scrollbar
- }
- }
-
- method set_policy {option value} {
- if {$value ne $options($option)} {
- set options($option) $value
- eval $self scrollcallback $myHsb [$myWidget xview]
- eval $self scrollcallback $myVsb [$myWidget yview]
- }
- }
-
- method widget {} {return $myWidget}
-
- delegate option -width to hull
- delegate option -height to hull
- delegate option * to myWidget
- delegate method * to myWidget
- }
-
- # Wrapper around the ::hv3::scrolledwidget constructor.
- #
- # Example usage to create a 400x400 canvas widget named ".c" with
- # automatic scrollbars:
- #
- # ::hv3::scrolled canvas .c -width 400 -height 400
- #
- proc scrolled {widget name args} {
- return [eval [concat ::hv3::scrolledwidget $name $widget $args]]
- }
-
}
-
::snit::widget ::hv3::toolbutton {
component myButton
@@ -245,7 +105,7 @@ namespace eval ::hv3 {
if {$::hv3::toolkit eq "Tile"} {
set myButton [::ttk::button ${win}.button -style Toolbutton]
} else {
- set myButton [::button ${win}.button]
+ set myButton [::button ${win}.button -takefocus 0]
# Configure Tk presentation options not required for Tile here.
$myButton configure -highlightthickness 0
@@ -253,7 +113,8 @@ namespace eval ::hv3 {
$myButton configure -relief flat -overrelief raised
}
set top [winfo toplevel $myButton]
- set myPopup ${top}[string map {. _} $myButton]
+ if {$top eq "."} {set top ""}
+ set myPopup ${top}.[string map {. _} $myButton]
set myPopupLabel ${myPopup}.label
frame $myPopup -bg black
::label $myPopupLabel -fg black -bg white
@@ -331,467 +192,6 @@ proc ::hv3::menu_color {} {
}
}
-
-
-#
-# This class uses vanilla Tk widgets to implement the following subset of
-# the Tile ttk::notebook API.
-#
-# $notebook select
-# $notebook select WIDGET
-# $notebook forget WIDGET
-# $notebook tabs
-# $notebook add WIDGET -sticky nsew -text TEXT
-# $notebook tab WIDGET -text
-# $notebook tab WIDGET -text TEXT
-# <<NotebookTabChanged>>
-#
-snit::widget ::hv3::pretend_tile_notebook {
-
- variable myWidgets [list]
- variable myTitles [list]
- variable myCurrent 0
-
- # Height of the tabs part of the window (when visible), in pixels.
- variable myTabHeight
-
- # Font used for tabs.
- variable myFont Hv3DefaultFont
-
- # True if an [after idle] callback on the RedrawCallback method is
- # pending. This variable is set by [$self Redraw] and cleared
- # by RedrawCallback.
- variable myRedrawScheduled 0
-
- # The two images to use for the small "close-tab" buttons
- # placed on the tabs themselves.
- variable myCloseTabImage ""
- variable myCloseTabImage2 ""
-
- delegate option * to hull
-
- option -closetabbuttons -default 0
-
- constructor {args} {
-
- # Create a canvas widget to paint the tabs in
- canvas ${win}.tabs
- ${win}.tabs configure -borderwidth 0
- ${win}.tabs configure -highlightthickness 0
- ${win}.tabs configure -selectborderwidth 0
-
- bind ${win}.tabs <Configure> [list $self Redraw]
- $self configurelist $args
-
- # Set up the two images used for the "close tab" buttons positioned
- # on the tabs themselves. The image data was created by me using an
- # archaic tool called "bitmap" that was installed with fedora.
- #
- set BitmapData {
- #define closetab_width 14
- #define closetab_height 14
- static unsigned char closetab_bits[] = {
- 0xff, 0x3f, 0x01, 0x20, 0x0d, 0x2c, 0x1d, 0x2e, 0x39, 0x27, 0xf1, 0x23,
- 0xe1, 0x21, 0xe1, 0x21, 0xf1, 0x23, 0x39, 0x27, 0x1d, 0x2e, 0x0d, 0x2c,
- 0x01, 0x20, 0xff, 0x3f
- };
- }
- set myCloseTabImage [image create bitmap -data $BitmapData -background ""]
- set myCloseTabImage2 [image create bitmap -data $BitmapData -background red]
- }
-
- destructor {
- image delete $myCloseTabImage
- image delete $myCloseTabImage2
-
- after cancel [list event generate $self <<NotebookTabChanged>>]
- after cancel [list $self RedrawCallback]
- }
-
- # add WIDGET
- #
- # Add a new widget to the set of tabbed windows.
- method add {widget args} {
- array set A $args
- lappend myWidgets $widget
- lappend myTitles ""
- if {[info exists A(-text)]} {
- lset myTitles end $A(-text)
- }
- $self Redraw
- # bind $widget <Destroy> [list $self forget $widget]
- bind $widget <Destroy> [list $self HandleDestroy $widget %W]
- }
-
- method HandleDestroy {widget w} {
- if {$widget eq $w} {$self forget $widget}
- }
-
- # forget WIDGET
- #
- # Remove $widget from the set of tabbed windows. Regardless of
- # whether or not $widget is the current tab, a <<NotebookTabChanged>>
- # event is generated.
- method forget {widget} {
-
- set idx [lsearch $myWidgets $widget]
- if {$idx < 0} { error "$widget is not managed by $self" }
-
- place forget $widget
- bind $widget <Destroy> ""
-
- set myWidgets [lreplace $myWidgets $idx $idx]
- set myTitles [lreplace $myTitles $idx $idx]
-
- if {$myCurrent == [llength $myWidgets]} {
- incr myCurrent -1
- }
- after cancel [list event generate $self <<NotebookTabChanged>>]
- after idle [list event generate $self <<NotebookTabChanged>>]
- $self Redraw
- }
-
- # select ?WIDGET?
- #
- # If an argument is provided, make that widget the current tab.
- # Return the current tab widget (a copy of the argument if one
- # was provided).
- method select {{widget ""}} {
- if {$widget ne ""} {
- set idx [lsearch $myWidgets $widget]
- if {$idx < 0} { error "$widget is not managed by $self" }
- if {$myCurrent != $idx} {
- set myCurrent $idx
- $self Redraw
- after cancel [list event generate $self <<NotebookTabChanged>>]
- after idle [list event generate $self <<NotebookTabChanged>>]
- }
- }
- return [lindex $myWidgets $myCurrent]
- }
-
- # tab WIDGET ?options?
- #
- # The only option recognized is the -text option. It sets the
- # title for the specified tabbed widget.
- #
- method tab {widget -text args} {
- set idx [lsearch $myWidgets $widget]
- if {$idx < 0} { error "$widget is not managed by $self" }
-
- if {[llength $args] ne 0} {
- lset myTitles $idx [lindex $args 0]
- $self Redraw
- }
- return [lindex $myTitles $idx]
- }
-
- method tabs {} {
- return $myWidgets
- }
-
- method Redraw {} {
- if {$myRedrawScheduled == 0} {
- set myRedrawScheduled 1
- after idle [list $self RedrawCallback]
- }
- }
-
- method ButtonRelease {tag idx x y} {
- foreach {x1 y1 x2 y2} [${win}.tabs bbox $tag] {}
- if {$x1 <= $x && $x2 >= $x && $y1 <= $y && $y2 >= $y} {
- destroy [lindex $myWidgets $idx]
- }
- }
- method CreateButton {idx x y size} {
- set c ${win}.tabs ;# Canvas widget to draw on
- set tag [$c create image $x $y -anchor nw]
- $c itemconfigure $tag -image $myCloseTabImage
- $c bind $tag <Enter> [list $c itemconfigure $tag -image $myCloseTabImage2]
- $c bind $tag <Leave> [list $c itemconfigure $tag -image $myCloseTabImage]
- $c bind $tag <ButtonRelease-1> [list $self ButtonRelease $tag $idx %x %y]
- }
-
- method RedrawCallback {} {
-
- set iPadding 2
- set iDiagonal 2
- set iButton 14
- set iCanvasWidth [expr [winfo width ${win}.tabs] - 2]
- set iThreeDots [font measure $myFont "..."]
-
- set myTabHeight [expr [font metrics $myFont -linespace] * 1.5]
- ${win}.tabs configure -height $myTabHeight -width 100
-
- # "place" the tabs canvas widget at the top of the parent frame
- place ${win}.tabs -anchor nw -x 0 -y 0 -relwidth 1.0 -height $myTabHeight
-
- # Delete the existing canvas items. This proc draws everything
- # from scratch.
- ${win}.tabs delete all
-
- # If the myCurrent variable is less than 0, the notebook widget is
- # empty. There are no tabs to draw in this case.
- if {$myCurrent < 0} return
-
- # Make sure the $myCurrent widget is the displayed tab.
- set c [lindex $myWidgets $myCurrent]
- place $c \
- -x 0 -y [expr $myTabHeight - 0] \
- -relwidth 1.0 -relheight 1.0 \
- -height [expr -1 * $myTabHeight] \
- -anchor nw
-
- # And unmap all other tab windows.
- foreach w $myWidgets {
- if {$w ne $c} {place forget $w}
- }
-
- # Variable $iAggWidth stores the aggregate requested width of all the
- # tabs. This loop loops through all the tabs to determine $iAggWidth
- #
- set iAggWidth 0
- foreach t $myTitles {
- incr iAggWidth [expr {
- [font measure $myFont $t] +
- $iPadding * 2 + $iDiagonal * 2 + $iButton + 1
- }]
- }
-
- set iRemainingTabs [llength $myTitles]
- set iRemainingPixels $iCanvasWidth
-
- set idx 0
- set yt [expr 0.5 * ($myTabHeight + [font metrics $myFont -linespace])]
- set x 1
- foreach title $myTitles {
-
- set iTabWidth [expr $iRemainingPixels / $iRemainingTabs]
- incr iRemainingTabs -1
- incr iRemainingPixels [expr $iTabWidth * -1]
-
- set iTextWidth [expr \
- $iTabWidth - $iButton - $iDiagonal * 2 - $iPadding * 2 - 1 \
- - $iThreeDots
- ]
- set zTitle $title
- for {set n 0} {$n <= [string length $zTitle]} {incr n} {
- if {[font measure $myFont [string range $zTitle 0 $n]] > $iTextWidth} {
- break;
- }
- }
- if {$n <= [string length $zTitle]} {
- set zTitle "[string range $zTitle 0 [expr $n - 1]]..."
- }
-
- set x2 [expr $x + $iDiagonal]
- set x3 [expr $x + $iTabWidth - $iDiagonal - 1]
- set x4 [expr $x + $iTabWidth - 1]
-
- set y1 [expr $myTabHeight - 0]
- set y2 [expr $iDiagonal + 1]
- set y3 1
-
- set ximg [expr $x + $iTabWidth - $iDiagonal - $iButton - 1]
- set yimg [expr 1 + ($myTabHeight - $iButton) / 2]
-
- set id [${win}.tabs create polygon \
- $x $y1 $x $y2 $x2 $y3 $x3 $y3 $x4 $y2 $x4 $y1]
-
- set id2 [${win}.tabs create text [expr $x2 + $iPadding] $yt]
- ${win}.tabs itemconfigure $id2 -anchor sw -text $zTitle -font $myFont
-
- if {$options(-closetabbuttons)} {
- $self CreateButton $idx $ximg $yimg $iButton
- }
-
- if {$idx == $myCurrent} {
- set yb [expr $y1 - 1]
- ${win}.tabs itemconfigure $id -fill #d9d9d9
- ${win}.tabs create line 0 $yb $x $yb -fill white -tags whiteline
- ${win}.tabs create line $x4 $yb $iCanvasWidth $yb -tags whiteline
- ${win}.tabs itemconfigure whiteline -fill white
- ${win}.tabs itemconfigure $id2 -fill darkblue
- } else {
- ${win}.tabs itemconfigure $id -fill #c3c3c3
- set cmd [list ${win}.tabs itemconfigure $id -fill]
- foreach i [list $id $id2] {
- ${win}.tabs bind $i <Enter> [concat $cmd #ececec]
- ${win}.tabs bind $i <Leave> [concat $cmd #c3c3c3]
- ${win}.tabs bind $i <1> [list $self select [lindex $myWidgets $idx]]
- }
- }
-
- ${win}.tabs create line $x $y1 $x $y2 $x2 $y3 $x3 $y3 -fill white
- ${win}.tabs create line $x3 $y3 $x4 $y2 $x4 $y1 -fill black
-
- incr x $iTabWidth
- incr idx
- }
-
- ${win}.tabs raise whiteline
- set myRedrawScheduled 0
- }
-}
-
-proc ::hv3::tile_notebook {args} {
- eval ::hv3::pretend_tile_notebook $args
-}
-
-#---------------------------------------------------------------------------
-# ::hv3::notebook
-#
-# Tabbed notebook widget for hv3 based on the Tile notebook widget. If
-# Tile is not available, ::hv3::pretend_tile_notebook is used instead.
-#
-# OPTIONS
-#
-# -newcmd
-# -switchcmd
-# -delcmd
-#
-# WIDGET COMMAND
-#
-# $notebook add ARGS
-# $notebook addbg ARGS
-# $notebook close
-# $notebook current
-# $notebook set_title WIDGET TITLE
-# $notebook tabs
-#
-snit::widget ::hv3::notebook {
-
- option -newcmd -default ""
- option -switchcmd -default ""
- option -delcmd -default ""
-
- variable myNextId 0
- variable myPendingTitle ""
-
- variable myOnlyTab ""
- variable myOnlyTitle ""
-
- method Switchcmd {} {
- if {$options(-switchcmd) ne ""} {
- eval [linsert $options(-switchcmd) end [$self current]]
- $self WorldChanged
- }
- }
-
- method WorldChanged {} {
- set dummy ${win}.notebook.dummy
-
- set nTab [llength [${win}.notebook tabs]]
- if {$myOnlyTab ne ""} { incr nTab }
-
- if {[lsearch [${win}.notebook tabs] $dummy] >= 0} {
- incr nTab -1
- }
-
- if {$nTab > 1} {
- if {$myOnlyTab ne ""} {
- place forget $myOnlyTab
- ${win}.notebook add $myOnlyTab -sticky ewns -text $myOnlyTitle
- catch { ${win}.notebook forget $dummy }
- set myOnlyTab ""
- set myOnlyTitle ""
-
- set tab1 [lindex [${win}.notebook tabs] 0]
- set text1 [${win}.notebook tab $tab1 -text]
- ${win}.notebook forget $tab1
- ${win}.notebook add $tab1
- ${win}.notebook tab $tab1 -text $text1
- }
- } else {
- if {$myOnlyTab eq ""} {
- set myOnlyTab [${win} current]
-
- catch { canvas $dummy -width 0 -height 0 -bg blue }
- catch { ${win}.notebook add ${win}.notebook.dummy -state hidden }
-
- set myOnlyTitle [${win}.notebook tab $myOnlyTab -text]
- ${win}.notebook forget $myOnlyTab
- raise $myOnlyTab
- place $myOnlyTab -relheight 1.0 -relwidth 1.0
- }
- }
- }
-
- method close {} {
- if {$myOnlyTab eq ""} {
- destroy [$self current]
- }
- }
-
- constructor {args} {
- $self configurelist $args
- ::hv3::tile_notebook ${win}.notebook -width 700 -height 500
- ${win}.notebook configure -closetabbuttons 1
- bind ${win}.notebook <<NotebookTabChanged>> [list $self Switchcmd]
- pack ${win}.notebook -fill both -expand true
- }
-
- method Addcommon {switchto args} {
- set widget ${win}.notebook.tab_[incr myNextId]
-
- set myPendingTitle ""
- eval [concat [linsert $options(-newcmd) 1 $widget] $args]
- ${win}.notebook add $widget -sticky ewns -text Blank
- if {$myPendingTitle ne ""} {$self set_title $widget $myPendingTitle}
-
- if {$switchto} {
- ${win}.notebook select $widget
- $self Switchcmd
- catch {${win}.notebook select $widget}
- } else {
- $self WorldChanged
- }
-
- return $widget
- }
-
- method addbg {args} {
- eval [concat $self Addcommon 0 $args]
- }
-
- method add {args} {
- eval [concat $self Addcommon 1 $args]
- }
-
- method set_title {widget title} {
- if {$widget eq $myOnlyTab} {
- set myOnlyTitle $title
- } elseif {[catch {${win}.notebook tab $widget -text $title}]} {
- set myPendingTitle $title
- }
- }
-
- method get_title {widget} {
- if {$widget eq $myOnlyTab} {
- set title $myOnlyTitle
- } elseif {[catch {set title [${win}.notebook tab $widget -text]}]} {
- set title $myPendingTitle
- }
- return $title
- }
-
- method current {} {
- if {$myOnlyTab ne ""} {return $myOnlyTab}
-
- if {0 == [catch {${win}.notebook select} current]} {
- return $current
- }
- return [lindex [${win}.notebook tabs] [${win}.notebook index current]]
- }
-
- method tabs {} {
- if {$myOnlyTab ne ""} {return $myOnlyTab}
- return [${win}.notebook tabs]
- }
-}
-# End of notebook implementation.
-#---------------------------------------------------------------------------
-
#---------------------------------------------------------------------------
# ::hv3::walkTree
#
@@ -911,7 +311,7 @@ proc ::hv3::ComparePositionId {frame1 frame2} {
#
#
snit::widget ::hv3::findwidget {
- variable myBrowser ;# The ::hv3::browser_toplevel widget
+ variable myBrowser ;# The ::hv3::browser widget
variable myNocaseVar 1 ;# Variable for the "Case insensitive" checkbox
variable myEntryVar "" ;# Variable for the entry widget
@@ -985,15 +385,15 @@ snit::widget ::hv3::findwidget {
}
method lazymoveto {hv3 n1 i1 n2 i2} {
- set nodebbox [$hv3 text bbox $n1 $i1 $n2 $i2]
- set docbbox [$hv3 bbox]
+ set nodebbox [$hv3 html text bbox $n1 $i1 $n2 $i2]
+ set docbbox [$hv3 html bbox]
set docheight "[lindex $docbbox 3].0"
set ntop [expr ([lindex $nodebbox 1].0 - 30.0) / $docheight]
set nbottom [expr ([lindex $nodebbox 3].0 + 30.0) / $docheight]
- set sheight [expr [winfo height $hv3].0 / $docheight]
+ set sheight [expr [winfo height [$hv3 html]].0 / $docheight]
set stop [lindex [$hv3 yview] 0]
set sbottom [expr $stop + $sheight]
@@ -1022,8 +422,8 @@ snit::widget ::hv3::findwidget {
# "findwidgetcurrent". Clear the caption.
#
foreach hv3 $hv3list {
- $hv3 tag delete findwidget
- $hv3 tag delete findwidgetcurrent
+ $hv3 html tag delete findwidget
+ $hv3 html tag delete findwidgetcurrent
}
set myCaptionVar ""
@@ -1036,7 +436,7 @@ snit::widget ::hv3::findwidget {
if {[string length $searchtext] == 0} return
foreach hv3 $hv3list {
- set doctext [$hv3 text text]
+ set doctext [$hv3 html text text]
if {$myNocaseVar} {
set doctext [string tolower $doctext]
}
@@ -1054,7 +454,7 @@ snit::widget ::hv3::findwidget {
set lMatch [lrange $lMatch 0 [expr ($nMaxHighlight - $nHighlight)*2 - 1]]
incr nHighlight [expr [llength $lMatch] / 2]
if {[llength $lMatch] > 0} {
- lappend matches $hv3 [eval [concat $hv3 text index $lMatch]]
+ lappend matches $hv3 [eval [concat $hv3 html text index $lMatch]]
}
}
@@ -1062,9 +462,9 @@ snit::widget ::hv3::findwidget {
foreach {hv3 matchlist} $matches {
foreach {n1 i1 n2 i2} $matchlist {
- $hv3 tag add findwidget $n1 $i1 $n2 $i2
+ $hv3 html tag add findwidget $n1 $i1 $n2 $i2
}
- $hv3 tag configure findwidget -bg purple -fg white
+ $hv3 html tag configure findwidget -bg purple -fg white
$self lazymoveto $hv3 \
[lindex $matchlist 0] [lindex $matchlist 1] \
[lindex $matchlist 2] [lindex $matchlist 3]
@@ -1103,13 +503,13 @@ snit::widget ::hv3::findwidget {
set hv3 ""
foreach {hv3 n1 i1 n2 i2} [$self GetHit $previousHit] { }
- catch {$hv3 tag delete findwidgetcurrent}
+ catch {$hv3 html tag delete findwidgetcurrent}
set hv3 ""
foreach {hv3 n1 i1 n2 i2} [$self GetHit $myCurrentHit] { }
$self lazymoveto $hv3 $n1 $i1 $n2 $i2
- $hv3 tag add findwidgetcurrent $n1 $i1 $n2 $i2
- $hv3 tag configure findwidgetcurrent -bg black -fg yellow
+ $hv3 html tag add findwidgetcurrent $n1 $i1 $n2 $i2
+ $hv3 html tag configure findwidgetcurrent -bg black -fg yellow
}
method GetHit {iIdx} {
@@ -1132,8 +532,8 @@ snit::widget ::hv3::findwidget {
# destroyed.
foreach hv3 [$self Hv3List] {
catch {
- $hv3 tag delete findwidget
- $hv3 tag delete findwidgetcurrent
+ $hv3 html tag delete findwidget
+ $hv3 html tag delete findwidgetcurrent
}
}
trace remove variable [myvar myEntryVar] write [list $self UpdateDisplay]
diff --git a/hv/hv3bridge.c b/hv/hv3bridge.c
new file mode 100644
index 0000000..142bb36
--- /dev/null
+++ b/hv/hv3bridge.c
@@ -0,0 +1,406 @@
+
+/*
+ * OVERVIEW:
+ *
+ * This file contains the implementation of the "bridge" object. A bridge
+ * object is used when one SEE interpreter needs to access an object that
+ * was created by another SEE interpreter.
+ *
+ * struct SEE_interpreter *pInterp1 = <....>;
+ * struct SEE_interpreter *pInterp2 = <....>;
+ * struct SEE_object *pObj;
+ * BridgeObject *pBridge;
+ *
+ * pObj = (struct SEE_object *)SEE_native_new(pInterp1);
+ * pBridge = createBridgeObject(pInterp2, pInterp1, pObj);
+ *
+ * After running the above fragment, object pObj may only be used by
+ * interpreter pInterp1. Object pBridge, which behaves the same way
+ * in all respects, may be accessed by interpreter pInterp2.
+ *
+ * This file is part of the Hv3 web-browser. But it is really generic
+ * code that can be used by any program that needs to share objects
+ * between SEE interpreters.
+ */
+
+typedef struct BridgeObject BridgeObject;
+typedef struct BridgeEnum BridgeEnum;
+
+struct BridgeObject {
+ struct SEE_object object;
+ struct SEE_interpreter *i;
+ struct SEE_object *pObj;
+};
+
+struct BridgeEnum {
+ struct SEE_enum base;
+ struct SEE_interpreter *i;
+ struct SEE_enum *pEnum;
+};
+
+static struct SEE_objectclass *getBridgeVtbl();
+static struct SEE_enumclass *getBridgeEnumVtbl();
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * createBridgeObject --
+ *
+ * This is the only public interface in this file. Create a a wrapper
+ * (bridge) object that can be used in interpreter pInterp to access an
+ * object pForiegnObj that was created in interpreter pForiegnInterp.
+ *
+ * Results:
+ * Pointer to new heap allocated bridge object.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+struct SEE_object *
+createBridgeObject(pInterp, pForiegnInterp, pForiegnObj)
+ struct SEE_interpreter *pInterp;
+ struct SEE_interpreter *pForiegnInterp;
+ struct SEE_object *pForiegnObj;
+{
+ BridgeObject *p;
+ if (!pForiegnObj || pForiegnObj->objectclass==getBridgeVtbl()) {
+ return pForiegnObj;
+ }
+ p = SEE_NEW(pInterp, BridgeObject);
+ memset(p, 0, sizeof(BridgeObject));
+ p->object.Prototype = 0;
+ p->object.objectclass = getBridgeVtbl();
+ p->i = pForiegnInterp;
+ p->pObj = pForiegnObj;
+ return (struct SEE_object *)p;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * bridgeCopyValue --
+ *
+ * This function is used to transfer SEE values between interpreters.
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *---------------------------------------------------------------------------
+ */
+static void
+bridgeCopyValue(pInterp, pValue, pForiegnInterp, pForiegnValue)
+ struct SEE_interpreter *pInterp; /* Source interpreter */
+ struct SEE_value *pValue; /* Destination value */
+ struct SEE_interpreter *pForiegnInterp; /* Source interpreter */
+ struct SEE_value *pForiegnValue; /* Source value */
+{
+ int eType = SEE_VALUE_GET_TYPE(pForiegnValue);
+
+ if( eType==SEE_OBJECT ){
+ struct SEE_object *o = pForiegnValue->u.object;
+ SEE_SET_OBJECT(pValue, createBridgeObject(pInterp, pForiegnInterp, o));
+ assert(SEE_VALUE_GET_TYPE(pValue) == eType);
+ }else{
+ SEE_VALUE_COPY(pValue, pForiegnValue);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * bridgeHandleException --
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *---------------------------------------------------------------------------
+ */
+static void
+bridgeHandleException(pInterp, pForiegnInterp, pForiegnTry)
+ struct SEE_interpreter *pInterp;
+ struct SEE_interpreter *pForiegnInterp;
+ SEE_try_context_t *pForiegnTry;
+{
+ struct SEE_value *pForiegnVal = SEE_CAUGHT(*pForiegnTry);
+ if (pForiegnVal) {
+ struct SEE_value exception;
+#if 0
+struct SEE_traceback *pTrace;
+printf("throw: ");
+SEE_PrintValue(pForiegnInterp, pForiegnVal, stdout);
+printf("\n");
+SEE_ToString(pForiegnInterp, pForiegnVal, &exception);
+SEE_PrintValue(pForiegnInterp, &exception, stdout);
+printf("\n");
+#endif
+#if 0
+ for (pTrace = pForiegnTry->traceback; pTrace; pTrace = pTrace->prev) {
+ if (!pTrace->prev) {
+ pTrace->prev = pInterp->traceback;
+ pInterp->traceback = pForiegnTry->traceback;
+ }
+ }
+#endif
+ bridgeCopyValue(pInterp, &exception, pForiegnInterp, pForiegnVal);
+ pInterp->try_location = pForiegnInterp->try_location;
+ SEE_THROW(pInterp, &exception);
+ }
+}
+
+
+static void
+Bridge_Get(pInterp, pObj, pProp, pRes)
+ struct SEE_interpreter *pInterp;
+ struct SEE_object *pObj;
+ struct SEE_string *pProp;
+ struct SEE_value *pRes;
+{
+ BridgeObject *p = (BridgeObject *)pObj;
+ if (p->i == pInterp) {
+ SEE_OBJECT_GET(pInterp, p->pObj, pProp, pRes);
+ return;
+ } else {
+ SEE_try_context_t try_ctxt;
+ struct SEE_value val;
+ pProp = SEE_intern(p->i, pProp);
+ SEE_TRY(p->i, try_ctxt) {
+ SEE_OBJECT_GET(p->i, p->pObj, pProp, &val);
+ bridgeCopyValue(pInterp, pRes, p->i, &val);
+ }
+ bridgeHandleException(pInterp, p->i, &try_ctxt);
+ }
+}
+
+static void
+Bridge_Put(pInterp, pObj, pProp, pValue, flags)
+ struct SEE_interpreter *pInterp;
+ struct SEE_object *pObj;
+ struct SEE_string *pProp;
+ struct SEE_value *pValue;
+ int flags;
+{
+ BridgeObject *p = (BridgeObject *)pObj;
+ if (p->i == pInterp) {
+ SEE_OBJECT_PUT(pInterp, p->pObj, pProp, pValue, flags);
+ return;
+ } else {
+ SEE_try_context_t try_ctxt;
+ struct SEE_value val;
+ pProp = SEE_intern(p->i, pProp);
+ bridgeCopyValue(p->i, &val, pInterp, pValue);
+
+ SEE_TRY(p->i, try_ctxt) {
+ SEE_OBJECT_PUT(p->i, p->pObj, pProp, &val, flags);
+ }
+ bridgeHandleException(pInterp, p->i, &try_ctxt);
+ }
+}
+
+static int
+Bridge_CanPut(pInterp, pObj, pProp)
+ struct SEE_interpreter *pInterp;
+ struct SEE_object *pObj;
+ struct SEE_string *pProp;
+{
+ BridgeObject *p = (BridgeObject *)pObj;
+ pProp = SEE_intern(p->i, pProp);
+ return SEE_OBJECT_CANPUT(p->i, p->pObj, pProp);
+}
+
+static int
+Bridge_HasProperty(pInterp, pObj, pProp)
+ struct SEE_interpreter *pInterp;
+ struct SEE_object *pObj;
+ struct SEE_string *pProp;
+{
+ BridgeObject *p = (BridgeObject *)pObj;
+ pProp = SEE_intern(p->i, pProp);
+ return SEE_OBJECT_HASPROPERTY(p->i, p->pObj, pProp);
+}
+
+static int
+Bridge_Delete(pInterp, pObj, pProp)
+ struct SEE_interpreter *pInterp;
+ struct SEE_object *pObj;
+ struct SEE_string *pProp;
+{
+ BridgeObject *p = (BridgeObject *)pObj;
+ if (p->i == pInterp) {
+ return SEE_OBJECT_DELETE(pInterp, p->pObj, pProp);
+ } else {
+ int ret;
+ SEE_try_context_t try_ctxt;
+ pProp = SEE_intern(p->i, pProp);
+ SEE_TRY(p->i, try_ctxt) {
+ ret = SEE_OBJECT_DELETE(p->i, p->pObj, pProp);
+ }
+ bridgeHandleException(pInterp, p->i, &try_ctxt);
+ return ret;
+ }
+}
+
+static void
+Bridge_DefaultValue(pInterp, pObj, pHint, pRes)
+ struct SEE_interpreter *pInterp;
+ struct SEE_object *pObj;
+ struct SEE_value *pHint;
+ struct SEE_value *pRes;
+{
+ BridgeObject *p = (BridgeObject *)pObj;
+ struct SEE_value val;
+ SEE_OBJECT_DEFAULTVALUE(p->i, p->pObj, pHint, &val);
+ bridgeCopyValue(pInterp, pRes, p->i, &val);
+}
+
+static struct SEE_enum *
+Bridge_Enumerator(pInterp, pObj)
+ struct SEE_interpreter *pInterp;
+ struct SEE_object *pObj;
+{
+ BridgeObject *p = (BridgeObject *)pObj;
+ BridgeEnum *pEnum;
+
+ pEnum = SEE_NEW(pInterp, BridgeEnum);
+ pEnum->base.enumclass = getBridgeEnumVtbl();
+ pEnum->i = p->i;
+ pEnum->pEnum = SEE_OBJECT_ENUMERATOR(p->i, p->pObj);
+
+ return (struct SEE_enum *)pEnum;
+}
+
+static void
+bridgeCallOrConstruct(pInterp, pObj, pThis, argc, argv, pRes, isConstruct)
+ struct SEE_interpreter *pInterp;
+ struct SEE_object *pObj;
+ struct SEE_object *pThis;
+ int argc;
+ struct SEE_value **argv;
+ struct SEE_value *pRes;
+ int isConstruct;
+{
+ BridgeObject *p = (BridgeObject *)pObj;
+
+ if (p->i==pInterp) {
+ if (isConstruct) {
+ SEE_OBJECT_CONSTRUCT(pInterp, p->pObj, pThis, argc, argv, pRes);
+ } else {
+ SEE_OBJECT_CALL(pInterp, p->pObj, pThis, argc, argv, pRes);
+ }
+ return;
+ }else{
+ SEE_try_context_t try_ctxt;
+ struct SEE_value **apValue;
+ struct SEE_value *aValue;
+ struct SEE_value val;
+
+ int nByte;
+ int i;
+ nByte = (sizeof(struct SEE_value) + sizeof(struct SEE_value *)) * argc;
+ aValue = SEE_malloc(pInterp, nByte);
+ apValue = (struct SEE_value **)&aValue[argc];
+ for(i = 0; i < argc; i++){
+ bridgeCopyValue(p->i, &aValue[i], pInterp, argv[i]);
+ apValue[i] = &aValue[i];
+ }
+ pThis = createBridgeObject(p->i, pInterp, pThis);
+
+ SEE_TRY(p->i, try_ctxt) {
+ if (isConstruct) {
+ SEE_OBJECT_CONSTRUCT(p->i, p->pObj, pThis, argc, apValue, &val);
+ } else {
+ SEE_OBJECT_CALL(p->i, p->pObj, pThis, argc, apValue, &val);
+ }
+ bridgeCopyValue(pInterp, pRes, p->i, &val);
+ }
+
+ bridgeHandleException(pInterp, p->i, &try_ctxt);
+ }
+}
+
+static void
+Bridge_Construct(pInterp, pObj, pThis, argc, argv, pRes)
+ struct SEE_interpreter *pInterp;
+ struct SEE_object *pObj;
+ struct SEE_object *pThis;
+ int argc;
+ struct SEE_value **argv;
+ struct SEE_value *pRes;
+{
+ return bridgeCallOrConstruct(pInterp, pObj, pThis, argc, argv, pRes, 1);
+}
+
+static void
+Bridge_Call(pInterp, pObj, pThis, argc, argv, pRes)
+ struct SEE_interpreter *pInterp;
+ struct SEE_object *pObj;
+ struct SEE_object *pThis;
+ int argc;
+ struct SEE_value **argv;
+ struct SEE_value *pRes;
+{
+ return bridgeCallOrConstruct(pInterp, pObj, pThis, argc, argv, pRes, 0);
+}
+
+static int
+Bridge_HasInstance(pInterp, pObj, pInstance)
+ struct SEE_interpreter *pInterp;
+ struct SEE_object *pObj;
+ struct SEE_value *pInstance;
+{
+ BridgeObject *p = (BridgeObject *)pObj;
+ struct SEE_value val;
+ bridgeCopyValue(p->i, &val, pInterp, pInstance);
+ return SEE_OBJECT_HASINSTANCE(p->i, p->pObj, &val);
+}
+
+static void *
+Bridge_GetSecDomain(pInterp, pObj)
+ struct SEE_interpreter *pInterp;
+ struct SEE_object *pObj;
+{
+ BridgeObject *p = (BridgeObject *)pObj;
+ return SEE_OBJECT_GET_SEC_DOMAIN(p->i, p->pObj);
+}
+
+static struct SEE_string *
+BridgeEnum_Next(pSeeInterp, pEnum, pFlags)
+ struct SEE_interpreter *pSeeInterp;
+ struct SEE_enum *pEnum;
+ int *pFlags;
+{
+ BridgeEnum *p = (BridgeEnum *)pEnum;
+ return SEE_ENUM_NEXT(p->i, p->pEnum, pFlags);
+}
+
+/* Return a pointer to the bridge object vtbl */
+static struct SEE_objectclass *getBridgeVtbl() {
+ static struct SEE_objectclass BridgeObjectVtbl = {
+ "Bridge",
+ Bridge_Get,
+ Bridge_Put,
+ Bridge_CanPut,
+ Bridge_HasProperty,
+ Bridge_Delete,
+ Bridge_DefaultValue,
+ Bridge_Enumerator,
+ Bridge_Construct,
+ Bridge_Call,
+ Bridge_HasInstance,
+ Bridge_GetSecDomain
+ };
+ return &BridgeObjectVtbl;
+}
+
+/* Return a pointer to the bridge object enumerator vtbl */
+static struct SEE_enumclass *getBridgeEnumVtbl() {
+ static struct SEE_enumclass BridgeEnumVtbl = {
+ 0, /* Unused */
+ BridgeEnum_Next
+ };
+ return &BridgeEnumVtbl;
+}
+
diff --git a/hv/hv3events.c b/hv/hv3events.c
index 5da9bb0..8b75279 100644
--- a/hv/hv3events.c
+++ b/hv/hv3events.c
@@ -156,6 +156,32 @@ getEventList(interp, pObj)
return 0;
}
+static void
+objectCall(pInterp, pObj, pThis, argc, argv, pRes)
+ struct SEE_interpreter *pInterp;
+ struct SEE_object *pObj;
+ struct SEE_object *pThis;
+ int argc;
+ struct SEE_value **argv;
+ struct SEE_value *pRes;
+{
+#if 1
+ SEE_OBJECT_CALL(pInterp, pObj, pThis, argc, argv, pRes);
+#else
+ SEE_try_context_t try_ctxt;
+ SEE_TRY(pInterp, try_ctxt) {
+ SEE_OBJECT_CALL(pInterp, pObj, pThis, argc, argv, pRes);
+ }
+ if (SEE_CAUGHT(try_ctxt)) {
+ struct SEE_value str;
+ SEE_ToString(pInterp, SEE_CAUGHT(try_ctxt), &str);
+ printf("Error in event-handler: ");
+ SEE_PrintValue(pInterp, &str, stdout);
+ printf("\n");
+ }
+#endif
+}
+
/*
*---------------------------------------------------------------------------
*
@@ -183,6 +209,11 @@ runEvent(interp, pTarget, pEvent, zType, isCapture)
ListenerContainer *pL = 0;
struct SEE_value target;
+ /* If *pTarget is a tcl-based object, then set this pointer to pTarget.
+ * Otherwise leave it as null.
+ */
+ SeeTclObject *pTclObject = 0;
+
assert(zType->flags & SEE_STRING_FLAG_INTERNED);
assert(isCapture == 1 || isCapture == 0);
assert(SEE_VALUE_GET_TYPE(pEvent) == SEE_OBJECT);
@@ -195,14 +226,18 @@ runEvent(interp, pTarget, pEvent, zType, isCapture)
return 0;
}
+ if (pTarget->objectclass == getVtbl()) {
+ pTclObject = (SeeTclObject *)pTarget;
+ }
+
/* If this is a Tcl based object, run any registered DOM event handlers */
- ppET = getEventList(interp, pTarget);
- if (ppET) {
+ if (pTclObject) {
+ ppET = &pTclObject->pTypeList;
for (pET = *ppET; pET && pET->zType != zType; pET = pET->pNext);
for (pL = (pET ? pET->pListenerList: 0); rc && pL; pL = pL->pNext) {
if (pL->isCapture == isCapture) {
struct SEE_value r;
- SEE_OBJECT_CALL(interp, pL->pListener, pTarget, 1, &pEvent, &r);
+ objectCall(interp, pL->pListener, pTarget, 1, &pEvent, &r);
setBooleanFlag(interp, pEvent->u.object, CALLED_LISTENER, 1);
}
}
@@ -212,16 +247,19 @@ runEvent(interp, pTarget, pEvent, zType, isCapture)
if (!isCapture) {
struct SEE_value val;
struct SEE_string *e = SEE_string_new(interp, 128);
+ struct SEE_object *pLookup = (pTclObject ?
+ ((struct SEE_object *)pTclObject->pNative) : pTarget
+ );
+
SEE_string_append_ascii(e, "on");
SEE_string_append(e, zType);
-
e = SEE_intern(interp, e);
- SEE_OBJECT_GET(interp, pTarget, e, &val);
+ SEE_OBJECT_GET(interp, pLookup, e, &val);
if (SEE_VALUE_GET_TYPE(&val) == SEE_OBJECT) {
struct SEE_object *pE = pEvent->u.object;
struct SEE_value res;
- SEE_OBJECT_CALL(interp, val.u.object, pTarget, 1, &pEvent, &res);
+ objectCall(interp, val.u.object, pTarget, 1, &pEvent, &res);
setBooleanFlag(interp, pE, CALLED_LISTENER, 1);
rc = valueToBoolean(interp, &res, 1);
if (!rc) {
@@ -280,6 +318,31 @@ stopPropagationFunc(interp, self, thisobj, argc, argv, res)
setBooleanFlag(interp, thisobj, STOP_PROPAGATION, 1);
}
+static struct SEE_object *
+getParentNode(interp, p)
+ struct SEE_interpreter *interp;
+ struct SEE_object *p;
+{
+ struct SEE_value val;
+
+ if (p->objectclass == getVtbl()){
+ NodeHack *pNode = ((SeeTclObject *)p)->nodehandle;
+ if (pNode && pNode->pParent && pNode->pParent->pObj) {
+ return (struct SEE_object *)pNode->pParent->pObj;
+ }
+ if (pNode && pNode->pParent == 0 && pNode->iNode < 0){
+ return 0;
+ }
+ if (pNode && pNode->pParent == 0) {
+ /* Return document... */
+ }
+ }
+
+ SEE_OBJECT_GETA(interp, p, "parentNode", &val);
+ if (SEE_VALUE_GET_TYPE(&val) != SEE_OBJECT) return 0;
+ return val.u.object;
+}
+
/*
*---------------------------------------------------------------------------
*
@@ -343,6 +406,7 @@ dispatchEventFunc(interp, self, thisobj, argc, argv, res)
return;
}
pEvent = argv[0]->u.object;
+ assert(pEvent);
SEE_CFUNCTION_PUTA(interp,pEvent,"stopPropagation",stopPropagationFunc,0,0);
SEE_CFUNCTION_PUTA(interp,pEvent,"preventDefault",preventDefaultFunc,0,0);
@@ -376,9 +440,8 @@ dispatchEventFunc(interp, self, thisobj, argc, argv, res)
if (isBubbler) {
struct SEE_object *p = thisobj;
while (1) {
- SEE_OBJECT_GETA(interp, p, "parentNode", &val);
- if (SEE_VALUE_GET_TYPE(&val) != SEE_OBJECT) break;
-
+ struct SEE_object *pObj = getParentNode(interp, p);
+ if (!pObj) break;
if (nObj == nObjAlloc) {
int nNew;
struct SEE_object **aNew;
@@ -391,9 +454,8 @@ dispatchEventFunc(interp, self, thisobj, argc, argv, res)
}
apObj = aNew;
}
-
- p = val.u.object;
- apObj[nObj++] = p;
+ apObj[nObj++] = pObj;
+ p = pObj;
}
}
@@ -455,7 +517,8 @@ eventDispatchCmd(clientData, pTcl, objc, objv)
int rc = TCL_OK;
pTarget = findOrCreateObject(pTclSeeInterp, objv[2], 0);
- pEvent = createTransient(pTclSeeInterp, objv[3]);
+ // pEvent = createTransient(pTclSeeInterp, objv[3]);
+ pEvent = createNative(pTclSeeInterp, objv[3]);
assert(Tcl_IsShared(objv[3]));
SEE_TRY (p, try_ctxt) {
diff --git a/hv/hv3see.c b/hv/hv3see.c
index 45cba2f..79dc094 100644
--- a/hv/hv3see.c
+++ b/hv/hv3see.c
@@ -167,25 +167,97 @@
*/
#include "hv3format.c"
-typedef struct SeeInterp SeeInterp;
+#include "hv3bridge.c"
+
typedef struct SeeTclObject SeeTclObject;
-typedef struct SeeJsObject SeeJsObject;
+typedef struct SeeTclClass SeeTclClass;
+typedef struct SeeInterp SeeInterp;
+typedef struct SeeJsObject SeeJsObject;
typedef struct SeeTimeout SeeTimeout;
+typedef struct NodeHack NodeHack;
+struct NodeHack {
+ SeeTclObject *pObj;
+ NodeHack *pParent; /* Parent of this node */
+ int iNode; /* Node index */
+};
+
/* Size of hash-table. This should be replaced with a dynamic hash
* table structure.
*/
#define OBJECT_HASH_SIZE 257
+typedef struct EventType EventType;
+
+/* Each javascript object created by the Tcl-side is represented by
+ * an instance of the following struct.
+ */
+struct SeeTclObject {
+ struct SEE_object object; /* C Base class - Object */
+ struct SEE_native *pNative; /* Store native properties here */
+ Tcl_Obj *pObj; /* Tcl script for object */
+
+ /* Used by the events sub-system (hv3events.c) */
+ EventType *pTypeList;
+ NodeHack *nodehandle; /* Non-zero if this is a "node" object */
+
+ /* Used by the timer sub-system (hv3timeout.c). This pointer is only
+ * ever used for objects of type Window, but space is allocated for
+ * every single object. This seems a bit wasteful, but it's not our
+ * biggest problem right now.
+ */
+ SeeTimeout *pTimeout;
+
+ SeeTclClass *pClass;
+
+ /* The data stored in these variables is based on the data in pObj.
+ * See the allocWordArray() function for details. The idea is that
+ * we break the list in pObj into an array of words (apWord). But
+ * the allocated size of apWord is larger than the number of
+ * words in pObj.
+ *
+ * So when we need to append some arguments and execute the object
+ * command, the code just looks like this:
+ *
+ * int N = pSeeTclObject->nWord;
+ * pSeeTclObject->apWord[N] = Tcl_NewStringObj(.....);
+ * pSeeTclObject->apWord[N+1] = Tcl_NewStringObj(.....);
+ * rc = Tcl_EvalObjv(interp, N+2, pSeeTclObject->apWord, flags);
+ * # ... cleanup the two allocated string objects....
+ */
+ Tcl_Obj **apWord;
+ int nWord;
+ int nAllocWord;
+
+ /* This is used by objects while they reside in the
+ * SeeInterp.aTclObject[] hash table.
+ */
+ SeeTclObject *pNext;
+};
+
+struct SeeTclClass {
+ /* Hash table containing fixed list of properties for this class. Hash
+ * table keys are intern'd SEE_string pointers. Because they are intern'd
+ * in the global string table, this can be used with any SEE interpreter.
+ */
+ Tcl_HashTable aProperty;
+};
+
+
struct SeeInterp {
/* The two interpreters - SEE and Tcl. The interp member must be
* first, so that we can cast between (struct SEE_interpreter *)
* and (SeeInterp *).
*/
struct SEE_interpreter interp;
+
+ /* The Tcl interpreter that created this object. */
Tcl_Interp *pTclInterp;
+ /* The global object used by this interpreter. */
+ SeeTclObject global;
+
ClientData pInstrumentData;
Tcl_Obj *pTclError;
@@ -234,50 +306,6 @@ struct SeeInterp {
};
static int iSeeInterp = 0;
-typedef struct EventType EventType;
-
-/* Each javascript object created by the Tcl-side is represented by
- * an instance of the following struct.
- */
-struct SeeTclObject {
- struct SEE_object object; /* Base class - Object */
- struct SEE_native *pNative; /* Store native properties here */
- Tcl_Obj *pObj; /* Tcl script for object */
-
- /* Used by the events sub-system (hv3events.c) */
- EventType *pTypeList;
-
- /* Used by the timer sub-system (hv3timeout.c). This pointer is only
- * ever used for objects of type Window, but space is allocated for
- * every single object. This seems a bit wasteful, but it's not our
- * biggest problem right now.
- */
- SeeTimeout *pTimeout;
-
- /* The data stored in these variables is based on the data in pObj.
- * See the allocWordArray() function for details. The idea is that
- * we break the list in pObj into an array of words (apWord). But
- * the allocated size of apWord is larger than the number of
- * words in pObj.
- *
- * So when we need to append some arguments and execute the object
- * command, the code just looks like this:
- *
- * int N = pSeeTclObject->nWord;
- * pSeeTclObject->apWord[N] = Tcl_NewStringObj(.....);
- * pSeeTclObject->apWord[N+1] = Tcl_NewStringObj(.....);
- * rc = Tcl_EvalObjv(interp, N+2, pSeeTclObject->apWord, flags);
- * # ... cleanup the two allocated string objects....
- */
- Tcl_Obj **apWord;
- int nWord;
- int nAllocWord;
-
- /* This is used by objects while they reside in the
- * SeeInterp.aTclObject[] hash table.
- */
- SeeTclObject *pNext;
-};
/* This variable, used for debugging, stores the total number of
* SeeTclObject structures currently allocated.
@@ -318,9 +346,6 @@ static void interpTimeoutInit(SeeInterp *, SeeTclObject *);
static void interpTimeoutCleanup(SeeInterp *, SeeTclObject *);
#include "hv3timeout.c"
-static void interpFunctionInit(SeeInterp *, SeeTclObject *);
-#include "hv3function.c"
-
/*
*---------------------------------------------------------------------------
@@ -537,7 +562,13 @@ static Tcl_Obj *
stringToObj(pString)
struct SEE_string *pString;
{
- return Tcl_NewUnicodeObj(pString->data, pString->length);
+ Tcl_Obj *pObj;
+ if( pString ){
+ pObj = Tcl_NewUnicodeObj(pString->data, pString->length);
+ } else {
+ pObj = Tcl_NewObj();
+ }
+ return pObj;
}
/*
@@ -576,7 +607,7 @@ primitiveValueToTcl(pTclSeeInterp, pValue)
if (
eType != SEE_UNDEFINED && eType != SEE_NULL &&
eType != SEE_BOOLEAN && eType != SEE_NUMBER &&
- eType != SEE_STRING
+ eType != SEE_STRING && eType != SEE_OBJECT
) {
SEE_ToPrimitive(&pTclSeeInterp->interp, pValue, 0, ©);
p = ©
@@ -607,9 +638,16 @@ primitiveValueToTcl(pTclSeeInterp, pValue)
aTclValues[1] = stringToObj(p->u.string);
break;
- case SEE_OBJECT:
- aTclValues[0] = Tcl_NewStringObj("OBJECT", -1);
+ case SEE_OBJECT: {
+ if (p->u.object->objectclass != getVtbl()) {
+ aTclValues[0] = Tcl_NewStringObj("OBJECT", -1);
+ } else {
+ SeeTclObject *pObj = (SeeTclObject *)(p->u.object);
+ aTclValues[0] = Tcl_NewStringObj("object", -1);
+ aTclValues[1] = pObj->pObj;
+ }
break;
+ }
case SEE_REFERENCE:
aTclValues[0] = Tcl_NewStringObj("REFERENCE", -1);
@@ -772,6 +810,7 @@ callSeeTclMethod(pTcl, pLog, p, zMethod, pProperty, pVal)
Tcl_ListObjAppendElement(0, pEval, p->pObj);
if (pMethod) Tcl_ListObjAppendElement(0, pEval, pMethod);
if (pProp) Tcl_ListObjAppendElement(0, pEval, pProp);
+ if (pVal) Tcl_ListObjAppendElement(0, pEval, pVal);
Tcl_ListObjAppendElement(0, pEval, pRes);
Tcl_EvalObjEx(pTcl, pEval, TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(pEval);
@@ -786,6 +825,35 @@ callSeeTclMethod(pTcl, pLog, p, zMethod, pProperty, pVal)
return rc;
}
+static void
+initSeeTclObject(pTclSeeInterp, p, pTclCommand)
+ SeeInterp *pTclSeeInterp;
+ SeeTclObject *p;
+ Tcl_Obj *pTclCommand;
+{
+ Tcl_CmdInfo info;
+ char zBuf[256];
+
+ memset(p, 0, sizeof(SeeTclObject));
+ p->pObj = pTclCommand;
+ p->object.objectclass = getVtbl();
+ p->object.Prototype = pTclSeeInterp->interp.Object_prototype;
+
+ Tcl_IncrRefCount(p->pObj);
+ allocWordArray(pTclSeeInterp, p, 5);
+
+ /* Initialise the native object (used to store native properties) */
+ p->pNative = (struct SEE_native *)SEE_native_new(&pTclSeeInterp->interp);
+
+ /* Initialise the class, if any */
+ sprintf(zBuf, "%s.class", Tcl_GetString(p->apWord[0]));
+ if (Tcl_GetCommandInfo(pTclSeeInterp->pTclInterp, zBuf, &info)){
+ p->pClass = (SeeTclClass *)info.objClientData;
+ }
+
+ iNumSeeTclObject++;
+}
+
/*
*---------------------------------------------------------------------------
*
@@ -807,21 +875,8 @@ newSeeTclObject(pTclSeeInterp, pTclCommand)
SeeInterp *pTclSeeInterp;
Tcl_Obj *pTclCommand;
{
- SeeTclObject *p;
-
- p = SEE_NEW(&pTclSeeInterp->interp, SeeTclObject);
- memset(p, 0, sizeof(SeeTclObject));
- p->pObj = pTclCommand;
- p->object.objectclass = getVtbl();
- p->object.Prototype = pTclSeeInterp->interp.Object_prototype;
-
- Tcl_IncrRefCount(p->pObj);
- allocWordArray(pTclSeeInterp, p, 5);
-
- /* Initialise the native object (used to store native properties) */
- p->pNative = (struct SEE_native *)SEE_native_new(&pTclSeeInterp->interp);
-
- iNumSeeTclObject++;
+ SeeTclObject *p = SEE_NEW(&pTclSeeInterp->interp, SeeTclObject);
+ initSeeTclObject(pTclSeeInterp, p, pTclCommand);
return p;
}
@@ -899,6 +954,67 @@ createTransient(pTclSeeInterp, pTclCommand)
/*
*---------------------------------------------------------------------------
*
+ * createNative --
+ *
+ * Results:
+ * Pointer to SEE_object structure.
+ *
+ * Side effects:
+ *
+ *---------------------------------------------------------------------------
+ */
+static int objToValue(SeeInterp *, Tcl_Obj *, struct SEE_value *, int *);
+static struct SEE_object *
+createNative(pTclSeeInterp, pTclList)
+ SeeInterp *pTclSeeInterp;
+ Tcl_Obj *pTclList;
+{
+ Tcl_Interp *pTcl = pTclSeeInterp->pTclInterp;
+ struct SEE_interpreter *pSee = (struct SEE_interpreter *)pTclSeeInterp;
+ int nElem = 0;
+ Tcl_Obj **apElem = 0;
+ int rc;
+ int ii;
+ struct SEE_object *pRet;
+
+ rc = Tcl_ListObjGetElements(pTcl, pTclList, &nElem, &apElem);
+ if (rc != TCL_OK) return 0;
+
+ pRet = (struct SEE_object *)SEE_native_new(pSee);
+ for (ii = 0; ii < (nElem-1); ii += 2){
+ struct SEE_value value;
+ rc = objToValue(pTclSeeInterp, apElem[ii+1], &value, 0);
+ if (rc != TCL_OK) return 0;
+ SEE_OBJECT_PUTA(pSee, pRet, Tcl_GetString(apElem[ii]), &value, 0);
+ }
+
+ return pRet;
+}
+
+static struct SEE_object *
+createBridge(pTclSeeInterp, pCommand)
+ SeeInterp *pTclSeeInterp;
+ Tcl_Obj *pCommand;
+{
+ Tcl_Command t;
+ Tcl_CmdInfo info;
+
+ SeeInterp *pForiegnInterp;
+
+ t = Tcl_GetCommandFromObj(pTclSeeInterp->pTclInterp, pCommand);
+ if( !t ) return 0;
+ assert(t);
+ Tcl_GetCommandInfoFromToken(t, &info);
+ pForiegnInterp = info.objClientData;
+ assert( pForiegnInterp->global.object.objectclass==getVtbl() );
+ return createBridgeObject(&pTclSeeInterp->interp,
+ &pForiegnInterp->interp, &pForiegnInterp->global.object
+ );
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
* findOrCreateObject --
*
* Results:
@@ -944,7 +1060,11 @@ findOrCreateObject(pTclSeeInterp, pTclCommand, isGlobal)
*/
if (!pObject) {
Tcl_Interp *pTcl = pTclSeeInterp->pTclInterp;
- pObject = newSeeTclObject(pTclSeeInterp, pTclCommand);
+ if (isGlobal) {
+ pObject = &pTclSeeInterp->global;
+ }else{
+ pObject = newSeeTclObject(pTclSeeInterp, pTclCommand);
+ }
/* Insert the new object into the hash table */
pObject->pNext = pTclSeeInterp->aTclObject[iSlot];
@@ -964,6 +1084,28 @@ findOrCreateObject(pTclSeeInterp, pTclCommand, isGlobal)
return (struct SEE_object *)pObject;
}
+static struct SEE_object *
+createNode(pTclSeeInterp, pTclCommand)
+ SeeInterp *pTclSeeInterp;
+ Tcl_Obj *pTclCommand;
+{
+ Tcl_Interp *pTcl = pTclSeeInterp->pTclInterp;
+ SeeTclObject * p;
+
+ p = (SeeTclObject *)findOrCreateObject(pTclSeeInterp, pTclCommand, 0);
+ if (p->nodehandle == 0) {
+ Tcl_Command t;
+ Tcl_CmdInfo info;
+ t = Tcl_GetCommandFromObj(pTcl, p->apWord[2]);
+ assert(t);
+ Tcl_GetCommandInfoFromToken(t, &info);
+ p->nodehandle = info.objClientData;
+ ((NodeHack *)p->nodehandle)->pObj = p;
+ }
+ return (struct SEE_object *)p;
+}
+
+
/*
*---------------------------------------------------------------------------
*
@@ -1089,6 +1231,9 @@ objToValue(pInterp, pObj, pValue, pIsCacheable)
} else {
int iChoice;
#define TRANSIENT -124
+ #define NATIVE -123
+ #define NODE -122
+ #define BRIDGE -121
struct ValueType {
char const *zType;
int eType;
@@ -1099,8 +1244,12 @@ objToValue(pInterp, pObj, pValue, pIsCacheable)
{"number", SEE_NUMBER, 1},
{"string", SEE_STRING, 1},
{"boolean", SEE_BOOLEAN, 1},
+
{"object", SEE_OBJECT, 1},
{"transient", TRANSIENT, 1},
+ {"native", NATIVE, 1},
+ {"node", NODE, 1},
+ {"bridge", BRIDGE, 1},
{0, 0, 0}
};
@@ -1176,12 +1325,36 @@ objToValue(pInterp, pObj, pValue, pIsCacheable)
break;
}
+ case NODE: {
+ struct SEE_object *p = createNode(pInterp, apElem[1]);
+ SEE_SET_OBJECT(pValue, (struct SEE_object *)p);
+ break;
+ }
+
case TRANSIENT: {
struct SEE_object *pObject =
createTransient(pInterp, apElem[1]);
SEE_SET_OBJECT(pValue, pObject);
break;
}
+
+ case NATIVE: {
+ struct SEE_object *pObject;
+ pObject = createNative(pInterp, apElem[1]);
+ SEE_SET_OBJECT(pValue, pObject);
+ break;
+ }
+
+ case BRIDGE: {
+ struct SEE_object *pObject;
+ pObject = createBridge(pInterp, apElem[1]);
+ if (pObject) {
+ SEE_SET_OBJECT(pValue, pObject);
+ }else{
+ rc = TCL_ERROR;
+ }
+ break;
+ }
}
}
}
@@ -1239,6 +1412,7 @@ handleJavascriptError(pTclSeeInterp, pTry)
pError = Tcl_NewObj();
Tcl_ListObjAppendElement(0, pError, Tcl_NewStringObj("JS_ERROR", -1));
+ /* String form of exception object thrown */
SEE_ToString(pSeeInterp, SEE_CAUGHT(*pTry), &error);
if (SEE_VALUE_GET_TYPE(&error) == SEE_STRING) {
struct SEE_string *pS = error.u.string;
@@ -1248,6 +1422,7 @@ handleJavascriptError(pTclSeeInterp, pTry)
Tcl_ListObjAppendElement(0, pError, Tcl_NewStringObj("N/A", -1));
}
+ /* If there is a Tcl error, append it. Otherwise append an empty string. */
if (pTclSeeInterp->pTclError) {
Tcl_ListObjAppendElement(0, pError, pTclSeeInterp->pTclError);
Tcl_DecrRefCount(pTclSeeInterp->pTclError);
@@ -1256,6 +1431,14 @@ handleJavascriptError(pTclSeeInterp, pTry)
Tcl_ListObjAppendElement(0, pError, Tcl_NewStringObj("", -1));
}
+ if (pSeeInterp->try_location) {
+ struct SEE_throw_location *pLoc = pSeeInterp->try_location;
+ Tcl_ListObjAppendElement(0, pError, stringToObj(pLoc->filename));
+ Tcl_ListObjAppendElement(0, pError, Tcl_NewIntObj(pLoc->lineno));
+ Tcl_ListObjAppendElement(0, pError, Tcl_NewObj());
+ Tcl_ListObjAppendElement(0, pError, Tcl_NewObj());
+ }
+
for (pTrace = pTry->traceback; pTrace; pTrace = pTrace->prev) {
struct SEE_string *pFile = pTrace->call_location->filename;
if (!pFile) {
@@ -1410,13 +1593,13 @@ interpEval(pTclSeeInterp, nArg, apArg)
TclCmdArg aOptions[] = {
{"-file", 0, 0}, /* 0 */
- {"-window", 0, 0}, /* 1 */
- {"-noresult", 1, 0}, /* 2 */
+ {"-noresult", 1, 0}, /* 1 */
{0, 0, 0}
};
+
Tcl_Obj *pFile; /* Value passed to -file option */
- Tcl_Obj *pWindow; /* Value passed to -window option */
Tcl_Obj *pCode; /* Javascript to evaluate */
+ int isNoResult; /* True if -noresult */
struct SEE_value res; /* Result of script evaluation */
@@ -1429,7 +1612,7 @@ interpEval(pTclSeeInterp, nArg, apArg)
}
pCode = apArg[nArg - 1];
pFile = aOptions[0].pVal;
- pWindow = aOptions[1].pVal;
+ isNoResult = (aOptions[1].pVal!=0);
memset(&res, 0, sizeof(struct SEE_value));
Tcl_ResetResult(pTclInterp);
@@ -1452,35 +1635,15 @@ interpEval(pTclSeeInterp, nArg, apArg)
pSee, "%s", Tcl_GetString(pFile)
);
}
-
- if (pWindow) {
- struct SEE_object *p = 0;
- struct SEE_scope *pScope = 0;
- struct SEE_scope *pScopeOld = pTclSeeInterp->pScope;
-
- p = findOrCreateObject(pTclSeeInterp, pWindow, 0);
- pScope = (struct SEE_scope *)SEE_malloc(pSee, sizeof(*pScope) * 2);
- pScope->obj = p;
- pScope->next = &pScope[1];
- pScope->next->obj = pTclSeeInterp->interp.Global;
- pScope->next->next = 0;
-
- pTclSeeInterp->pScope = pScope;
- SEE_TRY(pSee, try_ctxt) {
- SEE_eval(pSee, pInput, p, p, pScope, &res);
- }
- pTclSeeInterp->pScope = pScopeOld;
- } else {
- SEE_TRY(pSee, try_ctxt) {
- SEE_Global_eval(pSee, pInput, &res);
- }
+ SEE_TRY(pSee, try_ctxt) {
+ SEE_Global_eval(pSee, pInput, &res);
}
SEE_INPUT_CLOSE(pInput);
}
if (SEE_CAUGHT(try_ctxt)) {
rc = handleJavascriptError(pTclSeeInterp, &try_ctxt);
- } else if (!aOptions[2].pVal) {
+ } else if (!isNoResult) {
Tcl_SetObjResult(pTclInterp, primitiveValueToTcl(pTclSeeInterp, &res));
}
@@ -1488,24 +1651,21 @@ interpEval(pTclSeeInterp, nArg, apArg)
}
static int
-interpClear(pTclSeeInterp, objc, objv)
+interpGlobalSet(pTclSeeInterp, pProp, pValue)
SeeInterp *pTclSeeInterp; /* Interpreter */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument strings. */
+ Tcl_Obj *pProp;
+ Tcl_Obj *pValue;
{
- struct SEE_object *pObj;
- SeeTclObject *p;
-
- pObj = findOrCreateObject(pTclSeeInterp,objv[2],0);
- p = (SeeTclObject *)pObj;
- interpTimeoutCleanup(pTclSeeInterp, p);
- assert(p->pTimeout == 0);
- memset(p->pNative->properties, 0, sizeof(p->pNative->properties));
- p->pTypeList = 0;
- interpTimeoutInit(pTclSeeInterp, p);
- interpFunctionInit(pTclSeeInterp, p);
-
- return TCL_OK;
+ struct SEE_value value;
+ int rc;
+ rc = objToValue(pTclSeeInterp, pValue, &value, 0);
+ if (rc == TCL_OK) {
+ SEE_OBJECT_PUTA(&pTclSeeInterp->interp,
+ (struct SEE_object *)(pTclSeeInterp->global.pNative),
+ Tcl_GetString(pProp), &value, 0
+ );
+ }
+ return rc;
}
/*
@@ -1614,8 +1774,9 @@ interpCmd(clientData, pTclInterp, objc, objv)
INTERP_DESTROY, /* Destroy the interpreter */
INTERP_EVAL, /* Evaluate some javascript */
INTERP_TOSTRING, /* Convert js value to a string */
- INTERP_WINDOW, /* Initialize a "Window" object */
- INTERP_CLEAR,
+
+ INTERP_NODE,
+ INTERP_GLOBAL,
/* Object management */
INTERP_MAKE_TRANSIENT, /* Declare an object eligible for GC */
@@ -1641,8 +1802,11 @@ interpCmd(clientData, pTclInterp, objc, objv)
{"destroy", INTERP_DESTROY, 0, 0, ""},
{"eval", INTERP_EVAL, 0, -1, 0},
{"tostring", INTERP_TOSTRING, 1, 1, "JAVASCRIPT-VALUE"},
- {"window", INTERP_WINDOW, 1, 1, "JAVASCRIPT-VALUE"},
- {"clear", INTERP_CLEAR, 1, 1, "JAVASCRIPT-VALUE"},
+
+ {"node", INTERP_NODE, 1, 1, "TCL-COMMAND"},
+
+ /* Set properties on persistent objects */
+ {"global", INTERP_GLOBAL, 2, 2, "PROPERTY JAVASCRIPT-VALUE"},
/* Events */
{"dispatch", INTERP_DISPATCH, 2, 2, "TARGET-COMMAND EVENT-COMMAND"},
@@ -1697,20 +1861,18 @@ interpCmd(clientData, pTclInterp, objc, objv)
}
/*
- * seeInterp window JAVASCRIPT-OBJECT
+ * seeInterp node JAVASCRIPT-OBJECT
*/
- case INTERP_WINDOW: {
- struct SEE_object *p = findOrCreateObject(pTclSeeInterp,objv[2],0);
- interpTimeoutInit(pTclSeeInterp, (SeeTclObject *)p);
- interpFunctionInit(pTclSeeInterp, (SeeTclObject *)p);
+ case INTERP_NODE: {
+ createNode(pTclSeeInterp, objv[2]);
break;
}
/*
- * seeInterp clear JAVASCRIPT-OBJECT
+ * seeInterp global PROPERTY JAVASCRIPT-VALUE
*/
- case INTERP_CLEAR: {
- rc = interpClear(pTclSeeInterp, objc, objv);
+ case INTERP_GLOBAL: {
+ rc = interpGlobalSet(pTclSeeInterp, objv[2], objv[3]);
break;
}
@@ -1872,20 +2034,35 @@ tclSeeInterp(clientData, interp, objc, objv)
{
char zCmd[64];
SeeInterp *pInterp;
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "GLOBAL-OBJCOMMAND");
+ return TCL_ERROR;
+ }
- sprintf(zCmd, "::see::interp_%d", iSeeInterp++);
-
+ /* Allocate the interpreter structure and initialize the global object. */
pInterp = (SeeInterp *)GC_MALLOC_UNCOLLECTABLE(sizeof(SeeInterp));
memset(pInterp, 0, sizeof(SeeInterp));
+ pInterp->pTclInterp = interp;
+ initSeeTclObject(pInterp, &pInterp->global, objv[1]);
- /* Initialize a new SEE interpreter */
- SEE_interpreter_init_compat(&pInterp->interp,
- SEE_COMPAT_JS15|SEE_COMPAT_SGMLCOM|SEE_COMPAT_262_3B
+ /* Initialize the SEE interpreter. */
+ SEE_interpreter_init_hostglobal(&pInterp->interp,
+ SEE_COMPAT_JS15|SEE_COMPAT_SGMLCOM|SEE_COMPAT_262_3B,
+ (struct SEE_object *)&pInterp->global
);
pInterp->interp.trace = seeTraceHook;
- /* Initialise the pTclInterp field. */
- pInterp->pTclInterp = interp;
+ /* This call puts the global object in the hash table with the other
+ * Tcl based objects. This is required so that references to 'window'
+ * actually return a pointer to SEE_interpreter.Global.
+ */
+ findOrCreateObject(pInterp, objv[1], 1);
+ interpTimeoutInit(pInterp, &pInterp->global);
+
+ /* Create the tcl command used to access this javascript interpreter. */
+ sprintf(zCmd, "::see::interp_%d", iSeeInterp++);
+ Tcl_CreateObjCommand(interp, zCmd, interpCmd, pInterp, delInterpCmd);
+ Tcl_SetResult(interp, zCmd, TCL_VOLATILE);
#ifndef NDEBUG
if (1) {
@@ -1896,8 +2073,6 @@ tclSeeInterp(clientData, interp, objc, objv)
}
#endif
- Tcl_CreateObjCommand(interp, zCmd, interpCmd, pInterp, delInterpCmd);
- Tcl_SetResult(interp, zCmd, TCL_VOLATILE);
return TCL_OK;
}
@@ -1960,7 +2135,7 @@ tclCallOrConstruct(zMethod, pInterp, pObj, pThis, argc, argv, pRes)
struct SEE_object *pThis;
int argc;
struct SEE_value **argv;
- struct SEE_string *pRes;
+ struct SEE_value *pRes;
{
SeeTclObject *p = (SeeTclObject *)pObj;
SeeInterp *pTclSeeInterp = (SeeInterp *)pInterp;
@@ -2025,16 +2200,20 @@ SeeTcl_Get(pInterp, pObj, pProp, pRes)
*
* eval $obj Get $property
*/
- rc = callSeeTclMethod(pTclInterp, pTclSeeInterp->pLog, p, "Get", pProp, 0);
- throwTclError(pInterp, rc);
- pScriptRes = Tcl_GetObjResult(pTclInterp);
- Tcl_IncrRefCount(pScriptRes);
- rc = objToValue(pTclSeeInterp, pScriptRes, pRes, &isCacheable);
- Tcl_DecrRefCount(pScriptRes);
- throwTclError(pInterp, rc);
-
- if (isCacheable) {
- SEE_native_put(pInterp, pNative, pProp, pRes, SEE_ATTR_INTERNAL);
+ if (!p->pClass || Tcl_FindHashEntry(&p->pClass->aProperty, (char *)pProp)) {
+ rc = callSeeTclMethod(pTclInterp, pTclSeeInterp->pLog, p,"Get",pProp,0);
+ throwTclError(pInterp, rc);
+ pScriptRes = Tcl_GetObjResult(pTclInterp);
+ Tcl_IncrRefCount(pScriptRes);
+ rc = objToValue(pTclSeeInterp, pScriptRes, pRes, &isCacheable);
+ Tcl_DecrRefCount(pScriptRes);
+ throwTclError(pInterp, rc);
+
+ if (isCacheable) {
+ SEE_native_put(pInterp, pNative, pProp, pRes, SEE_ATTR_INTERNAL);
+ }
+ } else {
+ SEE_SET_UNDEFINED(pRes);
}
}
@@ -2057,6 +2236,7 @@ SeeTcl_Put(pInterp, pObj, pProp, pValue, flags)
Tcl_Obj *pVal;
int nObj = 0;
+ pProp = SEE_intern(pInterp, pProp);
isNative = SEE_OBJECT_HASPROPERTY(pInterp, pNative, pProp);
if (!isNative) {
@@ -2105,18 +2285,23 @@ SeeTcl_HasProperty(pInterp, pObj, pProp)
struct SEE_object *pObj;
struct SEE_string *pProp;
{
- SeeTclObject *pObject = (SeeTclObject *)pObj;
+ SeeTclObject *p = (SeeTclObject *)pObj;
SeeInterp *pTclSeeInterp = (SeeInterp *)pInterp;
int rc;
int ret = 0;
- struct SEE_object *pNative = (struct SEE_object *)pObject->pNative;
+ struct SEE_object *pNative = (struct SEE_object *)p->pNative;
+
+ if (p == &pTclSeeInterp->global) return 1;
/* First check if the property is stored in the native hash table. */
+ pProp = SEE_intern(pInterp, pProp);
ret = SEE_OBJECT_HASPROPERTY(pInterp, pNative, pProp);
- if (!ret) {
+ if (!ret && (
+ !p->pClass || Tcl_FindHashEntry(&p->pClass->aProperty, (char *)pProp)
+ )) {
Tcl_Interp *pTcl = pTclSeeInterp->pTclInterp;
- rc = callSeeTclMethod(pTcl, 0, pObject, "HasProperty", pProp, 0);
+ rc = callSeeTclMethod(pTcl, 0, p, "HasProperty", pProp, 0);
throwTclError(pInterp, rc);
rc = Tcl_GetBooleanFromObj(pTcl, Tcl_GetObjResult(pTcl), &ret);
throwTclError(pInterp, rc);
@@ -2180,7 +2365,7 @@ SeeTcl_Construct(pInterp, pObj, pThis, argc, argv, pRes)
struct SEE_object *pThis;
int argc;
struct SEE_value **argv;
- struct SEE_string *pRes;
+ struct SEE_value *pRes;
{
tclCallOrConstruct("Construct", pInterp, pObj, pThis, argc, argv, pRes);
}
@@ -2191,7 +2376,7 @@ SeeTcl_Call(pInterp, pObj, pThis, argc, argv, pRes)
struct SEE_object *pThis;
int argc;
struct SEE_value **argv;
- struct SEE_string *pRes;
+ struct SEE_value *pRes;
{
tclCallOrConstruct("Call", pInterp, pObj, pThis, argc, argv, pRes);
}
@@ -2365,6 +2550,84 @@ tclSeeCollect(clientData, interp, objc, objv)
return TCL_OK;
}
+static int
+classCall(clientData, interp, objc, objv)
+ ClientData clientData; /* Pointer to class object */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings. */
+{
+ return TCL_OK;
+}
+static void
+classDelete(clientData)
+ ClientData clientData; /* Pointer to class object */
+{
+ SeeTclClass *p = (SeeTclClass *)clientData;
+ Tcl_DeleteHashTable(&p->aProperty);
+ ckfree((char *)p);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * tclSeeClass --
+ *
+ * Implementation of [::see::class].
+ *
+ * ::see::class CLASS-NAME PROPERTY-LIST
+ *
+ * Results:
+ * TCL_OK or TCL_ERROR.
+ *
+ * Side effects:
+ * See above.
+ *
+ *---------------------------------------------------------------------------
+ */
+static int
+tclSeeClass(clientData, interp, objc, objv)
+ ClientData clientData; /* Unused */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings. */
+{
+ SeeTclClass *p;
+ Tcl_Obj **apObj;
+ int nObj;
+
+ int ii;
+ char zBuf[256];
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "CLASS-NAME PROPERTY-LIST");
+ return TCL_ERROR;
+ }
+
+ if (iSeeInterp > 0) {
+ Tcl_AppendResult(
+ interp, "::see::class cannot be called after ::see::interp", 0);
+ return TCL_ERROR;
+ }
+
+ p = (SeeTclClass *)ckalloc(sizeof(SeeTclClass));
+ memset(p, 0, sizeof(SeeTclClass));
+ Tcl_InitHashTable(&p->aProperty, TCL_ONE_WORD_KEYS);
+
+ if (Tcl_ListObjGetElements(interp, objv[2], &nObj, &apObj)) {
+ return TCL_ERROR;
+ }
+ for (ii = 0; ii < nObj; ii++) {
+ int isNew;
+ struct SEE_string *str = SEE_intern_global(Tcl_GetString(apObj[ii]));
+ Tcl_CreateHashEntry(&p->aProperty, (char *)str, &isNew);
+ }
+ sprintf(zBuf, "%s.class", Tcl_GetString(objv[1]));
+
+ Tcl_CreateObjCommand(interp, zBuf, classCall, (char *)p, classDelete);
+ return TCL_OK;
+}
+
int
Tclsee_Init(interp)
Tcl_Interp *interp;
@@ -2376,11 +2639,16 @@ Tclsee_Init(interp)
}
#endif
+#ifndef NO_HAVE_GC
+ GC_init();
+#endif
+
Tcl_PkgProvide(interp, "Tclsee", "0.1");
Tcl_CreateObjCommand(interp, "::see::interp", tclSeeInterp, 0, 0);
Tcl_CreateObjCommand(interp, "::see::alloc", tclSeeAlloc, 0, 0);
Tcl_CreateObjCommand(interp, "::see::format", tclSeeFormat, 0, 0);
Tcl_CreateObjCommand(interp, "::see::gc", tclSeeCollect, 0, 0);
+ Tcl_CreateObjCommand(interp, "::see::class", tclSeeClass, 0, 0);
return TCL_OK;
}
diff --git a/hv/hvinit.c b/hv/hvinit.c
new file mode 100644
index 0000000..2b8e478
--- /dev/null
+++ b/hv/hvinit.c
@@ -0,0 +1,7 @@
+#include <tcl.h>
+#include "hv.h"
+
+int Et_AppInit(Tcl_Interp *interp){
+ extern int Tkhtml_Init(Tcl_Interp*);
+ return Tkhtml_Init(interp);
+}
diff --git a/hv/nogif.fig b/hv/nogif.fig
new file mode 100644
index 0000000..02f1541
--- /dev/null
+++ b/hv/nogif.fig
@@ -0,0 +1,21 @@
+#FIG 3.2
+Landscape
+Center
+Inches
+Letter
+100.00
+Single
+-2
+1200 2
+2 2 0 1 15 17 100 0 20 0.000 0 0 -1 0 0 5
+ 2400 1800 2925 1800 2925 2325 2400 2325 2400 1800
+2 1 0 5 4 7 100 0 -1 0.000 0 1 -1 0 0 2
+ 2475 1875 2850 2250
+2 1 0 5 4 7 100 0 -1 0.000 0 1 -1 0 0 2
+ 2475 2250 2850 1875
+2 2 0 1 15 17 100 0 20 0.000 0 1 -1 0 0 5
+ 3675 2100 3900 2100 3900 2325 3675 2325 3675 2100
+2 1 0 3 4 7 100 0 -1 0.000 0 1 -1 0 0 2
+ 3717 2141 3856 2284
+2 1 0 3 4 7 100 0 -1 0.000 0 1 -1 0 0 2
+ 3714 2287 3856 2137
diff --git a/hv/nogif.gif b/hv/nogif.gif
new file mode 100644
index 0000000..676ea72
Binary files /dev/null and b/hv/nogif.gif differ
diff --git a/hv/nogifsm.gif b/hv/nogifsm.gif
new file mode 100644
index 0000000..adf6378
Binary files /dev/null and b/hv/nogifsm.gif differ
diff --git a/hv/ss.tcl b/hv/ss.tcl
new file mode 100644
index 0000000..42ab8ad
--- /dev/null
+++ b/hv/ss.tcl
@@ -0,0 +1,425 @@
+# @(#) $Id: ss.tcl,v 1.12 2002/09/22 16:55:45 peter Exp $
+#
+# This script implements the "ss" application. "ss" implements
+# a presentation slide-show based on HTML slides.
+#
+wm title . {Tk Slide Show}
+wm iconname . {SlideShow}
+
+package require Tkhtml
+
+# Attempt to load the HTML widget if it isn't already part
+# of the interpreter
+#
+if {[info command html]==""} {
+ foreach f {
+ ./tkhtml.so
+ /usr/lib/tkhtml.so
+ /usr/local/lib/tkhtml.so
+ ./tkhtml.dll
+ } {
+ if {[file exists $f]} {
+ if {[catch {load $f Tkhtml}]==0} break
+ }
+ }
+}
+
+# Pick the initial filename from the command line
+#
+set HtmlTraceMask 0
+set file {}
+foreach a $argv {
+ if {[regexp {^debug=} $a]} {
+ scan $a "debug=0x%x" HtmlTraceMask
+ } else {
+ set file $a
+ }
+}
+
+# These are images to use with the actual image specified in a
+# "<img>" markup can't be found.
+#
+image create photo biggray -data {
+ R0lGODdhPAA+APAAALi4uAAAACwAAAAAPAA+AAACQISPqcvtD6OctNqLs968+w+G4kiW5omm
+ 6sq27gvH8kzX9o3n+s73/g8MCofEovGITCqXzKbzCY1Kp9Sq9YrNFgsAO///
+}
+image create photo smgray -data {
+ R0lGODdhOAAYAPAAALi4uAAAACwAAAAAOAAYAAACI4SPqcvtD6OctNqLs968+w+G4kiW5omm
+ 6sq27gvH8kzX9m0VADv/
+}
+
+# Build the half-size view of the page
+#
+frame .mbar -bd 2 -relief raised
+pack .mbar -side top -fill x
+menubutton .mbar.help -text File -underline 0 -menu .mbar.help.m
+pack .mbar.help -side left -padx 5
+set m [menu .mbar.help.m]
+$m add command -label Open -underline 0 -command Load
+$m add command -label {Full Screen} -underline 0 -command FullScreen
+$m add command -label Refresh -underline 0 -command Refresh
+$m add separator
+$m add command -label Exit -underline 1 -command exit
+
+frame .h
+pack .h -side top -fill both -expand 1
+html .h.h \
+ -width 512 -height 384 \
+ -yscrollcommand {.h.vsb set} \
+ -xscrollcommand {.f2.hsb set} \
+ -padx 5 \
+ -pady 9 \
+ -formcommand FormCmd \
+ -imagecommand "ImageCmd 1" \
+ -scriptcommand ScriptCmd \
+ -appletcommand AppletCmd \
+ -hyperlinkcommand HyperCmd \
+ -fontcommand pickFont \
+ -appletcommand {runApplet small} \
+ -bg white -tablerelief raised
+.h.h token handler meta "Meta .h.h"
+
+if {$HtmlTraceMask} {
+ .h.h config -tablerelief flat
+}
+
+# This routine is called to pick fonts for the half-size window.
+#
+proc pickFont {size attrs} {
+ # puts "FontCmd: $size $attrs"
+ set a [expr {-1<[lsearch $attrs fixed]?{courier}:{charter}}]
+ set b [expr {-1<[lsearch $attrs italic]?{italic}:{roman}}]
+ set c [expr {-1<[lsearch $attrs bold]?{bold}:{normal}}]
+ set d [expr {int(12*pow(1.2,$size-4))}]
+ list $a $d $b $c
+}
+
+# This routine is called to pick fonts for the fullscreen view.
+#
+set baseFontSize 24
+proc pickFontFS {size attrs} {
+ # puts "FontCmd: $size $attrs"
+ set a [expr {-1<[lsearch $attrs fixed]?{courier}:{charter}}]
+ set b [expr {-1<[lsearch $attrs italic]?{italic}:{roman}}]
+ set c [expr {-1<[lsearch $attrs bold]?{bold}:{normal}}]
+ global baseFontSize
+ set d [expr {int($baseFontSize*pow(1.2,$size-4))}]
+ list $a $d $b $c
+}
+
+proc HyperCmd {args} {
+ puts "HyperlinkCommand: $args"
+}
+
+# This routine is called to run an applet
+#
+proc runApplet {size w arglist} {
+ global AppletArg
+ catch {unset AppletArg}
+ foreach {name value} $arglist {
+ set AppletArg([string tolower $name]) $value
+ }
+ if {![info exists AppletArg(src)]} return
+ set src [.h.h resolve $AppletArg(src)]
+ set AppletArg(window) $w
+ set AppletArg(fontsize) $size
+ if {[catch {uplevel #0 "source $src"} msg]} {
+ puts "Applet error: $msg"
+ }
+}
+
+proc FormCmd {n cmd args} {
+ # puts "FormCmd: $n $cmd $args"
+ # switch $cmd {
+ # select -
+ # textarea -
+ # input {
+ # set w [lindex $args 0]
+ # label $w -image smgray
+ # }
+ # }
+}
+proc ImageCmd {hs args} {
+ global OldImages Images
+ set fn [lindex $args 0]
+ if {[info exists OldImages($fn)]} {
+ set Images($fn) $OldImages($fn)
+ unset OldImages($fn)
+ return $Images($fn)
+ }
+ if {[catch {image create photo -file $fn} img]} {
+ if {$hs} {
+ return smallgray
+ } else {
+ return biggray
+ }
+ }
+ if {$hs} {
+ set img2 [image create photo]
+ $img2 copy $img -subsample 2 2
+ image delete $img
+ set img $img2
+ }
+ if {[image width $img]*[image height $img]>20000} {
+ global BigImages
+ set b [image create photo -width [image width $img] \
+ -height [image height $img]]
+ set BigImages($b) $img
+ set img $b
+ after idle "MoveBigImage $b"
+ }
+ set Images($fn) $img
+ return $img
+}
+proc MoveBigImage b {
+ global BigImages
+ if {![info exists BigImages($b)]} return
+ $b copy $BigImages($b)
+ image delete $BigImages($b)
+ unset BigImages($b)
+}
+
+proc ScriptCmd {args} {
+ # puts "ScriptCmd: $args"
+}
+proc AppletCmd {w arglist} {
+ # puts "AppletCmd: w=$w arglist=$arglist"
+ # label $w -text "The Applet $w" -bd 2 -relief raised
+}
+
+# This binding fires when there is a click on a hyperlink
+#
+proc HrefBinding {w x y} {
+ set new [$w href $x $y]
+ # puts "link to [list $new]";
+ if {$new!=""} {
+ ProcessUrl $new
+ }
+}
+bind HtmlClip <1> {KeyPress %W Down}
+bind HtmlClip <3> {KeyPress %W Up}
+bind HtmlClip <2> {KeyPress %w Down}
+
+# Clicking button three on the small screen causes the full-screen view
+# to appear.
+#
+# bind .h.h.x <3> FullScreen
+
+# Handle all keypress events on the screen
+#
+bind HtmlClip <KeyPress> {KeyPress %W %K}
+proc KeyPress {w keysym} {
+ global hotkey key_block
+ if {[info exists key_block]} return
+ set key_block 1
+ after 250 {catch {unset key_block}}
+ if {[info exists hotkey($keysym)]} {
+ ProcessUrl $hotkey($keysym)
+ }
+ switch -- $keysym {
+ Escape {
+ if {[winfo exists .fs]} {FullScreenOff} {FullScreen}
+ }
+ }
+}
+
+
+# Finish building the half-size screen
+#
+pack .h.h -side left -fill both -expand 1
+scrollbar .h.vsb -orient vertical -command {.h.h yview}
+pack .h.vsb -side left -fill y
+
+frame .f2
+pack .f2 -side top -fill x
+frame .f2.sp -width [winfo reqwidth .h.vsb] -bd 2 -relief raised
+pack .f2.sp -side right -fill y
+scrollbar .f2.hsb -orient horizontal -command {.h.h xview}
+pack .f2.hsb -side top -fill x
+
+#proc FontCmd {args} {
+# puts "FontCmd: $args"
+# return {Times 12}
+#}
+#proc ResolverCmd {args} {
+# puts "Resolver: $args"
+# return [lindex $args 0]
+#}
+
+set lastDir [pwd]
+proc Load {} {
+ set filetypes {
+ {{Html Files} {.html .htm}}
+ {{All Files} *}
+ }
+ global lastDir htmltext
+ set f [tk_getOpenFile -initialdir $lastDir -filetypes $filetypes]
+ if {$f!=""} {
+ LoadFile $f
+ set lastDir [file dirname $f]
+ }
+}
+
+# Clear the screen.
+#
+proc Clear {} {
+ global Images OldImages hotkey
+ if {[winfo exists .fs.h]} {set w .fs.h} {set w .h.h}
+ $w clear
+ catch {unset hotkey}
+ ClearBigImages
+ ClearOldImages
+ foreach fn [array names Images] {
+ set OldImages($fn) $Images($fn)
+ }
+ catch {unset Images}
+}
+proc ClearOldImages {} {
+ global OldImages
+ foreach fn [array names OldImages] {
+ image delete $OldImages($fn)
+ }
+ catch {unset OldImages}
+}
+proc ClearBigImages {} {
+ global BigImages
+ foreach b [array names BigImages] {
+ image delete $BigImages($b)
+ }
+ catch {unset BigImages}
+}
+
+# Read a file
+#
+proc ReadFile {name} {
+ if {[catch {open $name r} fp]} {
+ tk_messageBox -icon error -message $fp -type ok
+ return {}
+ } else {
+ set r [read $fp [file size $name]]
+ close $fp
+ return $r
+ }
+}
+
+# Process the given URL
+#
+proc ProcessUrl {url} {
+ switch -glob -- $url {
+ file:* {
+ LoadFile [string range $url 5 end]
+ }
+ exec:* {
+ regsub -all \\+ [string range $url 5 end] { } url
+ eval exec $url &
+ }
+ default {
+ LoadFile $url
+ }
+ }
+}
+
+# Load a file into the HTML widget
+#
+proc LoadFile {name} {
+ set html [ReadFile $name]
+ if {$html==""} return
+ Clear
+ global LastFile
+ set LastFile $name
+ if {[winfo exists .fs.h]} {set w .fs.h} {set w .h.h}
+ $w config -base $name -cursor watch
+ $w parse $html
+ $w config -cursor top_left_arrow
+ ClearOldImages
+}
+
+# Refresh the current file.
+#
+proc Refresh {} {
+ global LastFile
+ if {![info exists LastFile]} return
+ LoadFile $LastFile
+}
+
+# This routine is called whenever a "<meta>" markup is seen.
+#
+proc Meta {w tag alist} {
+ foreach {name value} $alist {
+ set v($name) $value
+ }
+ if {[info exists v(key)] && [info exists v(href)]} {
+ global hotkey
+ set hotkey($v(key)) [$w resolve $v(href)]
+ }
+ if {[info exists v(next)]} {
+ global hotkey
+ set hotkey(Down) $v(next)
+ }
+ if {[info exists v(prev)]} {
+ global hotkey
+ set hotkey(Up) $v(next)
+ }
+ if {[info exists v(other)]} {
+ global hotkey
+ set hotkey(o) $v(other)
+ }
+}
+
+# Go from full-screen mode back to window mode.
+#
+proc FullScreenOff {} {
+ destroy .fs
+ wm deiconify .
+ update
+ raise .
+ focus .h.h.x
+ Clear
+ ClearOldImages
+ Refresh
+}
+
+# Go from window mode to full-screen mode.
+#
+proc FullScreen {} {
+ if {[winfo exists .fs]} {
+ wm deiconify .fs
+ update
+ raise .fs
+ return
+ }
+ toplevel .fs
+ wm overrideredirect .fs 1
+ set w [winfo screenwidth .]
+ set h [winfo screenheight .]
+ wm geometry .fs ${w}x$h+0+0
+ # bind .fs <3> FullScreenOff
+ html .fs.h \
+ -padx 5 \
+ -pady 9 \
+ -formcommand FormCmd \
+ -imagecommand "ImageCmd 0" \
+ -scriptcommand ScriptCmd \
+ -appletcommand AppletCmd \
+ -hyperlinkcommand HyperCmd \
+ -bg white -tablerelief raised \
+ -appletcommand {runApplet big} \
+ -fontcommand pickFontFS \
+ -cursor tcross
+ pack .fs.h -fill both -expand 1
+ .fs.h token handler meta "Meta .fs.h"
+ Clear
+ ClearOldImages
+ Refresh
+ update
+ focus .fs.h.x
+}
+focus .h.h.x
+
+# Load the file named on the command-line, if there is
+# one.
+#
+update
+if {$file!=""} {
+ LoadFile $file
+}
diff --git a/hv/ssinit.c b/hv/ssinit.c
new file mode 100644
index 0000000..bf3fae2
--- /dev/null
+++ b/hv/ssinit.c
@@ -0,0 +1,7 @@
+#include <tcl.h>
+#include "ss.h"
+
+int Et_AppInit(Tcl_Interp *interp){
+ extern int Tkhtml_Init(Tcl_Interp*);
+ return Tkhtml_Init(interp);
+}
diff --git a/linux-gcc.mk b/linux-gcc.mk
index 0d1fbd9..81290e9 100644
--- a/linux-gcc.mk
+++ b/linux-gcc.mk
@@ -33,9 +33,9 @@ STARKITRT = ~/bin/tclkit
#
JS_SHARED_LIB = libTclsee.so
-JSLIB = $(HOME)/javascript/install/lib/libgc.a
-JSLIB += $(HOME)/javascript/install/lib/libsee.a -lpthread
-JSFLAGS = -I$(HOME)/javascript/install/include
+JSLIB = $(HOME)/work/tkhtml/js/lib/libgc.a
+JSLIB += $(HOME)/work/tkhtml/js/lib/libsee.a -lpthread
+JSFLAGS = -I$(HOME)/work/tkhtml/js/include
#JSLIB = $(HOME)/javascript/install_nogc/lib/libsee.a
#JSFLAGS = -I$(HOME)/javascript/install_nogc/include -DNO_HAVE_GC
@@ -45,8 +45,9 @@ JSFLAGS = -I$(HOME)/javascript/install/include
# TCLLIB_DEBUG = -L$(TCL)/lib -ltcl$(TCLVERSION)g -ltk$(TCLVERSION)g
TCLLIB_RELEASE = -L$(TCL)/lib -ltcl$(TCLVERSION) -ltk$(TCLVERSION)
TCLLIB_DEBUG = -L$(TCL)/lib -ltcl$(TCLVERSION) -ltk$(TCLVERSION)
-#TCLLIB_PROFILE = -L$(TCL)/lib -ltcl$(TCLVERSION) -ltk$(TCLVERSION)
-TCLLIB_PROFILE = $(TCL)/lib/libtcl8.5.a $(TCL)/lib/libtk8.5.a -lXft -lXss
+
+TCLLIB_PROFILE = $(TCL_PROFILE)/lib/libtcl8.5.a $(TCL_PROFILE)/lib/libtk8.5.a
+TCLLIB_PROFILE += -lX11 -lXft -lXss
TCLLIB_MEMDEBUG = $(TCLLIB_DEBUG)
TCLLIB_MEMDEBUG += $(TCL)/lib/libtclstub$(TCLVERSION).a
@@ -65,7 +66,7 @@ BCC = $(CC_$(BUILD))
CFLAGS_RELEASE = -O2 -Wall -DNDEBUG -DHTML_MACROS -DTKHTML_ENABLE_PROFILE
CFLAGS_DEBUG = -g -Wall -DHTML_DEBUG -DTKHTML_ENABLE_PROFILE
-CFLAGS_PROFILE = -g -pg -Wall -DNDEBUG
+CFLAGS_PROFILE = -g -pg -Wall -DNDEBUG -DTKHTML_ENABLE_PROFILE
CFLAGS_MEMDEBUG = -g -Wall -DRES_DEBUG -DHTML_DEBUG -DTCL_MEM_DEBUG=1
CFLAGS = $(CFLAGS_$(BUILD))
diff --git a/linux-mingw.mk b/linux-mingw.mk
new file mode 100644
index 0000000..786a061
--- /dev/null
+++ b/linux-mingw.mk
@@ -0,0 +1,49 @@
+#!/usr/bin/make
+#
+#### The toplevel directory of the source tree.
+#
+SRCDIR = /home/drh/tkhtml/htmlwidget
+
+#### C Compiler and options for use in building executables that
+# will run on the platform that is doing the build.
+#
+BCC = gcc -g -O2
+
+#### Name of the generated static library file
+#
+LIBNAME = libtkhtml.a
+
+#### The suffix to add to executable files. ".exe" for windows.
+# Nothing for unix.
+#
+E =
+
+#### C Compile and options for use in building executables that
+# will run on the target platform. This is usually the same
+# as BCC, unless you are cross-compiling.
+#
+#TCC = gcc -O6
+#TCC = gcc -g -O0 -Wall
+#TCC = gcc -g -O0 -Wall -fprofile-arcs -ftest-coverage
+TCC = /opt/mingw/bin/i386-mingw32msvc-gcc -O6 -DSTATIC_BUILD=1
+
+#### Include file directories for Tcl and Tk.
+#
+INC = -I/home/drh/tcltk/8.4win
+
+#### Extra arguments for linking
+#
+LIBS =
+
+#### Command used to build a static library
+#
+AR = /opt/mingw/bin/i386-mingw32msvc-ar r
+RANLIB = /opt/mingw/bin/i386-mingw32msvc-ranlib
+
+#### The TCLSH command
+#
+TCLSH = tclsh
+
+# You should not need to change anything below this line
+###############################################################################
+include $(SRCDIR)/main.mk
diff --git a/listvers.sh b/listvers.sh
new file mode 100755
index 0000000..a1d55cc
--- /dev/null
+++ b/listvers.sh
@@ -0,0 +1,9 @@
+#! /bin/sh
+#
+# This script extracts version information from all the source files.
+# Run this script in the top-level directory of the source tree.
+#
+
+grep Revision: `find . -type f -print` |
+ sed -e 's,^./,,' -e 's,:[^ ]*, ,' |
+ awk '/[1-9]\.[1-9]/ { printf "%-20s %s\n",$1,$3 }'
diff --git a/main.mk b/main.mk
index 6af4376..08ca0a9 100644
--- a/main.mk
+++ b/main.mk
@@ -20,19 +20,18 @@ CFLAGS += -I$(TCL)/include -I. -I$(TOP)/src/
STUBSFLAGS = -DUSE_TCL_STUBS -DUSE_TK_STUBS
SRC = htmlparse.c htmldraw.c htmltcl.c htmlimage.c htmltree.c htmltagdb.c \
- cssparse.c css.c cssprop.c csssearch.c htmlstyle.c htmllayout.c \
+ css.c cssprop.c csssearch.c htmlstyle.c htmllayout.c \
htmlprop.c htmlfloat.c htmlhash.c swproc.c htmlinline.c \
htmltable.c restrack.c cssdynamic.c htmldecode.c htmltext.c \
- htmlutil.c
+ htmlutil.c cssparser.c
SRCHDR = $(TOP)/src/html.h $(TOP)/src/cssInt.h $(TOP)/src/css.h
-GENHDR = cssprop.h htmltokens.h cssparse.h
+GENHDR = cssprop.h htmltokens.h
HDR = $(GENHDR) $(SRCHDR)
OBJS = $(SRC:.c=.o)
-LEMON = lemon
BINARIES = $(SHARED_LIB) pkgIndex.tcl
# How to run the C compiler:
@@ -84,24 +83,14 @@ cssprop.c: cssprop.h
htmltokens.c: htmltokens.h
-$(LEMON): $(TOP)/tools/lemon.c
- @echo '$$(BCC) $< -o $@'
- @$(BCC) $(TOP)/tools/lemon.c -o $(LEMON)
-
-cssparse.c: $(TOP)/src/cssparse.lem $(LEMON)
- cp $(TOP)/src/cssparse.lem .
- cp $(TOP)/tools/lempar.c .
- @echo '$$(LEMON) cssparse.lem'
- @./$(LEMON) cssparse.lem
-
-cssparse.h: cssparse.c
-
# hwish: $(OBJS) $(TOP)/src/main.c
# $(CC) $(CFLAGS) $^ $(TCLLIB) -o $@
hwish: $(OBJS) $(TOP)/src/main.c
$(COMPILE) $^ $(TCLLIB) -o $@
+ENCODINGS = cp1251 cp1253 cp1254 cp1255 cp1255 cp1257 cp1258
+
hv3_img.vfs: binaries
mkdir -p ./hv3_img.vfs
mkdir -p ./hv3_img.vfs/lib
@@ -120,10 +109,12 @@ hv3_img.vfs: binaries
if test -d $(TCL)/lib/*tls*/ ; then \
cp -R $(TCL)/lib/*tls* ./hv3_img.vfs/lib ; \
fi
- # if test -d $(TCL)/lib/tcl8.5/encoding/ ; then \
- # mkdir ./hv3_img.vfs/lib/tcl8.5 ; \
- # cp -R $(TCL)/lib/tcl8.5/encoding ./hv3_img.vfs/lib/tcl8.5 ; \
- # fi
+ if test -d $(TCL)/lib/tcl8.5/encoding/ ; then \
+ mkdir -p ./hv3_img.vfs/lib/tcl8.5/encoding ; \
+ for a in $(ENCODINGS) ; do \
+ cp -R $(TCL)/lib/tcl8.5/encoding/$$a.enc ./hv3_img.vfs/lib/tcl8.5/encoding ; \
+ done \
+ fi
if test -d $(TCL)/lib/*sqlite3*/ ; then \
cp -R $(TCL)/lib/*sqlite3* ./hv3_img.vfs/lib ; \
fi
@@ -158,18 +149,17 @@ hv3_img.kit: hv3_img.vfs
hv3.kit: hv3.vfs
$(MKSTARKIT) hv3.kit
-website: hv3_img.kit
+website:
mkdir -p www
$(TCLSH) $(TOP)/webpage/mkwebpage.tcl > www/index.html
$(TCLSH) $(TOP)/webpage/mksupportpage.tcl > www/support.html
$(TCLSH) $(TOP)/webpage/mkhv3page.tcl > www/hv3.html
$(TCLSH) $(TOP)/webpage/mkffaqpage.tcl > www/ffaq.html
$(TCLSH) $(TOP)/doc/macros.tcl -html $(TOP)/doc/html.man > www/tkhtml.html
+ $(TCLSH) $(TOP)/doc/macros.tcl -html $(TOP)/doc/hv3.man > www/hv3_widget.html
$(TCLSH) $(TOP)/doc/tkhtml_requirements.tcl > www/requirements.html
cp $(TOP)/doc/tree.gif www/tree.gif
cp $(TOP)/webpage/tkhtml_tcl_tk.css www/tkhtml_tcl_tk.css
- cp hv3_img.kit www/
- chmod 644 www/hv3_img.kit
test: hwish
./hwish $(TOP)/tests/all.tcl
@@ -203,7 +193,7 @@ tclsee: tclsee.o
mv $(JS_SHARED_LIB) tclsee0.1
echo 'package ifneeded Tclsee 0.1 [list load [file join $$dir $(JS_SHARED_LIB)]]' > tclsee0.1/pkgIndex.tcl
-tclsee.o: $(TOP)/hv/hv3see.c $(TOP)/hv/hv3format.c $(TOP)/hv/hv3events.c $(TOP)/hv/hv3timeout.c $(TOP)/hv/hv3function.c
+tclsee.o: $(TOP)/hv/hv3see.c $(TOP)/hv/hv3format.c $(TOP)/hv/hv3events.c $(TOP)/hv/hv3timeout.c $(TOP)/hv/hv3bridge.c
@echo '$$(COMPILE) $(JSFLAGS) -c $(TOP)/hv/hv3see.c -o $@'
@$(COMPILE) $(JSFLAGS) -c $(TOP)/hv/hv3see.c -o $@
#
diff --git a/make_main_mk.tcl b/make_main_mk.tcl
new file mode 100644
index 0000000..4373866
--- /dev/null
+++ b/make_main_mk.tcl
@@ -0,0 +1,90 @@
+#!/usr/bin/tclsh
+#
+# Run this TCL script to generate the "main.mk" makefile.
+#
+
+# Basenames of all source files:
+#
+set src {
+ htmlcmd
+ htmldraw
+ htmlexts
+ htmlform
+ htmlimage
+ htmlindex
+ htmllayout
+ htmlparse
+ htmlPs
+ htmlPsImg
+ htmlsizer
+ htmltable
+ htmltcl
+ htmltest
+ htmlurl
+ htmlwidget
+}
+
+# Generated files
+#
+set gen {
+ htmltokens
+}
+
+puts {# This file is included by linux-gcc.mk or linux-mingw.mk or possible
+# some other makefiles. This file contains the rules that are common
+# to building regardless of the target.
+#
+
+XTCC = $(TCC) $(CFLAGS) $(INC) -I. -I$(SRCDIR)
+
+}
+puts -nonewline "SRC ="
+foreach s [lsort $src] {
+ puts -nonewline " \\\n \$(SRCDIR)/src/$s.c"
+}
+puts "\n"
+puts -nonewline "OBJ ="
+foreach s [lsort [concat $src $gen]] {
+ puts -nonewline " \\\n $s.o"
+}
+puts "\n"
+
+puts {
+all: $(LIBNAME)
+
+makeheaders: $(SRCDIR)/tools/makeheaders.c
+ $(BCC) -o makeheaders $(SRCDIR)/tools/makeheaders.c
+
+$(LIBNAME): headers $(OBJ)
+ $(AR) $(LIBNAME) $(OBJ)
+ $(RANLIB) $(LIBNAME)
+
+htmltokens.c: $(SRCDIR)/src/tokenlist.txt $(SRCDIR)/tools/maketokens.tcl
+ $(TCLSH) $(SRCDIR)/tools/maketokens.tcl \
+ $(SRCDIR)/src/tokenlist.txt >htmltokents.c
+
+headers: makeheaders htmltokens.c $(SRC)
+ ./makeheaders $(SRCDIR)/src/html.h htmltokens.c $(SRC)
+ touch headers
+
+srcdir: headers htmltokens.c
+ mkdir -p srcdir
+ rm -f srcdir/*
+ cp $(SRC) htmltokens.c *.h srcdir
+
+clean:
+ rm -f *.o $(LIBNAME)
+ rm -f makeheaders headers}
+
+set hfiles {}
+foreach s [lsort [concat $src $gen]] {lappend hfiles $s.h}
+puts "\trm -f $hfiles\n"
+
+foreach s [lsort $src] {
+ puts "$s.o:\t\$(SRCDIR)/src/${s}.c $s.h"
+ puts "\t\$(XTCC) -o $s.o -c \$(SRCDIR)/src/${s}.c\n"
+}
+foreach s [lsort $gen] {
+ puts "$s.o:\t${s}.c $s.h"
+ puts "\t\$(XTCC) -o $s.o -c ${s}.c\n"
+}
diff --git a/mingw.mk b/mingw.mk
index ffddfbf..6b0b46a 100644
--- a/mingw.mk
+++ b/mingw.mk
@@ -65,9 +65,9 @@ STARKITRT = /home/dan/work/tclkit-win32.upx.exe
#
JS_SHARED_LIB = libTclsee.dll
-JSLIB = $(HOME)/javascript/mingw/install/lib/libsee.a
-JSLIB += $(HOME)/javascript/mingw/install/lib/libgc.a
-JSFLAGS = -I$(HOME)/javascript/mingw/install/include
+JSLIB = $(HOME)/work/tkhtml/jswin/lib/libsee.a
+JSLIB += $(HOME)/work/tkhtml/jswin/lib/libgc.a
+JSFLAGS = -I$(HOME)/work/tkhtml/jswin/include
#
# End of configuration section.
diff --git a/mkdll.sh b/mkdll.sh
new file mode 100755
index 0000000..2043b62
--- /dev/null
+++ b/mkdll.sh
@@ -0,0 +1,47 @@
+#! /bin/sh
+#
+# This script builds "tkhtml.dll" for Win95/NT and Tcl/Tk8.1.1-stubs.
+# First do "make srcdir; cd srcdir". Then run this script.
+#
+# Notes:
+#
+# The tclstub.o and tkstub.o files were obtained by compiling the
+# tclStubLib.c and tkStubLib.c files from the Tk8.1.1 distribution
+# using cygwin/mingw. Do not use the tclstub81.lib and tkstub81.lib
+# files that come with Tcl/Tk from scripts. They won't work.
+#
+# $Revision: 1.10 $
+#
+
+LIBHOME=/u/pcmacdon/Tcl8.3/win32/lib
+TCLBASE=/u/pcmacdon/Tcl8.3/tcl8.3
+TKBASE=/u/pcmacdon/Tcl8.3/tk8.3
+TKLIB="$LIBHOME/tkStubLib.a"
+TCLLIB="$LIBHOME/tclStubLib.a"
+
+PATH=$PATH:/usr/local/cygb20/bin
+
+CC='i586-cygwin32-gcc -DUSE_TCL_STUBS=1 -DUSE_TK_STUBS -mno-cygwin -O2'
+INC="-I. -I$TCLBASE/generic -I$TKBASE/xlib -I$TKBASE/generic"
+
+CMD="rm *.o"
+echo $CMD
+#$CMD
+for i in *.c; do
+ CMD="$CC $INC -c $i"
+ echo $CMD
+ $CMD
+done
+echo 'EXPORTS' >tkhtml.def
+echo 'Tkhtml_Init' >>tkhtml.def
+#-lcomdlg32 -luser32 -ladvapi32 -lgdi32.
+
+CMD="i586-cygwin32-dllwrap \
+ --def tkhtml.def -v --export-all \
+ --driver-name i586-cygwin32-gcc \
+ --dlltool-name i586-cygwin32-dlltool \
+ --as i586-cygwin32-as \
+ --target i386-mingw32 -mno-cygwin \
+ -dllname tkhtml.dll *.o $TKLIB $TCLLIB -luser32"
+echo $CMD
+$CMD
diff --git a/mkso.sh b/mkso.sh
new file mode 100755
index 0000000..0db34ee
--- /dev/null
+++ b/mkso.sh
@@ -0,0 +1,42 @@
+#! /bin/sh
+#
+# This script builds "libtkhtml.so" for Linux and Tcl/Tk8.3.3-stubs.
+# First do "make srcdir; cd srcdir; ../tkhtml/configure; make headers"
+# Then run this script.
+#
+# $Revision: 1.8 $
+#
+
+SVER=8.3
+VER=8.3.2
+
+TCLBASE=../tcl$VER
+TKBASE=../tk$VER
+TKHTML=../tkhtml
+TKLIB="/usr/lib/libtkstub$SVER.a -L/usr/X11R6/lib -lX11"
+TCLLIB="/usr/lib/libtclstub$SVER.a -lm -ldl"
+
+CC='gcc -g -fPIC -O2'
+STUBS='-DUSE_TCL_STUBS=1 -DUSE_TK_STUBS=1'
+INC="-I. -I$TCLBASE/generic -I$TKBASE/generic"
+
+CMD="rm *.o"
+echo $CMD
+$CMD
+for i in $TKHTML/src/html[a-z]*.c htmltokens.c; do
+ if [ `basename $i` != htmlwish.c ]; then
+ CMD="$CC $STUBS $INC -c $i"
+ echo $CMD
+ $CMD
+ fi
+done
+CMD="gcc -g -o tkhtml.so -shared *.o $TKLIB $TCLLIB"
+echo $CMD
+$CMD
+
+CMD="$CC $INC -c $TKHTML/src/htmlPs.c"
+echo $CMD
+$CMD
+CMD="gcc -g -o tkhtmlpr.so -shared htmlPs.o $TKLIB $TCLLIB"
+echo $CMD
+$CMD
diff --git a/nightly.sh b/nightly.sh
index c3bf69e..fd86326 100644
--- a/nightly.sh
+++ b/nightly.sh
@@ -1,6 +1,6 @@
-#export VERSION=nightly-`date +"%y_%m%d"`
-export VERSION=alpha-16
+export VERSION=nightly-`date +"%y_%m%d"`
+#export VERSION=alpha-16
HERE=`pwd`
diff --git a/puppy.sh b/puppy.sh
index 991b916..220f4b5 100644
--- a/puppy.sh
+++ b/puppy.sh
@@ -2,7 +2,7 @@
# Script to build puppy linux package.
#
-if test "${VERSION}" = "" ; then VERSION=15 ; fi
+if test "${VERSION}" = "" ; then VERSION=16 ; fi
if test "${BUILD}" = "" ; then BUILD=/home/dan/work/tkhtml/bld ; fi
if test "${SRC}" = "" ; then SRC=/home/dan/work/tkhtml/htmlwidget ; fi
diff --git a/src/css.c b/src/css.c
index 7898aee..0f65246 100644
--- a/src/css.c
+++ b/src/css.c
@@ -29,7 +29,7 @@
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
* POSSIBILITY OF SUCH DAMAGE.
*/
-static const char rcsid[] = "$Id: css.c,v 1.125 2007/10/03 17:46:37 danielk1977 Exp $";
+static const char rcsid[] = "$Id: css.c,v 1.139 2007/12/16 11:57:43 danielk1977 Exp $";
#define LOG if (pTree->options.logcmd)
@@ -73,7 +73,6 @@ static const char rcsid[] = "$Id: css.c,v 1.125 2007/10/03 17:46:37 danielk1977
#include <errno.h>
#include <ctype.h>
-#include "css.h"
#include "cssInt.h"
#include "html.h"
@@ -82,18 +81,8 @@ static const char rcsid[] = "$Id: css.c,v 1.125 2007/10/03 17:46:37 danielk1977
* output on stdout.
*/
#define TRACE_PARSER_CALLS 0
-#define TRACE_STYLE_APPLICATION 0
-#define TRACE_PROPERTY_PARSE 0
-/* Declarations for the parser functions generated by lemon. These are used
- * by HtmlCssParse() and HtmlCssInlineParse().
- */
-void *tkhtmlCssParserAlloc(void *(*)(size_t));
-void tkhtmlCssParser(void *, int, CssToken, CssParse*);
-void tkhtmlCssParserFree(void *, void (*)(void *));
-
-static int cssGetToken(CONST char *, int , int *);
-static int cssParse(HtmlTree*,int,CONST char*,int,int,Tcl_Obj*,Tcl_Obj*,Tcl_Obj*,CssStyleSheet**);
+static int cssParse(HtmlTree*,int,CONST char*,int,int,Tcl_Obj*,Tcl_Obj*,Tcl_Obj*,Tcl_Obj*,CssStyleSheet**);
/*
*---------------------------------------------------------------------------
@@ -188,7 +177,7 @@ static const char *constantToString(int c){
*
* dequote --
*
- * This function is used to dequote a CSS string value.
+ * This function is used to dequote a CSS string or identifier value.
*
* Argument z is a pointer to a buffer containing a possibly quoted,
* null-terminated string. If it is quoted, then this function overwrites
@@ -204,10 +193,12 @@ static const char *constantToString(int c){
*
*--------------------------------------------------------------------------
*/
-static void
+static int
dequote(z)
char *z;
{
+ int rc = 1;
+
static char hexvalue[128] = {
-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, /* 0x00-0x0F */
-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, /* 0x10-0x1F */
@@ -236,11 +227,12 @@ dequote(z)
n--;
}
- /* Figure out if the is a quote character (" or '). If there is one,
+ /* Figure out if there is a quote character (" or '). If there is one,
* strip it from the start of the string before proceeding.
*/
q = z[0];
if (q != '\'' && q != '"') {
+ rc = 0;
q = '\0';
}
if (n > 1 && z[n - 1] == q && z[n - 2] != '\\') {
@@ -253,7 +245,7 @@ dequote(z)
unsigned int ch = 0;
int ii;
o = z[i+1];
- for (ii = 0; isxdigit(o) && ii <= 6; ii++) {
+ for (ii = 0; isxdigit(o) && ii < 6; ii++) {
assert(hexvalue[o] >=0 && hexvalue[o] <= 15);
ch = (ch << 4) + hexvalue[o];
o = z[(++i)+1];
@@ -261,7 +253,17 @@ dequote(z)
if (ch > 0) {
int inc = Tcl_UniCharToUtf(ch, zOut);
zOut += inc;
+
+ /* Ignore a single white-space character after a
+ * hexadecimal escape.
+ */
+ if (isspace((unsigned char)(z[i + 1]))) i++;
}
+
+ /* Inside a string, if an escape character occurs just before
+ * a newline, ignore that newline.
+ */
+ if (ii == 0 && o == '\n') i++;
} else {
*zOut++ = o;
}
@@ -269,6 +271,7 @@ dequote(z)
*zOut = 0;
}
+ return rc;
/* printf("OUT: %s\n", z); */
}
@@ -349,8 +352,31 @@ static int tokenToReal(pToken, pLen, pVal)
return 0;
}
+/*
+ *---------------------------------------------------------------------------
+ *
+ * propertyIsLength --
+ *
+ * Return true if the property passed as the first argument is a length
+ * property. (i.e. pixels, em, percentage etc.)
+ *
+ * Usually, a number with no units is not considered a length. There
+ * are two exceptions:
+ *
+ * * When the number is 0, and
+ * * When quirks mode is enabled (in this case a number with no
+ * units is treated as a pixel quantity).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
static int
-propertyIsLength2(pParse, pProp)
+propertyIsLength(pParse, pProp)
CssParse *pParse;
CssProperty *pProp;
{
@@ -409,23 +435,68 @@ rgbToColor(zOut, zRgb, nRgb)
CONST char *z = zRgb;
CONST char *zEnd = zRgb+nRgb;
int n = 0;
+
int aN[3] = {0, 0, 0};
+ CssToken aToken[3];
+
+ int ii;
+ for (ii = 0; ii < 3; ii++){
+ aToken[ii].z = HtmlCssGetNextCommaListItem(z, zEnd - z, &aToken[ii].n);
+ z = &(aToken[ii].z[aToken[ii].n]);
+ }
+ if (!aToken[0].z || !aToken[1].z || !aToken[2].z ||
+ !aToken[0].n || !aToken[1].n || !aToken[2].n
+ ) {
+ goto bad_color;
+ }
- while (z < zEnd && n < 3) {
- while (!isdigit(*z) && *z!='.' && *z!='-' && *z!='+') z++;
- aN[n] = (int)strtod(z, (char **)&z);
- if (*z=='%') {
- aN[n] = ((aN[n] * 255) / 100);
+ if (aToken[0].z[aToken[0].n-1] == '%') {
+ for (ii = 0; ii < 3; ii++){
+ char *zEnd;
+ double percent;
+
+ if (aToken[ii].z[aToken[ii].n-1] != '%') {
+ goto bad_color;
+ }
+ percent = strtod(aToken[ii].z, &zEnd);
+ if ((zEnd - aToken[ii].z) != (aToken[ii].n-1)) {
+ goto bad_color;
+ }
+ aN[ii] = (percent * 255) / 100;
}
- aN[n] = MIN(aN[n], 255);
- aN[n] = MAX(aN[n], 0);
- n++;
+ } else {
+ for (ii = 0; ii < 3; ii++){
+ char *zEnd;
+ aN[ii] = strtol(aToken[ii].z, &zEnd, 0);
+ if ((zEnd - aToken[ii].z) != aToken[ii].n) {
+ goto bad_color;
+ }
+ }
+ }
+ for (ii = 0; ii < 3; ii++){
+ aN[ii] = MIN(MAX(aN[ii], 0), 255);
}
n = sprintf(zOut, "#%.2x%.2x%.2x", aN[0], aN[1], aN[2]);
assert(n==7);
+ return;
+
+ bad_color:
+ zOut[0] = '\0';
+ return;
}
+/*
+ *---------------------------------------------------------------------------
+ *
+ * doUrlCmd --
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *---------------------------------------------------------------------------
+ */
static int
doUrlCmd(pParse, zArg, nArg)
CssParse *pParse;
@@ -492,10 +563,12 @@ tokenToProperty(pParse, pToken)
int len;
char *zFunc;
} functions[] = {
- {CSS_TYPE_TCL, 3, "tcl"},
- {CSS_TYPE_URL, 3, "url"},
- {CSS_TYPE_ATTR, 4, "attr"},
- {-1, 3, "rgb"},
+ {CSS_TYPE_TCL, 3, "tcl"},
+ {CSS_TYPE_URL, 3, "url"},
+ {CSS_TYPE_ATTR, 4, "attr"},
+ {CSS_TYPE_COUNTER, 7, "counter"},
+ {CSS_TYPE_COUNTERS, 8, "counters"},
+ {-1, 3, "rgb"},
};
CssProperty *pProp = 0;
@@ -567,7 +640,7 @@ tokenToProperty(pParse, pToken)
*/
int nAlloc = sizeof(CssProperty) + 7 + 1;
pProp = (CssProperty *)HtmlAlloc("CssProperty", nAlloc);
- pProp->eType = CSS_TYPE_STRING;
+ pProp->eType = CSS_TYPE_RAW;
pProp->v.zVal = (char *)&pProp[1];
rgbToColor(pProp->v.zVal, zArg, nArg);
} else {
@@ -602,8 +675,8 @@ tokenToProperty(pParse, pToken)
/* Finally, treat the property as a generic string. v.zVal will point at
* a NULL-terminated copy of the string. The eType field is set to
- * either CSS_TYPE_STRING, or one of the symbols in cssprop.h (i.e.
- * CSS_TYPE_BLOCK).
+ * either CSS_TYPE_STRING, CSS_TYPE_RAW, or one of the symbols in
+ * cssprop.h (i.e. CSS_TYPE_BLOCK).
*/
if (!pProp) {
int eType;
@@ -613,11 +686,17 @@ tokenToProperty(pParse, pToken)
memcpy(pProp->v.zVal, z, n);
pProp->v.zVal[n] = '\0';
- eType = HtmlCssConstantLookup(-1, pProp->v.zVal);
- pProp->eType = eType > 0 ? eType : CSS_TYPE_STRING;
-
- if (pProp->eType == CSS_TYPE_STRING) {
+ if (z[0] == '"' || z[0] == '\'') {
+ dequote(pProp->v.zVal);
+ pProp->eType = CSS_TYPE_STRING;
+ } else {
dequote(pProp->v.zVal);
+ eType = HtmlCssConstantLookup(-1, pProp->v.zVal);
+ if (eType <= 0) {
+ pProp->eType = CSS_TYPE_RAW;
+ } else {
+ pProp->eType = eType;
+ }
}
}
return pProp;
@@ -698,7 +777,7 @@ HtmlCssPropertyGetString(pProp)
{
if (pProp) {
int eType = pProp->eType;
- if (eType == CSS_TYPE_STRING ||
+ if (eType == CSS_TYPE_STRING || eType == CSS_TYPE_RAW ||
(eType >= CSS_CONST_MIN_CONSTANT && eType <= CSS_CONST_MAX_CONSTANT)
) {
return pProp->v.zVal;
@@ -782,20 +861,24 @@ propertySetAdd(p, i, v)
int i; /* Property id (i.e CSS_PROPERTY_WIDTH). */
CssProperty *v; /* Value for property. */
{
- int j;
int nBytes;
assert( i<128 && i>=0 );
-
assert(!p->a || p->n > 0);
- for (j = 0; j < p->n; j++) {
- if (i == p->a[j].eProp) {
- HtmlFree(p->a[j].pProp);
- p->a[j].pProp = v;
- return;
- }
- }
+ /* Note: We used to avoid inserting duplicate properties into a
+ ** single property set. But that led to errors with CSS like:
+ **
+ ** <selector> {
+ ** padding: 3em;
+ ** padding: -3em;
+ ** }
+ **
+ ** The code in htmlprop.c needs to see both declarations, as the
+ ** second one is ignored because the value is illegal. TODO: It
+ ** would be better if we could verify the legality of the value
+ ** here.
+ */
nBytes = (p->n + 1) * sizeof(struct CssPropertySetItem);
p->a = (struct CssPropertySetItem *)HtmlRealloc(
@@ -806,6 +889,19 @@ propertySetAdd(p, i, v)
p->n++;
}
+
+static void
+propertyFree(CssProperty *p){
+ if (p && p->eType == CSS_TYPE_LIST) {
+ int ii;
+ CssProperty **apProp = (CssProperty **)p->v.p;
+ for (ii = 0; apProp[ii]; ii++) {
+ propertyFree(apProp[ii]);
+ }
+ }
+ HtmlFree(p);
+}
+
/*--------------------------------------------------------------------------
*
* propertySetFree --
@@ -825,7 +921,7 @@ propertySetFree(CssPropertySet *p){
int i;
if( !p ) return;
for (i = 0; i < p->n; i++) {
- HtmlFree(p->a[i].pProp);
+ propertyFree(p->a[i].pProp);
}
HtmlFree(p->a);
HtmlFree(p);
@@ -847,98 +943,18 @@ propertySetFree(CssPropertySet *p){
static CssProperty *propertyDup(pProp)
CssProperty *pProp;
{
- CssProperty *pRet = HtmlNew(CssProperty);
- memcpy(pRet, pProp, sizeof(CssProperty));
- return pRet;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * propertyIsLength --
- *
- * Return true if the property passed as the first argument is a length
- * property. (i.e. pixels, em, percentage etc.)
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-static int propertyIsLength(pProp)
- CssProperty *pProp;
-{
- return (
- pProp->eType==CSS_TYPE_EM ||
- pProp->eType==CSS_TYPE_PT ||
- pProp->eType==CSS_TYPE_PC ||
- pProp->eType==CSS_TYPE_EX ||
- pProp->eType==CSS_TYPE_PX ||
- pProp->eType==CSS_TYPE_PERCENT
- );
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * HtmlCssGetNextListItem --
- *
- * Return the first property from a space seperated list of properties.
- *
- * The property list is stored in string zList, length nList.
- *
- * A pointer to the first property is returned. The length of the first
- * property is stored in *pN.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-const char *
-HtmlCssGetNextListItem(zList, nList, pN)
- const char *zList;
- int nList;
- int *pN;
-{
- int n = 0;
- int t = CT_SPACE;
- const char *zRet = 0;
- const char *z = zList;
- const char *zEnd = zList+nList;
-
- while (z<zEnd && (t==CT_SPACE || t <= 0)) {
- t = cssGetToken(z, zEnd-z, &n);
- assert(n>0);
- if (t==CT_SPACE || t <= 0) {
- z += n;
- }
- }
- zRet = z;
- z += n;
-
- while (z<zEnd && t!=CT_SPACE && t > 0) {
- int n2 = 0;
- t = cssGetToken(z, zEnd-z, &n2);
- assert(n2>0);
- z += n2;
- if (t!=CT_SPACE && t > 0) {
- n += n2;
- }
- }
+ CssProperty *pRet;
+ const char *z = HtmlCssPropertyGetString(pProp);
+ int n = sizeof(CssProperty);
- if (zRet<zEnd && n>0) {
- assert(n<=nList);
- *pN = n;
- return zRet;
+ if (z) n += (strlen(z) + 1);
+ pRet = (CssProperty *)HtmlAlloc("CssProperty", n);
+ memcpy(pRet, pProp, sizeof(CssProperty));
+ if (z) {
+ pRet->v.zVal = (char *)(&pRet[1]);
+ strcpy(pRet->v.zVal, z);
}
- return 0;
+ return pRet;
}
/*
@@ -963,14 +979,19 @@ HtmlCssGetNextListItem(zList, nList, pN)
*
*---------------------------------------------------------------------------
*/
-static void propertySetAddShortcutBorder(p, prop, v)
+static void propertySetAddShortcutBorder(pParse, p, prop, v)
+ CssParse *pParse;
CssPropertySet *p; /* Property set. */
int prop;
CssToken *v; /* Value for property. */
{
CONST char *z = v->z;
CONST char *zEnd = z + v->n;
- int n;
+ int i;
+
+ CssProperty *pBorderColor = 0;
+ CssProperty *pBorderStyle = 0;
+ CssProperty *pBorderWidth = 0;
int aWidth[] = {
CSS_PROPERTY_BORDER_TOP_WIDTH,
@@ -1013,12 +1034,11 @@ static void propertySetAddShortcutBorder(p, prop, v)
}
while (z) {
+ int n;
z = HtmlCssGetNextListItem(z, zEnd-z, &n);
if (z) {
- int *aProp = 0;
CssToken token;
CssProperty *pProp;
- int i;
int eType;
token.z = z;
@@ -1026,8 +1046,14 @@ static void propertySetAddShortcutBorder(p, prop, v)
pProp = tokenToProperty(0, &token);
eType = pProp->eType;
- if (propertyIsLength(pProp) || eType==CSS_TYPE_FLOAT) {
- aProp = aWidth;
+ if (propertyIsLength(pParse, pProp) || eType == CSS_CONST_THIN ||
+ eType == CSS_CONST_THICK || eType == CSS_CONST_MEDIUM
+ ) {
+ if (pBorderWidth) {
+ HtmlFree(pProp);
+ goto parse_error;
+ }
+ pBorderWidth = pProp;
} else if (
eType == CSS_CONST_NONE || eType == CSS_CONST_HIDDEN ||
eType == CSS_CONST_DOTTED || eType == CSS_CONST_DASHED ||
@@ -1035,27 +1061,51 @@ static void propertySetAddShortcutBorder(p, prop, v)
eType == CSS_CONST_GROOVE || eType == CSS_CONST_RIDGE ||
eType == CSS_CONST_OUTSET || eType == CSS_CONST_INSET
) {
- aProp = aStyle;
- } else if (
- eType == CSS_CONST_THIN || eType == CSS_CONST_THICK ||
- eType == CSS_CONST_MEDIUM
- ) {
- aProp = aWidth;
+ if (pBorderStyle) {
+ HtmlFree(pProp);
+ goto parse_error;
+ }
+ pBorderStyle = pProp;
} else {
- aProp = aColor;
- }
-
- for (i = iOffset; i < iOffset+nProp; i++) {
- if (i != iOffset) {
- pProp = propertyDup(pProp);
+ if (pBorderColor) {
+ HtmlFree(pProp);
+ goto parse_error;
}
- propertySetAdd(p, aProp[i], pProp);
+ pBorderColor = pProp;
}
-
- assert(n>0);
z += n;
}
}
+
+ if (!pBorderColor) {
+ pBorderColor = HtmlCssStringToProperty("-tkhtml-no-color", -1);
+ }
+ if (!pBorderWidth) {
+ pBorderWidth = HtmlCssStringToProperty("medium", -1);
+ }
+ if (!pBorderStyle) {
+ pBorderStyle = HtmlCssStringToProperty("none", -1);
+ }
+
+ for (i = iOffset; i < iOffset+nProp; i++) {
+ CssProperty *pC = pBorderColor;
+ CssProperty *pW = pBorderWidth;
+ CssProperty *pS = pBorderStyle;
+ if (i != iOffset) {
+ pC = propertyDup(pC);
+ pW = propertyDup(pW);
+ pS = propertyDup(pS);
+ }
+ propertySetAdd(p, aColor[i], pC);
+ propertySetAdd(p, aWidth[i], pW);
+ propertySetAdd(p, aStyle[i], pS);
+ }
+ return;
+
+ parse_error:
+ HtmlFree(pBorderStyle);
+ HtmlFree(pBorderColor);
+ HtmlFree(pBorderWidth);
}
/*
@@ -1162,7 +1212,7 @@ shortcutBackground(pParse, p, v)
for (ii = 0; ii < nProp; ii++) {
CssProperty *pProp = apProp[ii];
- if (propertyIsLength(pProp) || pProp->eType==CSS_TYPE_FLOAT) {
+ if (propertyIsLength(pParse, pProp)) {
if (!pPositionX) pPositionX = pProp;
else if(!pPositionY) pPositionY = pProp;
else goto error_out;
@@ -1193,6 +1243,7 @@ shortcutBackground(pParse, p, v)
case CSS_CONST_RIGHT:
case CSS_CONST_LEFT:
case CSS_CONST_CENTER:
+ case CSS_TYPE_PERCENT:
if (!pPositionX) pPositionX = pProp;
else if(!pPositionY) pPositionY = pProp;
else goto error_out;
@@ -1219,11 +1270,15 @@ shortcutBackground(pParse, p, v)
/*
* From CSS2 description of the 'background-position' property:
*/
- if ((pPositionX && pPositionY && (
- pPositionX->eType == CSS_CONST_TOP ||
- pPositionX->eType == CSS_CONST_BOTTOM ||
- pPositionY->eType == CSS_CONST_RIGHT ||
- pPositionY->eType == CSS_CONST_LEFT))
+ if (
+ (pPositionX && (
+ pPositionX->eType == CSS_CONST_TOP ||
+ pPositionX->eType == CSS_CONST_BOTTOM
+ )) ||
+ (pPositionY && (
+ pPositionY->eType == CSS_CONST_RIGHT ||
+ pPositionY->eType == CSS_CONST_LEFT
+ ))
) {
CssProperty *pTmp = pPositionX;
pPositionX = pPositionY;
@@ -1322,6 +1377,7 @@ shortcutListStyle(pParse, p, v)
case CSS_TYPE_URL:
case CSS_TYPE_STRING:
+ case CSS_TYPE_RAW:
if (pImage) goto bad_parse;
pImage = pProp;
break;
@@ -1361,6 +1417,53 @@ bad_parse:
if (pType) HtmlFree(pType);
}
+static void
+propertySetAddList(pParse, eProp, p, v)
+ CssParse *pParse;
+ int eProp;
+ CssPropertySet *p; /* Property set */
+ CssToken *v; /* Value for 'content' property */
+{
+ CssProperty *pProp;
+ CssProperty **apProp;
+ int nAlloc;
+ int n;
+
+ int nElem = 0;
+ const char *z = v->z;
+ const char *zEnd = &z[v->n];
+
+ /* Count the elements in the list. */
+ z = HtmlCssGetNextListItem(z, zEnd-z, &n);
+ while (z) {
+ z = &z[n];
+ nElem++;
+ z = HtmlCssGetNextListItem(z, zEnd-z, &n);
+ }
+
+ nAlloc = sizeof(CssProperty) + (nElem + 1) * sizeof(CssProperty *);
+ pProp = (CssProperty *)HtmlAlloc("CssProperty", nAlloc);
+ pProp->v.p = &(pProp[1]);
+ pProp->eType = CSS_TYPE_LIST;
+ apProp = (CssProperty **)(pProp->v.p);
+ apProp[nElem] = 0;
+
+ z = HtmlCssGetNextListItem(v->z, zEnd - v->z, &n);
+ nElem = 0;
+ while (z) {
+ CssToken token;
+ token.z = z;
+ token.n = n;
+ apProp[nElem] = tokenToProperty(pParse, &token);
+ z = &z[n];
+ nElem++;
+ z = HtmlCssGetNextListItem(z, zEnd-z, &n);
+ }
+ assert(apProp[nElem] == 0);
+
+ propertySetAdd(p, eProp, pProp);
+}
+
/*
*---------------------------------------------------------------------------
*
@@ -1389,7 +1492,7 @@ getNextFontFamily(zList, nList, pzNext)
char *zRet;
while(
- (t = cssGetToken(&zList[nElem], nList-nElem, &nToken)) &&
+ (CT_EOF != (t = HtmlCssGetToken(&zList[nElem], nList-nElem, &nToken))) &&
(t != CT_COMMA)
){
nElem += nToken;
@@ -1407,6 +1510,17 @@ getNextFontFamily(zList, nList, pzNext)
return zRet;
}
+/*
+ *---------------------------------------------------------------------------
+ *
+ * textToFontFamilyProperty --
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *---------------------------------------------------------------------------
+ */
static CssProperty *
textToFontFamilyProperty(pParse, zText, nText)
CssParse *pParse; /* Parse context */
@@ -1559,7 +1673,9 @@ propertySetAddShortcutFont(pParse, p, v)
default: {
int hasLineHeight = 0;
- if (pProp->eType == CSS_TYPE_STRING) {
+ if (pProp->eType == CSS_TYPE_STRING ||
+ pProp->eType == CSS_TYPE_RAW
+ ) {
int j;
for (j = 0; j < n && z[j] != '/'; j++);
if (j == n) goto bad_parse;
@@ -1622,6 +1738,18 @@ bad_parse:
if (pLineHeight) HtmlFree(pLineHeight);
}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * tokenToPropertyList --
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *---------------------------------------------------------------------------
+ */
static int
tokenToPropertyList(pToken, apProp, nMax)
CssToken *pToken;
@@ -1694,7 +1822,7 @@ shortcutBackgroundPosition(pParse, p, v)
apProp[0]->eType == CSS_CONST_LEFT ||
apProp[0]->eType == CSS_CONST_RIGHT ||
apProp[0]->eType == CSS_CONST_CENTER ||
- propertyIsLength2(pParse, apProp[0])
+ propertyIsLength(pParse, apProp[0])
) {
apProp[1] = HtmlCssStringToProperty("50%", 3);
} else if (
@@ -1872,207 +2000,6 @@ static void selectorFree(pSelector)
/*
*---------------------------------------------------------------------------
*
- * cssGetToken --
- *
- * Return the id of the next CSS token in the string pointed to by z,
- * length n. The length of the token is written to *pLen. 0 is returned
- * if there are no complete tokens remaining.
- *
- * Results:
- * See above.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-static int
-cssGetToken(z, n, pLen)
- CONST char *z;
- int n;
- int *pLen;
-{
- if( n<=0 ){
- return 0;
- }
-
- *pLen = 1;
- switch( z[0] ){
- case ' ':
- case '\n':
- case '\t': {
- /* Collapse any contiguous whitespace to a single token */
- int i;
- for (i = 1; isspace((int)z[i]); i++);
- *pLen = i;
- return CT_SPACE;
- }
- case '{': return CT_LP;
- case '}': return CT_RP;
- case ')': return CT_RRP;
- case '[': return CT_LSP;
- case ']': return CT_RSP;
- case ';': return CT_SEMICOLON;
- case ',': return CT_COMMA;
- case ':': return CT_COLON;
- case '+': return CT_PLUS;
- case '>': return CT_GT;
- case '*': return CT_STAR;
- case '.': return CT_DOT;
- case '#': return CT_HASH;
- case '=': return CT_EQUALS;
- case '~': return CT_TILDE;
- case '|': return CT_PIPE;
- case '/': {
- int i;
- int c;
- if( z[1]!='*' || z[2]==0 ){
- return CT_SLASH;
- }
- /* C style comment. */
- for(i=3, c=z[2]; (c!='*' || z[i]!='/') && (c=z[i])!=0; i++){}
- if( c ) i++;
- *pLen = i;
- return -1;
- }
-
- case '"': case '\'': {
- char delim = z[0];
- char c;
- int i;
- for(i=1; i<n; i++){
- c = z[i];
- if( c=='\\' ){
- i++;
- }
- if( c==delim ){
- *pLen = i+1;
- return CT_STRING;
- }
- }
- *pLen = n;
- return -1;
- }
-
- case '@': {
- struct AtKeyWord {
- const char *z;
- int n;
- int t;
- } atkeywords[] = {
- {"import", 6, CT_IMPORT_SYM},
- {"page", 4, CT_PAGE_SYM},
- {"media", 5, CT_MEDIA_SYM},
- {"font-face", 9, CT_FONT_SYM},
- {"charset", 7, CT_CHARSET_SYM},
- };
- int i;
- for(i=0; i<sizeof(atkeywords)/sizeof(struct AtKeyWord); i++){
- if( 0==strnicmp(&z[1], atkeywords[i].z, atkeywords[i].n) ){
- *pLen = atkeywords[i].n + 1;
- return atkeywords[i].t;
- }
- }
- return CT_INVALID_AT_SYM;
- }
- case '!': {
- int a = 1;
- while (z[a] && isspace(z[a])) a++;
- if( 0==strnicmp(&z[a], "important", 9) ){
- *pLen = 9 + a;
- return CT_IMPORTANT_SYM;
- }
- goto bad_token;
- }
-
- case '<': {
- if (z[1] != '!' || z[2] != '-' || z[3] != '-') {
- goto parse_as_token;
- }
- *pLen = 4;
- return -1;
- }
- case '-': {
- if (z[1] != '-' || z[2] != '>') {
- goto parse_as_token;
- }
- *pLen = 3;
- return -1;
- }
-
-parse_as_token:
- default: {
-
- /* This must be either an identifier or a function. For the
- ** ASCII character range 0-127, the 'charmap' array is 1 for
- ** characters allowed in an identifier or function name, 0
- ** for characters not allowed. Allowed characters are a-z,
- ** 0-9, '-', '_', '%' and '\'. All unicode characters
- ** outside the ASCII range are allowed.
- */
- static u8 charmap[128] = {
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0x00-0x0F */
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0x10-0x1F */
- 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, /* 0x20-0x2F */
- 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, /* 0x30-0x3F */
- 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, /* 0x40-0x4F */
- 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 0, 0, 1, /* 0x50-0x5F */
- 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, /* 0x60-0x6F */
- 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0 /* 0x70-0x7F */
- };
- int i;
-
- /* Weed out HTML comment symbols: <!-- and --> */
- if (n >= 4 && 0 == strncmp("<!--", z, 4)) {
- *pLen = 4;
- return -1;
- }
- if (n >= 3 && 0 == strncmp("-->", z, 3)) {
- *pLen = 3;
- return -1;
- }
-
- for(i=0; i<n && (z[i]<0 || charmap[(int)z[i]]); i++){
- if (z[i] == '\\' && z[i + 1]) i++;
- }
-
- if( i==0 ) goto bad_token;
- if( i<n && z[i]=='(' ){
- int t = -1;
- int tlen;
- i++;
- while( i!=n && t!=0 && t!=CT_RRP ){
- t = cssGetToken(&z[i], n-i, &tlen);
- i += tlen;
- }
- if( t!=CT_RRP ) goto bad_token;
- *pLen = i;
- return CT_FUNCTION;
- }
- *pLen = i;
- return CT_IDENT;
- }
- }
-
-bad_token:
- *pLen = 1;
- return CT_UNKNOWN_SYM;
-}
-
-/* Versions of HtmlAlloc(0, ) and HtmlFree(0, ) that are always
- * functions (not macros).
- */
-static void * xCkalloc(size_t n){
- return HtmlAlloc("xCkalloc (css.c)", n);
-}
-static void xCkfree(void *p){
- HtmlFree(p);
-}
-
-
-/*
- *---------------------------------------------------------------------------
- *
* comparePriority --
*
* Compare stylesheet priorities *pLeft and *pRight, returning less
@@ -2119,268 +2046,84 @@ comparePriority(pLeft, pRight)
CONST char *zRight = Tcl_GetString(pRight->pIdTail);
return strcmp(zLeft, zRight);
}
- for (i = 0; i < 3; i++) {
- if (pLeft->origin == a[i]) return 1;
- if (pRight->origin == a[i]) return -1;
- }
- assert(!"Impossible");
- }
-
- /* One 'important' flag is set and the other cleared. The highest
- * priority is therefore the one with the 'important' flag set.
- */
- return pLeft->important ? 1 : -1;
-}
-#endif
-
-/*
- *---------------------------------------------------------------------------
- *
- * newCssPriority --
- *
- * Add a new entry to the CssStyleSheet.pPriority list with values
- * origin, pIdTail and important. Update the CssPriority.iPriority
- * variable for all list members that require it.
- *
- * See comments above CssPriority struct in cssInt.h for details.
- *
- * The pointer to pIdList is copied and the reference count increased
- * by one. It is decreased when the new list entry is deleted (along
- * with the rest of the stylesheet).
- *
- * Results:
- * Pointer to new list entry.
- *
- * Side effects:
- * Modifies linked-list pStyle->pPriority.
- *
- *---------------------------------------------------------------------------
- */
-static CssPriority *
-newCssPriority(pStyle, origin, pIdTail, important)
- CssStyleSheet *pStyle;
- int origin;
- Tcl_Obj *pIdTail;
- int important;
-{
- CssPriority *pNew; /* New list entry */
-
- pNew = HtmlNew(CssPriority);
- pNew->origin = origin;
- pNew->important = important;
- pNew->pIdTail = pIdTail;
- Tcl_IncrRefCount(pIdTail);
-
- switch (origin) {
- case CSS_ORIGIN_AGENT:
- pNew->iPriority = 1;
- break;
- case CSS_ORIGIN_USER:
- if (important) {
- pNew->iPriority = 5;
- } else {
- pNew->iPriority = 2;
- }
- break;
- case CSS_ORIGIN_AUTHOR:
- if (important) {
- pNew->iPriority = 4;
- } else {
- pNew->iPriority = 3;
- }
- break;
- default:
- assert(!"Impossible");
- }
-
- pNew->pNext = pStyle->pPriority;
- pStyle->pPriority = pNew;
-
- return pNew;
-}
-
-#define MEDIA_QUERY_NONE 0
-#define MEDIA_QUERY_MATCH 1
-#define MEDIA_QUERY_NOMATCH 2
-/*
- *---------------------------------------------------------------------------
- *
- * cssParseMediaQuery --
- *
- * Parse a media query.
- *
- * Results:
- * Return the number of bytes parsed.
- *
- * Side effects:
- * Set *pRes to the "result" - one of the MEDIA_QUERY_* symbols.
- *
- *---------------------------------------------------------------------------
- */
-static int cssParseMediaQuery(pParse, p, z, n, pRes)
- CssParse *pParse;
- void *p; /* The thing returned by tkhtmlCssParserAlloc */
- const char *z; /* Input text */
- int n; /* Length of input text in bytes */
- int *pRes; /* Result - one of the MEDIA_QUERY_* symbols */
-{
- int t;
- int c = 0;
- CssToken sToken;
-
- /* 0 -> Expect identifier
- ** 1 -> Expect comma
- ** 2 -> Failed to parse.
- ** 3 -> Finished.
- */
- int eState = 0; /* Media-query parser state */
-
- *pRes = MEDIA_QUERY_NOMATCH;
- while (eState!=3 && (t = cssGetToken(&z[c], n-c, &sToken.n))) {
- sToken.z = &z[c];
- c += sToken.n;
-
- switch (t) {
- case CT_SEMICOLON:
- /* If a ';' is encountered in the middle of a media-query,
- ** then terminate media-query parsing and drop back to the
- ** upper level.
- */
- *pRes = MEDIA_QUERY_NONE;
- eState = 3;
- break;
-
- case CT_SPACE:
- break;
-
- case CT_LP:
- if (eState == 0){
- *pRes = MEDIA_QUERY_NOMATCH;
- }
- eState = 3;
- break;
-
- case CT_COMMA:
- if (eState == 0){
- *pRes = MEDIA_QUERY_NOMATCH;
- eState = 2;
- }
- if (eState == 1){
- eState = 0;
- }
- break;
-
- case CT_IDENT:
- if (eState == 1){
- *pRes = MEDIA_QUERY_NOMATCH;
- eState = 2;
- }
- if (eState == 0){
- eState = 1;
- if (
- (sToken.n == 3 && 0 == strnicmp(sToken.z, "all", 3)) ||
- (sToken.n == 6 && 0 == strnicmp(sToken.z, "screen", 6))
- ) {
- *pRes = MEDIA_QUERY_MATCH;
- }
- }
- break;
-
- default:
- *pRes = MEDIA_QUERY_NOMATCH;
- eState = 2;
- break;
- }
+ for (i = 0; i < 3; i++) {
+ if (pLeft->origin == a[i]) return 1;
+ if (pRight->origin == a[i]) return -1;
+ }
+ assert(!"Impossible");
}
- return c;
+ /* One 'important' flag is set and the other cleared. The highest
+ * priority is therefore the one with the 'important' flag set.
+ */
+ return pLeft->important ? 1 : -1;
}
+#endif
/*
*---------------------------------------------------------------------------
*
- * cssParseBody --
- *
- * Parse the body of a stylesheet. The string/length argument pair
- * z/n is assumed to contain the body of a stylesheet document
- * (i.e. everything after the @charset and @import rules).
- *
- * This function basically pulls tokens out of (z/n) and passes
- * them to the lemon parser via tkhtmlCssParser(). It performs two
- * other tasks:
- *
- * 1. Handles @media rules. Only the content of matching @media
- * rules are passed through to tkhtmlCssParser().
- *
- * 2. Handles @page rules. These are simply discarded. (TODO)
- *
- * 3. Handles invalid at-rules. These are also discarded. CSS 2.1
- * says "User agents must ignore an invalid at-keyword together
- * with everything following it, up to and including the next
- * semicolon (;) or block ({...}), whichever comes first."
- *
- * Example from spec:
+ * newCssPriority --
*
- * @three-dee {
- * @background-lighting {
- * azimuth: 30deg;
- * }
- * h1 { color: red }
- * }
- * h1 { color: blue }
+ * Add a new entry to the CssStyleSheet.pPriority list with values
+ * origin, pIdTail and important. Update the CssPriority.iPriority
+ * variable for all list members that require it.
*
- * h1 is blue, *not* red.
+ * See comments above CssPriority struct in cssInt.h for details.
*
+ * The pointer to pIdList is copied and the reference count increased
+ * by one. It is decreased when the new list entry is deleted (along
+ * with the rest of the stylesheet).
*
* Results:
- * Return the number of bytes parsed.
+ * Pointer to new list entry.
*
* Side effects:
- * Set *pRes to the "result" - one of the MEDIA_QUERY_* symbols.
+ * Modifies linked-list pStyle->pPriority.
*
*---------------------------------------------------------------------------
*/
-static void cssParseBody(pParse, p, z, n)
- CssParse *pParse;
- void *p; /* The thing returned by tkhtmlCssParserAlloc */
- const char *z; /* Input text */
- int n; /* Length of input text in bytes */
+static CssPriority *
+newCssPriority(pStyle, origin, pIdTail, important)
+ CssStyleSheet *pStyle;
+ int origin;
+ Tcl_Obj *pIdTail;
+ int important;
{
- int t;
- int c = 0;
- CssToken sToken;
-
- int eMedia = MEDIA_QUERY_NONE;
- int nParen = 0;
+ CssPriority *pNew; /* New list entry */
- while ((t = cssGetToken(&z[c], n-c, &sToken.n))) {
- sToken.z = &z[c];
- c += sToken.n;
+ pNew = HtmlNew(CssPriority);
+ pNew->origin = origin;
+ pNew->important = important;
+ pNew->pIdTail = pIdTail;
+ Tcl_IncrRefCount(pIdTail);
- if (t > 0) {
- if (t == CT_MEDIA_SYM && eMedia == MEDIA_QUERY_NONE){
- c += cssParseMediaQuery(pParse, p, &z[c], n-c, &eMedia);
- if (eMedia != MEDIA_QUERY_NONE) {
- nParen++;
- }
- }else{
- if (eMedia != MEDIA_QUERY_NONE) {
- if (t == CT_LP) {
- nParen++;
- }else if (t == CT_RP) {
- nParen--;
- if (nParen == 0) {
- eMedia = MEDIA_QUERY_NONE;
- continue;
- }
- }
- }
- if (eMedia != MEDIA_QUERY_NOMATCH) {
- tkhtmlCssParser(p, t, sToken, pParse);
- }
+ switch (origin) {
+ case CSS_ORIGIN_AGENT:
+ pNew->iPriority = 1;
+ break;
+ case CSS_ORIGIN_USER:
+ if (important) {
+ pNew->iPriority = 5;
+ } else {
+ pNew->iPriority = 2;
}
- }
+ break;
+ case CSS_ORIGIN_AUTHOR:
+ if (important) {
+ pNew->iPriority = 4;
+ } else {
+ pNew->iPriority = 3;
+ }
+ break;
+ default:
+ assert(!"Impossible");
}
+
+ pNew->pNext = pStyle->pPriority;
+ pStyle->pPriority = pNew;
+
+ return pNew;
}
/*
@@ -2410,7 +2153,8 @@ static void cssParseBody(pParse, p, z, n)
*---------------------------------------------------------------------------
*/
static int
-cssParse(pTree, n, z, isStyle, origin, pStyleId, pImportCmd, pUrlCmd, ppStyle)
+cssParse(
+pTree, n, z, isStyle, origin, pStyleId, pImportCmd, pUrlCmd, pErrorVar, ppStyle)
HtmlTree *pTree;
int n; /* Size of z in bytes */
CONST char *z; /* Text of attribute/document */
@@ -2419,11 +2163,10 @@ cssParse(pTree, n, z, isStyle, origin, pStyleId, pImportCmd, pUrlCmd, ppStyle)
Tcl_Obj *pStyleId; /* Second and later parts of stylesheet id */
Tcl_Obj *pImportCmd; /* Command to invoke to process @import */
Tcl_Obj *pUrlCmd; /* Command to invoke to translate url() */
+ Tcl_Obj *pErrorVar; /* Name of error-log variable */
CssStyleSheet **ppStyle; /* IN/OUT: Stylesheet to append to */
{
CssParse sParse;
- CssToken sToken;
- void *p;
int ii;
memset(&sParse, 0, sizeof(CssParse));
@@ -2433,13 +2176,14 @@ cssParse(pTree, n, z, isStyle, origin, pStyleId, pImportCmd, pUrlCmd, ppStyle)
sParse.pUrlCmd = pUrlCmd;
sParse.interp = (pTree ? pTree->interp : 0);
sParse.pTree = pTree;
+ if (pErrorVar) {
+ sParse.pErrorLog = Tcl_NewObj();
+ Tcl_IncrRefCount(sParse.pErrorLog);
+ }
if( n<0 ){
n = strlen(z);
}
- p = tkhtmlCssParserAlloc(xCkalloc);
-
-/* tkhtmlCssParserTrace(stdout, "CSS: "); */
/* If *ppStyle is NULL, then create a new CssStyleSheet object. If it
* is not zero, then append the rules from the new stylesheet document
@@ -2449,9 +2193,11 @@ cssParse(pTree, n, z, isStyle, origin, pStyleId, pImportCmd, pUrlCmd, ppStyle)
sParse.pStyle = HtmlNew(CssStyleSheet);
/* If pStyleId is not NULL, then initialise the hash-tables */
- Tcl_InitHashTable(&sParse.pStyle->aByTag, TCL_STRING_KEYS);
- Tcl_InitHashTable(&sParse.pStyle->aByClass, TCL_STRING_KEYS);
- Tcl_InitHashTable(&sParse.pStyle->aById, TCL_STRING_KEYS);
+ if (pStyleId) {
+ Tcl_InitHashTable(&sParse.pStyle->aByTag, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&sParse.pStyle->aByClass, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&sParse.pStyle->aById, TCL_STRING_KEYS);
+ }
} else {
sParse.pStyle = *ppStyle;
}
@@ -2469,35 +2215,13 @@ cssParse(pTree, n, z, isStyle, origin, pStyleId, pImportCmd, pUrlCmd, ppStyle)
sParse.pPriority2 = newCssPriority(sParse.pStyle, origin, pStyleId, 1);
}
- /* If this is a style attribute, not a stylesheet, then feed the
- * parser the tokens '*' and '{' before attempting to parse the style
- * attribute text. After parsing the text, feed the parser a '}' to
- * finish everything off. Thus a style is converted to a stylesheet
- * with a rule, using the universal selector.
- */
- if (isStyle) {
- sToken.z = "*"; sToken.n = 1;
- tkhtmlCssParser(p, CT_STAR, sToken, &sParse);
- sToken.z = "{"; sToken.n = 1;
- tkhtmlCssParser(p, CT_LP, sToken, &sParse);
- }
-
- cssParseBody(&sParse, p, z, n);
-
- /* if this is a style, not a stylesheet (see above), then feed the
- * closing '}' token to the parser.
- */
if (isStyle) {
- sToken.z = "}"; sToken.n = 1;
- tkhtmlCssParser(p, CT_RP, sToken, &sParse);
+ HtmlCssRunStyleParser(z, n, &sParse);
+ } else {
+ HtmlCssRunParser(z, n, &sParse);
}
- /* Pass the end-of-input token to the parser */
- sToken.z = ""; sToken.n = 0;
- tkhtmlCssParser(p, 0, sToken, &sParse);
-
*ppStyle = sParse.pStyle;
- tkhtmlCssParserFree(p, xCkfree);
/* Clean up anything left in sParse */
selectorFree(sParse.pSelector);
@@ -2507,39 +2231,13 @@ cssParse(pTree, n, z, isStyle, origin, pStyleId, pImportCmd, pUrlCmd, ppStyle)
propertySetFree(sParse.pPropertySet);
propertySetFree(sParse.pImportant);
- return 0;
-}
+ if (pErrorVar) {
+ Tcl_ObjSetVar2(pTree->interp, pErrorVar, 0, sParse.pErrorLog, 0);
+ Tcl_DecrRefCount(sParse.pErrorLog);
+ }
-/*--------------------------------------------------------------------------
- *
- * HtmlCssParse --
- *
- * Parse the stylesheet pointed to by z, length n bytes. See comments
- * above cssParse() for more detail.
- *
- * Results:
- *
- * Returns a CssStyleSheet pointer, written to *ppStyle.
- *
- * Side effects:
- *
- *--------------------------------------------------------------------------
- */
-#if 0
-int
-HtmlCssParse(pText, origin, pStyleId, pImportCmd, ppStyle)
- Tcl_Obj *pText;
- int origin;
- Tcl_Obj *pStyleId;
- Tcl_Obj *pImportCmd;
- CssStyleSheet **ppStyle;
-{
- int n;
- CONST char *z;
- z = Tcl_GetStringFromObj(pText, &n);
- return cssParse(n, z, 0, origin, pStyleId, pImportCmd, 0, 0, ppStyle);
+ return 0;
}
-#endif
int
HtmlCssSelectorParse(pTree, n, z, ppStyle)
@@ -2548,7 +2246,7 @@ HtmlCssSelectorParse(pTree, n, z, ppStyle)
const char *z;
CssStyleSheet **ppStyle;
{
- return cssParse(pTree, n, z, 0, 0, 0, 0, 0, ppStyle);
+ return cssParse(pTree, n, z, 0, 0, 0, 0, 0, 0, ppStyle);
}
/*
@@ -2567,13 +2265,13 @@ HtmlCssSelectorParse(pTree, n, z, ppStyle)
*---------------------------------------------------------------------------
*/
int
-HtmlStyleParse(pTree, interp, pStyleText, pId, pImportCmd, pUrlCmd)
+HtmlStyleParse(pTree, pStyleText, pId, pImportCmd, pUrlCmd, pErrorVar)
HtmlTree *pTree;
- Tcl_Interp *interp;
Tcl_Obj *pStyleText;
Tcl_Obj *pId;
Tcl_Obj *pImportCmd;
Tcl_Obj *pUrlCmd;
+ Tcl_Obj *pErrorVar;
{
int origin = 0;
Tcl_Obj *pStyleId = 0;
@@ -2598,7 +2296,7 @@ HtmlStyleParse(pTree, interp, pStyleText, pId, pImportCmd, pUrlCmd)
pStyleId = Tcl_NewStringObj(&zId[6], -1);
}
if (!pStyleId) {
- Tcl_AppendResult(interp, "Bad style-sheet-id: ", zId, 0);
+ Tcl_AppendResult(pTree->interp, "Bad style-sheet-id: ", zId, 0);
return TCL_ERROR;
}
Tcl_IncrRefCount(pStyleId);
@@ -2619,6 +2317,7 @@ HtmlStyleParse(pTree, interp, pStyleText, pId, pImportCmd, pUrlCmd)
pStyleId, /* Rest of -id option */
pImportCmd, /* How to handle @import */
pUrlCmd, /* How to handle url() */
+ pErrorVar, /* Variable to store errors in */
&pTree->pStyle /* CssStylesheet to update/create */
);
@@ -2650,7 +2349,7 @@ HtmlCssInlineParse(
){
CssStyleSheet *pStyle = 0;
assert(ppPropertySet && !(*ppPropertySet));
- cssParse(pTree, n, z, 1, 0, 0, 0, 0,&pStyle);
+ cssParse(pTree, n, z, 1, 0, 0, 0, 0, 0, &pStyle);
if (pStyle) {
if (pStyle->pUniversalRules) {
@@ -2799,23 +2498,37 @@ HtmlCssDeclaration(pParse, pProp, pExpr, isImportant)
{
int prop;
CssPropertySet **ppPropertySet;
+ char zBuf[128];
/* Do nothing if the isIgnore flag is set */
if (pParse->isIgnore) return;
#if TRACE_PARSER_CALLS
- printf("HtmlCssDeclaration(%p, \"%.*s\", \"%.*s\")\n",
+ printf("HtmlCssDeclaration(%p, \"%.*s\", \"%.*s\", %d)\n",
pParse,
pProp?pProp->n:0, pProp?pProp->z:"",
- pExpr?pExpr->n:0, pExpr?pExpr->z:""
+ pExpr?pExpr->n:0, pExpr?pExpr->z:"",
+ isImportant
);
#endif
+ if (pParse->pStyleId == 0) {
+ isImportant = 0;
+ }
+
/* Resolve the property name. If we don't recognize it, then ignore the
* declaration (CSS2 spec says to do this - besides, what else could we
* do?).
*/
+#if 0
prop = HtmlCssPropertyLookup(pProp->n, pProp->z);
+#else
+ if (pProp->n > 127) pProp->n = 127;
+ memcpy(zBuf, pProp->z, pProp->n);
+ zBuf[pProp->n] = '\0';
+ dequote(zBuf);
+ prop = HtmlCssPropertyLookup(-1, zBuf);
+#endif
if( prop<0 ) return;
if (isImportant) {
@@ -2833,7 +2546,7 @@ HtmlCssDeclaration(pParse, pProp, pExpr, isImportant)
case CSS_SHORTCUTPROPERTY_BORDER_RIGHT:
case CSS_SHORTCUTPROPERTY_BORDER_TOP:
case CSS_SHORTCUTPROPERTY_BORDER_BOTTOM:
- propertySetAddShortcutBorder(*ppPropertySet, prop, pExpr);
+ propertySetAddShortcutBorder(pParse, *ppPropertySet, prop, pExpr);
break;
case CSS_SHORTCUTPROPERTY_BORDER_COLOR:
case CSS_SHORTCUTPROPERTY_BORDER_STYLE:
@@ -2857,6 +2570,11 @@ HtmlCssDeclaration(pParse, pProp, pExpr, isImportant)
case CSS_SHORTCUTPROPERTY_LIST_STYLE:
shortcutListStyle(pParse, *ppPropertySet, pExpr);
break;
+ case CSS_PROPERTY_CONTENT:
+ case CSS_PROPERTY_COUNTER_INCREMENT:
+ case CSS_PROPERTY_COUNTER_RESET:
+ propertySetAddList(pParse, prop, *ppPropertySet, pExpr);
+ break;
default:
propertySetAdd(*ppPropertySet, prop, tokenToProperty(pParse,pExpr));
}
@@ -3187,68 +2905,6 @@ cssSelectorPropertySetPair(pParse, pSelector, pPropertySet, freeWhat)
pRule->pPropertySet = pPropertySet;
}
-/*
- *---------------------------------------------------------------------------
- *
- * HtmlCssPseudo --
- *
- * This function is called by the parser to interpret the name of
- * a CSS pseudo-class or pseudo-element. (i.e. "hover" or "after"
- * etc.).
- *
- * Argument pToken contains the name to be interpreted. The second
- * argument, nColon, is the number of ':' characters that preceeded
- * the name.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-int HtmlCssPseudo(pToken, nColon)
- CssToken *pToken;
- int nColon;
-{
- struct PseudoString {
- const char *zOption;
- int eOption;
- int nMinColons;
- int nMaxColons;
- } a[] = {
- /* Pseudo-classes. One colon only. */
- {"link", CSS_PSEUDOCLASS_LINK, 1, 1},
- {"visited", CSS_PSEUDOCLASS_VISITED, 1, 1},
- {"active", CSS_PSEUDOCLASS_ACTIVE, 1, 1},
- {"hover", CSS_PSEUDOCLASS_HOVER, 1, 1},
- {"focus", CSS_PSEUDOCLASS_FOCUS, 1, 1},
- {"last-child", CSS_PSEUDOCLASS_LASTCHILD, 1, 1},
- {"first-child", CSS_PSEUDOCLASS_FIRSTCHILD, 1, 1},
-
- /* CSS 2.1 (or earlier) pseudo-elements. One or two colons */
- {"after", CSS_PSEUDOELEMENT_AFTER, 1, 2},
- {"before", CSS_PSEUDOELEMENT_BEFORE, 1, 2}
- };
- int ii;
-
- for (ii = 0; ii < (sizeof(a)/sizeof(a[0])); ii++) {
- if (
- nColon >= a[ii].nMinColons &&
- nColon <= a[ii].nMaxColons &&
- pToken->n == strlen(a[ii].zOption) &&
- 0 == strncmp(pToken->z, a[ii].zOption, pToken->n)
- ) {
- return a[ii].eOption;
- }
- }
-
- /* Tkhtml doesn't understand this pseudo-element or class. The rule will
- * never match anything. */
- return CSS_SELECTOR_NEVERMATCH;
-}
-
/*--------------------------------------------------------------------------
*
* HtmlCssRule --
@@ -3277,6 +2933,10 @@ void HtmlCssRule(pParse, success)
int nXtra = pParse->nXtra;
int i;
+#if TRACE_PARSER_CALLS
+ printf("HtmlCssRule(%p, %d)\n", pParse, success);
+#endif
+
if (pPropertySet && pPropertySet->n == 0) {
propertySetFree(pPropertySet);
pPropertySet = 0;
@@ -3442,7 +3102,8 @@ HtmlCssSelectorTest(pSelector, pNode, dynamic_true)
break;
case CSS_SELECTOR_TYPE:
- if( strcmp(N_TYPE(x), p->zValue) ) return 0;
+ assert(x->zTag || HtmlNodeIsText(x));
+ if( HtmlNodeIsText(x) || strcmp(x->zTag, p->zValue) ) return 0;
break;
case CSS_SELECTOR_CLASS: {
@@ -3583,6 +3244,17 @@ HtmlCssSelectorTest(pSelector, pNode, dynamic_true)
return (x && !p)?1:0;
}
+/*
+ *---------------------------------------------------------------------------
+ *
+ * HtmlCssInlineFree --
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *---------------------------------------------------------------------------
+ */
void
HtmlCssInlineFree(pPropertySet)
CssPropertySet *pPropertySet;
@@ -3590,6 +3262,17 @@ HtmlCssInlineFree(pPropertySet)
propertySetFree(pPropertySet);
}
+/*
+ *---------------------------------------------------------------------------
+ *
+ * propertySetToPropertyValues --
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *---------------------------------------------------------------------------
+ */
static void
propertySetToPropertyValues(p, aPropDone, pSet)
HtmlComputedValuesCreator *p;
@@ -3599,7 +3282,7 @@ propertySetToPropertyValues(p, aPropDone, pSet)
int i;
assert(pSet);
- for (i = 0; i < pSet->n; i++) {
+ for (i = pSet->n - 1; i >= 0; i--) {
int eProp = pSet->a[i].eProp;
/* eProp may be greater than MAX_PROPERTY if it stores a composite
* property that Tkhtml doesn't handle. In this case just ignore it.
@@ -3679,26 +3362,6 @@ overrideToPropertyValues(p, aPropDone, pOverride)
}
}
-#if 0
-static int
-selectorIsDynamic(pSelector)
- CssSelector *pSelector;
-{
- CssSelector *p;
- for (p = pSelector; p; p = p->pNext) {
- switch (p->eSelector) {
- case CSS_PSEUDOCLASS_ACTIVE:
- case CSS_PSEUDOCLASS_HOVER:
- case CSS_PSEUDOCLASS_FOCUS:
- case CSS_PSEUDOCLASS_LINK:
- case CSS_PSEUDOCLASS_VISITED:
- return 1;
- }
- }
- return 0;
-}
-#endif
-
/*--------------------------------------------------------------------------
*
* applyRule --
@@ -3762,6 +3425,16 @@ applyRule(pTree, pNode, pRule, aPropDone, pzIfMatch, pCreator)
return isMatch;
}
+/*--------------------------------------------------------------------------
+ *
+ * nextRule --
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *--------------------------------------------------------------------------
+ */
static CssRule *
nextRule(apRule, n)
CssRule **apRule;
@@ -3831,7 +3504,6 @@ HtmlCssStyleSheetApply(pTree, pNode)
*/
int aPropDone[CSS_PROPERTY_MAX_PROPERTY + 1];
- const char *zTag;
Tcl_HashEntry *pEntry;
char const *zClassAttr; /* Value of node "class" attribute */
char const *zIdAttr; /* Value of node "id" attribute */
@@ -3850,8 +3522,7 @@ HtmlCssStyleSheetApply(pTree, pNode)
npRule = 1;
/* Find the applicable "by-tag" rules list, if any. */
- zTag = HtmlNodeTagName(pNode);
- pEntry = Tcl_FindHashEntry(&pStyle->aByTag, zTag);
+ pEntry = Tcl_FindHashEntry(&pStyle->aByTag, pNode->zTag);
if (pEntry) {
apRule[npRule++] = Tcl_GetHashValue(pEntry);
}
@@ -3984,6 +3655,18 @@ generateContentText(pTree, zContent)
return pTextNode;
}
+/*--------------------------------------------------------------------------
+ *
+ * generatedContent --
+ *
+ * Results:
+ *
+ * None.
+ *
+ * Side effects:
+ *
+ *--------------------------------------------------------------------------
+ */
static void
generatedContent(pTree, pNode, pCssRule, ppNode)
HtmlTree *pTree;
@@ -4001,6 +3684,7 @@ generatedContent(pTree, pNode, pCssRule, ppNode)
char *zContent = 0;
memset(aPropDone, 0, sizeof(aPropDone));
+
sCreator.pzContent = &zContent;
for (pRule = pCssRule; pRule; pRule = pRule->pNext) {
char **pz = (have ? 0 : (&zContent));
@@ -4028,19 +3712,37 @@ generatedContent(pTree, pNode, pCssRule, ppNode)
}
}
-void HtmlCssStyleSheetGenerated(pTree, pElem)
+/*--------------------------------------------------------------------------
+ *
+ * HtmlCssStyleSheetGenerated --
+ *
+ * Retrieve the value of a specified property from a CssProperties
+ * object, or NULL if the property is not defined.
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *--------------------------------------------------------------------------
+ */
+void HtmlCssStyleGenerateContent(pTree, pElem, isBefore)
HtmlTree *pTree;
HtmlElementNode *pElem;
+ int isBefore;
{
CssStyleSheet *pStyle = pTree->pStyle; /* Stylesheet config */
HtmlNode *pNode = (HtmlNode *)pElem;
- generatedContent(pTree, pNode, pStyle->pAfterRules, &pElem->pAfter);
- generatedContent(pTree, pNode, pStyle->pBeforeRules, &pElem->pBefore);
+ if (isBefore) {
+ generatedContent(pTree, pNode, pStyle->pBeforeRules, &pElem->pBefore);
+ } else {
+ generatedContent(pTree, pNode, pStyle->pAfterRules, &pElem->pAfter);
+ }
}
/*--------------------------------------------------------------------------
*
* HtmlCssPropertiesGet --
+ *
* Retrieve the value of a specified property from a CssProperties
* object, or NULL if the property is not defined.
*
@@ -4128,7 +3830,7 @@ void HtmlCssImport(pParse, pToken)
Tcl_Obj *pEval = pParse->pImportCmd;
/* Do nothing if the isIgnore or isBody flags are set */
- if (pParse->isIgnore || pParse->isBody) return;
+ if (pParse->isBody) return;
if (pEval) {
Tcl_Interp *interp = pParse->interp;
@@ -4138,6 +3840,7 @@ void HtmlCssImport(pParse, pToken)
switch (p->eType) {
case CSS_TYPE_URL:
break;
+ case CSS_TYPE_RAW:
case CSS_TYPE_STRING:
if (pParse && pParse->pUrlCmd) {
doUrlCmd(pParse, zUrl, strlen(zUrl));
@@ -4157,7 +3860,17 @@ void HtmlCssImport(pParse, pToken)
}
}
-
+/*
+ *---------------------------------------------------------------------------
+ *
+ * HtmlCssSelectorToString --
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *---------------------------------------------------------------------------
+ */
void
HtmlCssSelectorToString(pSelector, pObj)
CssSelector *pSelector;
@@ -4229,6 +3942,17 @@ HtmlCssSelectorToString(pSelector, pObj)
if (z) Tcl_AppendToObj(pObj, z, -1);
}
+/*
+ *---------------------------------------------------------------------------
+ *
+ * rulelistReport --
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *---------------------------------------------------------------------------
+ */
static void
rulelistReport(pRule, pObj, pN)
CssRule *pRule;
@@ -4269,6 +3993,17 @@ rulelistReport(pRule, pObj, pN)
}
}
+/*
+ *---------------------------------------------------------------------------
+ *
+ * HtmlCssStyleReport --
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *---------------------------------------------------------------------------
+ */
int
HtmlCssStyleReport(clientData, interp, objc, objv)
ClientData clientData; /* The HTML widget data structure */
@@ -4417,6 +4152,17 @@ HtmlCssStyleReport(clientData, interp, objc, objv)
return TCL_OK;
}
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ruleQsortCompare --
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *---------------------------------------------------------------------------
+ */
static int
ruleQsortCompare(const void *pLeft, const void *pRight)
{
@@ -4454,7 +4200,7 @@ HtmlCssStyleConfigDump(clientData, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument strings. */
{
-#define MAX_RULES 1024
+#define MAX_RULES 8096
HtmlTree *pTree = (HtmlTree *)clientData;
CssStyleSheet *pStyle = pTree->pStyle;
Tcl_HashTable *apTable[3];
diff --git a/src/css.h b/src/css.h
index 06cb0b1..2e96251 100644
--- a/src/css.h
+++ b/src/css.h
@@ -86,13 +86,19 @@ typedef struct CssPropertySet CssPropertySet;
#define CSS_TYPE_PERCENT 9 /* Value in 'rVal' */
#define CSS_TYPE_FLOAT 10 /* Value in 'rVal' */
-#define CSS_TYPE_STRING 11 /* Value in 'sVal' */
+#define CSS_TYPE_STRING 11 /* Value in 'zVal' */
#define CSS_TYPE_NONE 12 /* No value */
/* Function notation */
#define CSS_TYPE_TCL 13 /* Value in 'zVal' */
#define CSS_TYPE_URL 14 /* Value in 'zVal' */
#define CSS_TYPE_ATTR 15 /* Value in 'zVal' */
+#define CSS_TYPE_COUNTER 16 /* Value in 'zVal' */
+#define CSS_TYPE_COUNTERS 17 /* Value in 'zVal' */
+
+#define CSS_TYPE_RAW 18
+
+#define CSS_TYPE_LIST 19 /* Used for 'content' property */
/*
@@ -126,7 +132,9 @@ CssProperty *HtmlCssStringToProperty(CONST char *z, int n);
/*
* This is used to split up a white-space seperated list.
*/
-const char *HtmlCssGetNextListItem(CONST char *z, int n, int *pN);
+const char *HtmlCssGetNextListItem(const char *z, int n, int *pN);
+
+const char *HtmlCssGetNextCommaListItem(const char *z, int n, int *pN);
/*
* Functions to parse stylesheet and style data into CssStyleSheet objects.
@@ -157,6 +165,7 @@ void HtmlCssStyleSheetFree(CssStyleSheet *);
*/
void HtmlCssStyleSheetApply(HtmlTree *, HtmlNode *);
void HtmlCssStyleSheetGenerated(HtmlTree *, HtmlElementNode *);
+void HtmlCssStyleGenerateContent(HtmlTree *, HtmlElementNode *, int);
/*
* Functions to interface with inline style information (in HTML,
diff --git a/src/cssInt.h b/src/cssInt.h
index 5aaaea2..e6bdf20 100644
--- a/src/cssInt.h
+++ b/src/cssInt.h
@@ -40,7 +40,6 @@
#define __CSSINT_H__
#include "css.h"
-#include "cssparse.h"
#include <tcl.h>
typedef struct CssSelector CssSelector;
@@ -251,6 +250,7 @@ struct CssParse {
Tcl_Obj *pStyleId;
Tcl_Obj *pImportCmd; /* Script to invoke for @import */
Tcl_Obj *pUrlCmd; /* Script to invoke for url() */
+ Tcl_Obj *pErrorLog; /* In non-zero, store syntax errors here */
Tcl_Interp *interp; /* Interpreter to invoke pImportCmd */
HtmlTree *pTree; /* Tree used to determine if quirks mode */
};
@@ -265,13 +265,6 @@ void HtmlCssRule(CssParse *, int);
void HtmlCssSelectorComma(CssParse *pParse);
void HtmlCssImport(CssParse *pParse, CssToken *);
-/*
- * Called by the parser to transform between the name of a psuedo-class or
- * psuedo-selector to a CSS_PSEUDO... value that can be passed to
- * HtmlCssSelector().
- */
-int HtmlCssPseudo(CssToken *, int);
-
/* Test if a selector matches a node */
int HtmlCssSelectorTest(CssSelector *, HtmlNode *, int);
@@ -284,5 +277,20 @@ int HtmlCssTclNodeDynamics(Tcl_Interp *, HtmlNode *);
int HtmlCssSelectorParse(HtmlTree *, int, const char *, CssStyleSheet **);
+enum CssTokenType {
+ CT_SPACE, CT_LP, CT_RP, CT_RRP, CT_LSP,
+ CT_RSP, CT_SEMICOLON, CT_COMMA, CT_COLON, CT_PLUS,
+ CT_DOT, CT_HASH, CT_EQUALS, CT_TILDE, CT_PIPE,
+ CT_AT, CT_BANG, CT_STRING, CT_LRP, CT_GT,
+ CT_STAR, CT_SLASH, CT_IDENT, CT_FUNCTION,
+
+ CT_SGML_OPEN, CT_SGML_CLOSE, CT_SYNTAX_ERROR, CT_EOF
+};
+typedef enum CssTokenType CssTokenType;
+
+void HtmlCssRunParser(const char *, int, CssParse *);
+void HtmlCssRunStyleParser(const char *, int, CssParse *);
+CssTokenType HtmlCssGetToken(const char *, int, int *);
+
#endif /* __CSS_H__ */
diff --git a/src/cssparse.lem b/src/cssparse.y
similarity index 89%
copy from src/cssparse.lem
copy to src/cssparse.y
index 45046a5..58c32ec 100644
--- a/src/cssparse.lem
+++ b/src/cssparse.y
@@ -49,12 +49,7 @@
%token_type {CssToken}
/* Need this value for a trick in the tokenizer used to parse CT_FUNCTION. */
-%nonassoc RRP.
-
-/* This does not appear in the grammar, but the tokenizer generates it. It
- * will (hopefully) match "error" somewhere in the grammar.
- */
-%nonassoc UNKNOWN_SYM INVALID_AT_SYM.
+%nonassoc RRP.
%syntax_error {
pParse->pStyle->nSyntaxErr++;
@@ -73,9 +68,7 @@ ws ::= SPACE ws.
** Style sheet header. Contains @charset and @import directives. @charset
** directives are ignored for the time being.
*/
-ss_header ::= ws charset_opt imports_opt. {
- pParse->isBody = 1;
-}
+ss_header ::= ws charset_opt imports_opt.
charset_opt ::= CHARSET_SYM ws STRING ws SEMICOLON ws.
charset_opt ::= .
@@ -85,30 +78,32 @@ imports_opt ::= imports_opt IMPORT_SYM ws term(X) medium_list_opt SEMICOLON ws.
HtmlCssImport(pParse, &X);
}
imports_opt ::= .
+imports_opt ::= unknown_at_rule.
medium_list_opt ::= medium_list.
medium_list_opt ::= .
-/*********************************************************************
- * Constructions for handling syntax errors in the stylesheet. When a
- * syntax error is encountered, the parser should ignore everything until
- * the end of the next block, or the next semi-colon.
+/*
+ * Code to handle an unknown "at-rule". If the tokenizer sees an "@"
+ * character that is not followed by any known at-keyword, it calls
+ * the "@" an UNKNOWN_SYM token. The correct behaviour is to discard
+ * everything up until the next semicolon or the end of the next
+ * block.
*/
-toplevel_syntaxerror ::= toplevel_trash SEMICOLON.
-toplevel_syntaxerror ::= toplevel_trash LP declaration_trash RP.
-toplevel_syntaxerror ::= LP declaration_trash RP.
-
-toplevel_trash ::= toplevel_trash error.
-toplevel_trash ::= error.
-
-declaration_syntaxerror ::= declaration_trash.
-declaration_syntaxerror ::= declaration_trash declaration_trash.
-declaration_trash ::= LP declaration_syntaxerror RP.
-declaration_trash ::= error.
+unknown_at_rule ::= UNKNOWN_SYM trash SEMICOLON ws.
+unknown_at_rule ::= UNKNOWN_SYM trash LP trash RP ws.
+trash ::= .
+trash ::= error.
+trash ::= trash error.
/*********************************************************************
** Style sheet body. A list of style sheet body items.
*/
+/*
+ss_body ::= .
+ss_body ::= ss_body_item ws ss_body.
+*/
+
ss_body ::= ss_body_item.
ss_body ::= ss_body ws ss_body_item.
@@ -176,9 +171,6 @@ ruleset ::= selector_list LP declaration_list RP. {
HtmlCssRule(pParse, 1);
}
ruleset ::= page.
-ruleset ::= toplevel_syntaxerror. {
- HtmlCssRule(pParse, 0);
-}
selector_list ::= selector.
selector_list ::= selector_list comma ws selector.
@@ -193,7 +185,12 @@ declaration_list ::= declaration_list SEMICOLON ws.
declaration ::= ws IDENT(X) ws COLON ws expr(E) prio(I). {
HtmlCssDeclaration(pParse, &X, &E, I);
}
-declaration ::= declaration_syntaxerror.
+declaration ::= garbage.
+
+garbage ::= garbage_token.
+garbage ::= garbage garbage_token.
+garbage_token ::= error.
+garbage_token ::= LP garbage RP.
%type prio {int}
prio(X) ::= IMPORTANT_SYM ws. {X = (pParse->pStyleId) ? 1 : 0;}
@@ -238,6 +235,10 @@ tag ::= SEMICOLON(X). { HtmlCssSelector(pParse, CSS_SELECTOR_TYPE, 0, &X); }
simple_selector_tail ::= simple_selector_tail_component.
simple_selector_tail ::= simple_selector_tail_component simple_selector_tail.
+simple_selector_tail ::= error. {
+ HtmlCssSelector(pParse, CSS_SELECTOR_NEVERMATCH, 0, 0);
+}
+
simple_selector_tail_component ::= HASH IDENT(X). {
HtmlCssSelector(pParse, CSS_SELECTOR_ID, 0, &X);
}
diff --git a/src/cssparser.c b/src/cssparser.c
new file mode 100644
index 0000000..e516198
--- /dev/null
+++ b/src/cssparser.c
@@ -0,0 +1,1207 @@
+/*
+ * Copyright (c) 2007 Dan Kennedy.
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * * Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * * Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ * * Neither the name of this software nor the names of its
+ * contributors may be used to endorse or promote products
+ * derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ */
+static const char rcsid[] = "$Id: cssparser.c,v 1.8 2008/01/19 06:08:13 danielk1977 Exp $";
+
+#include <ctype.h>
+#include <assert.h>
+
+#include "cssInt.h"
+
+#define ISSPACE(x) isspace((unsigned char)(x))
+
+typedef struct CssInput CssInput;
+struct CssInput {
+ /* Current token */
+ CssTokenType eToken;
+ char *zToken;
+ int nToken;
+
+ /* Input text */
+ char *zInput; /* Input text (CSS document) */
+ int nInput; /* Number of bytes allocated at zInput */
+ int iInput; /* Offset of next token in zInput */
+};
+
+
+#if 0
+static void inputPrintToken(pInput)
+ CssInput *pInput;
+{
+ switch (pInput->eToken) {
+ case CT_SPACE: printf("CT_SPACE"); break;
+ case CT_LP: printf("CT_LP"); break;
+ case CT_RP: printf("CT_RP"); break;
+ case CT_RRP: printf("CT_RRP"); break;
+ case CT_LSP: printf("CT_LSP"); break;
+
+ case CT_RSP: printf("CT_RSP"); break;
+ case CT_SEMICOLON: printf("CT_SEMICOLON"); break;
+ case CT_COMMA: printf("CT_COMMA"); break;
+ case CT_COLON: printf("CT_COLON"); break;
+ case CT_PLUS: printf("CT_PLUS"); break;
+
+ case CT_DOT: printf("CT_DOT"); break;
+ case CT_HASH: printf("CT_HASH"); break;
+ case CT_EQUALS: printf("CT_EQUALS"); break;
+ case CT_TILDE: printf("CT_TILDE"); break;
+ case CT_PIPE: printf("CT_PIPE"); break;
+
+ case CT_AT: printf("CT_AT"); break;
+ case CT_BANG: printf("CT_BANG"); break;
+ case CT_STRING: printf("CT_STRING"); break;
+ case CT_LRP: printf("CT_LRP"); break;
+ case CT_GT: printf("CT_GT"); break;
+
+ case CT_STAR: printf("CT_STAR"); break;
+ case CT_SLASH: printf("CT_SLASH"); break;
+ case CT_IDENT: printf("CT_IDENT"); break;
+
+ case CT_SGML_OPEN: printf("CT_SGML_OPEN"); break;
+ case CT_SGML_CLOSE: printf("CT_SGML_CLOSE"); break;
+ case CT_SYNTAX_ERROR: printf("CT_SYNTAX_ERROR"); break;
+ case CT_FUNCTION: printf("CT_FUNCTION"); break;
+ case CT_EOF: printf("CT_EOF"); break;
+ }
+ printf(" (%d) \"%.*s\"\n",
+ pInput->nToken, pInput->nToken, pInput->zToken
+ );
+}
+#endif
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * inputDiscardComment --
+ *
+ * Discard any comment from the current point in the input string
+ * *pInput.
+ *
+ * Results:
+ * Return 1 if a comment was found, or 0 otherwise.
+ *
+ * Side effects:
+ * May consume data from *pInput.
+ *
+ *---------------------------------------------------------------------------
+ */
+static int inputDiscardComment(pInput)
+ CssInput *pInput;
+{
+ const char *z = &pInput->zInput[pInput->iInput];
+ int n = pInput->nInput - pInput->iInput;
+
+ if (n > 1 && z[0] == '/' && z[1] == '*') {
+ int i;
+ for (i = 4; i <= n && (z[i-1] != '/' || z[i-2] != '*'); i++) {
+ }
+ pInput->iInput += i;
+
+ /* If the previous token returned was CT_SPACE, then ignore any
+ * white-space that occurs immediately after a comment. This is
+ * so the parser can assume there will never be two CT_SPACE
+ * tokens in a row.
+ */
+ if (pInput->eToken == CT_SPACE) {
+ while (
+ pInput->iInput < pInput->nInput &&
+ ISSPACE(pInput->zInput[pInput->iInput])
+ ) {
+ pInput->iInput++;
+ }
+ }
+
+ return 1;
+ }
+
+ return 0;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * inputGetToken --
+ *
+ * Access the type, text and length of the current input token.
+ *
+ * Results:
+ * Return the type of the current input token.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+static CssTokenType inputGetToken(pInput, pzToken, pnToken)
+ CssInput *pInput;
+ const char **pzToken; /* OUTPUT: Pointer to token */
+ int *pnToken; /* OUTPUT: Token length */
+{
+ if (pzToken) *pzToken = pInput->zToken;
+ if (pnToken) *pnToken = pInput->nToken;
+ return pInput->eToken;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * inputNextToken --
+ *
+ * Advance the input to the next token.
+ *
+ * Results:
+ * Non-zero is returned if the end-of-file is reached. Otherwise zero.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+static int inputNextToken(pInput)
+ CssInput *pInput;
+{
+ const char *z;
+ int n;
+ int nToken;
+ CssTokenType eToken = CT_SYNTAX_ERROR;
+
+ /* Discard any comments from the input stream */
+ while (inputDiscardComment(pInput));
+
+ z = &pInput->zInput[pInput->iInput];
+ n = pInput->nInput - pInput->iInput;
+
+ if (n <= 0) {
+ pInput->eToken = CT_EOF;
+ pInput->zToken = 0;
+ pInput->nToken = 0;
+ return 1; /* 1 == EOF */
+ }
+
+ nToken = 1;
+ switch( z[0] ){
+ case ' ':
+ case '\n':
+ case '\r':
+ case '\t': {
+ /* Collapse any contiguous whitespace to a single token */
+ int i;
+ for (i = 1; ISSPACE((int)z[i]); i++) {
+ }
+ nToken = i;
+ eToken = CT_SPACE;
+ break;
+ }
+ case '{': eToken = CT_LP; break;
+ case '}': eToken = CT_RP; break;
+ case ')': eToken = CT_RRP; break;
+ case '(': eToken = CT_LRP; break;
+ case '[': eToken = CT_LSP; break;
+ case ']': eToken = CT_RSP; break;
+ case ';': eToken = CT_SEMICOLON; break;
+ case ',': eToken = CT_COMMA; break;
+ case ':': eToken = CT_COLON; break;
+ case '+': eToken = CT_PLUS; break;
+ case '>': eToken = CT_GT; break;
+ case '*': eToken = CT_STAR; break;
+ case '.': eToken = CT_DOT; break;
+ case '#': eToken = CT_HASH; break;
+ case '=': eToken = CT_EQUALS; break;
+ case '~': eToken = CT_TILDE; break;
+ case '|': eToken = CT_PIPE; break;
+ case '@': eToken = CT_AT; break;
+ case '!': eToken = CT_BANG; break;
+ case '/': eToken = CT_SLASH; break;
+
+ case '"': case '\'': {
+ char delim = z[0];
+ char c;
+ int i;
+ for(i=1; i<n; i++){
+ c = z[i];
+ if( c=='\\' ){
+ i++;
+ }
+ else if( c=='\n' ){
+ /* This is illegal. A CSS string cannot contain a new-line
+ * unless it is escaped by a '\' character. The correct
+ * response is to skip all the input parsed so far,
+ * then fall back to normal syntax-error parsing.
+ */
+ pInput->iInput += i;
+ goto bad_token;
+ }
+ else if( c==delim ){
+ nToken = i+1;
+ eToken = CT_STRING;
+ break;
+ }
+ }
+ /* This is actually not a parse error. If an EOF occurs in the
+ * middle of a string constant, the correct behaviour is to
+ * act as though the string was closed with a " or ' character.
+ */
+ break;
+ }
+
+ case '<': {
+ if (z[1] != '!' || z[2] != '-' || z[3] != '-') {
+ goto parse_as_token;
+ }
+ eToken = CT_SGML_OPEN;
+ nToken = 4;
+ break;
+ }
+ case '-': {
+ if (z[1] != '-' || z[2] != '>') {
+ goto parse_as_token;
+ }
+ eToken = CT_SGML_CLOSE;
+ nToken = 3;
+ break;
+ }
+
+parse_as_token:
+ default: {
+
+ /* This must be either an identifier or a function. For the
+ ** ASCII character range 0-127, the 'charmap' array is 1 for
+ ** characters allowed in an identifier or function name, 0
+ ** for characters not allowed. Allowed characters are a-z,
+ ** 0-9, '-', '_', '%' and '\'. All unicode characters
+ ** outside the ASCII range are allowed.
+ */
+ static u8 charmap[128] = {
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0x00-0x0F */
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0x10-0x1F */
+ 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, /* 0x20-0x2F */
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, /* 0x30-0x3F */
+ 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, /* 0x40-0x4F */
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 0, 0, 1, /* 0x50-0x5F */
+ 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, /* 0x60-0x6F */
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0 /* 0x70-0x7F */
+ };
+ int i;
+ int inHexEscape = 0;
+
+ for(i=0; i<n && (z[i]<0 || charmap[(int)z[i]]); i++){
+ if (z[i] == '\\' && z[i + 1]) i++;
+
+ /* In CSS, a single white-space character that occurs after
+ * a hexadecimal escape sequence is ignored.
+ */
+ if (isxdigit((u8)(z[i]))) {
+ if (i > 0 && z[i - 1] == '\\') inHexEscape = 1;
+ if (inHexEscape && isspace((u8)(z[i + 1]))) i++;
+ } else {
+ inHexEscape = 0;
+ }
+ }
+
+ if( i==0 ) goto bad_token;
+ if( i<n && z[i]=='(' ){
+ CssInput sInput;
+ memset(&sInput, 0, sizeof(CssInput));
+ sInput.zInput = (char *)(&z[i]);
+ sInput.nInput = n - i;
+
+ inputNextToken(&sInput);
+ eToken = inputGetToken(&sInput, 0, 0);
+ while (eToken != CT_RRP && eToken != CT_EOF) {
+ inputNextToken(&sInput);
+ eToken = inputGetToken(&sInput, 0, 0);
+ }
+ if( eToken!=CT_RRP ) goto bad_token;
+ nToken = sInput.iInput + i;
+ eToken = CT_FUNCTION;
+ } else {
+ nToken = i;
+ eToken = CT_IDENT;
+ }
+ }
+ }
+
+ pInput->eToken = eToken;
+ pInput->nToken = nToken;
+ pInput->zToken = (char *)z;
+ pInput->iInput += nToken;
+ return 0;
+
+bad_token:
+ pInput->iInput++;
+ pInput->eToken = CT_SYNTAX_ERROR;
+ return 0;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * inputNextTokenIgnoreSpace --
+ *
+ * Advance the input to the next non-whitespace token.
+ *
+ * Results:
+ * Non-zero is returned if the end-of-file is reached. Otherwise zero.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+static int inputNextTokenIgnoreSpace(pInput)
+ CssInput *pInput;
+{
+ int rc = inputNextToken(pInput);
+ if (rc == 0 && CT_SPACE == inputGetToken(pInput, 0, 0)) {
+ rc = inputNextToken(pInput);
+ }
+ assert(CT_SPACE != inputGetToken(pInput, 0, 0));
+ return rc;
+}
+
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * parseSyntaxError --
+ *
+ * This function is called when a syntax-error is encountered parsing
+ * either an "at-rule" or a CSS rule (except within the body of the
+ * property declaration block, that is handled seperately by
+ * parseDeclarationError()).
+ *
+ * If the error occured while parsing an at-rule, the isStopAtSemiColon
+ * argument is true. Otherwise false.
+ *
+ * If isStopAtSemiColon is false, then tokens are discarded until the
+ * end of the next block or the end-of-file is encountered. If
+ * isStopAtSemiColon at semi-colon is true, then also stop if a
+ * semi-colon character (i.e. ';') that is not inside a block is
+ * encountered.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Consumes data from *pInput.
+ *
+ *---------------------------------------------------------------------------
+ */
+static void parseSyntaxError(pInput, pParse, isStopAtSemiColon)
+ CssInput *pInput;
+ CssParse *pParse;
+ int isStopAtSemiColon; /* True if error occured parsing an @ rule */
+{
+ char *zToken;
+ int nToken;
+ CssTokenType eToken;
+
+ int iNest = 0;
+
+ int iErrorStart = 0;
+ int iErrorLength = 0;
+
+ iErrorStart = pInput->iInput;
+ eToken = inputGetToken(pInput, &zToken, &nToken);
+
+ while (
+ eToken != CT_EOF &&
+ (eToken != CT_SEMICOLON || iNest != 0 || !isStopAtSemiColon) &&
+ (eToken != CT_RP || iNest > 1)
+ ) {
+ if (eToken == CT_LP) iNest++;
+ if (eToken == CT_RP) iNest--;
+ inputNextToken(pInput);
+ eToken = inputGetToken(pInput, 0, 0);
+ }
+ iErrorLength = pInput->iInput - iErrorStart;
+
+ if (pParse->pErrorLog) {
+ Tcl_Obj *pError = pParse->pErrorLog;
+ Tcl_ListObjAppendElement(0, pError, Tcl_NewIntObj(iErrorStart));
+ Tcl_ListObjAppendElement(0, pError, Tcl_NewIntObj(iErrorLength));
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * parseDeclarationError --
+ *
+ * This function is called when a syntax-error is encountered within
+ * a declarationblock (see parseDeclarationBlock()).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Consumes data from *pInput.
+ *
+ *---------------------------------------------------------------------------
+ */
+static int parseDeclarationError(pInput, pParse)
+ CssInput *pInput;
+ CssParse *pParse;
+{
+ char *zToken;
+ int nToken;
+ CssTokenType eToken;
+
+ int iNest = 0;
+
+ int iErrorStart = 0;
+ int iErrorLength = 0;
+
+ iErrorStart = pInput->iInput;
+ eToken = inputGetToken(pInput, &zToken, &nToken);
+
+ while (
+ eToken != CT_EOF &&
+ (eToken != CT_SEMICOLON || iNest != 0) &&
+ (eToken != CT_RP || iNest > 0)
+ ) {
+ if (eToken == CT_LP) iNest++;
+ if (eToken == CT_RP) iNest--;
+ inputNextToken(pInput);
+ eToken = inputGetToken(pInput, 0, 0);
+ }
+ iErrorLength = pInput->iInput - iErrorStart;
+ inputNextToken(pInput);
+
+ if (pParse->pErrorLog) {
+ Tcl_Obj *pError = pParse->pErrorLog;
+ Tcl_ListObjAppendElement(0, pError, Tcl_NewIntObj(iErrorStart));
+ Tcl_ListObjAppendElement(0, pError, Tcl_NewIntObj(iErrorLength));
+ }
+
+ return ((eToken == CT_SEMICOLON) ? 0: 1);
+}
+
+#define safe_isdigit(c) (isdigit((unsigned char)(c)))
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * parseSelector --
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *---------------------------------------------------------------------------
+ */
+static int parseSelector(pInput, pParse)
+ CssInput *pInput;
+ CssParse *pParse;
+{
+
+ while (1) {
+ const char *zToken;
+ int nToken;
+ CssTokenType eNext;
+ CssTokenType eToken;
+
+ eToken = inputGetToken(pInput, &zToken, &nToken);
+ inputNextToken(pInput);
+ eNext = inputGetToken(pInput, 0, 0);
+
+ switch (eToken) {
+ case CT_STAR: /* Universal selector (section 5.3) */
+ HtmlCssSelector(pParse, CSS_SELECTOR_UNIVERSAL, 0, 0);
+ break;
+
+ case CT_IDENT: { /* Type selector (section 5.4) */
+ CssToken tType;
+ tType.z = zToken;
+ tType.n = nToken;
+ HtmlCssSelector(pParse, CSS_SELECTOR_TYPE, 0, &tType);
+ break;
+ }
+
+ case CT_SPACE: { /* Descendant selector (section 5.5) */
+ /* Three possibilities here:
+ *
+ * (a) white-space between selectors, indicating a
+ * descendant selector (i.e. "H1 P"), or
+ *
+ * (b) white-space before a "+" or ">" selector, or
+ *
+ * (c) white-space before the start of the properties
+ * block (i.e. " {color: red}").
+ *
+ * Ignore the white-space if it is either (b) or (c). Otherwise
+ * add a descendant selector to the parse context.
+ */
+ if (eNext != CT_PLUS && eNext != CT_GT &&
+ eNext != CT_LP && eNext != CT_COMMA
+ ) {
+ HtmlCssSelector(pParse, CSS_SELECTORCHAIN_DESCENDANT, 0, 0);
+ }
+ break;
+ }
+
+ case CT_GT: { /* Child selector (section 5.5) */
+ HtmlCssSelector(pParse, CSS_SELECTORCHAIN_CHILD, 0, 0);
+ /* Ignore any white-space that occurs after a '>' */
+ if (eNext == CT_SPACE) inputNextToken(pInput);
+ break;
+ }
+
+ case CT_COLON: {
+ struct _Pseudo {
+ char *z;
+ int eArg;
+ int twocolonsok;
+ } aPseudo[] = {
+ {"first-child", CSS_PSEUDOCLASS_FIRSTCHILD, 0},
+ {"last-child", CSS_PSEUDOCLASS_LASTCHILD, 0},
+ {"link", CSS_PSEUDOCLASS_LINK, 0},
+ {"visited", CSS_PSEUDOCLASS_VISITED, 0},
+ {"active", CSS_PSEUDOCLASS_ACTIVE, 0},
+ {"hover", CSS_PSEUDOCLASS_HOVER, 0},
+ {"focus", CSS_PSEUDOCLASS_FOCUS, 0},
+ {"lang", CSS_PSEUDOCLASS_LANG, 0},
+
+ {"after", CSS_PSEUDOELEMENT_AFTER, 1},
+ {"before", CSS_PSEUDOELEMENT_BEFORE, 1},
+ {"first-line", CSS_PSEUDOELEMENT_FIRSTLINE, 1},
+ {"first-letter", CSS_PSEUDOELEMENT_FIRSTLETTER, 1},
+ {0, 0}
+ };
+ int ii;
+ int twocolons = 0;
+ if (eNext == CT_COLON) {
+ twocolons = 1;
+ inputNextToken(pInput);
+ eNext = inputGetToken(pInput, 0, 0);
+ }
+ if (eNext != CT_IDENT) goto syntax_error;
+ inputGetToken(pInput, &zToken, &nToken);
+ for (ii = 0; aPseudo[ii].z; ii++) {
+ if (
+ nToken == strlen(aPseudo[ii].z) &&
+ 0 == strncmp(zToken, aPseudo[ii].z, nToken) &&
+ aPseudo[ii].twocolonsok >= twocolons
+ ) break;
+ }
+ if (!aPseudo[ii].z) goto syntax_error;
+
+ if (aPseudo[ii].eArg == CSS_PSEUDOCLASS_LANG){
+ /* TODO: Parse lang(...) */
+ goto syntax_error;
+ } else {
+ HtmlCssSelector(pParse, aPseudo[ii].eArg, 0, 0);
+ }
+ inputNextToken(pInput);
+ break;
+ }
+
+ case CT_PLUS: { /* Child selector (section 5.7) */
+ HtmlCssSelector(pParse, CSS_SELECTORCHAIN_ADJACENT, 0, 0);
+ /* Ignore any white-space that occurs after a '+' */
+ if (eNext == CT_SPACE) inputNextToken(pInput);
+ break;
+ }
+
+ case CT_DOT: { /* Class selector (section 5.8.3) */
+ CssToken t;
+ eToken = inputGetToken(pInput, &t.z, &t.n);
+
+ /* Section 4.1.3 of CSS 2.1 says that class names,
+ * id names and element names may not start with a digit
+ * or a hyphen followed by a digit.
+ */
+ if (eToken != CT_IDENT ||
+ (t.z[0] == '-' && t.n > 1 && safe_isdigit(t.z[1])) ||
+ safe_isdigit(t.z[0])
+ ) {
+ goto syntax_error;
+ }
+ HtmlCssSelector(pParse, CSS_SELECTOR_CLASS, 0, &t);
+ inputNextToken(pInput);
+ break;
+ }
+
+ case CT_HASH: { /* Id selector (section 5.9) */
+ CssToken t;
+ eToken = inputGetToken(pInput, &t.z, &t.n);
+
+ /* Section 4.1.3 of CSS 2.1 says that class names,
+ * id names and element names may not start with a digit
+ * or a hyphen followed by a digit.
+ */
+ if (eToken != CT_IDENT ||
+ (t.z[0] == '-' && t.n > 1 && safe_isdigit(t.z[1])) ||
+ safe_isdigit(t.z[0])
+ ) {
+ goto syntax_error;
+ }
+ HtmlCssSelector(pParse, CSS_SELECTOR_ID, 0, &t);
+ inputNextToken(pInput);
+ break;
+ }
+
+ case CT_LSP: { /* Attribute selector of some kind */
+ CssToken t1;
+ CssToken t2;
+ if (eNext == CT_SPACE) inputNextToken(pInput);
+
+ eToken = inputGetToken(pInput, &t1.z, &t1.n);
+ if (eToken != CT_IDENT) goto syntax_error;
+
+ inputNextToken(pInput);
+ eToken = inputGetToken(pInput, 0, 0);
+ if (eToken == CT_SPACE) {
+ inputNextToken(pInput);
+ eToken = inputGetToken(pInput, 0, 0);
+ }
+
+ if (eToken == CT_RSP) {
+ HtmlCssSelector(pParse, CSS_SELECTOR_ATTR, &t1, 0);
+ } else if (
+ eToken == CT_TILDE ||
+ eToken == CT_PIPE ||
+ eToken == CT_EQUALS
+ ) {
+ if (eToken == CT_TILDE || eToken == CT_PIPE) {
+ CssTokenType e;
+ inputNextToken(pInput);
+ e = inputGetToken(pInput, 0, 0);
+ if (e != CT_EQUALS) goto syntax_error;
+ }
+ inputNextToken(pInput);
+ if (CT_SPACE == inputGetToken(pInput, 0, 0)) {
+ inputNextToken(pInput);
+ }
+ eNext = inputGetToken(pInput, &t2.z, &t2.n);
+ if (eNext != CT_IDENT && eNext != CT_STRING) {
+ goto syntax_error;
+ }
+
+ inputNextToken(pInput);
+ if (CT_SPACE == inputGetToken(pInput, 0, 0)) {
+ inputNextToken(pInput);
+ }
+ eNext = inputGetToken(pInput, 0, 0);
+ if (eNext != CT_RSP) goto syntax_error;
+
+ HtmlCssSelector(pParse, (
+ (eToken == CT_TILDE) ? CSS_SELECTOR_ATTRLISTVALUE :
+ (eToken == CT_PIPE) ? CSS_SELECTOR_ATTRHYPHEN :
+ CSS_SELECTOR_ATTRVALUE) , &t1, &t2
+ );
+ } else {
+ goto syntax_error;
+ }
+ inputNextToken(pInput);
+ break;
+ }
+
+ case CT_COMMA: {
+ if( !pParse->pSelector ){
+ goto syntax_error;
+ }
+ HtmlCssSelectorComma(pParse);
+ if (CT_SPACE == eNext) inputNextToken(pInput);
+ break;
+ }
+
+ case CT_LP: return 0;
+ default: goto syntax_error;
+ }
+ }
+
+ syntax_error:
+ return 1;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * parseDeclarationBlock --
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *---------------------------------------------------------------------------
+ */
+static int parseDeclarationBlock(CssInput *pInput, CssParse *pParse){
+ while (1) {
+ CssToken tProp;
+ CssToken tVal;
+ CssTokenType eToken;
+ int isImportant = 0;
+
+ /* Property name */
+ if (inputGetToken(pInput, 0, 0) == CT_SPACE) inputNextToken(pInput);
+ eToken = inputGetToken(pInput, &tProp.z, &tProp.n);
+ if (eToken == CT_RP) return 0;
+ if (eToken != CT_IDENT) goto syntax_error;
+
+ /* Colon */
+ inputNextTokenIgnoreSpace(pInput);
+ eToken = inputGetToken(pInput, 0, 0);
+ if (eToken != CT_COLON) goto syntax_error;
+
+ /* Property value */
+ inputNextTokenIgnoreSpace(pInput);
+ eToken = inputGetToken(pInput, &tVal.z, 0);
+ tVal.n = 0;
+ while (
+ eToken == CT_IDENT ||
+ eToken == CT_STRING ||
+ eToken == CT_COMMA ||
+ eToken == CT_PLUS ||
+ eToken == CT_FUNCTION ||
+ eToken == CT_HASH ||
+ eToken == CT_SLASH ||
+ eToken == CT_DOT
+ ) {
+ char *z;
+ int n;
+ inputGetToken(pInput, &z, &n);
+ tVal.n = (&z[n] - tVal.z);
+ inputNextTokenIgnoreSpace(pInput);
+ eToken = inputGetToken(pInput, 0, 0);
+ }
+ if (tVal.n == 0) goto syntax_error;
+
+ /* Check for the !IMPORTANT symbol */
+ if (eToken == CT_BANG) {
+ char *z;
+ int n;
+ inputNextTokenIgnoreSpace(pInput);
+ eToken = inputGetToken(pInput, &z, &n);
+ if (n != 9 || 0 != strnicmp("important", z, 9)) {
+ goto syntax_error;
+ }
+ isImportant = 1;
+ inputNextTokenIgnoreSpace(pInput);
+ }
+
+ eToken = inputGetToken(pInput, 0, 0);
+ if (eToken != CT_RP && eToken != CT_SEMICOLON && eToken != CT_EOF) {
+ goto syntax_error;
+ }
+
+ HtmlCssDeclaration(pParse, &tProp, &tVal, isImportant);
+
+ if (eToken == CT_RP || eToken == CT_EOF) return 0;
+ inputNextTokenIgnoreSpace(pInput);
+
+ continue;
+
+ syntax_error:
+ if (parseDeclarationError(pInput, pParse)) return 0;
+ }
+
+ return 1;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * parseMediaList --
+ *
+ * Tkhtml3 uses rules suitable for the following media:
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *---------------------------------------------------------------------------
+ */
+static int parseMediaList(pInput, pIsMatch)
+ CssInput *pInput;
+ int *pIsMatch;
+{
+ int media_ok = 0;
+
+ while (1) {
+ CssTokenType eToken;
+ char * zToken;
+ int nToken;
+ eToken = inputGetToken(pInput, &zToken, &nToken);
+
+ if (eToken != CT_IDENT) return 1;
+ if ((nToken == 3 && strnicmp("all", zToken, nToken) == 0) ||
+ (nToken == 6 && strnicmp("screen", zToken, nToken) == 0)
+ ) {
+ media_ok = 1;
+ }
+
+ inputNextTokenIgnoreSpace(pInput);
+ if (CT_COMMA != inputGetToken(pInput, 0, 0)) break;
+
+ inputNextTokenIgnoreSpace(pInput);
+ }
+
+ *pIsMatch = media_ok;
+ return 0;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * parseAtRule --
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *---------------------------------------------------------------------------
+ */
+static int parseAtRule(CssInput *pInput, CssParse *pParse){
+ char *zWord;
+ int nWord;
+ inputNextToken(pInput);
+
+ /* According to CSS2.1, white-space after the '@' character is illegal */
+ if (CT_IDENT != inputGetToken(pInput, &zWord, &nWord)) return 1;
+
+ if (nWord == 6 && strnicmp("import", zWord, nWord) == 0) {
+ CssTokenType eToken;
+ CssToken tToken;
+ int media_ok = 1;
+
+ /* If we are already into the stylesheet "body", this is a
+ * syntax error
+ */
+ if (pParse->isBody) {
+ return 1;
+ }
+
+ inputNextTokenIgnoreSpace(pInput);
+ eToken = inputGetToken(pInput, &tToken.z, &tToken.n);
+ if (eToken != CT_STRING && eToken != CT_FUNCTION) {
+ return 1;
+ }
+
+ inputNextTokenIgnoreSpace(pInput);
+ eToken = inputGetToken(pInput, 0, 0);
+ if (eToken != CT_SEMICOLON && eToken != CT_EOF) {
+ if (parseMediaList(pInput, &media_ok)) return 1;
+ }
+
+ eToken = inputGetToken(pInput, 0, 0);
+ if (eToken != CT_SEMICOLON && eToken != CT_EOF) return 1;
+
+ if (media_ok) {
+ HtmlCssImport(pParse, &tToken);
+ }
+ }
+
+ else if (nWord == 5 && strnicmp("media", zWord, nWord) == 0) {
+ int media_ok;
+ pParse->isBody = 1;
+ inputNextTokenIgnoreSpace(pInput);
+ if (parseMediaList(pInput, &media_ok)) return 1;
+ if (CT_LP != inputGetToken(pInput, 0, 0)) return 1;
+ inputNextToken(pInput);
+ if (!media_ok) {
+ /* The media does not match. Skip tokens until the end of
+ * the block.
+ */
+ int iNest = 1;
+ while (
+ (inputGetToken(pInput, 0, 0) != CT_EOF) &&
+ (inputGetToken(pInput, 0, 0) != CT_RP || iNest != 1)
+ ) {
+ if (inputGetToken(pInput, 0, 0) == CT_LP) iNest++;
+ if (inputGetToken(pInput, 0, 0) == CT_RP) iNest--;
+ inputNextToken(pInput);
+ }
+ }
+
+ /*
+ }
+ else if (nWord == 4 && strnicmp("page", zWord, nWord) == 0) {
+ */
+ }
+ else if (nWord == 7 && strnicmp("charset", zWord, nWord) == 0) {
+ CssTokenType eNext;
+ do {
+ inputNextTokenIgnoreSpace(pInput);
+ eNext = inputGetToken(pInput, 0, 0);
+ } while (eNext != CT_SEMICOLON && eNext != CT_EOF);
+ } else {
+ pParse->isBody = 1;
+ return 1;
+ }
+
+ return 0;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * HtmlCssRunParser --
+ *
+ * Parse a stylesheet document.
+ *
+ * Calls the following functions from css.c:
+ *
+ * HtmlCssDeclaration
+ * HtmlCssSelectorComma
+ * HtmlCssSelector
+ * HtmlCssImport
+ * HtmlCssRule
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *---------------------------------------------------------------------------
+ */
+void HtmlCssRunParser(zInput, nInput, pParse)
+ const char *zInput;
+ int nInput;
+ CssParse *pParse;
+{
+ int eToken;
+ CssInput sInput;
+ memset(&sInput, 0, sizeof(CssInput));
+ sInput.zInput = (char *)zInput;
+ sInput.nInput = nInput;
+
+ /* This function is the top-level parser. From this functions point
+ * of view, a CSS stylesheet is made up of statements. Each statement
+ * is either an at-rule or a declaration.
+ */
+ while (0 == inputNextTokenIgnoreSpace(&sInput)) {
+ int isSyntaxError;
+
+ eToken = inputGetToken(&sInput, 0, 0);
+
+ if (eToken == CT_SGML_OPEN || eToken == CT_SGML_CLOSE) {
+ isSyntaxError = 0;
+ } else if (eToken == CT_RP) {
+ isSyntaxError = 0;
+ } else if (eToken == CT_AT) {
+ isSyntaxError = parseAtRule(&sInput, pParse);
+ } else {
+ pParse->isBody = 1;
+ isSyntaxError = parseSelector(&sInput, pParse);
+ if (!isSyntaxError) {
+ isSyntaxError = parseDeclarationBlock(&sInput, pParse);
+ }
+ HtmlCssRule(pParse, !isSyntaxError);
+ }
+
+ if (isSyntaxError) {
+ parseSyntaxError(&sInput, pParse, (eToken==CT_AT));
+ }
+ }
+
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * HtmlCssRunStyleParser --
+ *
+ * Parse an inline style declaration.
+ *
+ * Results:
+ * See above.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+void HtmlCssRunStyleParser(zInput, nInput, pParse)
+ const char *zInput;
+ int nInput;
+ CssParse *pParse;
+{
+ CssInput sInput;
+ memset(&sInput, 0, sizeof(CssInput));
+ sInput.zInput = (char *)zInput;
+ sInput.nInput = nInput;
+
+ HtmlCssSelector(pParse, CSS_SELECTOR_UNIVERSAL, 0, 0);
+ parseDeclarationBlock(&sInput, pParse);
+ HtmlCssRule(pParse, 1);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * HtmlCssGetToken --
+ *
+ * Return the id of the next CSS token in the string pointed to by z,
+ * length n. The length of the token is written to *pLen. 0 is returned
+ * if there are no complete tokens remaining.
+ *
+ * Results:
+ * See above.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+CssTokenType HtmlCssGetToken(z, n, pLen)
+ CONST char *z;
+ int n;
+ int *pLen;
+{
+ CssInput sInput;
+ memset(&sInput, 0, sizeof(CssInput));
+ sInput.zInput = (char *)z;
+ sInput.nInput = n;
+
+ inputNextToken(&sInput);
+ *pLen = sInput.iInput;
+ return sInput.eToken;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * HtmlCssGetNextListItem --
+ *
+ * Return the first property from a space seperated list of properties.
+ *
+ * The property list is stored in string zList, length nList.
+ *
+ * A pointer to the first property is returned. The length of the first
+ * property is stored in *pN.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+const char *
+HtmlCssGetNextListItem(zList, nList, pN)
+ const char *zList;
+ int nList;
+ int *pN;
+{
+ char *zRet;
+ int eToken;
+ int eFirst;
+ int nLen = 0;
+
+ CssInput sInput;
+
+ memset(&sInput, 0, sizeof(CssInput));
+ sInput.zInput = (char *)zList;
+ sInput.nInput = nList;
+
+ inputNextTokenIgnoreSpace(&sInput);
+ eFirst = inputGetToken(&sInput, &zRet, &nLen);
+ *pN = nLen;
+ if (eFirst == CT_EOF) {
+ return 0;
+ }
+ if (eFirst == CT_STRING || eFirst == CT_FUNCTION) {
+ return zRet;
+ }
+
+ nLen = 0;
+ do {
+ int n;
+ inputGetToken(&sInput, 0, &n);
+ nLen += n;
+ inputNextToken(&sInput);
+ eToken = inputGetToken(&sInput, 0, 0);
+ } while (eToken != CT_SPACE && eToken != CT_EOF);
+
+ *pN = nLen;
+ assert(nLen <= nList);
+ return zRet;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * HtmlCssGetNextListItem --
+ *
+ * Return the next item in a comma seperated list of properties.
+ *
+ * The property list is stored in string zList, length nList.
+ *
+ * A pointer to the first property is returned. The length of the first
+ * property is stored in *pN.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+const char *
+HtmlCssGetNextCommaListItem(zList, nList, pN)
+ const char *zList;
+ int nList;
+ int *pN;
+{
+ char *zRet;
+ int eToken;
+ int nLen = 0;
+
+ CssInput sInput;
+
+ if (nList < 0) nList = strlen(zList);
+
+ memset(&sInput, 0, sizeof(CssInput));
+ sInput.zInput = (char *)zList;
+ sInput.nInput = nList;
+
+ inputNextTokenIgnoreSpace(&sInput);
+ if (inputGetToken(&sInput, 0, 0) == CT_EOF) {
+ *pN = 0;
+ return 0;
+ }
+ if (inputGetToken(&sInput, &zRet, 0) == CT_COMMA) {
+ inputNextTokenIgnoreSpace(&sInput);
+ inputGetToken(&sInput, &zRet, 0);
+ }
+
+ do {
+ int n;
+ inputGetToken(&sInput, 0, &n);
+ nLen += n;
+ inputNextTokenIgnoreSpace(&sInput);
+ eToken = inputGetToken(&sInput, 0, 0);
+ } while (eToken != CT_COMMA && eToken != CT_EOF);
+
+ *pN = nLen;
+ return zRet;
+}
+
diff --git a/src/cssprop.tcl b/src/cssprop.tcl
index 62a340c..2e956f7 100644
--- a/src/cssprop.tcl
+++ b/src/cssprop.tcl
@@ -83,7 +83,8 @@ E font-variant normal small-caps
E list-style-position outside inside
E list-style-type disc square circle none
E list-style-type decimal lower-alpha upper-alpha lower-roman
-E list-style-type upper-roman
+E list-style-type upper-roman decimal-leading-zero lower-latin
+E list-style-type upper-latin lower-greek armenian georgian
E overflow visible auto hidden scroll
E outline-style none hidden dotted dashed solid
E outline-style double groove ridge outset inset
@@ -110,6 +111,7 @@ C normal italic oblique
C black silver gray white maroon red purple aqua
C fuchsia green lime olive yellow navy blue teal
C transparent
+C -tkhtml-no-color
P azimuth background-attachment background-color background-image
P background-repeat border-collapse border-spacing
@@ -132,6 +134,8 @@ P top unicode-bidi vertical-align visibility voice-family volume white-space
P widows width word-spacing z-index
P -tkhtml-replacement-image
+P -tkhtml-ordered-list-start
+P -tkhtml-ordered-list-value
S background border border-top border-right border-bottom border-left
S border-color border-style border-width cue font padding outline margin
diff --git a/src/csssearch.c b/src/csssearch.c
index 079b395..cfd5e13 100644
--- a/src/csssearch.c
+++ b/src/csssearch.c
@@ -2,7 +2,7 @@
#include "html.h"
#include "cssInt.h"
-static const char rcsid[] = "$Id: csssearch.c,v 1.5 2007/07/16 15:35:49 danielk1977 Exp $";
+static const char rcsid[] = "$Id: csssearch.c,v 1.7 2007/10/27 08:37:50 hkoba Exp $";
/*-----------------------------------------------------------------------
*
@@ -100,8 +100,10 @@ HtmlCssSearchInvalidateCache(pTree)
while ((pEntry = Tcl_FirstHashEntry(p, &sSearch))) {
CssCachedSearch *pCache = (CssCachedSearch *)Tcl_GetHashValue(pEntry);
- HtmlFree(pCache->apNode);
- HtmlFree(pCache);
+ if (pCache) {
+ HtmlFree(pCache->apNode);
+ HtmlFree(pCache);
+ }
Tcl_DeleteHashEntry(pEntry);
}
@@ -236,7 +238,7 @@ HtmlCssSearch(clientData, interp, objc, objv)
CssSearch sSearch;
assert(n == strlen(zOrig));
- n += 14;
+ n += 11;
z = (char *)HtmlAlloc("temp", n);
sprintf(z, "%s {width:0}", zOrig);
HtmlCssSelectorParse(pTree, n, z, &pStyle);
diff --git a/src/html.css b/src/html.css
index 2690320..bdbdd4e 100644
--- a/src/html.css
+++ b/src/html.css
@@ -142,6 +142,8 @@ OL { list-style-type: decimal }
OL UL, UL OL,
UL UL, OL OL { margin-top: 0; margin-bottom: 0 }
U, INS { text-decoration: underline }
+BR:before { content: "\A" ; white-space: pre }
+/* :before, :after { white-space: pre-line } */
ABBR, ACRONYM { font-variant: small-caps; letter-spacing: 0.1em }
/* Formatting for <pre> etc. */
@@ -160,11 +162,6 @@ PRE, PLAINTEXT, XMP {
TD[nowrap] , TH[nowrap] { white-space: nowrap; }
TD[nowrap="0"] , TH[nowrap="0"] { white-space: normal; }
-BR {
- display: block;
-}
-/* BR:before { content: "\A" } */
-
/*
* Default decorations for form items.
*/
@@ -183,7 +180,7 @@ INPUT[type="image"][src] { -tkhtml-replacement-image: attr(src) }
/*
* Default style for buttons created using <input> elements.
*/
-INPUT[type="submit"],INPUT[type="button"] {
+INPUT[type="submit"],INPUT[type="button"],button {
display: -tkhtml-inline-button;
border: 2px solid;
border-color: #ffffff #828282 #828282 #ffffff;
@@ -199,7 +196,9 @@ INPUT[type="submit"]:after,INPUT[type="button"]:after {
position: relative;
}
-INPUT[type="submit"]:hover:active,INPUT[type="button"]:hover:active {
+INPUT[type="submit"]:hover:active,
+INPUT[type="button"]:hover:active,
+button:hover:active {
border-top-color: tcl(::tkhtml::if_disabled #ffffff #828282);
border-left-color: tcl(::tkhtml::if_disabled #ffffff #828282);
border-right-color: tcl(::tkhtml::if_disabled #828282 #ffffff);
@@ -220,7 +219,7 @@ BUTTON {
TEXTAREA[cols] { width: tcl(::tkhtml::textarea_width) }
TEXTAREA[rows] { height: tcl(::tkhtml::textarea_height) }
TEXTAREA {
- font-family: fixed;
+ font-family: monospace;
}
FRAMESET {
@@ -337,6 +336,9 @@ BODY[marginwidth] {
margin-right: attr(marginwidth l);
}
+OL[start] { -tkhtml-ordered-list-start: attr(start); }
+LI[value] { -tkhtml-ordered-list-value: attr(value); }
+
SPAN[spancontent]:after {
content: attr(spancontent);
}
diff --git a/src/html.h b/src/html.h
index fcd9a88..c8e82bc 100644
--- a/src/html.h
+++ b/src/html.h
@@ -292,9 +292,13 @@ struct HtmlTaggedRegion {
* node is carried by the derived classes HtmlTextNode and HtmlElementNode.
*/
struct HtmlNode {
- Html_u8 eTag; /* Tag type */
+ ClientData clientData;
HtmlNode *pParent; /* Parent of this node */
int iNode; /* Node index */
+
+ Html_u8 eTag; /* Tag type (or 0) */
+ const char *zTag; /* Atom string for tag type */
+
int iSnapshot; /* Last changed snapshot */
HtmlNodeCmd *pNodeCmd; /* Tcl command for this node */
@@ -408,12 +412,15 @@ struct HtmlOptions {
int forcewidth;
Tcl_Obj *imagecmd;
int imagecache;
+ int imagepixmapify;
int mode; /* One of the HTML_MODE_XXX values */
int shrink; /* Boolean */
- int xhtml; /* Boolean. True -> parse as XHTML */
double zoom; /* Universal scaling factor. */
+ int parsemode; /* One of the HTML_PARSEMODE values */
+
/* Debugging options. Not part of the official interface. */
+ int enablelayout;
int layoutcache;
Tcl_Obj *logcmd;
Tcl_Obj *timercmd;
@@ -423,6 +430,10 @@ struct HtmlOptions {
#define HTML_MODE_ALMOST 1
#define HTML_MODE_STANDARDS 2
+#define HTML_PARSEMODE_HTML 0
+#define HTML_PARSEMODE_XHTML 1
+#define HTML_PARSEMODE_XML 2
+
void HtmlLog(HtmlTree *, CONST char *, CONST char *, ...);
void HtmlTimer(HtmlTree *, CONST char *, CONST char *, ...);
@@ -556,6 +567,8 @@ struct HtmlTree {
HtmlNode *pRoot; /* The root-node of the document. */
+ Tcl_HashTable aAtom; /* String atoms for this widget */
+
HtmlTreeState state;
/* Sub-trees that are not currently linked into the tree rooted at
@@ -572,7 +585,7 @@ struct HtmlTree {
*/
HtmlFragmentContext *pFragment;
- int nFixedBackground; /* Number of nodes with fixed backgrounds */
+ int isFixed; /* True if any "fixed" graphics */
/*
* Handler callbacks configured by the [$widget handler] command.
@@ -593,6 +606,9 @@ struct HtmlTree {
CssStyleSheet *pStyle; /* Style sheet configuration */
+ /* Used by code in HtmlStyleApply() */
+ void *pStyleApply;
+
HtmlOptions options; /* Configurable options */
Tk_OptionTable optionTable; /* Option table */
@@ -619,6 +635,7 @@ struct HtmlTree {
HtmlFontCache fontcache;
Tcl_HashTable aValues;
Tcl_HashTable aFontFamilies;
+ Tcl_HashTable aCounterLists;
HtmlComputedValuesCreator *pPrototypeCreator;
int aFontSizeTable[7];
@@ -685,9 +702,11 @@ Tcl_ObjCmdProc HtmlLayoutPrimitives;
Tcl_ObjCmdProc HtmlCssStyleConfigDump;
Tcl_ObjCmdProc Rt_AllocCommand;
Tcl_ObjCmdProc HtmlWidgetBboxCmd;
+Tcl_ObjCmdProc HtmlImageServerReport;
Tcl_ObjCmdProc HtmlDebug;
Tcl_ObjCmdProc HtmlDecode;
+Tcl_ObjCmdProc HtmlEncode;
Tcl_ObjCmdProc HtmlEscapeUriComponent;
Tcl_ObjCmdProc HtmlResolveUri;
Tcl_ObjCmdProc HtmlCreateUri;
@@ -695,10 +714,14 @@ Tcl_ObjCmdProc HtmlCreateUri;
char *HtmlPropertyToString(CssProperty *, char **);
int HtmlStyleApply(HtmlTree *, HtmlNode *);
+int HtmlStyleCounter(HtmlTree *, const char *);
+int HtmlStyleCounters(HtmlTree *, const char *, int *, int);
+void HtmlStyleHandleCounters(HtmlTree *, HtmlComputedValues *);
int HtmlLayout(HtmlTree *);
+void HtmlLayoutMarkerBox(int, int, int, char *);
-int HtmlStyleParse(HtmlTree*, Tcl_Interp*, Tcl_Obj*,Tcl_Obj*,Tcl_Obj*,Tcl_Obj*);
+int HtmlStyleParse(HtmlTree*, Tcl_Obj*, Tcl_Obj*, Tcl_Obj*, Tcl_Obj*, Tcl_Obj*);
void HtmlTokenizerAppend(HtmlTree *, const char *, int, int);
int HtmlNameToType(void *, char *);
Html_u8 HtmlMarkupFlags(int);
@@ -722,7 +745,7 @@ char * HtmlNodeToString(HtmlNode *);
HtmlNode * HtmlNodeGetPointer(HtmlTree *, char CONST *);
int HtmlNodeIsOrphan(HtmlNode *);
-int HtmlNodeAddChild(HtmlElementNode *, int, HtmlAttributes *);
+int HtmlNodeAddChild(HtmlElementNode *, int, const char *, HtmlAttributes *);
int HtmlNodeAddTextChild(HtmlNode *, HtmlTextNode *);
Html_u8 HtmlNodeTagType(HtmlNode *);
@@ -771,6 +794,7 @@ void HtmlDrawCanvasItemReference(HtmlCanvasItem *);
void HtmlWidgetDamageText(HtmlTree *, HtmlNode *, int, HtmlNode *, int);
int HtmlWidgetNodeTop(HtmlTree *, HtmlNode *);
+void HtmlWidgetOverflowBox(HtmlTree *, HtmlNode *, int *, int *, int *, int *);
HtmlTokenMap *HtmlMarkup(int);
CONST char * HtmlMarkupName(int);
@@ -803,15 +827,18 @@ void HtmlImageServerInit(HtmlTree *);
void HtmlImageServerShutdown(HtmlTree *);
HtmlImage2 *HtmlImageServerGet(HtmlImageServer *, const char *);
HtmlImage2 *HtmlImageScale(HtmlImage2 *, int *, int *, int);
+void HtmlImageSize(HtmlImage2 *, int *, int *);
Tcl_Obj *HtmlImageUnscaledName(HtmlImage2 *);
Tk_Image HtmlImageImage(HtmlImage2 *);
-Tk_Image HtmlImageTile(HtmlImage2 *);
+Tk_Image HtmlImageTile(HtmlImage2 *, int*, int *);
+Pixmap HtmlImageTilePixmap(HtmlImage2 *, int*, int *);
+Pixmap HtmlImagePixmap(HtmlImage2 *);
void HtmlImageFree(HtmlImage2 *);
void HtmlImageRef(HtmlImage2 *);
const char *HtmlImageUrl(HtmlImage2 *);
void HtmlImageCheck(HtmlImage2 *);
Tcl_Obj *HtmlXImageToImage(HtmlTree *, XImage *, int, int);
-int HtmlImageAlphaChannel(HtmlTree *, HtmlImage2 *);
+int HtmlImageAlphaChannel(HtmlImage2 *);
void HtmlImageServerSuspendGC(HtmlTree *);
void HtmlImageServerDoGC(HtmlTree *);
@@ -864,8 +891,8 @@ void HtmlFontRelease(HtmlTree *, HtmlFont *);
/* HTML Tokenizer function. */
int HtmlTokenize(HtmlTree *, char const *, int,
void (*)(HtmlTree *, HtmlTextNode *, int),
- void (*)(HtmlTree *, int, HtmlAttributes *, int),
- void (*)(HtmlTree *, int, int)
+ void (*)(HtmlTree *, int, const char *, HtmlAttributes *, int),
+ void (*)(HtmlTree *, int, const char *, int)
);
/* The following three HtmlTreeAddXXX() functions - defined in htmltree.c -
@@ -881,21 +908,24 @@ int HtmlTokenize(HtmlTree *, char const *, int,
*
* These are also in htmltree.c but are not defined with external linkage.
*/
-void HtmlTreeAddElement(HtmlTree *, int, HtmlAttributes *, int);
+void HtmlTreeAddElement(HtmlTree *, int, const char *, HtmlAttributes *, int);
void HtmlTreeAddText(HtmlTree *, HtmlTextNode *, int);
-void HtmlTreeAddClosingTag(HtmlTree *, int, int);
+void HtmlTreeAddClosingTag(HtmlTree *, int, const char *, int);
void HtmlInitTree(HtmlTree *);
+void HtmlHashInit(void *, int);
+HtmlTokenMap * HtmlHashLookup(void *, const char *zType);
/*******************************************************************
* Interface to code in htmltext.c
*******************************************************************/
/*
- * Creation and deletion of HtmlTextNode objects.
+ * Creation, modification and deletion of HtmlTextNode objects.
*/
HtmlTextNode * HtmlTextNew(int, const char *, int, int);
+void HtmlTextSet(HtmlTextNode *, int, const char *, int, int);
void HtmlTextFree(HtmlTextNode *);
/* The details of this structure should be considered private to
@@ -926,6 +956,7 @@ struct HtmlTextIter {
void HtmlTextIterFirst(HtmlTextNode *, HtmlTextIter *);
void HtmlTextIterNext(HtmlTextIter *);
int HtmlTextIterIsValid(HtmlTextIter *);
+int HtmlTextIterIsLast(HtmlTextIter *);
/*
* Query functions to discover the token type, length and data.
@@ -983,5 +1014,8 @@ void HtmlInstrumentInit(Tcl_Interp *);
void HtmlInstrumentCall(ClientData, int, void(*)(ClientData), ClientData);
void *HtmlInstrumentCall2(ClientData, int, void*(*)(ClientData), ClientData);
+/* htmltagdb.c */
+const char *HtmlTypeToName(void *, int);
+
#endif
diff --git a/src/htmlPs.c b/src/htmlPs.c
new file mode 100644
index 0000000..5e71c59
--- /dev/null
+++ b/src/htmlPs.c
@@ -0,0 +1,1844 @@
+#if TKHTML_PS
+#define TCL_INTEGER_SPACE 24
+
+/*
+ * So blatently ripped off from canvas, most comments are unchanged.
+ * Peter MacDonald. http://browsex.com
+ *
+ * tkCanvPs.c --
+ *
+ * This module provides Postscript output support for canvases,
+ * including the "postscript" widget command plus a few utility
+ * procedures used for generating Postscript.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: htmlPs.c,v 1.8 2005/03/23 01:36:54 danielk1977 Exp $
+ */
+
+#include "tkInt.h"
+#include "tkCanvas.h"
+#include "tkPort.h"
+#include <tcl.h>
+#include <tk.h>
+
+/*
+ * See tkCanvas.h for key data structures used to implement canvases.
+ */
+
+/*
+ * One of the following structures is created to keep track of Postscript
+ * output being generated. It consists mostly of information provided on
+ * the widget command line.
+ */
+
+typedef struct TkPostscriptInfo {
+ int x, y, width, height; /* Area to print, in canvas pixel
+ * coordinates. */
+ int x2, y2; /* x+width and y+height. */
+ char *pageXString; /* String value of "-pagex" option or
+ * NULL. */
+ char *pageYString; /* String value of "-pagey" option or
+ * NULL. */
+ double pageX, pageY; /* Postscript coordinates (in points)
+ * corresponding to pageXString and
+ * pageYString. Don't forget that
+ * y-values grow upwards for
+ * Postscript! */
+ char *pageWidthString; /* Printed width of output. */
+ char *pageHeightString; /* Printed height of output. */
+ double scale; /* Scale factor for conversion: each
+ * pixel maps into this many points. */
+ Tk_Anchor pageAnchor; /* How to anchor bbox on Postscript
+ * page. */
+ int rotate; /* Non-zero means output should be
+ * rotated on page (landscape mode). */
+ char *fontVar; /* If non-NULL, gives name of global
+ * variable containing font mapping
+ * information. Malloc'ed. */
+ char *colorVar; /* If non-NULL, give name of global
+ * variable containing color mapping
+ * information. Malloc'ed. */
+ char *colorMode; /* Mode for handling colors:
+ * "monochrome", "gray", or "color".
+ * Malloc'ed. */
+ int colorLevel; /* Numeric value corresponding to
+ * colorMode: 0 for mono, 1 for gray,
+ * 2 for color. */
+ char *fileName; /* Name of file in which to write
+ * Postscript; NULL means return
+ * Postscript info as result.
+ * Malloc'ed. */
+ char *channelName; /* If -channel is specified, the name
+ * of the channel to use. */
+ Tcl_Channel chan; /* Open channel corresponding to
+ * fileName. */
+ Tcl_HashTable fontTable; /* Hash table containing names of all
+ * font families used in output. The
+ * hash table values are not used. */
+ int prepass; /* Non-zero means that we're currently
+ * in the pre-pass that collects font
+ * information, so the Postscript
+ * generated isn't relevant. */
+ int prolog; /* Non-zero means output should
+ * contain the file prolog.ps in the
+ * header. */
+ int noimages;
+} TkPostscriptInfo;
+
+#include "html.h"
+static void HtmlPsOutText(Tcl_Interp * interp, HtmlBlock * pBlock);
+
+double
+Html_PostscriptY(double y, TkPostscriptInfo * psinfo)
+{
+ double ret = (((double) (psinfo->y2)) - y);
+ return ret;
+}
+
+#define dHtml_PostscriptY(y,psinfo) (((double)((psinfo)->y2))-y)
+
+/*
+ * The table below provides a template that's used to process arguments
+ * to the canvas "postscript" command and fill in TkPostscriptInfo
+ * structures.
+ */
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_STRING, "-colormap", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, colorVar), 0},
+ {TK_CONFIG_STRING, "-colormode", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, colorMode), 0},
+ {TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, fileName), 0},
+ {TK_CONFIG_STRING, "-channel", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, channelName), 0},
+ {TK_CONFIG_STRING, "-fontmap", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, fontVar), 0},
+ {TK_CONFIG_PIXELS, "-height", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, height), 0},
+ {TK_CONFIG_ANCHOR, "-pageanchor", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, pageAnchor), 0},
+ {TK_CONFIG_STRING, "-pageheight", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, pageHeightString), 0},
+ {TK_CONFIG_STRING, "-pagewidth", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, pageWidthString), 0},
+ {TK_CONFIG_STRING, "-pagex", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, pageXString), 0},
+ {TK_CONFIG_STRING, "-pagey", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, pageYString), 0},
+ {TK_CONFIG_BOOLEAN, "-prolog", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, prolog), 0},
+ {TK_CONFIG_BOOLEAN, "-noimages", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, noimages), 0},
+ {TK_CONFIG_BOOLEAN, "-rotate", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, rotate), 0},
+ {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, width), 0},
+ {TK_CONFIG_PIXELS, "-x", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, x), 0},
+ {TK_CONFIG_PIXELS, "-y", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, y), 0},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * The prolog data. Generated by str2c from prolog.ps
+ * This was split in small chunks by str2c because
+ * some C compiler have limitations on the size of static strings.
+ * (str2c is a small tcl script in tcl's tool directory (source release))
+ */
+static CONST char *CONST prolog[] = {
+ /*
+ * Start of part 1 (2000 characters)
+ */
+ "%%BeginProlog\n\
+50 dict begin\n\
+\n\
+% This is a standard prolog for Postscript generated by Tk's canvas\n\
+% widget.\n\
+% RCS: @(#) $Id: htmlPs.c,v 1.8 2005/03/23 01:36:54 danielk1977 Exp $\n\
+\n\
+% The definitions below just define all of the variables used in\n\
+% any of the procedures here. This is needed for obscure reasons\n\
+% explained on p. 716 of the Postscript manual (Section H.2.7,\n\
+% \"Initializing Variables,\" in the section on Encapsulated Postscript).\n\
+\n\
+/baseline 0 def\n\
+/stipimage 0 def\n\
+/height 0 def\n\
+/justify 0 def\n\
+/lineLength 0 def\n\
+/spacing 0 def\n\
+/stipple 0 def\n\
+/strings 0 def\n\
+/xoffset 0 def\n\
+/yoffset 0 def\n\
+/tmpstip null def\n\
+\n\
+% Define the array ISOLatin1Encoding (which specifies how characters are\n\
+% encoded for ISO-8859-1 fonts), if it isn't already present (Postscript\n\
+% level 2 is supposed to define it, but level 1 doesn't).\n\
+\n\
+systemdict /ISOLatin1Encoding known not {\n\
+ /ISOLatin1Encoding [\n\
+ /space /space /space /space /space /space /space /space\n\
+ /space /space /space /space /space /space /space /space\n\
+ /space /space /space /space /space /space /space /space\n\
+ /space /space /space /space /space /space /space /space\n\
+ /space /exclam /quotedbl /numbersign /dollar /percent /ampersand\n\
+ /quoteright\n\
+ /parenleft /parenright /asterisk /plus /comma /minus /period /slash\n\
+ /zero /one /two /three /four /five /six /seven\n\
+ /eight /nine /colon /semicolon /less /equal /greater /question\n\
+ /at /A /B /C /D /E /F /G\n\
+ /H /I /J /K /L /M /N /O\n\
+ /P /Q /R /S /T /U /V /W\n\
+ /X /Y /Z /bracketleft /backslash /bracketright /asciicircum /underscore\n\
+ /quoteleft /a /b /c /d /e /f /g\n\
+ /h /i /j /k /l /m /n /o\n\
+ /p /q /r /s /t /u /v /w\n\
+ /x /y /z /braceleft /bar /braceright /asciitilde /space\n\
+ /space /space /space /space /space /space /space /space\n\
+ /space /space /space /space /space /space /space /space\n\
+ /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent\n\
+ /dieresis /space /ring /cedilla /space /hungarumlaut /ogonek /caron\n\
+ /space /exclamdown /cent /sterling /currency /yen /brokenbar /section\n\
+ /dieresis /copyright /ordfem",
+ /*
+ * End of part 1
+ */
+
+ /*
+ * Start of part 2 (2000 characters)
+ */
+ "inine /guillemotleft /logicalnot /hyphen\n\
+ /registered /macron\n\
+ /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph\n\
+ /periodcentered\n\
+ /cedillar /onesuperior /ordmasculine /guillemotright /onequarter\n\
+ /onehalf /threequarters /questiondown\n\
+ /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla\n\
+ /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex\n\
+ /Idieresis\n\
+ /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply\n\
+ /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn\n\
+ /germandbls\n\
+ /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla\n\
+ /egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex\n\
+ /idieresis\n\
+ /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide\n\
+ /oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn\n\
+ /ydieresis\n\
+ ] def\n\
+} if\n\
+\n\
+% font ISOEncode font\n\
+% This procedure changes the encoding of a font from the default\n\
+% Postscript encoding to ISOLatin1. It's typically invoked just\n\
+% before invoking \"setfont\". The body of this procedure comes from\n\
+% Section 5.6.1 of the Postscript book.\n\
+\n\
+/ISOEncode {\n\
+ dup length dict begin\n\
+ {1 index /FID ne {def} {pop pop} ifelse} forall\n\
+ /Encoding ISOLatin1Encoding def\n\
+ currentdict\n\
+ end\n\
+\n\
+ % I'm not sure why it's necessary to use \"definefont\" on this new\n\
+ % font, but it seems to be important; just use the name \"Temporary\"\n\
+ % for the font.\n\
+\n\
+ /Temporary exch definefont\n\
+} bind def\n\
+\n\
+% StrokeClip\n\
+%\n\
+% This procedure converts the current path into a clip area under\n\
+% the assumption of stroking. It's a bit tricky because some Postscript\n\
+% interpreters get errors during strokepath for dashed lines. If\n\
+% this happens then turn off dashes and try again.\n\
+\n\
+/StrokeClip {\n\
+ {strokepath} stopped {\n\
+ (This Postscript printer gets limitcheck overflows when) =\n\
+ (stippling dashed lines; lines will be printed solid instead.) =\n\
+ [] 0 setdash strokepath} if\n\
+ clip\n\
+} bind def\n\
+\n\
+% d",
+ /*
+ * End of part 2
+ */
+
+ /*
+ * Start of part 3 (2000 characters)
+ */
+ "esiredSize EvenPixels closestSize\n\
+%\n\
+% The procedure below is used for stippling. Given the optimal size\n\
+% of a dot in a stipple pattern in the current user coordinate system,\n\
+% compute the closest size that is an exact multiple of the device's\n\
+% pixel size. This allows stipple patterns to be displayed without\n\
+% aliasing effects.\n\
+\n\
+/EvenPixels {\n\
+ % Compute exact number of device pixels per stipple dot.\n\
+ dup 0 matrix currentmatrix dtransform\n\
+ dup mul exch dup mul add sqrt\n\
+\n\
+ % Round to an integer, make sure the number is at least 1, and compute\n\
+ % user coord distance corresponding to this.\n\
+ dup round dup 1 lt {pop 1} if\n\
+ exch div mul\n\
+} bind def\n\
+\n\
+% width height string StippleFill --\n\
+%\n\
+% Given a path already set up and a clipping region generated from\n\
+% it, this procedure will fill the clipping region with a stipple\n\
+% pattern. \"String\" contains a proper image description of the\n\
+% stipple pattern and \"width\" and \"height\" give its dimensions. Each\n\
+% stipple dot is assumed to be about one unit across in the current\n\
+% user coordinate system. This procedure trashes the graphics state.\n\
+\n\
+/StippleFill {\n\
+ % The following code is needed to work around a NeWSprint bug.\n\
+\n\
+ /tmpstip 1 index def\n\
+\n\
+ % Change the scaling so that one user unit in user coordinates\n\
+ % corresponds to the size of one stipple dot.\n\
+ 1 EvenPixels dup scale\n\
+\n\
+ % Compute the bounding box occupied by the path (which is now\n\
+ % the clipping region), and round the lower coordinates down\n\
+ % to the nearest starting point for the stipple pattern. Be\n\
+ % careful about negative numbers, since the rounding works\n\
+ % differently on them.\n\
+\n\
+ pathbbox\n\
+ 4 2 roll\n\
+ 5 index div dup 0 lt {1 sub} if cvi 5 index mul 4 1 roll\n\
+ 6 index div dup 0 lt {1 sub} if cvi 6 index mul 3 2 roll\n\
+\n\
+ % Stack now: width height string y1 y2 x1 x2\n\
+ % Below is a doubly-nested for loop to iterate across this area\n\
+ % in units of the stipple pattern size, going up columns then\n\
+ % acr",
+ /*
+ * End of part 3
+ */
+
+ /*
+ * Start of part 4 (2000 characters)
+ */
+ "oss rows, blasting out a stipple-pattern-sized rectangle at\n\
+ % each position\n\
+\n\
+ 6 index exch {\n\
+ 2 index 5 index 3 index {\n\
+ % Stack now: width height string y1 y2 x y\n\
+\n\
+ gsave\n\
+ 1 index exch translate\n\
+ 5 index 5 index true matrix tmpstip imagemask\n\
+ grestore\n\
+ } for\n\
+ pop\n\
+ } for\n\
+ pop pop pop pop pop\n\
+} bind def\n\
+\n\
+% -- AdjustColor --\n\
+% Given a color value already set for output by the caller, adjusts\n\
+% that value to a grayscale or mono value if requested by the CL\n\
+% variable.\n\
+\n\
+/AdjustColor {\n\
+ CL 2 lt {\n\
+ currentgray\n\
+ CL 0 eq {\n\
+ .5 lt {0} {1} ifelse\n\
+ } if\n\
+ setgray\n\
+ } if\n\
+} bind def\n\
+\n\
+% x y strings spacing xoffset yoffset justify stipple DrawText --\n\
+% This procedure does all of the real work of drawing text. The\n\
+% color and font must already have been set by the caller, and the\n\
+% following arguments must be on the stack:\n\
+%\n\
+% x, y - Coordinates at which to draw text.\n\
+% strings - An array of strings, one for each line of the text item,\n\
+% in order from top to bottom.\n\
+% spacing - Spacing between lines.\n\
+% xoffset - Horizontal offset for text bbox relative to x and y: 0 for\n\
+% nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se.\n\
+% yoffset - Vertical offset for text bbox relative to x and y: 0 for\n\
+% nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se.\n\
+% justify - 0 for left justification, 0.5 for center, 1 for right justify.\n\
+% stipple - Boolean value indicating whether or not text is to be\n\
+% drawn in stippled fashion. If text is stippled,\n\
+% procedure StippleText must have been defined to call\n\
+% StippleFill in the right way.\n\
+%\n\
+% Also, when this procedure is invoked, the color and font must already\n\
+% have been set for the text.\n\
+\n\
+/DrawText {\n\
+ /stipple exch def\n\
+ /justify exch def\n\
+ /yoffset exch def\n\
+ /xoffset exch def\n\
+ /spacing exch def\n\
+ /strings exch def\n\
+\n\
+ % First scan through all of the text to find the widest line.\n\
+\n\
+ /lineLength 0 def\n\
+ strings {\n\
+ stringwidth pop\n\
+ dup lineLength gt {/lineLength exch def}",
+ /*
+ * End of part 4
+ */
+
+ /*
+ * Start of part 5 (1546 characters)
+ */
+ " {pop} ifelse\n\
+ newpath\n\
+ } forall\n\
+\n\
+ % Compute the baseline offset and the actual font height.\n\
+\n\
+ 0 0 moveto (TXygqPZ) false charpath\n\
+ pathbbox dup /baseline exch def\n\
+ exch pop exch sub /height exch def pop\n\
+ newpath\n\
+\n\
+ % Translate coordinates first so that the origin is at the upper-left\n\
+ % corner of the text's bounding box. Remember that x and y for\n\
+ % positioning are still on the stack.\n\
+\n\
+ translate\n\
+ lineLength xoffset mul\n\
+ strings length 1 sub spacing mul height add yoffset mul translate\n\
+\n\
+ % Now use the baseline and justification information to translate so\n\
+ % that the origin is at the baseline and positioning point for the\n\
+ % first line of text.\n\
+\n\
+ justify lineLength mul baseline neg translate\n\
+\n\
+ % Iterate over each of the lines to output it. For each line,\n\
+ % compute its width again so it can be properly justified, then\n\
+ % display it.\n\
+\n\
+ strings {\n\
+ dup stringwidth pop\n\
+ justify neg mul 0 moveto\n\
+ stipple {\n\
+\n\
+ % The text is stippled, so turn it into a path and print\n\
+ % by calling StippledText, which in turn calls StippleFill.\n\
+ % Unfortunately, many Postscript interpreters will get\n\
+ % overflow errors if we try to do the whole string at\n\
+ % once, so do it a character at a time.\n\
+\n\
+ gsave\n\
+ /char (X) def\n\
+ {\n\
+ char 0 3 -1 roll put\n\
+ currentpoint\n\
+ gsave\n\
+ char true charpath clip StippleText\n\
+ grestore\n\
+ char stringwidth translate\n\
+ moveto\n\
+ } forall\n\
+ grestore\n\
+ } {show} ifelse\n\
+ 0 spacing neg translate\n\
+ } forall\n\
+} bind def\n\
+\n\
+%%EndProlog\n\
+",
+ /*
+ * End of part 5
+ */
+
+ NULL /* End of data marker */
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int GetPostscriptPoints _ANSI_ARGS_((Tcl_Interp * interp,
+ char *string, double *doublePtr));
+int
+ HtmlTk_PostscriptImage(Tk_Image image, Tcl_Interp * interp, Tk_Window tkwin,
+ TkPostscriptInfo * psinfo, int x, int y, int width,
+ int height, int prepass);
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkCanvPostscriptCmd --
+ *
+ * This procedure is invoked to process the "postscript" options
+ * of the widget command for canvas widgets. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /*
+ * ARGSUSED
+ */
+int
+HtmlPostscript(HtmlWidget * htmlPtr, Tcl_Interp * interp, int argc, char **argv)
+{
+ int mpg = 1;
+ TkPostscriptInfo psInfo;
+
+/* Tk_PostscriptInfo oldInfoPtr; */
+ int result;
+#define STRING_LENGTH 400
+ char string[STRING_LENGTH + 1], *p;
+ time_t now;
+ size_t length;
+ Tk_Window tkwin = htmlPtr->tkwin;
+ int deltaX = 0, deltaY = 0; /* Offset of lower-left corner of area
+ * to be marked up, measured in canvas
+ * units from the positioning point on
+ * the page (reflects anchor
+ * position). Initial values needed
+ * only to stop compiler warnings. */
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+ Tcl_DString buffer;
+ CONST char *CONST * chunk;
+ HtmlBlock *pB;
+
+ /*
+ *----------------------------------------------------------------
+ * Initialize the data structure describing Postscript generation,
+ * then process all the arguments to fill the data structure in.
+ *----------------------------------------------------------------
+ */
+
+/* oldInfoPtr = canvasPtr->psInfo;
+ canvasPtr->psInfo = (Tk_PostscriptInfo) &psInfo; */
+ psInfo.x = 0;
+ psInfo.y = 0;
+ psInfo.width = -1;
+ psInfo.height = -1;
+ psInfo.pageXString = NULL;
+ psInfo.pageYString = NULL;
+ psInfo.pageX = 72 * 4.25;
+ psInfo.pageY = 72 * 5.5;
+ psInfo.pageWidthString = NULL;
+ psInfo.pageHeightString = NULL;
+ psInfo.scale = 1.0;
+ psInfo.pageAnchor = TK_ANCHOR_CENTER;
+ psInfo.rotate = 0;
+ psInfo.fontVar = NULL;
+ psInfo.colorVar = NULL;
+ psInfo.colorMode = NULL;
+ psInfo.colorLevel = 0;
+ psInfo.fileName = NULL;
+ psInfo.channelName = NULL;
+ psInfo.chan = NULL;
+ psInfo.prepass = 0;
+ psInfo.prolog = 1;
+ Tcl_InitHashTable(&psInfo.fontTable, TCL_STRING_KEYS);
+ result = Tk_ConfigureWidget(interp, tkwin,
+ configSpecs, argc - 2, argv + 2,
+ (char *) &psInfo, TK_CONFIG_ARGV_ONLY);
+ if (result != TCL_OK) {
+ goto cleanup;
+ }
+
+ if (psInfo.width == -1) {
+
+/* psInfo.width = Tk_Width(tkwin); */
+ psInfo.width = htmlPtr->maxX;
+ }
+ if (psInfo.height == -1) {
+ double dheight;
+ psInfo.height = 72 * 11;
+ if (psInfo.pageHeightString != NULL) {
+ if (GetPostscriptPoints(interp, psInfo.pageHeightString,
+ &dheight) != TCL_OK) {
+ goto cleanup;
+ }
+ psInfo.height = (int) dheight;
+ }
+
+/* psInfo.height = htmlPtr->maxY; */
+
+/* psInfo.height = Tk_Height(tkwin); */
+ }
+ psInfo.x2 = psInfo.x + psInfo.width;
+ psInfo.y2 = psInfo.y + psInfo.height;
+
+ if (psInfo.pageXString != NULL) {
+ if (GetPostscriptPoints(interp, psInfo.pageXString,
+ &psInfo.pageX) != TCL_OK) {
+ goto cleanup;
+ }
+ }
+ if (psInfo.pageYString != NULL) {
+ if (GetPostscriptPoints(interp, psInfo.pageYString,
+ &psInfo.pageY) != TCL_OK) {
+ goto cleanup;
+ }
+ }
+ if (psInfo.pageWidthString != NULL) {
+ if (GetPostscriptPoints(interp, psInfo.pageWidthString,
+ &psInfo.scale) != TCL_OK) {
+ goto cleanup;
+ }
+ psInfo.scale /= psInfo.width;
+ }
+ else if (psInfo.pageHeightString != NULL) {
+ if (GetPostscriptPoints(interp, psInfo.pageHeightString,
+ &psInfo.scale) != TCL_OK) {
+ goto cleanup;
+ }
+ psInfo.scale /= psInfo.height;
+ }
+ else {
+ psInfo.scale = (72.0 / 25.4) * WidthMMOfScreen(Tk_Screen(tkwin));
+ psInfo.scale /= WidthOfScreen(Tk_Screen(tkwin));
+ }
+ switch (psInfo.pageAnchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_SW:
+ deltaX = 0;
+ break;
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_CENTER:
+ case TK_ANCHOR_S:
+ deltaX = -psInfo.width / 2;
+ break;
+ case TK_ANCHOR_NE:
+ case TK_ANCHOR_E:
+ case TK_ANCHOR_SE:
+ deltaX = -psInfo.width;
+ break;
+ }
+ switch (psInfo.pageAnchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_NE:
+ deltaY = -psInfo.height;
+ break;
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_CENTER:
+ case TK_ANCHOR_E:
+ deltaY = -psInfo.height / 2;
+ break;
+ case TK_ANCHOR_SW:
+ case TK_ANCHOR_S:
+ case TK_ANCHOR_SE:
+ deltaY = 0;
+ break;
+ }
+
+ if (psInfo.colorMode == NULL) {
+ psInfo.colorLevel = 2;
+ }
+ else {
+ length = strlen(psInfo.colorMode);
+ if (strncmp(psInfo.colorMode, "monochrome", length) == 0) {
+ psInfo.colorLevel = 0;
+ }
+ else if (strncmp(psInfo.colorMode, "gray", length) == 0) {
+ psInfo.colorLevel = 1;
+ }
+ else if (strncmp(psInfo.colorMode, "color", length) == 0) {
+ psInfo.colorLevel = 2;
+ }
+ else {
+ Tcl_AppendResult(interp, "bad color mode \"",
+ psInfo.colorMode, "\": must be monochrome, ",
+ "gray, or color", (char *) NULL);
+ goto cleanup;
+ }
+ }
+
+ if (psInfo.fileName != NULL) {
+
+ /*
+ * Check that -file and -channel are not both specified.
+ */
+
+ if (psInfo.channelName != NULL) {
+ Tcl_AppendResult(interp, "can't specify both -file",
+ " and -channel", (char *) NULL);
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+
+ /*
+ * Check that we are not in a safe interpreter. If we are, disallow
+ * the -file specification.
+ */
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_AppendResult(interp, "can't specify -file in a",
+ " safe interpreter", (char *) NULL);
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+
+ p = Tcl_TranslateFileName(interp, psInfo.fileName, &buffer);
+ if (p == NULL) {
+ goto cleanup;
+ }
+ psInfo.chan = Tcl_OpenFileChannel(interp, p, "w", 0666);
+ Tcl_DStringFree(&buffer);
+ if (psInfo.chan == NULL) {
+ goto cleanup;
+ }
+ }
+
+ if (psInfo.channelName != NULL) {
+ int mode;
+
+ /*
+ * Check that the channel is found in this interpreter and that it
+ * is open for writing.
+ */
+
+ psInfo.chan = Tcl_GetChannel(interp, psInfo.channelName, &mode);
+ if (psInfo.chan == (Tcl_Channel) NULL) {
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+ if ((mode & TCL_WRITABLE) == 0) {
+ Tcl_AppendResult(interp, "channel \"",
+ psInfo.channelName, "\" wasn't opened for writing",
+ (char *) NULL);
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+ }
+
+ /*
+ *--------------------------------------------------------
+ * Make a pre-pass over all of the items, generating Postscript
+ * and then throwing it away. The purpose of this pass is just
+ * to collect information about all the fonts in use, so that
+ * we can output font information in the proper form required
+ * by the Document Structuring Conventions.
+ *--------------------------------------------------------
+ */
+
+ psInfo.prepass = 1;
+
+ for (pB = htmlPtr->firstBlock; pB; pB = pB->pNext) {
+ HtmlElement *pElem;
+ if ((pB->left >= psInfo.x2) || (pB->right < psInfo.x)
+ || (pB->bottom >= psInfo.y2) || (pB->bottom < psInfo.y)) {
+ continue;
+ }
+ result = HtmlPostscriptProc(interp, htmlPtr, pB, 1, &psInfo);
+ Tcl_ResetResult(interp);
+ if (result != TCL_OK) {
+ /*
+ * An error just occurred. Just skip out of this loop.
+ * There's no need to report the error now; it can be
+ * reported later (errors can happen later that don't
+ * happen now, so we still have to check for errors later
+ * anyway).
+ */
+ break;
+ }
+ }
+ psInfo.prepass = 0;
+
+ /*
+ *--------------------------------------------------------
+ * Generate the header and prolog for the Postscript.
+ *--------------------------------------------------------
+ */
+
+ if (psInfo.prolog) {
+ Tcl_AppendResult(interp, "%!PS-Adobe-3.0 EPSF-3.0\n",
+ "%%Creator: Tk Canvas Widget\n", (char *) NULL);
+#ifdef HAVE_PW_GECOS
+ if (!Tcl_IsSafe(interp)) {
+ struct passwd *pwPtr = getpwuid(getuid()); /* INTL: Native. */
+ Tcl_AppendResult(interp, "%%For: ",
+ (pwPtr != NULL) ? pwPtr->pw_gecos : "Unknown",
+ "\n", (char *) NULL);
+ endpwent();
+ }
+#endif /* HAVE_PW_GECOS */
+ Tcl_AppendResult(interp, "%%Title: Window ",
+ Tk_PathName(tkwin), "\n", (char *) NULL);
+ time(&now);
+ Tcl_AppendResult(interp, "%%CreationDate: ", ctime(&now), (char *) NULL); /* INTL:
+ * Native.
+ */
+ if (!psInfo.rotate) {
+ sprintf(string, "%d %d %d %d",
+ (int) (psInfo.pageX + psInfo.scale * deltaX),
+ (int) (psInfo.pageY + psInfo.scale * deltaY),
+ (int) (psInfo.pageX + psInfo.scale * (deltaX + psInfo.width)
+ + 1.0),
+ (int) (psInfo.pageY +
+ psInfo.scale * (deltaY + psInfo.height)
+ + 1.0));
+ }
+ else {
+ sprintf(string, "%d %d %d %d",
+ (int) (psInfo.pageX -
+ psInfo.scale * (deltaY + psInfo.height)),
+ (int) (psInfo.pageY + psInfo.scale * deltaX),
+ (int) (psInfo.pageX - psInfo.scale * deltaY + 1.0),
+ (int) (psInfo.pageY + psInfo.scale * (deltaX + psInfo.width)
+ + 1.0));
+ }
+ Tcl_AppendResult(interp, "%%BoundingBox: ", string,
+ "\n", (char *) NULL);
+ sprintf(string, "%%%%Pages: 1\n %%%%DocumentData: Clean7Bit\n",
+ htmlPtr->maxY / psInfo.height + 1);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ Tcl_AppendResult(interp, "%%Orientation: ",
+ psInfo.rotate ? "Landscape\n" : "Portrait\n",
+ (char *) NULL);
+ p = "%%DocumentNeededResources: font ";
+ for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_AppendResult(interp, p,
+ Tcl_GetHashKey(&psInfo.fontTable, hPtr),
+ "\n", (char *) NULL);
+ p = "%%+ font ";
+ }
+ Tcl_AppendResult(interp, "%%EndComments\n\n", (char *) NULL);
+
+ /*
+ * Insert the prolog
+ */
+ for (chunk = prolog; *chunk; chunk++) {
+ Tcl_AppendResult(interp, *chunk, (char *) NULL);
+ }
+
+ if (psInfo.chan != NULL) {
+ Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1);
+ Tcl_ResetResult(htmlPtr->interp);
+ }
+ /*
+ *-----------------------------------------------------------
+ * Document setup: set the color level and include fonts.
+ *-----------------------------------------------------------
+ */
+
+ sprintf(string, "/CL %d def\n", psInfo.colorLevel);
+ Tcl_AppendResult(interp, "%%BeginSetup\n", string, (char *) NULL);
+ for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_AppendResult(interp, "%%IncludeResource: font ",
+ Tcl_GetHashKey(&psInfo.fontTable, hPtr), "\n",
+ (char *) NULL);
+ }
+ Tcl_AppendResult(interp, "%%EndSetup\n\n", (char *) NULL);
+
+ /*
+ *-----------------------------------------------------------
+ * Page setup: move to page positioning point, rotate if
+ * needed, set scale factor, offset for proper anchor position,
+ * and set clip region.
+ *-----------------------------------------------------------
+ */
+
+ Tcl_AppendResult(interp, "%%Page: 1 1\n", "save\n", (char *) NULL);
+ sprintf(string, "%.1f %.1f translate\n", psInfo.pageX, psInfo.pageY);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ if (psInfo.rotate) {
+ Tcl_AppendResult(interp, "90 rotate\n", (char *) NULL);
+ }
+ sprintf(string, "%.4g %.4g scale\n", psInfo.scale, psInfo.scale);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ sprintf(string, "%d %d translate\n", deltaX - psInfo.x, deltaY);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ sprintf(string,
+ "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g",
+ psInfo.x, Html_PostscriptY((double) psInfo.y, &psInfo),
+ psInfo.x2, Html_PostscriptY((double) psInfo.y, &psInfo),
+ psInfo.x2, Html_PostscriptY((double) psInfo.y2, &psInfo),
+ psInfo.x, Html_PostscriptY((double) psInfo.y2, &psInfo));
+ Tcl_AppendResult(interp, string, " lineto closepath clip newpath\n",
+ (char *) NULL);
+ }
+ if (psInfo.chan != NULL) {
+ Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1);
+ Tcl_ResetResult(htmlPtr->interp);
+ }
+
+ /*
+ *---------------------------------------------------------------------
+ * Iterate through all the items, having each relevant one draw itself.
+ * Quit if any of the items returns an error.
+ *---------------------------------------------------------------------
+ */
+
+ result = TCL_OK;
+ while (1) {
+ char *nxtpage = "showpage\n%%%%Page: %d %d\n%%%%BeginPageSetup"
+ "/pagelevel save def\n54 0 translate\n%%%%EndPageSetup"
+ "newpath 0 72 moveto 504 0 rlineto 0 648 rlineto -504 0 rlineto closepath clip newpath\n";
+
+ for (pB = htmlPtr->firstBlock; pB; pB = pB->pNext) {
+
+ HtmlElement *pElem;
+ if ((pB->left >= psInfo.x2) || (pB->right < psInfo.x)
+ || (pB->bottom >= psInfo.y2) || (pB->bottom < psInfo.y)) {
+ continue;
+ }
+ Tcl_AppendResult(htmlPtr->interp, "gsave\n", (char *) NULL);
+ result = HtmlPostscriptProc(interp, htmlPtr, pB, 0, &psInfo);
+ if (result != TCL_OK) {
+ char msg[64 + TCL_INTEGER_SPACE];
+
+ sprintf(msg, "\n (generating Postscript for item)");
+ Tcl_AddErrorInfo(interp, msg);
+ goto cleanup;
+ }
+ Tcl_AppendResult(interp, "grestore\n", (char *) NULL);
+ if (psInfo.chan != NULL) {
+ Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1);
+ Tcl_ResetResult(interp);
+ }
+ }
+ if (psInfo.y2 < htmlPtr->maxY) {
+ psInfo.y += psInfo.height;
+ psInfo.y2 += psInfo.height;
+ mpg++;
+ sprintf(string, nxtpage, mpg, mpg);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ }
+ else
+ break;
+ }
+
+ /*
+ *---------------------------------------------------------------------
+ * Output page-end information, such as commands to print the page
+ * and document trailer stuff.
+ *---------------------------------------------------------------------
+ */
+
+ if (psInfo.prolog) {
+ Tcl_AppendResult(interp, "restore showpage\n\n",
+ "%%Trailer\nend\n%%EOF\n", (char *) NULL);
+ }
+ if (psInfo.chan != NULL) {
+ Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1);
+ Tcl_ResetResult(htmlPtr->interp);
+ }
+
+ /*
+ * Clean up psInfo to release malloc'ed stuff.
+ */
+
+ cleanup:
+ if (psInfo.pageXString != NULL) {
+ HtmlFree(psInfo.pageXString);
+ }
+ if (psInfo.pageYString != NULL) {
+ HtmlFree(psInfo.pageYString);
+ }
+ if (psInfo.pageWidthString != NULL) {
+ HtmlFree(psInfo.pageWidthString);
+ }
+ if (psInfo.pageHeightString != NULL) {
+ HtmlFree(psInfo.pageHeightString);
+ }
+ if (psInfo.fontVar != NULL) {
+ HtmlFree(psInfo.fontVar);
+ }
+ if (psInfo.colorVar != NULL) {
+ HtmlFree(psInfo.colorVar);
+ }
+ if (psInfo.colorMode != NULL) {
+ HtmlFree(psInfo.colorMode);
+ }
+ if (psInfo.fileName != NULL) {
+ HtmlFree(psInfo.fileName);
+ }
+ if ((psInfo.chan != NULL) && (psInfo.channelName == NULL)) {
+ Tcl_Close(interp, psInfo.chan);
+ }
+ if (psInfo.channelName != NULL) {
+ HtmlFree(psInfo.channelName);
+ }
+ Tcl_DeleteHashTable(&psInfo.fontTable);
+
+/* canvasPtr->psInfo = (Tk_PostscriptInfo) oldInfoPtr; */
+ return result;
+}
+
+/* The rest of these just in here cause they are static in Tk. */
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetPostscriptPoints --
+ *
+ * Given a string, returns the number of Postscript points
+ * corresponding to that string.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If
+ * TCL_OK is returned, then everything went well and the
+ * screen distance is stored at *doublePtr; otherwise
+ * TCL_ERROR is returned and an error message is left in
+ * the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+GetPostscriptPoints(Tcl_Interp * interp, /* Use this for error
+ * reporting. */
+ char *string, /* String describing a screen
+ * distance. */
+ double *doublePtr)
+{ /* Place to store converted result. */
+ char *end;
+ double d;
+
+ d = strtod(string, &end);
+ if (end == string) {
+ error:
+ Tcl_AppendResult(interp, "bad distance \"", string,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ switch (*end) {
+ case 'c':
+ d *= 72.0 / 2.54;
+ end++;
+ break;
+ case 'i':
+ d *= 72.0;
+ end++;
+ break;
+ case 'm':
+ d *= 72.0 / 25.4;
+ end++;
+ break;
+ case 0:
+ break;
+ case 'p':
+ end++;
+ break;
+ default:
+ goto error;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ if (*end != 0) {
+ goto error;
+ }
+ *doublePtr = d;
+ return TCL_OK;
+}
+
+static int
+Html_PostscriptFont(Tcl_Interp * interp, TkPostscriptInfo * psInfo, /* Postscript
+ * Info.
+ */
+ Tk_Font tkfont)
+{ /* Information about font in which text * is
+ * to be printed. */
+ TkPostscriptInfo *psInfoPtr = psInfo;
+ char *end;
+ char pointString[TCL_INTEGER_SPACE];
+ Tcl_DString ds;
+ int i, points;
+
+ /*
+ * First, look up the font's name in the font map, if there is one.
+ * If there is an entry for this font, it consists of a list
+ * containing font name and size. Use this information.
+ */
+
+ Tcl_DStringInit(&ds);
+
+ if (psInfoPtr->fontVar != NULL) {
+ char *list, **argv;
+ int argc;
+ double size;
+ char *name;
+
+ name = Tk_NameOfFont(tkfont);
+ list = Tcl_GetVar2(interp, psInfoPtr->fontVar, name, 0);
+ if (list != NULL) {
+ if (Tcl_SplitList(interp, list, &argc, &argv) != TCL_OK) {
+ badMapEntry:
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad font map entry for \"", name,
+ "\": \"", list, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argc != 2) {
+ goto badMapEntry;
+ }
+ size = strtod(argv[1], &end);
+ if ((size <= 0) || (*end != 0)) {
+ goto badMapEntry;
+ }
+
+ Tcl_DStringAppend(&ds, argv[0], -1);
+ points = (int) size;
+
+ HtmlFree((char *) argv);
+ goto findfont;
+ }
+ }
+
+ points = Tk_PostscriptFontName(tkfont, &ds);
+ findfont:
+ sprintf(pointString, "%d", points);
+ Tcl_AppendResult(interp, "/", Tcl_DStringValue(&ds), " findfont ",
+ pointString, " scalefont ", (char *) NULL);
+ if (strncasecmp(Tcl_DStringValue(&ds), "Symbol", 7) != 0) {
+ Tcl_AppendResult(interp, "ISOEncode ", (char *) NULL);
+ }
+ Tcl_AppendResult(interp, "setfont\n", (char *) NULL);
+ Tcl_CreateHashEntry(&psInfoPtr->fontTable, Tcl_DStringValue(&ds), &i);
+ Tcl_DStringFree(&ds);
+
+ return TCL_OK;
+}
+
+static int
+Html_PostscriptBitmap(Tcl_Interp * interp, Tk_Window tkwin, TkPostscriptInfo * psInfo, /* Postscript
+ * info.
+ */
+ Pixmap bitmap, /* Bitmap for which to generate
+ * Postscript. */
+ int startX, int startY, /* Coordinates of upper-left
+ * corner * of rectangular
+ * region to output. */
+ int width, int height)
+{ /* Height of rectangular region. */
+ TkPostscriptInfo *psInfoPtr = psInfo;
+ XImage *imagePtr;
+ int charsInLine, x, y, lastX, lastY, value, mask;
+ unsigned int totalWidth, totalHeight;
+ char string[100];
+ Window dummyRoot;
+ int dummyX, dummyY;
+ unsigned dummyBorderwidth, dummyDepth;
+
+ if (psInfoPtr->prepass) {
+ return TCL_OK;
+ }
+
+ /*
+ * The following call should probably be a call to Tk_SizeOfBitmap
+ * instead, but it seems that we are occasionally invoked by custom
+ * item types that create their own bitmaps without registering them
+ * with Tk. XGetGeometry is a bit slower than Tk_SizeOfBitmap, but
+ * it shouldn't matter here.
+ */
+
+ XGetGeometry(Tk_Display(tkwin), bitmap, &dummyRoot,
+ (int *) &dummyX, (int *) &dummyY, (unsigned int *) &totalWidth,
+ (unsigned int *) &totalHeight, &dummyBorderwidth, &dummyDepth);
+ imagePtr = XGetImage(Tk_Display(tkwin), bitmap, 0, 0,
+ totalWidth, totalHeight, 1, XYPixmap);
+ Tcl_AppendResult(interp, "<", (char *) NULL);
+ mask = 0x80;
+ value = 0;
+ charsInLine = 0;
+ lastX = startX + width - 1;
+ lastY = startY + height - 1;
+ for (y = lastY; y >= startY; y--) {
+ for (x = startX; x <= lastX; x++) {
+ if (XGetPixel(imagePtr, x, y)) {
+ value |= mask;
+ }
+ mask >>= 1;
+ if (mask == 0) {
+ sprintf(string, "%02x", value);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ mask = 0x80;
+ value = 0;
+ charsInLine += 2;
+ if (charsInLine >= 60) {
+ Tcl_AppendResult(interp, "\n", (char *) NULL);
+ charsInLine = 0;
+ }
+ }
+ }
+ if (mask != 0x80) {
+ sprintf(string, "%02x", value);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ mask = 0x80;
+ value = 0;
+ charsInLine += 2;
+ }
+ }
+ Tcl_AppendResult(interp, ">", (char *) NULL);
+ XDestroyImage(imagePtr);
+ return TCL_OK;
+}
+
+int
+Html_PostscriptColor(Tcl_Interp * interp, TkPostscriptInfo * psInfo, /* Postscript
+ * info.
+ */
+ XColor * colorPtr)
+{ /* Information about color. */
+ TkPostscriptInfo *psInfoPtr = psInfo;
+ int tmp;
+ double red, green, blue;
+ char string[200];
+
+ if (psInfoPtr->prepass) {
+ return TCL_OK;
+ }
+
+ /*
+ * If there is a color map defined, then look up the color's name
+ * in the map and use the Postscript commands found there, if there
+ * are any.
+ */
+
+ if (psInfoPtr->colorVar != NULL) {
+ char *cmdString;
+
+ cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar,
+ Tk_NameOfColor(colorPtr), 0);
+ if (cmdString != NULL) {
+ Tcl_AppendResult(interp, cmdString, "\n", (char *) NULL);
+ return TCL_OK;
+ }
+ }
+
+ /*
+ * No color map entry for this color. Grab the color's intensities
+ * and output Postscript commands for them. Special note: X uses
+ * a range of 0-65535 for intensities, but most displays only use
+ * a range of 0-255, which maps to (0, 256, 512, ... 65280) in the
+ * X scale. This means that there's no way to get perfect white,
+ * since the highest intensity is only 65280 out of 65535. To
+ * work around this problem, rescale the X intensity to a 0-255
+ * scale and use that as the basis for the Postscript colors. This
+ * scheme still won't work if the display only uses 4 bits per color,
+ * but most diplays use at least 8 bits.
+ */
+
+ tmp = colorPtr->red;
+ red = ((double) (tmp >> 8)) / 255.0;
+ tmp = colorPtr->green;
+ green = ((double) (tmp >> 8)) / 255.0;
+ tmp = colorPtr->blue;
+ blue = ((double) (tmp >> 8)) / 255.0;
+ sprintf(string, "%.3f %.3f %.3f setrgbcolor AdjustColor\n",
+ red, green, blue);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ return TCL_OK;
+}
+
+static int
+Html_PostscriptStipple(Tcl_Interp * interp, Tk_Window tkwin, TkPostscriptInfo * psInfo, /* Interpreter
+ * for
+ * returning
+ * Postscript
+ * or error
+ * message. */
+ Pixmap bitmap)
+{ /* Bitmap to use for stippling. */
+ TkPostscriptInfo *psInfoPtr = psInfo;
+ int width, height;
+ char string[TCL_INTEGER_SPACE * 2];
+ Window dummyRoot;
+ int dummyX, dummyY;
+ unsigned dummyBorderwidth, dummyDepth;
+
+ if (psInfoPtr->prepass) {
+ return TCL_OK;
+ }
+
+ /*
+ * The following call should probably be a call to Tk_SizeOfBitmap
+ * instead, but it seems that we are occasionally invoked by custom
+ * item types that create their own bitmaps without registering them
+ * with Tk. XGetGeometry is a bit slower than Tk_SizeOfBitmap, but
+ * it shouldn't matter here.
+ */
+
+ XGetGeometry(Tk_Display(tkwin), bitmap, &dummyRoot,
+ (int *) &dummyX, (int *) &dummyY, (unsigned *) &width,
+ (unsigned *) &height, &dummyBorderwidth, &dummyDepth);
+ sprintf(string, "%d %d ", width, height);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ if (Html_PostscriptBitmap(interp, tkwin, psInfo, bitmap, 0, 0,
+ width, height) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_AppendResult(interp, " StippleFill\n", (char *) NULL);
+ return TCL_OK;
+}
+
+static int
+TextToPostscript(Tcl_Interp * interp, /* Leave Postscript or error message
+ * here. */
+ HtmlWidget * htmlPtr, HtmlBlock * pB, int prepass, /* 1
+ * means
+ * this
+ * is
+ * a
+ * prepass
+ * to
+ * collect
+ */
+ TkPostscriptInfo * psInfo)
+{ /* font information; 0 means final Postscript */
+ /*
+ * is being created.
+ */
+ HtmlElement *pElem = pB->base.pNext;
+ /*
+ * TextItem *textPtr = (TextItem *) itemPtr;
+ */
+ int x, y;
+ Tk_FontMetrics fm;
+ char *justify;
+ char buffer[500];
+ XColor *color;
+ Pixmap stipple;
+ Tk_Font tkfont;
+ color = htmlPtr->apColor[pElem->base.style.color];
+
+/* stipple = textPtr->stipple; */
+ stipple = None;
+ if (color == NULL || pElem->text.zText[0] == 0)
+ return TCL_OK;
+
+ tkfont = HtmlGetFont(htmlPtr, pElem->base.style.font);
+ if (Html_PostscriptFont(interp, psInfo, tkfont) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (prepass != 0) {
+ return TCL_OK;
+ }
+ if (Html_PostscriptColor(interp, psInfo, color) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (stipple != None) {
+ Tcl_AppendResult(interp, "/StippleText {\n ", (char *) NULL);
+ Html_PostscriptStipple(interp, htmlPtr->tkwin, psInfo, stipple);
+ Tcl_AppendResult(interp, "} bind def\n", (char *) NULL);
+ }
+
+ sprintf(buffer, "%.15g %.15g [\n", (double) pB->left,
+ Html_PostscriptY((double) pB->top, psInfo));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+
+/* Tk_TextLayoutToPostscript(interp, textPtr->textLayout); */
+ HtmlPsOutText(interp, pB);
+
+ x = 0;
+ y = 0;
+ justify = "0"; /* lint. */
+
+/* switch (textPtr->anchor) {
+ case TK_ANCHOR_NW: x = 0; y = 0; break;
+ case TK_ANCHOR_N: x = 1; y = 0; break;
+ case TK_ANCHOR_NE: x = 2; y = 0; break;
+ case TK_ANCHOR_E: x = 2; y = 1; break;
+ case TK_ANCHOR_SE: x = 2; y = 2; break;
+ case TK_ANCHOR_S: x = 1; y = 2; break;
+ case TK_ANCHOR_SW: x = 0; y = 2; break;
+ case TK_ANCHOR_W: x = 0; y = 1; break;
+ case TK_ANCHOR_CENTER: x = 1; y = 1; break;
+ }
+ switch (textPtr->justify) {
+ case TK_JUSTIFY_LEFT: justify = "0"; break;
+ case TK_JUSTIFY_CENTER: justify = "0.5";break;
+ case TK_JUSTIFY_RIGHT: justify = "1"; break;
+ } */
+
+ Tk_GetFontMetrics(tkfont, &fm);
+ sprintf(buffer, "] %d %g %g %s %s DrawText\n",
+ fm.linespace, x / -2.0, y / 2.0, justify,
+ ((stipple == None) ? "false" : "true"));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+
+ return TCL_OK;
+}
+
+static void
+HtmlPsOutText(Tcl_Interp * interp, HtmlBlock * pBlock)
+{
+#define MAXUSE 128
+ char buf[MAXUSE + 10];
+#ifdef NEWTK
+ Tcl_UniChar ch;
+#else
+ int ch;
+#endif
+ char *p;
+ int j, len, used = 0, c;
+
+ if (!pBlock->z)
+ return;
+ if (!pBlock->n)
+ return;
+ len = pBlock->n;
+ p = pBlock->z;
+ buf[used++] = '(';
+ for (j = 0; j < len; j++) {
+ /*
+ * INTL: For now we just treat the characters as binary
+ * data and display the lower byte. Eventually this should
+ * be revised to handle international postscript fonts.
+ */
+
+#ifdef NEWTK
+ p += Tcl_UtfToUniChar(p, &ch);
+#else
+ ch = *p++;
+#endif
+ c = UCHAR(ch & 0xff);
+ if ((c == '(') || (c == ')') || (c == '\\') || (c < 0x20)
+ || (c >= UCHAR(0x7f))) {
+ /*
+ * Tricky point: the "03" is necessary in the sprintf
+ * below, so that a full three digits of octal are
+ * always generated. Without the "03", a number
+ * following this sequence could be interpreted by
+ * Postscript as part of this sequence.
+ */
+
+ sprintf(buf + used, "\\%03o", c);
+ used += 4;
+ }
+ else {
+ buf[used++] = c;
+ }
+ if (used >= MAXUSE) {
+ buf[used] = '\0';
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+ used = 0;
+ }
+ }
+ buf[used++] = ')';
+ buf[used++] = '\n';
+ buf[used] = '\0';
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+}
+
+int
+HtmlPostscriptProc(Tcl_Interp * interp, HtmlWidget * htmlPtr,
+ HtmlBlock * pB, int prepass, TkPostscriptInfo * psInfo)
+{
+ HtmlElement *pe;
+ if (pB->base.style.flags & STY_Invisible) {
+ return TCL_OK;
+ }
+ pe = pB->base.pNext;
+ switch (pe->base.type) {
+ case Html_TEXTAREA:
+ break;
+ case Html_INPUT:
+ /*
+ * Config(pe->input.tkwin);
+ */
+ break;
+ case Html_SELECT:
+ break;
+ case Html_Text:
+ if (pB->n > 0)
+ return TextToPostscript(interp, htmlPtr, pB, prepass, psInfo);
+ break;
+ case Html_IMG:
+ if (psInfo->noimages)
+ break;
+ return HtmlTk_PostscriptImage(pe->image.pImage->image, interp,
+ htmlPtr->tkwin, psInfo,
+ pe->image.x, pe->image.y, pe->image.w,
+ pe->image.h, prepass);
+ break;
+ }
+ return TCL_OK;
+}
+
+static void
+TkImageGetColor(TkColormapData * cdata, /* Colormap data */
+ unsigned long pixel, /* Pixel value to look up */
+ double *red, double *green, double *blue)
+{ /* Color data to return */
+ if (cdata->separated) {
+ int r = (pixel & cdata->red_mask) >> cdata->red_shift;
+ int g = (pixel & cdata->green_mask) >> cdata->green_shift;
+ int b = (pixel & cdata->blue_mask) >> cdata->blue_shift;
+ *red = cdata->colors[r].red / 65535.0;
+ *green = cdata->colors[g].green / 65535.0;
+ *blue = cdata->colors[b].blue / 65535.0;
+ }
+ else {
+ *red = cdata->colors[pixel].red / 65535.0;
+ *green = cdata->colors[pixel].green / 65535.0;
+ *blue = cdata->colors[pixel].blue / 65535.0;
+ }
+}
+
+static int
+HtmlTkPostscriptImage(Tcl_Interp * interp, Tk_Window tkwin, TkPostscriptInfo * psInfo, /* postscript
+ * info
+ */
+ XImage * ximage, /* Image to draw */
+ int x, int y, /* First pixel to output */
+ int width, int height)
+{ /* Width and height of area */
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
+ char buffer[256];
+ int xx, yy, band, maxRows;
+ double red, green, blue;
+ int bytesPerLine = 0, maxWidth = 0;
+ int level = psInfoPtr->colorLevel;
+ Colormap cmap;
+ int i, depth, ncolors;
+ Visual *visual;
+ TkColormapData cdata;
+
+ if (psInfoPtr->prepass) {
+ return TCL_OK;
+ }
+
+ cmap = Tk_Colormap(tkwin);
+ depth = Tk_Depth(tkwin);
+ visual = Tk_Visual(tkwin);
+
+ /*
+ * Obtain information about the colormap, ie the mapping between
+ * pixel values and RGB values. The code below should work
+ * for all Visual types.
+ */
+
+ ncolors = visual->map_entries;
+ cdata.colors = (XColor *) HtmlAlloc(sizeof(XColor) * ncolors);
+ cdata.ncolors = ncolors;
+
+ if (visual->class == DirectColor || visual->class == TrueColor) {
+ cdata.separated = 1;
+ cdata.red_mask = visual->red_mask;
+ cdata.green_mask = visual->green_mask;
+ cdata.blue_mask = visual->blue_mask;
+ cdata.red_shift = 0;
+ cdata.green_shift = 0;
+ cdata.blue_shift = 0;
+ while ((0x0001 & (cdata.red_mask >> cdata.red_shift)) == 0)
+ cdata.red_shift++;
+ while ((0x0001 & (cdata.green_mask >> cdata.green_shift)) == 0)
+ cdata.green_shift++;
+ while ((0x0001 & (cdata.blue_mask >> cdata.blue_shift)) == 0)
+ cdata.blue_shift++;
+ for (i = 0; i < ncolors; i++)
+ cdata.colors[i].pixel =
+ ((i << cdata.red_shift) & cdata.red_mask) |
+ ((i << cdata.green_shift) & cdata.green_mask) |
+ ((i << cdata.blue_shift) & cdata.blue_mask);
+ }
+ else {
+ cdata.separated = 0;
+ for (i = 0; i < ncolors; i++)
+ cdata.colors[i].pixel = i;
+ }
+ if (visual->class == StaticGray || visual->class == GrayScale)
+ cdata.color = 0;
+ else
+ cdata.color = 1;
+
+ XQueryColors(Tk_Display(tkwin), cmap, cdata.colors, ncolors);
+
+ /*
+ * Figure out which color level to use (possibly lower than the
+ * one specified by the user). For example, if the user specifies
+ * color with monochrome screen, use gray or monochrome mode instead.
+ */
+
+ if (!cdata.color && level == 2) {
+ level = 1;
+ }
+
+ if (!cdata.color && cdata.ncolors == 2) {
+ level = 0;
+ }
+
+ /*
+ * Check that at least one row of the image can be represented
+ * with a string less than 64 KB long (this is a limit in the
+ * Postscript interpreter).
+ */
+
+ switch (level) {
+ case 0:
+ bytesPerLine = (width + 7) / 8;
+ maxWidth = 240000;
+ break;
+ case 1:
+ bytesPerLine = width;
+ maxWidth = 60000;
+ break;
+ case 2:
+ bytesPerLine = 3 * width;
+ maxWidth = 20000;
+ break;
+ }
+
+ if (bytesPerLine > 60000) {
+ Tcl_ResetResult(interp);
+ sprintf(buffer,
+ "Can't generate Postscript for images more than %d pixels wide",
+ maxWidth);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ HtmlFree((char *) cdata.colors);
+ return TCL_ERROR;
+ }
+
+ maxRows = 60000 / bytesPerLine;
+
+ for (band = height - 1; band >= 0; band -= maxRows) {
+ int rows = (band >= maxRows) ? maxRows : band + 1;
+ int lineLen = 0;
+ switch (level) {
+ case 0:
+ sprintf(buffer, "%d %d 1 matrix {\n<", width, rows);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ break;
+ case 1:
+ sprintf(buffer, "%d %d 8 matrix {\n<", width, rows);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ break;
+ case 2:
+ sprintf(buffer, "%d %d 8 matrix {\n<", width, rows);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ break;
+ }
+ for (yy = band; yy > band - rows; yy--) {
+ switch (level) {
+ case 0:{
+ /*
+ * Generate data for image in monochrome mode.
+ * No attempt at dithering is made--instead, just
+ * set a threshold.
+ */
+ unsigned char mask = 0x80;
+ unsigned char data = 0x00;
+ for (xx = x; xx < x + width; xx++) {
+ TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy),
+ &red, &green, &blue);
+ if (0.30 * red + 0.59 * green + 0.11 * blue > 0.5)
+ data |= mask;
+ mask >>= 1;
+ if (mask == 0) {
+ sprintf(buffer, "%02X", data);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ lineLen += 2;
+ if (lineLen > 60) {
+ lineLen = 0;
+ Tcl_AppendResult(interp, "\n",
+ (char *) NULL);
+ }
+ mask = 0x80;
+ data = 0x00;
+ }
+ }
+ if ((width % 8) != 0) {
+ sprintf(buffer, "%02X", data);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ mask = 0x80;
+ data = 0x00;
+ }
+ break;
+ }
+ case 1:{
+ /*
+ * Generate data in gray mode--in this case, take a
+ * weighted sum of the red, green, and blue values.
+ */
+ for (xx = x; xx < x + width; xx++) {
+ TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy),
+ &red, &green, &blue);
+ sprintf(buffer, "%02X", (int) floor(0.5 + 255.0 *
+ (0.30 * red +
+ 0.59 * green +
+ 0.11 * blue)));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ lineLen += 2;
+ if (lineLen > 60) {
+ lineLen = 0;
+ Tcl_AppendResult(interp, "\n", (char *) NULL);
+ }
+ }
+ break;
+ }
+ case 2:{
+ /*
+ * Finally, color mode. Here, just output the red, green,
+ * and blue values directly.
+ */
+ for (xx = x; xx < x + width; xx++) {
+ TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy),
+ &red, &green, &blue);
+ sprintf(buffer, "%02X%02X%02X",
+ (int) floor(0.5 + 255.0 * red),
+ (int) floor(0.5 + 255.0 * green),
+ (int) floor(0.5 + 255.0 * blue));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ lineLen += 6;
+ if (lineLen > 60) {
+ lineLen = 0;
+ Tcl_AppendResult(interp, "\n", (char *) NULL);
+ }
+ }
+ break;
+ }
+ }
+ }
+ switch (level) {
+ case 0:
+ sprintf(buffer, ">\n} image\n");
+ break;
+ case 1:
+ sprintf(buffer, ">\n} image\n");
+ break;
+ case 2:
+ sprintf(buffer, ">\n} false 3 colorimage\n");
+ break;
+ }
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ sprintf(buffer, "0 %d translate\n", rows);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ }
+ HtmlFree((char *) cdata.colors);
+ return TCL_OK;
+}
+
+int
+HtmlTk_PostscriptImage(Tk_Image image, /* Token for image to redisplay. */
+ Tcl_Interp * interp, Tk_Window tkwin, TkPostscriptInfo * psinfo, /* postscript
+ * info
+ */
+ int x, int y, /* Upper-left pixel of region in image
+ * that needs to be redisplayed. */
+ int width, int height, /* Dimensions of region to
+ * redraw. */
+ int prepass)
+{
+ int result;
+ XImage *ximage;
+ Pixmap pmap;
+ GC newGC;
+ XGCValues gcValues;
+ if (prepass) {
+ return TCL_OK;
+ }
+
+ /*
+ * Create a Pixmap, tell the image to redraw itself there, and then
+ * generate an XImage from the Pixmap. We can then read pixel
+ * values out of the XImage.
+ */
+
+ pmap = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin),
+ width, height, Tk_Depth(tkwin));
+
+ gcValues.foreground = WhitePixelOfScreen(Tk_Screen(tkwin));
+ newGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ if (0 && newGC != None) { /* ??? */
+ XFillRectangle(Tk_Display(tkwin), pmap, newGC,
+ 0, 0, (unsigned int) width, (unsigned int) height);
+ Tk_FreeGC(Tk_Display(tkwin), newGC);
+ }
+
+ Tk_RedrawImage(image, 0, 0, /* x, y, */ width, height, pmap, 0, 0);
+
+#ifdef WIN32
+ ximage = XGetImage(Tk_Display(tkwin), pmap, 0, 0,
+ (unsigned int) width, (unsigned int) height, 1,
+ XYPixmap);
+#else
+ ximage = XGetImage(Tk_Display(tkwin), pmap, 0, 0,
+ (unsigned int) width, (unsigned int) height, AllPlanes,
+ ZPixmap);
+#endif
+
+ Tk_FreePixmap(Tk_Display(tkwin), pmap);
+
+ if (ximage == NULL) {
+ /*
+ * The XGetImage() function is apparently not implemented on this
+ * system. Just ignore it.
+ */
+ return TCL_OK;
+ }
+ if (!prepass) {
+ char buffer[100 + TCL_DOUBLE_SPACE * 2 + TCL_INTEGER_SPACE * 4];
+ sprintf(buffer, "%.15g %.15g translate\n", (double) x,
+ Html_PostscriptY((double) (y), psinfo));
+ if (psinfo->chan == NULL)
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ else
+ Tcl_Write(psinfo->chan, buffer, -1);
+ }
+
+ result = HtmlTkPostscriptImage(interp, tkwin, psinfo, ximage, 0, 0 /* x,
+ * y */ ,
+ width, height);
+
+ XDestroyImage(ximage);
+ return result;
+}
+
+extern int (*HtmlPostscriptPtr) (HtmlWidget * htmlPtr, /* The HTML widget */
+ Tcl_Interp * interp, /* The interpreter */
+ int argc, /* Number of arguments */
+ char **argv /* List of all arguments */
+ );
+
+/*DLL_EXPORT*/ int
+Tkhtmlpr_Init(Tcl_Interp * interp)
+{
+ Tcl_PkgProvide(interp, HTML_PKGNAME "pr", HTML_PKGVERSION);
+ HtmlPostscriptPtr = HtmlPostscript;
+ return TCL_OK;
+}
+#endif /* TKHTML_PS=1 */
diff --git a/src/htmlPsImg.c b/src/htmlPsImg.c
new file mode 100644
index 0000000..2d6f336
--- /dev/null
+++ b/src/htmlPsImg.c
@@ -0,0 +1,503 @@
+#if TKHTML_PS
+
+/*
+ * So blatently ripped off from Tk, comments aren't even updated.
+ * Peter MacDonald. http://browsex.com
+ *
+ * This module provides Postscript output support for canvases,
+ * including the "postscript" widget command plus a few utility
+ * procedures used for generating Postscript.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: htmlPsImg.c,v 1.7 2005/03/23 01:36:54 danielk1977 Exp $
+ */
+
+int
+TkPostscriptImage(Tcl_Interp * interp, Tk_Window tkwin, Tk_PostscriptInfo psInfo, /* postscript
+ * info
+ */
+ XImage * ximage, /* Image to draw */
+ int x, int y, /* First pixel to output */
+ int width, int height)
+{ /* Width and height of area */
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
+ char buffer[256];
+ int xx, yy, band, maxRows;
+ double red, green, blue;
+ int bytesPerLine = 0, maxWidth = 0;
+ int level = psInfoPtr->colorLevel;
+ Colormap cmap;
+ int i, depth, ncolors;
+ Visual *visual;
+ TkColormapData cdata;
+
+ if (psInfoPtr->prepass) {
+ return TCL_OK;
+ }
+
+ cmap = Tk_Colormap(tkwin);
+ depth = Tk_Depth(tkwin);
+ visual = Tk_Visual(tkwin);
+
+ /*
+ * Obtain information about the colormap, ie the mapping between
+ * pixel values and RGB values. The code below should work
+ * for all Visual types.
+ */
+
+ ncolors = visual->map_entries;
+ cdata.colors = (XColor *) HtmlAlloc(sizeof(XColor) * ncolors);
+ cdata.ncolors = ncolors;
+
+ if (visual->class == DirectColor || visual->class == TrueColor) {
+ cdata.separated = 1;
+ cdata.red_mask = visual->red_mask;
+ cdata.green_mask = visual->green_mask;
+ cdata.blue_mask = visual->blue_mask;
+ cdata.red_shift = 0;
+ cdata.green_shift = 0;
+ cdata.blue_shift = 0;
+ while ((0x0001 & (cdata.red_mask >> cdata.red_shift)) == 0)
+ cdata.red_shift++;
+ while ((0x0001 & (cdata.green_mask >> cdata.green_shift)) == 0)
+ cdata.green_shift++;
+ while ((0x0001 & (cdata.blue_mask >> cdata.blue_shift)) == 0)
+ cdata.blue_shift++;
+ for (i = 0; i < ncolors; i++)
+ cdata.colors[i].pixel =
+ ((i << cdata.red_shift) & cdata.red_mask) |
+ ((i << cdata.green_shift) & cdata.green_mask) |
+ ((i << cdata.blue_shift) & cdata.blue_mask);
+ }
+ else {
+ cdata.separated = 0;
+ for (i = 0; i < ncolors; i++)
+ cdata.colors[i].pixel = i;
+ }
+ if (visual->class == StaticGray || visual->class == GrayScale)
+ cdata.color = 0;
+ else
+ cdata.color = 1;
+
+ XQueryColors(Tk_Display(tkwin), cmap, cdata.colors, ncolors);
+
+ /*
+ * Figure out which color level to use (possibly lower than the
+ * one specified by the user). For example, if the user specifies
+ * color with monochrome screen, use gray or monochrome mode instead.
+ */
+
+ if (!cdata.color && level == 2) {
+ level = 1;
+ }
+
+ if (!cdata.color && cdata.ncolors == 2) {
+ level = 0;
+ }
+
+ /*
+ * Check that at least one row of the image can be represented
+ * with a string less than 64 KB long (this is a limit in the
+ * Postscript interpreter).
+ */
+
+ switch (level) {
+ case 0:
+ bytesPerLine = (width + 7) / 8;
+ maxWidth = 240000;
+ break;
+ case 1:
+ bytesPerLine = width;
+ maxWidth = 60000;
+ break;
+ case 2:
+ bytesPerLine = 3 * width;
+ maxWidth = 20000;
+ break;
+ }
+
+ if (bytesPerLine > 60000) {
+ Tcl_ResetResult(interp);
+ sprintf(buffer,
+ "Can't generate Postscript for images more than %d pixels wide",
+ maxWidth);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ HtmlFree((char *) cdata.colors);
+ return TCL_ERROR;
+ }
+
+ maxRows = 60000 / bytesPerLine;
+
+ for (band = height - 1; band >= 0; band -= maxRows) {
+ int rows = (band >= maxRows) ? maxRows : band + 1;
+ int lineLen = 0;
+ switch (level) {
+ case 0:
+ sprintf(buffer, "%d %d 1 matrix {\n<", width, rows);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ break;
+ case 1:
+ sprintf(buffer, "%d %d 8 matrix {\n<", width, rows);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ break;
+ case 2:
+ sprintf(buffer, "%d %d 8 matrix {\n<", width, rows);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ break;
+ }
+ for (yy = band; yy > band - rows; yy--) {
+ switch (level) {
+ case 0:{
+ /*
+ * Generate data for image in monochrome mode.
+ * No attempt at dithering is made--instead, just
+ * set a threshold.
+ */
+ unsigned char mask = 0x80;
+ unsigned char data = 0x00;
+ for (xx = x; xx < x + width; xx++) {
+ TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy),
+ &red, &green, &blue);
+ if (0.30 * red + 0.59 * green + 0.11 * blue > 0.5)
+ data |= mask;
+ mask >>= 1;
+ if (mask == 0) {
+ sprintf(buffer, "%02X", data);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ lineLen += 2;
+ if (lineLen > 60) {
+ lineLen = 0;
+ Tcl_AppendResult(interp, "\n",
+ (char *) NULL);
+ }
+ mask = 0x80;
+ data = 0x00;
+ }
+ }
+ if ((width % 8) != 0) {
+ sprintf(buffer, "%02X", data);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ mask = 0x80;
+ data = 0x00;
+ }
+ break;
+ }
+ case 1:{
+ /*
+ * Generate data in gray mode--in this case, take a
+ * weighted sum of the red, green, and blue values.
+ */
+ for (xx = x; xx < x + width; xx++) {
+ TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy),
+ &red, &green, &blue);
+ sprintf(buffer, "%02X", (int) floor(0.5 + 255.0 *
+ (0.30 * red +
+ 0.59 * green +
+ 0.11 * blue)));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ lineLen += 2;
+ if (lineLen > 60) {
+ lineLen = 0;
+ Tcl_AppendResult(interp, "\n", (char *) NULL);
+ }
+ }
+ break;
+ }
+ case 2:{
+ /*
+ * Finally, color mode. Here, just output the red, green,
+ * and blue values directly.
+ */
+ for (xx = x; xx < x + width; xx++) {
+ TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy),
+ &red, &green, &blue);
+ sprintf(buffer, "%02X%02X%02X",
+ (int) floor(0.5 + 255.0 * red),
+ (int) floor(0.5 + 255.0 * green),
+ (int) floor(0.5 + 255.0 * blue));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ lineLen += 6;
+ if (lineLen > 60) {
+ lineLen = 0;
+ Tcl_AppendResult(interp, "\n", (char *) NULL);
+ }
+ }
+ break;
+ }
+ }
+ }
+ switch (level) {
+ case 0:
+ sprintf(buffer, ">\n} image\n");
+ break;
+ case 1:
+ sprintf(buffer, ">\n} image\n");
+ break;
+ case 2:
+ sprintf(buffer, ">\n} false 3 colorimage\n");
+ break;
+ }
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ sprintf(buffer, "0 %d translate\n", rows);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ }
+ HtmlFree((char *) cdata.colors);
+ return TCL_OK;
+}
+
+int
+Tk_PostscriptImage(Tk_Image image, /* Token for image to redisplay. */
+ Tcl_Interp * interp, Tk_Window tkwin, Tk_PostscriptInfo psinfo, /* postscript
+ * info
+ */
+ int x, int y, /* Upper-left pixel of region in image
+ * that needs to be redisplayed. */
+ int width, int height, /* Dimensions of region to
+ * redraw. */
+ int prepass)
+{
+ int result;
+ XImage *ximage;
+ Pixmap pmap;
+ GC newGC;
+ XGCValues gcValues;
+ if (prepass) {
+ return TCL_OK;
+ }
+
+ /*
+ * Create a Pixmap, tell the image to redraw itself there, and then
+ * generate an XImage from the Pixmap. We can then read pixel
+ * values out of the XImage.
+ */
+
+ pmap = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin),
+ width, height, Tk_Depth(tkwin));
+
+ gcValues.foreground = WhitePixelOfScreen(Tk_Screen(tkwin));
+ newGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ if (newGC != None) {
+ XFillRectangle(Tk_Display(tkwin), pmap, newGC,
+ 0, 0, (unsigned int) width, (unsigned int) height);
+ Tk_FreeGC(Tk_Display(tkwin), newGC);
+ }
+
+ Tk_RedrawImage(image, x, y, width, height, pmap, 0, 0);
+
+ ximage = XGetImage(Tk_Display(tkwin), pmap, 0, 0,
+ (unsigned int) width, (unsigned int) height, AllPlanes,
+ ZPixmap);
+
+ Tk_FreePixmap(Tk_Display(tkwin), pmap);
+
+ if (ximage == NULL) {
+ /*
+ * The XGetImage() function is apparently not implemented on this
+ * system. Just ignore it.
+ */
+ return TCL_OK;
+ }
+ result = TkPostscriptImage(interp, tkwin, psinfo, ximage, x, y,
+ width, height);
+
+ XDestroyImage(ximage);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_RedrawImage --
+ *
+ * This procedure is called by widgets that contain images in order
+ * to redisplay an image on the screen or an off-screen pixmap.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image's manager is notified, and it redraws the desired
+ * portion of the image before returning.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_RedrawImage(Tk_Image image, /* Token for image to redisplay. */
+ int imageX, int imageY, /* Upper-left pixel of region in image
+ * that needs to be redisplayed. */
+ int width, int height, /* Dimensions of region to redraw. */
+ Drawable drawable, /* Drawable in which to display image
+ * (window or pixmap). If this is a
+ * pixmap, it must have the same depth
+ * as the window used in the
+ * Tk_GetImage call for the image. */
+ int drawableX, int drawableY)
+{ /* Coordinates in drawable that correspond *
+ * to imageX and imageY. */
+ Image *imagePtr = (Image *) image;
+
+ if (imagePtr->masterPtr->typePtr == NULL) {
+ /*
+ * No master for image, so nothing to display.
+ */
+
+ return;
+ }
+
+ /*
+ * Clip the redraw area to the area of the image.
+ */
+
+ if (imageX < 0) {
+ width += imageX;
+ drawableX -= imageX;
+ imageX = 0;
+ }
+ if (imageY < 0) {
+ height += imageY;
+ drawableY -= imageY;
+ imageY = 0;
+ }
+ if ((imageX + width) > imagePtr->masterPtr->width) {
+ width = imagePtr->masterPtr->width - imageX;
+ }
+ if ((imageY + height) > imagePtr->masterPtr->height) {
+ height = imagePtr->masterPtr->height - imageY;
+ }
+ (*imagePtr->masterPtr->typePtr->displayProc) (imagePtr->instanceData,
+ imagePtr->display, drawable,
+ imageX, imageY, width, height,
+ drawableX, drawableY);
+}
+
+void
+Tk_SizeOfImage(Tk_Image image, /* Token for image whose size is
+ * wanted. */
+ int *widthPtr, /* Return width of image here. */
+ int *heightPtr)
+{ /* Return height of image here. */
+ Image *imagePtr = (Image *) image;
+
+ *widthPtr = imagePtr->masterPtr->width;
+ *heightPtr = imagePtr->masterPtr->height;
+}
+
+void
+Tk_DeleteImage(Tcl_Interp * interp, /* Interpreter in which the image was
+ * created. */
+ char *name)
+{ /* Name of image. */
+ Tcl_HashEntry *hPtr;
+ TkWindow *winPtr;
+
+ winPtr = (TkWindow *) Tk_MainWindow(interp);
+ if (winPtr == NULL) {
+ return;
+ }
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, name);
+ if (hPtr == NULL) {
+ return;
+ }
+ DeleteImage((ImageMaster *) Tcl_GetHashValue(hPtr));
+}
+
+static void
+DeleteImage(ImageMaster * masterPtr)
+{ /* Pointer to main data structure for image. */
+ Image *imagePtr;
+ Tk_ImageType *typePtr;
+
+ typePtr = masterPtr->typePtr;
+ masterPtr->typePtr = NULL;
+ if (typePtr != NULL) {
+ for (imagePtr = masterPtr->instancePtr; imagePtr != NULL;
+ imagePtr = imagePtr->nextPtr) {
+ (*typePtr->freeProc) (imagePtr->instanceData, imagePtr->display);
+ (*imagePtr->changeProc) (imagePtr->widgetClientData, 0, 0,
+ masterPtr->width, masterPtr->height,
+ masterPtr->width, masterPtr->height);
+ }
+ (*typePtr->deleteProc) (masterPtr->masterData);
+ }
+ if (masterPtr->instancePtr == NULL) {
+ Tcl_DeleteHashEntry(masterPtr->hPtr);
+ HtmlFree((char *) masterPtr);
+ }
+}
+
+void
+TkDeleteAllImages(TkMainInfo * mainPtr)
+{ /* Structure describing application that is *
+ * going away. */
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+ ImageMaster *masterPtr;
+
+ for (hPtr = Tcl_FirstHashEntry(&mainPtr->imageTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ DeleteImage(masterPtr);
+ }
+ Tcl_DeleteHashTable(&mainPtr->imageTable);
+}
+
+ClientData
+Tk_GetImageMasterData(Tcl_Interp * interp, /* Interpreter in which the
+ * image was created. */
+ char *name, /* Name of image. */
+ Tk_ImageType ** typePtrPtr)
+{ /* Points to location to fill in with *
+ * pointer to type information for image. */
+ Tcl_HashEntry *hPtr;
+ TkWindow *winPtr;
+ ImageMaster *masterPtr;
+
+ winPtr = (TkWindow *) Tk_MainWindow(interp);
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, name);
+ if (hPtr == NULL) {
+ *typePtrPtr = NULL;
+ return NULL;
+ }
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ *typePtrPtr = masterPtr->typePtr;
+ return masterPtr->masterData;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetTSOrigin --
+ *
+ * Set the pattern origin of the tile to a common point (i.e. the
+ * origin (0,0) of the top level window) so that tiles from two
+ * different widgets will match up. This done by setting the
+ * GCTileStipOrigin field is set to the translated origin of the
+ * toplevel window in the hierarchy.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * The GCTileStipOrigin is reset in the GC. This will cause the
+ * tile origin to change when the GC is used for drawing.
+ *
+ *----------------------------------------------------------------------
+ */
+ /*ARGSUSED*/ void
+Tk_SetTSOrigin(Tk_Window tkwin, GC gc, int x, int y)
+{
+ while (!Tk_IsTopLevel(tkwin)) {
+ x -= Tk_X(tkwin) + Tk_Changes(tkwin)->border_width;
+ y -= Tk_Y(tkwin) + Tk_Changes(tkwin)->border_width;
+ tkwin = Tk_Parent(tkwin);
+ }
+ XSetTSOrigin(Tk_Display(tkwin), gc, x, y);
+}
+
+#endif /* TKHTML_PS=1 */
diff --git a/src/htmlcmd.c b/src/htmlcmd.c
new file mode 100644
index 0000000..eb904a9
--- /dev/null
+++ b/src/htmlcmd.c
@@ -0,0 +1,876 @@
+static char const rcsid[] =
+ "@(#) $Id: htmlcmd.c,v 1.32 2005/03/26 11:54:30 danielk1977 Exp $";
+
+/*
+** Routines to implement the HTML widget commands
+**
+** This source code is released into the public domain by the author,
+** D. Richard Hipp, on 2002 December 17. Instead of a license, here
+** is a blessing:
+**
+** May you do good and not evil.
+** May you find forgiveness for yourself and forgive others.
+** May you share freely, never taking more than you give.
+*/
+#include <stdlib.h>
+#include "html.h"
+#include <X11/Xatom.h>
+#include <string.h>
+#include <assert.h>
+
+/*
+** WIDGET resolve ?URI ...?
+**
+** Call the TCL command specified by the -resolvercommand option
+** to resolve the URL.
+*/
+int
+HtmlResolveCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ const char **argv; /* List of all arguments */
+{
+ return HtmlCallResolver((HtmlWidget *) clientData, argv + 2);
+}
+
+/*
+** WIDGET cget CONFIG-OPTION
+**
+** Retrieve the value of a configuration option
+*/
+int
+HtmlCgetObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int objc; /* Number of arguments */
+ Tcl_Obj *const *objv; /* List of all arguments */
+{
+ int rc;
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ Tk_ConfigSpec *cs = HtmlConfigSpec();
+
+ if (htmlPtr->TclHtml)
+ rc = TclConfigureWidgetObj(interp, htmlPtr, cs,
+ objc - 2, objv + 2, (char *) htmlPtr, 0);
+ else
+ rc = Tk_ConfigureValue(interp, htmlPtr->tkwin, cs,
+ (char *) htmlPtr, Tcl_GetString(objv[2]), 0);
+ return rc;
+}
+
+/*
+** WIDGET clear
+**
+** Erase all HTML from this widget and clear the screen. This is
+** typically done before loading a new document.
+*/
+int
+HtmlClearCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ const char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ HtmlTreeFree(htmlPtr);
+ HtmlClear(htmlPtr);
+ htmlPtr->flags |= REDRAW_TEXT | VSCROLL | HSCROLL;
+ HtmlScheduleRedraw(htmlPtr);
+ return TCL_OK;
+}
+
+/*
+** WIDGET configure ?OPTIONS?
+**
+** The standard Tk configure command.
+*/
+int
+HtmlConfigCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int objc; /* Number of arguments */
+ Tcl_Obj *const *objv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+#ifdef _TCLHTML_
+ if (objv == 2) { /* ???? */
+ return HtmlCgetObjCmd(htmlPtr, interp, objc, objv);
+ }
+ else if (argc == 3) {
+ return HtmlCgetObjCmd(htmlPtr, interp, objc, objv);
+ }
+ else {
+ return ConfigureHtmlWidget(interp, htmlPtr, objc - 2, objv + 2,
+ TK_CONFIG_ARGV_ONLY, 0);
+ }
+#else
+ if (objc == 2) {
+ return Tk_ConfigureInfo(interp, htmlPtr->tkwin, HtmlConfigSpec(),
+ (char *) htmlPtr, (char *) NULL, 0);
+ }
+ else if (objc == 3) {
+ return Tk_ConfigureInfo(interp, htmlPtr->tkwin, HtmlConfigSpec(),
+ (char *) htmlPtr, Tcl_GetString(objv[2]), 0);
+ }
+ else {
+ return ConfigureHtmlWidgetObj(interp, htmlPtr, objc - 2, objv + 2,
+ TK_CONFIG_ARGV_ONLY, 0);
+ }
+#endif
+}
+
+/* Return pElem with attr "name" == value */
+HtmlElement *
+HtmlAttrElem(htmlPtr, name, value)
+ HtmlWidget *htmlPtr;
+ char *name;
+ const char *value;
+{
+ HtmlElement *p;
+ char *z;
+ for (p = htmlPtr->pFirst; p; p = p->pNext) {
+ if (p->base.type != Html_A)
+ continue;
+ z = HtmlMarkupArg(p, name, 0);
+ if (z && (!strcmp(z, value)))
+ return p;
+ }
+ return 0;
+}
+
+/*
+** WIDGET names
+**
+** Returns a list of names associated with <a name=...> tags.
+*/
+int
+HtmlNamesCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ const char **argv; /* List of all arguments */
+{
+ HtmlElement *p;
+ char *z;
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ for (p = htmlPtr->pFirst; p; p = p->pNext) {
+ if (p->base.type != Html_A)
+ continue;
+ z = HtmlMarkupArg(p, "name", 0);
+ if (z) {
+ Tcl_AppendElement(interp, z);
+ }
+ else {
+ z = HtmlMarkupArg(p, "id", 0);
+ if (z) {
+ Tcl_AppendElement(interp, z);
+ }
+ }
+ }
+ return TCL_OK;
+}
+
+int
+HtmlAdvanceLayout(htmlPtr)
+ HtmlWidget *htmlPtr; /* The HTML widget */
+{
+ if (htmlPtr->LOendPtr) {
+ if (htmlPtr->LOendPtr->pNext) {
+ htmlPtr->formStart = htmlPtr->LOformStart;
+ HtmlAddStyle(htmlPtr, htmlPtr->LOendPtr->pNext);
+ HtmlSizer(htmlPtr);
+ }
+ }
+ else if (htmlPtr->pFirst) {
+ htmlPtr->paraAlignment = ALIGN_None;
+ htmlPtr->rowAlignment = ALIGN_None;
+ htmlPtr->anchorFlags = 0;
+ htmlPtr->inDt = 0;
+ htmlPtr->anchorStart = 0;
+ htmlPtr->formStart = 0;
+ htmlPtr->LOformStart = 0;
+ htmlPtr->innerList = 0;
+ htmlPtr->nInput = 0;
+ HtmlAddStyle(htmlPtr, htmlPtr->pFirst);
+ HtmlSizer(htmlPtr);
+ }
+ htmlPtr->LOendPtr = htmlPtr->pLast;
+ htmlPtr->LOformStart = htmlPtr->formStart;
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * HtmlParseCmd --
+ *
+ * $widget parse HTML-TEXT
+ *
+ * Appends the given HTML text to the end of any HTML text that may have
+ * been inserted by prior calls to this command. Then it runs the
+ * tokenizer, parser and layout engine as far as possible with the text
+ * that is available. The display is updated appropriately.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * User callbacks might be invoked. A redraw is scheduled for the next
+ * idle time.
+ *
+ *---------------------------------------------------------------------------
+ */
+int HtmlParseCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int objc; /* Number of arguments */
+ Tcl_Obj *const *objv; /* List of all arguments */
+{
+ int i;
+ char *arg1, *arg2;
+ HtmlIndex iStart;
+ HtmlElement *savePtr;
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ assert( !HtmlIsDead(htmlPtr) );
+
+ iStart.p = 0;
+ iStart.i = 0;
+ htmlPtr->LOendPtr = htmlPtr->pLast;
+ HtmlLock(htmlPtr);
+
+ /*
+ * Currently this proc accepts two arguments: -insert and -ypos.
+ */
+ for (i = 3; i < (objc - 1); i += 2) {
+ arg1 = Tcl_GetString(objv[i]);
+ arg2 = Tcl_GetString(objv[i + 1]);
+ if ((!strcmp(arg1, "-insert")) && htmlPtr->LOendPtr) {
+ if (HtmlGetIndex(htmlPtr, arg2, &iStart.p, &iStart.i) != 0) {
+ Tcl_AppendResult(interp, "malformed index: \"", arg2, "\"", 0);
+ return TCL_ERROR;
+ }
+ if (iStart.p) {
+ savePtr = iStart.p->pNext;
+ htmlPtr->pLast = iStart.p;
+ iStart.p->pNext = 0;
+ }
+ }
+ else if ((!strcmp(arg1, "-ypos")) && arg2[0]) {
+ htmlPtr->zGoto = (char *) strdup(arg2);
+ }
+ }
+
+ /* Add the new text to the internal cache of the document. Also tokenize
+ * it and add the new HtmlElement objects to the HtmlWidget.pFirst/pLast
+ * linked list.
+ */
+ arg1 = Tcl_GetStringFromObj(objv[2], &i);
+ HtmlTokenizerAppend(htmlPtr, arg1, i);
+ if (HtmlIsDead(htmlPtr)) {
+ return TCL_OK;
+ }
+
+ /* Call HtmlAddStlye to add 'style' to the elements just added to
+ * the list (the entire list if it was initially empty).
+ */
+ if (htmlPtr->LOendPtr) {
+ htmlPtr->formStart = htmlPtr->LOformStart;
+ if (iStart.p && savePtr) {
+ HtmlAddStyle(htmlPtr, htmlPtr->LOendPtr);
+ htmlPtr->pLast->pNext = savePtr;
+ savePtr->base.pPrev = htmlPtr->pLast;
+ htmlPtr->pLast = htmlPtr->LOendPtr;
+ htmlPtr->flags |= (REDRAW_TEXT | RELAYOUT);
+ HtmlScheduleRedraw(htmlPtr);
+ }
+ else if (htmlPtr->LOendPtr->pNext) {
+ HtmlAddStyle(htmlPtr, htmlPtr->LOendPtr->pNext);
+ }
+ } else if (htmlPtr->pFirst) {
+ htmlPtr->paraAlignment = ALIGN_None;
+ htmlPtr->rowAlignment = ALIGN_None;
+ htmlPtr->anchorFlags = 0;
+ htmlPtr->inDt = 0;
+ htmlPtr->anchorStart = 0;
+ htmlPtr->formStart = 0;
+ htmlPtr->innerList = 0;
+ htmlPtr->nInput = 0;
+ HtmlAddStyle(htmlPtr, htmlPtr->pFirst);
+ }
+
+ /* Schedule a redraw (idle callback to HtmlRedrawCallback) - or just run
+ * the layout engine if there is no Tk window associated with this html
+ * object (i.e. -tclhtml was passed when it was constructed).
+ */
+ if (!HtmlUnlock(htmlPtr)) {
+ htmlPtr->flags |= EXTEND_LAYOUT;
+ HtmlScheduleRedraw(htmlPtr);
+ }
+ if (htmlPtr->TclHtml){
+ HtmlLayout(htmlPtr);
+ }
+
+ return TCL_OK;
+}
+
+int
+HtmlLayoutCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ const char **argv; /* List of all arguments */
+{
+ HtmlLayout((HtmlWidget *) clientData);
+ return TCL_OK;
+}
+
+#ifndef _TCLHTML_
+
+/*
+** WIDGET href X Y
+**
+** Returns the URL on the hyperlink that is beneath the position X,Y.
+** Returns {} if there is no hyperlink beneath X,Y.
+*/
+int
+HtmlHrefCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int objc; /* Number of arguments */
+ Tcl_Obj *const *objv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ int x, y;
+ char *z, *target = 0;
+
+ if (Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ z = HtmlGetHref(htmlPtr, x + htmlPtr->xOffset, y + htmlPtr->yOffset,
+ &target);
+ if (z) {
+ HtmlLock(htmlPtr);
+ z = HtmlResolveUri(htmlPtr, z);
+ if (z && !HtmlUnlock(htmlPtr)) {
+ Tcl_DString cmd;
+ Tcl_DStringInit(&cmd);
+ Tcl_DStringStartSublist(&cmd);
+ Tcl_DStringAppendElement(&cmd, z);
+ Tcl_DStringEndSublist(&cmd);
+ if (target) {
+ Tcl_DStringStartSublist(&cmd);
+ Tcl_DStringAppendElement(&cmd, target);
+ Tcl_DStringEndSublist(&cmd);
+ }
+ Tcl_DStringResult(interp, &cmd);
+ }
+ if (z)
+ HtmlFree(z);
+ }
+ return TCL_OK;
+}
+
+/*
+** WIDGET xview ?SCROLL-OPTIONS...?
+**
+** Implements horizontal scrolling in the usual Tk way.
+*/
+int
+HtmlXviewCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ const char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ if (argc == 2) {
+ HtmlComputeHorizontalPosition(htmlPtr, interp->result);
+ }
+ else {
+ int count;
+ double fraction;
+ int maxX = htmlPtr->maxX;
+ int w = HtmlUsableWidth(htmlPtr);
+ int offset = htmlPtr->xOffset;
+ int type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count);
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ return TCL_ERROR;
+ case TK_SCROLL_MOVETO:
+ offset = fraction * maxX;
+ break;
+ case TK_SCROLL_PAGES:
+ offset += (count * w * 9) / 10;
+ break;
+ case TK_SCROLL_UNITS:
+ offset += (count * w) / 10;
+ break;
+ }
+ if (offset + w > maxX) {
+ offset = maxX - w;
+ }
+ else {
+ }
+ if (offset < 0) {
+ offset = 0;
+ }
+ else {
+ }
+ HtmlHorizontalScroll(htmlPtr, offset);
+ htmlPtr->flags |= ANIMATE_IMAGES;
+ }
+ return TCL_OK;
+}
+
+/*
+** WIDGET yview ?SCROLL-OPTIONS...?
+**
+** Implements vertical scrolling in the usual Tk way, but with one
+** enhancement. If the argument is a single word, the widget looks
+** for a <a name=...> tag with that word as the "name" and scrolls
+** to the position of that tag.
+*/
+int
+HtmlYviewCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ const char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ if (argc == 2) {
+ HtmlComputeVerticalPosition(htmlPtr, interp->result);
+ }
+ else if (argc == 3) {
+ HtmlElement *p = HtmlAttrElem(htmlPtr, "name", argv[2]);
+ if (p && p->anchor.y == 0) {
+ HtmlLock(htmlPtr);
+ HtmlLayout(htmlPtr);
+ HtmlUnlock(htmlPtr);
+ }
+ if (p)
+ HtmlVerticalScroll(htmlPtr, p->anchor.y);
+ }
+ else {
+ int count;
+ double fraction;
+ int maxY = htmlPtr->maxY;
+ int h = HtmlUsableHeight(htmlPtr);
+ int offset = htmlPtr->yOffset;
+ int type =
+ Tk_GetScrollInfo(interp, argc, (const char **) argv, &fraction,
+ &count);
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ return TCL_ERROR;
+ case TK_SCROLL_MOVETO:
+ offset = fraction * maxY;
+ break;
+ case TK_SCROLL_PAGES:
+ offset += (count * h * 9) / 10;
+ break;
+ case TK_SCROLL_UNITS:
+ offset += (count * h) / 10;
+ break;
+ }
+ if (offset + h > maxY) {
+ offset = maxY - h;
+ }
+ else {
+ }
+ if (offset < 0) {
+ offset = 0;
+ }
+ else {
+ }
+ HtmlVerticalScroll(htmlPtr, offset);
+ htmlPtr->flags |= ANIMATE_IMAGES;
+ }
+ return TCL_OK;
+}
+
+/* The pSelStartBlock and pSelEndBlock values have been changed.
+** This routine's job is to loop over all HtmlBlocks and either
+** set or clear the HTML_Selected bits in the .base.flags field
+** as appropriate. For every HtmlBlock where the bit changes,
+** mark that block for redrawing.
+*/
+static void
+UpdateSelection(htmlPtr)
+ HtmlWidget *htmlPtr;
+{
+ int selected = 0;
+ HtmlIndex tempIndex;
+ HtmlBlock *pTempBlock;
+ int temp;
+ HtmlBlock *p;
+
+ for (p = htmlPtr->firstBlock; p; p = p->pNext) {
+ if (p == htmlPtr->pSelStartBlock) {
+ selected = 1;
+ HtmlRedrawBlock(htmlPtr, p);
+ }
+ else if (!selected && p == htmlPtr->pSelEndBlock) {
+ selected = 1;
+ tempIndex = htmlPtr->selBegin;
+ htmlPtr->selBegin = htmlPtr->selEnd;
+ htmlPtr->selEnd = tempIndex;
+ pTempBlock = htmlPtr->pSelStartBlock;
+ htmlPtr->pSelStartBlock = htmlPtr->pSelEndBlock;
+ htmlPtr->pSelEndBlock = pTempBlock;
+ temp = htmlPtr->selStartIndex;
+ htmlPtr->selStartIndex = htmlPtr->selEndIndex;
+ htmlPtr->selEndIndex = temp;
+ HtmlRedrawBlock(htmlPtr, p);
+ }
+ else {
+ }
+ if (p->base.flags & HTML_Selected) {
+ if (!selected) {
+ p->base.flags &= ~HTML_Selected;
+ HtmlRedrawBlock(htmlPtr, p);
+ }
+ else {
+ }
+ }
+ else {
+ if (selected) {
+ p->base.flags |= HTML_Selected;
+ HtmlRedrawBlock(htmlPtr, p);
+ }
+ else {
+ }
+ }
+ if (p == htmlPtr->pSelEndBlock) {
+ selected = 0;
+ HtmlRedrawBlock(htmlPtr, p);
+ }
+ else {
+ }
+ }
+}
+
+/* Given the selection end-points in htmlPtr->selBegin
+** and htmlPtr->selEnd, recompute pSelBeginBlock and
+** pSelEndBlock, then call UpdateSelection to update the
+** display.
+**
+** This routine should be called whenever the selection
+** changes or whenever the set of HtmlBlock structures
+** change.
+*/
+void
+HtmlUpdateSelection(htmlPtr, forceUpdate)
+ HtmlWidget *htmlPtr;
+ int forceUpdate;
+{
+ HtmlBlock *pBlock;
+ int index;
+ int needUpdate = forceUpdate;
+ int temp;
+
+ if (htmlPtr->selEnd.p == 0) {
+ htmlPtr->selBegin.p = 0;
+ }
+ else {
+ }
+ HtmlIndexToBlockIndex(htmlPtr, htmlPtr->selBegin, &pBlock, &index);
+ if (needUpdate || pBlock != htmlPtr->pSelStartBlock) {
+ needUpdate = 1;
+ HtmlRedrawBlock(htmlPtr, htmlPtr->pSelStartBlock);
+ htmlPtr->pSelStartBlock = pBlock;
+ htmlPtr->selStartIndex = index;
+ }
+ else if (index != htmlPtr->selStartIndex) {
+ HtmlRedrawBlock(htmlPtr, pBlock);
+ htmlPtr->selStartIndex = index;
+ }
+ else {
+ }
+ if (htmlPtr->selBegin.p == 0) {
+ htmlPtr->selEnd.p = 0;
+ }
+ else {
+ }
+ HtmlIndexToBlockIndex(htmlPtr, htmlPtr->selEnd, &pBlock, &index);
+ if (needUpdate || pBlock != htmlPtr->pSelEndBlock) {
+ needUpdate = 1;
+ HtmlRedrawBlock(htmlPtr, htmlPtr->pSelEndBlock);
+ htmlPtr->pSelEndBlock = pBlock;
+ htmlPtr->selEndIndex = index;
+ }
+ else if (index != htmlPtr->selEndIndex) {
+ HtmlRedrawBlock(htmlPtr, pBlock);
+ htmlPtr->selEndIndex = index;
+ }
+ else {
+ }
+ if (htmlPtr->pSelStartBlock
+ && htmlPtr->pSelStartBlock == htmlPtr->pSelEndBlock
+ && htmlPtr->selStartIndex > htmlPtr->selEndIndex) {
+ temp = htmlPtr->selStartIndex;
+ htmlPtr->selStartIndex = htmlPtr->selEndIndex;
+ htmlPtr->selEndIndex = temp;
+ }
+ else {
+ }
+ if (needUpdate) {
+ htmlPtr->flags |= ANIMATE_IMAGES;
+ UpdateSelection(htmlPtr);
+ }
+ else {
+ }
+}
+
+void
+HtmlLostSelection(clientData)
+ ClientData clientData; /* Information about table widget. */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ CONST char *argv[3];
+ argv[2] = "";
+ if (htmlPtr->exportSelection) {
+ HtmlSelectionClearCmd(htmlPtr, 0, 3, argv);
+ }
+}
+
+/*
+** WIDGET selection set INDEX INDEX
+*/
+int
+HtmlSelectionSetCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ const char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ HtmlIndex selBegin, selEnd;
+ int bi, ei;
+
+ HtmlLock(htmlPtr);
+ if (HtmlGetIndex(htmlPtr, argv[3], &selBegin.p, &selBegin.i)) {
+ if (!HtmlUnlock(htmlPtr)) {
+ Tcl_AppendResult(interp, "malformed index: \"", argv[3], "\"", 0);
+ }
+ return TCL_ERROR;
+ }
+ if (HtmlIsDead(htmlPtr))
+ return TCL_OK;
+ if (HtmlGetIndex(htmlPtr, argv[4], &selEnd.p, &selEnd.i)) {
+ if (!HtmlUnlock(htmlPtr)) {
+ Tcl_AppendResult(interp, "malformed index: \"", argv[4], "\"", 0);
+ }
+ return TCL_ERROR;
+ }
+ if (HtmlUnlock(htmlPtr))
+ return TCL_OK;
+ bi = HtmlTokenNumber(selBegin.p);
+ ei = HtmlTokenNumber(selEnd.p);
+ if (!(selBegin.p && selEnd.p))
+ return TCL_OK;
+ if (bi < ei || (bi == ei && selBegin.i <= selEnd.i)) {
+ htmlPtr->selBegin = selBegin;
+ htmlPtr->selEnd = selEnd;
+ }
+ else {
+ htmlPtr->selBegin = selEnd;
+ htmlPtr->selEnd = selBegin;
+ }
+ HtmlUpdateSelection(htmlPtr, 0);
+ if (htmlPtr->exportSelection) {
+ Tk_OwnSelection(htmlPtr->tkwin, XA_PRIMARY, HtmlLostSelection,
+ (ClientData) htmlPtr);
+ }
+
+ return TCL_OK;
+}
+
+/*
+** WIDGET selection clear
+*/
+int
+HtmlSelectionClearCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ const char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ htmlPtr->pSelStartBlock = 0;
+ htmlPtr->pSelEndBlock = 0;
+ htmlPtr->selBegin.p = 0;
+ htmlPtr->selEnd.p = 0;
+ UpdateSelection(htmlPtr);
+ return TCL_OK;
+}
+
+#endif /* _TCLHTML_ */
+
+#
+
+/*
+** Recompute the position of the insertion cursor based on the
+** position in htmlPtr->ins.
+*/
+void
+HtmlUpdateInsert(htmlPtr)
+ HtmlWidget *htmlPtr;
+{
+#ifndef _TCLHTML_
+ if (htmlPtr->TclHtml)
+ return;
+ HtmlIndexToBlockIndex(htmlPtr, htmlPtr->ins,
+ &htmlPtr->pInsBlock, &htmlPtr->insIndex);
+ HtmlRedrawBlock(htmlPtr, htmlPtr->pInsBlock);
+ if (htmlPtr->insTimer == 0) {
+ htmlPtr->insStatus = 0;
+ HtmlFlashCursor(htmlPtr);
+ }
+ else {
+ }
+#endif /* _TCLHTML_ */
+}
+
+/*
+** WIDGET token handler TAG ?SCRIPT?
+*/
+int
+HtmlTokenHandlerCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ const char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ int type = HtmlNameToType(htmlPtr, argv[3]);
+ if (type == Html_Unknown) {
+ Tcl_AppendResult(interp, "unknown tag: \"", argv[3], "\"", 0);
+ return TCL_ERROR;
+ }
+ if (argc == 4) {
+ if (htmlPtr->zHandler[type] != 0) {
+ interp->result = htmlPtr->zHandler[type];
+ }
+ }
+ else {
+ if (htmlPtr->zHandler[type] != 0) {
+ HtmlFree(htmlPtr->zHandler[type]);
+ }
+ htmlPtr->zHandler[type] = HtmlAlloc(strlen(argv[4]) + 1);
+ if (htmlPtr->zHandler[type]) {
+ strcpy(htmlPtr->zHandler[type], argv[4]);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+** WIDGET index INDEX
+*/
+int
+HtmlIndexCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ const char **argv; /* List of all arguments */
+{
+ HtmlElement *p;
+ int i;
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+
+ HtmlLock(htmlPtr);
+ if (HtmlGetIndex(htmlPtr, argv[2], &p, &i) != 0) {
+ if (!HtmlUnlock(htmlPtr)) {
+ Tcl_AppendResult(interp, "malformed index: \"", argv[2], "\"", 0);
+ }
+ return TCL_ERROR;
+ }
+ if (!HtmlUnlock(htmlPtr) && p) {
+ sprintf(interp->result, "%d.%d", HtmlTokenNumber(p), i);
+ }
+ else {
+ }
+ return TCL_OK;
+}
+
+/*
+** WIDGET insert INDEX
+*/
+int
+HtmlInsertCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ const char **argv; /* List of all arguments */
+{
+ HtmlIndex ins;
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ if (argv[2][0] == 0) {
+ HtmlRedrawBlock(htmlPtr, htmlPtr->pInsBlock);
+ htmlPtr->insStatus = 0;
+ htmlPtr->pInsBlock = 0;
+ htmlPtr->ins.p = 0;
+ }
+ else {
+ HtmlLock(htmlPtr);
+ if (HtmlGetIndex(htmlPtr, argv[2], &ins.p, &ins.i)) {
+ if (!HtmlUnlock(htmlPtr)) {
+ Tcl_AppendResult(interp, "malformed index: \"", argv[1], "\"",
+ 0);
+ }
+ return TCL_ERROR;
+ }
+ if (HtmlUnlock(htmlPtr))
+ return TCL_OK;
+ HtmlRedrawBlock(htmlPtr, htmlPtr->pInsBlock);
+ htmlPtr->ins = ins;
+ HtmlUpdateInsert(htmlPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+** WIDGET debug dump START END
+*/
+int
+HtmlDebugDumpCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ const char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ HtmlElement *pStart, *pEnd;
+ int i;
+
+ if (HtmlGetIndex(htmlPtr, argv[3], &pStart, &i) != 0) {
+ Tcl_AppendResult(interp, "malformed index: \"", argv[3], "\"", 0);
+ return TCL_ERROR;
+ }
+ if (HtmlGetIndex(htmlPtr, argv[4], &pEnd, &i) != 0) {
+ Tcl_AppendResult(interp, "malformed index: \"", argv[4], "\"", 0);
+ return TCL_ERROR;
+ }
+ if (pStart) {
+ HtmlPrintList(htmlPtr, pStart, pEnd ? pEnd->base.pNext : 0);
+ }
+ return TCL_OK;
+}
+
+/*
+** WIDGET debug testpt FILENAME
+*/
+int
+HtmlDebugTestPtCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ const char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ HtmlTestPointDump(argv[3]);
+ return TCL_OK;
+}
diff --git a/src/htmldecode.c b/src/htmldecode.c
index 6318dc5..3b4bada 100644
--- a/src/htmldecode.c
+++ b/src/htmldecode.c
@@ -30,7 +30,7 @@
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
* POSSIBILITY OF SUCH DAMAGE.
*/
-static char const rcsid[] = "@(#) $Id: htmldecode.c,v 1.6 2007/09/20 18:09:31 danielk1977 Exp $";
+static char const rcsid[] = "@(#) $Id: htmldecode.c,v 1.9 2008/01/09 06:49:37 danielk1977 Exp $";
#include "html.h"
@@ -192,12 +192,14 @@ HtmlDecode(clientData, interp, objc, objv)
/*
*---------------------------------------------------------------------------
*
- * HtmlEscapeUriComponent --
+ * HtmlEncode --
*
- * ::tkhtml::escape_uri ?-query? STRING
+ * ::tkhtml::encode DATA
+ *
+ * - _ . ! ~ * ' ( )
*
* Results:
- * Returns the decoded data.
+ * Returns the encoded data.
*
* Side effects:
* None.
@@ -205,22 +207,65 @@ HtmlDecode(clientData, interp, objc, objv)
*---------------------------------------------------------------------------
*/
int
-HtmlEscapeUriComponent(clientData, interp, objc, objv)
+HtmlEncode(clientData, interp, objc, objv)
ClientData clientData; /* The HTML widget data structure */
Tcl_Interp *interp; /* Current interpreter. */
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument strings. */
{
+ int map[128] = {
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0 */
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 16 */
+ 0, 1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 1, 1, 0, /* 32 */
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, /* 48 */
+
+ 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, /* 64 */
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1, /* 80 */
+ 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, /* 96 */
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 0 /* 112 */
+ };
+
+ char hex[16] = {
+ '0', '1', '2', '3', '4', '5', '6', '7',
+ '8', '9', 'A', 'B', 'C', 'D', 'E', 'F',
+ };
+
unsigned char *zOut;
- unsigned char *zRes;
+ int iOut;
- unsigned char *zCsr;
- unsigned char *zEnd;
- int nIn;
+ int iIn;
+ int nData;
+ char *zData;
- Tcl_Obj *pData;
- int isQuery;
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "DATA");
+ return TCL_ERROR;
+ }
+ zData = Tcl_GetStringFromObj(objv[1], &nData);
+
+ zOut = (unsigned char *)HtmlAlloc("temp", nData*3);
+ iOut = 0;
+ for(iIn = 0; iIn < nData; iIn++){
+ char c = zData[iIn];
+ if( !(c&0x80) && map[(int)c] ){
+ zOut[iOut++] = c;
+ } else {
+ zOut[iOut++] = '%';
+ zOut[iOut++] = hex[(int)((c>>4)&0x0F)];
+ zOut[iOut++] = hex[(int)(c&0x0F)];
+ }
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(zOut, iOut));
+ return TCL_OK;
+}
+
+static char *
+allocEscapedComponent(zInput, nInput, isQuery)
+ const char *zInput;
+ int nInput;
+ int isQuery;
+{
int map[128] = {
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0 */
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 16 */
@@ -233,17 +278,14 @@ HtmlEscapeUriComponent(clientData, interp, objc, objv)
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 0 /* 112 */
};
- if (objc != 3 && objc != 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "?-query? URI-COMPONENT");
- return TCL_ERROR;
- }
- pData = objv[objc - 1];
- isQuery = (objc == 3);
+ unsigned char *zEnd = (unsigned char *)&zInput[nInput];
+ unsigned char *zCsr = (unsigned char *)zInput;
+ char *zRes;
+ char *zOut;
+
+ zRes = (char *)HtmlAlloc("temp", 1+(nInput*3));
+ zOut = (char *)zRes;
- zCsr = (unsigned char *)Tcl_GetStringFromObj(pData, &nIn);
- zEnd = &zCsr[nIn];
- zRes = (unsigned char *)HtmlAlloc("temp", 1+(nIn*3));
- zOut = zRes;
for ( ; zCsr < zEnd; zCsr++) {
if (*zCsr == '%' && (zEnd - zCsr) >= 3) {
*(zOut++) = zCsr[0];
@@ -271,7 +313,49 @@ HtmlEscapeUriComponent(clientData, interp, objc, objv)
}
}
*zOut = '\0';
- assert((zOut - zRes) <= (1+(nIn*3)));
+ assert((zOut - zRes) <= (1+(nInput*3)));
+
+ return zRes;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * HtmlEscapeUriComponent --
+ *
+ * ::tkhtml::escape_uri ?-query? STRING
+ *
+ * Results:
+ * Returns the decoded data.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+int
+HtmlEscapeUriComponent(clientData, interp, objc, objv)
+ ClientData clientData; /* The HTML widget data structure */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings. */
+{
+ char *zRes;
+ unsigned char *zCsr;
+ int nIn;
+
+ Tcl_Obj *pData;
+ int isQuery;
+
+ if (objc != 3 && objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-query? URI-COMPONENT");
+ return TCL_ERROR;
+ }
+ pData = objv[objc - 1];
+ isQuery = (objc == 3);
+
+ zCsr = (unsigned char *)Tcl_GetStringFromObj(pData, &nIn);
+ zRes = allocEscapedComponent(zCsr, nIn, isQuery);
Tcl_SetResult(interp, (char *)zRes, TCL_VOLATILE);
HtmlFree(zRes);
@@ -387,7 +471,7 @@ objToUri(pObj)
}
static char *
-combinePath(zOne, zTwo, zOut)
+combinePath(zOne, zTwo)
const char *zOne;
const char *zTwo;
{
diff --git a/src/htmldraw.c b/src/htmldraw.c
index 3a5d903..0da69dd 100644
--- a/src/htmldraw.c
+++ b/src/htmldraw.c
@@ -30,7 +30,7 @@
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
* POSSIBILITY OF SUCH DAMAGE.
*/
-static const char rcsid[] = "$Id: htmldraw.c,v 1.201 2007/10/06 10:11:51 danielk1977 Exp $";
+static const char rcsid[] = "$Id: htmldraw.c,v 1.208 2008/02/14 08:43:49 danielk1977 Exp $";
#include "html.h"
#include <assert.h>
@@ -1642,10 +1642,12 @@ printf("%s\n", Tcl_GetString(HtmlNodeCommand(pQuery->pTree, p->pItem->pNode)));
#endif
if (!p->pixmap) {
+#if 0
printf(
"TODO: Using %dx%d pixmap for clipping. (performance hit)\n"
, p->pmw, p->pmh
);
+#endif
p->pixmap = Tk_GetPixmap(
Tk_Display(win), Tk_WindowId(win),
p->pmw, p->pmh,
@@ -1821,7 +1823,8 @@ pQuery, drawable, d_w, d_h, pImage, bg_x, bg_y, bg_w, bg_h, iPosX, iPosY)
int clip_x2 = MIN(d_w, bg_x + bg_w);
int clip_y2 = MIN(d_h, bg_y + bg_h);
- Tk_Image img;
+ Tk_Image img = 0;
+ Pixmap pix = 0;
int i_w;
int i_h;
@@ -1841,11 +1844,17 @@ pQuery, drawable, d_w, d_h, pImage, bg_x, bg_y, bg_w, bg_h, iPosX, iPosY)
}
#endif
- img = HtmlImageImage(pImage);
- Tk_SizeOfImage(img, &i_w, &i_h);
+ HtmlImageSize(pImage, &i_w, &i_h);
if (bg_h > (i_h * 2) && bg_w > (i_w * 2)) {
- img = HtmlImageTile(pImage);
- Tk_SizeOfImage(img, &i_w, &i_h);
+ pix = HtmlImageTilePixmap(pImage, &i_w, &i_h);
+ if (!pix) {
+ img = HtmlImageTile(pImage, &i_w, &i_h);
+ }
+ } else {
+ pix = HtmlImagePixmap(pImage);
+ if (!pix) {
+ img = HtmlImageImage(pImage);
+ }
}
if (i_w <= 0 || i_h <= 0) return;
@@ -1887,7 +1896,19 @@ pQuery, drawable, d_w, d_h, pImage, bg_x, bg_y, bg_w, bg_h, iPosX, iPosY)
}
if (w > 0 && h > 0) {
- Tk_RedrawImage(img, im_x, im_y, w, h, drawable, x, y);
+ if (pix) {
+ Tk_Window win = pQuery->pTree->tkwin;
+ XGCValues gc_values;
+ GC gc;
+ memset(&gc_values, 0, sizeof(XGCValues));
+ gc = Tk_GetGC(win, 0, &gc_values);
+ XCopyArea(Tk_Display(win),
+ pix, drawable, gc, im_x, im_y, w, h, x, y
+ );
+ Tk_FreeGC(Tk_Display(win), gc);
+ } else {
+ Tk_RedrawImage(img, im_x, im_y, w, h, drawable, x, y);
+ }
}
}
}
@@ -2067,25 +2088,27 @@ drawBox(pQuery, pItem, pBox, drawable, x, y, w, h, xview, yview, flags)
/* Image background, if required. */
if (0 == (flags & DRAWBOX_NOBACKGROUND) && pV->imZoomedBackgroundImage) {
- Tk_Image img;
+#if 0
Pixmap ipix;
GC gc;
XGCValues gc_values;
+#endif
int iWidth;
int iHeight;
+#if 0
Tk_Window win = pTree->tkwin;
Display *display = Tk_Display(win);
int dep = Tk_Depth(win);
+#endif
int eR = pV->eBackgroundRepeat;
- img = HtmlImageImage(pV->imZoomedBackgroundImage);
- Tk_SizeOfImage(img, &iWidth, &iHeight);
+ HtmlImageSize(pV->imZoomedBackgroundImage, &iWidth, &iHeight);
if (iWidth > 0 && iHeight > 0) {
int iPosX;
int iPosY;
- HtmlNode *pBgNode = pBox->pNode;
+ /* HtmlNode *pBgNode = pBox->pNode; */
#ifdef WIN32
/*
@@ -2152,7 +2175,7 @@ drawBox(pQuery, pItem, pBox, drawable, x, y, w, h, xview, yview, flags)
iPosX, iPosY
);
} else {
-
+#if 0
/* Create a pixmap of the image */
ipix = Tk_GetPixmap(
display, Tk_WindowId(win), iWidth, iHeight, dep
@@ -2190,6 +2213,7 @@ drawBox(pQuery, pItem, pBox, drawable, x, y, w, h, xview, yview, flags)
Tk_FreePixmap(display, ipix);
clearClippingRegion(display, gc);
Tk_FreeGC(display, gc);
+#endif
}
}
}
@@ -2237,10 +2261,8 @@ drawImage(pQuery, pI2, drawable, x, y, w, h)
if (pI2->pImage) {
int imW; /* Image width */
int imH; /* Image height */
- Tk_Image img; /* Tk Image */
- img = HtmlImageImage(pI2->pImage);
- Tk_SizeOfImage(img, &imW, &imH);
+ HtmlImageSize(pI2->pImage, &imW, &imH);
tileimage(
pQuery, drawable, w, h,
@@ -4230,6 +4252,57 @@ layoutBboxCb(pItem, origin_x, origin_y, pOverflow, clientData)
return 0;
}
+typedef struct OverflowBox OverflowBox;
+struct OverflowBox {
+ HtmlNode *pNode;
+ int *pX;
+ int *pY;
+ int *pW;
+ int *pH;
+ int isFound;
+};
+
+static int
+overflowBoxCb(pItem, origin_x, origin_y, pOverflow, clientData)
+ HtmlCanvasItem *pItem;
+ int origin_x;
+ int origin_y;
+ Overflow *pOverflow;
+ ClientData clientData;
+{
+ OverflowBox *p = (OverflowBox *)clientData;
+ if (p->isFound) return 0;
+
+ if (pOverflow && p->pNode == pOverflow->pItem->pNode) {
+ *p->pX = pOverflow->x;
+ *p->pY = pOverflow->y;
+ *p->pW = pOverflow->w;
+ *p->pH = pOverflow->h;
+ p->isFound = 1;
+ }
+ return 0;
+}
+
+void
+HtmlWidgetOverflowBox(pTree, pNode, pX, pY, pW, pH)
+ HtmlTree *pTree;
+ HtmlNode *pNode;
+ int *pX;
+ int *pY;
+ int *pW;
+ int *pH;
+{
+ OverflowBox sOverflowBox;
+ memset(&sOverflowBox, 0, sizeof(OverflowBox));
+ sOverflowBox.pX = pX;
+ sOverflowBox.pY = pY;
+ sOverflowBox.pW = pW;
+ sOverflowBox.pH = pH;
+ sOverflowBox.pNode = pNode;
+ searchCanvas(pTree, -1, -1, overflowBoxCb, &sOverflowBox, 1);
+ return;
+}
+
void
HtmlWidgetNodeBox(pTree, pNode, pX, pY, pW, pH)
HtmlTree *pTree;
@@ -4265,8 +4338,8 @@ HtmlWidgetNodeBox(pTree, pNode, pX, pY, pW, pH)
CanvasOverflow *pO = &pItem->x.overflow;
sQuery.left = MIN(sQuery.left, pO->x + origin_x);
sQuery.top = MIN(sQuery.top, pO->y + origin_y);
- sQuery.right = MAX(sQuery.right, sQuery.left + pO->w);
- sQuery.bottom = MAX(sQuery.bottom, sQuery.bottom + pO->h);
+ sQuery.right = MAX(sQuery.right, pO->x + origin_x + pO->w);
+ sQuery.bottom = MAX(sQuery.bottom, pO->y + origin_y + pO->h);
}
pSkip = pO->pEnd;
} else if (pItem->type == CANVAS_ORIGIN) {
@@ -4344,6 +4417,9 @@ HtmlWidgetRepair(pTree, x, y, w, h, windowsrepair)
int h;
int windowsrepair;
{
+ /* if( !pTree->options.enablelayout ) return; */
+ if (!Tk_IsMapped(pTree->tkwin)) return;
+
/* Make sure the widget main window exists before painting anything */
Tk_MakeWindowExist(pTree->tkwin);
Tk_MakeWindowExist(pTree->docwin);
@@ -4376,13 +4452,12 @@ HtmlWidgetSetViewport(pTree, scroll_x, scroll_y, force_redraw)
pTree->iScrollY = scroll_y;
pTree->iScrollX = scroll_x;
- if (pTree->nFixedBackground) {
- /* Variable HtmlTree.nFixedBackground contains the number of
- * fixed background images or boxes contained in this document. If
- * this is not zero, then we need to redraw the entire viewport
- * each time the user scrolls the window. In other words, we need
- * to do something generate an expose event that covers the whole
- * viewport.
+ if (pTree->isFixed) {
+ /* Variable HtmlTree.isFixed is true if the document contains
+ * fixed background images or boxes. If this is not zero, then we need
+ * to redraw the entire viewport each time the user scrolls the window.
+ * In other words, we need to do something generate an expose event
+ * that covers the whole viewport.
*
* Moving the docwin between coords (0,0) and (-10000,0) each time
* the window is scrolled seems to achieve this.
diff --git a/src/htmlexts.c b/src/htmlexts.c
new file mode 100644
index 0000000..59a932c
--- /dev/null
+++ b/src/htmlexts.c
@@ -0,0 +1,3636 @@
+static char const rcsid[] =
+ "@(#) $Id: htmlexts.c,v 1.11 2005/03/24 12:05:06 danielk1977 Exp $";
+
+/*
+** The extra routines for the HTML widget for Tcl/Tk
+**
+** Copyright (C) 1997-2000 Peter MacDonald and BrowseX Systems Inc.
+**
+** This library is free software; you can redistribute it and/or
+** modify it under the terms of the GNU Library General Public
+** License as published by the Free Software Foundation; either
+** version 2 of the License, or (at your option) any later version.
+**
+** This library is distributed in the hope that it will be useful,
+** but WITHOUT ANY WARRANTY; without even the implied warranty of
+** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+** Library General Public License for more details.
+**
+** You should have received a copy of the GNU Library General Public
+** License along with this library; if not, write to the
+** Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+** Boston, MA 02111-1307, USA.
+**
+** Author contact information:
+** peter at browsex.com
+** http://browsex.com
+*/
+
+#include <ctype.h>
+#include <fcntl.h>
+#include <errno.h>
+#include <stdlib.h>
+#include <string.h>
+#include "html.h"
+#ifdef USE_TK_STUBS
+# include <tkIntXlibDecls.h>
+#endif
+#include <X11/Xatom.h>
+#include <assert.h>
+
+#define TOKEN_LIST 1
+#define TOKEN_MARKUP 2
+#define TOKEN_DOM 4
+#define StrEqual(a,b) (a[0]==b[0] && (!strcmp(a,b)))
+#define StrIEqual(a,b) (tolower(a[0])==tolower(b[0]) && (!strcasecmp(a,b)))
+
+int (*HtmlPostscriptPtr) (HtmlWidget * htmlPtr, /* The HTML widget */
+ Tcl_Interp * interp, /* The interpreter */
+ int argc, /* Number of arguments */
+ char **argv /* List of all arguments */
+ );
+
+#ifndef _TCLHTML_
+
+static int HtmlRadioCount _ANSI_ARGS_((HtmlWidget *, HtmlElement *));
+
+void
+BgImageChangeProc(clientData, x, y, w, h, newWidth, newHeight)
+ ClientData clientData; /* Pointer to an HtmlImage structure */
+ int x; /* Left edge of region that changed */
+ int y; /* Top edge of region that changed */
+ int w; /* Width of region that changes.
+ * Maybe 0 */
+ int h; /* Height of region that changed.
+ * Maybe 0 */
+ int newWidth; /* New width of the image */
+ int newHeight; /* New height of the image */
+{
+ HtmlWidget *htmlPtr;
+ htmlPtr = (HtmlWidget *) clientData;
+ HtmlRedrawEverything(htmlPtr);
+}
+
+/* For animated images, update the image list */
+int
+HtmlImageUpdateCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp;
+ int argc;
+ const char **argv;
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ int id;
+ char *z;
+ HtmlElement *p;
+ HtmlImage *pImage;
+ HtmlElement *pElem;
+
+ if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ p = HtmlTokenByIndex(htmlPtr, id, 0);
+ if (!p)
+ return TCL_ERROR;
+ if (p->base.type != Html_IMG)
+ return TCL_ERROR;
+ HtmlAddImages(htmlPtr, p, p->image.pImage, argv[3], 0);
+ return TCL_OK;
+}
+
+/* For animated images, add the image to list */
+int
+HtmlImageAddCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp;
+ int argc;
+ const char **argv;
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ int id;
+ char *z;
+ HtmlElement *p;
+ HtmlImage *pImage;
+ HtmlElement *pElem;
+
+ if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ p = HtmlTokenByIndex(htmlPtr, id, 0);
+ if (!p)
+ return TCL_ERROR;
+ if (p->base.type != Html_IMG)
+ return TCL_ERROR;
+ HtmlAddImages(htmlPtr, p, p->image.pImage, argv[3], 1);
+ return TCL_OK;
+}
+
+/* For animated images, set the currently active Image */
+int
+HtmlImageSetCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp;
+ int argc;
+ const char **argv;
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ int id, idx;
+ char *z;
+ HtmlElement *p;
+ HtmlImage *pImage;
+ HtmlElement *pElem;
+
+ if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK
+ || Tcl_GetInt(interp, argv[3], &idx) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (idx < 0)
+ return TCL_ERROR;
+ p = HtmlTokenByIndex(htmlPtr, id, 0);
+ if (!p)
+ return TCL_ERROR;
+ if (p->base.type != Html_IMG)
+ return TCL_ERROR;
+ pImage = p->image.pImage;
+ pImage->cur = idx;
+ for (pElem = pImage->pList; pElem; pElem = pElem->image.pNext)
+ pElem->image.redrawNeeded = 1;
+ htmlPtr->flags |= REDRAW_IMAGES;
+ HtmlScheduleRedraw(htmlPtr);
+ return TCL_OK;
+}
+
+/* Return 1 if item given by id is on visible screen */
+int
+HtmlOnScreen(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp;
+ int argc;
+ const char **argv;
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ int id, x, y, w, h;
+ char *z;
+ HtmlElement *p;
+ HtmlImage *pImage;
+ HtmlElement *pElem;
+ Tk_Window clipwin = htmlPtr->clipwin;
+
+ if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (!Tk_IsMapped(htmlPtr->tkwin)) {
+ Tcl_AppendResult(interp, "0", 0);
+ return TCL_OK;
+ }
+ w = Tk_Width(clipwin);
+ h = Tk_Height(clipwin);
+ x = htmlPtr->xOffset;
+ y = htmlPtr->yOffset;
+
+ p = HtmlTokenByIndex(htmlPtr, id, 0);
+ if (!p)
+ return TCL_ERROR;
+ Tcl_AppendResult(interp, "1", 0);
+ return TCL_OK;
+}
+
+int
+HtmlAttrOverCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ const char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ int x, y, n;
+ char z[50];
+
+ if (Tcl_GetInt(interp, argv[2], &x) != TCL_OK
+ || Tcl_GetInt(interp, argv[3], &y) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ HtmlGetAttrOver(htmlPtr, x + htmlPtr->xOffset, y + htmlPtr->yOffset,
+ argv[4]);
+ return TCL_OK;
+}
+
+int
+HtmlOverCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ const char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ int x, y, n;
+ char z[50];
+
+ if (Tcl_GetInt(interp, argv[2], &x) != TCL_OK
+ || Tcl_GetInt(interp, argv[3], &y) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ HtmlGetOver(htmlPtr, x + htmlPtr->xOffset, y + htmlPtr->yOffset, argc > 4);
+ return TCL_OK;
+}
+
+/*
+** WIDGET image X Y
+**
+** Returns the image src name that is beneath the position X,Y.
+** Returns {} if there is no image beneath X,Y.
+*/
+int
+HtmlImageAtCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ const char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ int x, y, n;
+ char z[50];
+
+ if (Tcl_GetInt(interp, argv[2], &x) != TCL_OK
+ || Tcl_GetInt(interp, argv[3], &y) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ n = HtmlGetImageAt(htmlPtr, x + htmlPtr->xOffset, y + htmlPtr->yOffset);
+ sprintf(z, "%d", n);
+ Tcl_SetResult(interp, z, TCL_VOLATILE);
+ return TCL_OK;
+}
+
+/* Set a background image for page, or table element. */
+int
+HtmlSetImageBg(htmlPtr, interp, imgname, p)
+ HtmlWidget *htmlPtr; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ CONST char *imgname;
+ HtmlElement *p;
+{
+ Tk_Image bgimg, *nimg;
+ int i;
+ if (!imgname)
+ bgimg = 0;
+ else
+ bgimg = Tk_GetImage(htmlPtr->interp, htmlPtr->clipwin,
+ imgname, BgImageChangeProc, htmlPtr);
+ if (!p)
+ nimg = &htmlPtr->bgimage;
+ else {
+ switch (p->base.type) {
+ case Html_TABLE:
+ nimg = &p->table.bgimage;
+ break;
+ case Html_TR:
+ nimg = &p->ref.bgimage;
+ break;
+ case Html_TH:
+ case Html_TD:
+ nimg = &p->cell.bgimage;
+ break;
+ default:
+ Tcl_AppendResult(interp, "bg index not TABLE,TD,TR, or TH:", 0);
+ return TCL_ERROR;
+ }
+ }
+ if (*nimg) {
+ Tk_FreeImage(*nimg);
+ }
+ *nimg = bgimg;
+ HtmlRedrawEverything(htmlPtr);
+ return TCL_OK;
+}
+
+/* Set a background image for page, or table element. */
+int
+HtmlImageBgCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ HtmlElement *p;
+ int i;
+ if (argc == 3)
+ return HtmlSetImageBg(htmlPtr, interp, argv[2], 0);
+ if (HtmlGetIndex(htmlPtr, argv[3], &p, &i) != 0 || !p) {
+ Tcl_AppendResult(interp, "malformed index: \"", argv[3], "\"", 0);
+ return TCL_ERROR;
+ }
+ return HtmlSetImageBg(htmlPtr, interp, argv[2], p);
+}
+
+static void
+HtmlToken2Txt(htmlPtr, interp, p)
+ HtmlWidget *htmlPtr;
+ Tcl_Interp *interp;
+ HtmlElement *p;
+{
+ static char zBuf[BUFSIZ];
+ int j;
+ char *zName;
+
+ if (p == 0)
+ return;
+ switch (p->base.type) {
+ case Html_Text:
+ Tcl_AppendResult(interp, p->text.zText, 0);
+ break;
+ case Html_Space:
+ if (p->base.flags & HTML_NewLine) {
+ Tcl_AppendResult(interp, "\"\\n\"", 0);
+ }
+ else {
+ Tcl_AppendResult(interp, "\" \"", 0);
+ }
+ break;
+ case Html_Block:
+ break;
+ default:
+ if (p->base.type >= HtmlGetMarkupMap(htmlPtr, 0)->type
+ && p->base.type <= HtmlGetMarkupMap(htmlPtr,
+ HTML_MARKUP_COUNT -
+ 1)->type) {
+ zName = HtmlGetMarkupMap(htmlPtr,
+ p->base.type -
+ HtmlGetMarkupMap(htmlPtr,
+ 0)->type)->zName;
+ }
+ else {
+ zName = "Unknown";
+ }
+ Tcl_AppendResult(interp, "<", zName, 0);
+ /*
+ * ??? Doesn't work
+ */
+ for (j = 1; j < p->base.count; j += 2) {
+ Tcl_AppendResult(interp, " ", p->markup.argv[j - 1], "=",
+ p->markup.argv[j]);
+ }
+ Tcl_AppendResult(interp, ">", 0);
+ break;
+ }
+}
+
+/* Return HTML with all image link names substitued with indexed. */
+int
+HtmlImagesListCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ HtmlElement *p;
+ char *z, buf[BUFSIZ];
+ int ishtml = 1, icnt = 0;
+ if (!strcmp(argv[2], "list"))
+ ishtml = 0;
+ else if (strcmp(argv[2], "html")) {
+ Tcl_AppendResult(interp, "invalid args", 0);
+ return TCL_ERROR;
+ }
+ p = htmlPtr->pFirst;
+ while (p) {
+ if (ishtml) {
+ switch (p->base.type) {
+ case Html_IMG:
+ sprintf(buf, "<img src=%d.img>", icnt++);
+ Tcl_AppendResult(interp, buf, 0);
+ break;
+ default:
+ HtmlToken2Txt(htmlPtr, interp, p);
+ }
+ }
+ else {
+ if (p->base.type == Html_IMG) {
+ z = HtmlMarkupArg(p, "src", 0);
+ if (z)
+ z = HtmlResolveUri(htmlPtr, z);
+ if (z) {
+ Tcl_AppendResult(interp, z, " ", 0);
+ HtmlFree(z);
+ }
+ }
+ }
+ p = p->pNext;
+ }
+ return TCL_OK;
+}
+
+int
+HtmlPostscriptCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+#if TKHTML_PS
+#ifdef USE_TCL_STUBS
+ if (!HtmlPostscriptPtr) {
+ Tcl_AppendResult(interp, "postscript command unimplemented", 0);
+ return TCL_ERROR;
+ }
+ return HtmlPostscriptPtr(htmlPtr, interp, argc, argv);
+#else
+ return HtmlPostscript(htmlPtr, interp, argc, argv);
+#endif
+#else
+ return TCL_ERROR;
+#endif
+}
+
+/*
+** WIDGET coords INDEX
+*/
+int
+HtmlCoordsCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ HtmlElement *p;
+ int i, pct = 0;
+
+ HtmlLock(htmlPtr);
+ if (argc <= 2) {
+ char wh[40];
+ if (!HtmlUnlock(htmlPtr)) {
+ sprintf(wh, "%d %d", htmlPtr->maxX, htmlPtr->maxY);
+ Tcl_AppendResult(interp, wh, 0);
+ }
+ return TCL_OK;
+ }
+ if (HtmlGetIndex(htmlPtr, argv[2], &p, &i) != 0) {
+ if (!HtmlUnlock(htmlPtr)) {
+ Tcl_AppendResult(interp, "malformed index: \"", argv[2], "\"", 0);
+ }
+ return TCL_ERROR;
+ }
+ if (argc > 3 && !strcmp(argv[3], "percent"))
+ pct = 1;
+ if (!HtmlUnlock(htmlPtr) && p) {
+ HtmlGetCoords(interp, htmlPtr, p, i, pct);
+ }
+ return TCL_OK;
+}
+
+int
+HtmlFetchSelection(clientData, offset, buffer, maxBytes)
+ ClientData clientData; /* Information about html widget. */
+ int offset; /* Offset within selection of first
+ * character to be returned. */
+ char *buffer; /* Location in which to place
+ * selection. */
+ int maxBytes; /* Maximum number of bytes to place *
+ * at buffer, not including
+ * terminating * NULL character. */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ int count;
+
+ if (!htmlPtr->exportSelection)
+ return 0;
+ if ((!htmlPtr->selEnd.p) || (!htmlPtr->selEnd.p))
+ return 0;
+ count = HtmlAscii2Buf(htmlPtr->interp, &htmlPtr->selBegin, &htmlPtr->selEnd,
+ buffer, maxBytes, offset);
+ buffer[count] = 0;
+ return count;
+}
+
+#if 0
+void
+HtmlLostSelection(ClientData clientData)
+{ /* Information about table widget. */
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ char *argv[3];
+ argv[2] = "";
+ if (htmlPtr->exportSelection) {
+ HtmlSelectionClearCmd(htmlPtr, 0, 3, argv);
+ }
+}
+#endif
+
+#define DUMPIMGDRAW printf("BGIM: mx/my=%d/%d", mx, my); \
+ printf("sx/sy=%d,%d: ",sx,sy); \
+ printf("sw/sh=%d,%d ", sw,sh); \
+ printf("left/top=%d,%d ", left,top); \ \
+ printf("w/h=%d,%d ", w,h);
+
+int
+HtmlBGDraw(htmlPtr, left, top, w, h, pixmap, image)
+ HtmlWidget *htmlPtr;
+ int left;
+ int top;
+ int w;
+ int h;
+ Pixmap pixmap;
+ Tk_Image image;
+{
+ int iw, ih, mx, my, dl, dt, sh, sw, sx, sy;
+ dl = htmlPtr->dirtyLeft, dt = htmlPtr->dirtyTop;
+ Tk_SizeOfImage(image, &iw, &ih);
+ if (iw < 4 && ih < 4)
+ return 0; /* CPU Burners we ignore. */
+ /*
+ * if (iw<=4 || ih<=4) return 0; Buggy gifs?
+ */
+ sx = (left + dl) % iw; /* X offset within image to start from */
+ sw = (iw - sx); /* Width of section of image to draw. */
+ for (mx = 0; mx < w; mx += sw, sw = iw, sx = 0) {
+ sy = (top + dt) % ih; /* Y offset within image to start from */
+ sh = (ih - sy); /* Height of section of image to draw. */
+ for (my = 0; my < h; my += sh, sh = ih, sy = 0) {
+ /*
+ * printf("Tk_RedrawImage: %d %d %d %d %d %d\n", sx, sy, sw, sh,
+ * mx,my);
+ */
+ Tk_RedrawImage(image, sx, sy, sw, sh, pixmap, mx, my);
+ }
+ }
+ return 1;
+}
+
+int
+HtmlTblBGDraw(htmlPtr, l, t, w, h, pixmap, image)
+ HtmlWidget *htmlPtr;
+ int l;
+ int t;
+ int w;
+ int h;
+ Pixmap pixmap;
+ Tk_Image image;
+{
+ int iw, ih, mx, my, dl, dt, dr, db, sh, sw, sx, sy, left = l, top = t,
+ right, bottom, hd;
+ left -= htmlPtr->xOffset;
+ top -= htmlPtr->yOffset;
+ dl = htmlPtr->dirtyLeft;
+ dt = htmlPtr->dirtyTop;
+ dr = htmlPtr->dirtyRight;
+ db = htmlPtr->dirtyBottom;
+ right = left + w - 1;
+ bottom = top + h - 1;
+ if (dr == 0 && db == 0) {
+ dr = right;
+ db = bottom;
+ }
+ if (left > dr || right < dl || top > db || bottom < dt)
+ return 0;
+ Tk_SizeOfImage(image, &iw, &ih);
+ if (iw < 4 && ih < 4)
+ return 0; /* CPU Burners we ignore. */
+ sx = (dl < left ? 0 : (left - dl) % iw); /* X offset within image to
+ * start from */
+ sw = (iw - sx); /* Width of section of image to draw. */
+ for (mx = left - dl; w > 0; mx += sw, sw = iw, sx = 0) {
+ if (sw > w)
+ sw = w;
+ sy = (dt < top ? 0 : (top - dt) % ih); /* Y offset within image to
+ * start from */
+ sh = (ih - sy); /* Height of section of image to draw. */
+ for (my = top - dt, hd = h; hd > 0; my += sh, sh = ih, sy = 0) {
+ if (sh > hd)
+ sh = hd;
+ /*
+ * printf("Tk_RedrawImage: %d %d %d %d %d %d\n", sx, sy, sw, sh,
+ * mx,my);
+ */
+ Tk_RedrawImage(image, sx, sy, sw, sh, pixmap, mx, my);
+ hd -= sh;
+ }
+ w -= sw;
+ }
+ return 1;
+}
+
+/*
+** This routine searchs for an image beneath the coordinates x,y
+** and returns src name to the image. The text
+** is held one of the markup.argv[] fields of the <a> markup.
+*/
+int
+HtmlGetImageAt(htmlPtr, x, y)
+ HtmlWidget *htmlPtr;
+ int x;
+ int y;
+{
+ HtmlBlock *pBlock;
+ HtmlElement *pElem;
+ int n;
+
+ for (pBlock = htmlPtr->firstBlock; pBlock; pBlock = pBlock->pNext) {
+ if (pBlock->top > y || pBlock->bottom < y
+ || pBlock->left > x || pBlock->right < x) {
+ continue;
+ }
+ for (pElem = pBlock->base.pNext; pElem; pElem = pElem->pNext) {
+ if (pBlock->pNext && pElem == pBlock->pNext->base.pNext)
+ break;
+ if (pElem->base.type == Html_IMG) {
+ return HtmlTokenNumber(pElem);
+ }
+ }
+ }
+ return -1;
+}
+
+/* Find all attrs in attr list if over object. */
+int
+HtmlGetAttrOver(htmlPtr, x, y, attr)
+ HtmlWidget *htmlPtr;
+ int x;
+ int y;
+ char *attr;
+{
+ HtmlBlock *pBlock;
+ HtmlElement *pElem;
+ int n = 0, vargc, i, j;
+ char *z, *az;
+ CONST char **vargv;
+
+ if (Tcl_SplitList(htmlPtr->interp, attr, &vargc, &vargv) || vargc <= 0) {
+ Tcl_AppendResult(htmlPtr->interp, "attrover error: ", attr, 0);
+ return TCL_ERROR;
+ }
+
+ for (pBlock = htmlPtr->firstBlock; pBlock; pBlock = pBlock->pNext) {
+ if (pBlock->top > y || pBlock->bottom < y
+ || pBlock->left > x || pBlock->right < x) {
+ continue;
+ }
+ for (pElem = pBlock->base.pNext; pElem; pElem = pElem->pNext) {
+ if (pBlock->pNext && pElem == pBlock->pNext->base.pNext)
+ break;
+ if (HtmlIsMarkup(pElem)) {
+ char nbuf[50];
+ int fnd = 0;
+ for (i = 0; i < pElem->base.count; i += 2) {
+ az = pElem->markup.argv[i];
+ for (j = 0; j < vargc; j++)
+ if (az[0] == vargv[j][0] && (!strcmp(az, vargv[j]))) {
+ fnd = 1;
+ break;
+ }
+ if (j < vargc)
+ break;
+ }
+ if (fnd) {
+ sprintf(nbuf, "%d ", HtmlTokenNumber(pElem));
+ Tcl_AppendResult(htmlPtr->interp, nbuf, 0);
+ }
+ }
+ }
+ }
+ HtmlFree(vargv);
+ return TCL_OK;
+}
+
+int
+HtmlGetOver(htmlPtr, x, y, justmarkup)
+ HtmlWidget *htmlPtr;
+ int x;
+ int y;
+ int justmarkup;
+{
+ HtmlBlock *pBlock;
+ HtmlElement *pElem;
+ int n = 0, i, j;
+ char *z, *az;
+
+ for (pBlock = htmlPtr->firstBlock; pBlock; pBlock = pBlock->pNext) {
+ if (pBlock->top > y || pBlock->bottom < y
+ || pBlock->left > x || pBlock->right < x) {
+ continue;
+ }
+ for (pElem = pBlock->base.pNext; pElem; pElem = pElem->pNext) {
+ char nbuf[50];
+ if (pBlock->pNext && pElem == pBlock->pNext->base.pNext)
+ break;
+ if (HtmlIsMarkup(pElem) || (!justmarkup)) {
+ sprintf(nbuf, "%d ", HtmlTokenNumber(pElem));
+ Tcl_AppendResult(htmlPtr->interp, nbuf, 0);
+ }
+ }
+ }
+ return TCL_OK;
+}
+
+/* Return the form colors, etc */
+int
+OldHtmlFormColors(htmlPtr, fid)
+ HtmlWidget *htmlPtr;
+ int fid;
+{
+ HtmlElement *p;
+ for (p = htmlPtr->pFirst; p; p = p->pNext) {
+ if (p->base.type == Html_FORM) {
+ if (p->form.id == fid) {
+ char buf[BUFSIZ];
+ int bg = p->base.style.bgcolor;
+ int fg = p->base.style.color;
+ XColor *cbg = htmlPtr->apColor[bg];
+ XColor *cfg = htmlPtr->apColor[fg];
+ sprintf(buf, "%s %s", Tk_NameOfColor(cfg), Tk_NameOfColor(cbg));
+ Tcl_AppendResult(htmlPtr->interp, buf, 0);
+ return TCL_OK;
+ }
+ }
+ }
+ return TCL_OK;
+}
+
+char *
+Clr2Name(str)
+ const char *str;
+{
+ static char buf[50];
+ if (str[0] == '#') {
+ strcpy(buf, str);
+ buf[17] = 0;
+ }
+ else {
+ int l = strlen(str), n = strspn(str, "abcdefABCDEF0123456789");
+ if (n == l) {
+ buf[0] = '#';
+ strncpy(buf + 1, str, 16);
+ buf[17] = 0;
+ }
+ else
+ strcpy(buf, str);
+ }
+ return buf;
+}
+
+/* Return the form colors, etc */
+int
+HtmlFormColors(htmlPtr, fid, n)
+ HtmlWidget *htmlPtr;
+ int fid;
+ int n;
+{
+ HtmlElement *p, *pf = 0;
+ for (p = htmlPtr->pFirst; p; p = p->pNext) {
+ if (p->base.type == Html_INPUT) {
+ if (!p->input.pForm)
+ continue;
+ if (p->input.pForm->form.id != fid)
+ continue;
+ pf = p;
+ if (--n)
+ break; /* Not working properly */
+ }
+ }
+ if (pf) {
+ char buf[BUFSIZ];
+ CONST char *c1;
+ CONST char *c2;
+ int bg = pf->base.style.bgcolor;
+ int fg = pf->base.style.color;
+ XColor *cbg = htmlPtr->apColor[bg];
+ XColor *cfg = htmlPtr->apColor[fg];
+#if 0
+ sprintf(buf, "%s %s", Tk_NameOfColor(cfg), Tk_NameOfColor(cbg));
+#else
+ c1 = Tk_NameOfColor(cfg);
+ strcpy(buf, Clr2Name(c1));
+ c2 = Tk_NameOfColor(cbg);
+ strcat(buf, " ");
+ strcat(buf, Clr2Name(c2));
+#endif
+ Tcl_AppendResult(htmlPtr->interp, buf, 0);
+ return TCL_OK;
+ }
+ return TCL_OK;
+}
+
+/* Get Form info. */
+int
+HtmlFormInfo(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ if (argc >= 4)
+ return HtmlFormColors(htmlPtr, atoi(argv[2]), atoi(argv[3]));
+ return TCL_OK;
+}
+
+#endif /* _TCLHTML_ */
+
+int
+HtmlGetEndToken(htmlPtr, typ)
+ HtmlWidget *htmlPtr;
+ int typ;
+{
+ HtmlTokenMap *pMap = HtmlGetMarkupMap(htmlPtr, typ - Html_A);
+ if (!pMap)
+ return Html_Unknown;
+ if (pMap && pMap[1].zName[0] == '/')
+ return pMap[1].type;
+ return Html_Unknown;
+}
+
+int
+HtmlNameToTypeAndEnd(htmlPtr, zType, end)
+ HtmlWidget *htmlPtr;
+ char *zType;
+ int *end;
+{
+ HtmlTokenMap *pMap = HtmlHashLookup(htmlPtr, zType);
+ if (*end)
+ *end = Html_Unknown;
+ if (!pMap)
+ return Html_Unknown;
+ if (pMap[1].zName[0] == '/')
+ *end = pMap[1].type;
+ return pMap->type;
+}
+
+#define DOMMAXTOK 128
+static char *TagAliases[] = {
+ "anchor", "a",
+ "link", "a",
+ "row", "tr",
+ "rows", "tr",
+ "col", "td",
+ "cols", "td",
+ "column", "td",
+ "columns", "td",
+ "element", "input",
+ "elements", "input",
+ "options", "option",
+ 0, 0
+};
+
+static int
+HtmlDomSubEl(htmlPtr, tok, en)
+ HtmlWidget *htmlPtr;
+ char *tok;
+ int *en;
+{
+ int n, i, j;
+ for (i = 0; tok[i]; i++) {
+ tok[i] = tolower(tok[i]);
+ }
+ if (!i) {
+ return Html_Unknown;
+ }
+ for (j = 0; TagAliases[j]; j += 2) {
+ if (StrEqual(tok, TagAliases[j])) {
+ strcpy(tok, TagAliases[j + 1]);
+ break;
+ }
+ }
+ n = HtmlNameToTypeAndEnd(htmlPtr, tok, en);
+ if (n == Html_Unknown) {
+ if (tok[--i] != 's')
+ return Html_Unknown;
+ tok[i] = 0;
+ n = HtmlNameToTypeAndEnd(htmlPtr, tok, en);
+ }
+ return n;
+}
+
+static HtmlElement *
+HtmlFindEndPOther(htmlPtr, sp, op)
+ HtmlWidget *htmlPtr;
+ HtmlElement *sp;
+ HtmlElement *op;
+{
+ HtmlElement *p = sp;
+ while (p) {
+ if (p->base.type == sp->base.type) {
+ if (p->ref.pOther == op)
+ return p;
+ }
+ p = p->base.pNext;
+ }
+ return p;
+}
+
+/* Find End tag en, but ignore intervening begin/end tag pairs. */
+HtmlElement *
+HtmlFindEndNest(htmlPtr, sp, en, lp)
+ HtmlWidget *htmlPtr;
+ HtmlElement *sp; /* Pointer to start from. */
+ int en; /* End tag to search for */
+ HtmlElement *lp; /* Last pointer to try. */
+{
+ HtmlElement *p = sp->pNext;
+ int lvl = 0, n = sp->base.type;
+ while (p) {
+ if (p == lp)
+ return 0;
+ if (n == Html_LI) {
+ if (p->base.type == Html_LI || p->base.type == Html_EndUL ||
+ p->base.type == Html_EndOL) {
+ if (p->base.pPrev)
+ return p->base.pPrev;
+ return p;
+ }
+ }
+ else if (p->base.type == n) {
+ if (n == Html_OPTION) {
+ if (p->base.pPrev)
+ return p->base.pPrev;
+ return p;
+ }
+ lvl++;
+ }
+ else if (p->base.type == en) {
+ if (!lvl--)
+ return p;
+ }
+ switch (p->base.type) {
+ case Html_TABLE:
+ p = p->table.pEnd;
+ break; /* Optimization */
+ case Html_FORM:
+ p = p->form.pEnd;
+ break;
+ default:
+ p = p->base.pNext;
+ }
+ }
+ return 0;
+}
+
+/* Return element ptr to matching end tag, if any. For T? ignore nested tables. */
+static HtmlElement *
+HtmlFindEndTag(htmlPtr, p, tok, n, en, tp)
+ HtmlWidget *htmlPtr; /* The HTML widget */
+ HtmlElement *p;
+ char *tok;
+ int n;
+ int en;
+ HtmlElement *tp;
+{
+ HtmlElement *ep = p->base.pNext;
+ int lvl = 0;
+ char buf[DOMMAXTOK + 1];
+
+ if (en == Html_Unknown)
+ return p;
+ switch (n) {
+ case Html_TH:
+ case Html_TR:
+ case Html_TD:
+ goto potherelem;
+ case Html_FORM:
+ goto nestelem;
+ case Html_INPUT:{
+ n = p->input.type;
+ }
+ default:
+ while (ep) {
+ if (ep->base.type == en)
+ break;
+ ep = ep->base.pNext;
+ }
+ return ep;
+ }
+ return 0;
+
+/* buf[0]='/';
+ strcpy(buf+1,tok);
+ if ((en=HtmlNameToType(htmlPtr,tok))==Html_Unknown) return 0;
+ while (ep && ep->base.type!=en) ep=ep->base.pNext;
+ return ep;
+ */
+
+ potherelem: /* Find matching end tag via pOther field. */
+ while (ep) {
+ if (ep->base.type == tp->base.type)
+ return 0;
+ else if (ep->base.type == en) {
+ if (ep->ref.pOther == tp)
+ return ep;
+ }
+ ep = ep->base.pNext;
+ }
+ return ep;
+
+ nestelem: /* Find matching end tag via nesting counter.
+ */
+ while (ep) {
+ if (ep->base.type == n)
+ lvl++;
+ else if (ep->base.type == en) {
+ if (!lvl--)
+ return p;
+ }
+ ep = ep->base.pNext;
+ }
+ return ep;
+}
+
+#define DOMFORMEQ(n) (n==Html_INPUT || n==Html_SELECT || n==Html_TEXTAREA)
+#define DOMTAGEQ(n,t) (n==t || (DOMFORMEQ(n) && DOMFORMEQ(t)))
+
+/* Get the index'th element of type n.
+ When index is "", format integer value of max index into tok.
+ */
+static HtmlElement *
+HtmlDOMGetIndex(htmlPtr, p, interp, n, en, tok, a, ip, tp, tlim, aflag)
+ HtmlWidget *htmlPtr;
+ HtmlElement *p;
+ Tcl_Interp *interp;
+ int n; /* Tag to search for */
+ int en; /* End tag */
+ char *tok;
+ char *a;
+ int *ip;
+ HtmlElement *tp; /* Top pointer, tag were nested in. */
+ HtmlElement *tlim; /* Limit to stop at */
+ int aflag;
+{
+ int i = *ip, j, k, l, idx = 0;
+ char buf[DOMMAXTOK], *z;
+ if (a[i + 1] == '\"')
+ i++;
+ for (j = i + 1, k = 0;
+ a[j] != ']' && a[j] != '\"' && a[j] != ')' && k < DOMMAXTOK; j++, k++)
+ buf[k] = a[j];
+ if (a[j] == '\"')
+ j++;
+ if ((a[*ip] == '(' && a[j] == ')') || (a[*ip] == '[' && a[j] == ']')) {
+ int isint = 0;
+ buf[k] = 0;
+ if (!k) {
+ if ((idx = HtmlFormCount(htmlPtr, p, 0)) > 0)
+ goto fmtidx;
+ idx = 0;
+ }
+ for (l = 0; l < k && isdigit(buf[l]); l++);
+ if (l == k) {
+ idx = atoi(buf);
+ isint = 1;
+ }
+ while (p) {
+ if (p == tlim) {
+ p = 0;
+ break;
+ }
+ if (DOMTAGEQ(n, p->base.type)) {
+ if (isint) {
+ if (aflag) {
+ z = HtmlMarkupArg(p, "href", 0);
+ if ((aflag == 2 && !z) || (aflag == 1 && z)) {
+ p = p->base.pNext;
+ continue;
+ }
+ }
+ if (k > 0) {
+ if (idx)
+ idx--;
+ else
+ break;
+ }
+ else {
+ idx++;
+ }
+ }
+ else {
+ z = HtmlMarkupArg(p, "name", 0);
+ if (z && (!strcmp(z, buf))) {
+ break;
+ }
+ }
+ if (en != Html_Unknown)
+ p = HtmlFindEndNest(htmlPtr, p, en, 0);
+ /*
+ * p=HtmlFindEndTag(htmlPtr,p,tok,n, en,tp);
+ */
+ }
+ if (p)
+ p = p->base.pNext;
+ }
+ if (!k)
+ goto fmtidx;
+ if (!p) {
+ Tcl_AppendResult(interp, "DOM element not found: ", tok, "(", buf,
+ ")", 0);
+ return 0;
+ }
+ }
+ else {
+ Tcl_AppendResult(interp, "invalid index: ", tok, 0);
+ return 0;
+ }
+ *ip = j + 1;
+ return p;
+
+ fmtidx:
+ sprintf(tok, "%d", idx);
+ *ip = *ip + 1;
+ return 0;
+}
+
+/* Get elements ala DOM style. eg.
+ $w dom id table
+ $w dom id table(4)
+ $w dom value table(4).row(0)
+ $w dom value table(4).row(0).col(0).value 99
+ $w dom value form(4).elements(0).value "Dogmeat"
+ $w dom value form(4).textarea.value "Dogmeat"
+ $w dom value form[4].elements[0].value # Also accepts square brackets.
+ $w dom value form["SALES"].elements["NAME"].value # or use name attr as index.
+*/
+int
+HtmlDomIdLookup(htmlPtr, cname, dname, pp)
+ HtmlWidget *htmlPtr;
+ const char *cname;
+ const char *dname;
+ HtmlElement **pp;
+{
+ Tcl_DString cmd;
+
+ Tcl_Interp *interp = htmlPtr->interp;
+ char tok[DOMMAXTOK], *a, *z;
+ HtmlElement *p, *ep, *tp = 0, *tlim = 0;
+ int n = 0, ni = 0, en, i, iswrite = 0, aflag;
+ int isvalue = !strcmp(cname, "value");
+ a = (char *) dname;
+
+ p = htmlPtr->pFirst;
+ while (a[0]) {
+ aflag = 0;
+ if ((a[0] == '(' || a[0] == '[') && (a[1] == ')' || a[1] == ']')
+ && !a[2]) {
+ if (isvalue || p->base.type != Html_INPUT)
+ goto idluperr;
+ if (!(z = HtmlMarkupArg(p, "type", 0)))
+ goto idluperr;
+ if (strcmp(z, "radio"))
+ goto idluperr;
+ sprintf(tok, "%d", HtmlRadioCount(htmlPtr, p));
+ Tcl_AppendResult(interp, tok, 0);
+ return TCL_OK;
+ }
+ for (i = 0; isalnum(a[i]) && i < DOMMAXTOK; i++) {
+ tok[i] = a[i];
+ }
+ tok[i] = 0;
+ if (isvalue && (!a[i])) {
+ z = HtmlMarkupArg(p, tok, 0);
+ Tcl_AppendResult(interp, z ? z : "", 0);
+ return TCL_OK;
+ }
+ if ((n = HtmlDomSubEl(htmlPtr, tok, &en)) == Html_Unknown) {
+ /*
+ * Tcl_AppendResult(interp, "Unknown DOM markup: ", a, 0); return
+ * TCL_ERROR;
+ */
+ return TCL_OK;
+ }
+ if (StrEqual(tok, "anchor")) {
+ aflag = 1;
+ n = Html_A;
+ en = Html_EndA;
+ }
+ else if (StrEqual(tok, "link")) {
+ aflag = 2;
+ n = Html_A;
+ en = Html_EndA;
+ }
+ ni++;
+ if (a[i] == '(' || a[i] == '[') {
+ int savei = i;
+ if (!
+ ((p =
+ HtmlDOMGetIndex(htmlPtr, p, interp, n,
+ ni == 1 ? Html_Unknown : en, tok, a, &i, tp,
+ tlim, aflag)))) {
+ if (savei == (i - 1)) {
+ Tcl_SetResult(interp, tok, TCL_VOLATILE);
+ if (pp) {
+ *pp = p;
+ Tcl_ResetResult(interp);
+ }
+ return TCL_OK;
+ }
+ Tcl_AppendResult(interp, "Invalid index", 0);
+ return TCL_ERROR;
+ }
+ if (ni) {
+ switch (p->base.type) {
+ case Html_TABLE:
+ tlim = HtmlFindEndNest(htmlPtr, p, Html_EndTABLE, 0);
+ break;
+ case Html_TD:
+ tlim = HtmlFindEndNest(htmlPtr, p, Html_EndTD, 0);
+ break;
+ case Html_TR:
+ tlim = HtmlFindEndNest(htmlPtr, p, Html_EndTR, 0);
+ break;
+ case Html_FORM:
+ tlim = HtmlFindEndNest(htmlPtr, p, Html_EndFORM, 0);
+ break;
+ case Html_UL:
+ tlim = HtmlFindEndNest(htmlPtr, p, Html_EndUL, 0);
+ break;
+ case Html_OL:
+ tlim = HtmlFindEndNest(htmlPtr, p, Html_EndOL, 0);
+ break;
+ case Html_DL:
+ tlim = HtmlFindEndNest(htmlPtr, p, Html_EndDL, 0);
+ break;
+ }
+ tp = p;
+ }
+ a = a + i;
+ }
+ if (*a == '.') {
+ a++;
+ }
+ else if (*a) {
+ Tcl_AppendResult(htmlPtr->interp, "Unexpected char ", a, " in tok ",
+ dname, 0);
+ return TCL_ERROR;
+ }
+ }
+
+ if (ni && isvalue) {
+ Tcl_DStringInit(&cmd);
+ HtmlAppendArglist(&cmd, p);
+ Tcl_DStringResult(interp, &cmd);
+ return TCL_OK;
+ }
+
+ if (!strcmp(cname, "ids")) {
+ if (!tlim)
+ tlim = HtmlFindEndTag(htmlPtr, p->pNext, tok, n, en, tp);
+ if (p->base.type == Html_OPTION) {
+ tlim = p->pNext;
+ while (tlim) {
+ int ty = tlim->base.type;
+ if (ty == Html_EndOPTION || ty == Html_EndSELECT
+ || ty == Html_EndFORM || ty == Html_OPTION
+ || ty == Html_INPUT)
+ break;
+ tlim = tlim->pNext;
+ }
+ }
+ sprintf(tok, "%d %d", p ? HtmlTokenNumber(p) : -1,
+ tlim ? HtmlTokenNumber(tlim) : -1);
+ }
+ else
+ sprintf(tok, "%d", p ? HtmlTokenNumber(p) : -1);
+ Tcl_AppendResult(interp, tok, 0);
+ if (pp) {
+ Tcl_ResetResult(interp);
+ *pp = p;
+ }
+ return TCL_OK;
+
+ idluperr:
+ Tcl_AppendResult(interp, "Error in dom id", cname, " ", dname, 0);
+ return TCL_ERROR;
+}
+
+int
+HtmlDomCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ return HtmlDomIdLookup(htmlPtr, argv[2], argv[3], 0);
+}
+
+/* Count the number of tags of tp->typ before tp (inclusive). */
+int
+HtmlCountTagsBefore(htmlPtr, tag, tp, etag)
+ HtmlWidget *htmlPtr;
+ int tag;
+ HtmlElement *tp;
+ int etag;
+{
+ HtmlElement *p;
+ int i = 0;
+ if (etag != Html_Unknown) {
+ p = tp;
+ while (p) {
+ if (p->base.type == tag)
+ i++;
+ if (p->base.type == etag)
+ return i;
+ p = p->base.pPrev;
+ }
+ return i;
+ }
+ p = htmlPtr->pFirst;
+ while (p) {
+ if (tag == p->base.type)
+ i++;
+ if (tp == p)
+ return i;
+ p = p->base.pNext;
+ }
+ return 0;
+}
+
+HtmlElement *
+HtmlInObject(p, tag, endtag)
+ HtmlElement *p;
+ int tag;
+ int endtag;
+{
+ int lvl = 0;
+ p = p->base.pNext;
+ while (p) {
+ if (p->base.type == tag)
+ lvl++;
+ else if (p->base.type == endtag)
+ if (!(lvl--))
+ break;
+ p = p->base.pNext;
+ }
+ return p;
+}
+
+/* If inside tag, format the subindex. */
+int
+HtmlDOMFmtSubIndexGen(htmlPtr, pStart, cmd, tag, str, pretag, tp, nostr)
+ HtmlWidget *htmlPtr;
+ HtmlElement *pStart;
+ Tcl_DString *cmd;
+ int tag;
+ char *str;
+ int pretag;
+ HtmlElement *tp;
+ int nostr;
+{
+ char *z;
+ if (!tp)
+ return 0;
+ if (pretag != Html_Unknown)
+ Tcl_DStringAppend(cmd, ".", -1);
+ Tcl_DStringAppend(cmd, str, -1);
+ Tcl_DStringAppend(cmd, "(", -1);
+ if ((!nostr) && (z = HtmlMarkupArg(tp, "name", 0))) {
+ Tcl_DStringAppend(cmd, "\"", -1);
+ Tcl_DStringAppend(cmd, z, -1);
+ Tcl_DStringAppend(cmd, "\"", -1);
+ }
+ else {
+ char buf[50];
+ sprintf(buf, "%d",
+ HtmlCountTagsBefore(htmlPtr, tag, pStart, pretag) - 1);
+ Tcl_DStringAppend(cmd, buf, -1);
+ }
+ Tcl_DStringAppend(cmd, ")", -1);
+ return 1;
+}
+
+HtmlElement *
+HtmlFindBefore(p, tag)
+ HtmlElement *p;
+ int tag;
+{
+ while (p) {
+ if (p->base.type == tag)
+ return p;
+ p = p->base.pPrev;
+ }
+ return 0;
+}
+
+/* If inside tag, format the subindex. */
+int
+HtmlDOMFmtSubIndex(htmlPtr, pStart, cmd, tag, endtag, str, pretag, tp, nostr)
+ HtmlWidget *htmlPtr;
+ HtmlElement **pStart;
+ Tcl_DString *cmd;
+ int tag; /* Tag we are formatting for */
+ int endtag;
+ char *str;
+ int pretag;
+ HtmlElement *tp;
+ int nostr;
+{
+ HtmlElement *ep, *p = *pStart;
+
+/* while (p && p->base.type != tag) p=p->pNext;
+ *pStart=p; */
+ if (!p)
+ return 0;
+ if ((ep = HtmlInObject(p, tag, endtag))) {
+ if (!tp) {
+ if (!ep)
+ return 0;
+ if (ep->base.type != Html_EndLI)
+ tp = ep->ref.pOther;
+ else
+ tp = HtmlFindBefore(ep, Html_LI);
+ }
+ return HtmlDOMFmtSubIndexGen(htmlPtr, p, cmd, tag, str, pretag, tp,
+ nostr);
+ }
+ return 0;
+}
+
+int
+HtmlTextTable(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ HtmlElement *p;
+ Tcl_DString str;
+ int rc, i, flags = 0;
+ if (HtmlGetIndex(htmlPtr, argv[3], &p, &i) != 0) {
+ Tcl_AppendResult(interp, "malformed index: \"", argv[3], "\"", 0);
+ return TCL_ERROR;
+ }
+ if (p->base.type != Html_TABLE) {
+ Tcl_AppendResult(interp, "Not a table: \"", argv[3], "\"", 0);
+ return TCL_ERROR;
+ }
+ while (argc > 4) {
+ if (!strcmp(argv[4], "-images"))
+ flags |= 1;
+ if (!strcmp(argv[4], "-attrs"))
+ flags |= 2;
+ argc--;
+ argv++;
+ }
+ rc = HtmlTableText(htmlPtr, p, interp, flags, &str);
+ Tcl_DStringResult(interp, &str);
+ /*
+ * Tcl_DStringFree(&str);
+ */
+ return rc;
+}
+
+/* Given an ID, return the DOM style string address for the item.
+ eg. tables[0].rows[1].columns[2] or hr[5].
+ You can specify -tag table to try a table spec first.
+ */
+int
+HtmlIdToDomCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ Tcl_DString cmd;
+ char buf[100];
+ CONST char *a = argv[3];
+ char *z;
+ int try[10], ti = 0, en, i = 0, k, j, l, n, iswrite = 0, atend, lvl = 0;
+ int sc = 1, nostr = 0; /* Short-circuit */
+ HtmlElement *p, *tp = 0, *fp = 0;
+ HtmlElement *pStart = 0;
+ Tcl_DStringInit(&cmd);
+ try[i++] = Html_FORM;
+ try[i++] = Html_TABLE;
+ try[i++] = Html_UL;
+ try[i++] = Html_Unknown;
+ try[i++] = -1;
+
+ if (HtmlGetIndex(htmlPtr, argv[3], &pStart, &i) != 0) {
+ Tcl_AppendResult(interp, "malformed index: \"", argv[3], "\"", 0);
+ return TCL_ERROR;
+ }
+ if (!pStart)
+ return TCL_OK;
+ n = 4;
+ while ((n + 1) < argc) {
+ if (!strcmp(argv[n], "-tag")) {
+ if ((k = HtmlNameToType(htmlPtr, argv[n + 1])) != Html_Unknown) {
+ for (j = i; j > 0; j--)
+ try[j] = try[j - 1];
+ try[0] = k;
+ }
+ }
+ else if (!strcmp(argv[n], "-nostring")) {
+ nostr = atoi(argv[n + 1]);
+ }
+ else {
+ Tcl_AppendResult(interp, "dom addr: unknown flag: \"", argv[n],
+ "\"", 0);
+ return TCL_ERROR;
+ }
+ n += 2;
+ }
+ while (try[ti] >= 0) {
+ tp = pStart;
+ switch (try[ti++]) {
+ case Html_UL:
+ if (HtmlDOMFmtSubIndex
+ (htmlPtr, &tp, &cmd, Html_UL, Html_EndUL, "ul",
+ Html_Unknown, 0, nostr)) {
+ if (sc && tp->base.type == Html_UL)
+ goto domfmtdone;
+ if (HtmlDOMFmtSubIndex
+ (htmlPtr, &tp, &cmd, Html_LI, Html_EndLI, "li", Html_UL,
+ 0, nostr)) {
+ }
+ goto domfmtdone;
+ }
+ else if (HtmlDOMFmtSubIndex
+ (htmlPtr, &tp, &cmd, Html_OL, Html_EndOL, "ol",
+ Html_Unknown, 0, nostr)) {
+ if (sc && tp->base.type == Html_OL)
+ goto domfmtdone;
+ if (HtmlDOMFmtSubIndex
+ (htmlPtr, &tp, &cmd, Html_LI, Html_EndLI, "li", Html_UL,
+ 0, nostr)) {
+ }
+ goto domfmtdone;
+ }
+ break;
+ case Html_FORM:
+ if (HtmlDOMFmtSubIndex
+ (htmlPtr, &tp, &cmd, Html_FORM, Html_EndFORM, "forms",
+ Html_Unknown, 0, nostr)) {
+ if (sc && tp->base.type == Html_FORM)
+ goto domfmtdone;
+ if (tp->base.type == Html_INPUT &&
+ HtmlDOMFmtSubIndexGen(htmlPtr, tp, &cmd, Html_INPUT,
+ "elements", Html_FORM, tp,
+ nostr)) {
+ if (sc && tp->base.type == Html_INPUT)
+ goto domfmtdone;
+ }
+ else if (HtmlDOMFmtSubIndex
+ (htmlPtr, &tp, &cmd, Html_SELECT, Html_EndSELECT,
+ "elements", Html_FORM, 0, nostr)) {
+ if (sc && tp->base.type == Html_SELECT)
+ goto domfmtdone;
+ }
+ else if (HtmlDOMFmtSubIndex
+ (htmlPtr, &tp, &cmd, Html_TEXTAREA,
+ Html_EndTEXTAREA, "elements", Html_FORM, 0,
+ nostr)) {
+ if (sc && tp->base.type == Html_TEXTAREA)
+ goto domfmtdone;
+ }
+ goto domfmtdone;
+ }
+ break;
+ case Html_TABLE:
+ if (HtmlDOMFmtSubIndex
+ (htmlPtr, &tp, &cmd, Html_TABLE, Html_EndTABLE, "tables",
+ Html_Unknown, 0, nostr)) {
+ if (sc && tp->base.type == Html_TABLE)
+ goto domfmtdone;
+ if (HtmlDOMFmtSubIndex
+ (htmlPtr, &tp, &cmd, Html_TR, Html_EndTR, "rows",
+ Html_TABLE, 0, nostr)) {
+ if (sc && tp->base.type == Html_TR)
+ goto domfmtdone;
+ if (HtmlDOMFmtSubIndex
+ (htmlPtr, &tp, &cmd, Html_TD, Html_EndTD, "columns",
+ Html_TR, 0, nostr)) {
+ if (sc && tp->base.type == Html_TD)
+ goto domfmtdone;
+ }
+ }
+ else if (HtmlDOMFmtSubIndex
+ (htmlPtr, &tp, &cmd, Html_TH, Html_EndTH, "rows",
+ Html_TABLE, 0, nostr)) {
+ if (sc && tp->base.type == Html_TH)
+ goto domfmtdone;
+ if (HtmlDOMFmtSubIndex
+ (htmlPtr, &tp, &cmd, Html_TD, Html_EndTD, "columns",
+ Html_TH, 0, nostr)) {
+ if (sc && tp->base.type == Html_TD)
+ goto domfmtdone;
+ }
+ }
+ goto domfmtdone;
+ }
+ break;
+ default:
+ if (HtmlIsMarkup(pStart)) {
+ int etyp, typ;
+ char *setyp, *styp = HtmlGetTokenName(htmlPtr, pStart);
+ if (styp[0] != '/') {
+ typ = pStart->base.type;
+ if ((etyp =
+ HtmlGetEndToken(htmlPtr, typ)) != Html_Unknown)
+ if (HtmlDOMFmtSubIndex
+ (htmlPtr, &pStart, &cmd, typ, etyp, styp,
+ Html_Unknown, pStart, nostr))
+ goto domfmtdone;
+ }
+ }
+ }
+ }
+ domfmtdone:
+ Tcl_DStringResult(interp, &cmd);
+ return TCL_OK;
+}
+
+/* Define the begin, and end indexes */
+static int
+HtmlBeginEnd(htmlPtr, be, argc, argv)
+ HtmlWidget *htmlPtr;
+ HtmlIndex *be;
+ int argc;
+ const char **argv;
+{
+ char *cp, nbuf[50], *ep;
+ int i, n;
+ Tcl_Interp *interp = htmlPtr->interp;
+ be[0].p = htmlPtr->pFirst;
+ be[0].i = 0;
+ be[1].p = 0;
+ be[0].i = 0;
+ if (argc) {
+ if (HtmlGetIndex(htmlPtr, argv[0], &be[0].p, &be[0].i) != 0) {
+ Tcl_AppendResult(interp, "malformed index: \"", argv[0], "\"", 0);
+ return TCL_ERROR;
+ }
+ }
+ if (argc > 1) {
+ if (HtmlGetIndex(htmlPtr, argv[1], &be[1].p, &be[1].i) != 0) {
+ Tcl_AppendResult(interp, "malformed index: \"", argv[1], "\"", 0);
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
+
+/* Find all tags that contain an attr named in input list. Return TIDs. */
+int
+HtmlTokenAttrSearch(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ HtmlElement *p;
+ CONST char **vargv;
+ char *z;
+ char str[50];
+ int vargc, i, j, nocase, cnt = 0;
+ HtmlIndex be[2];
+ if (TCL_OK != HtmlBeginEnd(htmlPtr, be, argc - 4, argv + 4))
+ return TCL_ERROR;
+ if (Tcl_SplitList(interp, argv[3], &vargc, &vargv) || vargc <= 0) {
+ Tcl_AppendResult(interp, "token attrs error: ", argv[3], 0);
+ return TCL_ERROR;
+ }
+ for (p = be[0].p; p; p = p->pNext) {
+ if (HtmlIsMarkup(p)) {
+ for (i = 0; i < p->base.count; i += 2) {
+ for (j = 0; j < vargc; j++)
+ if (StrEqual(vargv[j], p->markup.argv[i]))
+ break;
+ if (j < vargc) {
+ if (cnt++)
+ Tcl_AppendResult(interp, " ", 0);
+ sprintf(str, "%d", p->base.id);
+ Tcl_AppendResult(interp, str, 0);
+ break;
+ }
+ }
+ }
+ if (p == be[1].p)
+ break;
+ }
+ HtmlFree(vargv);
+ return TCL_OK;
+}
+
+/* Define the -begin, -end and -range options */
+int
+HtmlBeginEndOpts(htmlPtr, be, argc, argv)
+ HtmlWidget *htmlPtr;
+ HtmlIndex *be;
+ int argc;
+ char **argv;
+{
+ char *cp, nbuf[50], *ep;
+ int i, n;
+ Tcl_Interp *interp = htmlPtr->interp;
+ be[0].p = htmlPtr->pFirst;
+ be[0].i = 0;
+ be[1].p = 0;
+ be[0].i = 0;
+ for (i = 0; i < (argc - 1); i += 2) {
+ cp = argv[i];
+ if (*cp++ != '-')
+ return -1;
+ if (StrEqual(cp, "begin")) {
+ if (HtmlGetIndex(htmlPtr, argv[i + 1], &be[0].p, &be[0].i) != 0) {
+ Tcl_AppendResult(interp, "malformed index: \"", argv[i + 1],
+ "\"", 0);
+ return TCL_ERROR;
+ }
+ }
+ else if (StrEqual(cp, "end")) {
+ if (HtmlGetIndex(htmlPtr, argv[i + 1], &be[1].p, &be[1].i) != 0) {
+ Tcl_AppendResult(interp, "malformed index: \"", argv[i + 1],
+ "\"", 0);
+ return TCL_ERROR;
+ }
+ }
+ else if (StrEqual(cp, "range")) {
+ cp = argv[i + 1];
+ while (isspace(*cp))
+ cp++;
+ ep = cp;
+ while (*ep && !isspace(*ep))
+ ep++;
+ while (isspace(*ep))
+ ep++;
+ if (!*ep) {
+ Tcl_AppendResult(interp, "malformed index: \"", argv[i + 1],
+ "\"", 0);
+ return TCL_ERROR;
+ }
+ if (HtmlGetIndex(htmlPtr, cp, &be[0].p, &be[0].i) != 0 ||
+ HtmlGetIndex(htmlPtr, ep, &be[1].p, &be[1].i) != 0) {
+ Tcl_AppendResult(interp, "malformed index: \"", argv[i + 1],
+ "\"", 0);
+ return TCL_ERROR;
+ }
+ }
+ }
+ return TCL_OK;
+}
+
+/* Find all onEvent tags and return list of Event id Event id ... */
+int
+HtmlTokenOnEvents(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ HtmlElement *p;
+ char **vargv, *z, str[50], *cp;
+ int vargc, i, nocase, cnt = 0;
+ HtmlIndex be[2];
+ if (TCL_OK != HtmlBeginEnd(htmlPtr, be, argc - 3, argv + 3))
+ return TCL_ERROR;
+ for (p = be[0].p; p; p = p->pNext) {
+ if (HtmlIsMarkup(p)) {
+ for (i = 0; i < p->base.count; i += 2) {
+ cp = p->markup.argv[i];
+ if (strlen(cp) >= 3 && cp[0] == 'o' && cp[1] == 'n') {
+ if (cnt++)
+ Tcl_AppendResult(interp, " ", 0);
+ sprintf(str, "%d", p->base.id);
+ Tcl_AppendResult(interp, str, " ", cp, 0);
+ }
+ }
+ }
+ if (p == be[1].p)
+ break;
+ }
+ return TCL_OK;
+}
+
+/* Translate a name attr index to a integer index. */
+int
+HtmlDomName2Index(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ HtmlElement *p;
+ int n = -1, i = -1, type;
+ char *z, str[50];
+ if ((type = HtmlNameToType(htmlPtr, argv[3])) == Html_Unknown)
+ return TCL_ERROR;
+ for (p = htmlPtr->pFirst; p; p = p->pNext) {
+ if (p->base.type != type) {
+ if (type != Html_INPUT &&
+ p->base.type != Html_SELECT && p->base.type != Html_TEXTAREA)
+ continue;
+ }
+ i++;
+ z = HtmlMarkupArg(p, "name", 0);
+ if (!z)
+ continue;
+ if (!strcmp(z, argv[4])) {
+ n = i;
+ break;
+ }
+ }
+ sprintf(str, "%d", n);
+ Tcl_AppendResult(interp, str, 0);
+ return TCL_OK;
+}
+
+HtmlElement *
+HtmlGetIndexth(htmlPtr, typ, cnt)
+ HtmlWidget *htmlPtr;
+ int typ;
+ int cnt;
+{
+ HtmlElement *p;
+ for (p = htmlPtr->pFirst; p; p = p->pNext)
+ if (p->base.type == typ && !cnt--)
+ return p;
+ return 0;
+}
+
+/* Count the radios matching this one */
+static int
+HtmlRadioCount(htmlPtr, radio)
+ HtmlWidget *htmlPtr;
+ HtmlElement *radio;
+{
+ char *z, *rz;
+ HtmlElement *p, *form;
+ int cnt = 0;
+ assert(radio->base.type == Html_INPUT
+ && radio->input.type == INPUT_TYPE_Radio);
+ if (!(rz = HtmlMarkupArg(radio, "name", 0)))
+ return 0;
+ form = radio->input.pForm;
+ for (p = form->form.pFirst; p && p->input.pForm == form; p = p->input.pNext) {
+ assert(p->base.type == Html_INPUT || p->base.type == Html_SELECT
+ || p->base.type == Html_TEXTAREA);
+ if (p == radio)
+ cnt++;
+ else if (p->input.type == INPUT_TYPE_Radio) {
+ if ((z = HtmlMarkupArg(p, "name", 0)) && !strcmp(z, rz))
+ cnt++;
+ }
+ }
+ return cnt;
+}
+
+/* Translate a radio index to a form element index. */
+int
+HtmlDomRadio2Index(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ HtmlElement *p, *form;
+ int n, type;
+ char *z, str[50];
+ n = atoi(argv[5]);
+ form = HtmlGetIndexth(htmlPtr, Html_FORM, atoi(argv[3]));
+ if (form)
+ for (p = form->form.pFirst; p && p->input.pForm == form;
+ p = p->input.pNext) {
+ assert(p->base.type == Html_INPUT || p->base.type == Html_SELECT
+ || p->base.type == Html_TEXTAREA);
+ if (p->input.type == INPUT_TYPE_Radio) {
+ if (p->input.subid == n) {
+ sprintf(str, "%d", p->input.id);
+ Tcl_AppendResult(interp, str, 0);
+ return TCL_OK;
+ }
+ }
+ }
+ Tcl_AppendResult(interp, "radioidx failed:", argv[3], " ", argv[4], " ",
+ argv[5], 0);
+ return TCL_ERROR;
+}
+
+/* Search through all of type tag and compile list of attr names */
+int
+HtmlTokenUnique(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ HtmlElement *p;
+ int i, j, k, type, nump = 0;
+ char *vars[201], *cp;
+ HtmlIndex be[2];
+ if (TCL_OK != HtmlBeginEnd(htmlPtr, be, argc - 4, argv + 4))
+ return TCL_ERROR;
+ if ((type = HtmlNameToType(htmlPtr, argv[3])) == Html_Unknown)
+ return TCL_ERROR;
+ for (p = be[0].p; p && nump < 200; p = p->pNext) {
+ if (p->base.type == type) {
+ for (i = 0; i < p->base.count; i += 2) {
+ for (j = 0; j < nump; j++) {
+ cp = p->markup.argv[i];
+ if (*cp == vars[j][0] && (!strcmp(cp, vars[j])))
+ break;
+ }
+ if (j >= nump)
+ vars[nump++] = p->markup.argv[i];
+ }
+ }
+ if (p == be[1].p)
+ break;
+ }
+ for (j = 0; j < nump; j++)
+ Tcl_AppendElement(htmlPtr->interp, vars[j]);
+ return TCL_OK;
+}
+
+/* Return the element offset index for the named el in form */
+static int
+HtmlDomFormEl(htmlPtr, form, el)
+ HtmlWidget *htmlPtr;
+ int form;
+ const char *el;
+{
+ HtmlElement *p, *pstart;
+ int i = 0;
+ char *z;
+ p = pstart = htmlPtr->pFirst;
+ if (!p)
+ return -1;
+ for (; p; p = p->pNext) {
+ if (p->base.type != Html_FORM)
+ continue;
+ if (!form--)
+ break;
+ }
+ for (; p; p = p->pNext) {
+ switch (p->base.type) {
+ case Html_INPUT:
+ if (p->input.type == INPUT_TYPE_Radio) {
+ }
+ case Html_TEXTAREA:
+ case Html_SELECT:
+ z = HtmlMarkupArg(p, "name", 0);
+ if (z && (!strcmp(z, el)))
+ return i;
+ i++;
+ break;
+ case Html_EndFORM:
+ break;
+ }
+ if (pstart->form.pEnd == p)
+ break;
+ }
+ return -1;
+}
+
+/* Return the element offset index for the named el in form */
+int
+HtmlDomFormElIndex(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ int i = HtmlDomFormEl(htmlPtr, atoi(argv[3]), argv[4]);
+ char str[50];
+ sprintf(str, "%d", i);
+ Tcl_AppendResult(interp, str, 0);
+ return TCL_OK;
+}
+
+/* Return the HTML Doc as one big DOM tree list */
+int
+HtmlDomTreeCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ Tcl_DString cmd;
+ CONST char *a = argv[3];
+ char *z;
+ HtmlElement *p, *ep;
+ int n[10], ni = 0, en, i, k, j, l, iswrite = 0, atend;
+ if (!(p = htmlPtr->pFirst))
+ return TCL_OK;
+ Tcl_DStringInit(&cmd);
+ while (p) {
+
+ switch (p->base.type) {
+ case Html_TABLE:
+ case Html_TH:
+ case Html_TR:
+ case Html_TD:
+ case Html_A:
+ case Html_FORM:
+ case Html_INPUT:{
+ }
+ default:{
+
+/* buf[0]='/';
+ strcpy(buf+1,tok);
+ if ((en=HtmlNameToType(htmlPtr,tok))==Html_Unknown) return 0;
+ while (ep && ep->base.type!=en) ep=ep->base.pNext;
+ return ep; */
+ return 0;
+ }
+ }
+
+ }
+ Tcl_DStringAppend(&cmd, "", -1);
+ Tcl_DStringStartSublist(&cmd);
+ HtmlAppendArglist(&cmd, p);
+ Tcl_DStringEndSublist(&cmd);
+ return TCL_OK;
+}
+
+/*
+**
+*/
+/*
+ *---------------------------------------------------------------------------
+ *
+ * HtmlTclizeList --
+ *
+ * Get the TCL representation of the list of tokens between arguments p
+ * and pEnd.
+ *
+ * Results:
+ *
+ * Side effects:
+ * The TCL representation of the list of tokens between the two
+ * elements is stored as the result of interp.
+ *
+ *---------------------------------------------------------------------------
+ */
+static void HtmlTclizeList(htmlPtr, interp, p, pEnd, flag)
+ HtmlWidget *htmlPtr;
+ Tcl_Interp *interp;
+ HtmlElement *p;
+ HtmlElement *pEnd;
+ int flag;
+{
+ Tcl_DString str;
+ int i, isatr;
+ char *zName;
+ char zLine[100];
+
+ Tcl_DStringInit(&str);
+ while (p && p != pEnd) {
+ isatr = 0;
+ switch (p->base.type) {
+ case Html_Block:
+ break;
+ case Html_Text:
+ case Html_COMMENT:
+ if (flag & (TOKEN_MARKUP | TOKEN_DOM))
+ break;
+ Tcl_DStringStartSublist(&str);
+ if (flag & TOKEN_LIST) {
+ sprintf(zLine, "%d", p->base.id);
+ Tcl_DStringAppendElement(&str, zLine);
+ }
+ Tcl_DStringAppendElement(&str, "Text");
+ Tcl_DStringAppendElement(&str, p->text.zText);
+ Tcl_DStringEndSublist(&str);
+ break;
+ case Html_Space:
+ if (flag & (TOKEN_MARKUP | TOKEN_DOM))
+ break;
+ if (flag & TOKEN_LIST)
+ sprintf(zLine, "%d Space %d %d", p->base.id,
+ p->base.count, (p->base.flags & HTML_NewLine) != 0);
+ else
+ sprintf(zLine, "Space %d %d",
+ p->base.count, (p->base.flags & HTML_NewLine) != 0);
+ Tcl_DStringAppendElement(&str, zLine);
+ break;
+ case Html_Unknown:
+ if (flag & (TOKEN_MARKUP | TOKEN_DOM))
+ break;
+ Tcl_DStringAppendElement(&str, "Unknown");
+ break;
+ case Html_EndVAR:
+ case Html_VAR:
+ case Html_EndU:
+ case Html_U:
+ case Html_EndTT:
+ case Html_TT:
+ case Html_EndSUP:
+ case Html_SUP:
+ case Html_EndSUB:
+ case Html_SUB:
+ case Html_EndSTRONG:
+ case Html_STRONG:
+ case Html_EndSTRIKE:
+ case Html_STRIKE:
+ case Html_EndSMALL:
+ case Html_SMALL:
+ case Html_EndSAMP:
+ case Html_SAMP:
+ case Html_EndS:
+ case Html_S:
+ case Html_EndP:
+ case Html_EndMARQUEE:
+ case Html_MARQUEE:
+ case Html_EndLISTING:
+ case Html_LISTING:
+ case Html_EndKBD:
+ case Html_KBD:
+ case Html_EndI:
+ case Html_I:
+ case Html_EndFONT:
+ case Html_FONT:
+ case Html_EndEM:
+ case Html_EM:
+ case Html_EndDIV:
+ case Html_DIV:
+ case Html_EndDFN:
+ case Html_DFN:
+ case Html_EndCODE:
+ case Html_CODE:
+ case Html_EndCITE:
+ case Html_CITE:
+ case Html_EndCENTER:
+ case Html_CENTER:
+ case Html_BR:
+ case Html_EndBLOCKQUOTE:
+ case Html_BLOCKQUOTE:
+ case Html_EndBIG:
+ case Html_BIG:
+ case Html_EndBASEFONT:
+ case Html_BASEFONT:
+ case Html_BASE:
+ case Html_EndB:
+ case Html_B:
+ isatr = 1;
+ default:
+ if (isatr && (flag & (TOKEN_DOM)))
+ break;
+ Tcl_DStringStartSublist(&str);
+ if (flag & TOKEN_LIST) {
+ sprintf(zLine, "%d", p->base.id);
+ Tcl_DStringAppendElement(&str, zLine);
+ }
+ if (!(flag & (TOKEN_MARKUP | TOKEN_DOM)))
+ Tcl_DStringAppendElement(&str, "Markup");
+ if (p->base.type >= HtmlGetMarkupMap(htmlPtr, 0)->type
+ && p->base.type <= HtmlGetMarkupMap(htmlPtr,
+ HTML_MARKUP_COUNT -
+ 1)->type) {
+ zName = HtmlGetMarkupMap(htmlPtr,
+ p->base.type -
+ HtmlGetMarkupMap(htmlPtr,
+ 0)->type)->zName;
+ }
+ else {
+ zName = "Unknown";
+ }
+ Tcl_DStringAppendElement(&str, zName);
+ for (i = 0; i < p->base.count; i++) {
+ Tcl_DStringAppendElement(&str, p->markup.argv[i]);
+ }
+ Tcl_DStringEndSublist(&str);
+ break;
+ }
+ p = p->pNext;
+ }
+ Tcl_DStringResult(interp, &str);
+}
+
+static int
+_HtmlTokenCmdSub(htmlPtr, interp, argc, argv, flag)
+ HtmlWidget *htmlPtr; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ const char **argv; /* List of all arguments */
+ int flag;
+{
+ HtmlElement *pStart, *pEnd = 0;
+ int i;
+ CONST char *cb;
+ CONST char *ce;
+ if (argc <= 3)
+ cb = "begin";
+ else
+ cb = argv[3];
+ if (argc <= 4)
+ ce = cb;
+ else
+ ce = argv[4];
+
+ if (HtmlGetIndex(htmlPtr, cb, &pStart, &i) != 0) {
+ Tcl_AppendResult(interp, "malformed index: \"", cb, "\"", 0);
+ return TCL_ERROR;
+ }
+ if (HtmlGetIndex(htmlPtr, ce, &pEnd, &i) != 0) {
+ Tcl_AppendResult(interp, "malformed index: \"", ce, "\"", 0);
+ return TCL_ERROR;
+ }
+ if (pStart) {
+ HtmlTclizeList(htmlPtr, interp, pStart, pEnd ? pEnd->base.pNext : 0,
+ flag);
+ }
+ return TCL_OK;
+}
+
+/*
+** WIDGET token attr INDEX NAME ?VALUE?
+ If modifying an attribute, we reallocate the whole argv with alloc.
+*/
+int
+HtmlTokenAttr(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ CONST char *name;
+ CONST char *value;
+ char fake[99], **nv;
+ HtmlElement *p;
+ int i, j, l, tl, ol, c, nc;
+ if (HtmlGetIndex(htmlPtr, argv[3], &p, &i) != 0 || p == 0
+ || !HtmlIsMarkup(p)) {
+ Tcl_AppendResult(interp, "malformed index: \"", argv[3], "\"", 0);
+ return TCL_ERROR;
+ }
+ if (argc < 5) {
+ Tcl_DString cmd;
+ Tcl_DStringInit(&cmd);
+ HtmlAppendArglist(&cmd, p);
+ Tcl_DStringResult(interp, &cmd);
+ return TCL_OK;
+ }
+ name = argv[4];
+ if (argc < 6) {
+ if (!(value = HtmlMarkupArg(p, name, 0))) {
+
+/* Tcl_AppendResult(interp,"attr not found: \"", name, "\"", 0);
+ return TCL_ERROR; */
+ return TCL_OK;
+ }
+ Tcl_AppendResult(interp, value ? value : "", 0);
+ return TCL_OK;
+ }
+ value = argv[5];
+ l = strlen(value);
+ nc = c = p->base.count;
+ for (j = 0; j < c; j += 2)
+ if (!strcasecmp(name, p->markup.argv[j]))
+ break;
+ if (j >= c || (ol = strlen(p->markup.argv[j])) < l) {
+ if (j >= c) {
+ nc += 2;
+ p->base.count += 2;
+ }
+ if (c == 0 || p->markup.argv == (char **) p->markup.argv[c + 1]) {
+ /*
+ * Migrate to dynamic allocations.
+ */
+ nv = (char **) HtmlAlloc(sizeof(char **) * (nc + 2));
+ for (i = 0; i < c; i++) {
+ CONST char *val = p->markup.argv[i];
+ if (i == (j + 1))
+ val = value;
+ nv[i] = (char *) HtmlAlloc(strlen(val) + 1);
+ if (!nv[i])
+ return TCL_ERROR;
+ strcpy(nv[i], val);
+ }
+ nv[i] = 0;
+ nv[i + 1] = (c == 0 ? 0 : p->markup.argv[i + 1]);
+ }
+ else if (nc > c) {
+ nv = (char **) HtmlRealloc((char *) p->markup.argv,
+ sizeof(char **) * (nc + 2));
+ i = c;
+ nv[nc + 1] = p->markup.argv[c + 1];
+ nv[nc] = 0;
+ }
+ else {
+ nv = p->markup.argv;
+ HtmlFree(nv[j + 1]);
+ nv[j + 1] = (char *) HtmlAlloc(strlen(value) + 1);
+ }
+ if (nc > c) {
+ nv[i + 2] = 0; /* Rallocate argv to be dynamic. */
+ nv[i + 3] = (c <= 0 ? 0 : p->markup.argv[i + 1]);
+ nv[i] = (char *) HtmlAlloc(strlen(name) + 1);;
+ if (!nv[i])
+ return TCL_ERROR;
+ strcpy(nv[i], name);
+ ToLower(nv[i]);
+ j = i;
+ nv[i + 1] = (char *) HtmlAlloc(strlen(value) + 1);;
+ if (!nv[i + 1])
+ return TCL_ERROR;
+ strcpy(nv[i + 1], value);
+ }
+ p->markup.argv = nv;
+ }
+ /*
+ * sprintf(pElem->markup.argv[j+1],"%.*s",l,value);
+ */
+ strcpy(p->markup.argv[j + 1], value);
+ HtmlTranslateEscapes(p->markup.argv[j + 1]);
+ return TCL_OK;
+}
+
+/*
+** WIDGET token list START END
+*/
+int
+HtmlTokenListCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ return _HtmlTokenCmdSub(htmlPtr, interp, argc, argv, TOKEN_LIST);
+}
+
+/*
+** WIDGET token markup START END
+*/
+int
+HtmlTokenMarkupCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ return _HtmlTokenCmdSub(htmlPtr, interp, argc, argv,
+ TOKEN_MARKUP | TOKEN_LIST);
+}
+
+/*
+** WIDGET token dom START END
+*/
+int
+HtmlTokenDomCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ return _HtmlTokenCmdSub(htmlPtr, interp, argc, argv,
+ TOKEN_DOM | TOKEN_LIST);
+}
+
+/*
+** Return all tokens between the two elements as a HTML.
+*/
+static
+ void
+HtmlTclizeHtml(htmlPtr, interp, p, pEnd)
+ HtmlWidget *htmlPtr;
+ Tcl_Interp *interp;
+ HtmlElement *p;
+ HtmlElement *pEnd;
+{
+ Tcl_DString str;
+ int i, j;
+ char *zName;
+ char zLine[100];
+
+ Tcl_DStringInit(&str);
+ while (p && p != pEnd) {
+ switch (p->base.type) {
+ case Html_Block:
+ break;
+ case Html_COMMENT:
+ Tcl_DStringAppend(&str, "<!--", -1);
+ Tcl_DStringAppend(&str, p->text.zText, -1);
+ Tcl_DStringAppend(&str, "-->", -1);
+ break;
+ case Html_Text:
+ Tcl_DStringAppend(&str, p->text.zText, -1);
+ break;
+ case Html_Space:
+ for (j = 0; j < p->base.count; j++) {
+ Tcl_DStringAppend(&str, " ", 1);
+ }
+ if ((p->base.flags & HTML_NewLine) != 0)
+ Tcl_DStringAppend(&str, "\n", 1);
+ break;
+ case Html_Unknown:
+ Tcl_DStringAppend(&str, "Unknown", -1);
+ break;
+ default:
+ if (p->base.type >= HtmlGetMarkupMap(htmlPtr, 0)->type
+ && p->base.type <= HtmlGetMarkupMap(htmlPtr,
+ HTML_MARKUP_COUNT -
+ 1)->type) {
+ zName = HtmlGetMarkupMap(htmlPtr,
+ p->base.type -
+ HtmlGetMarkupMap(htmlPtr,
+ 0)->type)->zName;
+ }
+ else {
+ zName = "Unknown";
+ }
+ Tcl_DStringAppend(&str, "<", 1);
+ Tcl_DStringAppend(&str, zName, -1);
+ for (i = 0; i < (p->base.count - 1); i++) {
+ Tcl_DStringAppend(&str, " ", 1);
+ Tcl_DStringAppend(&str, p->markup.argv[i++], -1);
+ Tcl_DStringAppend(&str, "=", 1);
+ Tcl_DStringAppend(&str, p->markup.argv[i], -1);
+ }
+ Tcl_DStringAppend(&str, ">", 1);
+ break;
+ }
+ p = p->pNext;
+ }
+ Tcl_DStringResult(interp, &str);
+}
+
+/*
+** WIDGET text html START END
+*/
+int
+HtmlTextHtmlCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ HtmlElement *pStart, *pEnd;
+ int i;
+ CONST char *cb;
+ CONST char *ce;
+ if (argc <= 3)
+ cb = "begin";
+ else
+ cb = argv[3];
+ if (argc <= 4)
+ ce = cb;
+ else
+ ce = argv[4];
+
+ if (HtmlGetIndex(htmlPtr, cb, &pStart, &i) != 0) {
+ Tcl_AppendResult(interp, "malformed index: \"", cb, "\"", 0);
+ return TCL_ERROR;
+ }
+ if (HtmlGetIndex(htmlPtr, ce, &pEnd, &i) != 0) {
+ Tcl_AppendResult(interp, "malformed index: \"", ce, "\"", 0);
+ return TCL_ERROR;
+ }
+ if (pStart) {
+ HtmlTclizeHtml(htmlPtr, interp, pStart, pEnd ? pEnd->base.pNext : 0);
+ }
+ return TCL_OK;
+}
+
+/*
+** Return all tokens between the two elements as a Text.
+*/
+static
+ void
+HtmlTclizeAscii(interp, s, e)
+ Tcl_Interp *interp;
+ HtmlIndex *s;
+ HtmlIndex *e;
+{
+ int i, j, nsub = 0;
+ HtmlElement *p = s->p;
+ Tcl_DString str;
+ if (p && p->base.type == Html_Text) {
+ nsub = s->i;
+ }
+ Tcl_DStringInit(&str);
+ while (p) {
+ switch (p->base.type) {
+ case Html_Block:
+ break;
+ case Html_Text:
+ j = strlen(p->text.zText);
+ if (j < nsub)
+ nsub = j;
+ if (p == e->p) {
+ j = (e->i - nsub + 1);
+ }
+ Tcl_DStringAppend(&str, p->text.zText + nsub, j - nsub);
+ nsub = 0;
+ break;
+ case Html_Space:
+ for (j = 0; j < p->base.count; j++) {
+ if (nsub-- > 0)
+ continue;
+ Tcl_DStringAppend(&str, " ", 1);
+ }
+ if ((p->base.flags & HTML_NewLine) != 0)
+ Tcl_DStringAppend(&str, "\n", 1);
+ nsub = 0;
+ break;
+ case Html_P:
+ case Html_BR:
+ Tcl_DStringAppend(&str, "\n", 1);
+ break;
+ case Html_Unknown:
+ break;
+ default:
+ break;
+ }
+ if (p == e->p)
+ break;
+ p = p->pNext;
+ }
+ Tcl_DStringResult(interp, &str);
+}
+
+/*
+** WIDGET text ascii START END
+*/
+int
+HtmlTextAsciiCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ HtmlIndex iStart, iEnd;
+ int i;
+ CONST char *cb;
+ CONST char *ce;
+ if (argc <= 3)
+ cb = "begin";
+ else
+ cb = argv[3];
+ if (argc <= 4)
+ ce = cb;
+ else
+ ce = argv[4];
+
+ if (HtmlGetIndex(htmlPtr, cb, &iStart.p, &iStart.i) != 0) {
+ Tcl_AppendResult(interp, "malformed index: \"", cb, "\"", 0);
+ return TCL_ERROR;
+ }
+ if (HtmlGetIndex(htmlPtr, ce, &iEnd.p, &iEnd.i) != 0) {
+ Tcl_AppendResult(interp, "malformed index: \"", ce, "\"", 0);
+ return TCL_ERROR;
+ }
+ if (iEnd.p && iStart.p) {
+ if ((!iEnd.i) && (!strchr(ce, '.'))) {
+ iEnd.p = iEnd.p->pNext;
+ }
+ HtmlTclizeAscii(interp, &iStart, &iEnd);
+ }
+ return TCL_OK;
+}
+
+/* Hard to describe, but used as follows: when you extract text, and do
+ a regex on it, with -indices, you need to convert these offsets back
+ into INDEXES. This returns those begin and end anchor. */
+int
+HtmlTextOffsetCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ HtmlIndex iStart;
+ int n1, n2;
+ int h, i1, i2, i = 0, j, k, n, m = 0, fnd = 0, sfnd = 0;
+ int si1, si2, mpos = 0, ii[2];
+ char zLine[256];
+ HtmlElement *p1 = 0, *p2 = 0, *p;
+ if (argc != 6) {
+ Tcl_AppendResult(interp, argv[0], " text offset START NUM1 NUM2", 0);
+ return TCL_ERROR;
+ }
+ if (HtmlGetIndex(htmlPtr, argv[3], &iStart.p, &iStart.i) != 0 || !iStart.p) {
+ Tcl_AppendResult(interp, "malformed index: \"", argv[3], "\"", 0);
+ return TCL_ERROR;
+ }
+ n1 = atoi(argv[4]);
+ n2 = atoi(argv[5]);
+ if (n1 < 0 || n2 < 0) {
+ Tcl_AppendResult(interp, "malformed offsets: ", argv[4], " or ",
+ argv[5], 0);
+ return TCL_ERROR;
+ }
+#if 1
+ {
+ p = iStart.p;
+ if (p->base.type == Html_Text) {
+ int tail;
+ j = strlen(p->text.zText);
+ tail = (j - iStart.i);
+ if (tail >= n1) {
+ p1 = p;
+ i1 = iStart.i + n1;
+ }
+ n1 -= tail;
+ if (tail >= n2) {
+ p2 = p;
+ i2 = iStart.i + n2;
+ }
+ n2 -= tail;
+ p = p->pNext;
+ }
+ while (p && (!p2)) {
+ j = 0;
+ switch (p->base.type) {
+ case Html_Text:
+ j = strlen(p->text.zText);
+ break;
+ case Html_Space:
+ j = p->base.count;
+ if (p->base.flags & HTML_NewLine)
+ j++;
+ break;
+ }
+ if (j > 0) {
+ if (!p1) {
+ if ((n1 - j) < 0) {
+ p1 = p;
+ i1 = n1;
+ }
+ n1 -= j;
+ }
+ if (!p2) {
+ if ((n2 - j) < 0) {
+ p2 = p;
+ i2 = n2;
+ }
+ n2 -= j;
+ }
+ }
+ p = p->pNext;
+ }
+ }
+#else
+ i1 = -1;
+ i2 = -1;
+ p = iStart.p;
+ if (iStart.i > 0 && p->base.type == Html_Text) {
+ j = strlen(p->text.zText) - iStart.i;
+ goto htoffset;
+ }
+ else if (n1 == 0) {
+ p1 = p;
+ i1 = iStart.i;
+ }
+ while (p) {
+ j = 0;
+ switch (p->base.type) {
+ case Html_Text:
+ j = strlen(p->text.zText);
+ break;
+ case Html_Space:
+ j = p->base.count;
+ if (p->base.flags & HTML_NewLine)
+ j++;
+ break;
+ }
+ htoffset:
+ if (j > 0) {
+ n1 -= j;
+ n2 -= j;
+ if (n1 <= 0 && !p1) {
+ p1 = p;
+ i1 = -n1 - 1;
+ }
+ /*
+ * if (n2<=0 && !p2) { p2=p; i2= -n2-1; break; }
+ */
+ if (n2 <= 0 && !p2) {
+ p2 = p;
+ i2 = j + n2;
+ break;
+ }
+ }
+ p = p->pNext;
+ }
+#endif
+ if (p1 && p2) {
+ n = HtmlTokenNumber(p1);
+ m = HtmlTokenNumber(p2);
+ if (i1 < 0)
+ i1 = 0;
+ if (i2 < 0)
+ i2 = 0;
+ if (n == m && i1 > i2)
+ sprintf(zLine, "%d.%d %d.%d", n, i2, m, i1);
+ else
+ sprintf(zLine, "%d.%d %d.%d", n, i1, m, i2);
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, zLine, 0);
+ }
+ return TCL_OK;
+}
+
+/*
+** Search all tokens between the two elements for pat.
+*/
+static
+ void
+HtmlTclizeFindText(interp, pat, ip, iEnd, nocase, after)
+ Tcl_Interp *interp;
+ char *pat;
+ HtmlIndex *ip;
+ HtmlIndex *iEnd;
+ int nocase;
+ int after;
+{
+ Tcl_DString str;
+ int h, i1, i2, i = 0, j, k, l = strlen(pat), n, m = 0, fnd = 0, sfnd = 0;
+ int si1, si2, mpos = 0;
+ char zLine[256];
+ HtmlElement *p1 = 0, *p2 = 0, *sp1, *sp2, *p = ip->p, *pEnd = iEnd->p;
+ if (nocase)
+ for (k = 0; k < l; k++)
+ pat[k] = tolower(pat[k]);
+ n = HtmlTokenNumber(p);
+ i1 = -1;
+ i2 = -1;
+ while (p && p != pEnd && !fnd) {
+ switch (p->base.type) {
+ case Html_Text:
+ j = strlen(p->text.zText);
+ for (k = 0; k < j; k++) {
+ char nchar =
+ (nocase ? tolower(p->text.zText[k]) : p->text.
+ zText[k]);
+ if (pat[mpos] == nchar) {
+ mpos++;
+ if (!p1) {
+ p1 = p;
+ i1 = k;
+ }
+ }
+ else {
+ if (p1) {
+ mpos = 0;
+ p1 = 0;
+ i1 = -1;
+ break;
+ }
+ }
+ if (mpos >= l)
+ break;
+ }
+ break;
+ case Html_Space:
+ for (k = 0; k < p->base.count; k++) {
+ if (pat[mpos] == ' ') {
+ if (!p1) {
+ p1 = p;
+ i1 = k;
+ }
+ mpos++;
+ if (mpos >= l)
+ break;
+ }
+ else {
+ mpos = 0;
+ p1 = 0;
+ i1 = -1;
+ break;
+ }
+ }
+
+/* if ((p->base.flags & HTML_NewLine)!=0) zLine[i=0]=0; */
+ break;
+ }
+ if (mpos >= l) {
+ fnd = 1;
+ i2 = k;
+ p2 = p;
+ }
+ if (fnd && !after) {
+ /*
+ * Primitive, but for reverse searches we search from the
+ * begining and take the last one matched.
+ */
+ sp1 = p1;
+ sp2 = p2;
+ si1 = i1;
+ si2 = i2;
+ sfnd = 1;
+ fnd = 0;
+ }
+ if (fnd)
+ break;
+ p = p->pNext;
+ }
+ if ((!fnd) && sfnd && !after) {
+ p1 = sp1;
+ p2 = sp2;
+ i1 = si1;
+ i2 = si2;
+ fnd = 1;
+ }
+ if (fnd) {
+ n = HtmlTokenNumber(p1);
+ m = HtmlTokenNumber(p2);
+ sprintf(zLine, "%d.%d %d.%d", n, i1, m, i2);
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, zLine, 0);
+ }
+}
+
+/*
+** Search all tokens between the two elements for tag.
+*/
+static
+ void
+HtmlTclizeFind(interp, tag, p, pEnd, near)
+ Tcl_Interp *interp;
+ int tag;
+ HtmlElement *p;
+ HtmlElement *pEnd;
+ int near;
+{
+ Tcl_DString str;
+ int i, j, n, nearest = 0;
+ char *zName;
+ char zLine[100];
+
+ Tcl_DStringInit(&str);
+ while (p && p != pEnd) {
+ n = p->base.id;
+ if (p->base.type == tag) {
+ if (near) {
+ if (!nearest)
+ nearest = n;
+ else if (abs(near - n) < abs(near - nearest)) {
+ nearest = n;
+ Tcl_DStringInit(&str);
+ }
+ else {
+ p = p->pNext;
+ n++;
+ continue;
+ }
+ }
+ switch (tag) {
+ case Html_Block:
+ break;
+ case Html_Text:
+ Tcl_DStringStartSublist(&str);
+ sprintf(zLine, "%d", n);
+ Tcl_DStringAppendElement(&str, zLine);
+ Tcl_DStringAppendElement(&str, p->text.zText);
+ Tcl_DStringEndSublist(&str);
+ break;
+ case Html_Space:
+#if 0
+ Tcl_DStringStartSublist(&str);
+ for (j = 0; j < p->base.count; j++) {
+ Tcl_DStringAppend(&str, " ", 1);
+ }
+ if ((p->base.flags & HTML_NewLine) != 0)
+ Tcl_DStringAppend(&str, "\n", 1);
+ Tcl_DStringEndSublist(&str);
+#endif
+ break;
+ case Html_Unknown:
+ Tcl_DStringAppend(&str, "Unknown", -1);
+ break;
+ default:
+ Tcl_DStringStartSublist(&str);
+ sprintf(zLine, "%d", n);
+ Tcl_DStringAppendElement(&str, zLine);
+ for (i = 0; i < p->base.count; i++) {
+ Tcl_DStringAppendElement(&str, p->markup.argv[i]);
+ }
+ Tcl_DStringEndSublist(&str);
+
+ break;
+ }
+ }
+ p = p->pNext;
+ n++;
+ }
+ Tcl_DStringResult(interp, &str);
+}
+
+int
+HtmlTextFindCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ HtmlIndex iStart, iEnd;
+ int i, j = 4, after = 1, nocase = 0;
+ char *pat;
+
+ iStart.p = iEnd.p = 0;
+ iStart.i = iEnd.i = 0;
+
+ if (!htmlPtr->pFirst)
+ return TCL_OK;
+ if (argc > 4) {
+ if (!strcasecmp(argv[j], "nocase")) {
+ nocase = 1;
+ j++;
+ }
+ }
+ if (argc > (j + 1)) {
+ if (HtmlGetIndex(htmlPtr, argv[j + 1], &iStart.p, &iStart.i) != 0) {
+ Tcl_AppendResult(interp, "malformed index: \"", argv[3], "\"", 0);
+ return TCL_ERROR;
+ }
+ if (!strcasecmp(argv[j], "before"))
+ after = 0;
+ else if (strcasecmp(argv[j], "after")) {
+ Tcl_AppendResult(interp, "before|after: \"", argv[j], "\"", 0);
+ return TCL_ERROR;
+ }
+ if (after) {
+ if (iStart.p)
+ iStart.p = iStart.p->base.pNext;
+ }
+ else {
+ iEnd.p = iStart.p;
+ iStart.p = 0;
+ }
+ }
+ if (!iStart.p)
+ iStart.p = htmlPtr->pFirst;
+ if (iEnd.p && after)
+ iEnd.p = iEnd.p->base.pNext;
+
+/* ?????? Fix i1,i2 */
+ pat = (char *) HtmlAlloc(strlen(argv[3]) + 1);
+ strcpy(pat, argv[3]);
+ HtmlTclizeFindText(interp, pat, &iStart, &iEnd, nocase, after);
+ HtmlFree(pat);
+ return TCL_OK;
+}
+
+/* Insert str into cp at n. */
+char *
+StrInsert(cp, str, n, clen)
+ char *cp;
+ char *str;
+ int n;
+ int clen;
+{
+ int l = strlen(str);
+ if (clen < 0)
+ clen = strlen(cp);
+ cp = HtmlRealloc(cp, clen + l + 1);
+ memmove(cp + n + l, cp + n, clen - n);
+ strncpy(cp + n, str, l);
+ return cp;
+}
+
+static void
+HtmlAddOffset(htmlPtr, p, n)
+ HtmlWidget *htmlPtr;
+ HtmlElement *p;
+ int n;
+{
+ while (p) {
+ p->base.offs += n;
+ p = p->pNext;
+ }
+}
+
+void
+HtmlAddStrOffset(htmlPtr, p, str, offs)
+ HtmlWidget *htmlPtr;
+ HtmlElement *p;
+ char *str;
+ int offs;
+{
+ int n = 0, l = strlen(str);
+ if ((!p) || !p->base.type == Html_Text)
+ return;
+ n = p->base.offs + offs;
+ if (n < 0 || htmlPtr->nText <= 0)
+ return;
+ htmlPtr->zText = StrInsert(htmlPtr->zText, str, n, htmlPtr->nText);
+ htmlPtr->nText += l;
+ HtmlAddOffset(htmlPtr, p->pNext, l);
+}
+
+static void
+HtmlDelStrOffset(htmlPtr, p, offs, l)
+ HtmlWidget *htmlPtr;
+ HtmlElement *p;
+ int offs;
+ int l;
+{
+ int len, n = p->base.offs + offs;
+ char *cp = htmlPtr->zText;
+ assert(p->base.type == Html_Text);
+ if (n < 0 || htmlPtr->nText <= 0)
+ return;
+ len = htmlPtr->nText - n;
+ memmove(cp + n, cp + n + l, len);
+ htmlPtr->nText -= l;
+ HtmlAddOffset(htmlPtr, p->pNext, -l);
+ cp = p->text.zText;
+ len = strlen(cp);
+ p->base.count -= l;
+ memmove(cp + offs, cp + offs + l, len - offs - l + 1);
+}
+
+/* Function that refreshes after internal adding/deleting elements. */
+int
+HtmlRefresh(htmlPtr, idx)
+ HtmlWidget *htmlPtr;
+ int idx;
+{
+ htmlPtr->flags |= RELAYOUT;
+ HtmlScheduleRedraw(htmlPtr);
+}
+
+int
+HtmlRefreshCmd(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int argc;
+ const char **argv;
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ if (argc < 3)
+ htmlPtr->flags |= RELAYOUT;
+ else {
+ int n = 2;
+ while (n < argc) {
+ switch (argv[n][0]) {
+ case 'i':
+ htmlPtr->flags |= REDRAW_IMAGES;
+ break;
+ case 'r':
+ htmlPtr->flags |= RESIZE_ELEMENTS;
+ break;
+ case 'f':
+ htmlPtr->flags |= REDRAW_FOCUS;
+ break;
+ case 't':
+ htmlPtr->flags |= REDRAW_TEXT;
+ break;
+ case 'b':
+ htmlPtr->flags |= REDRAW_BORDER;
+ break;
+ case 'e':
+ htmlPtr->flags |= EXTEND_LAYOUT;
+ break;
+ case 'c':
+ htmlPtr->flags |= RESIZE_CLIPWIN;
+ break;
+ case 's':
+ htmlPtr->flags |= STYLER_RUNNING;
+ break;
+ case 'a':
+ htmlPtr->flags |= ANIMATE_IMAGES;
+ break;
+ case 'v':
+ htmlPtr->flags |= VSCROLL;
+ break;
+ case 'h':
+ htmlPtr->flags |= HSCROLL;
+ break;
+ case 'g':
+ htmlPtr->flags |= GOT_FOCUS;
+ break;
+ case 'l':
+ htmlPtr->flags |= RELAYOUT;
+ break;
+ default:
+ Tcl_AppendResult(interp, "Unknown refresh option: ",
+ argv[n], 0);
+ return TCL_ERROR;
+ }
+ n++;
+ }
+ }
+ HtmlRefresh(htmlPtr, 0);
+ HtmlScheduleRedraw(htmlPtr);
+ return TCL_OK;
+}
+
+/* Return the source */
+int
+HtmlGetCmd(clientData, interp, objc, objv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *const *objv;
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ Tcl_SetObjResult(interp,
+ Tcl_NewByteArrayObj(htmlPtr->zText, htmlPtr->nText));
+ return TCL_OK;
+}
+
+/*
+** WIDGET text delete START END
+*/
+int
+HtmlTextDeleteCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ HtmlElement *pStart, *pEnd, *pn;
+ int ib, ie, idx = 0;
+ CONST char *cb;
+ CONST char *ce;
+ if (argc <= 3)
+ cb = "begin";
+ else
+ cb = argv[3];
+ if (argc <= 4)
+ ce = cb;
+ else
+ ce = argv[4];
+
+ if (HtmlGetIndex(htmlPtr, cb, &pStart, &ib) != 0) {
+ Tcl_AppendResult(interp, "malformed index: \"", cb, "\"", 0);
+ return TCL_ERROR;
+ }
+ if (HtmlGetIndex(htmlPtr, ce, &pEnd, &ie) != 0) {
+ Tcl_AppendResult(interp, "malformed index: \"", ce, "\"", 0);
+ return TCL_ERROR;
+ }
+ if (!pStart)
+ return TCL_OK;
+ idx = pStart->base.id;
+ if (pEnd == pStart) {
+ if (!ib && ((ie - 1) >= strlen(pStart->text.zText)))
+ HtmlRemoveElements(htmlPtr, pStart, pStart);
+ else
+ HtmlDelStrOffset(htmlPtr, pStart, ib, ie - ib + 1);
+ }
+ else {
+ pn = pStart->pNext;
+ if (pStart->base.type == Html_Text && ib)
+ HtmlDelStrOffset(htmlPtr, pStart, ib, ib + 1);
+ else
+ HtmlRemoveElements(htmlPtr, pStart, pStart);
+ pStart = pn;
+ if (pEnd) {
+ pn = pEnd->base.pPrev;
+ if (pEnd->base.type == Html_Text
+ && ((ie - 1) >= strlen(pEnd->text.zText)))
+ HtmlRemoveElements(htmlPtr, pEnd, pEnd);
+ else
+ HtmlDelStrOffset(htmlPtr, pEnd, 0, ie);
+ if (pStart == pEnd)
+ pEnd = 0;
+ else
+ pEnd = pn;
+ }
+ if (pEnd) {
+ HtmlRemoveElements(htmlPtr, pStart, pEnd);
+ }
+ }
+ HtmlRefresh(htmlPtr, idx);
+ return TCL_OK;
+}
+
+/*
+** WIDGET token insert INDEX TOKEN ARGS
+*/
+int
+HtmlTokenInsertCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ HtmlElement *pStart, *pEnd;
+ int idx = 0, i, tlen = strlen(argv[4]);
+ char *cp;
+ CONST char *attr = "";
+ if (argc > 5) {
+ attr = argv[5];
+ tlen += strlen(attr);
+ }
+ if (HtmlGetIndex(htmlPtr, argv[3], &pStart, &i) != 0) {
+ Tcl_AppendResult(interp, "malformed index: \"", argv[3], "\"", 0);
+ return TCL_ERROR;
+ }
+ if (pStart && pStart->base.type == Html_Text && i == pStart->base.count)
+ pStart = pStart->pNext;
+ HtmlInsertToken(htmlPtr, pStart, (char *) argv[4], attr, -1);
+ cp = (char *) HtmlAlloc(tlen + 6);
+ if (argc > 5) {
+ sprintf(cp, "<%s %s>", argv[4], argv[5]);
+ }
+ else {
+ sprintf(cp, "<%s>", argv[4]);
+ }
+ HtmlAddStrOffset(htmlPtr, pStart, cp, 0);
+ HtmlFree(cp);
+ if (pStart)
+ idx = pStart->base.id;
+ HtmlRefresh(htmlPtr, idx);
+ htmlPtr->ins.p = pStart;
+ htmlPtr->ins.i = 0;
+ return TCL_OK;
+}
+
+/*
+** WIDGET token delete START END
+*/
+int
+HtmlTokenDeleteCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ HtmlElement *pStart, *pEnd;
+ int i, idx = 0;
+ CONST char *cb;
+ CONST char *ce;
+ if (argc <= 3)
+ cb = "begin";
+ else
+ cb = argv[3];
+ if (argc <= 4)
+ ce = cb;
+ else
+ ce = argv[4];
+
+ if (HtmlGetIndex(htmlPtr, cb, &pStart, &i) != 0) {
+ Tcl_AppendResult(interp, "malformed index: \"", cb, "\"", 0);
+ return TCL_ERROR;
+ }
+ if (HtmlGetIndex(htmlPtr, ce, &pEnd, &i) != 0) {
+ Tcl_AppendResult(interp, "malformed index: \"", ce, "\"", 0);
+ return TCL_ERROR;
+ }
+ if (pStart) {
+ HtmlRemoveElements(htmlPtr, pStart, pEnd);
+ idx = pStart->base.id;
+ }
+ HtmlRefresh(htmlPtr, idx);
+ return TCL_OK;
+}
+
+/* Given a start token, find the matching end token. */
+int
+HtmlTokenGetEnd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ HtmlElement *pStart = 0;
+ int i;
+
+ if (HtmlGetIndex(htmlPtr, argv[3], &pStart, &i) != 0) {
+ Tcl_AppendResult(interp, "malformed index: \"", argv[3], "\"", 0);
+ return TCL_ERROR;
+ }
+ if (pStart && HtmlIsMarkup(pStart)) {
+ HtmlElement *p;
+ int en = HtmlGetEndToken(htmlPtr, pStart->base.type);
+ p = HtmlFindEndNest(htmlPtr, pStart, en, 0);
+ if (p && p->base.id == 0)
+ p = p->base.pNext;
+ if (p) {
+ char buf[20];
+ sprintf(buf, "%d", HtmlTokenNumber(p));
+ Tcl_AppendResult(interp, buf, 0);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * HtmlTokenGetCmd --
+ *
+ * $widget token get INDEX-1 ?INDEX-2?
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+int HtmlTokenGetCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ HtmlElement *pStart, *pEnd;
+ int i;
+ CONST char *cb;
+ CONST char *ce;
+ if (argc <= 3)
+ cb = "begin";
+ else
+ cb = argv[3];
+
+ if (HtmlGetIndex(htmlPtr, cb, &pStart, &i) != 0) {
+ Tcl_AppendResult(interp, "malformed index: \"", cb, "\"", 0);
+ return TCL_ERROR;
+ }
+ if (argc <= 4)
+ pEnd = pStart;
+ else {
+ if (HtmlGetIndex(htmlPtr, argv[4], &pEnd, &i) != 0) {
+ Tcl_AppendResult(interp, "malformed index: \"", argv[4], "\"", 0);
+ return TCL_ERROR;
+ }
+ }
+ if (pEnd)
+ pEnd = pEnd->base.pNext;
+ if (pStart) {
+ HtmlTclizeList(htmlPtr, interp, pStart, pEnd, 0);
+ }
+ return TCL_OK;
+}
+
+int
+HtmlTokenFindCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ HtmlIndex iStart, iEnd;
+ int i, after = 1, near = 0;
+ int type = HtmlNameToType(htmlPtr, argv[3]);
+ iStart.p = 0;
+ iEnd.p = 0;
+ iStart.i = 0;
+ iEnd.i = 0;
+ if (!htmlPtr->pFirst)
+ return TCL_OK;
+ if (type == Html_Unknown) {
+ Tcl_AppendResult(interp, "unknown tag: \"", argv[3], "\"", 0);
+ return TCL_ERROR;
+ }
+ if (argc > 5) {
+ if (HtmlGetIndex(htmlPtr, argv[5], &iStart.p, &iStart.i) != 0) {
+ Tcl_AppendResult(interp, "malformed index: \"", argv[5], "\"", 0);
+ return TCL_ERROR;
+ }
+ if (!strcasecmp(argv[4], "before"))
+ after = 0;
+ else if (!strcasecmp(argv[4], "near")) {
+ near = HtmlTokenNumber(iStart.p);
+ iStart.p = htmlPtr->pFirst;
+ }
+ else if (strcasecmp(argv[4], "after")) {
+ Tcl_AppendResult(interp, "before|after|near: \"", argv[4], "\"", 0);
+ return TCL_ERROR;
+ }
+ if (!near) {
+ if (after) {
+ if (iStart.p)
+ iStart.p = iStart.p->base.pNext;
+ }
+ else {
+ iEnd.p = iStart.p;
+ iStart.p = 0;
+ }
+ }
+ }
+ if (!iStart.p)
+ iStart.p = htmlPtr->pFirst;
+ if (!near)
+ if (iEnd.p)
+ iEnd.p = iEnd.p->base.pNext;
+ HtmlTclizeFind(interp, type, iStart.p, iEnd.p, near);
+ return TCL_OK;
+}
+
+/*
+** Remove Elements from the list of elements
+*/
+void
+HtmlRemoveElements(p, pElem, pLast)
+ HtmlWidget *p;
+ HtmlElement *pElem;
+ HtmlElement *pLast;
+{
+ HtmlElement *pPrev;
+ pPrev = pElem->base.pPrev;
+ if (p->pLast == pLast)
+ p->pLast = pPrev;
+ if (p->pFirst == pElem)
+ p->pFirst = pLast->base.pNext;
+ if (pPrev) {
+ pPrev->base.pNext = pLast->base.pNext;
+ }
+ if (pLast)
+ pLast->base.pPrev = pPrev;
+ while (pElem) {
+ pPrev = pElem->base.pNext;
+ HtmlDeleteElement(pElem);
+ p->nToken--;
+ if (pElem == pLast)
+ break;
+ pElem = pPrev;
+ }
+}
+
+/* Same as above, but puts ascii into buffer. */
+int
+HtmlAscii2Buf(interp, ip, ipEnd, buffer, len, offset)
+ Tcl_Interp *interp;
+ HtmlIndex *ip;
+ HtmlIndex *ipEnd;
+ char *buffer;
+ int len;
+ int offset;
+{
+ int i, j, l, n = 0, ob, oe;
+ char *cp;
+ HtmlElement *pBegin = ip->p, *p = ip->p, *pEnd = ipEnd->p;
+ ob = ip->i, oe = ipEnd->i;
+
+ while (p) {
+ switch (p->base.type) {
+ case Html_Text:
+ cp = p->text.zText;
+ for (i = 0, j = 0; cp[i]; i++) {
+ if (ob > 0)
+ ob--;
+ else if (p == pEnd && i >= oe)
+ return n;
+ else if (offset > 0)
+ offset--;
+ else if (n >= (len - 1))
+ return n;
+ else {
+ buffer[n++] = cp[i];
+ }
+ }
+ break;
+ case Html_P:
+ case Html_BR:
+ buffer[n++] = '\n';
+ break;
+ case Html_Space:
+ l = p->base.count;
+ j = -1;
+ if ((p->base.flags & HTML_NewLine) != 0) {
+ j = l++;
+ }
+ for (i = 0; i < l; i++) {
+ if (ob > 0)
+ ob--;
+ else if (p == pEnd && i >= oe)
+ return n;
+ else if (offset > 0)
+ offset--;
+ else if (n >= (len - 1))
+ return n;
+ else {
+ buffer[n++] = (j == i ? '\n' : ' ');
+ }
+ }
+ break;
+ }
+ if (p == pEnd)
+ return n;
+ p = p->pNext;
+ }
+ buffer[n] = 0;
+ return n;
+}
+
+static
+ void
+HtmlTclizeHtmlFmt(htmlPtr, interp, p, pEnd)
+ HtmlWidget *htmlPtr;
+ Tcl_Interp *interp;
+ HtmlElement *p;
+ HtmlElement *pEnd;
+{
+ Tcl_DString str;
+ int i, j, indent = 0;
+ char *zName;
+ char zLine[100];
+
+ Tcl_DStringInit(&str);
+ while (p && p != pEnd) {
+ switch (p->base.type) {
+ case Html_Block:
+ break;
+ case Html_COMMENT:
+ Tcl_DStringAppend(&str, "<!--", -1);
+ Tcl_DStringAppend(&str, p->text.zText, -1);
+ Tcl_DStringAppend(&str, "-->", -1);
+ break;
+ case Html_Text:
+ Tcl_DStringAppend(&str, p->text.zText, -1);
+ break;
+ case Html_Space:
+ for (j = 0; j < p->base.count; j++) {
+ Tcl_DStringAppend(&str, " ", 1);
+ }
+ if ((p->base.flags & HTML_NewLine) != 0)
+ Tcl_DStringAppend(&str, "\n", 1);
+ break;
+ case Html_Unknown:
+ Tcl_DStringAppend(&str, "Unknown", -1);
+ break;
+ default:
+ if (p->base.type >= HtmlGetMarkupMap(htmlPtr, 0)->type
+ && p->base.type <= HtmlGetMarkupMap(htmlPtr,
+ HTML_MARKUP_COUNT -
+ 1)->type) {
+ zName = HtmlGetMarkupMap(htmlPtr,
+ p->base.type -
+ HtmlGetMarkupMap(htmlPtr,
+ 0)->type)->zName;
+ }
+ else {
+ zName = "Unknown";
+ }
+ Tcl_DStringAppend(&str, "<", 1);
+ Tcl_DStringAppend(&str, zName, -1);
+ for (i = 0; i < (p->base.count - 1); i++) {
+ Tcl_DStringAppend(&str, " ", 1);
+ Tcl_DStringAppend(&str, p->markup.argv[i++], -1);
+ Tcl_DStringAppend(&str, "=", 1);
+ Tcl_DStringAppend(&str, p->markup.argv[i], -1);
+ }
+ Tcl_DStringAppend(&str, ">", 1);
+ break;
+ }
+ p = p->pNext;
+ }
+ Tcl_DStringResult(interp, &str);
+}
+
+/* Return num of chars at end of line that match chars at begin of pat */
+int
+trailmatch(line, pat)
+ char *line;
+ char *pat;
+{
+ char *p, *e, *ep;
+ int i, l = strlen(line);
+ if (!l)
+ return 0;
+ for (i = 0, l--; l >= i && line[l - i] == pat[i]; i++);
+ return i;
+}
+
+extern int (*HtmlFetchSelectionPtr) (ClientData, int, char *, int);
+
+int
+HtmlBP(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ CONST char **argv; /* List of all arguments */
+{
+ return TCL_OK;
+}
+/*DLL_EXPORT*/ int
+Htmlexts_Init(interp)
+ Tcl_Interp *interp;
+{
+#ifdef USE_TCL_STUBS
+ HtmlPostscriptPtr = 0;
+ if (Tcl_InitStubs(interp, "8.3", 0) == 0) {
+ return TCL_ERROR;
+ }
+#ifndef _TCLHTML_
+ if (Tk_InitStubs(interp, "8.3", 0) == 0) {
+ return TCL_ERROR;
+ }
+#endif /* _TCLHTML_ */
+#else
+#if TKHTML_PS
+ HtmlPostscriptPtr = HtmlPostscript;
+#endif
+ Tcl_PkgProvide(interp, HTML_PKGNAME "pr", HTML_PKGVERSION);
+#endif
+
+ HtmlFetchSelectionPtr = HtmlFetchSelection;
+ Tcl_LinkVar(interp, "tkhtmlexiting", (char *) &tkhtmlexiting, TCL_LINK_INT);
+ return TCL_OK;
+}
diff --git a/src/htmlform.c b/src/htmlform.c
new file mode 100644
index 0000000..f99b73c
--- /dev/null
+++ b/src/htmlform.c
@@ -0,0 +1,924 @@
+static char const rcsid[] =
+ "@(#) $Id: htmlform.c,v 1.33 2005/03/23 01:36:54 danielk1977 Exp $";
+
+/*
+** Routines used for processing HTML makeup for forms.
+**
+** This source code is released into the public domain by the author,
+** D. Richard Hipp, on 2002 December 17. Instead of a license, here
+** is a blessing:
+**
+** May you do good and not evil.
+** May you find forgiveness for yourself and forgive others.
+** May you share freely, never taking more than you give.
+*/
+#include <string.h>
+#include <stdlib.h>
+#include <stdarg.h>
+#include "html.h"
+
+static void EmptyInput _ANSI_ARGS_((HtmlElement * pElem));
+
+/*
+** Create the window name for a child widget. Space to hold the name
+** is obtained from HtmlAlloc() and must be freed by the calling function.
+*/
+static char *
+MakeWindowName(htmlPtr, pElem)
+ HtmlWidget *htmlPtr; /* The HTML widget */
+ HtmlElement *pElem; /* The input that needs a child widget
+ */
+{
+ int n;
+ char *zBuf;
+
+#ifdef _TCLHTML_
+ zBuf = HtmlAlloc(20);
+ strcpy(zBuf, ".bogus");
+#else
+ n = strlen(Tk_PathName(htmlPtr->clipwin));
+ zBuf = HtmlAlloc(n + 20);
+ sprintf(zBuf, "%s.x%d", Tk_PathName(htmlPtr->clipwin), pElem->input.cnt);
+#endif
+ return zBuf;
+}
+
+#ifdef _TCLHTML_
+static void
+SizeAndLink(HtmlWidget * htmlPtr, char *zWin, HtmlElement * pElem)
+{
+}
+void
+HtmlDeleteControls(HtmlWidget * htmlPtr)
+{
+}
+#else
+
+/*
+** Unmap any input control that is currently mapped.
+*/
+void
+HtmlUnmapControls(htmlPtr)
+ HtmlWidget *htmlPtr;
+{
+ HtmlElement *p;
+
+ for (p = htmlPtr->firstInput; p; p = p->input.pNext) {
+ if (p->input.tkwin != 0 && Tk_IsMapped(p->input.tkwin)) {
+ Tk_UnmapWindow(p->input.tkwin);
+ }
+ }
+}
+
+/*
+** Map any control that should be visible according to the
+** current scroll position. At the same time, if any controls that
+** should not be visible are mapped, unmap them. After this routine
+** finishes, all <INPUT> controls should be in their proper places
+** regardless of where they might have been before.
+**
+** Return the number of controls that are currently visible.
+*/
+int
+HtmlMapControls(htmlPtr)
+ HtmlWidget *htmlPtr;
+{
+ HtmlElement *p; /* For looping over all controls */
+ int x, y, w, h; /* Part of the virtual canvas that is
+ * visible */
+ int cnt = 0; /* Number of visible controls */
+
+ x = htmlPtr->xOffset;
+ y = htmlPtr->yOffset;
+ w = Tk_Width(htmlPtr->clipwin);
+ h = Tk_Height(htmlPtr->clipwin);
+ for (p = htmlPtr->firstInput; p; p = p->input.pNext) {
+ if (p->input.tkwin == 0)
+ continue;
+ if (p->input.y < y + h
+ && p->input.y + p->input.h > y
+ && p->input.x < x + w && p->input.x + p->input.w > x) {
+ /*
+ * The control should be visible. Make is so if it isn't already
+ */
+ Tk_MoveResizeWindow(p->input.tkwin,
+ p->input.x - x, p->input.y - y,
+ p->input.w, p->input.h);
+ if (!Tk_IsMapped(p->input.tkwin)) {
+ Tk_MapWindow(p->input.tkwin);
+ }
+ cnt++;
+ }
+ else {
+ /*
+ * This control should not be visible. Unmap it.
+ */
+ if (Tk_IsMapped(p->input.tkwin)) {
+ Tk_UnmapWindow(p->input.tkwin);
+ }
+ }
+ }
+ return cnt;
+}
+
+/*
+** Delete all input controls. This happens when the HTML widget
+** is cleared.
+**
+** When the TCL "exit" command is invoked, the order of operations
+** here is very touchy.
+*/
+void
+HtmlDeleteControls(htmlPtr)
+ HtmlWidget *htmlPtr;
+{
+ HtmlElement *p; /* For looping over all controls */
+ Tcl_Interp *interp; /* The interpreter */
+
+ interp = htmlPtr->interp;
+ p = htmlPtr->firstInput;
+ htmlPtr->firstInput = 0;
+ htmlPtr->lastInput = 0;
+ htmlPtr->nInput = 0;
+ if (p == 0 || htmlPtr->tkwin == 0)
+ return;
+ HtmlLock(htmlPtr);
+ for (; p; p = p->input.pNext) {
+ if (p->input.pForm && p->input.pForm->form.hasctl
+ && htmlPtr->zFormCommand && htmlPtr->zFormCommand[0]
+ && !Tcl_InterpDeleted(interp) && htmlPtr->clipwin) {
+ Tcl_DString cmd;
+ int result;
+ char zBuf[60];
+ Tcl_DStringInit(&cmd);
+ Tcl_DStringAppend(&cmd, htmlPtr->zFormCommand, -1);
+ sprintf(zBuf, " %d flush {}", p->input.pForm->form.id);
+ Tcl_DStringAppend(&cmd, zBuf, -1);
+ result = Tcl_GlobalEval(htmlPtr->interp, Tcl_DStringValue(&cmd));
+ Tcl_DStringFree(&cmd);
+ if (!Tcl_InterpDeleted(interp)) {
+ if (result != TCL_OK) {
+ Tcl_AddErrorInfo(htmlPtr->interp,
+ "\n (-formcommand flush callback executed by html widget)");
+ Tcl_BackgroundError(htmlPtr->interp);
+ }
+ Tcl_ResetResult(htmlPtr->interp);
+ }
+ p->input.pForm->form.hasctl = 0;
+ }
+ if (p->input.tkwin) {
+ if (htmlPtr->clipwin != 0)
+ Tk_DestroyWindow(p->input.tkwin);
+ p->input.tkwin = 0;
+ }
+ p->input.sized = 0;
+ }
+ HtmlUnlock(htmlPtr);
+}
+
+/*
+** This routine is called when one of the child windows for a form
+** wants to change its size.
+*/
+static void
+HtmlInputRequestProc(clientData, tkwin)
+ ClientData clientData;
+ Tk_Window tkwin;
+{
+ HtmlElement *pElem = (HtmlElement *) clientData;
+ if (pElem->base.type != Html_INPUT) {
+ CANT_HAPPEN;
+ return;
+ }
+ if (pElem->input.tkwin != tkwin) {
+ CANT_HAPPEN;
+ return;
+ }
+ pElem->input.w = Tk_ReqWidth(tkwin);
+ pElem->input.h = Tk_ReqHeight(tkwin);
+ if (pElem->input.htmlPtr && pElem->input.htmlPtr->tkwin != 0) {
+ pElem->input.htmlPtr->flags |= RELAYOUT;
+ HtmlScheduleRedraw(pElem->input.htmlPtr);
+ }
+}
+
+/*
+** This routine is called when another entity takes over geometry
+** management for a widget corresponding to an input element.
+*/
+static void
+HtmlInputLostSlaveProc(clientData, tkwin)
+ ClientData clientData;
+ Tk_Window tkwin;
+{
+ HtmlElement *pElem = (HtmlElement *) clientData;
+ if (pElem->base.type != Html_INPUT) {
+ CANT_HAPPEN;
+ return;
+ }
+ if (pElem->input.tkwin != tkwin) {
+ CANT_HAPPEN;
+ return;
+ }
+ EmptyInput(pElem);
+ if (pElem->input.htmlPtr && pElem->input.htmlPtr->tkwin != 0) {
+ pElem->input.htmlPtr->flags |= RELAYOUT;
+ HtmlScheduleRedraw(pElem->input.htmlPtr);
+ }
+}
+
+/*
+** This routine catches DestroyNotify events on a INPUT window so
+** that we will know the window is been deleted.
+*/
+static void
+HtmlInputEventProc(clientData, eventPtr)
+ ClientData clientData;
+ XEvent *eventPtr;
+{
+ HtmlElement *pElem = (HtmlElement *) clientData;
+ /*
+ * if( pElem->base.type!=Html_INPUT ){ CANT_HAPPEN; return; }
+ */
+ if (eventPtr->type == DestroyNotify) {
+ EmptyInput(pElem);
+ if (pElem->input.htmlPtr && pElem->input.htmlPtr->tkwin != 0) {
+ pElem->input.htmlPtr->flags |= RELAYOUT;
+ HtmlScheduleRedraw(pElem->input.htmlPtr);
+ }
+ }
+}
+
+/*
+** The geometry manager for the HTML widget
+*/
+static Tk_GeomMgr htmlGeomType = {
+ "html", /* Name */
+ HtmlInputRequestProc, /* Called when widget changes size */
+ HtmlInputLostSlaveProc, /* Called when someone else takes over
+ * management */
+};
+
+/*
+** zWin is the name of a child widget that is used to implement an
+** input element. Query Tk for information about this widget (such
+** as its size) and put that information in the pElem structure
+** that represents the input.
+*/
+static void
+SizeAndLink(htmlPtr, zWin, pElem)
+ HtmlWidget *htmlPtr;
+ char *zWin;
+ HtmlElement *pElem;
+{
+ pElem->input.tkwin =
+ Tk_NameToWindow(htmlPtr->interp, zWin, htmlPtr->clipwin);
+ if (pElem->input.tkwin == 0) {
+ Tcl_ResetResult(htmlPtr->interp);
+ EmptyInput(pElem);
+ }
+ else if (pElem->input.type == INPUT_TYPE_Hidden) {
+ pElem->input.w = 0;
+ pElem->input.h = 0;
+ pElem->base.flags &= !HTML_Visible;
+ pElem->base.style.flags |= STY_Invisible;
+ }
+ else {
+ pElem->input.w = Tk_ReqWidth(pElem->input.tkwin);
+ pElem->input.h =
+ Tk_ReqHeight(pElem->input.tkwin) + htmlPtr->formPadding;
+ pElem->base.flags |= HTML_Visible;
+ pElem->input.htmlPtr = htmlPtr;
+ Tk_ManageGeometry(pElem->input.tkwin, &htmlGeomType, pElem);
+ Tk_CreateEventHandler(pElem->input.tkwin, StructureNotifyMask,
+ HtmlInputEventProc, pElem);
+ }
+ pElem->input.pNext = 0;
+ if (htmlPtr->firstInput == 0) {
+ htmlPtr->firstInput = pElem;
+ }
+ else {
+ htmlPtr->lastInput->input.pNext = pElem;
+ }
+ htmlPtr->lastInput = pElem;
+ pElem->input.sized = 1;
+}
+
+int
+HtmlSizeWindow(clientData, interp, argc, argv)
+ ClientData clientData; /* The HTML widget */
+ Tcl_Interp *interp; /* The interpreter */
+ int argc; /* Number of arguments */
+ const char **argv; /* List of all arguments */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ CONST char *zWin = argv[2];
+ Tk_Window tkwin = Tk_NameToWindow(htmlPtr->interp, zWin, htmlPtr->clipwin);
+ Tk_ManageGeometry(tkwin, &htmlGeomType, 0);
+}
+
+#endif /* _TCLHTML_ */
+
+/*
+** Return an appropriate type value for the given <INPUT> markup.
+*/
+static int
+InputType(p)
+ HtmlElement *p;
+{
+ int type = INPUT_TYPE_Unknown;
+ char *z;
+ int i;
+ static struct {
+ char *zName;
+ int type;
+ } types[] = {
+ {
+ "checkbox", INPUT_TYPE_Checkbox}, {
+ "file", INPUT_TYPE_File}, {
+ "hidden", INPUT_TYPE_Hidden}, {
+ "image", INPUT_TYPE_Image}, {
+ "password", INPUT_TYPE_Password}, {
+ "radio", INPUT_TYPE_Radio}, {
+ "reset", INPUT_TYPE_Reset}, {
+ "submit", INPUT_TYPE_Submit}, {
+ "text", INPUT_TYPE_Text}, {
+ "name", INPUT_TYPE_Text}, {
+ "textfield", INPUT_TYPE_Text}, {
+ "button", INPUT_TYPE_Button},};
+
+ switch (p->base.type) {
+ case Html_INPUT:
+ z = HtmlMarkupArg(p, "type", "text");
+ if (z == 0) {
+ break;
+ }
+ for (i = 0; i < sizeof(types) / sizeof(types[0]); i++) {
+ if (stricmp(types[i].zName, z) == 0) {
+ type = types[i].type;
+ break;
+ }
+ }
+ break;
+ case Html_SELECT:
+ type = INPUT_TYPE_Select;
+ break;
+ case Html_TEXTAREA:
+ type = INPUT_TYPE_TextArea;
+ break;
+ case Html_TABLE:
+ type = INPUT_TYPE_Tktable;
+ break;
+ case Html_APPLET:
+ case Html_IFRAME:
+ case Html_EMBED:
+ type = INPUT_TYPE_Applet;
+ break;
+ default:
+ CANT_HAPPEN;
+ break;
+ }
+ return type;
+}
+
+/*
+** A Input element is the input. Mark this element as being
+** empty. It has no widget and doesn't appear on the screen.
+**
+** This is called for HIDDEN inputs or when the -formcommand
+** callback doesn't create the widget.
+*/
+static void
+EmptyInput(pElem)
+ HtmlElement *pElem;
+{
+ pElem->input.tkwin = 0;
+ pElem->input.w = 0;
+ pElem->input.h = 0;
+ pElem->base.flags &= !HTML_Visible;
+ pElem->base.style.flags |= STY_Invisible;
+ pElem->input.sized = 1;
+}
+
+/* Append all text and space tokens between pStart and pEnd to
+** the given Tcl_DString.
+*/
+static void
+HtmlAppendText(str, pFirst, pEnd)
+ Tcl_DString *str; /* Append the text here */
+ HtmlElement *pFirst; /* The first token */
+ HtmlElement *pEnd; /* The last token */
+{
+ while (pFirst && pFirst != pEnd) {
+ switch (pFirst->base.type) {
+ case Html_Text:{
+ Tcl_DStringAppend(str, pFirst->text.zText, -1);
+ break;
+ }
+ case Html_Space:{
+ if (pFirst->base.flags & HTML_NewLine) {
+ Tcl_DStringAppend(str, "\n", 1);
+ }
+ else {
+ int cnt;
+ static char zSpaces[] = " ";
+ cnt = pFirst->base.count;
+ while (cnt > sizeof(zSpaces) - 1) {
+ Tcl_DStringAppend(str, zSpaces,
+ sizeof(zSpaces) - 1);
+ cnt -= sizeof(zSpaces) - 1;
+ }
+ if (cnt > 0) {
+ Tcl_DStringAppend(str, zSpaces, cnt);
+ }
+ }
+ break;
+ }
+ default:
+ /*
+ * Do nothing
+ */
+ break;
+ }
+ pFirst = pFirst->pNext;
+ }
+}
+
+/*
+** The "p" argument points to a <select>. This routine scans all
+** subsequent elements (up to the next </select>) looking for
+** <option> tags. For each option tag, it appends three elements
+** to the "str" DString:
+**
+** * 1 or 0 to indicated whether or not the element is
+** selected.
+**
+** * The value returned if this element is selected.
+**
+** * The text displayed for this element.
+*/
+static void
+AddSelectOptions(str, p, pEnd)
+ Tcl_DString *str; /* Add text here */
+ HtmlElement *p; /* The <SELECT> markup */
+ HtmlElement *pEnd; /* The </SELECT> markup */
+{
+ HtmlElement *pSave;
+ while (p && p != pEnd && p->base.type != Html_EndSELECT) {
+ if (p->base.type == Html_OPTION) {
+ char *zValue;
+ Tcl_DStringStartSublist(str);
+ if (HtmlMarkupArg(p, "selected", 0) == 0) {
+ Tcl_DStringAppend(str, "0 ", 2);
+ }
+ else {
+ Tcl_DStringAppend(str, "1 ", 2);
+ }
+ zValue = HtmlMarkupArg(p, "value", 0);
+ if (zValue) {
+ Tcl_DStringAppendElement(str, zValue);
+ pSave = 0;
+ }
+ else
+ pSave = p;
+ SelectDo:
+ Tcl_DStringStartSublist(str);
+ p = p->pNext;
+ while (p && p != pEnd && p->base.type != Html_EndOPTION
+ && p->base.type != Html_OPTION
+ && p->base.type != Html_EndSELECT) {
+ if (p->base.type == Html_Text) {
+ Tcl_DStringAppend(str, p->text.zText, -1);
+ }
+ else if (p->base.type == Html_Space) {
+ Tcl_DStringAppend(str, " ", 1);
+ }
+ p = p->pNext;
+ }
+ Tcl_DStringEndSublist(str);
+ if (pSave) {
+ p = pSave;
+ pSave = 0;
+ goto SelectDo;
+ }
+ Tcl_DStringEndSublist(str);
+ }
+ else {
+ p = p->pNext;
+ }
+ }
+}
+
+/* BROKEN Return the idx'th elments of type n in form. */
+HtmlElement *
+HtmlFormIdx(htmlPtr, p, tag, idx, radio)
+ HtmlWidget *htmlPtr;
+ HtmlElement *p;
+ int tag;
+ int idx;
+ int radio;
+{
+ int n;
+ HtmlElement *q;
+ if (p->base.type = Html_FORM) {
+ switch (n) {
+ case Html_FORM:
+ case Html_SELECT:
+ case Html_TEXTAREA:
+ case Html_INPUT:
+ case Html_OPTION:
+ break;
+ }
+ }
+ return 0;
+}
+
+/* Return the number of elments of type p in form. */
+int
+HtmlFormCount(htmlPtr, p, radio)
+ HtmlWidget *htmlPtr;
+ HtmlElement *p;
+ int radio;
+{
+ HtmlElement *q = p;
+ switch (p->base.type) {
+ case Html_SELECT:
+ return p->input.subid;
+ case Html_TEXTAREA:
+ case Html_INPUT:
+ if (radio && p->input.type == INPUT_TYPE_Radio)
+ return p->input.subid;
+ return p->input.pForm->form.els;
+ case Html_OPTION:
+ while ((q = q->base.pPrev))
+ if (q->base.type == Html_SELECT)
+ return q->input.subid;
+ }
+ return -1;
+}
+
+/* Add the DOM control information for form elements. */
+int
+HtmlAddFormInfo(htmlPtr, p)
+ HtmlWidget *htmlPtr;
+ HtmlElement *p;
+{
+ HtmlElement *q, *f;
+ char *name, *z;
+ int t;
+ switch (p->base.type) {
+ case Html_SELECT:
+ case Html_TEXTAREA:
+ case Html_INPUT:
+ if (!(f = htmlPtr->formStart))
+ return;
+ p->input.pForm = htmlPtr->formStart;
+ if (!f->form.pFirst)
+ f->form.pFirst = p;
+ if (htmlPtr->formElemLast)
+ htmlPtr->formElemLast->input.pNext = p;
+ htmlPtr->formElemLast = p;
+ p->input.id = htmlPtr->inputIdx++;
+ t = p->input.type = InputType(p);
+ if (t == INPUT_TYPE_Radio) {
+ if ((name = HtmlMarkupArg(p, "name", 0))) {
+ for (q = f->form.pFirst; q; q = q->input.pNext)
+ if ((z = HtmlMarkupArg(q, "name", 0))
+ && !strcmp(z, name)) {
+ p->input.subid = htmlPtr->radioIdx++;
+ break;
+ }
+ if (!q)
+ p->input.subid = (htmlPtr->radioIdx = 0);
+ }
+ }
+ break;
+ case Html_FORM:
+ htmlPtr->formStart = p;
+ p->form.id = htmlPtr->nForm++;
+ break;
+ case Html_EndTEXTAREA:
+ case Html_EndSELECT:
+ case Html_EndFORM:
+ htmlPtr->formStart = 0;
+ htmlPtr->inputIdx = 0;
+ htmlPtr->radioIdx = 0;
+ htmlPtr->formElemLast = 0;
+ break;
+ case Html_OPTION:
+ if (htmlPtr->formElemLast && htmlPtr->formElemLast->base.type ==
+ Html_SELECT)
+ htmlPtr->formElemLast->input.subid++;
+ break;
+ default:
+ break;
+ }
+}
+
+void
+HtmlAppendStyle(htmlPtr, cmd, pf)
+ HtmlWidget *htmlPtr;
+ Tcl_DString *cmd;
+ HtmlElement *pf;
+{
+#ifndef _TCLHTML_
+ char buf[BUFSIZ];
+ CONST char *c1;
+ CONST char *c2;
+ int bg = pf->base.style.bgcolor;
+ int fg = pf->base.style.color;
+ XColor *cbg = htmlPtr->apColor[bg];
+ XColor *cfg = htmlPtr->apColor[fg];
+ c1 = Tk_NameOfColor(cfg);
+ c2 = Tk_NameOfColor(cbg);
+ Tcl_DStringAppend(cmd, "color ", -1);
+ Tcl_DStringAppend(cmd, Clr2Name(c1), -1);
+ Tcl_DStringAppend(cmd, " bgcolor ", -1);
+ Tcl_DStringAppend(cmd, Clr2Name(c2), -1);
+ Tcl_DStringAppend(cmd, " font {", -1);
+ Tcl_DStringAppend(cmd, Tk_NameOfFont(HtmlGetFont(htmlPtr,
+ pf->base.style.font)), -1);
+ Tcl_DStringAppend(cmd, "}", -1);
+#endif
+}
+
+/*
+** This routine implements the Sizer() function for <INPUT>,
+** <SELECT> and <TEXTAREA> markup.
+**
+** A side effect of sizing these markups is that widgets are
+** created to represent the corresponding input controls.
+**
+** The function normally returns 0. But if it is dealing with
+** a <SELECT> or <TEXTAREA> that is incomplete, 1 is returned.
+** In that case, the sizer will be called again at some point in
+** the future when more information is available.
+*/
+int
+HtmlControlSize(htmlPtr, pElem)
+ HtmlWidget *htmlPtr;
+ HtmlElement *pElem;
+{
+ char *zWin; /* Name of child widget that
+ * implements this input */
+ int incomplete = 0; /* True if data is incomplete */
+ Tcl_DString cmd; /* The complete -formcommand callback */
+
+ if (pElem->input.sized)
+ return 0;
+ if (pElem->input.type == INPUT_TYPE_Unknown)
+ pElem->input.type = InputType(pElem);
+ switch (pElem->input.type) {
+ case INPUT_TYPE_Checkbox:
+ case INPUT_TYPE_Hidden:
+ case INPUT_TYPE_Image:
+ case INPUT_TYPE_Radio:
+ case INPUT_TYPE_Reset:
+ case INPUT_TYPE_Submit:
+ case INPUT_TYPE_Button:
+ case INPUT_TYPE_Text:
+ case INPUT_TYPE_Password:
+ case INPUT_TYPE_File:{
+ int result;
+ char zToken[50];
+
+ if (pElem->input.pForm == 0 || htmlPtr->zFormCommand == 0
+ || htmlPtr->zFormCommand[0] == 0) {
+ EmptyInput(pElem);
+ break;
+ }
+ Tcl_DStringInit(&cmd);
+ Tcl_DStringAppend(&cmd, htmlPtr->zFormCommand, -1);
+ sprintf(zToken, " %d input ", pElem->input.pForm->form.id);
+ Tcl_DStringAppend(&cmd, zToken, -1);
+
+/*
+ Tcl_DStringStartSublist(&cmd);
+ HtmlAppendStyle(htmlPtr,&cmd, pElem);
+ Tcl_DStringEndSublist(&cmd);
+*/
+ Tcl_DStringAppend(&cmd, " ", -1);
+ pElem->input.cnt = ++htmlPtr->nInput;
+ zWin = MakeWindowName(htmlPtr, pElem);
+ Tcl_DStringAppend(&cmd, zWin, -1);
+ Tcl_DStringStartSublist(&cmd);
+ HtmlAppendArglist(&cmd, pElem);
+ Tcl_DStringEndSublist(&cmd);
+ HtmlLock(htmlPtr);
+ htmlPtr->inParse++;
+ result = Tcl_GlobalEval(htmlPtr->interp,
+ Tcl_DStringValue(&cmd));
+ htmlPtr->inParse--;
+ Tcl_DStringFree(&cmd);
+ if (!HtmlUnlock(htmlPtr)) {
+ pElem->form.hasctl = 1;
+ if (result != TCL_OK) {
+ Tcl_AddErrorInfo(htmlPtr->interp,
+ "\n (-formcommand input callback executed by html widget)");
+ Tcl_BackgroundError(htmlPtr->interp);
+ }
+ SizeAndLink(htmlPtr, zWin, pElem);
+ }
+ HtmlFree(zWin);
+ break;
+ }
+ case INPUT_TYPE_Select:{
+ int result;
+ char zToken[50];
+
+ if (pElem->input.pForm == 0 || htmlPtr->zFormCommand == 0
+ || htmlPtr->zFormCommand[0] == 0) {
+ EmptyInput(pElem);
+ break;
+ }
+ Tcl_DStringInit(&cmd);
+ Tcl_DStringAppend(&cmd, htmlPtr->zFormCommand, -1);
+ sprintf(zToken, " %d select ", pElem->input.pForm->form.id);
+ Tcl_DStringAppend(&cmd, zToken, -1);
+ Tcl_DStringStartSublist(&cmd);
+ HtmlAppendStyle(htmlPtr, &cmd, pElem);
+ Tcl_DStringEndSublist(&cmd);
+ Tcl_DStringAppend(&cmd, " ", -1);
+ pElem->input.cnt = ++htmlPtr->nInput;
+ zWin = MakeWindowName(htmlPtr, pElem);
+ Tcl_DStringAppend(&cmd, zWin, -1);
+ Tcl_DStringStartSublist(&cmd);
+ HtmlAppendArglist(&cmd, pElem);
+ Tcl_DStringEndSublist(&cmd);
+ Tcl_DStringStartSublist(&cmd);
+ AddSelectOptions(&cmd, pElem, pElem->input.pEnd);
+ Tcl_DStringEndSublist(&cmd);
+ HtmlLock(htmlPtr);
+ htmlPtr->inParse++;
+ result = Tcl_GlobalEval(htmlPtr->interp,
+ Tcl_DStringValue(&cmd));
+ htmlPtr->inParse--;
+ Tcl_DStringFree(&cmd);
+ if (!HtmlUnlock(htmlPtr)) {
+ SizeAndLink(htmlPtr, zWin, pElem);
+ if (result != TCL_OK) {
+ Tcl_AddErrorInfo(htmlPtr->interp,
+ "\n (-formcommand select callback executed by html widget)");
+ Tcl_BackgroundError(htmlPtr->interp);
+ }
+ }
+ HtmlFree(zWin);
+ break;
+ }
+ case INPUT_TYPE_TextArea:{
+ int result;
+ char zToken[50];
+
+ if (pElem->input.pForm == 0 || htmlPtr->zFormCommand == 0
+ || htmlPtr->zFormCommand[0] == 0) {
+ EmptyInput(pElem);
+ break;
+ }
+ Tcl_DStringInit(&cmd);
+ Tcl_DStringAppend(&cmd, htmlPtr->zFormCommand, -1);
+ sprintf(zToken, " %d textarea ", pElem->input.pForm->form.id);
+ Tcl_DStringAppend(&cmd, zToken, -1);
+ Tcl_DStringStartSublist(&cmd);
+ HtmlAppendStyle(htmlPtr, &cmd, pElem);
+ Tcl_DStringEndSublist(&cmd);
+ Tcl_DStringAppend(&cmd, " ", -1);
+ pElem->input.cnt = ++htmlPtr->nInput;
+ zWin = MakeWindowName(htmlPtr, pElem);
+ Tcl_DStringAppend(&cmd, zWin, -1);
+ Tcl_DStringStartSublist(&cmd);
+ HtmlAppendArglist(&cmd, pElem);
+ Tcl_DStringEndSublist(&cmd);
+ Tcl_DStringStartSublist(&cmd);
+ HtmlAppendText(&cmd, pElem, pElem->input.pEnd);
+ Tcl_DStringEndSublist(&cmd);
+ HtmlLock(htmlPtr);
+ htmlPtr->inParse++;
+ result = Tcl_GlobalEval(htmlPtr->interp,
+ Tcl_DStringValue(&cmd));
+ htmlPtr->inParse--;
+ Tcl_DStringFree(&cmd);
+ if (!HtmlUnlock(htmlPtr)) {
+ SizeAndLink(htmlPtr, zWin, pElem);
+ if (result != TCL_OK) {
+ Tcl_AddErrorInfo(htmlPtr->interp,
+ "\n (-formcommand textarea callback executed by html widget)");
+ Tcl_BackgroundError(htmlPtr->interp);
+ }
+ }
+ HtmlFree(zWin);
+ break;
+ }
+ case INPUT_TYPE_Tktable:
+ case INPUT_TYPE_Applet:{
+ int result;
+
+ if (htmlPtr->zAppletCommand == 0
+ || htmlPtr->zAppletCommand[0] == 0) {
+ EmptyInput(pElem);
+ break;
+ }
+ Tcl_DStringInit(&cmd);
+ Tcl_DStringAppend(&cmd, htmlPtr->zAppletCommand, -1);
+ Tcl_DStringAppend(&cmd, " ", 1);
+ pElem->input.cnt = ++htmlPtr->nInput;
+ zWin = MakeWindowName(htmlPtr, pElem);
+ Tcl_DStringAppend(&cmd, zWin, -1);
+ Tcl_DStringStartSublist(&cmd);
+ if (pElem->input.type != INPUT_TYPE_Tktable) {
+ HtmlAppendArglist(&cmd, pElem);
+ Tcl_DStringEndSublist(&cmd);
+ }
+ else {
+ if (pElem->pNext && pElem->pNext->base.type == Html_TABLE) {
+ char buf[30];
+ HtmlAppendArglist(&cmd, pElem->pNext);
+ Tcl_DStringEndSublist(&cmd);
+ Tcl_DStringAppend(&cmd, " ", 1);
+ sprintf(buf, "%d", pElem->pNext->base.id);
+ Tcl_DStringAppend(&cmd, buf, -1);
+ }
+ }
+ HtmlLock(htmlPtr);
+ htmlPtr->inParse++;
+ result = Tcl_GlobalEval(htmlPtr->interp,
+ Tcl_DStringValue(&cmd));
+ htmlPtr->inParse--;
+ Tcl_DStringFree(&cmd);
+ if (!HtmlUnlock(htmlPtr)) {
+ SizeAndLink(htmlPtr, zWin, pElem);
+ if (result != TCL_OK) {
+ Tcl_AddErrorInfo(htmlPtr->interp,
+ "\n (-appletcommand callback executed by html widget)");
+ Tcl_BackgroundError(htmlPtr->interp);
+ }
+ }
+ HtmlFree(zWin);
+ break;
+ }
+ default:{
+ CANT_HAPPEN;
+ pElem->base.flags &= ~HTML_Visible;
+ pElem->base.style.flags |= STY_Invisible;
+ pElem->input.tkwin = 0;
+ break;
+ }
+ }
+ return incomplete;
+}
+
+#if 0
+
+/*
+** The following array determines which characters can be put directly
+** in a query string and which must be escaped.
+*/
+static char needEscape[] = {
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1,
+ 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0,
+ 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1,
+};
+
+#define NeedToEscape(C) ((C)>0 && (C)<127 && needEscape[(int)(C)])
+
+/*
+** Append to the given DString, an encoded version of the given
+** text.
+*/
+static void
+EncodeText(Tcl_DString * str, char *z)
+{
+ int i;
+ while (*z) {
+ for (i = 0; z[i] && !NeedToEscape(z[i]); i++) {
+ }
+ if (i > 0) {
+ Tcl_DStringAppend(str, z, i);
+ }
+ z += i;
+ while (*z && NeedToEscape(*z)) {
+ if (*z == ' ') {
+ Tcl_DStringAppend(str, "+", 1);
+ }
+ else if (*z == '\n') {
+ Tcl_DStringAppend(str, "%0D%0A", 6);
+ }
+ else if (*z == '\r') {
+ /*
+ * Ignore it...
+ */
+ }
+ else {
+ char zBuf[5];
+ sprintf(zBuf, "%%%02X", 0xff & *z);
+ Tcl_DStringAppend(str, zBuf, 3);
+ }
+ z++;
+ }
+ }
+}
+#endif
diff --git a/src/htmlhash.c b/src/htmlhash.c
index 9a3e9ad..cac7cec 100644
--- a/src/htmlhash.c
+++ b/src/htmlhash.c
@@ -43,7 +43,7 @@
* POSSIBILITY OF SUCH DAMAGE.
* COPYRIGHT:
*/
-static const char rcsid[] = "$Id: htmlhash.c,v 1.22 2006/10/27 06:40:33 danielk1977 Exp $";
+static const char rcsid[] = "$Id: htmlhash.c,v 1.23 2007/11/11 11:00:48 danielk1977 Exp $";
#include <tcl.h>
/* #include <strings.h> */
@@ -133,7 +133,8 @@ allocCaseInsensitiveEntry(tablePtr, keyPtr)
Tcl_HashTable *tablePtr; /* Hash table. */
VOID *keyPtr; /* Key to store in the hash table entry. */
{
- CONST char *string = (CONST char *) keyPtr;
+ const char *string = (CONST char *) keyPtr;
+ char *pCsr;
Tcl_HashEntry *hPtr;
unsigned int size;
@@ -144,6 +145,10 @@ allocCaseInsensitiveEntry(tablePtr, keyPtr)
hPtr = (Tcl_HashEntry *) HtmlAlloc("allocCaseInsensitiveEntry()", size);
strcpy(hPtr->key.string, string);
+ for (pCsr = hPtr->key.string; *pCsr; pCsr++) {
+ if( *pCsr > 0 ) *pCsr = tolower(*pCsr);
+ }
+
return hPtr;
}
diff --git a/src/htmlimage.c b/src/htmlimage.c
index a99e7de..654bdba 100644
--- a/src/htmlimage.c
+++ b/src/htmlimage.c
@@ -36,7 +36,7 @@
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
* POSSIBILITY OF SUCH DAMAGE.
*/
-static const char rcsid[] = "$Id: htmlimage.c,v 1.65 2007/09/25 11:21:42 danielk1977 Exp $";
+static const char rcsid[] = "$Id: htmlimage.c,v 1.70 2008/01/20 06:17:49 danielk1977 Exp $";
#include <assert.h>
#include "html.h"
@@ -60,17 +60,24 @@ static const char rcsid[] = "$Id: htmlimage.c,v 1.65 2007/09/25 11:21:42 danielk
*
* HtmlImageServerInit()
* HtmlImageServerShutdown()
+ *
* HtmlImageServerGet()
+ *
+ * HtmlImageServerSuspendGC()
+ * HtmlImageServerDoGC()
*
* Image Object:
*
* HtmlImageUnscaledName()
* HtmlImageScale()
- * HtmlImageTile()
- * HtmlImageImage()
* HtmlImageFree()
* HtmlImageAlphaChannel()
*
+ * HtmlImageTile()
+ * HtmlImageImage()
+ * HtmlImagePixmap()
+ * HtmlImageTilePixmap()
+ *
* IMAGE CONVERSION ROUTINES
*
* As well as the image server, this file also contains the following
@@ -105,6 +112,15 @@ struct HtmlImage2 {
int height; /* Height of HtmlImage2.image */
Tk_Image image; /* Scaled (or unscaled) image */
+ int iTileWidth; /* Width of tile image (if it exists) */
+ int iTileHeight; /* Height of tile image (if it exists) */
+
+ Pixmap pixmap; /* Pixmap of image */
+ Pixmap tilepixmap; /* Tile pixmap of image */
+ Tcl_Obj *pCompressed; /* Compressed image data */
+
+ int nIgnoreChange;
+
Tcl_Obj *pTileName; /* Name of Tk tile image */
Tk_Image tile; /* Tiled image, or zero */
@@ -222,17 +238,23 @@ freeTile(pImage)
HtmlTree *pTree = pImage->pImageServer->pTree;
int flags = TCL_GLOBAL_ONLY;
Tcl_Obj *pScript;
- if (!pImage->pTileName) return;
-
- pScript = Tcl_NewStringObj("image delete", -1);
- Tcl_IncrRefCount(pScript);
- Tcl_ListObjAppendElement(0, pScript, pImage->pTileName);
- Tcl_EvalObjEx(pTree->interp, pScript, flags);
- Tcl_DecrRefCount(pScript);
-
- Tcl_DecrRefCount(pImage->pTileName);
- pImage->tile = 0;
- pImage->pTileName = 0;
+ if (pImage->pTileName) {
+ pScript = Tcl_NewStringObj("image delete", -1);
+ Tcl_IncrRefCount(pScript);
+ Tcl_ListObjAppendElement(0, pScript, pImage->pTileName);
+ Tcl_EvalObjEx(pTree->interp, pScript, flags);
+ Tcl_DecrRefCount(pScript);
+
+ Tcl_DecrRefCount(pImage->pTileName);
+ pImage->tile = 0;
+ pImage->pTileName = 0;
+ }
+ if (pImage->tilepixmap) {
+ assert(pImage->pixmap);
+ Tk_FreePixmap(
+ Tk_Display(pImage->pImageServer->pTree->tkwin), pImage->tilepixmap);
+ pImage->tilepixmap = 0;
+ }
}
#define UNSCALED(pImage) ( \
@@ -264,6 +286,53 @@ imageChangedCb(pTree, pNode, clientData)
return HTML_WALK_DESCEND;
}
+static void asyncPixmapify(clientData)
+ ClientData clientData;
+{
+ HtmlImage2 *pImage = (HtmlImage2 *)clientData;
+ HtmlImagePixmap(pImage);
+}
+
+static Tcl_Obj*
+getImageCompressed(pImage)
+ HtmlImage2 *pImage;
+{
+ if (!pImage->pCompressed) {
+ Tcl_Interp *interp = pImage->pImageServer->pTree->interp;
+ Tcl_Obj *apObj[3];
+ apObj[0] = pImage->pImageName;
+ apObj[1] = Tcl_NewStringObj("cget", -1);
+ apObj[2] = Tcl_NewStringObj("-data", -1);
+
+ Tcl_IncrRefCount(apObj[0]);
+ Tcl_IncrRefCount(apObj[1]);
+ Tcl_IncrRefCount(apObj[2]);
+ if (TCL_OK == Tcl_EvalObjv(interp, 3, apObj, TCL_EVAL_GLOBAL)) {
+ int nData;
+ Tcl_Obj *pData = Tcl_GetObjResult(interp);
+ Tcl_GetByteArrayFromObj(pData, &nData);
+ if (nData>0){
+ pImage->pCompressed = pData;
+ Tcl_IncrRefCount(pData);
+ }
+ }
+ Tcl_DecrRefCount(apObj[2]);
+ Tcl_DecrRefCount(apObj[1]);
+ Tcl_DecrRefCount(apObj[0]);
+ }
+ return pImage->pCompressed;
+}
+
+static void
+freeImageCompressed(pImage)
+ HtmlImage2 *pImage;
+{
+ if (pImage->pCompressed) {
+ Tcl_DecrRefCount(pImage->pCompressed);
+ pImage->pCompressed = 0;
+ }
+}
+
/*
*---------------------------------------------------------------------------
*
@@ -290,22 +359,33 @@ imageChanged(clientData, x, y, width, height, imgWidth, imgHeight)
int imgHeight;
{
HtmlImage2 *pImage = (HtmlImage2 *)clientData;
- if (pImage && !pImage->pUnscaled) {
+ if (pImage && !pImage->pUnscaled && !pImage->nIgnoreChange) {
HtmlImage2 *p;
HtmlTree *pTree = pImage->pImageServer->pTree;
assert(pImage->image);
+
for (p = pImage->pNext; p; p = p->pNext) {
p->isValid = 0;
assert(!p->pTileName);
}
freeTile(pImage);
+ pImage->eAlpha = ALPHA_CHANNEL_UNKNOWN;
- if (imgWidth!=pImage->width && imgHeight!=pImage->height) {
+ /* Delete the pixmap/compressed-data representation */
+ if( pImage->pixmap ){
+ Tk_FreePixmap(Tk_Display(pTree->tkwin), pImage->pixmap);
+ pImage->pixmap = 0;
+ }
+ freeImageCompressed(pImage);
+
+ if (imgWidth!=pImage->width || imgHeight!=pImage->height) {
pImage->width = imgWidth;
pImage->height = imgHeight;
HtmlWalkTree(pTree, 0, imageChangedCb, (ClientData)pImage);
}
+ Tcl_DoWhenIdle(asyncPixmapify, (ClientData)pImage);
+
/* If the image contents have been modified but the size is
* constant, then just redraw the display. This is lazy. If
* there were an efficient way to determine the minimum region
@@ -313,8 +393,6 @@ imageChanged(clientData, x, y, width, height, imgWidth, imgHeight)
* efficient.
*/
HtmlCallbackDamage(pTree, 0, 0, 1000000, 1000000);
-
- pImage->eAlpha = ALPHA_CHANNEL_UNKNOWN;
}
}
@@ -419,6 +497,7 @@ HtmlImageServerGet(p, zUrl)
pImage->image = img;
Tk_SizeOfImage(pImage->image, &pImage->width, &pImage->height);
pImage->isValid = 1;
+ HtmlImagePixmap(pImage);
}
}
@@ -464,6 +543,16 @@ Tcl_Obj *HtmlImageUnscaledName(pImage)
return pRet;
}
+void
+HtmlImageSize(pImage, pWidth, pHeight)
+ HtmlImage2 *pImage; /* Image object */
+ int *pWidth; /* OUT: Image width */
+ int *pHeight; /* OUT: Image height */
+{
+ if (pWidth) *pWidth = pImage->width;
+ if (pHeight) *pHeight = pImage->height;
+}
+
/*
*---------------------------------------------------------------------------
*
@@ -589,6 +678,29 @@ HtmlImageImage(pImage)
Tcl_Interp *interp = pImage->pImageServer->pTree->interp;
HtmlImage2 *pUnscaled = pImage->pUnscaled;
+ if (pUnscaled->pixmap) {
+ Tcl_Obj *apObj[4];
+ int rc;
+
+printf("TODO: BAD. Have to recreate image to make scaled copy.\n");
+
+ apObj[0] = pUnscaled->pImageName;
+ apObj[1] = Tcl_NewStringObj("configure", -1);
+ apObj[2] = Tcl_NewStringObj("-data", -1);
+ apObj[3] = pUnscaled->pCompressed;
+
+ Tcl_IncrRefCount(apObj[1]);
+ Tcl_IncrRefCount(apObj[2]);
+ Tcl_IncrRefCount(apObj[3]);
+ pUnscaled->nIgnoreChange++;
+ rc = Tcl_EvalObjv(interp, 4, apObj, TCL_EVAL_GLOBAL);
+ pUnscaled->nIgnoreChange--;
+ assert(rc==TCL_OK);
+ Tcl_IncrRefCount(apObj[3]);
+ Tcl_DecrRefCount(apObj[2]);
+ Tcl_DecrRefCount(apObj[1]);
+ }
+
assert(pUnscaled);
if (!pImage->pImageName) {
/* If pImageName is still NULL, then create a new photo
@@ -669,11 +781,184 @@ HtmlImageImage(pImage)
}
pImage->isValid = 1;
+ if (pUnscaled->pixmap) {
+ Tcl_Obj *apObj[4];
+
+ apObj[0] = Tcl_NewStringObj("image", -1);
+ apObj[1] = Tcl_NewStringObj("create", -1);
+ apObj[2] = Tcl_NewStringObj("photo", -1);
+ apObj[3] = pUnscaled->pImageName;
+
+ Tcl_IncrRefCount(apObj[0]);
+ Tcl_IncrRefCount(apObj[1]);
+ Tcl_IncrRefCount(apObj[2]);
+ pUnscaled->nIgnoreChange++;
+ Tcl_EvalObjv(interp, 4, apObj, TCL_EVAL_GLOBAL);
+ pUnscaled->nIgnoreChange--;
+ Tcl_DecrRefCount(apObj[2]);
+ Tcl_DecrRefCount(apObj[1]);
+ Tcl_IncrRefCount(apObj[0]);
+ }
}
return pImage->image;
}
+#define N_TILE_PIXELS 4000
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * tilesize --
+ *
+ * Results:
+ * True if the image should use a tile, false otherwise. If true
+ * is returned, *pW and *pH are set to the pixel height and width
+ * of the required tile.
+ *
+ * Side effects:
+ *
+ *
+ *---------------------------------------------------------------------------
+ */
+static int tilesize(pImage, pW, pH)
+ HtmlImage2* pImage;
+ int *pW;
+ int *pH;
+{
+ int iImageWidth = pImage->width;
+ int iImageHeight = pImage->height;
+
+ int xmul = 1;
+ int ymul = 1;
+
+ if (iImageWidth * iImageHeight > N_TILE_PIXELS) return 0;
+
+ /* Figure out the eventual width and height of the tile. */
+ while ((iImageWidth * iImageHeight * xmul * ymul) < N_TILE_PIXELS) {
+ xmul = xmul + xmul;
+ ymul = ymul + ymul;
+ }
+
+ *pW = pImage->width * xmul;
+ *pH = pImage->height * ymul;
+ return 1;
+}
+
+Pixmap
+HtmlImageTilePixmap(pImage, pW, pH)
+ HtmlImage2* pImage;
+ int *pW;
+ int *pH;
+{
+ if (HtmlImagePixmap(pImage)) {
+ Tk_Window win;
+ XGCValues gc_values;
+ GC gc;
+ int i, j;
+
+ if( pImage->tilepixmap ){
+ goto return_tile;
+ }
+
+ if (!tilesize(pImage, &pImage->iTileWidth, &pImage->iTileHeight)) {
+ goto return_original;
+ }
+
+ win = pImage->pImageServer->pTree->tkwin;
+ pImage->tilepixmap = Tk_GetPixmap(Tk_Display(win), Tk_WindowId(win),
+ pImage->iTileWidth, pImage->iTileHeight, Tk_Depth(win)
+ );
+
+ memset(&gc_values, 0, sizeof(XGCValues));
+ gc = Tk_GetGC(win, 0, &gc_values);
+ for (i = 0; i < pImage->iTileWidth; i += pImage->width){
+ for (j = 0; j < pImage->iTileHeight; j += pImage->height){
+ XCopyArea(Tk_Display(win),
+ pImage->pixmap, pImage->tilepixmap, gc, 0, 0,
+ pImage->width, pImage->height,
+ i, j
+ );
+ }
+ }
+ Tk_FreeGC(Tk_Display(win), gc);
+ }
+
+return_tile:
+ *pW = pImage->iTileWidth;
+ *pH = pImage->iTileHeight;
+ return pImage->tilepixmap;
+
+return_original:
+ *pW = pImage->width;
+ *pH = pImage->height;
+ return pImage->pixmap;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * HtmlImagePixmap --
+ *
+ * Results:
+ * Pixmap. Or zero.
+ *
+ * Side effects:
+ * May change the image storage to pixmap.
+ *
+ *---------------------------------------------------------------------------
+ */
+Pixmap
+HtmlImagePixmap(pImage)
+ HtmlImage2* pImage;
+{
+ if (!pImage->pImageServer->pTree->options.imagepixmapify ||
+ !pImage->pImageName ||
+ !getImageCompressed(pImage) ||
+ pImage->width<=0 ||
+ pImage->height<=0
+ ) {
+ return 0;
+ }
+ if (!pImage->isValid) {
+ HtmlImageImage(pImage);
+ }
+ if (!pImage->pixmap && !HtmlImageAlphaChannel(pImage)) {
+ Tk_Window win = pImage->pImageServer->pTree->tkwin;
+ Tcl_Interp *interp = pImage->pImageServer->pTree->interp;
+
+ Pixmap pix;
+ int rc;
+ Tcl_Obj *pGetData;
+
+#if 0
+printf("Pixmapifying - nData = %d\n", nData);
+#endif
+
+ pix = Tk_GetPixmap(Tk_Display(win), Tk_WindowId(win),
+ pImage->width, pImage->height, Tk_Depth(win)
+ );
+ Tk_RedrawImage(
+ pImage->image, 0, 0, pImage->width, pImage->height, pix, 0, 0
+ );
+
+ pImage->pixmap = pix;
+
+ pGetData = Tcl_NewObj();
+ Tcl_IncrRefCount(pGetData);
+ Tcl_ListObjAppendElement(0, pGetData, Tcl_NewStringObj("image",-1));
+ Tcl_ListObjAppendElement(0, pGetData, Tcl_NewStringObj("create",-1));
+ Tcl_ListObjAppendElement(0, pGetData, Tcl_NewStringObj("photo",-1));
+ Tcl_ListObjAppendElement(0, pGetData, pImage->pImageName);
+ pImage->nIgnoreChange++;
+ rc = Tcl_EvalObjEx(interp, pGetData, TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT);
+ pImage->nIgnoreChange--;
+ Tcl_DecrRefCount(pGetData);
+ assert(rc==TCL_OK);
+ }
+ return pImage->pixmap;
+}
+
void
HtmlImageFree(pImage)
HtmlImage2 *pImage;
@@ -694,6 +979,13 @@ HtmlImageFree(pImage)
*/
assert(pImage->pUnscaled || 0 == pImage->pNext);
+ freeImageCompressed(pImage);
+ freeTile(pImage);
+ if (pImage->pixmap) {
+ HtmlTree *pTree = pImage->pImageServer->pTree;
+ Tk_FreePixmap(Tk_Display(pTree->tkwin), pImage->pixmap);
+ pImage->pixmap = 0;
+ }
if (pImage->image) {
Tk_FreeImage(pImage->image);
}
@@ -731,8 +1023,8 @@ HtmlImageFree(pImage)
Tcl_DeleteHashEntry(pEntry);
}
- freeTile(pImage);
HtmlFree(pImage);
+ Tcl_CancelIdleCall(asyncPixmapify, (ClientData)pImage);
}
}
@@ -767,7 +1059,7 @@ void HtmlImageCheck(pImage)
*
* Results:
*
- * 1 if there are one or more pixels in the image with an
+ * 1 if there are one or more pixels in the image with an alpha
* alpha-channel value of other than 100%. Otherwise 0.
*
* Side effects:
@@ -776,14 +1068,12 @@ void HtmlImageCheck(pImage)
*---------------------------------------------------------------------------
*/
int
-HtmlImageAlphaChannel(pTree, pImage)
- HtmlTree *pTree;
+HtmlImageAlphaChannel(pImage)
HtmlImage2 *pImage;
{
-
HtmlImage2 *p = (pImage->pUnscaled ? pImage->pUnscaled : pImage);
-
if (p->eAlpha == ALPHA_CHANNEL_UNKNOWN) {
+ HtmlTree *pTree= pImage->pImageServer->pTree;
Tk_PhotoHandle photo;
Tk_PhotoImageBlock block;
int x, y;
@@ -791,12 +1081,22 @@ HtmlImageAlphaChannel(pTree, pImage)
int w = p->width;
int h = p->height;
- /* If the image consists of more than 40,000 pixels, assume
- * it contains a semi-translucent pixel.
- */
- if ((w * h) > 100) {
- p->eAlpha = ALPHA_CHANNEL_TRUE;
- return 1;
+ Tcl_Obj *pCompressed = getImageCompressed(pImage);
+ unsigned char *zCompressed;
+ int nCompressed;
+ int i;
+ assert(pCompressed);
+
+ zCompressed = Tcl_GetByteArrayFromObj(pCompressed, &nCompressed);
+ for(i = 0; 1 && i < 16 && i < (nCompressed-4); i++){
+ if (zCompressed[i] == 'J' &&
+ zCompressed[i+1] == 'F' &&
+ zCompressed[i+2] == 'I' &&
+ zCompressed[i+3] == 'F'
+ ) {
+ p->eAlpha = ALPHA_CHANNEL_FALSE;
+ return 0;
+ }
}
p->eAlpha = ALPHA_CHANNEL_FALSE;
@@ -806,16 +1106,14 @@ HtmlImageAlphaChannel(pTree, pImage)
if (!block.pixelPtr) return 0;
- for (x = 0; x < w; x++) {
- for (y = 0; y < h; y++) {
- unsigned char *z = &block.pixelPtr[
- x * block.pixelSize + y * block.pitch + block.offset[3]
- ];
-
+ for (y = 0; y < h; y++) {
+ unsigned char *z = &block.pixelPtr[block.pitch*y+block.offset[3]];
+ for (x = 0; x < w; x++) {
if (*z != 255) {
p->eAlpha = ALPHA_CHANNEL_TRUE;
return 1;
}
+ z += block.pixelSize;
}
}
}
@@ -835,10 +1133,11 @@ HtmlImageAlphaChannel(pTree, pImage)
*
*---------------------------------------------------------------------------
*/
-#define N_TILE_PIXELS 4000
Tk_Image
-HtmlImageTile(pImage)
+HtmlImageTile(pImage, pW, pH)
HtmlImage2 *pImage; /* Image object */
+ int *pW;
+ int *pH;
{
HtmlTree *pTree = pImage->pImageServer->pTree;
Tcl_Interp *interp = pTree->interp;
@@ -852,27 +1151,24 @@ HtmlImageTile(pImage)
Tk_PhotoHandle origphoto;
Tk_PhotoImageBlock origblock;
- int xmul;
- int ymul;
-
int x;
int y;
/* The tile has already been generated. Return it. */
if (pImage->pTileName) {
- return pImage->tile;
+ goto return_tile;
}
/* The image is too big to bother with a tile. Return the original. */
- if ((pImage->width * pImage->height) >= N_TILE_PIXELS) {
- return HtmlImageImage(pImage);
+ if (!tilesize(pImage, &iTileWidth, &iTileHeight)) {
+ goto return_original;
}
/* Retrieve the block for the original image */
origphoto = Tk_FindPhoto(interp, Tcl_GetString(pImage->pImageName));
- if (!origphoto) return HtmlImageImage(pImage);
+ if (!origphoto) goto return_original;
Tk_PhotoGetImage(origphoto, &origblock);
- if (!origblock.pixelPtr) return HtmlImageImage(pImage);
+ if (!origblock.pixelPtr) goto return_original;
/* Create the tile image. Surely there is a way to do this without
* invoking a script, but I haven't found it yet.
@@ -887,16 +1183,6 @@ HtmlImageTile(pImage)
interp, pTree->tkwin, Tcl_GetString(pTileName), imageChanged, 0
);
- /* Figure out the eventual width and height of the tile. */
- xmul = 1;
- ymul = 1;
- while ((pImage->width * pImage->height * xmul * ymul) < N_TILE_PIXELS) {
- xmul = xmul + xmul;
- ymul = ymul + ymul;
- }
- iTileWidth = pImage->width * xmul;
- iTileHeight = pImage->height * ymul;
-
/* Allocate a block to write the tile data into. */
tileblock.pixelPtr = (unsigned char *)HtmlAlloc(
"temp", iTileWidth * iTileHeight * 4
@@ -928,8 +1214,17 @@ HtmlImageTile(pImage)
photoputblock(interp,tilephoto,&tileblock,0,0,iTileWidth,iTileHeight,0);
HtmlFree(tileblock.pixelPtr);
+ pImage->iTileWidth = iTileWidth;
+ pImage->iTileHeight = iTileHeight;
+return_tile:
+ *pW = pImage->iTileWidth;
+ *pH = pImage->iTileHeight;
return pImage->tile;
+
+return_original:
+ HtmlImageSize(pImage, pW, pH);
+ return HtmlImageImage(pImage);
}
/*
@@ -1113,3 +1408,73 @@ Tcl_Obj *HtmlXImageToImage(pTree, pXImage, w, h)
return 0;
}
#endif
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * HtmlImageServerReport --
+ *
+ * For performance analysis. Returns a listing of the image server
+ * contents.
+ *
+ * Results:
+ *
+ * A list containing a single element for each HtmlImage2 structure
+ * managed by this image server. The format of each element is itself
+ * a list of the following form:
+ *
+ * { <url> <image name> <pixmapified> <width> <height> <alpha> <refs>}
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+int
+HtmlImageServerReport(clientData, interp, objc, objv)
+ ClientData clientData; /* The HTML widget data structure */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings. */
+{
+ HtmlTree *pTree = (HtmlTree *)clientData;
+
+ Tcl_HashSearch search;
+ Tcl_HashEntry *pEntry;
+ Tcl_Obj *pRet = Tcl_NewObj();
+
+ for (
+ pEntry = Tcl_FirstHashEntry(&pTree->pImageServer->aImage, &search);
+ pEntry;
+ pEntry = Tcl_NextHashEntry(&search)
+ ) {
+ HtmlImage2 *pImage = (HtmlImage2 *)Tcl_GetHashValue(pEntry);
+ for( ; pImage; pImage = pImage->pNext){
+ Tcl_Obj *p = Tcl_NewObj();
+ const char *zUrl = "";
+ if( !pImage->pUnscaled ){
+ zUrl = pImage->zUrl;
+ }
+ Tcl_ListObjAppendElement(interp, p, Tcl_NewStringObj(zUrl, -1));
+ if (pImage->pImageName) {
+ Tcl_ListObjAppendElement(interp, p, pImage->pImageName);
+ } else {
+ Tcl_ListObjAppendElement(interp, p, Tcl_NewStringObj("", -1));
+ }
+ Tcl_ListObjAppendElement(interp, p, Tcl_NewStringObj(
+ pImage->pixmap?"PIX":"", -1));
+ Tcl_ListObjAppendElement(interp, p, Tcl_NewIntObj(pImage->width));
+ Tcl_ListObjAppendElement(interp, p, Tcl_NewIntObj(pImage->height));
+ Tcl_ListObjAppendElement(interp, p, Tcl_NewStringObj(
+ pImage->eAlpha==ALPHA_CHANNEL_UNKNOWN?"unknown":
+ pImage->eAlpha==ALPHA_CHANNEL_TRUE?"true":
+ pImage->eAlpha==ALPHA_CHANNEL_FALSE?"false":"internal error!", -1));
+ Tcl_ListObjAppendElement(interp, p, Tcl_NewIntObj(pImage->nRef));
+
+ Tcl_ListObjAppendElement(interp, pRet, p);
+ }
+ }
+
+ Tcl_SetObjResult(interp, pRet);
+ return TCL_OK;
+}
diff --git a/src/htmlindex.c b/src/htmlindex.c
new file mode 100644
index 0000000..e7aecfa
--- /dev/null
+++ b/src/htmlindex.c
@@ -0,0 +1,636 @@
+static char const rcsid[] =
+ "@(#) $Id: htmlindex.c,v 1.15 2005/03/24 12:05:06 danielk1977 Exp $";
+
+/*
+** Routines that deal with indexes
+**
+** This source code is released into the public domain by the author,
+** D. Richard Hipp, on 2002 December 17. Instead of a license, here
+** is a blessing:
+**
+** May you do good and not evil.
+** May you find forgiveness for yourself and forgive others.
+** May you share freely, never taking more than you give.
+*/
+#include <ctype.h>
+#include <string.h>
+#include "html.h"
+
+/*
+** Return a pointer to the Nth HtmlElement in the list. If there
+** is no Nth element, return 0 if flag==0 and return either the first
+** or last element (whichever is closest) if flag!=0
+*/
+HtmlElement *
+HtmlTokenByIndex(htmlPtr, N, flag)
+ HtmlWidget *htmlPtr;
+ int N;
+ int flag;
+{
+ HtmlElement *p;
+ int n;
+
+ if (!N)
+ return htmlPtr->pFirst;
+ if (N > htmlPtr->nToken / 2) {
+ /*
+ * Start at the end and work back toward the beginning
+ */
+ for (p = htmlPtr->pLast, n = htmlPtr->nToken; p; p = p->base.pPrev) {
+ if (p->base.type != Html_Block) {
+ if (p->base.id == N) {
+ break;
+ }
+ n--;
+ }
+ }
+ }
+ else {
+ /*
+ * Start at the beginning and work forward
+ */
+ for (p = htmlPtr->pFirst; p; p = p->base.pNext) {
+ if (p->base.type != Html_Block) {
+
+/* N--; */
+ if (N == p->base.id) {
+ break;
+ }
+ }
+ }
+ }
+ return p;
+}
+
+/*
+** Return the token number for the given HtmlElement
+*/
+int
+HtmlTokenNumber(p)
+ HtmlElement *p;
+{
+ int n = 0;
+
+ if (!p)
+ return -1;
+ return p->base.id;
+
+ while (p) {
+ if (p->base.type != Html_Block) {
+ n++;
+ }
+ p = p->base.pPrev;
+ }
+ return n;
+}
+
+/*
+** Find the maximum index for the given token
+*/
+static void
+maxIndex(p, pIndex, islast)
+ HtmlElement *p;
+ int *pIndex;
+ int islast;
+{
+ if (p == 0) {
+ *pIndex = 0;
+ }
+ else {
+ switch (p->base.type) {
+ case Html_Text:
+ *pIndex = p->base.count - islast;
+ break;
+ case Html_Space:
+ if (p->base.style.flags & STY_Preformatted) {
+ *pIndex = p->base.count - islast;
+ }
+ else {
+ *pIndex = 0;
+ }
+ break;
+ default:
+ *pIndex = 0;
+ break;
+ }
+ }
+}
+
+#ifndef _TCLHTML_
+
+/*
+** Given a Block and an x coordinate, find the Index of the character
+** that is closest to the given x coordinate.
+**
+** The x-coordinate might specify a point to the left of the block,
+** in which case the procedure returns the first token and a character
+** index of 0. Or the x-coordinate might specify a point to the right
+** of the block, in which case the last token is returned with an index
+** equal to its last character.
+*/
+static void
+FindIndexInBlock(htmlPtr, pBlock, x, ppToken, pIndex)
+ HtmlWidget *htmlPtr; /* The widget */
+ HtmlBlock *pBlock; /* The block */
+ int x; /* The x coordinate */
+ HtmlElement **ppToken; /* Write the closest token here */
+ int *pIndex; /* Write the charater index in ppToken
+ * here */
+{
+ HtmlElement *p;
+ Tk_Font font;
+ int len;
+ int n;
+
+ p = pBlock->base.pNext;
+ HtmlLock(htmlPtr);
+ font = HtmlGetFont(htmlPtr, p->base.style.font);
+ if (HtmlUnlock(htmlPtr)) {
+ *ppToken = p;
+ *pIndex = 0;
+ return;
+ }
+ if (x <= pBlock->left) {
+ *ppToken = p;
+ *pIndex = 0;
+ return;
+ }
+ else if (x >= pBlock->right) {
+ *ppToken = p;
+ *pIndex = 0;
+ while (p && p->base.type != Html_Block) {
+ *ppToken = p;
+ p = p->base.pNext;
+ }
+ p = *ppToken;
+ if (p && p->base.type == Html_Text) {
+ *pIndex = p->base.count - 1;
+ }
+ return;
+ }
+ if (pBlock->n == 0) {
+ *ppToken = p;
+ *pIndex = 0;
+ }
+ n = Tk_MeasureChars(font, pBlock->z, pBlock->n, x - pBlock->left, 0, &len);
+ *pIndex = 0;
+ *ppToken = 0;
+ while (p && n >= 0) {
+ switch (p->base.type) {
+ case Html_Text:
+ if (n < p->base.count) {
+ *pIndex = n;
+ }
+ else {
+ *pIndex = p->base.count - 1;
+ }
+ *ppToken = p;
+ n -= p->base.count;
+ break;
+ case Html_Space:
+ if (p->base.style.flags & STY_Preformatted) {
+ if (n < p->base.count) {
+ *pIndex = n;
+ }
+ else {
+ *pIndex = p->base.count - 1;
+ }
+ *ppToken = p;
+ n -= p->base.count;
+ }
+ else {
+ *pIndex = 0;
+ *ppToken = p;
+ n--;
+ }
+ break;
+ default:
+ break;
+ }
+ if (p) {
+ p = p->base.pNext;
+ }
+ else {
+ }
+ }
+}
+#endif /* _TCLHTML_ */
+
+/*
+** Convert an Element-based index into a Block-based index.
+**
+** In other words, given a pointer to an element and an index
+** of a particular character within that element, compute a
+** pointer to the HtmlBlock used to display that character and
+** the index in the HtmlBlock of the character.
+*/
+void
+HtmlIndexToBlockIndex(htmlPtr, sIndex, ppBlock, piIndex)
+ HtmlWidget *htmlPtr; /* The widget */
+ HtmlIndex sIndex; /* The index to be translated */
+ HtmlBlock **ppBlock; /* Write the corresponding block here */
+ int *piIndex; /* Write the block index here */
+{
+ int n = sIndex.i;
+ HtmlElement *p, *lp;
+
+ if (sIndex.p == 0) {
+ *ppBlock = 0;
+ *piIndex = 0;
+ return;
+ }
+ p = sIndex.p->base.pPrev;
+ while (p && p->base.type != Html_Block) {
+ switch (p->base.type) {
+ case Html_Text:
+ n += p->base.count;
+ break;
+ case Html_Space:
+ if (p->base.style.flags & STY_Preformatted) {
+ n += p->base.count;
+ }
+ else {
+ n++;
+ }
+ break;
+ default:
+ break;
+ }
+ lp = p;
+ p = p->base.pPrev;
+ }
+ if (p) {
+ *ppBlock = &p->block;
+ *piIndex = n;
+ return;
+ }
+ for (p = sIndex.p; p && p->base.type != Html_Block; p = p->base.pNext) {
+ }
+ *ppBlock = &p->block;
+ *piIndex = 0;
+}
+
+/* Modify an index for both pointer and char +/-/=N */
+int
+HtmlIndexMod(htmlPtr, pp, ip, cp)
+ HtmlWidget *htmlPtr;
+ HtmlElement **pp;
+ int *ip;
+ char *cp;
+{
+ char nbuf[50];
+ int i, x, cnt, ccnt[2], cflag[2];
+ if (pp == 0 || !*pp)
+ return -1;
+ ccnt[0] = ccnt[1] = cflag[0] = cflag[1] = 0;
+ x = 0;
+ while (*cp && x < 2) {
+ cnt = 0;
+ i = 1;
+ while (i < 45 && isdigit(cp[i]))
+ nbuf[i - 1] = cp[i++];
+ if (i > 1) {
+ nbuf[i - 1] = 0;
+ cnt = atoi(nbuf);
+ if (cnt < 0)
+ return -1;
+ }
+ switch (*cp) {
+ case '+':
+ if (i == 1)
+ ccnt[x] = 1;
+ else
+ ccnt[x] = cnt;
+ break;
+ case '-':
+ if (i == 1)
+ ccnt[x] = -1;
+ else
+ ccnt[x] = -cnt;
+ break;
+ case '=':
+ ccnt[x] = 0;
+ cflag[x] = 1;
+ break;
+ default:
+ return -1;
+ }
+ cp += i;
+ x++;
+ }
+ if (ccnt[0] > 0) {
+ for (i = 0; i < ccnt[0] && (*pp)->pNext; i++) {
+ *pp = (*pp)->pNext;
+ while ((*pp)->base.type == Html_Block && (*pp)->pNext)
+ *pp = (*pp)->pNext;
+ }
+ }
+ else if (ccnt[0] < 0) {
+ for (i = 0; ccnt[0] < i && (*pp)->base.pPrev; i--) {
+ printf("i=%d,cnt=%d\n", i, ccnt[0]);
+ *pp = (*pp)->base.pPrev;
+ while ((*pp)->base.type == Html_Block && (*pp)->base.pPrev)
+ *pp = (*pp)->base.pPrev;
+ }
+ }
+ if (ccnt[1] > 0)
+ for (i = 0; i < ccnt[1]; i++)
+ (*ip)++;
+ else if (ccnt[1] < 0)
+ for (i = 0; i > ccnt[1]; i--)
+ (*ip)--;
+ return 0;
+}
+
+/*
+** Given a base index name (without any modifiers) return a pointer
+** to the token described, and the character within that token.
+**
+** Valid input forms include:
+**
+** N.M Token number N (with numbering starting at 1) and
+** character number M (with numbering starting at 0).
+**
+** M.X Like above, but token is markup and X is an attribute.
+**
+** begin The start of all text
+**
+** end The end of all text
+**
+** N.last Last character of token number N.
+**
+** N.end One past last character of token number N.
+**
+** sel.first First character of the selection.
+**
+** sel.last Last character of the selection.
+**
+** sel.end On past last character of the selection.
+**
+** insert The character holding the insertion cursor.
+**
+** @X,Y The character a location X,Y of the clipping window.
+**
+** &DOM The DOM Address of a token.
+**
+** Zero is returned if we are successful and non-zero if there is
+** any kind of error.
+**
+** If the given token doesn't exist (for example if there are only 10
+** tokens and 11.5 is requested) then *ppToken is left pointing to NULL.
+** But the function still returns 0 for success.
+*/
+static int
+DecodeBaseIndex(htmlPtr, Baseind, ppToken, pIndex)
+ HtmlWidget *htmlPtr; /* The HTML widget we are dealing with
+ */
+ const char *Baseind; /* The base index string */
+ HtmlElement **ppToken; /* Write the pointer to the token here
+ */
+ int *pIndex; /* Write the character offset here */
+{
+ int x, y;
+ int n;
+ int i;
+ HtmlElement *p;
+ HtmlBlock *pBlock;
+ HtmlBlock *pNearby;
+ int dist = 1000000;
+ int rc = 0;
+ char buf[200], *zBase = buf, *suffix, *ep;
+ strncpy(buf, Baseind, sizeof(buf));
+ buf[sizeof(buf) - 1] = 0;
+ while (isspace(*zBase)) {
+ zBase++;
+ }
+ ep = zBase;
+ while (*ep && !isspace(*ep))
+ ep++;
+ *ep = 0;
+ if ((suffix = strchr(zBase, ':')))
+ *suffix = 0;
+
+ switch (*zBase) {
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9':
+ case '0':
+ n = sscanf(zBase, "%d.%d", &x, &y);
+ if (n > 0) {
+ p = *ppToken = HtmlTokenByIndex(htmlPtr, x, 0);
+ }
+ if (n == 2) {
+ *pIndex = y;
+ }
+ else {
+ for (i = 1; isdigit(zBase[i]); i++) {
+ }
+ if (zBase[i] == 0) {
+ *pIndex = 0;
+ }
+ else if (strcmp(&zBase[i], ".last") == 0) {
+ maxIndex(p, pIndex, 1);
+ }
+ else if (strcmp(&zBase[i], ".end") == 0) {
+ maxIndex(p, pIndex, 0);
+ (*pIndex)++;
+ }
+ else {
+ if (n == 1 && p && HtmlIsMarkup(p) && zBase[i] == '.' &&
+ HtmlMarkupArg(p, zBase + i + 1, 0))
+ *pIndex = 0;
+ else
+ rc = 1;
+ }
+ }
+ break;
+ case 'b':
+ if (strcmp(zBase, "begin") == 0) {
+ p = *ppToken = htmlPtr->pFirst;
+ *pIndex = 0;
+ }
+ else {
+ rc = 1;
+ }
+ break;
+ case 'e':
+ if (strcmp(zBase, "end") == 0) {
+ p = *ppToken = htmlPtr->pLast;
+ maxIndex(p, pIndex, 0);
+ }
+ else {
+ rc = 1;
+ }
+ break;
+ case 'l':
+ if (strcmp(zBase, "last") == 0) {
+ p = *ppToken = htmlPtr->pLast;
+ maxIndex(p, pIndex, 1);
+ }
+ else {
+ rc = 1;
+ }
+ break;
+ case 's':
+ if (strcmp(zBase, "sel.first") == 0) {
+ *ppToken = htmlPtr->selBegin.p;
+ *pIndex = htmlPtr->selBegin.i;
+ }
+ else if (strcmp(zBase, "sel.last") == 0) {
+ *ppToken = htmlPtr->selEnd.p;
+ *pIndex = htmlPtr->selEnd.i;
+ }
+ else if (strcmp(zBase, "sel.end") == 0) {
+ *ppToken = htmlPtr->selEnd.p;
+ *pIndex = htmlPtr->selEnd.i + 1;
+ }
+ else {
+ rc = 1;
+ }
+ break;
+ case 'i':
+ if (strcmp(zBase, "insert") == 0) {
+ *ppToken = htmlPtr->ins.p;
+ *pIndex = htmlPtr->ins.i;
+ }
+ else {
+ rc = 1;
+ }
+ break;
+ case '&':
+ *pIndex = 0;
+ if (HtmlDomIdLookup(htmlPtr, "id", zBase + 1, ppToken))
+ rc = 1;
+ break;
+ case '@':
+#ifdef _TCLHTML_
+ rc = 1;
+#else
+ n = sscanf(zBase, "@%d,%d", &x, &y);
+ if (n != 2) {
+ rc = 1;
+ break;
+ }
+ x += htmlPtr->xOffset;
+ y += htmlPtr->yOffset;
+ pNearby = 0;
+ *ppToken = htmlPtr->pLast;
+ *pIndex = 0;
+ for (pBlock = htmlPtr->firstBlock; pBlock; pBlock = pBlock->pNext) {
+ int dotest;
+ if (pBlock->n == 0) {
+ switch (pBlock->base.pNext->base.type) {
+ case Html_LI:
+ case Html_IMG:
+ case Html_INPUT:
+ case Html_TEXTAREA:
+ case Html_SELECT:
+ dotest = 1;
+ break;
+ default:
+ dotest = 0;
+ break;
+ }
+ }
+ else {
+ dotest = 1;
+ }
+ if (dotest) {
+ if (pBlock->top <= y && pBlock->bottom >= y) {
+ if (pBlock->left > x) {
+ if (pBlock->left - x < dist) {
+ dist = pBlock->left - x;
+ pNearby = pBlock;
+ }
+ }
+ else if (pBlock->right < x) {
+ if (x - pBlock->right < dist) {
+ dist = x - pBlock->right;
+ pNearby = pBlock;
+ }
+ }
+ else {
+ HtmlLock(htmlPtr);
+ FindIndexInBlock(htmlPtr, pBlock, x, ppToken,
+ pIndex);
+ if (HtmlUnlock(htmlPtr))
+ return 1;
+ break;
+ }
+ }
+ else {
+ int distY;
+ int distX;
+
+ if (pBlock->bottom < y) {
+ distY = y - pBlock->bottom;
+ }
+ else {
+ distY = pBlock->top - y;
+ }
+ if (pBlock->left > x) {
+ distX = pBlock->left - x;
+ }
+ else if (pBlock->right < x) {
+ distX = x - pBlock->right;
+ }
+ else {
+ distX = 0;
+ }
+ if (distX + 4 * distY < dist) {
+ dist = distX + 4 * distY;
+ pNearby = pBlock;
+ }
+ }
+ }
+ }
+ if (pBlock == 0) {
+ if (pNearby) {
+ HtmlLock(htmlPtr);
+ FindIndexInBlock(htmlPtr, pNearby, x, ppToken, pIndex);
+ if (HtmlUnlock(htmlPtr))
+ return 1;
+ }
+ }
+ break;
+#endif /* _TCLHTML_ */
+ default:
+ rc = 1;
+ break;
+ }
+ if (suffix)
+ HtmlIndexMod(htmlPtr, ppToken, pIndex, suffix + 1);
+ return rc;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * HtmlGetIndex --
+ *
+ * This routine decodes a complete index specification. A complete
+ * index consists of the base specification followed by modifiers.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+int
+HtmlGetIndex(htmlPtr, zIndex, ppToken, pIndex)
+ HtmlWidget *htmlPtr; /* The widget */
+ char *zIndex; /* Complete text of the index spec */
+ HtmlElement **ppToken; /* Write the pointer to the token here */
+ int *pIndex; /* Write the character offset here */
+{
+ return DecodeBaseIndex(htmlPtr, zIndex, ppToken, pIndex);
+}
diff --git a/src/htmlinline.c b/src/htmlinline.c
index cedf28f..98c26a4 100644
--- a/src/htmlinline.c
+++ b/src/htmlinline.c
@@ -32,6 +32,8 @@
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
* POSSIBILITY OF SUCH DAMAGE.
*/
+static const char rcsid[] = "$Id: htmlinline.c,v 1.60 2008/01/12 14:23:05 danielk1977 Exp $";
+
#include "htmllayout.h"
#include <stdio.h>
#include <stdarg.h>
@@ -65,8 +67,8 @@
* QUERY:
*
* HtmlInlineContextIsEmpty()
+ * HtmlInlineContextCreator()
*/
-static const char rcsid[] = "$Id: htmlinline.c,v 1.47 2007/06/10 07:53:03 danielk1977 Exp $";
/* The InlineBox and InlineMetrics types are only used within this file.
* The InlineContext type is only used within this file, but opaque handles
@@ -108,6 +110,9 @@ struct InlineBorder {
* this case iVerticalAlign is not meaningful.
*/
int iVerticalAlign;
+
+ int iTop;
+ int iBottom;
int eLineboxAlign; /* One of the LINEBOX_ALIGN_XXX values below */
int iStartBox; /* Leftmost inline-box */
@@ -151,6 +156,7 @@ struct InlineBox {
#define INLINE_TEXT 22
#define INLINE_REPLACED 23
#define INLINE_NEWLINE 24
+#define INLINE_SPACER 25
struct InlineContext {
HtmlTree *pTree; /* Pointer to owner widget */
@@ -167,8 +173,6 @@ struct InlineContext {
int nInlineAlloc; /* Number of slots allocated in aInline */
InlineBox *aInline; /* Array of inline boxes. */
- int iVAlign; /* Current vertical box offset */
-
InlineBorder *pBorders; /* Linked list of active inline-borders. */
InlineBorder *pBoxBorders; /* Borders list for next box to be added */
@@ -185,6 +189,18 @@ struct InlineContext {
InlineBorder *pCurrent; /* Current inline border */
};
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Logging system --
+ *
+ * START_LOG(pNode)
+ * oprintf(pLog, ...)
+ * oprintf(pLog, ...)
+ * END_LOG(zFunction)
+ *
+ *---------------------------------------------------------------------------
+ */
#define START_LOG(pLogNode) \
if (pContext->pTree->options.logcmd && !pContext->isSizeOnly && \
pLogNode->iNode >= 0) { \
@@ -192,16 +208,14 @@ if (pContext->pTree->options.logcmd && !pContext->isSizeOnly && \
Tcl_Obj *pLogCmd = HtmlNodeCommand(pContext->pTree, pLogNode); \
Tcl_IncrRefCount(pLog); \
{
-
#define END_LOG(zFunction) \
} \
- HtmlLog(pContext->pTree, "LAYOUTENGINE", "%s %s() -> %s", \
+ HtmlLog(pContext->pTree, "LAYOUTENGINE", "%s %s(): %s", \
Tcl_GetString(pLogCmd), \
zFunction, Tcl_GetString(pLog) \
); \
Tcl_DecrRefCount(pLog); \
}
-
static void
oprintf(Tcl_Obj *pObj, CONST char *zFormat, ...) {
int nBuf = 0;
@@ -277,6 +291,75 @@ inlineBoxMetrics(pContext, pNode, pMetrics)
END_LOG("inlineBoxMetrics()");
}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * inlineContextAddInlineCanvas --
+ *
+ * This function is used to add inline box content to an inline
+ * context. The content is drawn by the caller into the canvas object
+ * returned by this function.
+ *
+ * Results:
+ * Returns a pointer to an empty html canvas to draw the content of the
+ * new inline-box to.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+static HtmlCanvas *
+inlineContextAddInlineCanvas(p, eType, pNode)
+ InlineContext *p;
+ int eType; /* One of the INLINE_xxx constants */
+ HtmlNode *pNode;
+{
+ InlineBox *pBox;
+ InlineBorder *pBorder;
+
+ p->nInline++;
+ if(p->nInline > p->nInlineAlloc) {
+ /* We need to grow the InlineContext.aInline array. Note that we
+ * don't bother to zero the newly allocated memory. The InlineBox
+ * for which the canvas is returned is zeroed below.
+ */
+ char *a = (char *)p->aInline;
+ int nAlloc = p->nInlineAlloc + 25;
+ p->aInline = (InlineBox *)HtmlRealloc(
+ "InlineContext.aInline", a, nAlloc*sizeof(InlineBox)
+ );
+ p->nInlineAlloc = nAlloc;
+ }
+
+ pBox = &p->aInline[p->nInline - 1];
+ memset(pBox, 0, sizeof(InlineBox));
+ pBox->pBorderStart = p->pBoxBorders;
+ for (pBorder = pBox->pBorderStart; pBorder; pBorder = pBorder->pNext) {
+ pBox->nLeftPixels += pBorder->box.iLeft;
+ pBox->nLeftPixels += pBorder->margin.margin_left;
+ }
+ p->pBoxBorders = 0;
+ /* pBox->eReplaced = eReplaced; */
+ pBox->eType = eType;
+ pBox->pNode = pNode;
+ return &pBox->canvas;
+}
+
+static void
+inlineContextAddSpacer(p, eWhitespace)
+ InlineContext *p;
+ int eWhitespace;
+{
+ InlineBox *pBox;
+
+ inlineContextAddInlineCanvas(p, INLINE_SPACER, 0);
+ pBox = &p->aInline[p->nInline-1];
+ pBox->eWhitespace = eWhitespace;
+}
+
+
/*
*---------------------------------------------------------------------------
*
@@ -375,7 +458,7 @@ int HtmlInlineContextPushBorder(pContext, pBorder)
iVert = pPM->iBaseline - (pM->iLogical / 2);
if (pNodeParent) {
HtmlFont *pF=HtmlNodeComputedValues(pNodeParent)->fFont;
- iVert -= pF->ex_pixels;
+ iVert -= (pF->ex_pixels / 2);
}
break;
}
@@ -385,9 +468,11 @@ int HtmlInlineContextPushBorder(pContext, pBorder)
break;
/* These two are unhandled as of yet. Treat as "baseline". */
- case CSS_CONST_TOP: /* Todo. */
- case CSS_CONST_BOTTOM: /* Todo. */
- iVert = pPM->iBaseline - pM->iBaseline;
+ case CSS_CONST_TOP:
+ pBorder->eLineboxAlign = LINEBOX_ALIGN_TOP;
+ break;
+ case CSS_CONST_BOTTOM:
+ pBorder->eLineboxAlign = LINEBOX_ALIGN_BOTTOM;
break;
}
@@ -399,7 +484,32 @@ int HtmlInlineContextPushBorder(pContext, pBorder)
assert(!pContext->pRootBorder);
pContext->pRootBorder = pBorder;
}
+
+ /* Under some circumstances, we need to push a 'spacer' box into
+ * the inline context here. This is to account for markup like
+ * this:
+ *
+ * xxx<SPAN class=bordered> span contents</SPAN>yyy
+ *
+ * In this case we want the border to open immediately after the
+ * text "xxx", and a space to follow the start of the border. i.e.
+ * it should be rendered like this:
+ *
+ * +--------------+
+ * xxx| span contents|yyy
+ * +--------------+
+ */
+ if (pContext->nInline > 0 && !pBorder->isReplaced) {
+ InlineBox *pPrev = &pContext->aInline[pContext->nInline-1];
+ HtmlComputedValues *pV = HtmlNodeComputedValues(pBorder->pNode);
+
+ int isPre = (pV->eWhitespace == CSS_CONST_PRE);
+ if (isPre || pPrev->nSpace == 0) {
+ inlineContextAddSpacer(pContext, pV->eWhitespace);
+ }
+ }
}
+
return 0;
}
@@ -424,6 +534,8 @@ HtmlInlineContextPopBorder(p, pBorder)
InlineContext *p;
InlineBorder *pBorder;
{
+ int eWhitespace = CSS_CONST_NORMAL;
+
if (!pBorder) return;
assert(pBorder == p->pCurrent);
@@ -452,10 +564,30 @@ HtmlInlineContextPopBorder(p, pBorder)
pBorder = p->pBorders;
assert(pBorder);
p->pBorders = pBorder->pNext;
- p->iVAlign -= pBorder->iVerticalAlign;
HtmlFree(pBorder);
}
}
+
+ /* A border has just been closed. If there was no white-space just before
+ * the close of the border, or if the 'white-space' property is set
+ * to "pre", add an empty inline-text block to the context. This is
+ * to catch any whitespace that follows closing the border. i.e.
+ * so that for markup like this:
+ *
+ * ...<SPAN class="bordered">The quick brown</SPAN> fox...
+ *
+ * there is a white-space character added to the line immediately after
+ * closing the <SPAN> border.
+ */
+ if (p->pBorders) {
+ HtmlComputedValues *pV = HtmlNodeComputedValues(p->pBorders->pNode);
+ eWhitespace = pV->eWhitespace;
+ }
+ if (p->nInline > 0 && (
+ p->aInline[p->nInline-1].nSpace == 0 || eWhitespace == CSS_CONST_PRE
+ )) {
+ inlineContextAddSpacer(p, eWhitespace);
+ }
}
/*
@@ -514,61 +646,6 @@ HtmlGetInlineBorder(pLayout, pContext, pNode)
/*
*---------------------------------------------------------------------------
*
- * inlineContextAddInlineCanvas --
- *
- * This function is used to add inline box content to an inline
- * context. The content is drawn by the caller into the canvas object
- * returned by this function.
- *
- * Results:
- * Returns a pointer to an empty html canvas to draw the content of the
- * new inline-box to.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-static HtmlCanvas *
-inlineContextAddInlineCanvas(p, eType, pNode)
- InlineContext *p;
- int eType; /* One of INLINE_NEWLINE, INLINE_TEXT, INLINE_REPLACED */
- HtmlNode *pNode;
-{
- InlineBox *pBox;
- InlineBorder *pBorder;
-
- p->nInline++;
- if(p->nInline > p->nInlineAlloc) {
- /* We need to grow the InlineContext.aInline array. Note that we
- * don't bother to zero the newly allocated memory. The InlineBox
- * for which the canvas is returned is zeroed below.
- */
- char *a = (char *)p->aInline;
- int nAlloc = p->nInlineAlloc + 25;
- p->aInline = (InlineBox *)HtmlRealloc(
- "InlineContext.aInline", a, nAlloc*sizeof(InlineBox)
- );
- p->nInlineAlloc = nAlloc;
- }
-
- pBox = &p->aInline[p->nInline - 1];
- memset(pBox, 0, sizeof(InlineBox));
- pBox->pBorderStart = p->pBoxBorders;
- for (pBorder = pBox->pBorderStart; pBorder; pBorder = pBorder->pNext) {
- pBox->nLeftPixels += pBorder->box.iLeft;
- pBox->nLeftPixels += pBorder->margin.margin_left;
- }
- p->pBoxBorders = 0;
- /* pBox->eReplaced = eReplaced; */
- pBox->eType = eType;
- pBox->pNode = pNode;
- return &pBox->canvas;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
* inlineContextAddSpace --
*
* This function is used to add space generated by white-space
@@ -592,7 +669,7 @@ inlineContextAddSpace(p, nPixels, eWhitespace)
InlineBox *pBox = &p->aInline[p->nInline - 1];
if (eWhitespace == CSS_CONST_PRE) {
pBox->nSpace += nPixels;
- } else {
+ } else if (pBox->nSpace == 0) {
pBox->nSpace = MAX(nPixels, pBox->nSpace);
}
}
@@ -612,9 +689,10 @@ inlineContextAddSpace(p, nPixels, eWhitespace)
*---------------------------------------------------------------------------
*/
static void
-inlineContextAddNewLine(p, nHeight)
+inlineContextAddNewLine(p, nHeight, isLast)
InlineContext *p;
int nHeight;
+ int isLast;
{
InlineBox *pBox;
inlineContextAddInlineCanvas(p, INLINE_NEWLINE, 0);
@@ -623,7 +701,9 @@ inlineContextAddNewLine(p, nHeight)
/* This inline-box is added only to account for space that may come
* after the new line box.
*/
- inlineContextAddInlineCanvas(p, INLINE_TEXT, 0);
+ if (!isLast) {
+ inlineContextAddSpacer(p, CSS_CONST_PRE);
+ }
}
/*
@@ -651,7 +731,7 @@ inlineContextAddNewLine(p, nHeight)
*
*---------------------------------------------------------------------------
*/
-static void
+static void
inlineContextDrawBorder(
pLayout, pCanvas, pBorder, x1, x2, iVerticalOffset, drb, aRepX, nRepX)
LayoutContext *pLayout;
@@ -676,6 +756,18 @@ pLayout, pCanvas, pBorder, x1, x2, iVerticalOffset, drb, aRepX, nRepX)
HtmlNode *pNode = pBorder->pNode;
HtmlElementNode *pElem = HtmlNodeAsElement(pNode);
+#if 0
+ HtmlComputedValues *pComputed = pElem->pPropertyValues;
+ if( pComputed->eTextDecoration == CSS_CONST_NONE &&
+ pComputed->eBorderTopStyle == CSS_CONST_NONE &&
+ pComputed->eBorderBottomStyle == CSS_CONST_NONE &&
+ pComputed->eBorderRightStyle == CSS_CONST_NONE &&
+ pComputed->eBorderLeftStyle == CSS_CONST_NONE &&
+ pComputed->cBackgroundColor->xcolor == 0 &&
+ pComputed->imBackgroundImage == 0
+ ) return;
+#endif
+
assert(pNode && pElem);
assert(!pBorder->isReplaced);
@@ -684,9 +776,9 @@ pLayout, pCanvas, pBorder, x1, x2, iVerticalOffset, drb, aRepX, nRepX)
x1 += (dlb ? pBorder->margin.margin_left : 0);
x2 -= (drb ? pBorder->margin.margin_right : 0);
- iTop = iVerticalOffset + pBorder->metrics.iFontTop - pBorder->box.iTop - 1;
+ iTop = iVerticalOffset + pBorder->metrics.iFontTop - pBorder->box.iTop;
iHeight = (pBorder->metrics.iFontBottom - pBorder->metrics.iFontTop);
- iHeight += (pBorder->box.iTop + pBorder->box.iBottom) + 1;
+ iHeight += (pBorder->box.iTop + pBorder->box.iBottom);
if (pBorder->pParent) {
if (flags == 0) {
@@ -750,7 +842,6 @@ calculateLineBoxHeight(pContext, nBox, hasText, piTop, piBottom)
int iTop;
int iBottom;
int ii;
- int iVerticalOffset = 0;
int doLineHeightQuirk = 0;
iTop = 0;
@@ -760,35 +851,91 @@ calculateLineBoxHeight(pContext, nBox, hasText, piTop, piBottom)
doLineHeightQuirk = 1;
}
- /* Inline boxes that flow over from previous lines. */
- for (p = pContext->pBorders; p; p = p->pNext) {
- assert(p->eLineboxAlign == 0);
- assert(p->isReplaced == 0);
- if (!doLineHeightQuirk) {
- iVerticalOffset += p->iVerticalAlign;
- iTop = MIN(iTop, iVerticalOffset);
- iBottom = MAX(iBottom, p->iVerticalAlign + p->metrics.iLogical);
+ for (ii = -1; ii < nBox; ii++) {
+ if (ii >= 0) {
+ /* Inline boxes that start on this line. */
+ p = pContext->aInline[ii].pBorderStart;
+ } else {
+ /* Inline boxes that flow over from the previous line. */
+ p = pContext->pBorders;
}
- }
+ for ( ; p; p = p->pNext) {
+
+ if (p->eLineboxAlign != LINEBOX_ALIGN_PARENT) {
+ p->iTop = 0;
+ p->iBottom = 0;
+ }
- /* Inline boxes that start on this line. */
- for (ii = 0; ii < nBox; ii++) {
- for (p = pContext->aInline[ii].pBorderStart; p; p = p->pNext) {
- assert(p->eLineboxAlign == 0);
if (!doLineHeightQuirk) {
InlineBorder *p2;
- iVerticalOffset = 0;
+ int iVerticalOffset = 0;
+ int iBottomOffset = 0;
for (p2 = p; p2; p2 = p2->pParent) {
iVerticalOffset += p2->iVerticalAlign;
+ if (p2->eLineboxAlign != LINEBOX_ALIGN_PARENT) break;
+ }
+
+ iBottomOffset = iVerticalOffset + p->metrics.iLogical;
+ if (p2) {
+ p2->iTop = MIN(p2->iTop, iVerticalOffset);
+ p2->iBottom = MAX(p2->iBottom, iBottomOffset);
+ } else {
+ iTop = MIN(iTop, iVerticalOffset);
+ iBottom = MAX(iBottom, iBottomOffset);
}
- iTop = MIN(iTop, iVerticalOffset);
- iBottom = MAX(iBottom, iVerticalOffset + p->metrics.iLogical);
} else if (p->isReplaced) {
iBottom = MAX(iBottom, p->metrics.iLogical);
}
}
}
+ for (ii = -1; ii < nBox; ii++) {
+ if (ii >= 0) {
+ /* Inline boxes that start on this line. */
+ p = pContext->aInline[ii].pBorderStart;
+ } else {
+ /* Inline boxes that flow over from the previous line. */
+ p = pContext->pBorders;
+ }
+ for ( ; p; p = p->pNext) {
+
+ if (p->eLineboxAlign != LINEBOX_ALIGN_PARENT) {
+ int iHeight = p->iBottom - p->iTop;
+ if (p->eLineboxAlign == LINEBOX_ALIGN_TOP) {
+ iBottom = MAX(iBottom, iTop + iHeight);
+ } else {
+ assert(p->eLineboxAlign == LINEBOX_ALIGN_BOTTOM);
+ iTop = MIN(iTop, iBottom - iHeight);
+ }
+ }
+ }
+ }
+
+ for (ii = -1; ii < nBox; ii++) {
+ if (ii >= 0) {
+ /* Inline boxes that start on this line. */
+ p = pContext->aInline[ii].pBorderStart;
+ } else {
+ /* Inline boxes that flow over from the previous line. */
+ p = pContext->pBorders;
+ }
+ for ( ; p; p = p->pNext) {
+ if (p->eLineboxAlign != LINEBOX_ALIGN_PARENT) {
+ InlineBorder *p2;
+ int iVerticalOffset = 0;
+ for (p2 = p; p2; p2 = p2->pParent) {
+ iVerticalOffset += p2->iVerticalAlign;
+ }
+ if (p->eLineboxAlign == LINEBOX_ALIGN_TOP) {
+ p->iVerticalAlign = -1 * iVerticalOffset;
+ } else {
+ int iHeight = p->iBottom - p->iTop;
+ p->iVerticalAlign = iBottom - iHeight - iVerticalOffset;
+ }
+ }
+ }
+ }
+
/* Set the functions output variables. */
assert(iBottom >= iTop);
*piTop = iTop;
@@ -838,6 +985,12 @@ calculateLineBoxWidth(p, flags, iReqWidth, piWidth, pnBox, pHasText)
int eType = pBox->eType;
int iBoxW; /* Box width */
+ if (pBox->eType == INLINE_NEWLINE) {
+ hasText = 1;
+ nBox = ii + 1;
+ break;
+ }
+
/* Determine the extra width required to add pBox to the line box. */
iBoxW = pBox->nContentPixels + pBox->nRightPixels + pBox->nLeftPixels;
if (pPrevBox) {
@@ -850,15 +1003,10 @@ calculateLineBoxWidth(p, flags, iReqWidth, piWidth, pnBox, pHasText)
}
iWidth += iBoxW;
- if (eType == INLINE_TEXT || eType == INLINE_NEWLINE) {
+ if (eType == INLINE_TEXT) {
hasText = 1;
}
- if (pBox->eType == INLINE_NEWLINE) {
- nBox = ii + 1;
- break;
- }
-
if (
pBox->eWhitespace == CSS_CONST_NORMAL ||
!pNextBox ||
@@ -901,7 +1049,9 @@ calculateLineBoxWidth(p, flags, iReqWidth, piWidth, pnBox, pHasText)
*pnBox = nBox;
*pHasText = hasText;
+#if 0
assert(nBox > 0 || iWidth > 0 || p->nInline == 0 || !isForceLine);
+#endif
return ((nBox == 0) ? 0 : 1);
}
@@ -977,6 +1127,9 @@ HtmlInlineContextGetLineBox(pLayout, p, flags, pWidth, pCanvas, pVSpace,pAscent)
int *aReplacedX = 0; /* List of x-coords - borders of replaced objs. */
int nReplacedX = 0; /* Size of aReplacedX divided by 2 */
+ int iVAlign = 0;
+ int ignoreSpace = 1;
+
/* True if this line-box contains one or more INLINE_NEWLINE or
* INLINE_TEXT elements. This is used to activate a line-box height quirk
* in both "quirks" and "almost standards" mode. This variable is set
@@ -995,7 +1148,7 @@ HtmlInlineContextGetLineBox(pLayout, p, flags, pWidth, pCanvas, pVSpace,pAscent)
int iLeft = 0; /* Leftmost pixel of line box */
/* The amount of horizontal space available in which to stack boxes */
- const int iReqWidth = *pWidth - p->iTextIndent;
+ const int iReqWidth = MAX(*pWidth - p->iTextIndent, 0);
HtmlCanvas content; /* Canvas for content (as opposed to borders) */
HtmlCanvas borders; /* Canvas for borders */
@@ -1052,6 +1205,24 @@ HtmlInlineContextGetLineBox(pLayout, p, flags, pWidth, pCanvas, pVSpace,pAscent)
iLeft += p->iTextIndent;
x += iLeft;
+ for (pBorder=p->pBorders; pBorder; pBorder=pBorder->pNext) {
+ iVAlign += pBorder->iVerticalAlign;
+ }
+
+ START_LOG(pContext->pNode);
+ oprintf(pLog, "<p>Creating line box with %d boxes</p><p>", nBox);
+ for(i = 0; i < nBox; i++) {
+ int eType = p->aInline[i].eType;
+ oprintf(pLog, "%s ",
+ eType == INLINE_TEXT ? "TEXT" :
+ eType == INLINE_NEWLINE ? "NEWLINE" :
+ eType == INLINE_SPACER ? "SPACER" :
+ eType == INLINE_REPLACED ? "REPLACED" : "unknown"
+ );
+ }
+ oprintf(pLog, "</p>");
+ END_LOG("HtmlInlineContextGetLineBox");
+
/* Draw nBox boxes side by side in pCanvas to create the line-box. */
for(i = 0; i < nBox; i++) {
int extra_pixels = 0; /* Number of extra pixels for justification */
@@ -1076,11 +1247,10 @@ HtmlInlineContextGetLineBox(pLayout, p, flags, pWidth, pCanvas, pVSpace,pAscent)
}
}
- if (
- !pContext->isSizeOnly &&
- pBox != &p->aInline[0] && pBox->eType == INLINE_TEXT &&
- pBox->pNode && pBox[-1].pNode &&
- pBox[-1].eType == INLINE_TEXT
+ if ( !pContext->isSizeOnly &&
+ pBox != &p->aInline[0] &&
+ pBox->pNode &&
+ pBox->eType == INLINE_TEXT
) {
HtmlFont *pFont = HtmlNodeComputedValues(pBox->pNode)->fFont;
@@ -1094,7 +1264,8 @@ HtmlInlineContextGetLineBox(pLayout, p, flags, pWidth, pCanvas, pVSpace,pAscent)
* This is an optimization only.
*/
if (
- pBox->pNode == pBox[-1].pNode &&
+ pBox[-1].eType == INLINE_TEXT &&
+ pBox->pNode == pBox[-1].pNode &&
nExtra <= 0.0 &&
pFont->space_pixels == pBox[-1].nSpace
) {
@@ -1104,20 +1275,31 @@ HtmlInlineContextGetLineBox(pLayout, p, flags, pWidth, pCanvas, pVSpace,pAscent)
HtmlDrawCleanup(pContext->pTree, &pBox->canvas);
}
- /* Otherwise, if there are no borders drawn between the two
- * adjacent text boxes, stretch the previous box so that
+ /* Otherwise, if there are no borders drawn between this text
+ * box and the previous one, stretch the previous box so that
* there is no gap between the two boxes. This ensures that
* selected regions (a.k.a. text tags) are drawn contigiously.
*/
- else if (
- pBox->nLeftPixels == 0 &&
- pBox[-1].nRightPixels == 0
- ) {
- int iExtra = 0;
- if (nExtra > 0.0) {
- iExtra = (extra_pixels - (int)(nExtra * (i-1)));
+ else {
+ InlineBox *pPrev;
+
+ pPrev = &pBox[-1];
+ while( pPrev && pPrev->eType == INLINE_SPACER ){
+ pPrev = (pPrev == p->aInline)?0:(&pPrev[-1]);
+ }
+
+ if( pPrev &&
+ pPrev->eType == INLINE_TEXT &&
+ pPrev->pNode &&
+ pBox->nLeftPixels == 0 &&
+ pPrev->nRightPixels == 0
+ ) {
+ int iExtra = 0;
+ if (nExtra > 0.0) {
+ iExtra = (extra_pixels - (int)(nExtra * (i-1)));
+ }
+ HtmlDrawTextExtend(&content, 0, pBox[-1].nSpace + iExtra);
}
- HtmlDrawTextExtend(&content, 0, pBox[-1].nSpace + iExtra);
}
}
@@ -1132,7 +1314,7 @@ HtmlInlineContextGetLineBox(pLayout, p, flags, pWidth, pCanvas, pVSpace,pAscent)
x1 -= pBorder->box.iLeft;
pBorder->iStartBox = i;
pBorder->iStartPixel = x1;
- p->iVAlign += pBorder->iVerticalAlign;
+ iVAlign += pBorder->iVerticalAlign;
if (!pBorder->pNext) {
pBorder->pNext = p->pBorders;
p->pBorders = pBox->pBorderStart;
@@ -1156,12 +1338,15 @@ HtmlInlineContextGetLineBox(pLayout, p, flags, pWidth, pCanvas, pVSpace,pAscent)
aReplacedX[(nReplacedX-1)*2+1] = x1 + boxwidth;
}
if (hasText || pContext->pTree->options.mode == HTML_MODE_STANDARDS) {
- DRAW_CANVAS(&content, &pBox->canvas, x1, p->iVAlign, pBox->pNode);
+ DRAW_CANVAS(&content, &pBox->canvas, x1, iVAlign, pBox->pNode);
} else {
- assert(pBox->eType == INLINE_REPLACED);
- assert(pBox->pBorderStart);
- assert(pBox->pBorderStart->isReplaced == 1);
- DRAW_CANVAS(&content, &pBox->canvas, x1, 0, pBox->pNode);
+ int eBoxType = pBox->eType;
+ assert(eBoxType == INLINE_REPLACED || eBoxType == INLINE_SPACER);
+ if (eBoxType == INLINE_REPLACED) {
+ assert(pBox->pBorderStart);
+ assert(pBox->pBorderStart->isReplaced == 1);
+ DRAW_CANVAS(&content, &pBox->canvas, x1, 0, pBox->pNode);
+ }
}
x += (boxwidth + pBox->nLeftPixels + pBox->nRightPixels);
@@ -1179,6 +1364,7 @@ HtmlInlineContextGetLineBox(pLayout, p, flags, pWidth, pCanvas, pVSpace,pAscent)
nBorderDraw++;
}
} else {
+ x2 += pBox->nSpace;
nBorderDraw = pBox->nBorderEnd;
}
for(j = 0; j < nBorderDraw; j++) {
@@ -1232,15 +1418,24 @@ HtmlInlineContextGetLineBox(pLayout, p, flags, pWidth, pCanvas, pVSpace,pAscent)
if (!pBorder) {
pBorder = p->pBoxBorders;
assert(pBorder);
- p->pBoxBorders = pBorder->pNext;;
+ p->pBoxBorders = pBorder->pNext;
} else {
- p->iVAlign -= pBorder->iVerticalAlign;
+ iVAlign -= pBorder->iVerticalAlign;
p->pBorders = pBorder->pNext;
HtmlFree(pBorder);
}
}
- x += pBox->nSpace;
+ if (
+ pBox->eType != INLINE_SPACER ||
+ pBox->eWhitespace == CSS_CONST_PRE
+ ) {
+ ignoreSpace = 0;
+ }
+ if (!ignoreSpace) {
+ x += pBox->nSpace;
+ }
+
}
/* If any borders are still in the InlineContext.pBorders list, then
@@ -1530,8 +1725,9 @@ HtmlInlineContextAddText(pContext, pNode)
case HTML_TEXT_TOKEN_NEWLINE:
if (eWhitespace == CSS_CONST_PRE) {
int i;
+ int isLast = HtmlTextIterIsLast(&sIter);
for (i = 0; i < nData; i++) {
- inlineContextAddNewLine(pContext, nh);
+ inlineContextAddNewLine(pContext, nh, isLast);
}
break;
}
@@ -1603,6 +1799,11 @@ HtmlInlineContextAddBox(pContext, pNode, pCanvas, iWidth, iHeight, iOffset)
return;
}
+ START_LOG(pNode);
+ oprintf(pLog, "iWidth=%d iHeight=%d ", iWidth, iHeight);
+ oprintf(pLog, "iOffset=%d", iOffset);
+ END_LOG("HtmlInlineContextAddBox");
+
pBorder = HtmlNew(InlineBorder);
pBorder->isReplaced = 1;
pBorder->pNode = pNode;
@@ -1616,18 +1817,11 @@ HtmlInlineContextAddBox(pContext, pNode, pCanvas, iWidth, iHeight, iOffset)
pBox = &pContext->aInline[pContext->nInline-1];
pBox->nContentPixels = iWidth;
pBox->eWhitespace = pComputed->eWhitespace;
+ assert(pBox->pBorderStart);
DRAW_CANVAS(pInline, pCanvas, 0, 0, pNode);
HtmlInlineContextPopBorder(pContext, pBorder);
}
-void
-HtmlInlineContextSetTextIndent(pContext, iTextIndent)
- InlineContext *pContext;
- int iTextIndent;
-{
- pContext->iTextIndent = iTextIndent;
-}
-
HtmlNode *
HtmlInlineContextCreator(pContext)
InlineContext *pContext;
diff --git a/src/htmllayout.c b/src/htmllayout.c
index cdaa156..62a917a 100644
--- a/src/htmllayout.c
+++ b/src/htmllayout.c
@@ -47,7 +47,7 @@
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
* POSSIBILITY OF SUCH DAMAGE.
*/
-static const char rcsid[] = "$Id: htmllayout.c,v 1.259 2007/09/28 14:14:56 danielk1977 Exp $";
+static const char rcsid[] = "$Id: htmllayout.c,v 1.270 2008/01/07 04:48:02 danielk1977 Exp $";
#include "htmllayout.h"
#include <assert.h>
@@ -184,7 +184,7 @@ static FlowLayoutFunc normalFlowLayoutReplaced;
static FlowLayoutFunc normalFlowLayoutTable;
static FlowLayoutFunc normalFlowLayoutText;
static FlowLayoutFunc normalFlowLayoutInline;
-static FlowLayoutFunc normalFlowLayoutReplacedInline;
+static FlowLayoutFunc normalFlowLayoutInlineReplaced;
static FlowLayoutFunc normalFlowLayoutAbsolute;
static FlowLayoutFunc normalFlowLayoutOverflow;
@@ -584,6 +584,19 @@ getWidthProperty(pLayout, pComputed, iContaining)
);
}
+/*
+ *---------------------------------------------------------------------------
+ *
+ * considerMinMaxWidth --
+ *
+ * Results:
+ * See above.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
static void
considerMinMaxWidth(pNode, iContaining, piWidth)
HtmlNode *pNode;
@@ -740,7 +753,7 @@ createScrollbars(pTree, pNode, iWidth, iHeight, iHorizontal, iVertical)
Tcl_Obj *pName;
Tk_Window win;
snprintf(zTmp, 255, "::tkhtml::vscrollbar %s %s",
- Tk_PathName(pTree->tkwin),
+ Tk_PathName(pTree->docwin),
Tcl_GetString(HtmlNodeCommand(pTree, pNode))
);
zTmp[255] = '\0';
@@ -763,7 +776,7 @@ createScrollbars(pTree, pNode, iWidth, iHeight, iHorizontal, iVertical)
Tcl_Obj *pName;
Tk_Window win;
snprintf(zTmp, 255, "::tkhtml::hscrollbar %s %s",
- Tk_PathName(pTree->tkwin),
+ Tk_PathName(pTree->docwin),
Tcl_GetString(HtmlNodeCommand(pTree, pNode))
);
zTmp[255] = '\0';
@@ -927,9 +940,10 @@ normalFlowLayoutOverflow(pLayout, pBox, pNode, pY, pContext, pNormal)
}
if (
- pV->eOverflow == CSS_CONST_SCROLL ||
- (pV->eOverflow == CSS_CONST_AUTO && (useHorizontal || useVertical))
- ) {
+ pLayout->minmaxTest == 0 && (
+ pV->eOverflow == CSS_CONST_SCROLL ||
+ (pV->eOverflow == CSS_CONST_AUTO && (useHorizontal || useVertical)
+ ))) {
HtmlElementNode *pElem = (HtmlElementNode *)pNode;
if (pElem->pScrollbar == 0) {
pElem->pScrollbar = HtmlNew(HtmlNodeScrollbars);
@@ -964,6 +978,8 @@ normalFlowLayoutOverflow(pLayout, pBox, pNode, pY, pContext, pNormal)
pBox->width = MAX(pBox->width, sBox.width);
pBox->height = MAX(pBox->height, *pY);
+ normalFlowMarginAdd(pLayout, pNode, pNormal, margin.margin_bottom);
+
return 0;
}
@@ -1036,9 +1052,9 @@ normalFlowLayoutFloat(pLayout, pBox, pNode, pY, pDoNotUse, pNormal)
*
* Note: "outer-edge" means including the the top and bottom margins.
*/
- normalFlowMarginCollapse(pLayout, pNode, pNormal, pY);
- pBox->height = MAX(pBox->height, *pY);
y = (*pY);
+ y += normalFlowMarginQuery(pNormal);
+ pBox->height = MAX(pBox->height, *pY);
y = HtmlFloatListClear(pNormal->pFloat, pV->eClear, y);
y = HtmlFloatListClearTop(pNormal->pFloat, y);
@@ -1064,7 +1080,9 @@ normalFlowLayoutFloat(pLayout, pBox, pNode, pY, pDoNotUse, pNormal)
* calculating the actual width and height, and of drawing borders
* etc. As usual horizontal margins are included, but vertical are not.
*/
+ CHECK_INTEGER_PLAUSIBILITY(sBox.vc.bottom);
drawReplacement(pLayout, &sBox, pNode);
+ CHECK_INTEGER_PLAUSIBILITY(sBox.vc.bottom);
} else {
/* A non-replaced element. */
BoxProperties box; /* Box properties of pNode */
@@ -1197,9 +1215,9 @@ normalFlowLayoutFloat(pLayout, pBox, pNode, pY, pDoNotUse, pNormal)
*---------------------------------------------------------------------------
*/
static void
-getRomanIndex(zBuf, index, isUpper)
+getRomanIndex(zBuf, iList, isUpper)
char *zBuf;
- int index;
+ int iList;
int isUpper;
{
int i = 0;
@@ -1228,13 +1246,15 @@ getRomanIndex(zBuf, index, isUpper)
{ 4, "iv" },
{ 1, "i" },
};
+ int index = iList;
+
if (index<1 || index>=5000) {
sprintf(zBuf, "%d", index);
return;
}
for (j = 0; index > 0 && j < sizeof(values)/sizeof(values[0]); j++) {
- int k;
while (index >= values[j].value) {
+ int k;
for (k = 0; values[j].name[k]; k++) {
zBuf[i++] = values[j].name[k];
}
@@ -1247,7 +1267,61 @@ getRomanIndex(zBuf, index, isUpper)
zBuf[i] += 'A' - 'a';
}
}
- strcat(zBuf,".");
+}
+
+void
+HtmlLayoutMarkerBox(eStyle, iList, isList, zBuf)
+ int eStyle;
+ int iList;
+ int isList;
+ char *zBuf;
+{
+ zBuf[0] = '\0';
+
+ if (eStyle == CSS_CONST_LOWER_LATIN) eStyle = CSS_CONST_LOWER_ALPHA;
+ if (eStyle == CSS_CONST_UPPER_LATIN) eStyle = CSS_CONST_UPPER_ALPHA;
+
+ /* If the document has requested an alpha marker, switch to decimal
+ * after item 26. (i.e. item markers will be "x", "y", "z", "27".
+ */
+ if (eStyle == CSS_CONST_LOWER_ALPHA || eStyle == CSS_CONST_UPPER_ALPHA)
+ if (iList > 26 || iList < 0) {
+ eStyle = CSS_CONST_DECIMAL;
+ }
+
+ switch (eStyle) {
+ case CSS_CONST_SQUARE:
+ strcpy(zBuf, "\xe2\x96\xa1"); /* Unicode 0x25A1 */
+ break;
+ case CSS_CONST_CIRCLE:
+ strcpy(zBuf, "\xe2\x97\x8b"); /* Unicode 0x25CB */
+ break;
+ case CSS_CONST_DISC:
+ strcpy(zBuf ,"\xe2\x80\xa2"); /* Unicode 0x25CF */
+ break;
+
+ case CSS_CONST_LOWER_ALPHA:
+ sprintf(zBuf, "%c%s", iList + 96, isList?".":"");
+ break;
+ case CSS_CONST_UPPER_ALPHA:
+ sprintf(zBuf, "%c%s", iList + 64, isList?".":"");
+ break;
+
+ case CSS_CONST_LOWER_ROMAN:
+ getRomanIndex(zBuf, iList, 0);
+ if (isList) strcat(zBuf, ".");
+ break;
+ case CSS_CONST_UPPER_ROMAN:
+ getRomanIndex(zBuf, iList, 1);
+ if (isList) strcat(zBuf, ".");
+ break;
+ case CSS_CONST_DECIMAL:
+ sprintf(zBuf, "%d%s", iList, isList?".":"");
+ break;
+ case CSS_CONST_DECIMAL_LEADING_ZERO:
+ sprintf(zBuf, "%.2d%s", iList, isList?".":"");
+ break;
+ }
}
@@ -1314,6 +1388,10 @@ markerBoxLayout(pLayout, pBox, pNode, pVerticalOffset)
*/
if (pParent) {
int ii;
+ int iStart = HtmlNodeComputedValues(pParent)->iOrderedListStart;
+ if (iStart != PIXELVAL_AUTO) {
+ iList = iStart;
+ }
for (ii = 0; ii < HtmlNodeNumChildren(pParent); ii++) {
HtmlNode *pSibling = HtmlNodeChild(pParent, ii);
HtmlComputedValues *pSibProp = HtmlNodeComputedValues(pSibling);
@@ -1322,47 +1400,18 @@ markerBoxLayout(pLayout, pBox, pNode, pVerticalOffset)
}
if (DISPLAY(pSibProp) == CSS_CONST_LIST_ITEM) {
iList++;
+ if (pSibProp->iOrderedListValue != PIXELVAL_AUTO) {
+ iList = pSibProp->iOrderedListValue;
+ }
}
}
}
-
- /* If the document has requested an alpha marker, switch to decimal
- * after item 26. (i.e. item markers will be "x", "y", "z", "27".
- */
- if (eStyle == CSS_CONST_LOWER_ALPHA || eStyle == CSS_CONST_UPPER_ALPHA)
- if (iList > 26) {
- eStyle = CSS_CONST_DECIMAL;
- }
-
- switch (eStyle) {
- case CSS_CONST_SQUARE:
- strcpy(zBuf, "\xe2\x96\xa1"); /* Unicode 0x25A1 */
- break;
- case CSS_CONST_CIRCLE:
- strcpy(zBuf, "\xe2\x97\x8b"); /* Unicode 0x25CB */
- break;
- case CSS_CONST_DISC:
- strcpy(zBuf ,"\xe2\x80\xa2"); /* Unicode 0x25CF */
- break;
-
- case CSS_CONST_LOWER_ALPHA:
- sprintf(zBuf, "%c.", iList + 96);
- break;
- case CSS_CONST_UPPER_ALPHA:
- sprintf(zBuf, "%c.", iList + 64);
- break;
-
- case CSS_CONST_LOWER_ROMAN:
- getRomanIndex(zBuf, iList, 0);
- break;
- case CSS_CONST_UPPER_ROMAN:
- getRomanIndex(zBuf, iList, 1);
- break;
- case CSS_CONST_DECIMAL:
- sprintf(zBuf, "%d.", iList);
- break;
+ if (pComputed->iOrderedListValue != PIXELVAL_AUTO) {
+ iList = pComputed->iOrderedListValue;
}
+ HtmlLayoutMarkerBox(eStyle, iList, 1, zBuf);
+
font = pComputed->fFont->tkfont;
/* voffset = pComputed->fFont->metrics.ascent; */
pBox->height = voffset + pComputed->fFont->metrics.descent;
@@ -1661,7 +1710,15 @@ drawReplacementContent(pLayout, pBox, pNode)
}
} else {
int t = pLayout->minmaxTest;
+ int dummy_height = height;
HtmlImage2 *pImg = pV->imReplacementImage;
+
+ /* Take the 'max-width'/'min-width' properties into account */
+ if (iWidth == PIXELVAL_AUTO) {
+ HtmlImageScale(pImg, &iWidth, &dummy_height, 0);
+ }
+ considerMinMaxWidth(pNode, pBox->iContaining, &iWidth);
+
pImg = HtmlImageScale(pImg, &iWidth, &height, (t ? 0 : 1));
HtmlDrawImage(&pBox->vc, pImg, 0, 0, iWidth, height, pNode, t);
HtmlImageFree(pImg);
@@ -2773,7 +2830,7 @@ normalFlowLayoutText(pLayout, pBox, pNode, pY, pContext, pNormal)
/*
*---------------------------------------------------------------------------
*
- * normalFlowLayoutReplacedInline --
+ * normalFlowLayoutInlineReplaced --
*
* Results:
* None.
@@ -2784,7 +2841,7 @@ normalFlowLayoutText(pLayout, pBox, pNode, pY, pContext, pNormal)
*---------------------------------------------------------------------------
*/
static int
-normalFlowLayoutReplacedInline(pLayout, pBox, pNode, pY, pContext, pNormal)
+normalFlowLayoutInlineReplaced(pLayout, pBox, pNode, pY, pContext, pNormal)
LayoutContext *pLayout;
BoxContext *pBox;
HtmlNode *pNode;
@@ -2795,7 +2852,7 @@ normalFlowLayoutReplacedInline(pLayout, pBox, pNode, pY, pContext, pNormal)
BoxContext sBox;
HtmlCanvas canvas;
int w, h;
- int iOffset;
+ int iOffset = 0;
MarginProperties margin;
BoxProperties box;
@@ -2812,7 +2869,15 @@ normalFlowLayoutReplacedInline(pLayout, pBox, pNode, pY, pContext, pNormal)
nodeGetBoxProperties(pLayout, pNode, pBox->iContaining, &box);
h = sBox.height + margin.margin_top + margin.margin_bottom;
w = sBox.width;
- iOffset = box.iBottom + (pReplace ? pReplace->iOffset : 0);
+
+ /* If the box does not have a baseline (i.e. if the replaced content
+ * is an image, not a widget), then the bottom margin edge of the box
+ * is it's baseline. See the description of "baseline" in CSS2.1 section
+ * 10.8 ('vertical-align' property).
+ */
+ if (pReplace) {
+ iOffset = box.iBottom + pReplace->iOffset;
+ }
memset(&canvas, 0, sizeof(HtmlCanvas));
DRAW_CANVAS(&canvas, &sBox.vc, 0, margin.margin_top, pNode);
HtmlInlineContextAddBox(pContext, pNode, &canvas, w, h, iOffset);
@@ -3089,26 +3154,24 @@ normalFlowLayoutNode(pLayout, pBox, pNode, pY, pContext, pNormal)
char *z;
int doDrawLines; /* True to call inlineLayoutDrawLines() */
int doClearFloat; /* True to call normalFlowClearFloat() */
- int doLineBreak; /* Make a line-break (i.e. for <br>) */
FlowLayoutFunc *xLayout; /* Layout function to invoke */
};
/* Look-up table used by this function. */
- #define F(z, d, c, l, x) static FlowType FT_ ## z = {#z, d, c, l, x}
- F( NONE, 0, 0, 0, 0);
- F( BLOCK, 1, 1, 0, normalFlowLayoutBlock);
- F( BR, 1, 1, 1, normalFlowLayoutBlock);
- F( FLOAT, 0, 0, 0, normalFlowLayoutFloat);
- F( TABLE, 1, 1, 0, normalFlowLayoutTable);
- F( BLOCK_REPLACED, 1, 1, 0, normalFlowLayoutReplaced);
- F( TEXT, 0, 0, 0, normalFlowLayoutText);
- F( INLINE, 0, 0, 0, normalFlowLayoutInline);
- F( INLINE_BLOCK, 0, 0, 0, normalFlowLayoutInlineBlock);
- F( INLINE_REPLACED, 0, 0, 0, normalFlowLayoutReplacedInline);
- F( ABSOLUTE, 0, 0, 0, normalFlowLayoutAbsolute);
- F( FIXED, 0, 0, 0, normalFlowLayoutFixed);
- F( OVERFLOW, 1, 1, 0, normalFlowLayoutOverflow);
- F( TABLE_COMPONENT, 0, 0, 0, normalFlowLayoutTableComponent);
+ #define F(z, d, c, x) static FlowType FT_ ## z = {#z, d, c, x}
+ F( NONE, 0, 0, 0);
+ F( BLOCK, 1, 1, normalFlowLayoutBlock);
+ F( FLOAT, 0, 0, normalFlowLayoutFloat);
+ F( TABLE, 1, 1, normalFlowLayoutTable);
+ F( BLOCK_REPLACED, 1, 1, normalFlowLayoutReplaced);
+ F( TEXT, 0, 0, normalFlowLayoutText);
+ F( INLINE, 0, 0, normalFlowLayoutInline);
+ F( INLINE_BLOCK, 0, 0, normalFlowLayoutInlineBlock);
+ F( INLINE_REPLACED, 0, 0, normalFlowLayoutInlineReplaced);
+ F( ABSOLUTE, 0, 0, normalFlowLayoutAbsolute);
+ F( FIXED, 0, 0, normalFlowLayoutFixed);
+ F( OVERFLOW, 1, 1, normalFlowLayoutOverflow);
+ F( TABLE_COMPONENT, 0, 0, normalFlowLayoutTableComponent);
#undef F
/*
@@ -3162,9 +3225,7 @@ normalFlowLayoutNode(pLayout, pBox, pNode, pY, pContext, pNormal)
pFlow = &FT_BLOCK_REPLACED;
} else if (eDisplay == CSS_CONST_BLOCK || eDisplay == CSS_CONST_LIST_ITEM) {
pFlow = &FT_BLOCK;
- if (HtmlNodeTagType(pNode) == Html_BR) {
- pFlow = &FT_BR;
- } else if (pV->eOverflow != CSS_CONST_VISIBLE) {
+ if (pV->eOverflow != CSS_CONST_VISIBLE) {
pFlow = &FT_OVERFLOW;
}
} else if (eDisplay == CSS_CONST_TABLE) {
@@ -3213,9 +3274,6 @@ normalFlowLayoutNode(pLayout, pBox, pNode, pY, pContext, pNormal)
Tcl_DecrRefCount(pLog);
}
- if (pFlow->doLineBreak && HtmlInlineContextIsEmpty(pContext)) {
- *pY += pV->fFont->em_pixels;
- }
if (pFlow->doDrawLines) {
inlineLayoutDrawLines(pLayout, pBox, pContext, 1, pY, pNormal);
}
@@ -3229,6 +3287,25 @@ normalFlowLayoutNode(pLayout, pBox, pNode, pY, pContext, pNormal)
/* See if there are any complete line-boxes to copy to the main canvas. */
inlineLayoutDrawLines(pLayout, pBox, pContext, 0, pY, pNormal);
+ /* More backwards compatible insanity. As of CSS 2, the 'clear' property
+ * should be ignored on all inline elements. And the BR element, so
+ * says the spec, should be implemented as:
+ *
+ * BR:before { content: "\A" ; white-space: pre-line; }
+ *
+ * But it's common to apply the 'clear' property to BR elements. The
+ * following block seems to mimic what other browsers are doing - add
+ * the newline, then clear any floats if required.
+ */
+ if (
+ HtmlNodeTagType(pNode) == Html_BR &&
+ pV->eClear != CSS_CONST_NONE &&
+ pV->eDisplay == CSS_CONST_INLINE
+ ) {
+ inlineLayoutDrawLines(pLayout, pBox, pContext, 1, pY, pNormal);
+ *pY = normalFlowClearFloat(pBox, pNode, pNormal, *pY);
+ }
+
/* Log the state of the normal-flow context after this node */
LOG(pNode) {
HtmlTree *pTree = pLayout->pTree;
@@ -3912,6 +3989,12 @@ HtmlLayout(pTree)
BoxContext sBox;
NormalFlow sNormal;
+ if (pTree->options.shrink) {
+ int iMaxWidth = 0;
+ blockMinMaxWidth(&sLayout, pBody, 0, &iMaxWidth);
+ nWidth = MIN(iMaxWidth, nWidth);
+ }
+
nodeGetMargins(&sLayout, pBody, nWidth, &margin);
nodeGetBoxProperties(&sLayout, pBody, nWidth, &box);
diff --git a/src/htmllayout.h b/src/htmllayout.h
index 5495dc6..8f5512e 100644
--- a/src/htmllayout.h
+++ b/src/htmllayout.h
@@ -94,8 +94,6 @@ InlineBorder *HtmlGetInlineBorder(LayoutContext*,InlineContext*,HtmlNode*);
int HtmlInlineContextPushBorder(InlineContext *, InlineBorder *);
void HtmlInlineContextPopBorder(InlineContext *, InlineBorder *);
-void HtmlInlineContextSetTextIndent(InlineContext*, int);
-
HtmlNode *HtmlInlineContextCreator(InlineContext *);
/* End of htmllayoutinline.c interface
diff --git a/src/htmlparse.c b/src/htmlparse.c
index 41a8e76..666fbac 100644
--- a/src/htmlparse.c
+++ b/src/htmlparse.c
@@ -31,7 +31,7 @@
* POSSIBILITY OF SUCH DAMAGE.
*/
static char const rcsid[] =
- "@(#) $Id: htmlparse.c,v 1.117 2007/09/25 11:21:42 danielk1977 Exp $";
+ "@(#) $Id: htmlparse.c,v 1.121 2007/12/08 15:33:00 danielk1977 Exp $";
#include <string.h>
#include <stdlib.h>
@@ -501,52 +501,6 @@ HtmlLiContent(pTree, pNode, tag)
*/
#include "htmltokens.c"
-static HtmlTokenMap *HtmlHashLookup(void *htmlPtr, CONST char *zType);
-
-/******************* Begin HTML tokenizer code *******************/
-
-/*
-** The following variable becomes TRUE when the markup hash table
-** (stored in HtmlMarkupMap[]) is initialized.
-*/
-static int isInit = 0;
-
-/* The hash table for HTML markup names.
-**
-** If an HTML markup name hashes to H, then apMap[H] will point to
-** a linked list of sgMap structure, one of which will describe the
-** the particular markup (if it exists.)
-*/
-static HtmlTokenMap *apMap[HTML_MARKUP_HASH_SIZE];
-
-/* Hash a markup name
-**
-** HTML markup is case insensitive, so this function will give the
-** same hash regardless of the case of the markup name.
-**
-** The value returned is an integer between 0 and HTML_MARKUP_HASH_SIZE-1,
-** inclusive.
-*/
-static int
-HtmlHash(htmlPtr, zName)
- void *htmlPtr;
- const char *zName;
-{
- int h = 0;
- char c;
- while ((c = *zName) != 0) {
- if (isupper(c)) {
- c = tolower(c);
- }
- h = h << 5 ^ h ^ c;
- zName++;
- }
- if (h < 0) {
- h = -h;
- }
- return h % HTML_MARKUP_HASH_SIZE;
-}
-
#ifdef TEST
/*
@@ -583,41 +537,6 @@ HtmlHashStats(void * htmlPtr)
}
#endif
-/* Initialize the escape sequence hash table
-*/
-static void
-HtmlHashInit(htmlPtr, start)
- void *htmlPtr;
- int start;
-{
- int i; /* For looping thru the list of markup
- * names */
- int h; /* The hash on a markup name */
-
- for (i = start; i < HTML_MARKUP_COUNT; i++) {
- h = HtmlHash(htmlPtr, HtmlMarkupMap[i].zName);
- HtmlMarkupMap[i].pCollide = apMap[h];
- apMap[h] = &HtmlMarkupMap[i];
- }
-#ifdef TEST
- HtmlHashStats(htmlPtr);
-#endif
-}
-
-/*
-** Convert a string to all lower-case letters.
-*/
-static void
-ToLower(z)
- char *z;
-{
- while (*z) {
- if (isupper(*z))
- *z = tolower(*z);
- z++;
- }
-}
-
/*
*---------------------------------------------------------------------------
*
@@ -640,62 +559,13 @@ getScriptHandler(pTree, tag)
int tag;
{
Tcl_HashEntry *pEntry;
- pEntry = Tcl_FindHashEntry(&pTree->aScriptHandler, (char *)tag);
+ pEntry = Tcl_FindHashEntry(&pTree->aScriptHandler, (char *)((size_t) tag));
if (pEntry) {
return (Tcl_Obj *)Tcl_GetHashValue(pEntry);
}
return 0;
}
-HtmlAttributes *
-HtmlAttributesNew(argc, argv, arglen, doEscape)
- int argc;
- char const **argv;
- int *arglen;
- int doEscape;
-{
- HtmlAttributes *pMarkup = 0;
-
- if (argc > 1) {
- int nByte;
- int j;
- char *zBuf;
-
- int nAttr = argc / 2;
-
- nByte = sizeof(HtmlAttributes);
- for (j = 0; j < argc; j++) {
- nByte += arglen[j] + 1;
- }
- nByte += sizeof(struct HtmlAttribute) * (argc - 1);
-
- pMarkup = (HtmlAttributes *)HtmlAlloc("HtmlAttributes", nByte);
- pMarkup->nAttr = nAttr;
- zBuf = (char *)(&pMarkup->a[nAttr]);
-
- for (j=0; j < nAttr; j++) {
- int idx = (j * 2);
-
- pMarkup->a[j].zName = zBuf;
- memcpy(zBuf, argv[idx], arglen[idx]);
- zBuf[arglen[idx]] = '\0';
- if (doEscape) {
- HtmlTranslateEscapes(zBuf);
- ToLower(zBuf);
- }
- zBuf += (arglen[idx] + 1);
-
- pMarkup->a[j].zValue = zBuf;
- memcpy(zBuf, argv[idx+1], arglen[idx+1]);
- zBuf[arglen[idx+1]] = '\0';
- if (doEscape) HtmlTranslateEscapes(zBuf);
- zBuf += (arglen[idx+1] + 1);
- }
- }
-
- return pMarkup;
-}
-
/*
*---------------------------------------------------------------------------
*
@@ -834,8 +704,8 @@ HtmlTokenize(pTree, zText, isFinal, xAddText, xAddElement, xAddClosing)
char const *zText;
int isFinal;
void (*xAddText)(HtmlTree *, HtmlTextNode *, int);
- void (*xAddElement)(HtmlTree *, int, HtmlAttributes *, int);
- void (*xAddClosing)(HtmlTree *, int, int);
+ void (*xAddElement)(HtmlTree *, int, const char *, HtmlAttributes *, int);
+ void (*xAddClosing)(HtmlTree *, int, const char *, int);
{
char *z; /* The input HTML text */
int c; /* The next character of input */
@@ -922,6 +792,28 @@ HtmlTokenize(pTree, zText, isFinal, xAddText, xAddElement, xAddClosing)
isTrimStart = 0;
}
+ else if (
+ pTree->options.parsemode == HTML_PARSEMODE_XML &&
+ 0 == strncmp(&z[n], "<![CDATA[", 9)
+ ) {
+ const char *zData = &z[n+9];
+ int nData;
+ for (i = 9; z[n + i]; i++) {
+ if (z[n + i] == ']' && strncmp(&z[n + i], "]]>", 3) == 0) {
+ break;
+ }
+ }
+ if (z[n + i] == 0) {
+ goto incomplete;
+ }
+ n += i + 3;
+
+ nData = i - 9;
+ xAddText(pTree, HtmlTextNew(nData, zData, 0, 0), 0);
+
+ isTrimStart = 0;
+ }
+
/* A markup tag (i.e "<p>" or <p color="red"> or </p>). We parse
* this into a vector of strings stored in the argv[] array. The
* length of each string is stored in the corresponding element
@@ -942,6 +834,9 @@ HtmlTokenize(pTree, zText, isFinal, xAddText, xAddElement, xAddClosing)
int isSelfClosing = 0;
int i = 1;
int nStartScript = n;
+ const char *zAtom = 0;
+ int eType = 0;
+
argc = 1;
argv[0] = &z[n + 1];
assert( c=='<' );
@@ -1070,7 +965,7 @@ HtmlTokenize(pTree, zText, isFinal, xAddText, xAddElement, xAddClosing)
assert(c == '>');
n += i + 1;
- if (pTree->options.xhtml) {
+ if (pTree->options.parsemode > HTML_PARSEMODE_HTML) {
for (i = n - 2; i>=0 && z[i] == ' '; i--);
if (z[i] == '/') isSelfClosing = 1;
}
@@ -1083,21 +978,29 @@ HtmlTokenize(pTree, zText, isFinal, xAddText, xAddElement, xAddClosing)
* HtmlHashLookup(). It would be easy enough to fix
* HtmlHashLookup() to understand a length argument.
*/
- if (!isInit) {
- HtmlHashInit(0, 0);
- isInit = 1;
- }
+ HtmlHashInit(0, 0);
c = argv[0][arglen[0]];
argv[0][arglen[0]] = 0;
pMap = HtmlHashLookup(0, argv[0]);
- argv[0][arglen[0]] = c;
if (pMap == 0) {
- continue;
+ Tcl_HashEntry *pEntry;
+ int dummy;
+ if (pTree->options.parsemode != HTML_PARSEMODE_XML){
+ argv[0][arglen[0]] = c;
+ continue;
+ }
+ pEntry = Tcl_CreateHashEntry(&pTree->aAtom, argv[0], &dummy);
+ zAtom = Tcl_GetHashKey(&pTree->aAtom, pEntry);
+ eType = 0;
+ } else {
+ zAtom = pMap->zName;
+ eType = pMap->type;
}
+ argv[0][arglen[0]] = c;
if (isClosingTag) {
/* Closing tag (i.e. "</p>"). */
- xAddClosing(pTree, pMap->type, nStartScript);
+ xAddClosing(pTree, eType, zAtom, nStartScript);
} else {
char *zScript = 0;
@@ -1114,12 +1017,12 @@ HtmlTokenize(pTree, zText, isFinal, xAddText, xAddElement, xAddClosing)
* never fired from within [$html fragment] commands.
*/
if (!zText) {
- pScript = getScriptHandler(pTree, pMap->type);
+ pScript = getScriptHandler(pTree, eType);
}
- if (pScript || pMap->flags & HTMLTAG_PCDATA) {
+ if (pScript || (pMap && pMap->flags & HTMLTAG_PCDATA)) {
zScript = &z[n];
- nScript = findEndOfScript(pMap->type, z, &n);
+ nScript = findEndOfScript(eType, z, &n);
if (nScript < 0) {
n = nStartScript;
HtmlFree(pAttr);
@@ -1133,7 +1036,7 @@ HtmlTokenize(pTree, zText, isFinal, xAddText, xAddElement, xAddClosing)
* it to the list of all tokens.
*/
assert(nStartScript >= 0);
- xAddElement(pTree, pMap->type, pAttr, nStartScript);
+ xAddElement(pTree, eType, zAtom, pAttr, nStartScript);
if( pTree->eWriteState==HTML_WRITE_INHANDLERRESET ){
goto incomplete;
}
@@ -1141,13 +1044,13 @@ HtmlTokenize(pTree, zText, isFinal, xAddText, xAddElement, xAddClosing)
HtmlTextNode *pTextNode;
pTextNode = HtmlTextNew(nScript, zScript, 1, 1);
xAddText(pTree, pTextNode, n);
- xAddClosing(pTree, pMap->type, n);
+ xAddClosing(pTree, eType, zAtom, n);
} else {
- if (pMap->type == Html_PRE) {
+ if (eType == Html_PRE) {
isTrimStart = 1;
}
if (isSelfClosing) {
- xAddClosing(pTree, pMap->type, n);
+ xAddClosing(pTree, eType, zAtom, n);
}
}
@@ -1211,8 +1114,8 @@ tokenizeWrapper(pTree, isFin, xAddText, xAddElement, xAddClosing)
HtmlTree *pTree; /* The HTML widget doing the parsing */
int isFin;
void (*xAddText)(HtmlTree *, HtmlTextNode *, int);
- void (*xAddElement)(HtmlTree *, int, HtmlAttributes *, int);
- void (*xAddClosing)(HtmlTree *, int, int);
+ void (*xAddElement)(HtmlTree *, int, const char *, HtmlAttributes *, int);
+ void (*xAddClosing)(HtmlTree *, int, const char *, int);
{
int rc;
HtmlNode *pCurrent = pTree->state.pCurrent;
@@ -1227,20 +1130,22 @@ tokenizeWrapper(pTree, isFin, xAddText, xAddElement, xAddClosing)
HtmlFinishNodeHandlers(pTree);
}
- pCurrent = pTree->state.pCurrent;
- HtmlCallbackRestyle(pTree, pCurrent ? pCurrent : pTree->pRoot);
-
- /* The theory is that the above calls to CallbackRestyle() ensure that
- * any nodes added to the tree by HtmlTokenize() are styled in the next
- * idle callback. This call, which is a no-op in -DNDEBUG builds,
- * checks if that is true.
- *
- * TODO. Each time an element is added to a foster-tree in htmltree.c
- * it calls HtmlCheckRestylePoint(). This is inefficient. But otherwise
- * the following assert() fails (HtmlCheckRestylePoint() is a complex
- * assert() function).
- */
- HtmlCheckRestylePoint(pTree);
+ if (pTree->eWriteState != HTML_WRITE_INHANDLERRESET) {
+ pCurrent = pTree->state.pCurrent;
+ HtmlCallbackRestyle(pTree, pCurrent ? pCurrent : pTree->pRoot);
+
+ /* The theory is that the above calls to CallbackRestyle() ensure that
+ * any nodes added to the tree by HtmlTokenize() are styled in the next
+ * idle callback. This call, which is a no-op in -DNDEBUG builds,
+ * checks if that is true.
+ *
+ * TODO. Each time an element is added to a foster-tree in htmltree.c
+ * it calls HtmlCheckRestylePoint(). This is inefficient. But otherwise
+ * the following assert() fails (HtmlCheckRestylePoint() is a complex
+ * assert() function).
+ */
+ HtmlCheckRestylePoint(pTree);
+ }
return rc;
}
@@ -1295,76 +1200,6 @@ HtmlTokenizerAppend(pTree, zText, nText, isFinal)
/*
*---------------------------------------------------------------------------
*
- * HtmlHashLookup --
- *
- * Look up an HTML tag name in the hash-table.
- *
- * Results:
- * Return the corresponding HtmlTokenMap if the tag name is recognized,
- * or NULL otherwise.
- *
- * Side effects:
- * May initialise the hash table from the autogenerated array
- * in htmltokens.c (generated from tokenlist.txt).
- *
- *---------------------------------------------------------------------------
- */
-static HtmlTokenMap *
-HtmlHashLookup(htmlPtr, zType)
- void *htmlPtr;
- const char *zType; /* Null terminated tag name. eg. "br" */
-{
- HtmlTokenMap *pMap; /* For searching the markup name hash table */
- int h; /* The hash on zType */
- char buf[256];
- if (!isInit) {
- HtmlHashInit(htmlPtr, 0);
- isInit = 1;
- }
- h = HtmlHash(htmlPtr, zType);
- for (pMap = apMap[h]; pMap; pMap = pMap->pCollide) {
- if (stricmp(pMap->zName, zType) == 0) {
- return pMap;
- }
- }
- strncpy(buf, zType, 255);
- buf[255] = 0;
-
- return NULL;
-}
-
-/*
-** Convert a markup name into a type integer
-*/
-int
-HtmlNameToType(htmlPtr, zType)
- void *htmlPtr;
- char *zType;
-{
- HtmlTokenMap *pMap = HtmlHashLookup(htmlPtr, zType);
- return pMap ? pMap->type : Html_Unknown;
-}
-
-/*
-** Convert a type into a symbolic name
-*/
-const char *
-HtmlTypeToName(htmlPtr, eTag)
- void *htmlPtr;
- int eTag;
-{
- if (eTag >= Html_A && eTag < Html_TypeCount) {
- HtmlTokenMap *pMap = apMap[eTag - Html_A];
- return pMap->zName;
- }
- else {
- return "???";
- }
-}
-
-/*
- *---------------------------------------------------------------------------
- *
* HtmlMarkupArg --
*
* Lookup an argument in the given markup with the name given.
diff --git a/src/htmlprop.c b/src/htmlprop.c
index 78155a6..a660990 100644
--- a/src/htmlprop.c
+++ b/src/htmlprop.c
@@ -36,7 +36,7 @@
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
* POSSIBILITY OF SUCH DAMAGE.
*/
-static const char rcsid[] = "$Id: htmlprop.c,v 1.122 2007/10/05 18:33:57 danielk1977 Exp $";
+static const char rcsid[] = "$Id: htmlprop.c,v 1.135 2007/12/05 10:11:12 danielk1977 Exp $";
#include "html.h"
#include <assert.h>
@@ -66,7 +66,7 @@ static const char rcsid[] = "$Id: htmlprop.c,v 1.122 2007/10/05 18:33:57 danielk
*/
enum PropertyValueType {
- ENUM, COLOR, LENGTH, IMAGE, BORDERWIDTH, CUSTOM
+ ENUM, COLOR, LENGTH, IMAGE, BORDERWIDTH, COUNTERLIST, CUSTOM, AUTOINTEGER
};
typedef struct PropertyDef PropertyDef;
@@ -169,9 +169,12 @@ static PropertyDef propdef[] = {
PROPDEFM(BORDERWIDTH, BORDER_BOTTOM_WIDTH, border.iBottom, 2),
PROPDEFM(BORDERWIDTH, OUTLINE_WIDTH, iOutlineWidth, 2),
+ PROPDEF(AUTOINTEGER, Z_INDEX, iZIndex),
+ PROPDEF(AUTOINTEGER, _TKHTML_ORDERED_LIST_START, iOrderedListStart),
+ PROPDEF(AUTOINTEGER, _TKHTML_ORDERED_LIST_VALUE, iOrderedListValue),
+
PROPDEF(CUSTOM, VERTICAL_ALIGN, iVerticalAlign),
PROPDEF(CUSTOM, LINE_HEIGHT, iLineHeight),
- PROPDEF(CUSTOM, Z_INDEX, iZIndex),
PROPDEF(CUSTOM, FONT_SIZE, fFont),
PROPDEF(CUSTOM, FONT_WEIGHT, fFont),
@@ -179,6 +182,9 @@ static PropertyDef propdef[] = {
PROPDEF(CUSTOM, FONT_STYLE, fFont),
PROPDEF(CUSTOM, CONTENT, fFont),
+
+ PROPDEF(COUNTERLIST, COUNTER_INCREMENT, clCounterIncrement),
+ PROPDEF(COUNTERLIST, COUNTER_RESET, clCounterReset),
};
#define SZ_AUTO 0x00000001
@@ -227,7 +233,9 @@ static int propertyValuesSetFontFamily(HtmlComputedValuesCreator*,CssProperty*);
static int propertyValuesSetFontWeight(HtmlComputedValuesCreator*,CssProperty*);
static int propertyValuesSetContent(HtmlComputedValuesCreator*,CssProperty*);
-static int propertyValuesSetZIndex(HtmlComputedValuesCreator*,CssProperty*);
+
+static int
+propertyValuesSetAutoInteger(HtmlComputedValuesCreator*,CssProperty*,int *);
static Tcl_Obj *propertyValuesObjFontSize(HtmlComputedValues*);
static Tcl_Obj *propertyValuesObjLineHeight(HtmlComputedValues*);
@@ -237,7 +245,6 @@ static Tcl_Obj *propertyValuesObjFontFamily(HtmlComputedValues*);
static Tcl_Obj *propertyValuesObjFontWeight(HtmlComputedValues*);
static Tcl_Obj *propertyValuesObjContent(HtmlComputedValues*);
-static Tcl_Obj *propertyValuesObjZIndex(HtmlComputedValues*);
#define CUSTOMDEF(x, y) {x, propertyValuesSet ## y, propertyValuesObj ## y}
static struct CustomDef {
@@ -252,7 +259,6 @@ static struct CustomDef {
CUSTOMDEF(CSS_PROPERTY_FONT_STYLE, FontStyle),
CUSTOMDEF(CSS_PROPERTY_FONT_FAMILY, FontFamily),
CUSTOMDEF(CSS_PROPERTY_CONTENT, Content),
- CUSTOMDEF(CSS_PROPERTY_Z_INDEX, ZIndex),
};
static int inheritlist[] = {
@@ -377,8 +383,11 @@ HtmlPropertyToString(pProp, pzFree)
(pProp->eType==CSS_TYPE_URL)?"url":
"attr", pProp->v.zVal
);
+ } else if (pProp->eType == CSS_TYPE_LIST) {
+ return "List";
} else {
char *zSym = 0;
+ char *zFunc = 0;
switch (pProp->eType) {
case CSS_TYPE_EM: zSym = "em"; break;
case CSS_TYPE_PX: zSym = "px"; break;
@@ -390,12 +399,22 @@ HtmlPropertyToString(pProp, pzFree)
case CSS_TYPE_CENTIMETER: zSym = "cm"; break;
case CSS_TYPE_INCH: zSym = "in"; break;
case CSS_TYPE_MILLIMETER: zSym = "mm"; break;
+ case CSS_TYPE_ATTR: zFunc = "attr"; break;
+ case CSS_TYPE_COUNTER: zFunc = "counter"; break;
+ case CSS_TYPE_COUNTERS: zFunc = "counters"; break;
default:
assert(!"Unknown CssProperty.eType value");
}
- zRet = HtmlAlloc("HtmlPropertyToString()", 128);
- sprintf(zRet, "%.2f%s", pProp->v.rVal, zSym);
+ if (zSym) {
+ zRet = HtmlAlloc("HtmlPropertyToString()", 128);
+ sprintf(zRet, "%.2f%s", pProp->v.rVal, zSym);
+ } else if (zFunc) {
+ zRet = HtmlAlloc("HtmlPropertyToString()",
+ strlen(zFunc) + strlen(pProp->v.zVal) + 3
+ );
+ sprintf(zRet, "%s(%s)", zFunc, pProp->v.zVal);
+ }
}
*pzFree = zRet;
}
@@ -481,9 +500,9 @@ physicalToPixels(p, rVal, type)
*
* propertyValuesSetFontStyle --
*
- * Keywords 'italic' and 'oblique' map to a Tk italic font. Keyword
- * 'normal' maps to a non-italic font. Any other property value is
- * rejected as a type-mismatch.
+ * Keywords 'italic' and 'oblique' map to a Tk italic font. Keyword
+ * 'normal' maps to a non-italic font. Any other property value is
+ * rejected as a type-mismatch.
*
* Results:
* 0 if value is successfully set. 1 if the value of *pProp is not a valid
@@ -512,37 +531,205 @@ propertyValuesSetFontStyle(p, pProp)
return 0;
}
+
+static int propertyValuesSetEnum(HtmlComputedValuesCreator *, unsigned char*, unsigned char *, CssProperty *);
+
+static int
+contentCounter(pTree, pProp, zOut, nOut)
+ HtmlTree *pTree;
+ CssProperty *pProp;
+ char *zOut;
+ int nOut;
+{
+ const char *zCounter; int nCounter;
+ const char *zStyle; int nStyle;
+
+ CssProperty *pCounter;
+
+ int iValue;
+ unsigned char eStyle = CSS_CONST_DECIMAL;
+
+ zCounter = HtmlCssGetNextCommaListItem(pProp->v.zVal, -1, &nCounter);
+ zStyle = HtmlCssGetNextCommaListItem(&zCounter[nCounter], -1, &nStyle);
+
+ pCounter = HtmlCssStringToProperty(zCounter, nCounter);
+ if (zStyle) {
+ CssProperty *pStyle;
+ unsigned char *options;
+ options = HtmlCssEnumeratedValues(CSS_PROPERTY_LIST_STYLE_TYPE);
+ pStyle = HtmlCssStringToProperty(zStyle, nStyle);
+ if (propertyValuesSetEnum(0, &eStyle, options, pStyle)) {
+ /* Unknown style type */
+ return 1;
+ }
+ HtmlFree(pStyle);
+ }
+
+ zCounter = HtmlCssPropertyGetString(pCounter);
+ iValue = HtmlStyleCounter(pTree, zCounter);
+
+ HtmlLayoutMarkerBox(eStyle, iValue, 0, zOut);
+
+ HtmlFree(pCounter);
+
+ return 0;
+}
+
+static int
+contentCounters(pTree, pProp, zOut, nOut)
+ HtmlTree *pTree;
+ CssProperty *pProp;
+ char *zOut;
+ int nOut;
+{
+ const char *zCounter; int nCounter;
+ const char *zStyle; int nStyle;
+ const char *zSep; int nSep;
+
+ CssProperty *pCounter;
+ CssProperty *pSep;
+
+ unsigned char eStyle = CSS_CONST_DECIMAL;
+
+ int aValue[128];
+ int nValue;
+ int ii;
+
+ zCounter = HtmlCssGetNextCommaListItem(pProp->v.zVal, -1, &nCounter);
+ zSep = HtmlCssGetNextCommaListItem(&zCounter[nCounter], -1, &nSep);
+ zStyle = HtmlCssGetNextCommaListItem(&zSep[nSep], -1, &nStyle);
+
+ pCounter = HtmlCssStringToProperty(zCounter, nCounter);
+ pSep = HtmlCssStringToProperty(zSep, nSep);
+ zCounter = HtmlCssPropertyGetString(pCounter);
+
+ if (!zCounter || !pSep || pSep->eType != CSS_TYPE_STRING) {
+ HtmlFree(pCounter);
+ HtmlFree(pSep);
+ return 1;
+ }
+ zSep = HtmlCssPropertyGetString(pSep);
+
+ if (zStyle) {
+ CssProperty *pStyle;
+ unsigned char *options;
+ options = HtmlCssEnumeratedValues(CSS_PROPERTY_LIST_STYLE_TYPE);
+ pStyle = HtmlCssStringToProperty(zStyle, nStyle);
+ propertyValuesSetEnum(0, &eStyle, options, pStyle);
+ HtmlFree(pStyle);
+ }
+
+ nValue = HtmlStyleCounters(pTree, zCounter, aValue, 128);
+ assert(nValue > 0); /* Otherwise zOut[] will never be initialized */
+
+ for (ii = 0; ii < nValue; ii++) {
+ if (ii != 0) {
+ strcat(zOut, zSep);
+ zOut = &zOut[strlen(zOut)];
+ }
+ HtmlLayoutMarkerBox(eStyle, aValue[ii], 0, zOut);
+ zOut = &zOut[strlen(zOut)];
+ }
+
+ HtmlFree(pCounter);
+ HtmlFree(pSep);
+ return 0;
+}
+
static int
propertyValuesSetContent(p, pProp)
HtmlComputedValuesCreator *p;
CssProperty *pProp;
{
- if (pProp->eType == CSS_TYPE_STRING && p->pzContent) {
- int nBytes = strlen(pProp->v.zVal) + 1;
- *(p->pzContent) = HtmlAlloc(
- "*HtmlComputedValuesCreator.pzContent", nBytes
- );
- strcpy(*(p->pzContent), pProp->v.zVal);
- return 0;
+ if (p->pzContent) {
+ p->pContent = pProp;
}
- return 1;
+ return 0;
+}
+
+static void
+propertyValuesCalculateContent(p)
+ HtmlComputedValuesCreator *p;
+{
+ int ii;
+ int nOut = 0;
+ char *zOut = 0;
+ CssProperty *pProp = p->pContent;
+
+ CssProperty **apProp;
+ assert(p->pzContent);
+
+ assert(pProp->eType == CSS_TYPE_LIST);
+ apProp = (CssProperty **)pProp->v.p;
+ for (ii = 0; apProp[ii]; ii++) {
+ char zCounter[512];
+ const char *z = 0;
+ switch (apProp[ii]->eType) {
+
+ case CSS_TYPE_STRING:
+ z = apProp[ii]->v.zVal;
+ break;
+
+ case CSS_TYPE_ATTR:
+ z = HtmlNodeAttr(p->pNode, apProp[ii]->v.zVal);
+ break;
+
+ case CSS_TYPE_COUNTER:
+ contentCounter(p->pTree, apProp[ii], zCounter, 512);
+ z = zCounter;
+ break;
+
+ case CSS_TYPE_COUNTERS:
+ contentCounters(p->pTree, apProp[ii], zCounter, 512);
+ z = zCounter;
+ break;
+ }
+
+ if (z) {
+ int n = strlen(z);
+ zOut = HtmlRealloc("zContent", zOut, nOut + n + 1);
+ strcpy(&zOut[nOut], z);
+ nOut += n;
+ }
+ }
+ *(p->pzContent) = zOut;
}
+/*
+ *---------------------------------------------------------------------------
+ *
+ * propertyValuesSetAutoInteger --
+ *
+ * Set the value of the 'z-index' property (either an integer or "auto").
+ * This procedure is also used for the custom Tkhtml3 properties:
+ *
+ * -tkhtml-ordered-list-start
+ * -tkhtml-ordered-list-value
+ *
+ * Results:
+ * 0 if value is successfully set. 1 if the value of *pProp is not a valid
+ * a value for the 'font-weight' property.
+ *
+ * Side effects:
+ *
+ *---------------------------------------------------------------------------
+ */
static int
-propertyValuesSetZIndex(p, pProp)
+propertyValuesSetAutoInteger(p, pProp, piVal)
HtmlComputedValuesCreator *p;
CssProperty *pProp;
+ int *piVal;
{
if (pProp->eType == CSS_TYPE_FLOAT) {
- p->values.iZIndex = (int)pProp->v.rVal;
+ *piVal = (int)pProp->v.rVal;
}else if (pProp->eType == CSS_CONST_AUTO) {
- p->values.iZIndex = PIXELVAL_AUTO;
+ *piVal = PIXELVAL_AUTO;
}else{
/* Type mismatch */
return 1;
}
return 0;
-}
+}
/*
*---------------------------------------------------------------------------
@@ -640,7 +827,11 @@ propertyValuesObjFontSize(p)
{
char zBuf[64];
int iFontSize = p->fFont->pKey->iFontSize;
- sprintf(zBuf, "%.3fpts", (float)iFontSize / 1000);
+ if (iFontSize >= 0) {
+ sprintf(zBuf, "%.3fpts", (float)iFontSize / HTML_IFONTSIZE_SCALE);
+ } else {
+ sprintf(zBuf, "%dpx", -1 * iFontSize / HTML_IFONTSIZE_SCALE);
+ }
return Tcl_NewStringObj(zBuf, -1);
}
static Tcl_Obj*
@@ -674,15 +865,6 @@ propertyValuesObjContent(p)
return Tcl_NewStringObj("", -1);
}
static Tcl_Obj*
-propertyValuesObjZIndex(p)
- HtmlComputedValues *p;
-{
- if (p->iZIndex == PIXELVAL_AUTO) {
- return Tcl_NewStringObj("auto", -1);
- }
- return Tcl_NewIntObj(p->iZIndex);
-}
-static Tcl_Obj*
propertyValuesObjLineHeight(p)
HtmlComputedValues *p;
{
@@ -711,6 +893,17 @@ propertyValuesObjVerticalAlign(p)
return Tcl_NewStringObj(zBuf, -1);
}
+static int normalizeFontSize(p, pNode)
+ HtmlComputedValuesCreator *p;
+ HtmlNode *pNode;
+{
+ int iFontSize = HtmlNodeComputedValues(pNode)->fFont->pKey->iFontSize;
+ if (iFontSize >= 0) {
+ return iFontSize;
+ } else {
+ return pixelsToPoints(p, iFontSize * -1);
+ }
+}
/*
*---------------------------------------------------------------------------
@@ -774,7 +967,7 @@ propertyValuesSetFontSize(p, pProp)
if (pParent) {
int ii;
int *aSize = p->pTree->aFontSizeTable;
- int ps =HtmlNodeComputedValues(pParent)->fFont->pKey->iFontSize;
+ int ps = normalizeFontSize(p, pParent);
int points = ps / HTML_IFONTSIZE_SCALE;
for (ii = 1; ii < 7 && aSize[ii] < points; ii++);
iPoints = ps + (aSize[ii-1] - aSize[ii]) * HTML_IFONTSIZE_SCALE;
@@ -788,7 +981,7 @@ propertyValuesSetFontSize(p, pProp)
if (pParent) {
int ii;
int *aSize = p->pTree->aFontSizeTable;
- int ps =HtmlNodeComputedValues(pParent)->fFont->pKey->iFontSize;
+ int ps = normalizeFontSize(p, pParent);
int points = ps / HTML_IFONTSIZE_SCALE;
for (ii = 0; ii < 6 && aSize[ii] < points; ii++);
iPoints = ps + (aSize[ii+1] - aSize[ii]) * HTML_IFONTSIZE_SCALE;
@@ -857,7 +1050,7 @@ propertyValuesSetFontSize(p, pProp)
}
if (iPixels > 0) {
- p->fontKey.iFontSize = HTML_IFONTSIZE_SCALE * pixelsToPoints(p,iPixels);
+ p->fontKey.iFontSize = HTML_IFONTSIZE_SCALE * iPixels * -1;
} else if (iPoints > 0) {
p->fontKey.iFontSize = iPoints;
} else if (iScale > 0.0) {
@@ -1044,9 +1237,21 @@ propertyValuesSetColor(p, pCVar, pProp)
cVal = *pInherit;
goto setcolor_out;
}
+ if (pProp->eType == CSS_CONST__TKHTML_NO_COLOR) {
+ goto setcolor_out;
+ }
+
+ /* According to CSS2.1, a color value must be either one of the
+ * keyword colors, or a numeric color specification. We modify
+ * this slightly so that any Tk color can be used as a keyword (but
+ * not as a string).
+ */
+ if (pProp->eType == CSS_TYPE_STRING) {
+ return 1;
+ }
zColor = HtmlCssPropertyGetString(pProp);
- if (!zColor) return 1;
+ if (!zColor || !zColor[0]) return 1;
pEntry = Tcl_CreateHashEntry(&pTree->aColor, zColor, &newEntry);
if (newEntry) {
@@ -1099,8 +1304,10 @@ propertyValuesSetColor(p, pCVar, pProp)
}
setcolor_out:
- assert(cVal);
- cVal->nRef++;
+ assert(cVal || pProp->eType == CSS_CONST__TKHTML_NO_COLOR);
+ if (cVal) {
+ cVal->nRef++;
+ }
if (*pCVar) {
decrementColorRef(pTree, *pCVar);
}
@@ -1108,6 +1315,82 @@ setcolor_out:
return 0;
}
+static int
+propertyValuesSetCounterList(p, ppCL, eProp, pProp)
+ HtmlComputedValuesCreator *p;
+ HtmlCounterList **ppCL;
+ int eProp;
+ CssProperty *pProp;
+{
+ int nByte = 0;
+ int nCounter = 0;
+ int nCounter2 = 0;
+
+ int ii;
+ CssProperty **ap;
+
+ HtmlCounterList *pRet;
+ char *zOut;
+
+ /* Property should always be a list. */
+ if (pProp->eType != CSS_TYPE_LIST) return 1;
+ ap = (CssProperty **)(pProp->v.p);
+
+ /* Figure out the number of counters and the amount of space required
+ * to store everything.
+ */
+ for (ii = 0; ap[ii]; ii++) {
+ if (ap[ii]->eType == CSS_TYPE_RAW) {
+ nByte += (strlen(ap[ii]->v.zVal) + 1);
+ nCounter++;
+ } else {
+ return 1;
+ }
+ if (ap[ii + 1] && ap[ii + 1]->eType == CSS_TYPE_FLOAT) {
+ ii++;
+ }
+ }
+
+ nByte += sizeof(HtmlCounterList);
+ nByte += nCounter * (sizeof(int *) + sizeof(char *));
+
+ pRet = (HtmlCounterList *)HtmlAlloc("HtmlCounterList", nByte);
+ pRet->nRef = 0;
+ pRet->nCounter = nCounter;
+ pRet->azCounter = (char **)&pRet[1];
+ pRet->anValue = (int *)&pRet->azCounter[nCounter];
+ zOut = (char *)&pRet->anValue[nCounter];
+
+ for (ii = 0; ap[ii]; ii++) {
+ int n;
+ assert(ap[ii]->eType == CSS_TYPE_RAW);
+ n = (strlen(ap[ii]->v.zVal) + 1);
+ memcpy(zOut, ap[ii]->v.zVal, n);
+ pRet->azCounter[nCounter2] = zOut;
+ zOut += n;
+ if (ap[ii + 1] && ap[ii + 1]->eType == CSS_TYPE_FLOAT) {
+ pRet->anValue[nCounter2] = INTEGER(ap[ii + 1]->v.rVal);
+ ii++;
+ } else if (eProp == CSS_PROPERTY_COUNTER_INCREMENT) {
+ pRet->anValue[nCounter2] = 1;
+ } else {
+ pRet->anValue[nCounter2] = 0;
+ }
+ nCounter2++;
+ }
+ assert(nCounter2 == nCounter);
+
+ *ppCL = pRet;
+ return 0;
+}
+
+static void
+decrementCounterListRef(pCounterList)
+ HtmlCounterList *pCounterList;
+{
+ HtmlFree(pCounterList);
+}
+
/*
*---------------------------------------------------------------------------
*
@@ -1325,6 +1608,7 @@ propertyValuesSetImage(p, pImVar, pProp)
case CSS_TYPE_URL:
case CSS_TYPE_STRING:
+ case CSS_TYPE_RAW:
zUrl = pProp->v.zVal;
break;
@@ -1646,7 +1930,6 @@ getPrototypeCreator(pTree, pMask, piCopyBytes)
/* Initialise the CUSTOM properties. */
pValues->eVerticalAlign = CSS_CONST_BASELINE;
pValues->iLineHeight = PIXELVAL_NORMAL;
- pValues->iZIndex = PIXELVAL_AUTO;
propertyValuesSetFontSize(p, &Medium);
p->fontKey.zFontFamily = "Helvetica";
@@ -1682,6 +1965,11 @@ getPrototypeCreator(pTree, pMask, piCopyBytes)
assert(*opt);
break;
}
+ case AUTOINTEGER: {
+ /* Default is 'auto' */
+ *(int *)(values + pDef->iOffset) = PIXELVAL_AUTO;
+ break;
+ }
default: /* do nothing */
break;
}
@@ -2025,6 +2313,10 @@ HtmlComputedValuesSet(p, eProp, pProp)
p, pBVar, pDef->mask, pProp
);
}
+ case AUTOINTEGER: {
+ int *pAVar = (int*)((unsigned char*)&p->values + pDef->iOffset);
+ return propertyValuesSetAutoInteger(p, pProp, pAVar);
+ }
case CUSTOM: {
return pDef->xSet(p, pProp);
}
@@ -2033,6 +2325,11 @@ HtmlComputedValuesSet(p, eProp, pProp)
pCVar = (HtmlColor **)((char *)&p->values + pDef->iOffset);
return propertyValuesSetColor(p, pCVar, pProp);
}
+ case COUNTERLIST: {
+ HtmlCounterList **ppCL;
+ ppCL= (HtmlCounterList **)((char *)&p->values + pDef->iOffset);
+ return propertyValuesSetCounterList(p, ppCL, eProp, pProp);
+ }
case IMAGE: {
HtmlImage2 **pI2Var;
pI2Var = (HtmlImage2 **)
@@ -2132,7 +2429,6 @@ allocateNewFont(clientData)
strcpy(pFont->zFont, zTkFontName);
Tk_GetFontMetrics(tkfont, &pFont->metrics);
- pFont->ex_pixels = Tk_TextWidth(tkfont, "x", 1);
pFont->space_pixels = Tk_TextWidth(tkfont, " ", 1);
/* Set the number of pixels to be used for 1 "em" unit for this font.
@@ -2141,14 +2437,17 @@ allocateNewFont(clientData)
* new Xft fonts (Tk 8.5).
*/
pFont->em_pixels = pFont->metrics.ascent + pFont->metrics.descent;
-
if (isForceFontMetrics) {
float ratio;
Tk_FontMetrics *pMet = &pFont->metrics;
char zBuf[24];
- sprintf(zBuf, "%.3fp", fontsize);
- Tk_GetPixels(interp, tkwin, zBuf, &pFont->em_pixels);
+ if (iFontSize >= 0) {
+ sprintf(zBuf, "%.3fp", fontsize);
+ Tk_GetPixels(interp, tkwin, zBuf, &pFont->em_pixels);
+ } else {
+ pFont->em_pixels = -1 * iFontSize;
+ }
pMet->linespace = pMet->ascent + pMet->descent;
if (pFont->em_pixels < pMet->linespace) {
@@ -2159,6 +2458,17 @@ allocateNewFont(clientData)
}
}
+ /* Determine the x-height of the font. See ticket #221.
+ *
+ * The case dealing specifically with the "Ahem" font is added so
+ * that the official CSS 2.1 test suite can be more easily used to
+ * test Hv3. Ticket #221 describes this issue further.
+ */
+ pFont->ex_pixels = Tk_TextWidth(tkfont, "x", 1);
+ if (0 == stricmp("Ahem", zFamily)) {
+ pFont->ex_pixels = ((pFont->em_pixels * 4) / 5);
+ }
+
return (void *)pFont;
}
@@ -2313,12 +2623,19 @@ HtmlComputedValuesFinish(p)
*/
for (ii = 0; ii < sizeof(emexmap)/sizeof(struct EmExMap); ii++) {
struct EmExMap *pMap = &emexmap[ii];
+ int h; /* Computed value in hundrenths of pixels */
+ int *pVal = 0;
if (p->em_mask & pMap->mask) {
- int *pVal = (int *)(((unsigned char *)&p->values) + pMap->offset);
- *pVal = (*pVal * pFont->em_pixels) / 100;
+ pVal = (int *)(((unsigned char *)&p->values) + pMap->offset);
+ h = (*pVal * pFont->em_pixels);
} else if (p->ex_mask & pMap->mask) {
- int *pVal = (int *)(((unsigned char *)&p->values) + pMap->offset);
- *pVal = (*pVal * pFont->ex_pixels) / 100;
+ pVal = (int *)(((unsigned char *)&p->values) + pMap->offset);
+ h = (*pVal * pFont->ex_pixels);
+ }
+
+ if (pVal) {
+ h += ((h>0)?50:-50);
+ *pVal = h / 100;
}
}
@@ -2478,15 +2795,6 @@ HtmlComputedValuesFinish(p)
HtmlImageFree(pValues->imReplacementImage);
HtmlImageFree(pValues->imBackgroundImage);
HtmlImageFree(pValues->imListStyleImage);
- } else if (
- pValues->eBackgroundAttachment == CSS_CONST_FIXED ||
- pValues->ePosition == CSS_CONST_FIXED
- ) {
- /* If this is a new entry and the 'background-attachment' or
- * 'position' property computes to "fixed", then increment
- * HtmlTree.nFixedBackground.
- */
- p->pTree->nFixedBackground++;
}
HtmlImageCheck(pValues->imReplacementImage);
HtmlImageCheck(pValues->imBackgroundImage);
@@ -2499,6 +2807,11 @@ HtmlComputedValuesFinish(p)
pValues->imZoomedBackgroundImage = pZ;
}
+ if (p->pContent) {
+ HtmlStyleHandleCounters(p->pTree, pValues);
+ propertyValuesCalculateContent(p);
+ }
+
/* Delete any CssProperty structures allocated for Tcl properties */
if (p->pDeleteList) {
CssProperty *p1 = p->pDeleteList;
@@ -2633,13 +2946,9 @@ HtmlComputedValuesRelease(pTree, pValues)
HtmlImageFree(pValues->imBackgroundImage);
HtmlImageFree(pValues->imZoomedBackgroundImage);
HtmlImageFree(pValues->imListStyleImage);
- if (
- pValues->eBackgroundAttachment == CSS_CONST_FIXED ||
- pValues->ePosition == CSS_CONST_FIXED
- ) {
- pTree->nFixedBackground--;
- assert(pTree->nFixedBackground >= 0);
- }
+
+ decrementCounterListRef(pValues->clCounterIncrement);
+ decrementCounterListRef(pValues->clCounterReset);
if (pEntry) {
Tcl_DeleteHashEntry(pEntry);
@@ -2824,6 +3133,18 @@ HtmlFontCacheClear(pTree, isReinit)
}
}
+
+void HtmlComputedValuesFreePrototype(pTree)
+ HtmlTree *pTree;
+{
+ if (pTree->pPrototypeCreator) {
+ pTree->pPrototypeCreator->values.nRef = 1;
+ HtmlComputedValuesRelease(pTree, &pTree->pPrototypeCreator->values);
+ HtmlFree(pTree->pPrototypeCreator);
+ pTree->pPrototypeCreator = 0;
+ }
+}
+
/*
*---------------------------------------------------------------------------
*
@@ -2874,12 +3195,7 @@ HtmlComputedValuesCleanupTables(pTree)
0
};
- if (pTree->pPrototypeCreator) {
- pTree->pPrototypeCreator->values.nRef = 1;
- HtmlComputedValuesRelease(pTree, &pTree->pPrototypeCreator->values);
- HtmlFree(pTree->pPrototypeCreator);
- pTree->pPrototypeCreator = 0;
- }
+ HtmlComputedValuesFreePrototype(pTree);
for (pzCursor = azColor; *pzCursor; pzCursor++) {
HtmlColor *pColor;
@@ -2932,11 +3248,32 @@ getPropertyObj(pValues, eProp)
break;
}
+ case COUNTERLIST: {
+ HtmlCounterList *pCL = *(HtmlCounterList **)(v + pDef->iOffset);
+ if (!pCL) {
+ pValue = Tcl_NewStringObj("none", -1);
+ } else {
+ int ii;
+ pValue = Tcl_NewObj();
+ for (ii = 0; ii < pCL->nCounter; ii++) {
+ if (ii > 0) {
+ Tcl_AppendToObj(pValue, " ", -1);
+ }
+ Tcl_AppendToObj(pValue, pCL->azCounter[ii], -1);
+ Tcl_AppendToObj(pValue, " ", -1);
+ Tcl_AppendObjToObj(
+ pValue, Tcl_NewIntObj(pCL->anValue[ii])
+ );
+ }
+ }
+ break;
+ }
+
case IMAGE: {
HtmlImage2 *pImage = *(HtmlImage2 **)(v + pDef->iOffset);
if (pImage) {
/* Todo: Might be some character escapin' to do here */
- pValue = Tcl_NewStringObj("uri('", -1);
+ pValue = Tcl_NewStringObj("url('", -1);
Tcl_AppendToObj(pValue, HtmlImageUrl(pImage), -1);
Tcl_AppendToObj(pValue, "')", -1);
} else {
@@ -2976,6 +3313,16 @@ getPropertyObj(pValues, eProp)
break;
}
+ case AUTOINTEGER: {
+ int i = *(int *)(v + pDef->iOffset);
+ if (i==PIXELVAL_AUTO) {
+ pValue = Tcl_NewStringObj("auto", 4);
+ } else {
+ pValue = Tcl_NewIntObj(i);
+ }
+ break;
+ }
+
case CUSTOM: {
pValue = pDef->xObj(pValues);
break;
@@ -3065,6 +3412,7 @@ HtmlNodeProperties(interp, pValues)
return TCL_OK;
}
+#define HTML_REQUIRE_CONTENT 3
#define HTML_REQUIRE_LAYOUT 2
#define HTML_REQUIRE_PAINT 1
#define HTML_OK 0
@@ -3084,6 +3432,22 @@ HtmlComputedValuesCompare(pV1, pV2)
/*
* Check for changes in the following properties:
*
+ * 'counter-reset'
+ * 'counter-increment'
+ *
+ */
+ if (
+ (!pV1 && (pV2->clCounterIncrement || pV2->clCounterReset)) ||
+ (!pV2 && (pV1->clCounterIncrement || pV1->clCounterReset)) ||
+ (pV1 && pV2 && pV2->clCounterIncrement != pV1->clCounterIncrement) ||
+ (pV1 && pV2 && pV2->clCounterReset != pV1->clCounterReset)
+ ) {
+ return HTML_REQUIRE_CONTENT;
+ }
+
+ /*
+ * Check for changes in the following properties:
+ *
* '-tkhtml-replacement-image'
* 'list-style-image'
* 'font'
@@ -3129,7 +3493,23 @@ HtmlComputedValuesCompare(pV1, pV2)
case COLOR:
case IMAGE:
+ break;
+
+ case AUTOINTEGER: {
+ int *pI1 = (int *)(v1 + pDef->iOffset);
+ int *pI2 = (int *)(v2 + pDef->iOffset);
+ if (*pI1 != *pI2) {
+ return HTML_REQUIRE_LAYOUT;
+ }
+ break;
+ }
+
case CUSTOM:
+ /* TODO */
+ break;
+
+ case COUNTERLIST:
+ /* TODO */
break;
}
}
diff --git a/src/htmlprop.h b/src/htmlprop.h
index ce7b85b..eed25fd 100644
--- a/src/htmlprop.h
+++ b/src/htmlprop.h
@@ -23,6 +23,7 @@ typedef struct HtmlFourSides HtmlFourSides;
typedef struct HtmlComputedValues HtmlComputedValues;
typedef struct HtmlComputedValuesCreator HtmlComputedValuesCreator;
typedef struct HtmlColor HtmlColor;
+typedef struct HtmlCounterList HtmlCounterList;
typedef struct HtmlFont HtmlFont;
typedef struct HtmlFontKey HtmlFontKey;
@@ -55,7 +56,10 @@ struct HtmlFourSides {
*/
#define HTML_IFONTSIZE_SCALE 1000
struct HtmlFontKey {
+ /* If iFontSize is positive, then it is in thousandths of points.
+ * If negative, in thousandths of pixels. */
int iFontSize; /* Font size in thousandths of points */
+
const char *zFontFamily; /* Name of font family (i.e. "Serif") */
unsigned char isItalic; /* True if the font is italic */
unsigned char isBold; /* True if the font is bold */
@@ -98,6 +102,18 @@ struct HtmlColor {
};
/*
+ * An HtmlCounterList is used to store the computed value of the
+ * 'counter-increment' and 'counter-reset' properties.
+ */
+struct HtmlCounterList {
+ int nRef;
+
+ int nCounter;
+ char **azCounter;
+ int *anValue;
+};
+
+/*
* An instance of this structure stores a set of property values as assigned by
* the styler process. The values are as far as I can tell "computed" values,
* but in some cases I'm really only guessing.
@@ -252,15 +268,21 @@ struct HtmlComputedValues {
unsigned char eOverflow; /* 'overflow' */
+ int iZIndex; /* 'z-index' (integer, AUTO) */
+
/* The Tkhtml specific properties */
HtmlImage2 *imReplacementImage; /* '-tkhtml-replacement-image' */
- int iZIndex; /* 'z-index' (integer, AUTO) */
+ int iOrderedListStart; /* '-tkhtml-ordered-list-start' */
+ int iOrderedListValue; /* '-tkhtml-ordered-list-value' */
/* Properties not yet in use - TODO! */
unsigned char eUnicodeBidi; /* 'unicode-bidi' */
unsigned char eTableLayout; /* 'table-layout' */
+ HtmlCounterList *clCounterReset;
+ HtmlCounterList *clCounterIncrement;
+
/* 'font-size', 'font-family', 'font-style', 'font-weight' */
HtmlFont *fFont;
@@ -304,8 +326,10 @@ struct HtmlComputedValuesCreator {
unsigned int em_mask;
unsigned int ex_mask;
int eVerticalAlignPercent; /* True if 'vertical-align' is a % */
- char **pzContent;
CssProperty *pDeleteList;
+
+ CssProperty *pContent;
+ char **pzContent;
};
/*
@@ -432,6 +456,8 @@ void HtmlComputedValuesReference(HtmlComputedValues *);
void HtmlComputedValuesSetupTables(HtmlTree *);
void HtmlComputedValuesCleanupTables(HtmlTree *);
+void HtmlComputedValuesFreePrototype(HtmlTree *);
+
/*
* Empty the font cache (i.e. because font config options have changed).
*/
diff --git a/src/htmlsizer.c b/src/htmlsizer.c
new file mode 100644
index 0000000..9957d4e
--- /dev/null
+++ b/src/htmlsizer.c
@@ -0,0 +1,1420 @@
+static char const rcsid[] =
+ "@(#) $Id: htmlsizer.c,v 1.44 2005/03/23 01:36:54 danielk1977 Exp $";
+
+/*
+** Routines used to compute the style and size of individual elements.
+**
+** This source code is released into the public domain by the author,
+** D. Richard Hipp, on 2002 December 17. Instead of a license, here
+** is a blessing:
+**
+** May you do good and not evil.
+** May you find forgiveness for yourself and forgive others.
+** May you share freely, never taking more than you give.
+*/
+#include <tk.h>
+#include <string.h>
+#include <stdlib.h>
+#include "html.h"
+
+/*
+** Get the current rendering style. In other words, get the style
+** that is currently on the top of the style stack.
+*/
+static HtmlStyle
+GetCurrentStyle(htmlPtr)
+ HtmlWidget *htmlPtr;
+{
+ HtmlStyle style;
+ if (htmlPtr->styleStack) {
+ style = htmlPtr->styleStack->style;
+ }
+ else {
+ style.font = NormalFont(2);
+ style.color = COLOR_Normal;
+ style.bgcolor = COLOR_Background;
+ style.subscript = 0;
+ style.align = ALIGN_Left;
+ style.flags = 0;
+ style.expbg = 0;
+ }
+ return style;
+}
+
+/*
+** Push a new rendering style onto the stack.
+*/
+static void
+PushStyleStack(htmlPtr, tag, style)
+ HtmlWidget *htmlPtr; /* Widget on which to push the style */
+ int tag; /* Tag for this style. Normally the
+ * end-tag such as </h3> or </em>. */
+ HtmlStyle style; /* The style to push */
+{
+ HtmlStyleStack *p;
+
+ p = HtmlAlloc(sizeof(*p));
+ p->pNext = htmlPtr->styleStack;
+ p->type = tag;
+ p->style = style;
+ htmlPtr->styleStack = p;
+}
+
+/*
+** Pop a rendering style off of the stack.
+**
+** The top-most style on the stack should have a tag equal to "tag".
+** If not, then we have an HTML coding error. Perhaps something
+** like this: "Some text <em>Enphasized</i> more text". It is an
+** interesting problem to figure out how to respond sanely to this
+** kind of error. Our solution it to keep popping the stack until
+** we find the correct tag, or until the stack is empty.
+*/
+HtmlStyle
+HtmlPopStyleStack(htmlPtr, tag)
+ HtmlWidget *htmlPtr;
+ int tag;
+{
+ int type;
+ HtmlStyleStack *p;
+ static Html_u8 priority[Html_TypeCount + 1];
+
+ if (priority[Html_TABLE] == 0) {
+ int i;
+ for (i = 0; i <= Html_TypeCount; i++)
+ priority[i] = 1;
+ priority[Html_TD] = 2;
+ priority[Html_EndTD] = 2;
+ priority[Html_TH] = 2;
+ priority[Html_EndTH] = 2;
+ priority[Html_TR] = 3;
+ priority[Html_EndTR] = 3;
+ priority[Html_TABLE] = 4;
+ priority[Html_EndTABLE] = 4;
+ }
+ if (tag <= 0 || tag > Html_TypeCount) {
+ CANT_HAPPEN;
+ return GetCurrentStyle(htmlPtr);
+ }
+ while ((p = htmlPtr->styleStack) != 0) {
+ type = p->type;
+ if (type <= 0 || type > Html_TypeCount) {
+ CANT_HAPPEN;
+ return GetCurrentStyle(htmlPtr);
+ }
+ if (type != tag && priority[type] > priority[tag]) {
+ return GetCurrentStyle(htmlPtr);
+ }
+ htmlPtr->styleStack = p->pNext;
+ HtmlFree(p);
+ if (type == tag) {
+ break;
+ }
+ }
+ return GetCurrentStyle(htmlPtr);
+}
+
+/*
+** Change the font size on the given style by the delta-amount given
+*/
+static void
+ScaleFont(pStyle, delta)
+ HtmlStyle *pStyle;
+ int delta;
+{
+ int size = FontSize(pStyle->font) + delta;
+ if (size < 0) {
+ delta -= size;
+ }
+ else if (size > 6) {
+ delta -= size - 6;
+ }
+ pStyle->font += delta;
+}
+
+/*
+** Lookup an argument in the given markup with the name given.
+** Return a pointer to its value, or the given default
+** value if it doesn't appear.
+*/
+char *
+HtmlMarkupArg(p, tag, zDefault)
+ HtmlElement *p;
+ const char *tag;
+ char *zDefault;
+{
+ int i;
+ if (!HtmlIsMarkup(p)) {
+ return 0;
+ }
+ for (i = 0; i < p->base.count; i += 2) {
+ if (strcmp(p->markup.argv[i], tag) == 0) {
+ return p->markup.argv[i + 1];
+ }
+ }
+ return zDefault;
+}
+
+/*
+** Return an alignment or justification flag associated with the
+** given markup. The given default value is returned if no alignment is
+** specified.
+*/
+static int
+GetAlignment(p, dflt)
+ HtmlElement *p;
+ int dflt;
+{
+ char *z = HtmlMarkupArg(p, "align", 0);
+ int rc = dflt;
+ if (z) {
+ if (stricmp(z, "left") == 0) {
+ rc = ALIGN_Left;
+ }
+ else if (stricmp(z, "right") == 0) {
+ rc = ALIGN_Right;
+ }
+ else if (stricmp(z, "center") == 0) {
+ rc = ALIGN_Center;
+ }
+ }
+ return rc;
+}
+
+/*
+** The "type" argument to the given element might describe the type
+** for an ordered list. Return the corresponding LI_TYPE_* entry
+** if this is the case, or the default value if it isn't.
+*/
+static int
+GetOrderedListType(p, dflt)
+ HtmlElement *p;
+ int dflt;
+{
+ char *z;
+
+ z = HtmlMarkupArg(p, "type", 0);
+ if (z) {
+ switch (*z) {
+ case 'A':
+ dflt = LI_TYPE_Enum_A;
+ break;
+ case 'a':
+ dflt = LI_TYPE_Enum_a;
+ break;
+ case '1':
+ dflt = LI_TYPE_Enum_1;
+ break;
+ case 'I':
+ dflt = LI_TYPE_Enum_I;
+ break;
+ case 'i':
+ dflt = LI_TYPE_Enum_i;
+ break;
+ default:
+ break;
+ }
+ }
+ else {
+ }
+ return dflt;
+}
+
+/*
+** The "type" argument to the given element might describe a type
+** for an unordered list. Return the corresponding LI_TYPE entry
+** if this is the case, or the default value if it isn't.
+*/
+static int
+GetUnorderedListType(p, dflt)
+ HtmlElement *p;
+ int dflt;
+{
+ char *z;
+
+ z = HtmlMarkupArg(p, "type", 0);
+ if (z) {
+ if (stricmp(z, "disc") == 0) {
+ dflt = LI_TYPE_Bullet1;
+ }
+ else if (stricmp(z, "circle") == 0) {
+ dflt = LI_TYPE_Bullet2;
+ }
+ else if (stricmp(z, "square") == 0) {
+ dflt = LI_TYPE_Bullet3;
+ }
+ }
+ return dflt;
+}
+
+/*
+** Add the STY_Invisible style to every token between pFirst and pLast.
+*/
+static void
+MakeInvisible(pFirst, pLast)
+ HtmlElement *pFirst;
+ HtmlElement *pLast;
+{
+ if (pFirst == 0)
+ return;
+ pFirst = pFirst->pNext;
+ while (pFirst && pFirst != pLast) {
+ pFirst->base.style.flags |= STY_Invisible;
+ pFirst = pFirst->pNext;
+ }
+}
+
+/*
+** For the markup <a href=XXX>, find out if the URL has been visited
+** before or not. Return COLOR_Visited or COLOR_Unvisited, as
+** appropriate.
+**
+** This routine may invoke a callback procedure which could delete
+** the HTML widget. The calling function should call HtmlLock()
+** if it needs the widget structure to be preserved.
+*/
+static int
+GetLinkColor(htmlPtr, zURL)
+ HtmlWidget *htmlPtr;
+ char *zURL;
+{
+ char *zCmd;
+ int result;
+ int isVisited;
+
+ if (htmlPtr->tkwin == 0) {
+ return COLOR_Normal;
+ }
+ if (htmlPtr->zIsVisited == 0 || htmlPtr->zIsVisited[0] == 0) {
+ return COLOR_Unvisited;
+ }
+ zCmd = HtmlAlloc(strlen(htmlPtr->zIsVisited) + strlen(zURL) + 10);
+ if (zCmd == 0) {
+ return COLOR_Unvisited;
+ }
+ sprintf(zCmd, "%s {%s}", htmlPtr->zIsVisited, zURL);
+ HtmlLock(htmlPtr);
+ result = Tcl_GlobalEval(htmlPtr->interp, zCmd);
+ HtmlFree(zCmd);
+ if (HtmlUnlock(htmlPtr)) {
+ return COLOR_Unvisited;
+ }
+ if (result != TCL_OK) {
+ goto errorOut;
+ }
+ result = Tcl_GetBoolean(htmlPtr->interp, htmlPtr->interp->result,
+ &isVisited);
+ if (result != TCL_OK) {
+ goto errorOut;
+ }
+ return isVisited ? COLOR_Visited : COLOR_Unvisited;
+
+ errorOut:
+ Tcl_AddErrorInfo(htmlPtr->interp,
+ "\n (\"-isvisitedcommand\" command executed by html widget)");
+ Tcl_BackgroundError(htmlPtr->interp);
+ return COLOR_Unvisited;
+}
+
+static int *
+GetCoords(str, nptr)
+ char *str;
+ int *nptr;
+{
+ char *cp = str, *ncp;
+ int i, n = 0, sz = 4, *cr;
+ cr = (int *) HtmlAlloc(sz * sizeof(int));
+ while (cp) {
+ while (*cp && (!isdigit(*cp)))
+ cp++;
+ if ((!*cp) || (!isdigit(*cp)))
+ break;
+ cr[n] = (int) strtol(cp, &ncp, 10);
+ if (cp == ncp)
+ break;
+ cp = ncp;
+ n++;
+ if (n >= sz) {
+ sz += 4;
+ cr = (int *) HtmlRealloc((char *) cr, sz * sizeof(int));
+ }
+ }
+ *nptr = n;
+ return cr;
+}
+
+/*
+** This routine adds information to the input texts that doesn't change
+** when the display is resized or when new fonts are selected, etc.
+** Mostly this means adding style attributes. But other constant
+** information (such as numbering on <li> and images used for <IMG>)
+** is also obtained. The key is that this routine is only called
+** once, where the sizer and layout routines can be called many times.
+**
+** This routine is called whenever the list of elements grows. The
+** style stack is stored as part of the HTML widget so that we can
+** always continue where we left off the last time.
+**
+** In addition to adding style, this routine will invoke callbacks
+** needed to acquire information about a markup. The htmlPtr->zIsVisitied
+** callback is called for each <a> and the htmlPtr->zGetImage is called
+** for each <IMG> or for each <LI> that has a SRC= field.
+**
+** This routine may invoke a callback procedure which could delete
+** the HTML widget.
+**
+** When a markup is inserted or deleted from the token list, the
+** style routine must be completely rerun from the beginning. So
+** what we said above, that this routine is only run once, is not
+** strictly true.
+*/
+void
+HtmlAddStyle(htmlPtr, p)
+ HtmlWidget *htmlPtr;
+ HtmlElement *p;
+{
+ HtmlStyle style; /* Current style */
+ int size; /* A new font size */
+ int i; /* Loop counter */
+ int paraAlign; /* Current paragraph alignment */
+ int rowAlign; /* Current table row alignment */
+ int anchorFlags; /* Flags associated with <a> tag */
+ int inDt; /* True if within <dt>..</dt> */
+ HtmlStyle nextStyle; /* Style for next token if
+ * useNextStyle==1 */
+ int useNextStyle = 0; /* True if nextStyle is valid */
+ char *z; /* A tag parameter's value */
+
+ /*
+ * The size of header fonts relative to the current font size
+ */
+ static int header_sizes[] = { +2, +1, 1, 1, -1, -1 };
+
+ /*
+ * Don't allow recursion
+ */
+ if (htmlPtr->flags & STYLER_RUNNING) {
+ return;
+ }
+ htmlPtr->flags |= STYLER_RUNNING;
+
+ /*
+ * Load the style state out of the htmlPtr structure and into local **
+ * variables. This is purely a matter of convenience...
+ */
+ style = GetCurrentStyle(htmlPtr);
+ paraAlign = htmlPtr->paraAlignment;
+ rowAlign = htmlPtr->rowAlignment;
+ anchorFlags = htmlPtr->anchorFlags;
+ inDt = htmlPtr->inDt;
+
+ /*
+ * Loop over tokens
+ */
+ while (htmlPtr->pFirst && p) {
+ switch (p->base.type) {
+ case Html_A:
+ if (htmlPtr->anchorStart) {
+ style = HtmlPopStyleStack(htmlPtr, Html_EndA);
+ htmlPtr->anchorStart = 0;
+ anchorFlags = 0;
+ }
+ z = HtmlMarkupArg(p, "href", 0);
+ if (z) {
+ HtmlLock(htmlPtr);
+ style.color = GetLinkColor(htmlPtr, z);
+ if (htmlPtr->underlineLinks) {
+ style.flags |= STY_Underline;
+ }
+ if (HtmlUnlock(htmlPtr))
+ return;
+ anchorFlags |= STY_Anchor;
+ PushStyleStack(htmlPtr, Html_EndA, style);
+ htmlPtr->anchorStart = p;
+ }
+ break;
+ case Html_EndA:
+ if (htmlPtr->anchorStart) {
+ p->ref.pOther = htmlPtr->anchorStart;
+ style = HtmlPopStyleStack(htmlPtr, Html_EndA);
+ htmlPtr->anchorStart = 0;
+ anchorFlags = 0;
+ }
+ break;
+ case Html_MAP:
+ break;
+ case Html_EndMAP:
+ break;
+ case Html_AREA:
+ z = HtmlMarkupArg(p, "shape", 0);
+ p->area.type = MAP_RECT;
+ if (z) {
+ if (!strcasecmp(z, "circle"))
+ p->area.type = MAP_CIRCLE;
+ else if (!strcasecmp(z, "poly"))
+ p->area.type = MAP_POLY;
+ }
+ z = HtmlMarkupArg(p, "coords", 0);
+ if (z) {
+ p->area.coords = GetCoords(z, &p->area.num);
+ }
+ break;
+ case Html_ADDRESS:
+ case Html_EndADDRESS:
+ case Html_BLOCKQUOTE:
+ case Html_EndBLOCKQUOTE:
+ paraAlign = ALIGN_None;
+ break;
+ case Html_APPLET:
+ if (htmlPtr->zAppletCommand && *htmlPtr->zAppletCommand) {
+ nextStyle = style;
+ nextStyle.flags |= STY_Invisible;
+ PushStyleStack(htmlPtr, Html_EndAPPLET, nextStyle);
+ useNextStyle = 1;
+ }
+ else {
+ PushStyleStack(htmlPtr, Html_EndAPPLET, style);
+ }
+ break;
+ case Html_B:
+ style.font = BoldFont(FontSize(style.font));
+ PushStyleStack(htmlPtr, Html_EndB, style);
+ break;
+ case Html_EndAPPLET:
+ case Html_EndB:
+ case Html_EndBIG:
+ case Html_EndCENTER:
+ case Html_EndCITE:
+ case Html_EndCODE:
+ case Html_EndCOMMENT:
+ case Html_EndEM:
+ case Html_EndFONT:
+ case Html_EndI:
+ case Html_EndKBD:
+ case Html_EndMARQUEE:
+ case Html_EndNOBR:
+ case Html_EndNOFRAMES:
+ case Html_EndNOSCRIPT:
+ case Html_EndNOEMBED:
+ case Html_EndS:
+ case Html_EndSAMP:
+ case Html_EndSMALL:
+ case Html_EndSTRIKE:
+ case Html_EndSTRONG:
+ case Html_EndSUB:
+ case Html_EndSUP:
+ case Html_EndTITLE:
+ case Html_EndTT:
+ case Html_EndU:
+ case Html_EndVAR:
+ style = HtmlPopStyleStack(htmlPtr, p->base.type);
+ break;
+ case Html_BASE:
+ z = HtmlMarkupArg(p, "href", 0);
+ if (z) {
+ HtmlLock(htmlPtr);
+ z = HtmlResolveUri(htmlPtr, z);
+ if (HtmlUnlock(htmlPtr)) {
+ if (z)
+ HtmlFree(z);
+ return;
+ }
+ if (z != 0) {
+ if (htmlPtr->zBaseHref) {
+ HtmlFree(htmlPtr->zBaseHref);
+ }
+ htmlPtr->zBaseHref = z;
+ }
+ }
+ break;
+ case Html_EndDIV:
+ paraAlign = ALIGN_None;
+ style = HtmlPopStyleStack(htmlPtr, p->base.type);
+ break;
+ case Html_EndBASEFONT:
+ style = HtmlPopStyleStack(htmlPtr, Html_EndBASEFONT);
+ style.font = FontFamily(style.font) + 2;
+ break;
+ case Html_BIG:
+ ScaleFont(&style, 1);
+ PushStyleStack(htmlPtr, Html_EndBIG, style);
+ break;
+ case Html_CAPTION:
+ paraAlign = GetAlignment(p, paraAlign);
+ break;
+ case Html_EndCAPTION:
+ paraAlign = ALIGN_None;
+ break;
+ case Html_CENTER:
+ paraAlign = ALIGN_None;
+ style.align = ALIGN_Center;
+ PushStyleStack(htmlPtr, Html_EndCENTER, style);
+ break;
+ case Html_CITE:
+ PushStyleStack(htmlPtr, Html_EndCITE, style);
+ break;
+ case Html_CODE:
+ style.font = CWFont(FontSize(style.font));
+ PushStyleStack(htmlPtr, Html_EndCODE, style);
+ break;
+ case Html_COMMENT:
+ style.flags |= STY_Invisible;
+ PushStyleStack(htmlPtr, Html_EndCOMMENT, style);
+ break;
+ case Html_DD:
+ if (htmlPtr->innerList
+ && htmlPtr->innerList->base.type == Html_DL) {
+ p->ref.pOther = htmlPtr->innerList;
+ }
+ else {
+ p->ref.pOther = 0;
+ }
+ inDt = 0;
+ break;
+ case Html_DIR:
+ case Html_MENU:
+ case Html_UL:
+ p->list.pPrev = htmlPtr->innerList;
+ p->list.cnt = 0;
+ htmlPtr->innerList = p;
+ if (p->list.pPrev == 0) {
+ p->list.type = LI_TYPE_Bullet1;
+ p->list.compact = HtmlMarkupArg(p, "compact", 0) != 0;
+ }
+ else if (p->list.pPrev->list.pPrev == 0) {
+ p->list.type = LI_TYPE_Bullet2;
+ p->list.compact = 1;
+ }
+ else {
+ p->list.type = LI_TYPE_Bullet3;
+ p->list.compact = 1;
+ }
+ p->list.type = GetUnorderedListType(p, p->list.type);
+ break;
+ case Html_EndDL:
+ inDt = 0;
+ /*
+ * Fall thru into the next case
+ */
+ case Html_EndDIR:
+ case Html_EndMENU:
+ case Html_EndOL:
+ case Html_EndUL:
+ p->ref.pOther = htmlPtr->innerList;
+ if (htmlPtr->innerList) {
+ htmlPtr->innerList = htmlPtr->innerList->list.pPrev;
+ }
+ else {
+ }
+ break;
+ case Html_DIV:
+ paraAlign = ALIGN_None;
+ style.align = GetAlignment(p, style.align);
+ PushStyleStack(htmlPtr, Html_EndDIV, style);
+ break;
+ case Html_DT:
+ if (htmlPtr->innerList
+ && htmlPtr->innerList->base.type == Html_DL) {
+ p->ref.pOther = htmlPtr->innerList;
+ }
+ else {
+ p->ref.pOther = 0;
+ }
+ inDt = STY_DT;
+ break;
+ case Html_EndDD:
+ case Html_EndDT:
+ inDt = 0;
+ break;
+ case Html_DL:
+ p->list.pPrev = htmlPtr->innerList;
+ p->list.cnt = 0;
+ htmlPtr->innerList = p;
+ p->list.compact = HtmlMarkupArg(p, "compact", 0) != 0;
+ inDt = 0;
+ break;
+ case Html_EM:
+ style.font = ItalicFont(FontSize(style.font));
+ PushStyleStack(htmlPtr, Html_EndEM, style);
+ break;
+ case Html_EMBED:
+ break;
+ case Html_BASEFONT:
+ case Html_FONT:
+ z = HtmlMarkupArg(p, "size", 0);
+ if (z && (!htmlPtr->overrideFonts)) {
+ if (*z == '-') {
+ size = FontSize(style.font) - atoi(&z[1]) + 1;
+ }
+ else if (*z == '+') {
+ size = FontSize(style.font) + atoi(&z[1]);
+ }
+ else {
+ size = atoi(z);
+ }
+ if (size <= 0) {
+ size = 1;
+ }
+ if (size >= N_FONT_SIZE) {
+ size = N_FONT_SIZE - 1;
+ }
+ style.font = FontFamily(style.font) + size - 1;
+ }
+ z = HtmlMarkupArg(p, "color", 0);
+ if (z && z[0] && (!htmlPtr->overrideColors)) {
+ style.color = HtmlGetColorByName(htmlPtr, z, style.color);
+ }
+ PushStyleStack(htmlPtr,
+ p->base.type ==
+ Html_FONT ? Html_EndFONT : Html_EndBASEFONT,
+ style);
+ break;
+ case Html_FORM:{
+ char *zUrl;
+ char *zMethod;
+ Tcl_DString cmd; /* -formcommand callback */
+ int result;
+ char zToken[50];
+
+ htmlPtr->formStart = 0;
+
+/* p->form.id = 0; */
+ if (htmlPtr->zFormCommand == 0
+ || htmlPtr->zFormCommand[0] == 0) {
+ TestPoint(0);
+ break;
+ }
+ zUrl = HtmlMarkupArg(p, "action", 0);
+ if (zUrl == 0) {
+ TestPoint(0);
+ /*
+ * break;
+ */
+ zUrl = htmlPtr->zBase;
+ }
+ HtmlLock(htmlPtr);
+ zUrl = HtmlResolveUri(htmlPtr, zUrl);
+ if (HtmlUnlock(htmlPtr)) {
+ if (zUrl)
+ HtmlFree(zUrl);
+ return;
+ }
+ if (zUrl == 0)
+ zUrl = strdup("");
+ zMethod = HtmlMarkupArg(p, "method", "GET");
+ sprintf(zToken, " %d form {} ", p->form.id);
+ Tcl_DStringInit(&cmd);
+ Tcl_DStringAppend(&cmd, htmlPtr->zFormCommand, -1);
+ Tcl_DStringAppend(&cmd, zToken, -1);
+ Tcl_DStringAppendElement(&cmd, zUrl);
+ HtmlFree(zUrl);
+ Tcl_DStringAppendElement(&cmd, zMethod);
+ Tcl_DStringStartSublist(&cmd);
+ HtmlAppendArglist(&cmd, p);
+ Tcl_DStringEndSublist(&cmd);
+ HtmlLock(htmlPtr);
+ htmlPtr->inParse++;
+ result = Tcl_GlobalEval(htmlPtr->interp,
+ Tcl_DStringValue(&cmd));
+ htmlPtr->inParse--;
+ Tcl_DStringFree(&cmd);
+ if (HtmlUnlock(htmlPtr))
+ return;
+ if (result == TCL_OK) {
+ htmlPtr->formStart = p;
+ }
+ else {
+ Tcl_AddErrorInfo(htmlPtr->interp,
+ "\n (\"-formcommand\" command executed by html widget)");
+ Tcl_BackgroundError(htmlPtr->interp);
+ }
+ Tcl_ResetResult(htmlPtr->interp);
+ break;
+ }
+ case Html_EndFORM:
+ p->ref.pOther = htmlPtr->formStart;
+ if (htmlPtr->formStart)
+ htmlPtr->formStart->form.pEnd = p;
+ htmlPtr->formStart = 0;
+ break;
+ case Html_H1:
+ case Html_H2:
+ case Html_H3:
+ case Html_H4:
+ case Html_H5:
+ case Html_H6:
+ paraAlign = ALIGN_None;
+ i = (p->base.type - Html_H1) / 2 + 1;
+ if (i >= 1 && i <= 6) {
+ ScaleFont(&style, header_sizes[i - 1]);
+ }
+ style.font = BoldFont(FontSize(style.font));
+ style.align = GetAlignment(p, style.align);
+ PushStyleStack(htmlPtr, Html_EndH1, style);
+ break;
+ case Html_EndH1:
+ case Html_EndH2:
+ case Html_EndH3:
+ case Html_EndH4:
+ case Html_EndH5:
+ case Html_EndH6:
+ paraAlign = ALIGN_None;
+ style = HtmlPopStyleStack(htmlPtr, Html_EndH1);
+ break;
+ case Html_HR:
+ nextStyle = style;
+ style.align = GetAlignment(p, ALIGN_None);
+ useNextStyle = 1;
+ break;
+ case Html_I:
+ style.font = ItalicFont(FontSize(style.font));
+ PushStyleStack(htmlPtr, Html_EndI, style);
+ break;
+ case Html_IMG:
+ if (style.flags & STY_Invisible)
+ break;
+ HtmlLock(htmlPtr);
+ p->image.pImage = HtmlGetImage(htmlPtr, p);
+ if (HtmlUnlock(htmlPtr))
+ return;
+ break;
+ case Html_OPTION:
+ break;
+ case Html_INPUT:
+ p->input.pForm = htmlPtr->formStart;
+ if (htmlPtr->TclHtml)
+ HtmlControlSize(htmlPtr, p);
+ break;
+ case Html_KBD:
+ style.font = CWFont(FontSize(style.font));
+ PushStyleStack(htmlPtr, Html_EndKBD, style);
+ break;
+ case Html_LI:
+ if (htmlPtr->innerList) {
+ p->li.type = htmlPtr->innerList->list.type;
+ if (htmlPtr->innerList->base.type == Html_OL) {
+ z = HtmlMarkupArg(p, "value", 0);
+ if (z) {
+ int n = atoi(z);
+ if (n > 0) {
+ p->li.cnt = n;
+ htmlPtr->innerList->list.cnt = n + 1;
+ }
+ else {
+ }
+ }
+ else {
+ p->li.cnt = htmlPtr->innerList->list.cnt++;
+ }
+ p->li.type = GetOrderedListType(p, p->li.type);
+ }
+ else {
+ p->li.type = GetUnorderedListType(p, p->li.type);
+ }
+ }
+ else {
+ p->base.flags &= ~HTML_Visible;
+ }
+ break;
+ case Html_MARQUEE:
+ style.flags |= STY_Invisible;
+ PushStyleStack(htmlPtr, Html_EndMARQUEE, style);
+ break;
+ case Html_NOBR:
+ style.flags |= STY_NoBreak;
+ PushStyleStack(htmlPtr, Html_EndNOBR, style);
+ break;
+ case Html_NOFRAMES:
+ if (htmlPtr->zFrameCommand && *htmlPtr->zFrameCommand) {
+ nextStyle = style;
+ nextStyle.flags |= STY_Invisible;
+ PushStyleStack(htmlPtr, Html_EndNOFRAMES, nextStyle);
+ useNextStyle = 1;
+ }
+ else {
+ PushStyleStack(htmlPtr, Html_EndNOFRAMES, style);
+ }
+ break;
+ case Html_NOEMBED:
+ if (htmlPtr->zScriptCommand && *htmlPtr->zScriptCommand
+ && htmlPtr->HasScript) {
+ nextStyle = style;
+ nextStyle.flags |= STY_Invisible;
+ PushStyleStack(htmlPtr, Html_EndNOEMBED, nextStyle);
+ useNextStyle = 1;
+ }
+ else {
+ PushStyleStack(htmlPtr, Html_EndNOEMBED, style);
+ }
+ break;
+ case Html_NOSCRIPT:
+ if (htmlPtr->zScriptCommand && *htmlPtr->zScriptCommand
+ && htmlPtr->HasScript) {
+ nextStyle = style;
+ nextStyle.flags |= STY_Invisible;
+ PushStyleStack(htmlPtr, Html_EndNOSCRIPT, nextStyle);
+ useNextStyle = 1;
+ }
+ else {
+ PushStyleStack(htmlPtr, Html_EndNOSCRIPT, style);
+ }
+ break;
+ case Html_OL:
+ p->list.pPrev = htmlPtr->innerList;
+ p->list.type = GetOrderedListType(p, LI_TYPE_Enum_1);
+ p->list.cnt = 1;
+ z = HtmlMarkupArg(p, "start", 0);
+ if (z) {
+ int n = atoi(z);
+ if (n > 0) {
+ p->list.cnt = n;
+ }
+ else {
+ }
+ }
+ else {
+ }
+ p->list.compact = htmlPtr->innerList != 0 ||
+ HtmlMarkupArg(p, "compact", 0) != 0;
+ htmlPtr->innerList = p;
+ break;
+ case Html_P:
+ paraAlign = GetAlignment(p, ALIGN_None);
+ break;
+ case Html_EndP:
+ paraAlign = ALIGN_None;
+ break;
+ case Html_PRE:
+ case Html_LISTING:
+ case Html_XMP:
+ case Html_PLAINTEXT:
+ paraAlign = ALIGN_None;
+ style.font = CWFont(FontSize(style.font));
+ style.flags |= STY_Preformatted;
+ PushStyleStack(htmlPtr, Html_EndPRE, style);
+ break;
+ case Html_EndPRE:
+ case Html_EndLISTING:
+ case Html_EndXMP:
+ style = HtmlPopStyleStack(htmlPtr, Html_EndPRE);
+ break;
+ case Html_S:
+ style.flags |= STY_StrikeThru;
+ PushStyleStack(htmlPtr, Html_EndS, style);
+ break;
+ case Html_SCRIPT:
+#if 0
+ if (htmlPtr->zScriptCommand && *htmlPtr->zScriptCommand) {
+ Tcl_DString cmd;
+ char *resstr;
+ int result, reslen;
+ Tcl_DStringInit(&cmd);
+ Tcl_DStringAppend(&cmd, htmlPtr->zScriptCommand, -1);
+ Tcl_DStringStartSublist(&cmd);
+ HtmlAppendArglist(&cmd, p);
+ Tcl_DStringEndSublist(&cmd);
+ Tcl_DStringStartSublist(&cmd);
+ Tcl_DStringAppend(&cmd, p->script.zScript,
+ p->script.nScript);
+ Tcl_DStringEndSublist(&cmd);
+ HtmlLock(htmlPtr);
+ htmlPtr->inParse++;
+ result = Tcl_GlobalEval(htmlPtr->interp,
+ Tcl_DStringValue(&cmd));
+ htmlPtr->inParse--;
+ Tcl_DStringFree(&cmd);
+ if (HtmlUnlock(htmlPtr))
+ return;
+ resstr = Tcl_GetByteArrayObj(Tcl_GetObjResult
+ (htmlPtr->interp->result),
+ &reslen);
+ if (result == 0 && resstr && reslen) {
+ HtmlElement *b2 = p->pNext, *b3, *ps, *e1 = p, *e2 =
+ b2, *e3;
+ if (e2)
+ while (e2->pNext)
+ e2 = e2->pNext;
+ HtmlTokenizerAppend(htmlPtr, resstr, reslen);
+ if (e2 && e2 != p && ((e3 = b3 = e2->pNext))) {
+ while (e3->pNext)
+ e3 = e3->pNext;
+ e1->pNext = b3;
+ e2->pNext = 0;
+ b2->base.pPrev = e3;
+ e3->pNext = b2;
+ b3->base.pPrev = e1;
+ }
+ }
+ Tcl_ResetResult(htmlPtr->interp);
+ }
+#endif
+ nextStyle = style;
+ style.flags |= STY_Invisible;
+ useNextStyle = 1;
+ break;
+ case Html_SELECT:
+ p->input.pForm = htmlPtr->formStart;
+ nextStyle.flags |= STY_Invisible;
+ useNextStyle = 1;
+ PushStyleStack(htmlPtr, Html_EndSELECT, style);
+ htmlPtr->formElemStart = p;
+ break;
+ case Html_EndSELECT:
+ style = HtmlPopStyleStack(htmlPtr, Html_EndSELECT);
+ if (htmlPtr->formElemStart
+ && htmlPtr->formElemStart->base.type == Html_SELECT) {
+ p->ref.pOther = htmlPtr->formElemStart;
+ MakeInvisible(p->ref.pOther, p);
+ }
+ else {
+ p->ref.pOther = 0;
+ }
+ htmlPtr->formElemStart = 0;
+ break;
+ case Html_STRIKE:
+ style.flags |= STY_StrikeThru;
+ PushStyleStack(htmlPtr, Html_EndSTRIKE, style);
+ break;
+ case Html_STYLE:
+ /*
+ * Ignore style sheets
+ */
+ break;
+ case Html_SAMP:
+ style.font = CWFont(FontSize(style.font));
+ PushStyleStack(htmlPtr, Html_EndSAMP, style);
+ break;
+ case Html_SMALL:
+ ScaleFont(&style, -1);
+ PushStyleStack(htmlPtr, Html_EndSMALL, style);
+ break;
+ case Html_STRONG:
+ style.font = BoldFont(FontSize(style.font));
+ PushStyleStack(htmlPtr, Html_EndSTRONG, style);
+ break;
+ case Html_SUB:
+ ScaleFont(&style, -1);
+ if (style.subscript > -6) {
+ style.subscript--;
+ }
+ else {
+ }
+ PushStyleStack(htmlPtr, Html_EndSUB, style);
+ break;
+ case Html_SUP:
+ ScaleFont(&style, -1);
+ if (style.subscript < 6) {
+ style.subscript++;
+ }
+ else {
+ }
+ PushStyleStack(htmlPtr, Html_EndSUP, style);
+ break;
+ case Html_TABLE:
+ if (p->table.tktable) {
+ if (p->table.pEnd =
+ HtmlFindEndNest(htmlPtr, p, Html_EndTABLE, 0))
+ MakeInvisible(p, p->table.pEnd);
+ if (p->table.pEnd) {
+ p = p->table.pEnd;
+ break;
+ }
+ }
+ paraAlign = ALIGN_None;
+ nextStyle = style;
+ if (style.flags & STY_Preformatted) {
+ nextStyle.flags &= ~STY_Preformatted;
+ style.flags |= STY_Preformatted;
+ }
+ nextStyle.align = ALIGN_Left;
+ z = HtmlMarkupArg(p, "bgcolor", 0);
+ if (z && z[0] && (!htmlPtr->overrideColors)) {
+ style.bgcolor = nextStyle.bgcolor =
+ HtmlGetColorByName(htmlPtr, z, style.bgcolor);
+ style.expbg = 1;
+
+/* }else{
+ nextStyle.bgcolor = COLOR_Background; */
+ }
+ HtmlTableBgImage(htmlPtr, p);
+ PushStyleStack(htmlPtr, Html_EndTABLE, nextStyle);
+ useNextStyle = 1;
+ htmlPtr->inTd = 0;
+ htmlPtr->inTr = 0;
+ break;
+ case Html_EndTABLE:
+ paraAlign = ALIGN_None;
+ if (htmlPtr->inTd) {
+ style = HtmlPopStyleStack(htmlPtr, Html_EndTD);
+ htmlPtr->inTd = 0;
+ }
+ if (htmlPtr->inTr) {
+ style = HtmlPopStyleStack(htmlPtr, Html_EndTR);
+ htmlPtr->inTr = 0;
+ }
+ style = HtmlPopStyleStack(htmlPtr, p->base.type);
+ break;
+ case Html_TD:
+ if (htmlPtr->inTd) {
+ style = HtmlPopStyleStack(htmlPtr, Html_EndTD);
+ }
+ htmlPtr->inTd = 1;
+ paraAlign = GetAlignment(p, rowAlign);
+ if ((z = HtmlMarkupArg(p, "bgcolor", 0)) != 0 && z[0]
+ && (!htmlPtr->overrideColors)) {
+ style.bgcolor =
+ HtmlGetColorByName(htmlPtr, z, style.bgcolor);
+ style.expbg = 1;
+ }
+ HtmlTableBgImage(htmlPtr, p);
+ PushStyleStack(htmlPtr, Html_EndTD, style);
+ break;
+ case Html_TEXTAREA:
+ p->input.pForm = htmlPtr->formStart;
+ nextStyle = style;
+ nextStyle.flags |= STY_Invisible;
+ PushStyleStack(htmlPtr, Html_EndTEXTAREA, nextStyle);
+ htmlPtr->formElemStart = p;
+ useNextStyle = 1;
+ break;
+ case Html_EndTEXTAREA:
+ style = HtmlPopStyleStack(htmlPtr, Html_EndTEXTAREA);
+ if (htmlPtr->formElemStart
+ && htmlPtr->formElemStart->base.type == Html_TEXTAREA) {
+ p->ref.pOther = htmlPtr->formElemStart;
+ }
+ else {
+ p->ref.pOther = 0;
+ }
+ htmlPtr->formElemStart = 0;
+ break;
+ case Html_TH:
+ /*
+ * paraAlign = GetAlignment(p, rowAlign);
+ */
+ if (htmlPtr->inTd) {
+ style = HtmlPopStyleStack(htmlPtr, Html_EndTD);
+ }
+ paraAlign = GetAlignment(p, ALIGN_Center);
+ style.font = BoldFont(FontSize(style.font));
+ if ((z = HtmlMarkupArg(p, "bgcolor", 0)) != 0 && z[0]) {
+ style.bgcolor =
+ HtmlGetColorByName(htmlPtr, z, style.bgcolor);
+ style.expbg = 1;
+ }
+ HtmlTableBgImage(htmlPtr, p);
+ PushStyleStack(htmlPtr, Html_EndTD, style);
+ htmlPtr->inTd = 1;
+ break;
+ case Html_TR:
+ if (htmlPtr->inTd) {
+ style = HtmlPopStyleStack(htmlPtr, Html_EndTD);
+ htmlPtr->inTd = 0;
+ }
+ if (htmlPtr->inTr) {
+ style = HtmlPopStyleStack(htmlPtr, Html_EndTR);
+ }
+ rowAlign = GetAlignment(p, ALIGN_None);
+ if ((z = HtmlMarkupArg(p, "bgcolor", 0)) != 0 && z[0]
+ && (!htmlPtr->overrideColors)) {
+ style.bgcolor =
+ HtmlGetColorByName(htmlPtr, z, style.bgcolor);
+ style.expbg = 1;
+ }
+ HtmlTableBgImage(htmlPtr, p);
+ PushStyleStack(htmlPtr, Html_EndTR, style);
+ htmlPtr->inTr = 1;
+ break;
+ case Html_EndTR:
+ if (htmlPtr->inTd) {
+ style = HtmlPopStyleStack(htmlPtr, Html_EndTD);
+ htmlPtr->inTd = 0;
+ }
+ style = HtmlPopStyleStack(htmlPtr, Html_EndTR);
+ htmlPtr->inTr = 0;
+ paraAlign = ALIGN_None;
+ rowAlign = ALIGN_None;
+ break;
+ case Html_EndTD:
+ case Html_EndTH:
+ style = HtmlPopStyleStack(htmlPtr, Html_EndTD);
+ htmlPtr->inTd = 0;
+ paraAlign = ALIGN_None;
+ rowAlign = ALIGN_None;
+ break;
+ case Html_TITLE:
+ style.flags |= STY_Invisible;
+ PushStyleStack(htmlPtr, Html_EndTITLE, style);
+ break;
+ case Html_TT:
+ style.font = CWFont(FontSize(style.font));
+ PushStyleStack(htmlPtr, Html_EndTT, style);
+ break;
+ case Html_U:
+ style.flags |= STY_Underline;
+ PushStyleStack(htmlPtr, Html_EndU, style);
+ break;
+ case Html_VAR:
+ style.font = ItalicFont(FontSize(style.font));
+ PushStyleStack(htmlPtr, Html_EndVAR, style);
+ break;
+ default:
+ break;
+ }
+ p->base.style = style;
+ p->base.style.flags |= anchorFlags | inDt;
+ if (paraAlign != ALIGN_None) {
+ p->base.style.align = paraAlign;
+ }
+ if (useNextStyle) {
+ style = nextStyle;
+ style.expbg = 0;
+ useNextStyle = 0;
+ }
+ TRACE(HtmlTrace_Style,
+ ("Style of 0x%08x font=%02d color=%02d bg=%02d "
+ "align=%d flags=0x%04x token=%s\n",
+ (int) p, p->base.style.font, p->base.style.color,
+ p->base.style.bgcolor, p->base.style.align, p->base.style.flags,
+ HtmlTokenName(htmlPtr, p)));
+ p = p->pNext;
+ }
+
+ /*
+ * Copy state information back into the htmlPtr structure for ** safe
+ * keeping.
+ */
+ htmlPtr->paraAlignment = paraAlign;
+ htmlPtr->rowAlignment = rowAlign;
+ htmlPtr->anchorFlags = anchorFlags;
+ htmlPtr->inDt = inDt;
+ htmlPtr->flags &= ~STYLER_RUNNING;
+}
+
+void
+HtmlTableBgImage(htmlPtr, p)
+ HtmlWidget *htmlPtr;
+ HtmlElement *p;
+{
+#ifndef _TCLHTML_
+ Tcl_DString cmd;
+ int result;
+ char *z, buf[30];
+ if (htmlPtr->TclHtml)
+ return;
+ if ((!htmlPtr->zGetBGImage) || (!*htmlPtr->zGetBGImage))
+ return;
+ if (!(z = HtmlMarkupArg(p, "background", 0)))
+ return;
+ Tcl_DStringInit(&cmd);
+ Tcl_DStringAppend(&cmd, htmlPtr->zGetBGImage, -1);
+ Tcl_DStringAppend(&cmd, " ", 1);
+ Tcl_DStringAppend(&cmd, z, -1);
+ sprintf(buf, " %d", p->base.id);
+ Tcl_DStringAppend(&cmd, buf, -1);
+ HtmlLock(htmlPtr);
+ htmlPtr->inParse++;
+ result = Tcl_GlobalEval(htmlPtr->interp, Tcl_DStringValue(&cmd));
+ htmlPtr->inParse--;
+ Tcl_DStringFree(&cmd);
+ if (HtmlUnlock(htmlPtr))
+ return;
+ if (result == TCL_OK)
+ HtmlSetImageBg(htmlPtr, htmlPtr->interp, htmlPtr->interp->result, p);
+ Tcl_ResetResult(htmlPtr->interp);
+#endif
+}
+
+/*
+** Compute the size of all elements in the widget. Assume that a
+** style has already been assigned to all elements.
+**
+** Some of the elements might have already been sized. Refer to the
+** htmlPtr->lastSized and only compute sizes for elements that follow
+** this one. If htmlPtr->lastSized==0, then size everything.
+**
+** This routine only computes the sizes of individual elements. The
+** size of aggregate elements (like tables) are computed separately.
+**
+** The HTML_Visible flag is also set on every element that results
+** in ink on the page.
+**
+** This routine may invoke a callback procedure which could delete
+** the HTML widget.
+*/
+void
+HtmlSizer(htmlPtr)
+ HtmlWidget *htmlPtr;
+{
+ HtmlElement *p;
+ int iFont = -1;
+ Tk_Font font = 0;
+ int spaceWidth = 0;
+ Tk_FontMetrics fontMetrics;
+ char *z;
+ int stop = 0;
+
+ if (htmlPtr->pFirst == 0) {
+ return;
+ }
+ if (htmlPtr->lastSized == 0) {
+ p = htmlPtr->pFirst;
+ }
+ else {
+ p = htmlPtr->lastSized->pNext;
+ }
+ for (; !stop && p; p = p ? p->pNext : 0) {
+ if (p->base.style.flags & STY_Invisible) {
+ p->base.flags &= ~HTML_Visible;
+ continue;
+ }
+ if (iFont != p->base.style.font) {
+ iFont = p->base.style.font;
+ HtmlLock(htmlPtr);
+#ifndef _TCLHTML_
+ font = HtmlGetFont(htmlPtr, iFont);
+ if (HtmlUnlock(htmlPtr))
+ break;
+ Tk_GetFontMetrics(font, &fontMetrics);
+#else
+ fontMetrics.descent = 1;
+ fontMetrics.ascent = 9;
+#endif
+ spaceWidth = 0;
+ }
+ switch (p->base.type) {
+ case Html_Text:
+#ifndef _TCLHTML_
+ p->text.w = Tk_TextWidth(font, p->text.zText, p->base.count);
+ p->base.flags |= HTML_Visible;
+ p->text.descent = fontMetrics.descent;
+ p->text.ascent = fontMetrics.ascent;
+ if (spaceWidth == 0) {
+ spaceWidth = Tk_TextWidth(font, " ", 1);
+ }
+ else {
+ }
+ p->text.spaceWidth = spaceWidth;
+#else
+ p->text.w = 10;
+ p->base.flags |= HTML_Visible;
+ p->text.descent = 1;
+ p->text.ascent = 9;
+ if (spaceWidth == 0) {
+ spaceWidth = 10;
+ TestPoint(0);
+ }
+ else {
+ TestPoint(0);
+ }
+ p->text.spaceWidth = spaceWidth;
+#endif
+ break;
+ case Html_Space:
+ if (spaceWidth == 0) {
+#ifndef _TCLHTML_
+ spaceWidth = Tk_TextWidth(font, " ", 1);
+#else
+ spaceWidth = 10;
+#endif
+ }
+ p->space.w = spaceWidth;
+ p->space.descent = fontMetrics.descent;
+ p->space.ascent = fontMetrics.ascent;
+ p->base.flags &= ~HTML_Visible;
+ break;
+ case Html_TD:
+ case Html_TH:
+ z = HtmlMarkupArg(p, "rowspan", "1");
+ p->cell.rowspan = atoi(z);
+ z = HtmlMarkupArg(p, "colspan", "1");
+ p->cell.colspan = atoi(z);
+ p->base.flags |= HTML_Visible;
+ break;
+ case Html_LI:
+ p->li.descent = fontMetrics.descent;
+ p->li.ascent = fontMetrics.ascent;
+ p->base.flags |= HTML_Visible;
+ break;
+ case Html_IMG:
+#ifndef _TCLHTML_
+ z = HtmlMarkupArg(p, "usemap", 0);
+ if (z && *z == '#') {
+ p->image.pMap = HtmlGetMap(htmlPtr, z + 1);
+ }
+ else
+ p->image.pMap = 0;
+ p->base.flags |= HTML_Visible;
+ p->image.redrawNeeded = 0;
+ p->image.textAscent = fontMetrics.ascent;
+ p->image.textDescent = fontMetrics.descent;
+ p->image.align = HtmlGetImageAlignment(p);
+ if (p->image.pImage == 0) {
+ p->image.ascent = fontMetrics.ascent;
+ p->image.descent = fontMetrics.descent;
+ p->image.zAlt = HtmlMarkupArg(p, "alt", "<image>");
+ p->image.w =
+ Tk_TextWidth(font, p->image.zAlt,
+ strlen(p->image.zAlt));
+ }
+ else {
+ int w, h;
+ p->image.pNext = p->image.pImage->pList;
+ p->image.pImage->pList = p;
+ Tk_SizeOfImage(p->image.pImage->image, &w, &h);
+ p->image.h = h;
+ p->image.w = w;
+ p->image.ascent = h / 2;
+ p->image.descent = h - p->image.ascent;
+ }
+ if ((z = HtmlMarkupArg(p, "width", 0)) != 0) {
+ int w = atoi(z);
+ if (w > 0)
+ p->image.w = w;
+ }
+ if ((z = HtmlMarkupArg(p, "height", 0)) != 0) {
+ int h = atoi(z);
+ if (h > 0)
+ p->image.h = h;
+ }
+#endif /* _TCLHTML_ */
+ break;
+ case Html_TABLE:
+ if (p->table.tktable) {
+ p = p->table.pEnd;
+ break;
+ }
+ case Html_HR:
+ p->base.flags |= HTML_Visible;
+ break;
+ case Html_APPLET:
+ case Html_EMBED:
+ case Html_INPUT:
+ p->input.textAscent = fontMetrics.ascent;
+ p->input.textDescent = fontMetrics.descent;
+ stop = HtmlControlSize(htmlPtr, p);
+ break;
+ case Html_SELECT:
+ case Html_TEXTAREA:
+ p->input.textAscent = fontMetrics.ascent;
+ p->input.textDescent = fontMetrics.descent;
+ break;
+ case Html_EndSELECT:
+ case Html_EndTEXTAREA:
+ if (p->ref.pOther) {
+ p->ref.pOther->input.pEnd = p;
+ stop = HtmlControlSize(htmlPtr, p->ref.pOther);
+ }
+ break;
+ default:
+ p->base.flags &= ~HTML_Visible;
+ break;
+ }
+ }
+ if (p) {
+ htmlPtr->lastSized = p;
+ }
+ else {
+ htmlPtr->lastSized = htmlPtr->pLast;
+ }
+}
diff --git a/src/htmlstyle.c b/src/htmlstyle.c
index 9899bcf..7fed6f0 100644
--- a/src/htmlstyle.c
+++ b/src/htmlstyle.c
@@ -36,7 +36,7 @@
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
* POSSIBILITY OF SUCH DAMAGE.
*/
-static const char rcsid[] = "$Id: htmlstyle.c,v 1.57 2007/09/25 11:21:42 danielk1977 Exp $";
+static const char rcsid[] = "$Id: htmlstyle.c,v 1.61 2007/12/12 04:50:29 danielk1977 Exp $";
#include "html.h"
#include <assert.h>
@@ -483,117 +483,331 @@ styleNode(pTree, pNode, clientData)
ClientData clientData;
{
CONST char *zStyle; /* Value of "style" attribute for node */
- int trashDynamics = (int)clientData;
-
- if (!HtmlNodeIsText(pNode)) {
- HtmlElementNode *pElem = (HtmlElementNode *)pNode;
- int redrawmode = 0;
- HtmlComputedValues *pV = pElem->pPropertyValues;
- pElem->pPropertyValues = 0;
- HtmlDelStackingInfo(pTree, pElem);
-
- /* If the clientData was set to a non-zero value, then the
- * stylesheet configuration has changed. In this case we need to
- * recalculate the nodes list of dynamic conditions.
- */
- if (trashDynamics) {
- HtmlCssFreeDynamics(pElem);
+ int trashDynamics = (int)((size_t) clientData);
+
+ HtmlElementNode *pElem = (HtmlElementNode *)pNode;
+ HtmlComputedValues *pV = pElem->pPropertyValues;
+ pElem->pPropertyValues = 0;
+ HtmlDelStackingInfo(pTree, pElem);
+
+ /* If the clientData was set to a non-zero value, then the
+ * stylesheet configuration has changed. In this case we need to
+ * recalculate the nodes list of dynamic conditions.
+ */
+ if (trashDynamics) {
+ HtmlCssFreeDynamics(pElem);
+ }
+
+ /* If there is a "style" attribute on this node, parse the attribute
+ * value and put the resulting mini-stylesheet in pNode->pStyle.
+ *
+ * We assume that if the pStyle attribute is not NULL, then this node
+ * has been styled before. The stylesheet configuration may have
+ * changed since then, so we have to recalculate pNode->pProperties,
+ * but the "style" attribute is constant so pStyle is never invalid.
+ *
+ * Actually, the style attribute can be modified by the user, using
+ * the [$node attribute style "new-value"] command. In this case
+ * the style attribute is treated as a special case and the
+ * pElem->pStyle structure is invalidated/recalculated as required.
+ */
+ if (!pElem->pStyle) {
+ zStyle = HtmlNodeAttr(pNode, "style");
+ if (zStyle) {
+ HtmlCssInlineParse(pTree, -1, zStyle, &pElem->pStyle);
}
-
- /* If there is a "style" attribute on this node, parse the attribute
- * value and put the resulting mini-stylesheet in pNode->pStyle.
- *
- * We assume that if the pStyle attribute is not NULL, then this node
- * has been styled before. The stylesheet configuration may have
- * changed since then, so we have to recalculate pNode->pProperties,
- * but the "style" attribute is constant so pStyle is never invalid.
- *
- * Actually, the style attribute can be modified by the user, using
- * the [$node attribute style "new-value] command. In this case
- * the style attribute is treated as a special case and the
- * pElem->pStyle structure is invalidated/recalculated as required.
+ }
+
+ /* Recalculate the properties for this node */
+ HtmlCssStyleSheetApply(pTree, pNode);
+ HtmlComputedValuesRelease(pTree, pElem->pPreviousValues);
+ pElem->pPreviousValues = pV;
+
+ addStackingInfo(pTree, pElem);
+
+ /* Compare the new computed property set with the old. If
+ * ComputedValuesCompare() returns 0, then the properties have
+ * not changed (in any way that affects rendering). If it
+ * returns 1, then some aspect has changed that does not
+ * require a relayout (i.e. 'color', or 'text-decoration').
+ * If it returns 2, then something has changed that does require
+ * relayout (i.e. 'display', 'font-size').
+ */
+ return HtmlComputedValuesCompare(pElem->pPropertyValues, pV);
+}
+
+typedef struct StyleCounter StyleCounter;
+struct StyleCounter {
+ char *zName;
+ int iValue;
+};
+
+struct StyleApply {
+ /* Node to begin recalculating style at */
+ HtmlNode *pRestyle;
+
+ /* True if currently traversing pRestyle, or a descendent, right-sibling
+ * or descendent of a right-sibling of pRestyle.
+ */
+ int doStyle;
+
+ int doContent;
+
+ /* True if the whole tree is being restyled. */
+ int isRoot;
+
+ StyleCounter **apCounter;
+ int nCounter;
+ int nCounterAlloc;
+ int nCounterStartScope;
+
+ /* True if we have seen one or more "fixed" items */
+ int isFixed;
+};
+typedef struct StyleApply StyleApply;
+
+static void
+styleApply(pTree, pNode, p)
+ HtmlTree *pTree;
+ HtmlNode *pNode;
+ StyleApply *p;
+{
+ int i;
+ int doStyle;
+ int nCounterStartScope;
+ int redrawmode = 0;
+ HtmlElementNode *pElem = HtmlNodeAsElement(pNode);
+
+ /* Text nodes do not have an associated style. */
+ if (!pElem) return;
+
+ if (p->pRestyle == pNode) {
+ p->doStyle = 1;
+ }
+
+ if (p->doStyle) {
+ redrawmode = styleNode(pTree, pNode, (ClientData) ((size_t) p->isRoot));
+
+ /* If there has been a style-callback configured (-stylecmd option to
+ * the [nodeHandle replace] command) for this node, invoke it now.
*/
- if (!pElem->pStyle) {
- zStyle = HtmlNodeAttr(pNode, "style");
- if (zStyle) {
- HtmlCssInlineParse(pTree, -1, zStyle, &pElem->pStyle);
+ if (pElem->pReplacement && pElem->pReplacement->pStyleCmd) {
+ Tcl_Obj *pCmd = pElem->pReplacement->pStyleCmd;
+ int rc = Tcl_EvalObjEx(pTree->interp, pCmd, TCL_EVAL_GLOBAL);
+ if (rc != TCL_OK) {
+ Tcl_BackgroundError(pTree->interp);
}
}
-
- /* Recalculate the properties for this node */
- HtmlCssStyleSheetApply(pTree, pNode);
- HtmlComputedValuesRelease(pTree, pElem->pPreviousValues);
- pElem->pPreviousValues = pV;
-
- /* Compare the new computed property set with the old. If
- * ComputedValuesCompare() returns 0, then the properties have
- * not changed (in any way that affects rendering). If it
- * returns 1, then some aspect has changed that does not
- * require a relayout (i.e. 'color', or 'text-decoration').
- * If it returns 2, then something has changed that does require
- * relayout (i.e. 'display', 'font-size').
- */
- redrawmode = HtmlComputedValuesCompare(pElem->pPropertyValues, pV);
+ }
- /* Regenerate any :before and :after content */
+ HtmlStyleHandleCounters(pTree, HtmlNodeComputedValues(pNode));
+ nCounterStartScope = p->nCounterStartScope;
+ p->nCounterStartScope = p->nCounter;
+
+ if (p->doStyle || p->doContent) {
+ /* Destroy current generated content */
if (pElem->pBefore || pElem->pAfter) {
- HtmlCallbackLayout(pTree, pNode);
HtmlNodeClearGenerated(pTree, pElem);
- redrawmode = 2;
- }
- HtmlCssStyleSheetGenerated(pTree, pElem);
- if (pElem->pBefore || pElem->pAfter) {
- redrawmode = 2;
- }
-
- if (!pV || redrawmode == 2) {
- HtmlCallbackLayout(pTree, pNode);
- HtmlCallbackDamageNode(pTree, pNode);
- } else if (redrawmode == 1) {
- /* HtmlCallbackLayout(pTree, pNode); */
- HtmlCallbackDamageNode(pTree, pNode);
- }
-
- /* If this element was either the <body> or <html> nodes,
- * go ahead and repaint the entire display. The worst that
- * can happen is that we have to paint a little extra
- * area if the document background is set by the <HTML>
- * element.
- */
- if (redrawmode && (
- (HtmlNode *)pElem == pTree->pRoot ||
- (HtmlNode *)pElem == HtmlNodeChild(pTree->pRoot, 1)
- )
- ) {
- HtmlCallbackDamage(pTree, 0, 0, 1000000, 1000000);
+ redrawmode = MAX(redrawmode, 2);
}
- addStackingInfo(pTree, pElem);
-
+ /* Generate :before content */
+ HtmlCssStyleGenerateContent(pTree, pElem, 1);
if (pElem->pBefore) {
((HtmlElementNode *)(pElem->pBefore))->pStack = pElem->pStack;
pElem->pBefore->pParent = pNode;
pElem->pBefore->iNode = -1;
}
+ } else if (pElem->pBefore) {
+ HtmlStyleHandleCounters(pTree, HtmlNodeComputedValues(pElem->pBefore));
+ }
+
+ doStyle = p->doStyle;
+ for (i = 0; i < HtmlNodeNumChildren(pNode); i++) {
+ styleApply(pTree, HtmlNodeChild(pNode, i), p);
+ }
+ p->doStyle = doStyle;
+
+ if (p->doStyle || p->doContent) {
+ /* Generate :after content */
+ HtmlCssStyleGenerateContent(pTree, pElem, 0);
if (pElem->pAfter) {
((HtmlElementNode *)(pElem->pAfter))->pStack = pElem->pStack;
pElem->pAfter->pParent = pNode;
pElem->pAfter->iNode = -1;
}
- /* If there has been a style-callback configured (-stylecmd option to
- * the [nodeHandle replace] command) for this node, invoke it now.
- */
- if (pElem->pReplacement && pElem->pReplacement->pStyleCmd) {
- Tcl_Obj *pCmd = pElem->pReplacement->pStyleCmd;
- int rc = Tcl_EvalObjEx(pTree->interp, pCmd, TCL_EVAL_GLOBAL);
- if (rc != TCL_OK) {
- Tcl_BackgroundError(pTree->interp);
+ if (pElem->pBefore || pElem->pAfter) {
+ redrawmode = MAX(redrawmode, 2);
+ }
+ } else if(pElem->pAfter) {
+ HtmlStyleHandleCounters(pTree, HtmlNodeComputedValues(pElem->pAfter));
+ }
+
+ for (i = p->nCounterStartScope; i < p->nCounter; i++) {
+ HtmlFree(p->apCounter[i]);
+ }
+ p->nCounter = p->nCounterStartScope;
+ p->nCounterStartScope = nCounterStartScope;
+
+ if (redrawmode == 3) {
+ HtmlCallbackLayout(pTree, pNode);
+ HtmlCallbackDamageNode(pTree, pNode);
+ p->doContent = 1;
+ } else if (redrawmode == 2) {
+ HtmlCallbackLayout(pTree, pNode);
+ HtmlCallbackDamageNode(pTree, pNode);
+ } else if (redrawmode == 1) {
+ /* HtmlCallbackLayout(pTree, pNode); */
+ HtmlCallbackDamageNode(pTree, pNode);
+ }
+
+ /* If this element was either the <body> or <html> nodes,
+ * go ahead and repaint the entire display. The worst that
+ * can happen is that we have to paint a little extra
+ * area if the document background is set by the <HTML>
+ * element.
+ */
+ if (redrawmode && (
+ (HtmlNode *)pElem == pTree->pRoot ||
+ (HtmlNode *)pElem == HtmlNodeChild(pTree->pRoot, 1)
+ )
+ ) {
+ HtmlCallbackDamage(pTree, 0, 0, 1000000, 1000000);
+ }
+
+ if (pElem->pPropertyValues->eDisplay != CSS_CONST_NONE && (
+ pElem->pPropertyValues->ePosition == CSS_CONST_FIXED ||
+ pElem->pPropertyValues->eBackgroundAttachment == CSS_CONST_FIXED
+ )) {
+ p->isFixed = 1;
+ }
+}
+
+static void addCounterEntry(p, zName, iValue)
+ StyleApply *p;
+ const char *zName;
+ int iValue;
+{
+ StyleCounter *pCounter;
+
+ int n;
+ if (p->nCounterAlloc < (p->nCounter + 1)) {
+ int nByte;
+ p->nCounterAlloc += 10;
+ nByte = p->nCounterAlloc * sizeof(HtmlCounterList *);
+ p->apCounter = (StyleCounter **)HtmlRealloc(
+ "apCounter", p->apCounter, nByte
+ );
+ }
+
+ n = sizeof(StyleCounter) + strlen(zName) + 1;
+ pCounter = (StyleCounter *)HtmlAlloc("StyleCounter", n);
+ pCounter->zName = (char *)&pCounter[1];
+ strcpy(pCounter->zName, zName);
+ pCounter->iValue = iValue;
+ p->apCounter[p->nCounter] = pCounter;
+ p->nCounter++;
+}
+
+void
+HtmlStyleHandleCounters(pTree, pComputed)
+ HtmlTree *pTree;
+ HtmlComputedValues *pComputed;
+{
+ StyleApply *p = (StyleApply *)pTree->pStyleApply;
+
+ HtmlCounterList *pReset = pComputed->clCounterReset;
+ HtmlCounterList *pIncr = pComputed->clCounterIncrement;
+
+
+ /* Section 12.4.3 of CSS 2.1: Elements with "display:none" neither
+ * increment or reset counters.
+ */
+ if (pComputed->eDisplay == CSS_CONST_NONE) {
+ return;
+ }
+
+ if (pReset) {
+ int ii;
+
+ for (ii = 0; ii < pReset->nCounter; ii++) {
+ StyleCounter *pCounter = 0;
+ int jj;
+ for (jj = p->nCounterStartScope; jj < p->nCounter; jj++) {
+ if (!strcmp(pReset->azCounter[ii], p->apCounter[jj]->zName)) {
+ pCounter = p->apCounter[jj];
+ pCounter->iValue = pReset->anValue[ii];
+ break;
+ }
+ }
+ if (pCounter == 0) {
+ addCounterEntry(p, pReset->azCounter[ii], pReset->anValue[ii]);
}
}
}
- return HTML_WALK_DESCEND;
+ if (pIncr) {
+ int ii;
+ for (ii = 0; ii < pIncr->nCounter; ii++) {
+ int jj;
+ for (jj = p->nCounter - 1; jj >= 0; jj--) {
+ if (0 == strcmp(pIncr->azCounter[ii],p->apCounter[jj]->zName)) {
+ p->apCounter[jj]->iValue += pIncr->anValue[ii];
+ break;
+ }
+ }
+
+ if (jj < 0) {
+ /* No counter with the specified name is found. Act as if
+ * there is a 'counter-reset: zName iValue' directive.
+ */
+ addCounterEntry(p, pIncr->azCounter[ii], pIncr->anValue[ii]);
+ }
+ }
+ }
+}
+
+int HtmlStyleCounters(pTree, zName, aValue, nValue)
+ HtmlTree *pTree;
+ const char *zName;
+ int *aValue;
+ int nValue;
+{
+ int ii;
+ StyleApply *p = (StyleApply *)(pTree->pStyleApply);
+
+ int n = 0;
+
+ for (ii = 0; ii < p->nCounter && n < nValue; ii++) {
+ if (0 == strcmp(zName, p->apCounter[ii]->zName)) {
+ aValue[n] = p->apCounter[ii]->iValue;
+ n++;
+ }
+ }
+
+ if (n == 0) {
+ n = 1;
+ aValue[0] = 0;
+ }
+
+ return n;
+}
+
+int HtmlStyleCounter(pTree, zName)
+ HtmlTree *pTree;
+ const char *zName;
+{
+ int ii;
+ StyleApply *p = (StyleApply *)(pTree->pStyleApply);
+
+ for (ii = p->nCounter - 1; ii >= 0; ii--) {
+ if (0 == strcmp(zName, p->apCounter[ii]->zName)) {
+ return p->apCounter[ii]->iValue;
+ }
+ }
+
+ return 0;
}
/*
@@ -614,9 +828,20 @@ HtmlStyleApply(pTree, pNode)
HtmlTree *pTree;
HtmlNode *pNode;
{
+ StyleApply sApply;
int isRoot = ((pNode == pTree->pRoot) ? 1 : 0);
HtmlLog(pTree, "STYLEENGINE", "START");
- HtmlWalkTree(pTree, pNode, styleNode, (ClientData)isRoot);
+
+ memset(&sApply, 0, sizeof(StyleApply));
+ sApply.pRestyle = pNode;
+ sApply.isRoot = isRoot;
+
+ assert(pTree->pStyleApply == 0);
+ pTree->pStyleApply = (void *)&sApply;
+ styleApply(pTree, pTree->pRoot, &sApply);
+ pTree->pStyleApply = 0;
+ pTree->isFixed = sApply.isFixed;
+ HtmlFree(sApply.apCounter);
return TCL_OK;
}
diff --git a/src/htmltable.c b/src/htmltable.c
index 47ff55a..1520de6 100644
--- a/src/htmltable.c
+++ b/src/htmltable.c
@@ -34,7 +34,7 @@
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
* POSSIBILITY OF SUCH DAMAGE.
*/
-static const char rcsid[] = "$Id: htmltable.c,v 1.122 2007/09/15 07:59:12 danielk1977 Exp $";
+static const char rcsid[] = "$Id: htmltable.c,v 1.124 2007/11/03 11:23:16 danielk1977 Exp $";
#include "htmllayout.h"
@@ -278,7 +278,7 @@ tableColWidthSingleSpan(pNode, col, colspan, row, rowspan, pContext)
} else if (pV->iWidth >= 0) {
/* There is a pixel value for the 'width' property */
- int val = pV->iWidth;
+ int val = pV->iWidth + box.iLeft + box.iRight;
switch (aReq[col].eType) {
case CELL_WIDTH_AUTO:
case CELL_WIDTH_PIXELS:
@@ -1126,11 +1126,8 @@ rowIterate(pTree, pNode, p)
HtmlNode *pCell = HtmlNodeChild(pNode, ii);
HtmlComputedValues *pV = HtmlNodeComputedValues(pCell);
- /* Throw away text node children of the row node. Todo: Only
- * white-space should be thrown away, Html_Text nodes should have
- * implicit table-cell boxes created around them.
- */
- if (HtmlNodeIsText(pCell)) continue;
+ /* Throw away white-space children of the row node. */
+ if (HtmlNodeIsWhitespace(pCell)) continue;
if (DISPLAY(pV) == CSS_CONST_TABLE_CELL) {
/* Child has "display:table-cell". Good. */
diff --git a/src/htmltagdb.c b/src/htmltagdb.c
index 48ee975..12f03d1 100644
--- a/src/htmltagdb.c
+++ b/src/htmltagdb.c
@@ -37,11 +37,12 @@
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
* POSSIBILITY OF SUCH DAMAGE.
*/
-static const char rcsid[] = "$Id: htmltagdb.c,v 1.10 2006/07/14 13:37:56 danielk1977 Exp $";
+static const char rcsid[] = "$Id: htmltagdb.c,v 1.11 2007/11/11 11:00:48 danielk1977 Exp $";
#include "html.h"
#include <assert.h>
#include <string.h>
+#include <ctype.h>
/*
* Public interface to code in this file:
@@ -53,6 +54,57 @@ static const char rcsid[] = "$Id: htmltagdb.c,v 1.10 2006/07/14 13:37:56 danielk
extern HtmlTokenMap HtmlMarkupMap[];
+
+/* The hash table for HTML markup names.
+**
+** If an HTML markup name hashes to H, then apMap[H] will point to
+** a linked list of sgMap structure, one of which will describe the
+** the particular markup (if it exists.)
+*/
+static HtmlTokenMap *apMap[HTML_MARKUP_HASH_SIZE];
+
+/* Hash a markup name
+**
+** HTML markup is case insensitive, so this function will give the
+** same hash regardless of the case of the markup name.
+**
+** The value returned is an integer between 0 and HTML_MARKUP_HASH_SIZE-1,
+** inclusive.
+*/
+static int
+HtmlHash(htmlPtr, zName)
+ void *htmlPtr;
+ const char *zName;
+{
+ int h = 0;
+ char c;
+ while ((c = *zName) != 0) {
+ if (isupper(c)) {
+ c = tolower(c);
+ }
+ h = h << 5 ^ h ^ c;
+ zName++;
+ }
+ if (h < 0) {
+ h = -h;
+ }
+ return h % HTML_MARKUP_HASH_SIZE;
+}
+
+/*
+** Convert a string to all lower-case letters.
+*/
+static void
+ToLower(z)
+ char *z;
+{
+ while (*z) {
+ if (isupper(*z))
+ *z = tolower(*z);
+ z++;
+ }
+}
+
static int
textContent(pTree, pNode, tag)
HtmlTree *pTree;
@@ -91,11 +143,12 @@ HtmlMarkup(markup)
0
};
return &textmapentry;
- } else {
+ } else if (markup > 0) {
int i = markup-Html_A;
- assert(i>=0 && i<HTML_MARKUP_COUNT);
+ assert(i<HTML_MARKUP_COUNT);
return &HtmlMarkupMap[i];
}
+ return 0;
}
/*
@@ -158,3 +211,149 @@ HtmlMarkupName(markup)
return "unknown";
}
+
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * HtmlHashLookup --
+ *
+ * Look up an HTML tag name in the hash-table.
+ *
+ * Results:
+ * Return the corresponding HtmlTokenMap if the tag name is recognized,
+ * or NULL otherwise.
+ *
+ * Side effects:
+ * May initialise the hash table from the autogenerated array
+ * in htmltokens.c (generated from tokenlist.txt).
+ *
+ *---------------------------------------------------------------------------
+ */
+HtmlTokenMap *
+HtmlHashLookup(htmlPtr, zType)
+ void *htmlPtr;
+ const char *zType; /* Null terminated tag name. eg. "br" */
+{
+ HtmlTokenMap *pMap; /* For searching the markup name hash table */
+ int h; /* The hash on zType */
+ char buf[256];
+ HtmlHashInit(htmlPtr, 0);
+
+ h = HtmlHash(htmlPtr, zType);
+ for (pMap = apMap[h]; pMap; pMap = pMap->pCollide) {
+ if (stricmp(pMap->zName, zType) == 0) {
+ return pMap;
+ }
+ }
+ strncpy(buf, zType, 255);
+ buf[255] = 0;
+
+ return NULL;
+}
+
+/* Initialize the escape sequence hash table
+*/
+void
+HtmlHashInit(htmlPtr, start)
+ void *htmlPtr;
+ int start;
+{
+ static int isInit = 0;
+
+ int i; /* For looping thru the list of markup names */
+ int h; /* The hash on a markup name */
+
+ if (isInit) return;
+
+ for (i = start; i < HTML_MARKUP_COUNT; i++) {
+ h = HtmlHash(htmlPtr, HtmlMarkupMap[i].zName);
+ HtmlMarkupMap[i].pCollide = apMap[h];
+ apMap[h] = &HtmlMarkupMap[i];
+ }
+#ifdef TEST
+ HtmlHashStats(htmlPtr);
+#endif
+
+ isInit = 1;
+}
+
+
+HtmlAttributes *
+HtmlAttributesNew(argc, argv, arglen, doEscape)
+ int argc;
+ char const **argv;
+ int *arglen;
+ int doEscape;
+{
+ HtmlAttributes *pMarkup = 0;
+
+ if (argc > 1) {
+ int nByte;
+ int j;
+ char *zBuf;
+
+ int nAttr = argc / 2;
+
+ nByte = sizeof(HtmlAttributes);
+ for (j = 0; j < argc; j++) {
+ nByte += arglen[j] + 1;
+ }
+ nByte += sizeof(struct HtmlAttribute) * (argc - 1);
+
+ pMarkup = (HtmlAttributes *)HtmlAlloc("HtmlAttributes", nByte);
+ pMarkup->nAttr = nAttr;
+ zBuf = (char *)(&pMarkup->a[nAttr]);
+
+ for (j=0; j < nAttr; j++) {
+ int idx = (j * 2);
+
+ pMarkup->a[j].zName = zBuf;
+ memcpy(zBuf, argv[idx], arglen[idx]);
+ zBuf[arglen[idx]] = '\0';
+ if (doEscape) {
+ HtmlTranslateEscapes(zBuf);
+ ToLower(zBuf);
+ }
+ zBuf += (arglen[idx] + 1);
+
+ pMarkup->a[j].zValue = zBuf;
+ memcpy(zBuf, argv[idx+1], arglen[idx+1]);
+ zBuf[arglen[idx+1]] = '\0';
+ if (doEscape) HtmlTranslateEscapes(zBuf);
+ zBuf += (arglen[idx+1] + 1);
+ }
+ }
+
+ return pMarkup;
+}
+
+/*
+** Convert a markup name into a type integer
+*/
+int
+HtmlNameToType(htmlPtr, zType)
+ void *htmlPtr;
+ char *zType;
+{
+ HtmlTokenMap *pMap = HtmlHashLookup(htmlPtr, zType);
+ return pMap ? pMap->type : Html_Unknown;
+}
+
+/*
+** Convert a type into a symbolic name
+*/
+const char *
+HtmlTypeToName(htmlPtr, eTag)
+ void *htmlPtr;
+ int eTag;
+{
+ if (eTag >= Html_A && eTag < Html_TypeCount) {
+ HtmlTokenMap *pMap = &HtmlMarkupMap[eTag - Html_A];
+ return pMap->zName;
+ }
+ else {
+ return "???";
+ }
+}
+
diff --git a/src/htmltcl.c b/src/htmltcl.c
index 9c7c70b..055213e 100644
--- a/src/htmltcl.c
+++ b/src/htmltcl.c
@@ -30,7 +30,7 @@
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
* POSSIBILITY OF SUCH DAMAGE.
*/
-static char const rcsid[] = "@(#) $Id: htmltcl.c,v 1.191 2007/10/03 10:06:38 danielk1977 Exp $";
+static char const rcsid[] = "@(#) $Id: htmltcl.c,v 1.207 2008/01/16 06:29:27 danielk1977 Exp $";
#include <ctype.h>
#include <stdlib.h>
@@ -40,6 +40,7 @@ static char const rcsid[] = "@(#) $Id: htmltcl.c,v 1.191 2007/10/03 10:06:38 dan
#include <errno.h>
#include <assert.h>
#include "html.h"
+#include "restrack.h"
#include "swproc.h"
#include <time.h>
@@ -53,6 +54,21 @@ static char const rcsid[] = "@(#) $Id: htmltcl.c,v 1.191 2007/10/03 10:06:38 dan
return TCL_ERROR; \
}
+/* We need to get at the TkBindEventProc() function, which is in the
+ * internal stubs table for Tk. So create this structure and hope that
+ * it is compatible enough.
+ */
+struct MyTkIntStubs {
+ int magic;
+ void *hooks;
+ void (*zero)(void);
+ void (*one)(void);
+ void (*two)(void);
+ void (*three)(void);
+ void (*tkBindEventProc)(Tk_Window winPtr, XEvent *eventPtr); /* 4 */
+};
+extern struct MyTkIntStubs *tkIntStubsPtr;
+
#ifndef NDEBUG
static int
allocCmd(clientData, interp, objc, objv)
@@ -219,7 +235,7 @@ doLoadDefaultStyle(pTree)
Tcl_Obj *pId = Tcl_NewStringObj("agent", 5);
assert(pObj);
Tcl_IncrRefCount(pId);
- HtmlStyleParse(pTree, pTree->interp, pObj, pId, 0, 0);
+ HtmlStyleParse(pTree, pObj, pId, 0, 0, 0);
Tcl_DecrRefCount(pId);
}
@@ -304,6 +320,8 @@ doScrollCallback(pTree)
int iTotal;
int iPage;
+ if (!Tk_IsMapped(win)) return;
+
pScrollCommand = pTree->options.yscrollcommand;
iOffScreen = pTree->iScrollY;
iTotal = pTree->canvas.bottom;
@@ -407,24 +425,13 @@ INSTRUMENTED(runDynamicStyleEngine, HTML_INSTRUMENT_DYNAMIC_STYLE_ENGINE)
INSTRUMENTED(runStyleEngine, HTML_INSTRUMENT_STYLE_ENGINE)
{
HtmlTree *pTree = (HtmlTree *)clientData;
- HtmlNode *pParent = HtmlNodeParent(pTree->cb.pRestyle);
HtmlNode *pRestyle = pTree->cb.pRestyle;
pTree->cb.pRestyle = 0;
assert(pTree->cb.pSnapshot);
assert(pRestyle);
- if (pParent) {
- int i;
- int nChild = HtmlNodeNumChildren(pParent);
- assert(HtmlNodeComputedValues(pParent));
- for (i = 0; HtmlNodeChild(pParent, i) != pRestyle; i++);
- for ( ; i < nChild; i++) {
- HtmlStyleApply(pTree, HtmlNodeChild(pParent, i));
- }
- } else {
- HtmlStyleApply(pTree, pRestyle);
- }
+ HtmlStyleApply(pTree, pRestyle);
HtmlRestackNodes(pTree);
HtmlCheckRestylePoint(pTree);
@@ -440,6 +447,8 @@ INSTRUMENTED(runLayoutEngine, HTML_INSTRUMENT_LAYOUT_ENGINE)
assert(pTree->cb.pSnapshot);
+ if (!pTree->options.enablelayout) return;
+
pD = pTree->cb.pDamage;
HtmlLayout(pTree);
if (0 && pTree->cb.isForce) {
@@ -584,8 +593,8 @@ INSTRUMENTED(callbackHandler, HTML_INSTRUMENT_CALLBACK)
/* If the HTML_SCROLL flag is set, scroll the viewport. */
if (pTree->cb.flags & HTML_SCROLL) {
clock_t scrollClock = 0;
- HtmlLog(pTree, "ACTION", "SetViewport: x=%d y=%d force=%d nFixed=%d",
- p->iScrollX, p->iScrollY, force_redraw, pTree->nFixedBackground
+ HtmlLog(pTree, "ACTION", "SetViewport: x=%d y=%d force=%d isFixed=%d",
+ p->iScrollX, p->iScrollY, force_redraw, pTree->isFixed
);
scrollClock = clock();
HtmlWidgetSetViewport(pTree, p->iScrollX, p->iScrollY, 0);
@@ -1089,6 +1098,9 @@ deleteWidget(clientData)
HtmlFree(pDamage);
}
+ /* Atoms table */
+ Tcl_DeleteHashTable(&pTree->aAtom);
+
/* Delete the structure itself */
HtmlFree(pTree);
}
@@ -1215,8 +1227,7 @@ docwinEventHandler(clientData, pEvent)
pEvent->xmotion.window = Tk_WindowId(pTree->tkwin);
pEvent->xmotion.x += Tk_X(pTree->docwin);
pEvent->xmotion.y += Tk_Y(pTree->docwin);
- Tk_HandleEvent(pEvent);
-
+ tkIntStubsPtr->tkBindEventProc(pTree->tkwin, pEvent);
pEvent->type = EnterNotify;
pEvent->xcrossing.detail = NotifyInferior;
break;
@@ -1287,6 +1298,8 @@ configureCmd(clientData, interp, objc, objv)
Tcl_Obj *const *objv; /* List of all arguments */
{
static const char *azModes[] = {"quirks","almost standards","standards",0};
+ static const char *azParseModes[] = {"html","xhtml","xml",0};
+
/*
* Mask bits for options declared in htmlOptionSpec.
*/
@@ -1310,9 +1323,9 @@ configureCmd(clientData, interp, objc, objv)
#define STRING(v, s1, s2, s3) \
{TK_OPTION_STRING, "-" #v, s1, s2, s3, \
Tk_Offset(HtmlOptions, v), -1, TK_OPTION_NULL_OK, 0, 0}
- #define XCOLOR(v, s1, s2, s3) \
- {TK_OPTION_COLOR, "-" #v, s1, s2, s3, -1, \
- Tk_Offset(HtmlOptions, v), 0, 0, 0}
+ #define STRINGT(v, s1, s2, s3, t) \
+ {TK_OPTION_STRING_TABLE, "-" #v, s1, s2, s3, -1, \
+ Tk_Offset(HtmlOptions, v), 0, (ClientData)t, 0}
#define BOOLEAN(v, s1, s2, s3, flags) \
{TK_OPTION_BOOLEAN, "-" #v, s1, s2, s3, -1, \
Tk_Offset(HtmlOptions, v), 0, 0, flags}
@@ -1326,47 +1339,38 @@ configureCmd(clientData, interp, objc, objv)
/* Option table definition for the html widget. */
static Tk_OptionSpec htmlOptionSpec[] = {
- /* Standard geometry interface */
- GEOMETRY(height, "height", "Height", "600"),
- GEOMETRY(width, "width", "Width", "800"),
-
-BOOLEAN(shrink, "shrink", "Shrink", "0", S_MASK),
-BOOLEAN(layoutcache, "layoutCache", "LayoutCache", "1", S_MASK),
-BOOLEAN(forcefontmetrics, "forceFontMetrics", "ForceFontMetrics", "1", F_MASK),
-BOOLEAN(forcewidth, "forceWidth", "ForceWidth", "0", L_MASK),
-
- BOOLEAN(xhtml, "xhtml", "xhtml", "0", 0),
-
- DOUBLE(fontscale, "fontScale", "FontScale", "1.0", F_MASK),
- DOUBLE(zoom, "zoom", "Zoom", "1.0", F_MASK),
+/* Standard geometry and scrolling interface - same as canvas, text */
+GEOMETRY(height, "height", "Height", "600"),
+GEOMETRY(width, "width", "Width", "800"),
+PIXELS (yscrollincrement, "yScrollIncrement", "ScrollIncrement", "20"),
+PIXELS (xscrollincrement, "xScrollIncrement", "ScrollIncrement", "20"),
+STRING (xscrollcommand, "xScrollCommand", "ScrollCommand", ""),
+STRING (yscrollcommand, "yScrollCommand", "ScrollCommand", ""),
+
+/* Non-debugging, non-standard options in alphabetical order. */
+OBJ (defaultstyle, "defaultStyle", "DefaultStyle", HTML_DEFAULT_CSS, 0),
+DOUBLE (fontscale, "fontScale", "FontScale", "1.0", F_MASK),
+OBJ (fonttable, "fontTable", "FontTable", "8 9 10 11 13 15 17", FT_MASK),
+BOOLEAN (forcefontmetrics, "forceFontMetrics", "ForceFontMetrics", "1", F_MASK),
+BOOLEAN (forcewidth, "forceWidth", "ForceWidth", "0", L_MASK),
+BOOLEAN (imagecache, "imageCache", "ImageCache", "1", S_MASK),
+BOOLEAN (imagepixmapify, "imagePixmapify", "ImagePixmapify", "0", 0),
+STRING (imagecmd, "imageCmd", "ImageCmd", ""),
+STRINGT (mode, "mode", "Mode", "standards", azModes),
+STRINGT (parsemode, "parsemode", "Parsemode", "html", azParseModes),
+BOOLEAN (shrink, "shrink", "Shrink", "0", S_MASK),
+DOUBLE (zoom, "zoom", "Zoom", "1.0", F_MASK),
+
+/* Debugging options */
+BOOLEAN (enablelayout, "enableLayout", "EnableLayout", "1", S_MASK),
+BOOLEAN (layoutcache, "layoutCache", "LayoutCache", "1", L_MASK),
+STRING (logcmd, "logCmd", "LogCmd", ""),
+STRING (timercmd, "timerCmd", "TimerCmd", ""),
- /* Standard scroll interface - same as canvas, text */
- PIXELS(yscrollincrement, "yScrollIncrement", "ScrollIncrement", "20"),
- PIXELS(xscrollincrement, "xScrollIncrement", "ScrollIncrement", "20"),
- STRING(xscrollcommand, "xScrollCommand", "ScrollCommand", ""),
- STRING(yscrollcommand, "yScrollCommand", "ScrollCommand", ""),
-
- /* Non-debugging widget specific options */
- OBJ(defaultstyle, "defaultStyle", "DefaultStyle",
- HTML_DEFAULT_CSS, 0),
- STRING(imagecmd, "imageCmd", "ImageCmd", ""),
- BOOLEAN(imagecache, "imageCache", "ImageCache", "1", S_MASK),
-
- /* Options for logging info to debugging scripts */
- STRING(logcmd, "logCmd", "LogCmd", ""),
- STRING(timercmd, "timerCmd", "TimerCmd", ""),
-
- OBJ(fonttable, "fontTable", "FontTable", "8 9 10 11 13 15 17", FT_MASK),
-
- {TK_OPTION_STRING_TABLE, "-mode", "mode", "Mode", "standards",
- -1, Tk_Offset(HtmlOptions, mode), 0, (ClientData)azModes, 0
- },
-
{TK_OPTION_END, 0, 0, 0, 0, 0, 0, 0, 0}
};
#undef PIXELS
#undef STRING
- #undef XCOLOR
#undef BOOLEAN
HtmlTree *pTree = (HtmlTree *)clientData;
@@ -1425,6 +1429,7 @@ BOOLEAN(forcewidth, "forceWidth", "ForceWidth", "0", L_MASK),
} else {
memcpy(pTree->aFontSizeTable, aFontSize, sizeof(aFontSize));
mask |= S_MASK;
+ HtmlComputedValuesFreePrototype(pTree);
}
}
@@ -1849,6 +1854,8 @@ viewCommon(pTree, isXview, objc, objv)
int count;
int iNewVal = 0; /* New value of iScrollY or iScrollX */
+ HtmlCallbackForce(pTree);
+
/* The [widget yview] command also supports "scroll-to-node" */
if (!isXview && objc == 3) {
const char *zCmd = Tcl_GetString(objv[2]);
@@ -2112,12 +2119,12 @@ handlerCmd(clientData, interp, objc, objv)
pScript = objv[4];
if (Tcl_GetCharLength(pScript) == 0) {
- pEntry = Tcl_FindHashEntry(pHash, (char *)tag);
+ pEntry = Tcl_FindHashEntry(pHash, (char *)((size_t) tag));
if (pEntry) {
Tcl_DeleteHashEntry(pEntry);
}
} else {
- pEntry = Tcl_CreateHashEntry(pHash,(char*)tag,&newentry);
+ pEntry = Tcl_CreateHashEntry(pHash,(char*)((size_t) tag),&newentry);
if (!newentry) {
Tcl_Obj *pOld = (Tcl_Obj *)Tcl_GetHashValue(pEntry);
Tcl_DecrRefCount(pOld);
@@ -2154,14 +2161,15 @@ styleCmd(clientData, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument strings. */
{
- SwprocConf aConf[4 + 1] = {
+ SwprocConf aConf[5 + 1] = {
{SWPROC_OPT, "id", "author", 0}, /* -id <style-sheet id> */
{SWPROC_OPT, "importcmd", 0, 0}, /* -importcmd <cmd> */
{SWPROC_OPT, "urlcmd", 0, 0}, /* -urlcmd <cmd> */
+ {SWPROC_OPT, "errorvar", 0, 0}, /* -errorvar <varname> */
{SWPROC_ARG, 0, 0, 0}, /* STYLE-SHEET-TEXT */
{SWPROC_END, 0, 0, 0}
};
- Tcl_Obj *apObj[4];
+ Tcl_Obj *apObj[5];
int rc = TCL_OK;
int n;
HtmlTree *pTree = (HtmlTree *)clientData;
@@ -2173,7 +2181,8 @@ styleCmd(clientData, interp, objc, objv)
* apObj[0] -> Value passed to -id option (or default "author")
* apObj[1] -> Value passed to -importcmd option (or default "")
* apObj[2] -> Value passed to -urlcmd option (or default "")
- * apObj[3] -> Text of stylesheet to parse
+ * apObj[3] -> Variable to store error log in
+ * apObj[4] -> Text of stylesheet to parse
*
* Pass these on to the HtmlStyleParse() command to actually parse the
* stylesheet.
@@ -2183,9 +2192,17 @@ styleCmd(clientData, interp, objc, objv)
return TCL_ERROR;
}
- Tcl_GetStringFromObj(apObj[3], &n);
+ Tcl_GetStringFromObj(apObj[4], &n);
if (n > 0) {
- rc = HtmlStyleParse(pTree,interp,apObj[3],apObj[0],apObj[1],apObj[2]);
+ rc = HtmlStyleParse(pTree,apObj[4],apObj[0],apObj[1],apObj[2],apObj[3]);
+ } else {
+ /* For a zero length stylesheet, we don't need to run the parser.
+ * But we do need to set the error-log variable to an empty string
+ * if one was specified.
+ */
+ if (apObj[3]) {
+ Tcl_ObjSetVar2(interp, apObj[3], 0, Tcl_NewObj(), 0);
+ }
}
/* Clean up object references created by SwprocRt() */
@@ -2426,6 +2443,15 @@ primitivesCmd(clientData, interp, objc, objv)
return HtmlLayoutPrimitives(clientData, interp, objc, objv);
}
static int
+imagesCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* The HTML widget data structure */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings. */
+{
+ return HtmlImageServerReport(clientData, interp, objc, objv);
+}
+static int
searchCmd(clientData, interp, objc, objv)
ClientData clientData; /* The HTML widget data structure */
Tcl_Interp *interp; /* Current interpreter. */
@@ -2555,6 +2581,7 @@ int widgetCmd(clientData, interp, objc, objv)
*/
{"_delay", delayCmd},
{"_force", forceCmd},
+ {"_images", imagesCmd},
{"_primitives", primitivesCmd},
{"_relayout", relayoutCmd},
{"_styleconfig", styleconfigCmd},
@@ -2597,6 +2624,7 @@ newWidget(clientData, interp, objc, objv)
CONST char *zCmd;
int rc;
Tk_Window mainwin; /* Main window of application */
+ Tcl_HashKeyType *pType;
if (objc<2) {
Tcl_WrongNumArgs(interp, 1, objv, "WINDOW-PATH ?OPTIONS?");
@@ -2635,6 +2663,9 @@ newWidget(clientData, interp, objc, objv)
Tcl_InitHashTable(&pTree->aTag, TCL_STRING_KEYS);
pTree->cmd = Tcl_CreateObjCommand(interp,zCmd,widgetCmd,pTree,widgetCmdDel);
+ pType = HtmlCaseInsenstiveHashType();
+ Tcl_InitCustomHashTable(&pTree->aAtom, TCL_CUSTOM_TYPE_KEYS, pType);
+
HtmlCssSearchInit(pTree);
/* Initialise the hash tables used by styler code */
@@ -2760,6 +2791,15 @@ htmlDecodeCmd(clientData, interp, objc, objv)
{
return HtmlDecode(clientData, interp, objc, objv);
}
+static int
+htmlEncodeCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* The HTML widget data structure */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings. */
+{
+ return HtmlEncode(clientData, interp, objc, objv);
+}
static int
htmlEscapeCmd(clientData, interp, objc, objv)
@@ -2900,7 +2940,9 @@ DLL_EXPORT int Tkhtml_Init(interp)
Tcl_CreateObjCommand(interp, "::tkhtml::htmlstyle", htmlstyleCmd, 0, 0);
Tcl_CreateObjCommand(interp, "::tkhtml::version", htmlVersionCmd, 0, 0);
+
Tcl_CreateObjCommand(interp, "::tkhtml::decode", htmlDecodeCmd, 0, 0);
+ Tcl_CreateObjCommand(interp, "::tkhtml::encode", htmlEncodeCmd, 0, 0);
Tcl_CreateObjCommand(interp, "::tkhtml::escape_uri", htmlEscapeCmd, 0, 0);
Tcl_CreateObjCommand(interp, "::tkhtml::uri", htmlUriCmd, 0, 0);
diff --git a/src/htmltest.c b/src/htmltest.c
new file mode 100644
index 0000000..1fc6d16
--- /dev/null
+++ b/src/htmltest.c
@@ -0,0 +1,113 @@
+static char const rcsid[] =
+ "@(#) $Id: htmltest.c,v 1.15 2005/03/23 01:36:54 danielk1977 Exp $";
+
+/*
+** This file contains the TestPoint routines used for profiling
+** and coverage analysis of the code.
+**
+** This source code is released into the public domain by the author,
+** D. Richard Hipp, on 2002 December 17. Instead of a license, here
+** is a blessing:
+**
+** May you do good and not evil.
+** May you find forgiveness for yourself and forgive others.
+** May you share freely, never taking more than you give.
+*/
+
+/*
+** A macro named "TestPoint" is defined which increments a counter
+** whenever it is encountered. This is very efficient, and should
+** not impact performance of the system. For delivery, the macro
+** can be nulled out by recompiling without the COVERAGE_TEST macro
+** defined.
+**
+** See also the "renumber.c" program which can be used
+** to assign unique numbers to all of the TestPoint(0) macros.
+*/
+#include "tcl.h"
+#include "html.h"
+
+#if INTERFACE
+
+#endif /* INTERFACE */
+
+/*
+** The following global array keeps track of the number of visits to
+** each testpoint. The size of the array must be set manually to the
+** be at least one greater than the largest TestPoint number.
+*/
+#if defined(COVERAGE_TEST)
+int HtmlTPArray[2000];
+#endif
+
+/* Needed by the EslTestPointDump routine
+*/
+#include <stdio.h>
+
+/*
+** Recursion depth
+*/
+#if defined(DEBUG)
+int HtmlDepth = 0;
+#endif
+#if INTERFACE
+#if defined(DEBUG)
+#define HtmlPush HtmlDepth+=2
+#define HtmlPop HtmlDepth-=2
+#else
+#define HtmlPush
+#define HtmlPop
+#endif
+#endif
+
+/* This function is called to print the values of all elements of the
+** TP_Array to the given file. Values are printed in decimal, one per line.
+*/
+void
+HtmlTestPointDump(filename)
+ char *filename;
+{
+#if defined(COVERAGE_TEST)
+ FILE *fp;
+
+ fp = fopen(filename, "a");
+ if (fp) {
+ int i;
+ for (i = 0; i < sizeof(HtmlTPArray) / sizeof(HtmlTPArray[0]); i++) {
+ if (HtmlTPArray[i] > 0) {
+ fprintf(fp, "%d %d\n", i, HtmlTPArray[i]);
+ }
+ }
+ }
+ fclose(fp);
+#endif
+}
+
+/* This function reports an error to stderr when code that is marked
+** UNTESTED gets executed.
+*/
+void
+HtmlTPUntested(zFile, line)
+ const char *zFile;
+ int line;
+{
+#ifndef USE_TCL_STUBS
+ fprintf(stderr, "Untested HTML Widget code executed in file %s line %d\n",
+ zFile, line);
+#endif
+}
+
+/* This function reports an error to stderr when safety code that should
+** never execute is called.
+*/
+void
+HtmlTPCantHappen(zFile, line)
+ const char *zFile;
+ int line;
+{
+#ifndef USE_TCL_STUBS
+ fprintf(stderr,
+ "Unplanned behavior in the HTML Widget in file %s line %d\n", zFile,
+ line);
+#endif
+}
diff --git a/src/htmltext.c b/src/htmltext.c
index 1476731..d76dc7c 100644
--- a/src/htmltext.c
+++ b/src/htmltext.c
@@ -358,6 +358,7 @@ static struct sgEsc esc_sequences[] = {
/* Non-standard. But very common. */
{"quote", "\"", 0},
+ {"apos", "'", 0},
};
/* The size of the handler hash table. For best results this should
@@ -2003,21 +2004,25 @@ populateTextNode(n, z, pText, pnToken, pnText)
if (pnText) *pnText = nText;
}
-HtmlTextNode *
-HtmlTextNew(n, z, isTrimEnd, isTrimStart)
+void
+HtmlTextSet(pText, n, z, isTrimEnd, isTrimStart)
+ HtmlTextNode *pText;
int n;
const char *z;
int isTrimEnd;
int isTrimStart;
{
char *z2;
- HtmlTextNode *pText;
HtmlTextToken *pFinal;
int nText = 0;
int nToken = 0;
int nAlloc; /* Number of bytes allocated */
+ if (pText->aToken) {
+ HtmlFree(pText->aToken);
+ }
+
/* Make a temporary copy of the text and translate any embedded html
* escape characters (i.e. " "). Todo: Avoid this copy by changing
* populateTextNode() so that it deals with escapes.
@@ -2031,10 +2036,9 @@ HtmlTextNew(n, z, isTrimEnd, isTrimStart)
populateTextNode(strlen(z2), z2, 0, &nToken, &nText);
assert(nText >= 0 && nToken > 0);
- /* Allocate space for the HtmlTextNode and it's two array members */
- nAlloc = sizeof(HtmlTextNode) + nText + (nToken * sizeof(HtmlTextToken));
- pText = (HtmlTextNode *)HtmlClearAlloc("HtmlTextNode", nAlloc);
- pText->aToken = (HtmlTextToken *)&pText[1];
+ /* Allocate space for HtmlTextNode.aToken and HtmlTextNode.zText */
+ nAlloc = nText + (nToken * sizeof(HtmlTextToken));
+ pText->aToken = (HtmlTextToken *)HtmlClearAlloc("TextNode.aToken", nAlloc);
if (nText > 0) {
pText->zText = (char *)&pText->aToken[nToken];
} else {
@@ -2086,7 +2090,21 @@ HtmlTextNew(n, z, isTrimEnd, isTrimStart)
);
}
#endif
+}
+
+HtmlTextNode *
+HtmlTextNew(n, z, isTrimEnd, isTrimStart)
+ int n;
+ const char *z;
+ int isTrimEnd;
+ int isTrimStart;
+{
+ HtmlTextNode *pText;
+
+ /* Allocate space for the HtmlTextNode. */
+ pText = HtmlNew(HtmlTextNode);
+ HtmlTextSet(pText, n, z, isTrimEnd, isTrimStart);
return pText;
}
@@ -2180,6 +2198,16 @@ HtmlTextIterNext(pTextIter)
pTextIter->iToken++;
}
+int
+HtmlTextIterIsLast(pTextIter)
+ HtmlTextIter *pTextIter;
+{
+ HtmlTextIter sIter;
+ memcpy(&sIter, pTextIter, sizeof(HtmlTextIter));
+ HtmlTextIterNext(&sIter);
+ return !HtmlTextIterIsValid(&sIter);
+}
+
int
HtmlTextIterType(pTextIter)
HtmlTextIter *pTextIter;
diff --git a/src/htmltree.c b/src/htmltree.c
index 82eaab6..079fd58 100644
--- a/src/htmltree.c
+++ b/src/htmltree.c
@@ -36,7 +36,7 @@
* POSSIBILITY OF SUCH DAMAGE.
*/
-static const char rcsid[] = "$Id: htmltree.c,v 1.150 2007/09/25 11:21:43 danielk1977 Exp $";
+static const char rcsid[] = "$Id: htmltree.c,v 1.161 2008/02/14 08:39:14 danielk1977 Exp $";
#include "html.h"
#include "swproc.h"
@@ -73,6 +73,8 @@ struct HtmlFragmentContext {
(eTag==Html_TH) ? 1 : 0 \
)
+static void treeCloseFosterTree(HtmlTree *);
+
/*
*---------------------------------------------------------------------------
*
@@ -88,9 +90,10 @@ struct HtmlFragmentContext {
*---------------------------------------------------------------------------
*/
static void
-explicitCloseCount(pCurrent, eTag, pNClose)
+explicitCloseCount(pCurrent, eTag, zTag, pNClose)
HtmlNode *pCurrent; /* Node currently being constructed */
int eTag; /* Id of closing tag (i.e. "</p>" -> Html_P) */
+ const char *zTag; /* Atom of closing tag */
int *pNClose; /* OUT: Number of elements to close */
{
*pNClose = 0;
@@ -101,7 +104,8 @@ explicitCloseCount(pCurrent, eTag, pNClose)
for (p = pCurrent; p; p = HtmlNodeParent(p)) {
nLevel++;
- if (eTag == p->eTag) {
+ assert(zTag == p->zTag || stricmp(zTag, p->zTag));
+ if (zTag == p->zTag) {
*pNClose = nLevel;
break;
}
@@ -211,9 +215,9 @@ clearReplacement(pTree, pElem)
}
/* Delete the Tcl_Obj's and the structure itself. */
- if (p->pDelete) Tcl_DecrRefCount(p->pDelete);
- if (p->pReplace) Tcl_DecrRefCount(p->pReplace);
- if (p->pConfigureCmd) Tcl_DecrRefCount(p->pConfigureCmd);
+ if (p->pDelete) { Tcl_DecrRefCount(p->pDelete); }
+ if (p->pReplace) { Tcl_DecrRefCount(p->pReplace); }
+ if (p->pConfigureCmd) { Tcl_DecrRefCount(p->pConfigureCmd); }
HtmlFree(p);
}
}
@@ -314,6 +318,7 @@ freeNode(pTree, pNode)
HtmlTextNode *pTextNode = HtmlNodeAsText(pNode);
assert(pTextNode);
HtmlTagCleanupNode(pTextNode);
+ HtmlFree(pTextNode->aToken);
}
/* Delete the computed values caches. */
@@ -330,6 +335,7 @@ HtmlNodeClearGenerated(pTree, pElem)
HtmlTree *pTree;
HtmlElementNode *pElem;
{
+ assert(!pElem->pBefore || !HtmlNodeIsText(pElem->pBefore));
freeNode(pTree, pElem->pBefore);
freeNode(pTree, pElem->pAfter);
pElem->pBefore = 0;
@@ -499,8 +505,12 @@ nodeHandlerCallbacks(pTree, pNode)
/* HtmlElementNormalize(HtmlNodeAsElement(pNode)); */
}
+ if (!isFragment && TAG_TO_TABLELEVEL(eTag) > 0) {
+ treeCloseFosterTree(pTree);
+ }
+
/* Execute the node-handler script for node pNode, if one exists. */
- pEntry = Tcl_FindHashEntry(&pTree->aNodeHandler, (char *)eTag);
+ pEntry = Tcl_FindHashEntry(&pTree->aNodeHandler, (char *)((size_t) eTag));
if (pEntry) {
Tcl_Obj *pEval;
Tcl_Obj *pScript;
@@ -718,9 +728,10 @@ nodeInsertChild(pTree, pElem, pBefore, pAfter, pChild)
*---------------------------------------------------------------------------
*/
int
-HtmlNodeAddChild(pElem, eTag, pAttributes)
+HtmlNodeAddChild(pElem, eTag, zTag, pAttributes)
HtmlElementNode *pElem;
int eTag;
+ const char *zTag; /* Atom for tag name */
HtmlAttributes *pAttributes;
{
int n; /* Number of bytes to alloc for pNode->apChildren */
@@ -735,10 +746,16 @@ HtmlNodeAddChild(pElem, eTag, pAttributes)
"HtmlNode.apChildren", (char *)pElem->apChildren, n
);
+ if (!zTag) {
+ zTag = HtmlTypeToName(0, eTag);
+ }
+ assert(zTag);
+
pNew = HtmlNew(HtmlElementNode);
pNew->pAttributes = pAttributes;
pNew->node.pParent = (HtmlNode *)pElem;
pNew->node.eTag = eTag;
+ pNew->node.zTag = zTag;
pElem->apChildren[r] = (HtmlNode *)pNew;
assert(r < pElem->nChild);
@@ -868,7 +885,7 @@ doAttributeHandler(pTree, pNode, zAttr, zValue)
int eType = pNode->eTag;
Tcl_HashEntry *pEntry;
- pEntry = Tcl_FindHashEntry(&pTree->aAttributeHandler, (char*)eType);
+ pEntry = Tcl_FindHashEntry(&pTree->aAttributeHandler, (char*)((size_t) eType));
if (pEntry) {
Tcl_Obj *pScript;
pScript = (Tcl_Obj *)Tcl_GetHashValue(pEntry);
@@ -900,7 +917,7 @@ doParseHandler(pTree, eType, pNode, iOffset)
eType = Html_Text;
}
- pEntry = Tcl_FindHashEntry(&pTree->aParseHandler, (char *)eType);
+ pEntry = Tcl_FindHashEntry(&pTree->aParseHandler, (char *)((size_t) eType));
if (pEntry) {
Tcl_Obj *pScript;
pScript = (Tcl_Obj *)Tcl_GetHashValue(pEntry);
@@ -966,10 +983,12 @@ HtmlInitTree(pTree)
pRoot = HtmlNew(HtmlElementNode);
pRoot->node.eTag = Html_HTML;
+ pRoot->node.zTag = HtmlTypeToName(pTree, Html_HTML);
pTree->pRoot = (HtmlNode *)pRoot;
- HtmlNodeAddChild(pRoot, Html_HEAD, 0);
- HtmlNodeAddChild(pRoot, Html_BODY, 0);
+
+ HtmlNodeAddChild(pRoot, Html_HEAD, HtmlTypeToName(pTree, Html_HEAD), 0);
+ HtmlNodeAddChild(pRoot, Html_BODY, HtmlTypeToName(pTree, Html_BODY), 0);
HtmlCallbackRestyle(pTree, (HtmlNode *)pRoot);
}
@@ -1041,9 +1060,10 @@ treeAddFosterText(pTree, pTextNode)
}
HtmlNode *
-treeAddFosterElement(pTree, eTag, pAttr)
+treeAddFosterElement(pTree, eTag, zTag, pAttr)
HtmlTree *pTree;
int eTag;
+ const char *zTag; /* Atom for tag */
HtmlAttributes *pAttr;
{
HtmlNode *pFosterParent;
@@ -1070,12 +1090,16 @@ treeAddFosterElement(pTree, eTag, pAttr)
}
if (pFoster) {
- int n = HtmlNodeAddChild((HtmlElementNode *)pFoster, eTag, pAttr);
+ int n = HtmlNodeAddChild((HtmlElementNode *)pFoster, eTag, zTag, pAttr);
pNew = HtmlNodeChild(pFoster, n);
} else {
pNew = (HtmlNode *)HtmlNew(HtmlElementNode);
((HtmlElementNode *)pNew)->pAttributes = pAttr;
pNew->eTag = eTag;
+ if (!zTag) {
+ zTag = HtmlTypeToName(0, eTag);
+ }
+ pNew->zTag = zTag;
nodeInsertChild(pTree, (HtmlElementNode *)pFosterParent,pBefore,0,pNew);
}
@@ -1093,9 +1117,10 @@ treeAddFosterElement(pTree, eTag, pAttr)
}
static void
-treeAddFosterClosingTag(pTree, eTag)
+treeAddFosterClosingTag(pTree, eTag, zTag)
HtmlTree *pTree;
int eTag;
+ const char *zTag;
{
HtmlNode *pFosterParent;
HtmlNode *pFoster;
@@ -1106,7 +1131,7 @@ treeAddFosterClosingTag(pTree, eTag)
pFosterParent = findFosterParent(pTree, 0);
assert(pFosterParent);
- explicitCloseCount(pTree->state.pFoster, eTag, &nClose);
+ explicitCloseCount(pTree->state.pFoster, eTag, zTag, &nClose);
pFoster = pTree->state.pFoster;
for (ii = 0; ii < nClose && pFoster != pFosterParent; ii++) {
nodeHandlerCallbacks(pTree, pFoster);
@@ -1167,7 +1192,7 @@ treeAddTableComponent(pTree, eTag, pAttr)
eParentTag == Html_TABLE &&
(eTag == Html_TR || eTag == Html_TD || eTag == Html_TH)
) {
- int n2 = HtmlNodeAddChild((HtmlElementNode *)pParent, Html_TBODY, 0);
+ int n2 = HtmlNodeAddChild((HtmlElementNode *)pParent, Html_TBODY, 0, 0);
pParent = HtmlNodeChild(pParent, n2);
pParent->iNode = pTree->iNextNode++;
eParentTag = Html_TBODY;
@@ -1175,14 +1200,14 @@ treeAddTableComponent(pTree, eTag, pAttr)
/* See if we need to add an implicit <TR> node */
if (eParentTag != Html_TR && (eTag == Html_TD || eTag == Html_TH)) {
- int n2 = HtmlNodeAddChild((HtmlElementNode *)pParent, Html_TR, 0);
+ int n2 = HtmlNodeAddChild((HtmlElementNode *)pParent, Html_TR, 0, 0);
pParent = HtmlNodeChild(pParent, n2);
pParent->iNode = pTree->iNextNode++;
eParentTag = Html_TR;
}
/* Add the new node to pParent */
- n = HtmlNodeAddChild((HtmlElementNode *)pParent, eTag, pAttr);
+ n = HtmlNodeAddChild((HtmlElementNode *)pParent, eTag, 0, pAttr);
pNew = HtmlNodeChild(pParent, n);
pNew->iNode = pTree->iNextNode++;
pTree->state.pCurrent = pNew;
@@ -1209,9 +1234,10 @@ treeAddTableComponent(pTree, eTag, pAttr)
*---------------------------------------------------------------------------
*/
void
-HtmlTreeAddElement(pTree, eType, pAttr, iOffset)
+HtmlTreeAddElement(pTree, eType, zType, pAttr, iOffset)
HtmlTree *pTree;
int eType;
+ const char *zType;
HtmlAttributes *pAttr;
int iOffset;
{
@@ -1278,7 +1304,7 @@ HtmlTreeAddElement(pTree, eType, pAttr, iOffset)
* section.
*/
case Html_TITLE: {
- int n = HtmlNodeAddChild(pHeadElem, eType, pAttr);
+ int n = HtmlNodeAddChild(pHeadElem, eType, 0, pAttr);
HtmlNode *p = HtmlNodeChild(pHeadNode, n);
pTree->state.isCdataInHead = 1;
p->iNode = pTree->iNextNode++;
@@ -1291,7 +1317,7 @@ HtmlTreeAddElement(pTree, eType, pAttr, iOffset)
case Html_META:
case Html_LINK:
case Html_BASE: {
- int n = HtmlNodeAddChild(pHeadElem, eType, pAttr);
+ int n = HtmlNodeAddChild(pHeadElem, eType, 0, pAttr);
HtmlNode *p = HtmlNodeChild(pHeadNode, n);
p->iNode = pTree->iNextNode++;
nodeHandlerCallbacks(pTree, p);
@@ -1317,14 +1343,14 @@ HtmlTreeAddElement(pTree, eType, pAttr, iOffset)
default: {
int eCurrentType = HtmlNodeTagType(pCurrent);
-
- if (
+ int isTableType = ((
eCurrentType == Html_TABLE || eCurrentType == Html_TBODY ||
eCurrentType == Html_TFOOT || eCurrentType == Html_THEAD ||
eCurrentType == Html_TR
- ) {
+ ) ? 1 : 0);
+ if (isTableType && eType != Html_FORM) {
/* Need to add this node to the foster tree. */
- pParsed = treeAddFosterElement(pTree, eType, pAttr);
+ pParsed = treeAddFosterElement(pTree, eType, zType, pAttr);
} else {
/* Add this node to pCurrent. */
int nClose = 0;
@@ -1341,12 +1367,13 @@ HtmlTreeAddElement(pTree, eType, pAttr, iOffset)
pC = HtmlNodeAsElement(pCurrent);
assert(!HtmlNodeIsText(pTree->state.pCurrent));
- N = HtmlNodeAddChild(pC, eType, pAttr);
+ N = HtmlNodeAddChild(pC, eType, zType, pAttr);
pCurrent = HtmlNodeChild(pCurrent, N);
pCurrent->iNode = pTree->iNextNode++;
pParsed = pCurrent;
- if (HtmlMarkupFlags(eType) & HTMLTAG_EMPTY) {
+ assert(!isTableType || eType == Html_FORM);
+ if ((HtmlMarkupFlags(eType) & HTMLTAG_EMPTY) || isTableType) {
nodeHandlerCallbacks(pTree, pCurrent);
pCurrent = HtmlNodeParent(pCurrent);
}
@@ -1437,9 +1464,10 @@ HtmlTreeAddText(pTree, pTextNode, iOffset)
*---------------------------------------------------------------------------
*/
void
-HtmlTreeAddClosingTag(pTree, eTag, iOffset)
+HtmlTreeAddClosingTag(pTree, eTag, zTag, iOffset)
HtmlTree *pTree;
int eTag;
+ const char *zTag;
int iOffset;
{
int nClose;
@@ -1449,10 +1477,10 @@ HtmlTreeAddClosingTag(pTree, eTag, iOffset)
if (pTree->state.pFoster && 0 == TAG_TO_TABLELEVEL(eTag)) {
assert(TAG_TO_TABLELEVEL(HtmlNodeTagType(pTree->state.pCurrent)) > 0);
- treeAddFosterClosingTag(pTree, eTag);
+ treeAddFosterClosingTag(pTree, eTag, zTag);
} else {
HtmlNode *pBody = HtmlNodeChild(pTree->pRoot, 1);
- explicitCloseCount(pTree->state.pCurrent, eTag, &nClose);
+ explicitCloseCount(pTree->state.pCurrent, eTag, zTag, &nClose);
for (ii = 0; ii < nClose && pTree->state.pCurrent != pBody; ii++) {
nodeHandlerCallbacks(pTree, pTree->state.pCurrent);
pTree->state.pCurrent = HtmlNodeParent(pTree->state.pCurrent);
@@ -1690,7 +1718,9 @@ Html_u8 HtmlNodeTagType(pNode)
CONST char * HtmlNodeTagName(pNode)
HtmlNode *pNode;
{
- return HtmlMarkupName(pNode->eTag);
+ assert(pNode->zTag || HtmlNodeIsText(pNode));
+ if (!pNode->zTag) return "";
+ return pNode->zTag;
}
/*
@@ -1884,12 +1914,17 @@ nodeViewCmd(pNode, isVertical, objv, objc)
pElem->pScrollbar->iHorizontal = iNew;
}
+ /* Invoke the scrollbar callbacks (i.e. [$scrollbar set]) to update
+ * the scrollbar widgets with their new positions.
+ */
HtmlNodeScrollbarDoCallback(pNode->pNodeCmd->pTree, pNode);
- HtmlWidgetNodeBox(pTree, pNode, &x, &y, &w, &h);
+
+ HtmlWidgetOverflowBox(pTree, pNode, &x, &y, &w, &h);
HtmlCallbackDamage(pTree, x - pTree->iScrollX, y - pTree->iScrollY, w, h);
- pTree->cb.flags |= HTML_NODESCROLL;
+ if (pTree->cb.flags) {
+ pTree->cb.flags |= HTML_NODESCROLL;
+ }
HtmlWalkTree(pTree, pNode, markWindowAsClipped, 0);
-
return TCL_OK;
}
@@ -2180,12 +2215,9 @@ nodeTextCommand(interp, pNode, objc, objv)
* * In the parent node, if this is not an orphan.
* * In the orphan node table, if this is an orphan.
*/
- const char *zCommand;
const char *zNew;
int nNew;
- HtmlTextNode *pNew;
HtmlTextNode *pOrig;
- Tcl_CmdInfo info;
pOrig = HtmlNodeAsText(pNode);
assert(pOrig);
@@ -2193,45 +2225,9 @@ nodeTextCommand(interp, pNode, objc, objv)
/* Invalidate the layout of this node. */
HtmlCallbackLayout(pTree, pNode);
+ /* Set the node to contain the new text */
zNew = Tcl_GetStringFromObj(objv[3], &nNew);
- pNew = HtmlTextNew(nNew, zNew, 0, 0);
-
- /* Copy the base class attributes to the new HtmlTextNode */
- memcpy(pNew, pNode, sizeof(HtmlNode));
- pNode->pParent = 0;
- pNode->pNodeCmd = 0;
-
- /* Move any node tags */
- pNew->pTagged = pOrig->pTagged;
- pOrig->pTagged = 0;
-
- /* Modify the parent node or orphan table pointer */
- if( pNew->node.pParent ){
- int i;
- HtmlElementNode *pParent = HtmlNodeAsElement(pNew->node.pParent);
- for (i=0; i < pParent->nChild; i++) {
- if (pNode == pParent->apChildren[i]) {
- pParent->apChildren[i] = (HtmlNode *)pNew;
- break;
- }
- }
- assert(i<pParent->nChild);
- } else {
- int eNew;
- assert(pNew->node.iNode == HTML_NODE_ORPHAN);
- Tcl_CreateHashEntry(&pTree->aOrphan, (const char *)pNew, &eNew);
- nodeDeorphanize(pTree, pNode);
- assert(eNew);
- }
-
- /* Modify the Tcl_CmdInfo structure */
- zCommand = Tcl_GetString(pNew->node.pNodeCmd->pCommand);
- Tcl_GetCommandInfo(interp, zCommand, &info);
- info.objClientData = pNew;
- Tcl_SetCommandInfo(interp, zCommand, &info);
-
- /* Delete the old node structure */
- freeNode(pTree, pNode);
+ HtmlTextSet(pOrig, nNew, zNew, 0, 0);
} else if (eChoice == NODE_TEXT_PRE) {
pRet = nodeGetPreText(HtmlNodeAsText(pNode));
@@ -2531,7 +2527,7 @@ node_attr_usage:
Tcl_WrongNumArgs(interp, 2, objv, "");
return TCL_ERROR;
}
- zTag = HtmlMarkupName(HtmlNodeTagType(pNode));
+ zTag = HtmlNodeTagName(pNode);
Tcl_SetResult(interp, (char *)zTag, TCL_VOLATILE);
break;
}
@@ -2566,8 +2562,6 @@ node_attr_usage:
/* This method is a no-op for text nodes */
if (HtmlNodeIsText(p)) break;
- if (HtmlNodeIsOrphan(p)) break;
-
if (nArg > 0 && 0 == strcmp(Tcl_GetString(aArg[0]), "-inline")) {
CssPropertySet *pSet = nodeGetStyle(pTree, p);
if (nArg == 1) return HtmlCssInlineQuery(interp, pSet, 0);
@@ -2575,6 +2569,12 @@ node_attr_usage:
/* Otherwise, fall through for the WrongNumArgs() message */
}
+ /* Orphan nodes may have an inline style specified (required by
+ * DOM implementations to implement HTMLElement.style), but
+ * they do not have a computed style, so the rest of this
+ * function is a no-op for orphan nodes.
+ */
+ if (HtmlNodeIsOrphan(p)) break;
HtmlCallbackForce(pTree);
if (nArg > 0) {
@@ -3009,6 +3009,7 @@ int HtmlTreeClear(pTree)
freeNode(pTree, pTree->pRoot);
pTree->pRoot = 0;
pTree->state.pCurrent = 0;
+ pTree->state.pFoster = 0;
/* Free any orphan nodes associated with this tree: */
for (
@@ -3130,9 +3131,10 @@ fragmentAddText(pTree, pTextNode, iOffset)
}
static void
-fragmentAddElement(pTree, eType, pAttributes, iOffset)
+fragmentAddElement(pTree, eType, zType, pAttributes, iOffset)
HtmlTree *pTree;
int eType;
+ const char *zType; /* Atom */
HtmlAttributes *pAttributes;
int iOffset;
{
@@ -3158,14 +3160,22 @@ fragmentAddElement(pTree, eType, pAttributes, iOffset)
implicitCloseCount(pTree, pFragment->pCurrent, eType, &nClose);
for (ii = 0; ii < nClose; ii++) {
HtmlNode *pC = &pFragment->pCurrent->node;
+ HtmlNode *pParentC = HtmlNodeParent(pC);
assert(pC);
nodeHandlerCallbacks(pTree, pC);
- pFragment->pCurrent = HtmlNodeAsElement(HtmlNodeParent(pC));
+ pFragment->pCurrent = (HtmlElementNode *)pParentC;
+ }
+ if (!pFragment->pCurrent) {
+ fragmentOrphan(pTree);
}
pElem = HtmlNew(HtmlElementNode);
pElem->pAttributes = pAttributes;
pElem->node.eTag = eType;
+ if (!zType) {
+ zType = HtmlTypeToName(0, eType);
+ }
+ pElem->node.zTag = zType;
if (pFragment->pCurrent) {
nodeInsertChild(pTree, pFragment->pCurrent, 0, 0, (HtmlNode *)pElem);
@@ -3186,15 +3196,16 @@ fragmentAddElement(pTree, eType, pAttributes, iOffset)
}
static void
-fragmentAddClosingTag(pTree, eType, iOffset)
+fragmentAddClosingTag(pTree, eType, zType, iOffset)
HtmlTree *pTree;
int eType;
+ const char *zType;
int iOffset;
{
int nClose;
int ii;
HtmlFragmentContext *p = pTree->pFragment;
- explicitCloseCount(p->pCurrent, eType, &nClose);
+ explicitCloseCount(p->pCurrent, eType, zType, &nClose);
for (ii = 0; ii < nClose; ii++) {
assert(p->pCurrent);
nodeHandlerCallbacks(pTree, p->pCurrent);
diff --git a/src/htmlurl.c b/src/htmlurl.c
new file mode 100644
index 0000000..d68c821
--- /dev/null
+++ b/src/htmlurl.c
@@ -0,0 +1,438 @@
+static char const rcsid[] =
+ "@(#) $Id: htmlurl.c,v 1.27 2005/03/23 01:36:54 danielk1977 Exp $";
+
+/*
+** Routines for processing URLs.
+**
+** This source code is released into the public domain by the author,
+** D. Richard Hipp, on 2002 December 17. Instead of a license, here
+** is a blessing:
+**
+** May you do good and not evil.
+** May you find forgiveness for yourself and forgive others.
+** May you share freely, never taking more than you give.
+*/
+#include <tk.h>
+#include <ctype.h>
+#include <string.h>
+#include <stdlib.h>
+#include "html.h"
+
+/*
+** A parsed URI is held in an instance of the following structure.
+** Each component is recorded in memory obtained from HtmlAlloc().
+**
+** The examples are from the URI
+**
+** http://192.168.1.1:8080/cgi-bin/printenv?name=xyzzy&addr=none#frag
+*/
+struct HtmlUri {
+ char *zScheme; /* Ex: "http" */
+ char *zAuthority; /* Ex: "192.168.1.1:8080" */
+ char *zPath; /* Ex: "cgi-bin/printenv" */
+ char *zQuery; /* Ex: "name=xyzzy&addr=none" */
+ char *zFragment; /* Ex: "frag" */
+};
+typedef struct HtmlUri HtmlUri;
+
+/*
+** Return the length of the next component of the URL in z[] given
+** that the component starts at z[0]. The initial sequence of the
+** component must be zInit[]. The component is terminated by any
+** character in zTerm[]. The length returned is 0 if the component
+** doesn't exist. The length includes the zInit[] string, but not
+** the termination character.
+**
+** Component zInit zTerm
+** ---------- ------- -------
+** scheme "" ":/?#"
+** authority "//" "/?#"
+** path "/" "?#"
+** query "?" "#"
+** fragment "#" ""
+*/
+static int
+ComponentLength(z, zInit, zTerm)
+ const char *z;
+ const char *zInit;
+ const char *zTerm;
+{
+ int i, n;
+ for (n = 0; zInit[n]; n++) {
+ if (zInit[n] != z[n])
+ return 0;
+ }
+ while (z[n]) {
+ for (i = 0; zTerm[i]; i++) {
+ if (z[n] == zTerm[i])
+ return n;
+ }
+ n++;
+ }
+ return n;
+}
+
+/*
+** Duplicate a string of length n.
+*/
+static char *
+StrNDup(z, n)
+ const char *z;
+ int n;
+{
+ char *zResult;
+ if (n <= 0) {
+ n = strlen(z);
+ }
+ zResult = HtmlAlloc(n + 1);
+ if (zResult) {
+ memcpy(zResult, z, n);
+ zResult[n] = 0;
+ }
+ return zResult;
+}
+
+/*
+** Parse a text URI into an HtmlUri structure.
+*/
+static HtmlUri *
+ParseUri(zUri)
+ const char *zUri;
+{
+ HtmlUri *p;
+ int n;
+
+ p = HtmlAlloc(sizeof(*p));
+ if (p == 0)
+ return 0;
+ memset(p, 0, sizeof(*p));
+ if (zUri == 0 || zUri[0] == 0)
+ return p;
+ while (isspace(zUri[0])) {
+ zUri++;
+ }
+ n = ComponentLength(zUri, "", ":/?# ");
+ if (n > 0 && zUri[n] == ':') {
+ p->zScheme = StrNDup(zUri, n);
+ zUri += n + 1;
+ }
+ n = ComponentLength(zUri, "//", "/?# ");
+ if (n > 0) {
+ p->zAuthority = StrNDup(&zUri[2], n - 2);
+ zUri += n;
+ }
+ n = ComponentLength(zUri, "", "?#");
+ if (n > 0) {
+ p->zPath = StrNDup(zUri, n);
+ zUri += n;
+ }
+ n = ComponentLength(zUri, "?", "# ");
+ if (n > 0) {
+ p->zQuery = StrNDup(&zUri[1], n - 1);
+ zUri += n;
+ }
+ n = ComponentLength(zUri, "#", " ");
+ if (n > 0) {
+ p->zFragment = StrNDup(&zUri[1], n - 1);
+ }
+ return p;
+}
+
+/*
+** Delete an HtmlUri structure.
+*/
+static void
+FreeUri(p)
+ HtmlUri *p;
+{
+ if (p == 0)
+ return;
+ if (p->zScheme)
+ HtmlFree(p->zScheme);
+ if (p->zAuthority)
+ HtmlFree(p->zAuthority);
+ if (p->zPath)
+ HtmlFree(p->zPath);
+ if (p->zQuery)
+ HtmlFree(p->zQuery);
+ if (p->zFragment)
+ HtmlFree(p->zFragment);
+ HtmlFree(p);
+}
+
+/*
+** Create a string to hold the given URI. Memory to hold the string
+** is obtained from HtmlAlloc() and must be freed by the calling
+** function.
+*/
+static char *
+BuildUri(p)
+ HtmlUri *p;
+{
+ int n = 1;
+ char *z;
+ if (p->zScheme)
+ n += strlen(p->zScheme) + 1;
+ if (p->zAuthority)
+ n += strlen(p->zAuthority) + 2;
+ if (p->zPath)
+ n += strlen(p->zPath) + 1;
+ if (p->zQuery)
+ n += strlen(p->zQuery) + 1;
+ if (p->zFragment)
+ n += strlen(p->zFragment) + 1;
+ z = HtmlAlloc(n);
+ if (z == 0)
+ return 0;
+ n = 0;
+ if (p->zScheme) {
+ sprintf(z, "%s:", p->zScheme);
+ n = strlen(z);
+ }
+ if (p->zAuthority) {
+ sprintf(&z[n], "//%s", p->zAuthority);
+ n += strlen(&z[n]);
+ }
+ if (p->zPath) {
+ sprintf(&z[n], "%s", p->zPath);
+ n += strlen(&z[n]);
+ }
+ if (p->zQuery) {
+ sprintf(&z[n], "?%s", p->zQuery);
+ n += strlen(&z[n]);
+ }
+ if (p->zFragment) {
+ sprintf(&z[n], "#%s", p->zFragment);
+ }
+ else {
+ z[n] = 0;
+ }
+ return z;
+}
+
+/*
+** Replace the string in *pzDest with the string in zSrc
+*/
+static void
+ReplaceStr(pzDest, zSrc)
+ char **pzDest;
+ const char *zSrc;
+{
+ if (*pzDest != 0)
+ HtmlFree(*pzDest);
+ if (zSrc == 0) {
+ *pzDest = 0;
+ }
+ else {
+ *pzDest = StrNDup(zSrc, -1);
+ }
+}
+
+/*
+** Remove leading and trailing spaces from the given string. Return
+** a new string obtained from HtmlAlloc().
+*/
+static char *
+Trim(z)
+ char *z;
+{
+ int i;
+ char *zNew;
+ while (isspace(*z))
+ z++;
+ i = strlen(z);
+ zNew = HtmlAlloc(i + 1);
+ if (zNew == 0)
+ return 0;
+ strcpy(zNew, z);
+ if (i > 0 && isspace(zNew[i - 1])) {
+ i--;
+ zNew[i] = 0;
+ }
+ return zNew;
+}
+
+/*
+** The input azSeries[] is a sequence of URIs. This command must
+** resolve them all and put the result in the interp->result field
+** of the interpreter associated with the HTML widget. Return
+** TCL_OK on success and TCL_ERROR if there is a failure.
+**
+** This function can cause the HTML widget to be deleted or changed
+** arbitrarily.
+*/
+int
+HtmlCallResolver(htmlPtr, azSeries)
+ HtmlWidget *htmlPtr; /* The widget that is doing the
+ * resolving. */
+ char **azSeries; /* A list of URIs. NULL terminated */
+{
+ int rc = TCL_OK; /* Return value of this function. */
+ char *z = 0;
+
+ HtmlVerifyLock(htmlPtr);
+ if (htmlPtr->zResolverCommand && htmlPtr->zResolverCommand[0]) {
+ /*
+ ** Append the current base URI then the azSeries arguments to the
+ ** TCL command specified by the -resolvercommand optoin, then execute
+ ** the result.
+ **
+ ** The -resolvercommand could do nasty things, such as delete
+ ** the HTML widget out from under us. Be prepared for the worst.
+ */
+ Tcl_DString cmd;
+ Tcl_DStringInit(&cmd);
+ Tcl_DStringAppend(&cmd, htmlPtr->zResolverCommand, -1);
+ if (htmlPtr->zBaseHref && htmlPtr->zBaseHref[0]) {
+ z = Trim(htmlPtr->zBaseHref);
+ }
+ else if (htmlPtr->zBase && htmlPtr->zBase[0]) {
+ z = Trim(htmlPtr->zBase);
+ }
+ if (z) {
+ Tcl_DStringAppendElement(&cmd, z);
+ HtmlFree(z);
+ }
+ while (azSeries[0]) {
+ z = Trim(azSeries[0]);
+ if (z) {
+ Tcl_DStringAppendElement(&cmd, z);
+ HtmlFree(z);
+ }
+ azSeries++;
+ }
+ HtmlLock(htmlPtr);
+ htmlPtr->inParse++;
+ rc = Tcl_GlobalEval(htmlPtr->interp, Tcl_DStringValue(&cmd));
+ htmlPtr->inParse--;
+ Tcl_DStringFree(&cmd);
+ if (HtmlUnlock(htmlPtr))
+ return TCL_ERROR;
+ if (rc != TCL_OK) {
+ Tcl_AddErrorInfo(htmlPtr->interp,
+ "\n (-resolvercommand executed by HTML widget)");
+ Tcl_BackgroundError(htmlPtr->interp);
+ }
+ }
+ else {
+ /*
+ ** No -resolvercommand has been specified. Do the default
+ ** resolver algorithm specified in section 5.2 of RFC 2396.
+ */
+ HtmlUri *base, *term;
+ if (htmlPtr->zBaseHref && htmlPtr->zBaseHref[0]) {
+ base = ParseUri(htmlPtr->zBaseHref);
+ }
+ else {
+ base = ParseUri(htmlPtr->zBase);
+ }
+ while (azSeries[0]) {
+ term = ParseUri(azSeries[0]);
+ azSeries++;
+ if (term->zScheme == 0 && term->zAuthority == 0 && term->zPath == 0
+ && term->zQuery == 0 && term->zFragment) {
+ ReplaceStr(&base->zFragment, term->zFragment);
+ }
+ else if (term->zScheme) {
+ HtmlUri temp;
+ temp = *term;
+ *term = *base;
+ *base = temp;
+ }
+ else if (term->zAuthority) {
+ ReplaceStr(&base->zAuthority, term->zAuthority);
+ ReplaceStr(&base->zPath, term->zPath);
+ ReplaceStr(&base->zQuery, term->zQuery);
+ ReplaceStr(&base->zFragment, term->zFragment);
+ }
+ else if (term->zPath && (term->zPath[0] == '/' || base->zPath == 0)) {
+ ReplaceStr(&base->zPath, term->zPath);
+ ReplaceStr(&base->zQuery, term->zQuery);
+ ReplaceStr(&base->zFragment, term->zFragment);
+ }
+ else if (term->zPath && base->zPath) {
+ char *zBuf;
+ int i, j;
+ zBuf = HtmlAlloc(strlen(base->zPath) + strlen(term->zPath) + 2);
+ if (zBuf) {
+ sprintf(zBuf, "%s", base->zPath);
+ for (i = strlen(zBuf) - 1; i >= 0 && zBuf[i] != '/'; i--) {
+ zBuf[i] = 0;
+ }
+ strcat(zBuf, term->zPath);
+ for (i = 0; zBuf[i]; i++) {
+ if (zBuf[i] == '/' && zBuf[i + 1] == '.'
+ && zBuf[i + 2] == '/') {
+ strcpy(&zBuf[i + 1], &zBuf[i + 3]);
+ i--;
+ continue;
+ }
+ if (zBuf[i] == '/' && zBuf[i + 1] == '.'
+ && zBuf[i + 2] == 0) {
+ zBuf[i + 1] = 0;
+ continue;
+ }
+ if (i > 0 && zBuf[i] == '/' && zBuf[i + 1] == '.'
+ && zBuf[i + 2] == '.' && (zBuf[i + 3] == '/'
+ || zBuf[i + 3] == 0)) {
+ for (j = i - 1; j >= 0 && zBuf[j] != '/'; j--) {
+ }
+ if (zBuf[i + 3]) {
+ strcpy(&zBuf[j + 1], &zBuf[i + 4]);
+ }
+ else {
+ zBuf[j + 1] = 0;
+ }
+ i = j - 1;
+ if (i < -1)
+ i = -1;
+ continue;
+ }
+ }
+ HtmlFree(base->zPath);
+ base->zPath = zBuf;
+ }
+ ReplaceStr(&base->zQuery, term->zQuery);
+ ReplaceStr(&base->zFragment, term->zFragment);
+ }
+ else if (term->zQuery) {
+ ReplaceStr(&base->zQuery, term->zQuery);
+ }
+ FreeUri(term);
+ }
+ Tcl_SetResult(htmlPtr->interp, BuildUri(base), TCL_DYNAMIC);
+ FreeUri(base);
+ }
+ return rc;
+}
+
+/*
+** This is a convenient wrapper routine for HtmlCallResolver.
+** It makes a copy of the result into memory obtained from HtmlAlloc()
+** and invokes Tcl_ResetResult().
+*/
+char *
+HtmlResolveUri(htmlPtr, zUri)
+ HtmlWidget *htmlPtr;
+ char *zUri;
+{
+ char *azSeq[2];
+ char *zSrc = 0;
+ int result;
+
+ if (zUri == 0 || *zUri == 0)
+ return 0;
+ azSeq[0] = zUri;
+ azSeq[1] = 0;
+ HtmlLock(htmlPtr);
+ result = HtmlCallResolver(htmlPtr, azSeq);
+ if (HtmlUnlock(htmlPtr))
+ return 0;
+ if (result == TCL_OK) {
+ zSrc = HtmlAlloc(strlen(htmlPtr->interp->result) + 1);
+ if (zSrc)
+ strcpy(zSrc, htmlPtr->interp->result);
+ }
+ Tcl_ResetResult(htmlPtr->interp);
+ return zSrc;
+}
diff --git a/src/htmlwidget.c b/src/htmlwidget.c
new file mode 100644
index 0000000..069e87f
--- /dev/null
+++ b/src/htmlwidget.c
@@ -0,0 +1,2419 @@
+static char const rcsid[] =
+ "@(#) $Id: htmlwidget.c,v 1.59 2005/03/23 23:56:27 danielk1977 Exp $";
+
+/*
+** The main routine for the HTML widget for Tcl/Tk
+**
+** This source code is released into the public domain by the author,
+** D. Richard Hipp, on 2002 December 17. Instead of a license, here
+** is a blessing:
+**
+** May you do good and not evil.
+** May you find forgiveness for yourself and forgive others.
+** May you share freely, never taking more than you give.
+*/
+#include <tk.h>
+#include <ctype.h>
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+#include "html.h"
+#ifdef USE_TK_STUBS
+# include <tkIntXlibDecls.h>
+#endif
+#include <X11/Xatom.h>
+
+/*
+** This global variable is used for tracing the operation of
+** the Html formatter.
+*/
+int HtmlTraceMask = 0;
+
+#ifdef __WIN32__
+# define DEF_FRAME_BG_COLOR "SystemButtonFace"
+# define DEF_FRAME_BG_MONO "White"
+# define DEF_FRAME_CURSOR ""
+# define DEF_BUTTON_FG "SystemButtonText"
+# define DEF_BUTTON_HIGHLIGHT_BG "SystemButtonFace"
+# define DEF_BUTTON_HIGHLIGHT "SystemWindowFrame"
+#else
+# define DEF_FRAME_BG_COLOR "#d9d9d9"
+# define DEF_FRAME_BG_MONO "White"
+# define DEF_FRAME_CURSOR ""
+# define DEF_BUTTON_FG "Black"
+# define DEF_BUTTON_HIGHLIGHT_BG "#d9d9d9"
+# define DEF_BUTTON_HIGHLIGHT "Black"
+#endif
+
+/*
+** Information used for argv parsing.
+*/
+static Tk_ConfigSpec configSpecs[] = {
+#if !defined(_TCLHTML_)
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_HTML_BG_COLOR, Tk_Offset(HtmlWidget, border),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_HTML_BG_MONO, Tk_Offset(HtmlWidget, border),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_HTML_BORDER_WIDTH, Tk_Offset(HtmlWidget, borderWidth), 0},
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_HTML_CURSOR, Tk_Offset(HtmlWidget, cursor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BOOLEAN, "-exportselection", "exportSelection",
+ "ExportSelection",
+ DEF_HTML_EXPORT_SEL, Tk_Offset(HtmlWidget, exportSelection), 0},
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_STRING, "-fontcommand", "fontCommand", "FontCommand",
+ DEF_HTML_CALLBACK, Tk_Offset(HtmlWidget, zFontCommand), 0},
+ {TK_CONFIG_STRING, "-fontfamily", "fontFamily", "FontFamily",
+ "times", Tk_Offset(HtmlWidget, FontFamily), 0},
+ {TK_CONFIG_INT, "-fontadjust", "fontAdjust", "FontAdjust",
+ "2", Tk_Offset(HtmlWidget, FontAdjust), 0},
+ {TK_CONFIG_INT, "-formpadding", "formPadding", "FormPadding",
+ "4", Tk_Offset(HtmlWidget, formPadding), 0},
+ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_HTML_FG, Tk_Offset(HtmlWidget, fgColor), 0},
+ {TK_CONFIG_STRING, "-imgidxcommand", "imgidxCommand", "HtmlCallback",
+ DEF_HTML_CALLBACK, Tk_Offset(HtmlWidget, zImgIdxCommand), 0},
+ {TK_CONFIG_PIXELS, "-height", "height", "Hidth",
+ DEF_HTML_HEIGHT, Tk_Offset(HtmlWidget, height), 0},
+ {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_HTML_HIGHLIGHT_BG,
+ Tk_Offset(HtmlWidget, highlightBgColorPtr), 0},
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_HTML_HIGHLIGHT, Tk_Offset(HtmlWidget, highlightColorPtr), 0},
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness",
+ DEF_HTML_HIGHLIGHT_WIDTH, Tk_Offset(HtmlWidget, highlightWidth), 0},
+ {TK_CONFIG_STRING, "-hyperlinkcommand", "hyperlinkCommand", "HtmlCallback",
+ DEF_HTML_CALLBACK, Tk_Offset(HtmlWidget, zHyperlinkCommand), 0},
+ {TK_CONFIG_STRING, "-imagecommand", "imageCommand", "HtmlCallback",
+ DEF_HTML_CALLBACK, Tk_Offset(HtmlWidget, zGetImage), 0},
+ {TK_CONFIG_STRING, "-bgimagecommand", "BGimageCommand", "HtmlCallback",
+ DEF_HTML_CALLBACK, Tk_Offset(HtmlWidget, zGetBGImage), 0},
+ {TK_CONFIG_INT, "-insertofftime", "insertOffTime", "OffTime",
+ DEF_HTML_INSERT_OFF_TIME, Tk_Offset(HtmlWidget, insOffTime), 0},
+ {TK_CONFIG_INT, "-insertontime", "insertOnTime", "OnTime",
+ DEF_HTML_INSERT_ON_TIME, Tk_Offset(HtmlWidget, insOnTime), 0},
+ {TK_CONFIG_STRING, "-isvisitedcommand", "isVisitedCommand", "HtmlCallback",
+ DEF_HTML_CALLBACK, Tk_Offset(HtmlWidget, zIsVisited), 0},
+ {TK_CONFIG_PIXELS, "-padx", "padX", "Pad",
+ DEF_HTML_PADX, Tk_Offset(HtmlWidget, padx), 0},
+ {TK_CONFIG_PIXELS, "-pady", "padY", "Pad",
+ DEF_HTML_PADY, Tk_Offset(HtmlWidget, pady), 0},
+ {TK_CONFIG_PIXELS, "-leftmargin", "leftmargin", "Margin",
+ DEF_HTML_PADY, Tk_Offset(HtmlWidget, leftmargin), 0},
+ {TK_CONFIG_PIXELS, "-topmargin", "topmargin", "Margin",
+ DEF_HTML_PADY, Tk_Offset(HtmlWidget, topmargin), 0},
+ {TK_CONFIG_PIXELS, "-marginwidth", "marginwidth", "Margin",
+ DEF_HTML_PADY, Tk_Offset(HtmlWidget, marginwidth), 0},
+ {TK_CONFIG_PIXELS, "-marginheight", "marginheight", "Margin",
+ DEF_HTML_PADY, Tk_Offset(HtmlWidget, marginheight), 0},
+ {TK_CONFIG_BOOLEAN, "-overridecolors", "overrideColors",
+ "OverrideColors", "0", Tk_Offset(HtmlWidget, overrideColors), 0},
+ {TK_CONFIG_BOOLEAN, "-overridefonts", "overrideFonts",
+ "OverrideFonts", "0", Tk_Offset(HtmlWidget, overrideFonts), 0},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_HTML_RELIEF, Tk_Offset(HtmlWidget, relief), 0},
+ {TK_CONFIG_RELIEF, "-rulerelief", "ruleRelief", "RuleRelief",
+ "sunken", Tk_Offset(HtmlWidget, ruleRelief), 0},
+ {TK_CONFIG_COLOR, "-selectioncolor", "background", "Background",
+ DEF_HTML_SELECTION_COLOR, Tk_Offset(HtmlWidget, selectionColor), 0},
+ {TK_CONFIG_RELIEF, "-tablerelief", "tableRelief", "TableRelief",
+ "raised", Tk_Offset(HtmlWidget, tableRelief), 0},
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_HTML_TAKE_FOCUS, Tk_Offset(HtmlWidget, takeFocus),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-unvisitedcolor", "foreground", "Foreground",
+ DEF_HTML_UNVISITED, Tk_Offset(HtmlWidget, newLinkColor), 0},
+ {TK_CONFIG_BOOLEAN, "-underlinehyperlinks", "underlineHyperlinks",
+ "UnderlineHyperlinks", "1", Tk_Offset(HtmlWidget, underlineLinks), 0},
+ {TK_CONFIG_COLOR, "-visitedcolor", "foreground", "Foreground",
+ DEF_HTML_VISITED, Tk_Offset(HtmlWidget, oldLinkColor), 0},
+ {TK_CONFIG_PIXELS, "-width", "width", "Width",
+ DEF_HTML_WIDTH, Tk_Offset(HtmlWidget, width), 0},
+ {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ DEF_HTML_SCROLL_COMMAND, Tk_Offset(HtmlWidget, xScrollCmd),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
+ DEF_HTML_SCROLL_COMMAND, Tk_Offset(HtmlWidget, yScrollCmd),
+ TK_CONFIG_NULL_OK},
+#endif
+ {TK_CONFIG_STRING, "-appletcommand", "appletCommand", "HtmlCallback",
+ DEF_HTML_CALLBACK, Tk_Offset(HtmlWidget, zAppletCommand), 0},
+ {TK_CONFIG_STRING, "-base", "base", "Base",
+ "", Tk_Offset(HtmlWidget, zBase), 0},
+ {TK_CONFIG_STRING, "-scriptcommand", "scriptCommand", "HtmlCallback",
+ "", Tk_Offset(HtmlWidget, zScriptCommand), 0},
+ {TK_CONFIG_STRING, "-formcommand", "formCommand", "HtmlCallback",
+ DEF_HTML_CALLBACK, Tk_Offset(HtmlWidget, zFormCommand), 0},
+ {TK_CONFIG_STRING, "-framecommand", "frameCommand", "HtmlCallback",
+ DEF_HTML_CALLBACK, Tk_Offset(HtmlWidget, zFrameCommand), 0},
+ {TK_CONFIG_INT, "-addendtags", "addendtags", "bool",
+ 0, Tk_Offset(HtmlWidget, AddEndTags), 0},
+ {TK_CONFIG_INT, "-tableborder", "tableborder", "int",
+ 0, Tk_Offset(HtmlWidget, TableBorderMin), 0},
+ {TK_CONFIG_INT, "-hasscript", "hasscript", "bool",
+ 0, Tk_Offset(HtmlWidget, HasScript), 0},
+ {TK_CONFIG_INT, "-hasframes", "hasframes", "bool",
+ 0, Tk_Offset(HtmlWidget, HasFrames), 0},
+ {TK_CONFIG_INT, "-hastktables", "hastktables", "bool",
+ 0, Tk_Offset(HtmlWidget, HasTktables), 0},
+ {TK_CONFIG_INT, "-tclhtml", "tclhtml", "bool",
+ 0, Tk_Offset(HtmlWidget, TclHtml), 0},
+ {TK_CONFIG_STRING, "-resolvercommand", "resolverCommand", "HtmlCallback",
+ DEF_HTML_CALLBACK, Tk_Offset(HtmlWidget, zResolverCommand), 0},
+ {TK_CONFIG_BOOLEAN, "-sentencepadding", "sentencePadding",
+ "SentencePadding", "0", Tk_Offset(HtmlWidget, iSentencePadding), 0},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+** Get a copy of the config specs.
+*/
+Tk_ConfigSpec *
+HtmlConfigSpec()
+{
+ return configSpecs;
+}
+
+int
+TclConfigureWidgetObj(interp, htmlPtr, configSpecs, objc, objv, dp, flags)
+ Tcl_Interp *interp;
+ HtmlWidget *htmlPtr;
+ Tk_ConfigSpec *configSpecs;
+ int objc;
+ Tcl_Obj *const *objv;
+ char *dp;
+ int flags;
+{
+ Tk_ConfigSpec *cs;
+ int i;
+ char *op;
+ if (objc == 0) {
+ cs = configSpecs;
+ while (cs->type != TK_CONFIG_END) {
+ switch (cs->type) {
+ case TK_CONFIG_STRING:{
+ char **sp;
+ op = dp + cs->offset;
+ sp = (char **) op;
+ Tcl_AppendElement(interp, cs->argvName);
+ Tcl_AppendElement(interp, *sp);
+ }
+ break;
+ case TK_CONFIG_INT:{
+ int *sp;
+ char buf[50];
+ op = dp + cs->offset;
+ sp = (int *) op;
+ sprintf(buf, "%d", *sp);
+ Tcl_AppendElement(interp, cs->argvName);
+ Tcl_AppendElement(interp, buf);
+ }
+ break;
+ default:
+ assert(0 == "Unknown spec type");
+ }
+ cs = cs + 1;
+ }
+ return TCL_OK;
+ }
+ for (i = 0; (i + 1) <= objc; i++) {
+ char *arg = Tcl_GetString(objv[i]);
+ cs = configSpecs;
+ while (cs->type != TK_CONFIG_END) {
+ if (!strcmp(arg, cs->argvName)) {
+ switch (cs->type) {
+ case TK_CONFIG_STRING:{
+ char **sp;
+ op = dp + cs->offset;
+ sp = (char **) op;
+ if (++i >= objc) {
+ Tcl_SetResult(interp, *sp, 0);
+ return TCL_OK;
+ }
+ *sp = strdup(arg);
+ goto foundopt;
+ }
+ break;
+ case TK_CONFIG_INT:{
+ int *sp;
+ op = dp + cs->offset;
+ sp = (int *) op;
+ if (++i >= objc) {
+ char buf[50];
+ sprintf(buf, "%d", *sp);
+ Tcl_SetResult(interp, buf, 0);
+ return TCL_OK;
+ }
+ *sp = atoi(arg);
+ goto foundopt;
+ }
+ break;
+ default:
+ assert(0 == "Unknown spec type");
+ }
+ }
+ cs = cs + 1;
+ }
+ fprintf(stderr, "Unknown option %s\n", arg);
+ return TCL_ERROR;
+ foundopt:
+ continue;
+ }
+ return TCL_OK;
+}
+
+int
+TclConfigureWidget(interp, htmlPtr, configSpecs, argc, argv, dp, flags)
+ Tcl_Interp *interp;
+ HtmlWidget *htmlPtr;
+ Tk_ConfigSpec *configSpecs;
+ int argc;
+ char **argv;
+ char *dp;
+ int flags;
+{
+ Tk_ConfigSpec *cs;
+ int i;
+ char *op;
+ if (argc == 0) {
+ cs = configSpecs;
+ while (cs->type != TK_CONFIG_END) {
+ switch (cs->type) {
+ case TK_CONFIG_STRING:{
+ char **sp;
+ op = dp + cs->offset;
+ sp = (char **) op;
+ Tcl_AppendElement(interp, cs->argvName);
+ Tcl_AppendElement(interp, *sp);
+ }
+ break;
+ case TK_CONFIG_INT:{
+ int *sp;
+ char buf[50];
+ op = dp + cs->offset;
+ sp = (int *) op;
+ sprintf(buf, "%d", *sp);
+ Tcl_AppendElement(interp, cs->argvName);
+ Tcl_AppendElement(interp, buf);
+ }
+ break;
+ default:
+ assert(0 == "Unknown spec type");
+ }
+ cs = cs + 1;
+ }
+ return TCL_OK;
+ }
+ for (i = 0; (i + 1) <= argc && argv[i]; i++) {
+ cs = configSpecs;
+ while (cs->type != TK_CONFIG_END) {
+ if (!strcmp(argv[i], cs->argvName)) {
+ switch (cs->type) {
+ case TK_CONFIG_STRING:{
+ char **sp;
+ op = dp + cs->offset;
+ sp = (char **) op;
+ if (++i >= argc) {
+ Tcl_SetResult(interp, *sp, 0);
+ return TCL_OK;
+ }
+ *sp = strdup(argv[i]);
+ goto foundopt;
+ }
+ break;
+ case TK_CONFIG_INT:{
+ int *sp;
+ op = dp + cs->offset;
+ sp = (int *) op;
+ if (++i >= argc) {
+ char buf[50];
+ sprintf(buf, "%d", *sp);
+ Tcl_SetResult(interp, buf, 0);
+ return TCL_OK;
+ }
+ *sp = atoi(argv[i]);
+ goto foundopt;
+ }
+ break;
+ default:
+ assert(0 == "Unknown spec type");
+ }
+ }
+ cs = cs + 1;
+ }
+ fprintf(stderr, "Unknown option %s\n", argv[i]);
+ return TCL_ERROR;
+ foundopt:
+ continue;
+ }
+ return TCL_OK;
+}
+
+#ifdef _TCLHTML_
+static void
+HtmlCmdDeletedProc(ClientData clientData)
+{
+}
+static void
+HtmlEventProc(ClientData clientData, XEvent * eventPtr)
+{
+}
+void
+HtmlRedrawText(HtmlWidget * htmlPtr, int y)
+{
+}
+void
+HtmlRedrawBlock(HtmlWidget * htmlPtr, HtmlBlock * p)
+{
+}
+int
+HtmlGetColorByName(HtmlWidget * htmlPtr, char *zColor, int def)
+{
+ return 0;
+}
+
+void
+HtmlScheduleRedraw(HtmlWidget * htmlPtr)
+{
+}
+#else
+
+/*
+** Find the width of the usable drawing area in pixels. If the window isn't
+** mapped, use the size requested by the user.
+**
+** The usable drawing area is the area available for displaying rendered
+** HTML. The usable drawing area does not include the 3D border or the
+** padx and pady boundry within the 3D border. The usable drawing area
+** is the size of the clipping window.
+*/
+int
+HtmlUsableWidth(htmlPtr)
+ HtmlWidget *htmlPtr;
+{
+ int w;
+ Tk_Window tkwin = htmlPtr->tkwin;
+ if (tkwin && Tk_IsMapped(tkwin)) {
+ w = Tk_Width(tkwin) - 2 * (htmlPtr->padx + htmlPtr->inset);
+ }
+ else {
+ w = htmlPtr->width;
+ }
+ return w;
+}
+
+/*
+** Find the height of the usable drawing area in pixels. If the window isn't
+** mapped, use the size requested by the user.
+**
+** The usable drawing area is the area available for displaying rendered
+** HTML. The usable drawing area does not include the 3D border or the
+** padx and pady boundry within the 3D border. The usable drawing area
+** is the size of the clipping window.
+*/
+int
+HtmlUsableHeight(htmlPtr)
+ HtmlWidget *htmlPtr;
+{
+ int h;
+ Tk_Window tkwin = htmlPtr->tkwin;
+ if (tkwin && Tk_IsMapped(tkwin)) {
+ h = Tk_Height(tkwin) - 2 * (htmlPtr->pady + htmlPtr->inset);
+ }
+ else {
+ h = htmlPtr->height;
+ }
+ return h;
+}
+
+/*
+** Compute a pair of floating point numbers that describe the current
+** vertical scroll position. The first number is the fraction of
+** the document that is off the top of the visible region and the second
+** number is the fraction that is beyond the end of the visible region.
+*/
+void
+HtmlComputeVerticalPosition(htmlPtr, buf)
+ HtmlWidget *htmlPtr;
+ char *buf; /* Write the two floating point values
+ * here */
+{
+ int actual; /* Size of the viewing area */
+ double frac1, frac2;
+
+ actual = HtmlUsableHeight(htmlPtr);
+ if (htmlPtr->maxY <= 0) {
+ frac1 = 0.0;
+ frac2 = 1.0;
+ }
+ else {
+ frac1 = (double) htmlPtr->yOffset / (double) htmlPtr->maxY;
+ if (frac1 > 1.0) {
+ frac1 = 1.0;
+ }
+ else if (frac1 < 0.0) {
+ frac1 = 0.0;
+ }
+ frac2 = (double) (htmlPtr->yOffset + actual) / (double) htmlPtr->maxY;
+ if (frac2 > 1.0) {
+ frac2 = 1.0;
+ }
+ else if (frac2 < 0.0) {
+ frac2 = 0.0;
+ }
+ }
+ sprintf(buf, "%g %g", frac1, frac2);
+}
+
+/*
+** Do the same thing for the horizontal direction
+*/
+void
+HtmlComputeHorizontalPosition(htmlPtr, buf)
+ HtmlWidget *htmlPtr;
+ char *buf; /* Write the two floating point values
+ * here */
+{
+ int actual; /* Size of the viewing area */
+ double frac1, frac2;
+
+ actual = HtmlUsableWidth(htmlPtr);
+ if (htmlPtr->maxX <= 0) {
+ frac1 = 0.0;
+ frac2 = 1.0;
+ }
+ else {
+ frac1 = (double) htmlPtr->xOffset / (double) htmlPtr->maxX;
+ if (frac1 > 1.0) {
+ frac1 = 1.0;
+ }
+ else if (frac1 < 0.0) {
+ frac1 = 0.0;
+ }
+ frac2 = (double) (htmlPtr->xOffset + actual) / (double) htmlPtr->maxX;
+ if (frac2 > 1.0) {
+ frac2 = 1.0;
+ }
+ else if (frac2 < 0.0) {
+ frac2 = 0.0;
+ }
+ }
+ sprintf(buf, "%g %g", frac1, frac2);
+}
+
+static int GcNextToFree = 0;
+
+/*
+** Clear the cache of GCs
+*/
+void
+ClearGcCache(htmlPtr)
+ HtmlWidget *htmlPtr;
+{
+ int i;
+ for (i = 0; i < N_CACHE_GC; i++) {
+ if (htmlPtr->aGcCache[i].index) {
+ Tk_FreeGC(htmlPtr->display, htmlPtr->aGcCache[i].gc);
+ htmlPtr->aGcCache[i].index = 0;
+ }
+ else {
+ }
+ }
+ GcNextToFree = 0;
+}
+
+/*
+** This routine is called when the widget command is deleted. If the
+** widget isn't already in the process of being destroyed, this command
+** starts that process rolling.
+**
+** This routine can be called in two ways.
+**
+** (1) The window is destroyed, which causes the command to be deleted.
+** In this case, we don't have to do anything.
+**
+** (2) The command only is deleted (ex: "rename .html {}"). In that
+** case we need to destroy the window.
+*/
+static void
+HtmlCmdDeletedProc(clientData)
+ ClientData clientData;
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ if (htmlPtr != NULL && htmlPtr->tkwin != NULL) {
+ Tk_Window tkwin = htmlPtr->tkwin;
+ htmlPtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+** Reset the main layout context in the main widget. This happens
+** before we redo the layout, or just before deleting the widget.
+*/
+static void
+ResetLayoutContext(htmlPtr)
+ HtmlWidget *htmlPtr;
+{
+ htmlPtr->layoutContext.headRoom = 0;
+ htmlPtr->layoutContext.top = 0;
+ htmlPtr->layoutContext.bottom = 0;
+ HtmlClearMarginStack(&htmlPtr->layoutContext.leftMargin);
+ HtmlClearMarginStack(&htmlPtr->layoutContext.rightMargin);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * HtmlRedrawCallback --
+ *
+ * This routine is invoked in order to redraw all or part of the HTML
+ * widget. This might happen because the display has changed, or in
+ * response to an expose event. In all cases, though, this routine is
+ * called by an idle callback.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Layout engine might be run. The window contents might be modified.
+ *
+ *---------------------------------------------------------------------------
+ */
+void
+HtmlRedrawCallback(clientData)
+ ClientData clientData; /* The Html widget */
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ Tk_Window tkwin = htmlPtr->tkwin;
+ Tk_Window clipwin = htmlPtr->clipwin;
+ Pixmap pixmap; /* The buffer on which to render HTML */
+ int x, y, w, h; /* Virtual canvas coordinates of area
+ * to draw */
+ int hw; /* highlight thickness */
+ int insetX, insetY; /* Total highlight thickness, border
+ * width and ** padx/y */
+ int clipwinH, clipwinW; /* Width and height of the clipping
+ * window */
+ HtmlBlock *pBlock; /* For looping over blocks to be drawn
+ */
+ int redoSelection = 0; /* True to recompute the selection */
+ int top, bottom, left, right; /* Coordinates of the clipping window */
+ int imageTop; /* Top edge of image */
+ HtmlElement *pElem;
+
+ /*
+ * Don't bother doing anything if the widget is in the process of
+ * being destroyed, or we are in the middle of a parse.
+ */
+ if (tkwin == 0) {
+ goto redrawExit;
+ }
+ if (htmlPtr->inParse) {
+ htmlPtr->flags &= ~REDRAW_PENDING;
+ goto redrawExit;
+ }
+
+ if ((htmlPtr->flags & RESIZE_ELEMENTS) != 0
+ && (htmlPtr->flags & STYLER_RUNNING) == 0) {
+ HtmlImage *pImage;
+ for (pImage = htmlPtr->imageList; pImage; pImage = pImage->pNext) {
+ pImage->pList = 0;
+ }
+ htmlPtr->lastSized = 0;
+ htmlPtr->flags &= ~RESIZE_ELEMENTS;
+ htmlPtr->flags |= RELAYOUT;
+ }
+
+ /*
+ * Recompute the layout, if necessary or requested.
+ *
+ * We used to make a distinction between RELAYOUT and EXTEND_LAYOUT. **
+ * RELAYOUT would be used when the widget was resized, but the ** less
+ * compute-intensive EXTEND_LAYOUT would be used when new ** text was
+ * appended. ** ** Unfortunately, EXTEND_LAYOUT has some problem that
+ * arise when ** tables are used. The quick fix is to make an
+ * EXTEND_LAYOUT do ** a complete RELAYOUT. Someday, we need to fix
+ * EXTEND_LAYOUT so ** that it works right...
+ *
+ * Calling HtmlLayout() is tricky because HtmlLayout() may invoke one
+ * or more callbacks (thru the "-imagecommand" callback, for instance)
+ * and these callbacks could, in theory, do nasty things like delete
+ * or unmap this widget. So we have to take precautions:
+ *
+ * * Don't remove the REDRAW_PENDING flag until after HtmlLayout()
+ * has been called, to prevent a recursive call to
+ * HtmlRedrawCallback().
+ *
+ * * Call HtmlLock() on the htmlPtr structure to prevent it from
+ * being deleted out from under us.
+ */
+ if ((htmlPtr->flags & (RELAYOUT | EXTEND_LAYOUT)) != 0
+ && (htmlPtr->flags & STYLER_RUNNING) == 0) {
+ htmlPtr->nextPlaced = 0;
+ /*
+ * htmlPtr->nInput = 0;
+ */
+ htmlPtr->varId = 0;
+ htmlPtr->maxX = 0;
+ htmlPtr->maxY = 0;
+ ResetLayoutContext(htmlPtr);
+ htmlPtr->firstBlock = 0;
+ htmlPtr->lastBlock = 0;
+ redoSelection = 1;
+ htmlPtr->flags &= ~RELAYOUT;
+ htmlPtr->flags |= HSCROLL | VSCROLL | REDRAW_TEXT | EXTEND_LAYOUT;
+ }
+ if ((htmlPtr->flags & EXTEND_LAYOUT) && htmlPtr->pFirst != 0) {
+ HtmlLock(htmlPtr);
+ HtmlLayout(htmlPtr);
+ if (HtmlUnlock(htmlPtr))
+ goto redrawExit;
+ tkwin = htmlPtr->tkwin;
+ htmlPtr->flags &= ~EXTEND_LAYOUT;
+ HtmlFormBlocks(htmlPtr);
+ HtmlMapControls(htmlPtr);
+ if (redoSelection && htmlPtr->selBegin.p && htmlPtr->selEnd.p) {
+ HtmlUpdateSelection(htmlPtr, 1);
+ HtmlUpdateInsert(htmlPtr);
+ }
+ }
+ htmlPtr->flags &= ~REDRAW_PENDING;
+
+ /*
+ * No need to do any actual drawing if we aren't mapped
+ */
+ if (!Tk_IsMapped(tkwin)) {
+ goto redrawExit;
+ }
+
+ /*
+ * Redraw the scrollbars. Take care here, since the scrollbar ** update
+ * command could (in theory) delete the html widget, or ** even the whole
+ * interpreter. Preserve critical data structures, ** and check to see
+ * if we are still alive before continuing.
+ */
+ if ((htmlPtr->flags & (HSCROLL | VSCROLL)) != 0) {
+ Tcl_Interp *interp = htmlPtr->interp;
+ int result;
+ char buf[200];
+
+ if ((htmlPtr->flags & HSCROLL) != 0) {
+ if (htmlPtr->xScrollCmd && htmlPtr->xScrollCmd[0]) {
+ HtmlComputeHorizontalPosition(htmlPtr, buf);
+ HtmlLock(htmlPtr);
+ result = Tcl_VarEval(interp, htmlPtr->xScrollCmd, " ", buf, 0);
+ if (HtmlUnlock(htmlPtr))
+ goto redrawExit;
+ if (result != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (horizontal scrolling command executed by html widget)");
+ Tcl_BackgroundError(interp);
+ }
+ }
+ htmlPtr->flags &= ~HSCROLL;
+ }
+ if ((htmlPtr->flags & VSCROLL) != 0 && tkwin && Tk_IsMapped(tkwin)) {
+ if (htmlPtr->yScrollCmd && htmlPtr->yScrollCmd[0]) {
+ Tcl_Interp *interp = htmlPtr->interp;
+ int result;
+ char buf[200];
+ HtmlComputeVerticalPosition(htmlPtr, buf);
+ HtmlLock(htmlPtr);
+ result = Tcl_VarEval(interp, htmlPtr->yScrollCmd, " ", buf, 0);
+ if (HtmlUnlock(htmlPtr))
+ goto redrawExit;
+ if (result != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (horizontal scrolling command executed by html widget)");
+ Tcl_BackgroundError(interp);
+ }
+ }
+ htmlPtr->flags &= ~VSCROLL;
+ }
+ tkwin = htmlPtr->tkwin;
+ if (tkwin == 0 || !Tk_IsMapped(tkwin)) {
+ goto redrawExit;
+ }
+ if (htmlPtr->flags & REDRAW_PENDING) {
+ return;
+ }
+ clipwin = htmlPtr->clipwin;
+ if (clipwin == 0) {
+ goto redrawExit;
+ }
+ }
+
+ /*
+ * Redraw the focus highlight, if requested
+ */
+ hw = htmlPtr->highlightWidth;
+ if (htmlPtr->flags & REDRAW_FOCUS) {
+ if (hw > 0) {
+ GC gc;
+ Tk_Window tkwin = htmlPtr->tkwin;
+
+ if (htmlPtr->flags & GOT_FOCUS) {
+ gc = Tk_GCForColor(htmlPtr->highlightColorPtr,
+ Tk_WindowId(tkwin));
+ }
+ else {
+ gc = Tk_GCForColor(htmlPtr->highlightBgColorPtr,
+ Tk_WindowId(tkwin));
+ }
+ Tk_DrawFocusHighlight(tkwin, gc, hw, Tk_WindowId(tkwin));
+ }
+ htmlPtr->flags &= ~REDRAW_FOCUS;
+ }
+
+ /*
+ * Draw the borders around the parameter of the window. This is ** drawn
+ * directly -- it is not double buffered.
+ */
+ if (htmlPtr->flags & REDRAW_BORDER) {
+ htmlPtr->flags &= ~REDRAW_BORDER;
+ Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), htmlPtr->border, hw, /* x
+ */
+ hw, /* y */
+ Tk_Width(tkwin) - 2 * hw, /* width */
+ Tk_Height(tkwin) - 2 * hw, /* height */
+ htmlPtr->borderWidth, htmlPtr->relief);
+ }
+
+ /*
+ ** If the styler is in a callback, unmap the clipping window and
+ ** abort further processing.
+ */
+ if (htmlPtr->flags & STYLER_RUNNING) {
+ if (Tk_IsMapped(clipwin)) {
+ Tk_UnmapWindow(clipwin);
+ }
+ goto earlyOut;
+ }
+
+ /*
+ ** If we don't have a clipping window, then something is seriously
+ ** wrong. We might as well give up.
+ */
+ if (clipwin == NULL) {
+ goto earlyOut;
+ }
+
+ /*
+ * Resize, reposition and map the clipping window, if necessary
+ */
+ insetX = htmlPtr->padx + htmlPtr->inset;
+ insetY = htmlPtr->pady + htmlPtr->inset;
+ if (htmlPtr->flags & RESIZE_CLIPWIN) {
+ int h, w;
+ Tk_MoveResizeWindow(clipwin, insetX, insetY,
+ htmlPtr->realWidth - 2 * insetX,
+ htmlPtr->realHeight - 2 * insetY);
+ if (!Tk_IsMapped(clipwin)) {
+ Tk_MapWindow(clipwin);
+ }
+ h = htmlPtr->realHeight - 2 * insetY;
+ if (htmlPtr->yOffset + h > htmlPtr->maxY) {
+ htmlPtr->yOffset = htmlPtr->maxY - h;
+ }
+ if (htmlPtr->yOffset < 0) {
+ htmlPtr->yOffset = 0;
+ }
+ w = htmlPtr->realWidth - 2 * insetX;
+ if (htmlPtr->xOffset + w > htmlPtr->maxX) {
+ htmlPtr->xOffset = htmlPtr->maxX - w;
+ }
+ if (htmlPtr->xOffset < 0) {
+ htmlPtr->xOffset = 0;
+ }
+ htmlPtr->flags &= ~RESIZE_CLIPWIN;
+ }
+ HtmlMapControls(htmlPtr);
+
+ /*
+ ** Compute the virtual canvas coordinates corresponding to the
+ ** dirty region of the clipping window.
+ */
+ clipwinW = Tk_Width(clipwin);
+ clipwinH = Tk_Height(clipwin);
+ if (htmlPtr->flags & REDRAW_TEXT) {
+ w = clipwinW;
+ h = clipwinH;
+ x = htmlPtr->xOffset;
+ y = htmlPtr->yOffset;
+ htmlPtr->dirtyLeft = 0;
+ htmlPtr->dirtyTop = 0;
+ htmlPtr->flags &= ~REDRAW_TEXT;
+ }
+ else {
+ if (htmlPtr->dirtyLeft < 0) {
+ htmlPtr->dirtyLeft = 0;
+ }
+ if (htmlPtr->dirtyRight > clipwinW) {
+ htmlPtr->dirtyRight = clipwinW;
+ }
+ if (htmlPtr->dirtyTop < 0) {
+ htmlPtr->dirtyTop = 0;
+ }
+ if (htmlPtr->dirtyBottom > clipwinH) {
+ htmlPtr->dirtyBottom = clipwinH;
+ }
+ w = htmlPtr->dirtyRight - htmlPtr->dirtyLeft;
+ h = htmlPtr->dirtyBottom - htmlPtr->dirtyTop;
+ x = htmlPtr->xOffset + htmlPtr->dirtyLeft;
+ y = htmlPtr->yOffset + htmlPtr->dirtyTop;
+ }
+
+ top = htmlPtr->yOffset;
+ bottom = top + HtmlUsableHeight(htmlPtr);
+ left = htmlPtr->xOffset;
+ right = left + HtmlUsableWidth(htmlPtr);
+
+ /*
+ * Skip the rest of the drawing process if the area to be refreshed is **
+ * less than zero
+ */
+ if (w > 0 && h > 0) {
+ Display *display = htmlPtr->display;
+ int dead;
+ GC gcBg;
+ XRectangle xrec;
+ /*
+ * fprintf(stderr,"Redraw %dx%d at %d,%d: %d,%d: %d,%d\n", w, h, x,
+ * y, left, top, htmlPtr->dirtyLeft, htmlPtr->dirtyTop);
+ */
+
+ /*
+ * Allocate and clear a pixmap upon which to draw
+ */
+ gcBg = HtmlGetGC(htmlPtr, COLOR_Background, FONT_Any);
+ pixmap = Tk_GetPixmap(display, Tk_WindowId(clipwin), w, h,
+ Tk_Depth(clipwin));
+ xrec.x = 0;
+ xrec.y = 0;
+ xrec.width = w;
+ xrec.height = h;
+ XFillRectangles(display, pixmap, gcBg, &xrec, 1);
+ if (htmlPtr->bgimage)
+ HtmlBGDraw(htmlPtr, left, top, w, h, pixmap, htmlPtr->bgimage);
+
+ /*
+ * Render all visible HTML onto the pixmap
+ */
+ HtmlLock(htmlPtr);
+ for (pBlock = htmlPtr->firstBlock; pBlock; pBlock = pBlock->pNext) {
+ if (pBlock->top <= y + h && pBlock->bottom >= y
+ && pBlock->left <= x + w && pBlock->right >= x) {
+ HtmlBlockDraw(htmlPtr, pBlock, pixmap, x, y, w, h, pixmap);
+ if (htmlPtr->tkwin == 0)
+ break;
+ }
+ }
+ dead = HtmlUnlock(htmlPtr);
+
+ /*
+ * Finally, copy the pixmap onto the window and delete the pixmap
+ */
+ if (!dead) {
+ XCopyArea(display, pixmap, Tk_WindowId(clipwin),
+ gcBg, 0, 0, w, h, htmlPtr->dirtyLeft, htmlPtr->dirtyTop);
+ }
+ Tk_FreePixmap(display, pixmap);
+ if (dead)
+ goto redrawExit;
+ /*
+ * XFlush(display);
+ */
+ }
+
+ /*
+ * Redraw images, if requested
+ */
+ if (htmlPtr->flags & REDRAW_IMAGES) {
+ HtmlImage *pImage;
+
+ for (pImage = htmlPtr->imageList; pImage; pImage = pImage->pNext) {
+ for (pElem = pImage->pList; pElem; pElem = pElem->image.pNext) {
+ if (pElem->image.redrawNeeded == 0)
+ continue;
+ imageTop = pElem->image.y - pElem->image.ascent;
+ if (imageTop > bottom
+ || imageTop + pElem->image.h < top
+ || pElem->image.x > right
+ || pElem->image.x + pElem->image.w < left) {
+ continue;
+ }
+ HtmlDrawImage(htmlPtr, pElem, Tk_WindowId(htmlPtr->clipwin),
+ left, top, right, bottom);
+ }
+ }
+ htmlPtr->flags &= ~(REDRAW_IMAGES | ANIMATE_IMAGES);
+ }
+
+ /*
+ * Set the dirty region to the empty set.
+ */
+ earlyOut:
+ htmlPtr->dirtyTop = LARGE_NUMBER;
+ htmlPtr->dirtyLeft = LARGE_NUMBER;
+ htmlPtr->dirtyBottom = 0;
+ htmlPtr->dirtyRight = 0;
+ redrawExit:
+ return;
+}
+
+/*
+** If any part of the screen needs to be redrawn, Then call this routine
+** with the values of a box (in window coordinates) that needs to be
+** redrawn. This routine will make sure an idle callback is scheduled
+** to do the redraw.
+**
+** The box coordinates are relative to the clipping window (clipwin),
+** not the main window (tkwin).
+*/
+void
+HtmlRedrawArea(htmlPtr, left, top, right, bottom)
+ HtmlWidget *htmlPtr; /* The widget to be redrawn */
+ int left; /* Top left corner of area to redraw */
+ int top;
+ int right; /* bottom right corner of area to
+ * redraw */
+ int bottom;
+{
+ if (bottom < 0) {
+ return;
+ }
+ if (top > htmlPtr->realHeight) {
+ return;
+ }
+ if (right < 0) {
+ return;
+ }
+ if (left > htmlPtr->realWidth) {
+ return;
+ }
+ if (htmlPtr->dirtyTop > top) {
+ htmlPtr->dirtyTop = top;
+ }
+ if (htmlPtr->dirtyLeft > left) {
+ htmlPtr->dirtyLeft = left;
+ }
+ if (htmlPtr->dirtyBottom < bottom) {
+ htmlPtr->dirtyBottom = bottom;
+ }
+ if (htmlPtr->dirtyRight < right) {
+ htmlPtr->dirtyRight = right;
+ }
+ HtmlScheduleRedraw(htmlPtr);
+}
+
+/* Redraw the HtmlBlock given.
+*/
+void
+HtmlRedrawBlock(htmlPtr, p)
+ HtmlWidget *htmlPtr;
+ HtmlBlock *p;
+{
+ if (p) {
+ HtmlRedrawArea(htmlPtr,
+ p->left - htmlPtr->xOffset,
+ p->top - htmlPtr->yOffset,
+ p->right - htmlPtr->xOffset + 1,
+ p->bottom - htmlPtr->yOffset);
+ }
+ else {
+ }
+}
+
+/*
+** Call this routine to force the entire widget to be redrawn.
+*/
+void
+HtmlRedrawEverything(htmlPtr)
+ HtmlWidget *htmlPtr;
+{
+ htmlPtr->flags |= REDRAW_FOCUS | REDRAW_TEXT | REDRAW_BORDER;
+ HtmlScheduleRedraw(htmlPtr);
+}
+
+/*
+** Do the redrawing right now. Don't wait.
+*/
+#if 0 /* NOT_USED */
+static void
+HtmlRedrawPush(HtmlWidget * htmlPtr)
+{
+ if (htmlPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(HtmlRedrawCallback, (ClientData) htmlPtr);
+ }
+ else {
+ }
+ HtmlRedrawCallback((ClientData) htmlPtr);
+}
+#endif
+
+/*
+** Call this routine to cause all of the rendered HTML at the
+** virtual canvas coordinate of Y and beyond to be redrawn.
+*/
+void
+HtmlRedrawText(htmlPtr, y)
+ HtmlWidget *htmlPtr;
+ int y;
+{
+ int yOffset; /* Top-most visible canvas coordinate */
+ int clipHeight; /* Height of the clipping window */
+
+ yOffset = htmlPtr->yOffset;
+ clipHeight = HtmlUsableHeight(htmlPtr);
+ y -= yOffset;
+ if (y < clipHeight) {
+ HtmlRedrawArea(htmlPtr, 0, y, LARGE_NUMBER, clipHeight);
+ }
+ else {
+ }
+}
+
+/*
+** Recalculate the preferred size of the html widget and pass this
+** along to the geometry manager.
+*/
+static void
+HtmlRecomputeGeometry(htmlPtr)
+ HtmlWidget *htmlPtr;
+{
+ int w, h; /* Total width and height of the
+ * widget */
+
+ htmlPtr->inset = htmlPtr->highlightWidth + htmlPtr->borderWidth;
+ w = htmlPtr->width + 2 * (htmlPtr->padx + htmlPtr->inset);
+ h = htmlPtr->height + 2 * (htmlPtr->pady + htmlPtr->inset);
+ Tk_GeometryRequest(htmlPtr->tkwin, w, h);
+ Tk_SetInternalBorder(htmlPtr->tkwin, htmlPtr->inset);
+}
+
+void
+HtmlClearTk(htmlPtr)
+ HtmlWidget *htmlPtr;
+{
+ int i;
+ HtmlElement *p, *pNext;
+ HtmlImage *Ip;
+ htmlPtr->topmargin = htmlPtr->leftmargin = HTML_INDENT / 4;
+ htmlPtr->marginwidth = htmlPtr->marginheight = HTML_INDENT / 4;
+ for (i = N_PREDEFINED_COLOR; i < N_COLOR; i++) {
+ if (htmlPtr->apColor[i] != 0) {
+ Tk_FreeColor(htmlPtr->apColor[i]);
+ htmlPtr->apColor[i] = 0;
+ }
+ }
+ for (i = 0; i < N_COLOR; i++) {
+ htmlPtr->iDark[i] = 0;
+ htmlPtr->iLight[i] = 0;
+ }
+ htmlPtr->colorUsed = 0;
+ while ((Ip = htmlPtr->imageList)) {
+ htmlPtr->imageList = Ip->pNext;
+ Tk_FreeImage(Ip->image);
+ while (Ip->anims) {
+ HtmlImageAnim *a = Ip->anims;
+ Ip->anims = a->next;
+ Tk_FreeImage(a->image);
+ HtmlFree((char *) a);
+ }
+ HtmlFree(Ip);
+ }
+ if (htmlPtr->bgimage) {
+ Tk_FreeImage(htmlPtr->bgimage);
+ htmlPtr->bgimage = 0;
+ }
+ ClearGcCache(htmlPtr);
+ ResetLayoutContext(htmlPtr);
+}
+
+void
+DestroyHtmlWidgetTk(htmlPtr)
+ HtmlWidget *htmlPtr;
+{
+ int i;
+
+ Tk_FreeOptions(configSpecs, (char *) htmlPtr, htmlPtr->display, 0);
+ for (i = 0; i < N_FONT; i++) {
+ if (htmlPtr->aFont[i] != 0) {
+ Tk_FreeFont(htmlPtr->aFont[i]);
+ htmlPtr->aFont[i] = 0;
+ }
+ }
+ HtmlFree(htmlPtr->zClipwin);
+}
+
+/*
+** Flash the insertion cursor.
+*/
+void
+HtmlFlashCursor(clientData)
+ ClientData clientData;
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ if (htmlPtr->pInsBlock == 0 || htmlPtr->insOnTime <= 0
+ || htmlPtr->insOffTime <= 0) {
+ htmlPtr->insTimer = 0;
+ return;
+ }
+ HtmlRedrawBlock(htmlPtr, htmlPtr->pInsBlock);
+ if ((htmlPtr->flags & GOT_FOCUS) == 0) {
+ htmlPtr->insStatus = 0;
+ htmlPtr->insTimer = 0;
+ }
+ else if (htmlPtr->insStatus) {
+ htmlPtr->insTimer = Tcl_CreateTimerHandler(htmlPtr->insOffTime,
+ HtmlFlashCursor, clientData);
+ htmlPtr->insStatus = 0;
+ }
+ else {
+ htmlPtr->insTimer = Tcl_CreateTimerHandler(htmlPtr->insOnTime,
+ HtmlFlashCursor, clientData);
+ htmlPtr->insStatus = 1;
+ }
+}
+
+/*
+** Return a GC from the cache. As many as N_CACHE_GCs are kept valid
+** at any one time. They are replaced using an LRU algorithm.
+**
+** A value of FONT_Any (-1) for the font means "don't care".
+*/
+GC
+HtmlGetGC(htmlPtr, color, font)
+ HtmlWidget *htmlPtr;
+ int color;
+ int font;
+{
+ int i, j;
+ GcCache *p = htmlPtr->aGcCache;
+ XGCValues gcValues;
+ int mask;
+ Tk_Font tkfont;
+
+ /*
+ ** Check for an existing GC.
+ */
+ if (color < 0 || color >= N_COLOR) {
+ color = 0;
+ }
+ if (font < FONT_Any || font >= N_FONT) {
+ font = FONT_Default;
+ }
+ for (i = 0; i < N_CACHE_GC; i++, p++) {
+ if (p->index == 0) {
+ continue;
+ }
+ if ((font < 0 || p->font == font) && p->color == color) {
+ if (p->index > 1) {
+ for (j = 0; j < N_CACHE_GC; j++) {
+ if (htmlPtr->aGcCache[j].index
+ && htmlPtr->aGcCache[j].index < p->index) {
+ htmlPtr->aGcCache[j].index++;
+ }
+ }
+ p->index = 1;
+ }
+ return htmlPtr->aGcCache[i].gc;
+ }
+ }
+
+ /*
+ ** No GC matches. Find a place to allocate a new GC.
+ */
+ p = htmlPtr->aGcCache;
+ for (i = 0; i < N_CACHE_GC; i++, p++) {
+ if (p->index == 0 || p->index == N_CACHE_GC) {
+ break;
+ }
+ }
+ if (i >= N_CACHE_GC) { /* No slot, so free one: round-robin */
+ p = htmlPtr->aGcCache;
+ for (i = 0; i < N_CACHE_GC && i < GcNextToFree; i++, p++);
+ GcNextToFree = (GcNextToFree + 1) % N_CACHE_GC;
+ Tk_FreeGC(htmlPtr->display, p->gc);
+ /*
+ * fprintf(stderr,"Tk_FreeGC: %d)\n", p->gc);
+ */
+ }
+ gcValues.foreground = htmlPtr->apColor[color]->pixel;
+ gcValues.graphics_exposures = True;
+ mask = GCForeground | GCGraphicsExposures;
+ if (font < 0) {
+ font = FONT_Default;
+ }
+ tkfont = HtmlGetFont(htmlPtr, font);
+ if (tkfont) {
+ gcValues.font = Tk_FontId(tkfont);
+ mask |= GCFont;
+ }
+ p->gc = Tk_GetGC(htmlPtr->tkwin, mask, &gcValues);
+ /*
+ * fprintf(stderr,"Tk_GetGC: %d\n", p->gc);
+ */
+ if (p->index == 0) {
+ p->index = N_CACHE_GC + 1;
+ }
+ for (j = 0; j < N_CACHE_GC; j++) {
+ if (htmlPtr->aGcCache[j].index && htmlPtr->aGcCache[j].index < p->index) {
+ htmlPtr->aGcCache[j].index++;
+ }
+ }
+ p->index = 1;
+ p->font = font;
+ p->color = color;
+ return p->gc;
+}
+
+/*
+** Retrieve any valid GC. The font and color don't matter since the
+** GC will only be used for copying.
+*/
+GC
+HtmlGetAnyGC(htmlPtr)
+ HtmlWidget *htmlPtr;
+{
+ int i;
+ GcCache *p = htmlPtr->aGcCache;
+
+ for (i = 0; i < N_CACHE_GC; i++, p++) {
+ if (p->index) {
+ return p->gc;
+ }
+ }
+ return HtmlGetGC(htmlPtr, COLOR_Normal, FONT_Default);
+}
+
+/*
+** All window events (for both tkwin and clipwin) are
+** sent to this routine.
+*/
+static void
+HtmlEventProc(clientData, eventPtr)
+ ClientData clientData;
+ XEvent *eventPtr;
+{
+ HtmlWidget *htmlPtr = (HtmlWidget *) clientData;
+ int redraw_needed = 0;
+ XConfigureRequestEvent *p;
+
+ switch (eventPtr->type) {
+ case GraphicsExpose:
+ case Expose:
+ if (htmlPtr->tkwin == 0) {
+ /*
+ * The widget is being deleted. Do nothing
+ */
+ }
+ else if (eventPtr->xexpose.window != Tk_WindowId(htmlPtr->tkwin)) {
+ /*
+ * Exposure in the clipping window
+ */
+ htmlPtr->flags |= ANIMATE_IMAGES;
+ HtmlRedrawArea(htmlPtr, eventPtr->xexpose.x - 1,
+ eventPtr->xexpose.y - 1,
+ eventPtr->xexpose.x + eventPtr->xexpose.width +
+ 1,
+ eventPtr->xexpose.y + eventPtr->xexpose.height +
+ 1);
+ }
+ else {
+ /*
+ * Exposure in the main window
+ */
+ htmlPtr->flags |= (REDRAW_BORDER | ANIMATE_IMAGES);
+ HtmlScheduleRedraw(htmlPtr);
+ }
+ break;
+ case DestroyNotify:
+ if ((htmlPtr->flags & REDRAW_PENDING)) {
+ Tcl_CancelIdleCall(HtmlRedrawCallback, (ClientData) htmlPtr);
+ htmlPtr->flags &= ~REDRAW_PENDING;
+ }
+ if (htmlPtr->tkwin != 0) {
+ if (eventPtr->xany.window != Tk_WindowId(htmlPtr->tkwin)) {
+ Tk_DestroyWindow(htmlPtr->tkwin);
+ htmlPtr->clipwin = 0;
+ break;
+ }
+ htmlPtr->tkwin = 0;
+ Tcl_DeleteCommand(htmlPtr->interp, htmlPtr->zCmdName);
+ Tcl_DeleteCommand(htmlPtr->interp, htmlPtr->zClipwin);
+ }
+ HtmlUnlock(htmlPtr);
+ break;
+ case ConfigureNotify:
+ if (htmlPtr->tkwin != 0
+ && eventPtr->xconfigure.window == Tk_WindowId(htmlPtr->tkwin)
+ ) {
+ p = (XConfigureRequestEvent *) eventPtr;
+ if (p->width != htmlPtr->realWidth) {
+ redraw_needed = 1;
+ htmlPtr->realWidth = p->width;
+ }
+ if (p->height != htmlPtr->realHeight) {
+ redraw_needed = 1;
+ htmlPtr->realHeight = p->height;
+ }
+ else {
+ }
+ if (redraw_needed) {
+ htmlPtr->flags |=
+ RELAYOUT | VSCROLL | HSCROLL | RESIZE_CLIPWIN;
+ htmlPtr->flags |= ANIMATE_IMAGES;
+ HtmlRedrawEverything(htmlPtr);
+ }
+ }
+ break;
+ case FocusIn:
+ if (htmlPtr->tkwin != 0
+ && eventPtr->xfocus.window == Tk_WindowId(htmlPtr->tkwin)
+ && eventPtr->xfocus.detail != NotifyInferior) {
+ htmlPtr->flags |= GOT_FOCUS | REDRAW_FOCUS | ANIMATE_IMAGES;
+ HtmlScheduleRedraw(htmlPtr);
+ HtmlUpdateInsert(htmlPtr);
+ }
+ break;
+ case FocusOut:
+ if (htmlPtr->tkwin != 0
+ && eventPtr->xfocus.window == Tk_WindowId(htmlPtr->tkwin)
+ && eventPtr->xfocus.detail != NotifyInferior) {
+ htmlPtr->flags &= ~GOT_FOCUS;
+ htmlPtr->flags |= REDRAW_FOCUS;
+ HtmlScheduleRedraw(htmlPtr);
+ }
+ break;
+ }
+}
+
+/*
+** The rendering and layout routines should call this routine in order to get
+** a font structure. The iFont parameter specifies which of the N_FONT
+** fonts should be obtained. The font is allocated if necessary.
+**
+** Because the -fontcommand callback can be invoked, this function can
+** (in theory) cause the HTML widget to be changed arbitrarily or even
+** deleted. Callers of this function much be prepared to be called
+** recursively and/or to have the HTML widget deleted out from under
+** them. This routine will return NULL if the HTML widget is deleted.
+*/
+Tk_Font
+HtmlGetFont(htmlPtr, iFont)
+ HtmlWidget *htmlPtr; /* The HTML widget to which the font
+ * applies */
+ int iFont; /* Which font to obtain */
+{
+ Tk_Font toFree = 0;
+
+ if (iFont < 0) {
+ iFont = 0;
+ }
+ if (iFont >= N_FONT) {
+ iFont = N_FONT - 1;
+ CANT_HAPPEN;
+ }
+
+ /*
+ ** If the font has previously been allocated, but the "fontValid" bitmap
+ ** shows it is no longer valid, then mark it for freeing later. We use
+ ** a policy of allocate-before-free because Tk's font cache operates
+ ** much more efficiently that way.
+ */
+ if (!FontIsValid(htmlPtr, iFont) && htmlPtr->aFont[iFont] != 0) {
+ toFree = htmlPtr->aFont[iFont];
+ htmlPtr->aFont[iFont] = 0;
+ }
+
+ /*
+ ** If we need to allocate a font, first construct the font name then
+ ** allocate it.
+ */
+ if (htmlPtr->aFont[iFont] == 0) {
+ char name[200]; /* Name of the font */
+
+ name[0] = 0;
+
+ /*
+ * Run the -fontcommand if it is specified
+ */
+ if (htmlPtr->zFontCommand && htmlPtr->zFontCommand[0]) {
+ int iFam; /* The font family index. Value
+ * between 0 and 7 */
+ Tcl_DString str; /* The command we'll execute to get
+ * the font name */
+ char *zSep = ""; /* Separator between font attributes */
+ int rc; /* Return code from the font command */
+ char zBuf[100]; /* Temporary buffer */
+
+ Tcl_DStringInit(&str);
+ Tcl_DStringAppend(&str, htmlPtr->zFontCommand, -1);
+ sprintf(zBuf, " %d {", FontSize(iFont) + 1);
+ Tcl_DStringAppend(&str, zBuf, -1);
+ iFam = iFont / N_FONT_SIZE;
+ if (iFam & 1) {
+ Tcl_DStringAppend(&str, "bold", -1);
+ zSep = " ";
+ }
+ if (iFam & 2) {
+ Tcl_DStringAppend(&str, zSep, -1);
+ Tcl_DStringAppend(&str, "italic", -1);
+ zSep = " ";
+ }
+ if (iFam & 4) {
+ Tcl_DStringAppend(&str, zSep, -1);
+ Tcl_DStringAppend(&str, "fixed", -1);
+ }
+ Tcl_DStringAppend(&str, "}", -1);
+ HtmlLock(htmlPtr);
+ rc = Tcl_GlobalEval(htmlPtr->interp, Tcl_DStringValue(&str));
+ Tcl_DStringFree(&str);
+ if (HtmlUnlock(htmlPtr)) {
+ return NULL;
+ }
+ if (rc != TCL_OK) {
+ Tcl_AddErrorInfo(htmlPtr->interp,
+ "\n (-fontcommand callback of HTML widget)");
+ Tcl_BackgroundError(htmlPtr->interp);
+ }
+ else {
+ sprintf(name, "%.100s", htmlPtr->interp->result);
+ }
+ Tcl_ResetResult(htmlPtr->interp);
+ }
+
+ /*
+ ** If the -fontcommand failed or returned an empty string, or if
+ ** there is no -fontcommand, then get the default font name.
+ */
+ if (name[0] == 0) {
+ char *familyStr = "";
+ int iFamily;
+ int iSize;
+ int size, finc = htmlPtr->FontAdjust;
+
+ iFamily = iFont / N_FONT_SIZE;
+ iSize = iFont % N_FONT_SIZE + 1;
+ switch (iFamily) {
+ case 0:
+ familyStr = "%s -%d";
+ break;
+ case 1:
+ familyStr = "%s -%d bold";
+ break;
+ case 2:
+ familyStr = "%s -%d italic";
+ break;
+ case 3:
+ familyStr = "%s -%d bold italic";
+ break;
+ case 4:
+ familyStr = "%s -%d";
+ break;
+ case 5:
+ familyStr = "%s -%d bold";
+ break;
+ case 6:
+ familyStr = "%s -%d italic";
+ break;
+ case 7:
+ familyStr = "%s -%d bold italic";
+ break;
+ default:
+ familyStr = "%s -14";
+ CANT_HAPPEN;
+ }
+ switch (iSize) {
+ case 1:
+ size = 6 + finc;
+ break;
+ case 2:
+ size = 10 + finc;
+ break;
+ case 3:
+ size = 12 + finc;
+ break;
+ case 4:
+ size = 14 + finc;
+ break;
+ case 5:
+ size = 20 + finc;
+ break;
+ case 6:
+ size = 24 + finc;
+ break;
+ case 7:
+ size = 30 + finc;
+ break;
+ default:
+ size = 14 + finc;
+ CANT_HAPPEN;
+ }
+ sprintf(name, familyStr, htmlPtr->FontFamily, size);
+ }
+
+ /*
+ * Get the named font
+ */
+ htmlPtr->aFont[iFont] =
+ Tk_GetFont(htmlPtr->interp, htmlPtr->tkwin, name);
+ if (htmlPtr->aFont[iFont] == 0) {
+ Tcl_AddErrorInfo(htmlPtr->interp,
+ "\n (trying to create a font named \"");
+ Tcl_AddErrorInfo(htmlPtr->interp, name);
+ Tcl_AddErrorInfo(htmlPtr->interp, "\" in the HTML widget)");
+ Tcl_BackgroundError(htmlPtr->interp);
+ htmlPtr->aFont[iFont] =
+ Tk_GetFont(htmlPtr->interp, htmlPtr->tkwin, "fixed");
+ }
+ if (htmlPtr->aFont[iFont] == 0) {
+ Tcl_AddErrorInfo(htmlPtr->interp,
+ "\n (trying to create font \"fixed\" in the HTML widget)");
+ Tcl_BackgroundError(htmlPtr->interp);
+ htmlPtr->aFont[iFont] =
+ Tk_GetFont(htmlPtr->interp, htmlPtr->tkwin,
+ "helvetica -12");
+ }
+ FontSetValid(htmlPtr, iFont);
+ }
+
+ /*
+ ** Free the expired font, if any.
+ */
+ if (toFree != 0) {
+ Tk_FreeFont(toFree);
+ }
+ return htmlPtr->aFont[iFont];
+}
+
+/*
+** Compute the squared distance between two colors
+*/
+static float
+colorDistance(pA, pB)
+ XColor *pA;
+ XColor *pB;
+{
+ float x, y, z;
+
+ x = 0.30 * (pA->red - pB->red);
+ y = 0.61 * (pA->green - pB->green);
+ z = 0.11 * (pA->blue - pB->blue);
+ return x * x + y * y + z * z;
+}
+
+/*
+** This routine returns an index between 0 and N_COLOR-1 which indicates
+** which XColor structure in the apColor[] array of htmlPtr should be
+** used to describe the color specified by the given name.
+*/
+int
+HtmlGetColorByName(htmlPtr, zColor, def)
+ HtmlWidget *htmlPtr;
+ char *zColor;
+ int def;
+{
+ XColor *pNew;
+ int iColor;
+ Tk_Uid name;
+ int i, n;
+ char zAltColor[16];
+
+ /*
+ * Netscape accepts color names that are just HEX values, without ** the
+ * # up front. This isn't valid HTML, but we support it for **
+ * compatibility.
+ */
+ n = strlen(zColor);
+ if (n == 6 || n == 3 || n == 9 || n == 12) {
+ for (i = 0; i < n; i++) {
+ if (!isxdigit(zColor[i]))
+ break;
+ }
+ if (i == n) {
+ sprintf(zAltColor, "#%s", zColor);
+ }
+ else {
+ strcpy(zAltColor, zColor);
+ }
+ name = Tk_GetUid(zAltColor);
+ }
+ else {
+ name = Tk_GetUid(zColor);
+ }
+ pNew = Tk_GetColor(htmlPtr->interp, htmlPtr->clipwin, name);
+ if (pNew == 0) {
+ return def;
+ }
+
+ iColor = GetColorByValue(htmlPtr, pNew);
+ Tk_FreeColor(pNew);
+ if (iColor < N_COLOR)
+ return iColor;
+ return def;
+}
+
+/*
+** Macros used in the computation of appropriate shadow colors.
+*/
+#define MAX_COLOR 65535
+#define MAX(A,B) ((A)<(B)?(B):(A))
+#define MIN(A,B) ((A)<(B)?(A):(B))
+
+/*
+** Check to see if the given color is too dark to be easily distinguished
+** from black.
+*/
+static int
+isDarkColor(p)
+ XColor *p;
+{
+ float x, y, z;
+
+ x = 0.50 * p->red;
+ y = 1.00 * p->green;
+ z = 0.28 * p->blue;
+ return (x * x + y * y + z * z) < 0.05 * MAX_COLOR * MAX_COLOR;
+}
+
+/*
+** Given that the background color is iBgColor, figure out an
+** appropriate color for the dark part of a 3D shadow.
+*/
+int
+HtmlGetDarkShadowColor(htmlPtr, iBgColor)
+ HtmlWidget *htmlPtr;
+ int iBgColor;
+{
+ if (htmlPtr->iDark[iBgColor] == 0) {
+ XColor *pRef, val;
+ pRef = htmlPtr->apColor[iBgColor];
+ if (isDarkColor(pRef)) {
+ int t1, t2;
+ t1 = MIN(MAX_COLOR, pRef->red * 1.2);
+ t2 = (pRef->red * 3 + MAX_COLOR) / 4;
+ val.red = MAX(t1, t2);
+ t1 = MIN(MAX_COLOR, pRef->green * 1.2);
+ t2 = (pRef->green * 3 + MAX_COLOR) / 4;
+ val.green = MAX(t1, t2);
+ t1 = MIN(MAX_COLOR, pRef->blue * 1.2);
+ t2 = (pRef->blue * 3 + MAX_COLOR) / 4;
+ val.blue = MAX(t1, t2);
+ }
+ else {
+ val.red = pRef->red * 0.6;
+ val.green = pRef->green * 0.6;
+ val.blue = pRef->blue * 0.6;
+ }
+ htmlPtr->iDark[iBgColor] = GetColorByValue(htmlPtr, &val) + 1;
+ }
+ return htmlPtr->iDark[iBgColor] - 1;
+}
+
+/*
+** Check to see if the given color is too light to be easily distinguished
+** from white.
+*/
+static int
+isLightColor(p)
+ XColor *p;
+{
+ return p->green >= 0.85 * MAX_COLOR;
+}
+
+/*
+** Given that the background color is iBgColor, figure out an
+** appropriate color for the bright part of the 3D shadow.
+*/
+int
+HtmlGetLightShadowColor(htmlPtr, iBgColor)
+ HtmlWidget *htmlPtr;
+ int iBgColor;
+{
+ if (htmlPtr->iLight[iBgColor] == 0) {
+ XColor *pRef, val;
+ pRef = htmlPtr->apColor[iBgColor];
+ if (isLightColor(pRef)) {
+ val.red = pRef->red * 0.9;
+ val.green = pRef->green * 0.9;
+ val.blue = pRef->blue * 0.9;
+ }
+ else {
+ int t1, t2;
+ t1 = MIN(MAX_COLOR, pRef->green * 1.4);
+ t2 = (pRef->green + MAX_COLOR) / 2;
+ val.green = MAX(t1, t2);
+ t1 = MIN(MAX_COLOR, pRef->red * 1.4);
+ t2 = (pRef->red + MAX_COLOR) / 2;
+ val.red = MAX(t1, t2);
+ t1 = MIN(MAX_COLOR, pRef->blue * 1.4);
+ t2 = (pRef->blue + MAX_COLOR) / 2;
+ val.blue = MAX(t1, t2);
+ }
+ htmlPtr->iLight[iBgColor] = GetColorByValue(htmlPtr, &val) + 1;
+ }
+ return htmlPtr->iLight[iBgColor] - 1;
+}
+
+# define COLOR_MASK 0xf800
+
+/* Eliminate remapped duplicate colors. */
+int
+CheckDupColor(htmlPtr, slot)
+ HtmlWidget *htmlPtr;
+ int slot;
+{
+ int i;
+ int r, g, b;
+ XColor *pRef = htmlPtr->apColor[slot];
+ r = pRef->red &= COLOR_MASK;
+ g = pRef->green &= COLOR_MASK;
+ b = pRef->blue &= COLOR_MASK;
+ for (i = 0; i < N_COLOR; i++) {
+ XColor *p = htmlPtr->apColor[i];
+ if (i == slot)
+ continue;
+ if (p && (p->red & COLOR_MASK) == r && (p->green & COLOR_MASK) == g
+ && (p->blue & COLOR_MASK) == b) {
+ htmlPtr->colorUsed &= ~(1LL << slot);
+ htmlPtr->apColor[slot] = 0;
+ return i;
+ }
+ }
+ return slot;
+}
+
+/*
+** Find a color integer for the color whose color components
+** are given by pRef.
+*/
+int
+GetColorByValue(htmlPtr, pRef)
+ HtmlWidget *htmlPtr;
+ XColor *pRef;
+{
+ int i;
+ float dist;
+ float closestDist;
+ int closest;
+ int r, g, b;
+
+ /*
+ * Search for an exact match
+ */
+ r = pRef->red &= COLOR_MASK;
+ g = pRef->green &= COLOR_MASK;
+ b = pRef->blue &= COLOR_MASK;
+ for (i = 0; i < N_COLOR; i++) {
+ XColor *p = htmlPtr->apColor[i];
+ if (p && (p->red & COLOR_MASK) == r && (p->green & COLOR_MASK) == g
+ && (p->blue & COLOR_MASK) == b) {
+ htmlPtr->colorUsed |= (1LL << i);
+ return i;
+ }
+ }
+
+ /*
+ * No exact matches. Look for a completely unused slot
+ */
+ for (i = N_PREDEFINED_COLOR; i < N_COLOR; i++) {
+ if (htmlPtr->apColor[i] == 0) {
+ htmlPtr->apColor[i] = Tk_GetColorByValue(htmlPtr->clipwin, pRef);
+ /*
+ * Check if colow was remapped to an existing slot
+ */
+ htmlPtr->colorUsed |= (1LL << i);
+ return CheckDupColor(htmlPtr, i);
+ }
+ }
+
+ /*
+ * No empty slots. Look for a slot that contains a color that ** isn't
+ * currently in use.
+ */
+ for (i = N_PREDEFINED_COLOR; i < N_COLOR; i++) {
+ if (((htmlPtr->colorUsed >> i) & 1LL) == 0) {
+ Tk_FreeColor(htmlPtr->apColor[i]);
+ htmlPtr->apColor[i] = Tk_GetColorByValue(htmlPtr->clipwin, pRef);
+ htmlPtr->colorUsed |= (1LL << i);
+ return CheckDupColor(htmlPtr, i);
+ }
+ }
+
+ /*
+ * Ok, find the existing color that is closest to the color requested **
+ * and use it.
+ */
+ closest = 0;
+ closestDist = colorDistance(pRef, htmlPtr->apColor[0]);
+ for (i = 1; i < N_COLOR; i++) {
+ dist = colorDistance(pRef, htmlPtr->apColor[i]);
+ if (dist < closestDist) {
+ closestDist = dist;
+ closest = i;
+ }
+ }
+ return i;
+}
+
+/* Only support rect for now */
+int
+HtmlInArea(p, left, top, x, y)
+ HtmlElement *p;
+ int left;
+ int top;
+ int x;
+ int y;
+{
+ int *ip = p->area.coords;
+ return (ip && (left + ip[0]) <= x && (top + ip[1]) <= y
+ && (left + ip[2]) >= x && (top + ip[3]) >= y);
+}
+
+/*
+** This routine searchs for a hyperlink beneath the coordinates x,y
+** and returns a pointer to the HREF for that hyperlink. The text
+** is held one of the markup.argv[] fields of the <a> markup.
+*/
+char *
+HtmlGetHref(htmlPtr, x, y, target)
+ HtmlWidget *htmlPtr;
+ int x;
+ int y;
+ char **target;
+{
+ HtmlBlock *pBlock;
+ HtmlElement *pElem;
+ char *z;
+
+ for (pBlock = htmlPtr->firstBlock; pBlock; pBlock = pBlock->pNext) {
+ if (pBlock->top > y || pBlock->bottom < y
+ || pBlock->left > x || pBlock->right < x) {
+ continue;
+ }
+ pElem = pBlock->base.pNext;
+ if (pElem->base.type == Html_IMG && pElem->image.pMap) {
+ pElem = pElem->image.pMap->pNext;
+ while (pElem && pElem->base.type != Html_EndMAP) {
+ if (pElem->base.type == Html_AREA)
+ if (HtmlInArea(pElem, pBlock->left, pBlock->top, x, y)) {
+ *target = HtmlMarkupArg(pElem, "target", 0);
+ return HtmlMarkupArg(pElem, "href", 0);
+ }
+ pElem = pElem->pNext;
+ }
+ continue;
+ }
+ if ((pElem->base.style.flags & STY_Anchor) == 0) {
+ continue;
+ }
+ switch (pElem->base.type) {
+ case Html_Text:
+ case Html_Space:
+ case Html_IMG:
+ while (pElem && pElem->base.type != Html_A) {
+ pElem = pElem->base.pPrev;
+ }
+ if (pElem == 0 || pElem->base.type != Html_A) {
+ break;
+ }
+ *target = HtmlMarkupArg(pElem, "target", 0);
+ return HtmlMarkupArg(pElem, "href", 0);
+ default:
+ break;
+ }
+ }
+ return 0;
+}
+
+/* Return coordinates of item. */
+int
+HtmlElementCoords(interp, htmlPtr, p, i, pct, coords)
+ Tcl_Interp *interp;
+ HtmlWidget *htmlPtr;
+ HtmlElement *p;
+ int i;
+ int pct;
+ int *coords;
+{
+ HtmlBlock *pBlock;
+
+ while (p && p->base.type != Html_Block) {
+ p = p->base.pPrev;
+ }
+ if (!p)
+ return 1;
+ pBlock = &p->block;
+ if (pct) {
+ HtmlElement *pEnd = htmlPtr->pLast;
+ HtmlBlock *pb2;
+ while (pEnd && pEnd->base.type != Html_Block) {
+ pEnd = pEnd->base.pPrev;
+ }
+ pb2 = &pEnd->block;
+#define HGCo(dir) pb2->dir?pBlock->dir*100/pb2->dir:0
+ coords[0] = HGCo(left);
+ coords[1] = HGCo(top);
+ coords[2] = HGCo(right);
+ coords[3] = HGCo(bottom);
+ }
+ else {
+ coords[0] = pBlock->left;
+ coords[1] = pBlock->top;
+ coords[2] = pBlock->right;
+ coords[3] = pBlock->bottom;
+ }
+ return 0;
+}
+
+/* Return coordinates of item. */
+void
+HtmlGetCoords(interp, htmlPtr, p, i, pct)
+ Tcl_Interp *interp;
+ HtmlWidget *htmlPtr;
+ HtmlElement *p;
+ int i;
+ int pct;
+{
+ Tcl_DString str;
+ char *z, zLine[100];
+ int coords[4];
+
+ if (HtmlElementCoords(interp, htmlPtr, p, i, pct, coords))
+ return;
+ Tcl_DStringInit(&str);
+ sprintf(zLine, "%d %d %d %d", coords[0], coords[1], coords[2], coords[3]);
+ Tcl_DStringAppend(&str, zLine, -1);
+ Tcl_DStringResult(interp, &str);
+}
+
+/*
+** Change the "yOffset" field from its current value to the value given.
+** This has the effect of scrolling the widget vertically.
+*/
+void
+HtmlVerticalScroll(htmlPtr, yOffset)
+ HtmlWidget *htmlPtr;
+ int yOffset;
+{
+ int inset; /* The 3D border plus the pady */
+ int h; /* Height of the clipping window */
+ int diff; /* Difference between old and new
+ * offset */
+ GC gc; /* Graphics context used for copying */
+ int w; /* Width of text area */
+
+ if (yOffset == htmlPtr->yOffset) {
+ return;
+ }
+ inset = htmlPtr->pady + htmlPtr->inset;
+ h = htmlPtr->realHeight - 2 * inset;
+ if ((htmlPtr->flags & REDRAW_TEXT) != 0
+ || (htmlPtr->dirtyTop < h && htmlPtr->dirtyBottom > 0)
+ || htmlPtr->yOffset > yOffset + (h - 30)
+ || htmlPtr->yOffset < yOffset - (h - 30)
+ ) {
+ htmlPtr->yOffset = yOffset;
+ htmlPtr->flags |= VSCROLL | REDRAW_TEXT;
+ HtmlScheduleRedraw(htmlPtr);
+ return;
+ }
+ diff = htmlPtr->yOffset - yOffset;
+ gc = HtmlGetAnyGC(htmlPtr);
+ w = htmlPtr->realWidth - 2 * (htmlPtr->inset + htmlPtr->padx);
+ htmlPtr->flags |= VSCROLL;
+ htmlPtr->yOffset = yOffset;
+ if (diff < 0) {
+ XCopyArea(htmlPtr->display, Tk_WindowId(htmlPtr->clipwin), /* source
+ */
+ Tk_WindowId(htmlPtr->clipwin), /* destination */
+ gc, 0, -diff, /* source X, Y */
+ w, h + diff, /* Width and height */
+ 0, 0); /* Destination X, Y */
+ HtmlRedrawArea(htmlPtr, 0, h + diff, w, h);
+ }
+ else {
+ XCopyArea(htmlPtr->display, Tk_WindowId(htmlPtr->clipwin), /* source
+ */
+ Tk_WindowId(htmlPtr->clipwin), /* destination */
+ gc, 0, 0, /* source X, Y */
+ w, h - diff, /* Width and height */
+ 0, diff); /* Destination X, Y */
+ HtmlRedrawArea(htmlPtr, 0, 0, w, diff);
+ }
+ /*
+ * HtmlMapControls(htmlPtr);
+ */
+}
+
+/*
+** Change the "xOffset" field from its current value to the value given.
+** This has the effect of scrolling the widget horizontally.
+*/
+void
+HtmlHorizontalScroll(htmlPtr, xOffset)
+ HtmlWidget *htmlPtr;
+ int xOffset;
+{
+ if (xOffset == htmlPtr->xOffset) {
+ return;
+ }
+ htmlPtr->xOffset = xOffset;
+ HtmlMapControls(htmlPtr);
+ htmlPtr->flags |= HSCROLL | REDRAW_TEXT;
+ HtmlScheduleRedraw(htmlPtr);
+}
+
+/*
+** Make sure that a call to the HtmlRedrawCallback() routine has been
+** queued.
+*/
+void
+HtmlScheduleRedraw(htmlPtr)
+ HtmlWidget *htmlPtr;
+{
+ if ((htmlPtr->flags & REDRAW_PENDING) == 0
+ && htmlPtr->tkwin != 0 && Tk_IsMapped(htmlPtr->tkwin)
+ ) {
+ Tcl_DoWhenIdle(HtmlRedrawCallback, (ClientData) htmlPtr);
+ htmlPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+#endif /* _TCLHTML_ */
+
+/*
+** This routine is called in order to process a "configure" subcommand
+** on the given html widget.
+*/
+int
+ConfigureHtmlWidgetObj(interp, htmlPtr, objc, objv, flags, realign)
+ Tcl_Interp *interp; /* Write error message to this
+ * interpreter */
+ HtmlWidget *htmlPtr; /* The Html widget to be configured */
+ int objc; /* Number of configuration arguments */
+ Tcl_Obj *CONST objv[]; /* Text of configuration arguments */
+ int flags; /* Configuration flags */
+ int realign; /* Always do a redraw if set */
+{
+ int rc;
+ int i;
+ int redraw = realign; /* True if a redraw is required. */
+ char *arg;
+
+ /*
+ * Scan thru the configuration options to see if we need to redraw ** the
+ * widget.
+ */
+ for (i = 0; redraw == 0 && i < objc; i += 2) {
+ int c;
+ int n;
+ arg = Tcl_GetStringFromObj(objv[i], &n);
+ if (arg[0] != '-') {
+ redraw = 1;
+ break;
+ }
+ c = arg[1];
+ if (c == 'c' && n > 4 && strncmp(arg, "-cursor", n) == 0) {
+ /*
+ * do nothing
+ */
+ }
+ else
+ /*
+ * The default case
+ */
+ {
+ redraw = 1;
+ }
+ }
+#ifdef _TCLHTML_
+ rc = TclConfigureWidgetObj(interp, htmlPtr, configSpecs, objc, objv,
+ (char *) htmlPtr, flags);
+ if (rc != TCL_OK || redraw == 0) {
+ return rc;
+ }
+#else
+ {
+ CONST char *sargv[20];
+ CONST char **argv;
+ if (objc >= 19) {
+ argv = calloc(sizeof(char *), objc + 1);
+ for (i = 0; i < objc; i++)
+ argv[i] = Tcl_GetString(objv[i]);
+ argv[i] = 0;
+ rc = Tk_ConfigureWidget(interp, htmlPtr->tkwin, configSpecs, objc,
+ argv, (char *) htmlPtr, flags);
+ HtmlFree(argv);
+ }
+ else {
+ for (i = 0; i < objc; i++)
+ sargv[i] = Tcl_GetString(objv[i]);
+ sargv[i] = 0;
+ rc = Tk_ConfigureWidget(interp, htmlPtr->tkwin, configSpecs, objc,
+ sargv, (char *) htmlPtr, flags);
+ }
+ }
+ if (rc != TCL_OK || redraw == 0) {
+ return rc;
+ }
+ memset(htmlPtr->fontValid, 0, sizeof(htmlPtr->fontValid));
+ htmlPtr->apColor[COLOR_Normal] = htmlPtr->fgColor;
+ htmlPtr->apColor[COLOR_Visited] = htmlPtr->oldLinkColor;
+ htmlPtr->apColor[COLOR_Unvisited] = htmlPtr->newLinkColor;
+ htmlPtr->apColor[COLOR_Selection] = htmlPtr->selectionColor;
+ htmlPtr->apColor[COLOR_Background] = Tk_3DBorderColor(htmlPtr->border);
+ Tk_SetBackgroundFromBorder(htmlPtr->tkwin, htmlPtr->border);
+ if (htmlPtr->highlightWidth < 0) {
+ htmlPtr->highlightWidth = 0;
+ }
+ if (htmlPtr->padx < 0) {
+ htmlPtr->padx = 0;
+ }
+ if (htmlPtr->pady < 0) {
+ htmlPtr->pady = 0;
+ }
+ if (htmlPtr->width < 100) {
+ htmlPtr->width = 100;
+ }
+ if (htmlPtr->height < 100) {
+ htmlPtr->height = 100;
+ }
+ if (htmlPtr->borderWidth < 0) {
+ htmlPtr->borderWidth = 0;
+ }
+ htmlPtr->flags |=
+ RESIZE_ELEMENTS | RELAYOUT | REDRAW_BORDER | RESIZE_CLIPWIN;
+ HtmlRecomputeGeometry(htmlPtr);
+ HtmlRedrawEverything(htmlPtr);
+ ClearGcCache(htmlPtr);
+#endif
+ return rc;
+}
+
+int
+HtmlNewWidget(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings. */
+{
+
+ HtmlWidget *htmlPtr;
+ Tk_Window new;
+ Tk_Window clipwin;
+ char *zClipwin;
+ Tk_Window tkwin = (Tk_Window) clientData;
+ static int varId = 1; /* Used to construct unique names */
+ int n;
+ char *arg1 = Tcl_GetStringFromObj(objv[1], &n);
+
+#ifndef _TCLHTML_
+ new = Tk_CreateWindowFromPath(interp, tkwin, arg1, (char *) NULL);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+ zClipwin = HtmlAlloc(n + 3);
+ if (zClipwin == 0) {
+ Tk_DestroyWindow(new);
+ return TCL_ERROR;
+ }
+ sprintf(zClipwin, "%s.x", arg1);
+ clipwin = Tk_CreateWindowFromPath(interp, new, zClipwin, 0);
+ if (clipwin == 0) {
+ Tk_DestroyWindow(new);
+ HtmlFree(zClipwin);
+ return TCL_ERROR;
+ }
+#endif
+
+ dbghtmlPtr = htmlPtr = HtmlAlloc(sizeof(HtmlWidget) + n + 1);
+ memset(htmlPtr, 0, sizeof(HtmlWidget));
+#ifdef _TCLHTML_
+ htmlPtr->tkwin = 1;
+#else
+ htmlPtr->tkwin = new;
+ htmlPtr->clipwin = clipwin;
+ htmlPtr->zClipwin = zClipwin;
+ htmlPtr->display = Tk_Display(new);
+#endif
+ htmlPtr->interp = interp;
+ htmlPtr->zCmdName = (char *) &htmlPtr[1];
+ strcpy(htmlPtr->zCmdName, arg1);
+ htmlPtr->relief = TK_RELIEF_FLAT;
+ htmlPtr->dirtyLeft = LARGE_NUMBER;
+ htmlPtr->dirtyTop = LARGE_NUMBER;
+ htmlPtr->flags = RESIZE_CLIPWIN;
+ htmlPtr->varId = varId++;
+ Tcl_CreateObjCommand(interp, htmlPtr->zCmdName,
+ HtmlWidgetObjCommand, (ClientData) htmlPtr,
+ HtmlCmdDeletedProc);
+#ifndef _TCLHTML_
+ Tcl_CreateObjCommand(interp, htmlPtr->zClipwin,
+ HtmlWidgetObjCommand, (ClientData) htmlPtr,
+ HtmlCmdDeletedProc);
+
+ Tk_SetClass(new, "Html");
+ Tk_SetClass(clipwin, "HtmlClip");
+ Tk_CreateEventHandler(htmlPtr->tkwin,
+ ExposureMask | StructureNotifyMask | FocusChangeMask,
+ HtmlEventProc, (ClientData) htmlPtr);
+ Tk_CreateEventHandler(htmlPtr->clipwin,
+ ExposureMask | StructureNotifyMask,
+ HtmlEventProc, (ClientData) htmlPtr);
+ if (HtmlFetchSelectionPtr) {
+ Tk_CreateSelHandler(htmlPtr->tkwin, XA_PRIMARY, XA_STRING,
+ HtmlFetchSelectionPtr, (ClientData) htmlPtr,
+ XA_STRING);
+ Tk_CreateSelHandler(htmlPtr->clipwin, XA_PRIMARY, XA_STRING,
+ HtmlFetchSelectionPtr, (ClientData) htmlPtr,
+ XA_STRING);
+ }
+#endif /* _TCLHTML_ */
+
+ if (ConfigureHtmlWidgetObj(interp, htmlPtr, objc - 2, objv + 2, 0, 1) !=
+ TCL_OK) {
+ goto error;
+ }
+
+ Tcl_InitHashTable(&htmlPtr->tokenHash, TCL_STRING_KEYS);
+ htmlPtr->tokenCnt = Html_TypeCount;
+#ifdef _TCLHTML_
+ interp->result = arg1;
+#else
+ interp->result = Tk_PathName(htmlPtr->tkwin);
+#endif
+ return TCL_OK;
+
+ error:
+#ifndef _TCLHTML_
+ Tk_DestroyWindow(htmlPtr->tkwin);
+#endif
+ return TCL_ERROR;
+}
+
+/*
+** The following routine implements the Tcl "html" command. This command
+** is used to create new HTML widgets only. After the widget has been
+** created, it is manipulated using the widget command defined above.
+*/
+int
+HtmlObjCommand(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings. */
+{
+ int n;
+ char *arg1, *zn, zs, *cmd;
+
+ cmd = Tcl_GetString(objv[0]);
+
+ if (objc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ cmd, " pathName ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ arg1 = Tcl_GetStringFromObj(objv[1], &n);
+
+ /*
+ * If the first argument begins with ".", then it must be the ** name of
+ * a new window the user wants to create.
+ */
+ if (*arg1 == '.')
+ return HtmlNewWidget(clientData, interp, objc, objv);
+
+ return HtmlCommandObj(clientData, interp, objc, objv);
+}
+
+/*
+** The following mess is used to define DLL_EXPORT. DLL_EXPORT is
+** blank except when we are building a Windows95/NT DLL from this
+** library. Some special trickery is necessary to make this wall
+** work together with makeheaders.
+*/
+#if INTERFACE
+#define DLL_EXPORT
+#endif
+#if defined(USE_TCL_STUBS) && defined(__WIN32__)
+# undef DLL_EXPORT
+# define DLL_EXPORT __declspec(dllexport)
+#endif
+
+#ifndef DLL_EXPORT
+#define DLL_EXPORT
+#endif
+
+/*
+** This routine is used to register the "html" command with the
+** Tcl interpreter. This is the only routine in this file with
+** external linkage.
+*/
+extern Tcl_Command htmlcmdhandle;
+
+#ifndef _TCLHTML_
+int
+HtmlXErrorHandler(dsp, ev)
+ Display *dsp;
+ XErrorEvent *ev;
+{
+ char buf[300];
+
+/* #if ! defined(__WIN32__) */
+#if 0
+ XGetErrorText(dsp, ev->error_code, buf, 300);
+ fprintf(stderr, "X-Error: %s\n", buf);
+#endif
+
+/* if (dsp) abort();
+ if (ev) abort();
+ abort(); */
+}
+
+DLL_EXPORT int
+Tkhtml_SafeInit(interp)
+ Tcl_Interp *interp;
+{
+ return Tkhtml_Init(interp);
+}
+
+DLL_EXPORT int
+Tkhtml_Init(interp)
+ Tcl_Interp *interp;
+{
+#ifdef USE_TCL_STUBS
+ if (Tcl_InitStubs(interp, "8.3", 0) == 0) {
+ return TCL_ERROR;
+ }
+ if (Tk_InitStubs(interp, "8.3", 0) == 0) {
+ return TCL_ERROR;
+ }
+#endif
+ htmlcmdhandle = Tcl_CreateObjCommand(interp, "html", HtmlObjCommand,
+ Tk_MainWindow(interp), 0);
+ /*
+ * Tcl_GlobalEval(interp,HtmlLib);
+ */
+#ifdef DEBUG
+ Tcl_LinkVar(interp, "HtmlTraceMask", (char *) &HtmlTraceMask, TCL_LINK_INT);
+#endif
+ Tcl_StaticPackage(interp, "Tkhtml", Tkhtml_Init, Tkhtml_SafeInit);
+ Tcl_PkgProvide(interp, HTML_PKGNAME, HTML_PKGVERSION);
+ XSetErrorHandler(HtmlXErrorHandler);
+ return Htmlexts_Init(interp);
+ return TCL_OK;
+}
+#endif
diff --git a/src/htmlwish.c b/src/htmlwish.c
new file mode 100644
index 0000000..16ba9d6
--- /dev/null
+++ b/src/htmlwish.c
@@ -0,0 +1,25 @@
+static char const rcsid[] =
+ "@(#) $Id: htmlwish.c,v 1.10 2005/03/23 23:56:27 danielk1977 Exp $";
+
+/*
+** Make a "wish" that includes the html widget.
+**
+** This source code is released into the public domain by the author,
+** D. Richard Hipp, on 2002 December 17. Instead of a license, here
+** is a blessing:
+**
+** May you do good and not evil.
+** May you find forgiveness for yourself and forgive others.
+** May you share freely, never taking more than you give.
+*/
+#include "appinit.h"
+
+#ifndef _TCLHTML_
+int Et_AppInit(interp)
+ Tcl_Interp *interp;
+{
+ extern int Tkhtml_Init(Tcl_Interp *);
+ Tkhtml_Init(interp);
+ return TCL_OK;
+}
+#endif
diff --git a/src/restrack.c b/src/restrack.c
index 7860091..0d0943e 100644
--- a/src/restrack.c
+++ b/src/restrack.c
@@ -61,7 +61,7 @@
* POSSIBILITY OF SUCH DAMAGE.
*
*/
-static const char rcsid[] = "$Id: restrack.c,v 1.11 2007/01/27 12:53:15 danielk1977 Exp $";
+static const char rcsid[] = "$Id: restrack.c,v 1.13 2007/12/12 04:50:29 danielk1977 Exp $";
#ifdef HTML_RES_DEBUG
#define RES_DEBUG
@@ -216,7 +216,7 @@ ResAlloc(v1, v2)
pRec->aStack[pRec->nStack - 1] = aFrame;
#endif
- aResCounts[(int)v1]++;
+ aResCounts[(int)((size_t) v1)]++;
}
/*
@@ -269,7 +269,7 @@ ResFree(v1, v2)
}
#endif
- aResCounts[(int)v1]--;
+ aResCounts[(int)((size_t) v1)]--;
}
/*
@@ -634,7 +634,7 @@ Rt_Free(p)
memset(z, 0x55, n);
ckfree((char *)&z[-2]);
ResFree(RES_ALLOC, &z[-2]);
- freeMallocHash(z, n);
+ freeMallocHash((char *) z, n);
}
}
diff --git a/src/restrack.h b/src/restrack.h
index b717c6e..06a7432 100644
--- a/src/restrack.h
+++ b/src/restrack.h
@@ -8,6 +8,7 @@
char * Rt_Alloc(const char * ,int);
char * Rt_Realloc(const char *, char *, int);
void Rt_Free(char *);
+int HtmlHeapDebug(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj * const objv[]);
Tcl_ObjCmdProc Rt_AllocCommand;
Tcl_ObjCmdProc HtmlHeapDebug;
diff --git a/src/tokenlist.txt b/src/tokenlist.txt
index 99568f3..8a49501 100644
--- a/src/tokenlist.txt
+++ b/src/tokenlist.txt
@@ -1,5 +1,5 @@
#
-# $Revision: 1.43 $
+# $Revision: 1.45 $
#
# tokenlist.tcl --
#
@@ -91,7 +91,7 @@ TAG a -flow inline -content HtmlAnchorContent
# TAG abbr
# TAG acronym
TAG address
-TAG applet
+TAG applet -flow inline
TAG area -content HtmlEmptyContent
TAG base -content HtmlEmptyContent
TAG basefont
@@ -111,7 +111,7 @@ TAG code -flow inline
TAG dd -content HtmlLiContent
# TAG del
TAG dfn -flow inline
-TAG dir -flow block
+TAG dir -flow block -content HtmlUlContent
TAG div -flow block
TAG dl -flow block -content HtmlDlContent
TAG dt -content HtmlLiContent
@@ -141,7 +141,7 @@ TAG legend -flow inline
TAG li -content HtmlLiContent
TAG link -content HtmlEmptyContent
TAG map -flow inline
-TAG menu -flow block
+TAG menu -flow block -content HtmlUlContent
TAG meta -content HtmlEmptyContent
TAG noframes
TAG noscript
diff --git a/tests/all.test b/tests/all.test
new file mode 100644
index 0000000..4a1d17d
--- /dev/null
+++ b/tests/all.test
@@ -0,0 +1,8 @@
+# Run all tests
+#
+cd [file dirname $argv0]
+set me [file tail $argv0]
+foreach file [lsort -dictionary [glob *.test]] {
+ if {$file==$me} continue
+ source $file
+}
diff --git a/tests/autotest.test b/tests/autotest.test
new file mode 100644
index 0000000..0ac211c
--- /dev/null
+++ b/tests/autotest.test
@@ -0,0 +1,30 @@
+
+if {[info exists INAUTOTEST]} return
+set testdir [file dirname [info script]]
+
+set files [list \
+ tree.test \
+ style.test \
+]
+
+###########################################################################
+
+catch {memory init on}
+
+set auto_path [concat . $auto_path]
+package require Tkhtml
+package require tcltest
+tcltest::configure -verbose {body error pass}
+
+set INAUTOTEST 1
+if {![info exists INTEST]} {
+ foreach f $files {
+ if {[catch {source $testdir/$f} msg]} {
+ puts stderr $msg
+ }
+ }
+ exit
+}
+
+
+
diff --git a/tests/canvas.tcl b/tests/canvas.tcl
new file mode 100644
index 0000000..aff0949
--- /dev/null
+++ b/tests/canvas.tcl
@@ -0,0 +1,304 @@
+
+# catch {memory init on}
+# catch {memory onexit mem.out}
+# catch {memory validate on}
+
+# Required packages
+set auto_path [concat . $auto_path]
+package require Tkhtml
+catch {
+ package require Img
+}
+
+# Procedure to return the contents of a file-system entry
+proc readFile {fname} {
+ set ret {}
+ catch {
+ set fd [open $fname]
+ set ret [read $fd]
+ close $fd
+ }
+ return $ret
+}
+
+proc tree_to_html {indent tree} {
+ set in [string repeat " " $indent]
+ if {[regexp {^TEXT} $tree]} {
+ puts -nonewline "$in"
+ puts $tree
+ } else {
+ set tag [lindex $tree 0]
+ puts "$in<$tag>"
+ foreach child [lindex $tree 1] {
+ tree_to_html [expr $indent + 2] $child
+ }
+ puts "$in</$tag>"
+ }
+}
+
+proc scriptcommand {line_number tag tarargs script} {
+ if {$tag=="style"} {
+ append ::STYLE_TEXT $script
+ puts $script
+ }
+ return ""
+}
+
+proc stylecmd {style} {
+ append ::STYLE_TEXT $style
+ append ::STYLE_TEXT "\n"
+ return ""
+}
+
+proc scriptcmd {script} {
+ return ""
+}
+
+proc linkcmd {node} {
+ set rel [string tolower [$node attr rel]]
+ set media [string tolower [$node attr media]]
+ set media_list [list all visual screen ""]
+ if {[string compare $rel stylesheet]==0 && [lsearch $media_list $media]!=-1} {
+ set href [$node attr href]
+ set filename [file join $::BASE $href]
+ lappend ::STYLESHEET_FILES $filename
+ }
+}
+
+set HTML .h
+proc main {document css} {
+
+ html $::HTML
+
+ $::HTML handler script script dummycmd
+ $::HTML handler script style stylecmd
+ $::HTML handler node link linkcmd
+
+ set ::STYLESHEET_FILES {}
+ set ::STYLE_TEXT {}
+ set parsetime [time {
+ $::HTML parse $document
+ $::HTML style parse agent $css
+ while {[llength $::STYLESHEET_FILES]>0} {
+ set ss [lindex $::STYLESHEET_FILES 0]
+ set ::STYLESHEET_FILES [lrange $::STYLESHEET_FILES 1 end]
+ $::HTML style parse author [readFile $ss]
+ }
+ $::HTML style parse author $::STYLE_TEXT
+ }]
+ puts "Parse time [lrange $parsetime 0 1]"
+
+ $::HTML style parse author.1 {
+ img { -tkhtml-replace: tcl(replace_img) }
+ object { -tkhtml-replace: tcl(replace_img) }
+ input { -tkhtml-replace: tcl(replace_input) }
+ select { -tkhtml-replace: tcl(replace_select) }
+ }
+
+ set s [$::HTML style syntax_errs]
+ puts "$s syntax errors in style sheet"
+
+ set styletime [time {
+ $::HTML style apply
+ }]
+ puts "Style time [lrange $styletime 0 1]"
+}
+
+set W 800
+proc redraw {{w 0}} {
+ if {$w==0} {
+ set w $::W
+ } else {
+ set ::W $w
+ }
+ set codetime [time {$::HTML layout force -width $w -win .c}]
+ puts "Layout time [lrange $codetime 0 1]"
+ set tclizetime [time {set code [$::HTML layout primitives]}]
+ puts "Tclize time [lrange $tclizetime 0 1]"
+ set drawtime [time {draw_to_canvas $code .c 0 0}]
+ puts "Draw time [lrange $drawtime 0 1]"
+}
+
+proc replace_img {node} {
+ if {[$node tag]=="object"} {
+ set filename [file join $::BASE [$node attr data]]
+ } else {
+ set filename [file join $::BASE [$node attr src]]
+ }
+ if [catch { set img [image create photo -file $filename] } msg] {
+ puts "Error: $msg"
+ error $msg
+ }
+ return $img
+}
+
+set CONTROL 0
+proc replace_input {node} {
+ set tkname ".control[incr ::CONTROL]"
+ set width [$node attr width]
+ if {$width==""} {
+ set width 20
+ }
+
+ switch -exact [$node attr type] {
+ image {
+ return [replace_img $node]
+ }
+ hidden {
+ return ""
+ }
+ checkbox {
+ return [checkbutton $tkname]
+ }
+ radio {
+ return [checkbutton $tkname]
+ }
+ submit {
+ return [button $tkname -text Submit]
+ }
+ default {
+ entry $tkname -width $width
+ return $tkname
+ }
+ }
+ return ""
+}
+
+proc replace_select {node} {
+ set tkname ".control[incr ::CONTROL]"
+ button $tkname -text Select
+ return $tkname
+}
+
+proc draw_origin {x y} {
+ upvar X X
+ upvar Y Y
+ upvar C C
+
+ incr X $x
+ incr Y $y
+}
+
+proc draw_text {x y font color string} {
+ upvar X X
+ upvar Y Y
+ upvar C C
+
+ incr x $X
+ incr y $Y
+
+ # The Y coordinate supplied by the layout code is for the baseline of the
+ # text item. The canvas widget doesn't support this, so decrement Y by
+ # the font metric 'ascent' value and anchor the nw corner of the text to
+ # simulate it.
+ set ascent [font metrics $font -ascent]
+ incr y [expr -1*$ascent]
+
+ $C create text $x $y -font $font -fill $color -text $string -anchor nw
+}
+
+proc draw_quad {x1 y1 x2 y2 x3 y3 x4 y4 color} {
+ upvar X X
+ upvar Y Y
+ upvar C C
+
+ foreach v {x1 x2 x3 x4} {incr $v $X}
+ foreach v {y1 y2 y3 y4} {incr $v $Y}
+ $C create polygon $x1 $y1 $x2 $y2 $x3 $y3 $x4 $y4 -fill $color
+}
+
+proc draw_image {x y image} {
+ upvar X X
+ upvar Y Y
+ upvar C C
+
+ incr x $X
+ incr y $Y
+ $C create image $x $y -image $image -anchor nw
+}
+
+proc draw_window {x y window} {
+ upvar X X
+ upvar Y Y
+ upvar C C
+
+ incr x $X
+ incr y $Y
+ $C create window $x $y -window $window -anchor nw
+}
+
+proc draw_background {color} {
+ upvar C C
+ $C configure -background $color
+}
+
+proc draw_to_canvas {code c x y} {
+ $c delete all
+
+ set X $x
+ set Y $y
+ set C $c
+
+ foreach instruction $code {
+ # puts $instruction
+ eval $instruction
+ }
+
+ set scrollregion [$c bbox all]
+ if {[llength $scrollregion]==4} {
+ lset scrollregion 0 0
+ lset scrollregion 1 0
+ $c configure -scrollregion $scrollregion
+ }
+ puts "Scrollregion: $scrollregion"
+}
+
+proc new_document {{r 1}} {
+ # catch {destroy $::HTML}
+ if {[llength $::DOCS]==0} {
+ rename $::HTML {}
+ exit
+ }
+ set ::BASE [file dirname [lindex $::DOCS 0]]
+ main [readFile [lindex $::DOCS 0]] $::CSS
+ set ::DOCS [lrange $::DOCS 1 end]
+ if {$r} redraw
+}
+
+wm geometry . 800x600
+
+frame .buttons
+button .buttons.correct -text Incorrect -command new_document
+button .buttons.incorrect -text Correct -command new_document
+
+pack .buttons.correct .buttons.incorrect -side left
+pack .buttons -side bottom -fill x
+
+scrollbar .s -orient vertical
+scrollbar .s2 -orient horizontal
+canvas .c -background grey
+pack .s -side right -fill y
+pack .s2 -side bottom -fill x
+pack .c -fill both -expand true
+
+.c configure -yscrollcommand {.s set}
+.c configure -xscrollcommand {.s2 set}
+.s configure -command {.c yview}
+.s2 configure -command {.c xview}
+
+bind .c <Configure> {redraw [expr %w - 5]}
+bind .c <KeyPress-Down> {.c yview scroll 1 units}
+bind .c <KeyPress-Up> {.c yview scroll -1 units}
+focus .c
+
+set cssfile [file join [file dirname [info script]] html.css]
+set CSS [readFile $cssfile]
+
+set arg [lindex $argv 0]
+if {[file isdirectory $arg]} {
+ set DOCS [lsort [glob [file join [lindex $argv 0] *.html]]]
+} else {
+ set DOCS $arg
+}
+
+new_document 0
diff --git a/tests/encoding.bt b/tests/encoding.bt
new file mode 100644
index 0000000..509e880
--- /dev/null
+++ b/tests/encoding.bt
@@ -0,0 +1,106 @@
+
+# This test script tests some browser behaviour related to encodings
+# (charsets). Test plan is as follows:
+#
+# encoding.1.* - Test that charsets specified as both HTTP
+# Content-Type headers or their <meta> tag equivalents
+# are handled.
+#
+# encoding.2.* - Test that Hv3 works around the polipo bug. This is
+# only really important for Hv3.
+#
+
+set str "\xC0\xC1"
+
+set encoding.1.javascript {
+ var div = document.getElementById("div");
+ var str = div.firstChild.data
+ return str.charCodeAt(0) + "." + str.charCodeAt(1)
+}
+
+#--------------------------------------------------------------------------
+# START encoding.1.*
+#
+# Test with no <meta> tag and no Content-Type header.
+#
+do_browser_test encoding.1.1 -html [subst {
+ <DIV id="div">[encoding convertto iso8859-1 $str]</DIV>
+}] -javascript ${encoding.1.javascript}
+
+# Test with a <meta> tag only.
+#
+do_browser_test encoding.1.2 -html [subst {
+ <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+ <DIV id="div">[encoding convertto utf-8 $str]</DIV>
+}] -javascript ${encoding.1.javascript}
+
+# Test with Content-Type header only.
+#
+do_browser_test encoding.1.3 -encoding utf-8 -html [subst {
+ <DIV id="div">[encoding convertto utf-8 $str]</DIV>
+}] -javascript ${encoding.1.javascript}
+
+# Test with Content-Type and matching <meta> tag.
+#
+do_browser_test encoding.1.4 -encoding utf-8 -html [subst {
+ <META http-equiv="Content-Type" content="text/html; charset=utf-8" >
+ <DIV id="div">[encoding convertto utf-8 $str]</DIV>
+}] -javascript ${encoding.1.javascript}
+
+# Test with Content-Type and conflicting <meta> tag. In this case the
+# Content-Type should take precedence. Previous versions of Hv3 had
+# this wrong.
+#
+do_browser_test encoding.1.5 -encoding utf-8 -html [subst {
+ <META http-equiv="Content-Type" content="text/html; charset=windows-1252">
+ <DIV id="div">[encoding convertto utf-8 $str]</DIV>
+}] -javascript ${encoding.1.javascript}
+
+# Test with an incorrect <meta> tag only. In this case firefox does not
+# do any encoding detection - it just uses the explicitly specified
+# one in the same way as Hv3.
+#
+do_browser_test encoding.1.6 -html [subst {
+ <meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
+ <DIV id="div">[encoding convertto utf-8 $str]</DIV>
+}] -javascript ${encoding.1.javascript}
+#
+# END encoding.1.*
+#--------------------------------------------------------------------------
+
+
+proc enc_slow_css {channel} {
+ enc_slow_part1 $channel {
+HTTP/1.1 200 OK
+Content-type: text/css
+Cache-Control: s-maxage=10
+
+.hello { color: green }
+} {
+.tall { height: 500px }
+}
+}
+
+proc enc_slow_part1 {channel data1 data2} {
+ puts -nonewline $channel [string trimleft $data1]
+ flush $channel
+ after 1000 [list enc_slow_part2 $channel $data2]
+}
+
+proc enc_slow_part2 {channel data} {
+ puts -nonewline $channel $data
+ flush $channel
+ close $channel
+}
+
+do_browser_test encoding.2.1 -html {
+
+ <style> @import "/tcl?script=enc_slow_css" ; </style>
+ <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+
+ <DIV id="div" class="tall">...
+ </DIV>
+} -javascript {
+ return document.getElementById("div").offsetHeight
+}
+
diff --git a/tests/engine.tcl b/tests/engine.tcl
new file mode 100644
index 0000000..205e89c
--- /dev/null
+++ b/tests/engine.tcl
@@ -0,0 +1,165 @@
+# This file contains the test driver for the html widget. It defines
+# a special version of the test procedure to use for testing the
+# html widget.
+#
+
+# $Id: engine.tcl,v 1.2 2003/01/28 05:01:05 hkoba Exp $
+
+# Make sure the html widget is loaded into
+# our interpreter
+#
+if {[info command html]==""} {
+ if {[catch {package require Tkhtml} error]} {
+ foreach f {
+ ./libTkhtml*.so
+ ../libTkhtml*.so
+ /usr/lib/libTkhtml*.so
+ /usr/local/lib/libTkhtml*.so
+ ./tkhtml.dll
+ } {
+ if {[set f [lindex [glob -nocomplain $f] end]] != ""} {
+ if {[catch {load $f Tkhtml}]==0} break
+ }
+ }
+ }
+}
+
+# Initialize variables
+#
+namespace eval tcltest {
+ set mode run
+ set current {}
+ set passed 0
+ set failed 0
+ set total 0
+ set status {}
+}
+
+# Arguments:
+#
+# tag A symbolic tag for this test. Ex: html-1.0
+#
+# desc A human-readable description of what this test does.
+#
+# script Tcl code to implement the test
+#
+# result The expected result from this test. If the actual result
+# is different the test fails.
+#
+proc ::tcltest::test {tag desc script result} {
+ ::tcltest::change-desc $tag $desc
+ if {[info exists ::tcltest::idle]} {
+ catch {after cancel $::tcltest::idle}
+ catch {unset ::tcltest::idle}
+ }
+ set rc [catch {uplevel #0 $script} msg]
+ set r [list $rc $msg]
+ if {$r==$result} {
+ incr ::tcltest::passed
+ puts "---- Test $tag passed"
+ } else {
+ incr ::tcltest::failed
+ puts "**** Test $tag failed"
+ puts "Expected: [list $result]"
+ puts "Got: [list $r]"
+ }
+ incr ::tcltest::total
+ ::tcltest::update-status
+ set ::tcltest::idle [after 100 ::tcltest::testing-complete]
+}
+
+# Create the test control window
+#
+proc ::tcltest::mainwin {} {
+ set w .testinfo
+ toplevel $w
+ wm title $w {Html Widget Test Information}
+ wm iconname $w {Html-Test}
+ set f $w.f1
+ frame $f
+ pack $f -side top -fill x
+ label $f.l -text {Status: }
+ label $f.v -textvariable ::tcltest::status
+ pack $f.l $f.v -side left
+ set f $w.f2
+ frame $f
+ pack $f -side top -fill x
+ label $f.l -text {Current Test: }
+ label $f.v -textvariable ::tcltest::current
+ pack $f.l $f.v -side left
+ set f $w.b
+ frame $f
+ pack $f -side bottom -fill x
+ button $f.pause -text Pause -command ::tcltest::pause
+ button $f.pass -text {Pass} -command {::tcltest::set-result pass}
+ button $f.fail -text {Fail} -command {::tcltest::set-result fail}
+ button $f.exit -text Exit -command exit
+ pack $f.pause $f.pass $f.fail $f.exit -side right -pady 10 -expand 1
+ scrollbar $w.sb -orient vertical -command "$w.t yview"
+ pack $w.sb -side right -fill y
+ html $w.t -yscrollcommand "$w.sb set" -width 400 -height 150 \
+ -bd 2 -relief sunken -padx 5 -pady 5
+ pack $w.t -side right -fill both -expand 1
+ ::tcltest::update-status
+}
+
+# Change the test description in the control window
+#
+proc ::tcltest::change-desc {tag desc} {
+ if {![winfo exists .testinfo]} ::tcltest::mainwin
+ .testinfo.t clear
+ .testinfo.t parse $desc\n
+ set ::tcltest::current $tag
+}
+
+# Update the status line
+#
+proc ::tcltest::update-status {} {
+ set v "$::tcltest::passed passed $::tcltest::failed failed "
+ append v "$::tcltest::total total"
+ set ::tcltest::status $v
+}
+
+# Wait for the user to press either the pass or failed buttons.
+#
+proc ::tcltest::user-result {} {
+ .testinfo.b.pass config -state normal
+ .testinfo.b.fail config -state normal
+ update
+ raise .testinfo
+ focus .testinfo.b.pass
+ set ::tcltest::result {}
+ vwait ::tcltest::result
+ .testinfo.b.pass config -state disabled
+ .testinfo.b.fail config -state disabled
+ return $::tcltest::result
+}
+
+# Called when the user presses either the failed or passed buttons.
+#
+proc ::tcltest::set-result v {
+ set ::tcltest::result $v
+}
+
+# Call this routine at the end of all tests
+#
+proc ::tcltest::testing-complete {} {
+ ::tcltest::change-desc {} {Testing is now complete}
+}
+
+# Construct an HTML widget to use for testing.
+#
+proc tkhtml_test_widget {} {
+ set w .tkhtml_test
+ if {[winfo exists $w]} {
+ return $w.h
+ }
+ toplevel $w
+ wm title $w {TkHtml Test Widget}
+ wm iconname $w {TkHtml Test}
+ scrollbar $w.sb -orient vertical -command "$w.h yview"
+ pack $w.sb -side right -fill y
+ html $w.h -yscrollcommand "$w.sb set"
+ pack $w.h -side right -fill both -expand 1
+ return $w.h
+}
diff --git a/tests/events.bt b/tests/events.bt
index a790c5f..1fca693 100644
--- a/tests/events.bt
+++ b/tests/events.bt
@@ -38,3 +38,56 @@ if 0 {_
} -expected "three two one"
}
+
+proc slow_html {channel} {
+puts SLOWHTML
+ slow_part1 $channel {
+HTTP/1.1 200 OK
+Content-type: text/html
+Cache-Control: no-cache
+
+<p> Paragraph 1</p>
+} {
+<p> Paragraph 2</p>
+}
+}
+
+proc slow_css {channel} {
+ slow_part1 $channel {
+HTTP/1.1 200 OK
+Content-type: text/css
+Cache-Control: no-cache
+
+} {
+.tall { height: 500px }
+}
+}
+
+proc slow_part1 {channel data1 data2} {
+ puts -nonewline $channel [string trimleft $data1]
+ flush $channel
+ after 1000 [list slow_part2 $channel $data2]
+}
+
+proc slow_part2 {channel data} {
+ puts -nonewline $channel $data
+ flush $channel
+ close $channel
+}
+
+# This is to test that the browser waits until all stylesheets are
+# downloaded and applied before firing the "onload" event.
+#
+do_browser_test events.1 -timeout 10000000 -html {
+ <STYLE>
+ @import "/tcl?script=slow_css";
+ div { height: 50px }
+ </STYLE>
+ <BODY>
+ <DIV class="tall" id="me">hello</DIV>
+} -javascript {
+ var div = document.getElementById("me")
+ return div.offsetHeight
+}
+
+
diff --git a/tests/form.bt b/tests/form.bt
index b67aee7..52723d6 100644
--- a/tests/form.bt
+++ b/tests/form.bt
@@ -26,21 +26,21 @@ set ::Doc {
# The reference to forms[0].i_one is a collection, because
# there is more than one element named i_one.
#
-::browsertest::do_test forms.1 -html $::Doc -javascript {
+do_browser_test forms.1 -html $::Doc -javascript {
return document.forms.one.i_one.length
} -expected 2
# But forms[0].i_two is the HTMLInputElement.
#
-::browsertest::do_test forms.2 -html $::Doc -javascript {
+do_browser_test forms.2 -html $::Doc -javascript {
return document.forms[0].i_two.type
} -expected "text"
-::browsertest::do_test forms.3 -html $::Doc -javascript {
+do_browser_test forms.3 -html $::Doc -javascript {
return document.forms[0].i_three.type
} -expected "text"
-::browsertest::do_test forms.4 -html $::Doc -javascript {
+do_browser_test forms.4 -html $::Doc -javascript {
return document.forms[0].i_four.length
} -expected 2
diff --git a/src/html.css b/tests/html.css
similarity index 56%
copy from src/html.css
copy to tests/html.css
index 2690320..80709cb 100644
--- a/src/html.css
+++ b/tests/html.css
@@ -1,13 +1,11 @@
/* Display types for non-table items. */
ADDRESS, BLOCKQUOTE, BODY, DD, DIV, DL, DT, FIELDSET,
- FRAME, H1, H2, H3, H4, H5, H6, NOFRAMES,
- OL, P, UL, APPLET, CENTER, DIR, HR, MENU, PRE, FORM
+ FRAME, FRAMESET, H1, H2, H3, H4, H5, H6, NOFRAMES,
+ OL, P, UL, APPLET, CENTER, DIR, HR, MENU, PRE
{ display: block }
HEAD, SCRIPT, TITLE { display: none }
-BODY {
- margin:8px;
-}
+BODY { margin: 8px; }
/* Rules for unordered-lists */
LI { display: list-item }
@@ -20,8 +18,6 @@ LI[type="disc"] { list-style-type : disc }
OL, UL, DIR, MENU, DD { padding-left: 40px ; margin-left: 1em }
-OL[type] { list-style-type : tcl(::tkhtml::ol_liststyletype) }
-
NOBR {
white-space: nowrap;
}
@@ -31,14 +27,11 @@ NOBR {
* for different elements.
*/
TABLE[align="left"] { float:left }
-TABLE[align="right"] {
- float:right;
- text-align: inherit;
-}
+TABLE[align="right"] { float:right }
TABLE[align="center"] {
- margin-left:auto;
- margin-right:auto;
- text-align:inherit;
+ margin-left:auto;
+ margin-right:auto;
+ text-align:left;
}
IMG[align="left"] { float:left }
IMG[align="right"] { float:right }
@@ -49,9 +42,11 @@ IMG[align="right"] { float:right }
*
* Also the <center> tag means to center align things.
*/
-[align="right"] { text-align: -tkhtml-right }
-[align="left"] { text-align: -tkhtml-left }
-CENTER, [align="center"] { text-align: -tkhtml-center }
+[align="center"] { text-align:center }
+[align="right"] { text-align:right }
+[align="left"] { text-align:left }
+CENTER { text-align: center }
+
/* Rules for unordered-lists */
/* Todo! */
@@ -96,12 +91,6 @@ TABLE {
border-right-color: grey25;
border-top-color: grey60;
border-left-color: grey60;
-
- /* <table> elements do not inherit text-align by default. Strictly
- * speaking, this rule should not be used with documents that
- * use the "strict" DTD. Or something.
- */
- text-align: left;
}
TR { display: table-row }
@@ -153,8 +142,7 @@ PRE, PLAINTEXT, XMP {
}
/* Display properties for hyperlinks */
-:link { color: darkblue; text-decoration: underline ; cursor: pointer }
-:visited { color: purple; text-decoration: underline ; cursor: pointer }
+:link { color: darkblue; text-decoration: underline }
/* Deal with the "nowrap" HTML attribute on table cells. */
TD[nowrap] , TH[nowrap] { white-space: nowrap; }
@@ -169,71 +157,17 @@ BR {
* Default decorations for form items.
*/
INPUT[type="hidden"] { display: none }
-INPUT[type] { border: none }
-
-INPUT, INPUT[type="file"], INPUT[type="text"], INPUT[type="password"],
-TEXTAREA, SELECT {
- border: 2px solid;
- border-color: #848280 #ececec #ececec #848280;
- line-height: normal;
-}
-
-INPUT[type="image"][src] { -tkhtml-replacement-image: attr(src) }
-/*
- * Default style for buttons created using <input> elements.
- */
-INPUT[type="submit"],INPUT[type="button"] {
- display: -tkhtml-inline-button;
+INPUT[type] { border: none }
+INPUT, INPUT[type="text"], INPUT[type="password"] {
border: 2px solid;
- border-color: #ffffff #828282 #828282 #ffffff;
- background-color: #d9d9d9;
- color: #000000;
- /* padding: 3px 10px 1px 10px; */
- padding: 3px 3px 1px 3px;
- white-space: nowrap;
- color: tcl(::tkhtml::if_disabled #666666 #000000);
-}
-INPUT[type="submit"]:after,INPUT[type="button"]:after {
- content: attr(value);
- position: relative;
-}
-
-INPUT[type="submit"]:hover:active,INPUT[type="button"]:hover:active {
- border-top-color: tcl(::tkhtml::if_disabled #ffffff #828282);
- border-left-color: tcl(::tkhtml::if_disabled #ffffff #828282);
- border-right-color: tcl(::tkhtml::if_disabled #828282 #ffffff);
- border-bottom-color: tcl(::tkhtml::if_disabled #828282 #ffffff);
-}
-
-INPUT[size] { width: tcl(::tkhtml::inputsize_to_css) }
-
-BUTTON {
- white-space:nowrap;
- border-width: 2px;
- border-style: solid;
-}
-
-/* Handle "cols" and "rows" on a <textarea> element. By default, use
- * a fixed width font in <textarea> elements.
- */
-TEXTAREA[cols] { width: tcl(::tkhtml::textarea_width) }
-TEXTAREA[rows] { height: tcl(::tkhtml::textarea_height) }
-TEXTAREA {
- font-family: fixed;
+ border-color: #848280 #faf9f7 #faf9f7 #848280;
}
FRAMESET {
display: none;
}
-/* Default size for <IFRAME> elements */
-IFRAME {
- width: 300px;
- height: 200px;
-}
-
-
/*
*************************************************************************
* Below this point are stylesheet rules for mapping presentational
@@ -243,23 +177,22 @@ IFRAME {
*/
/* 'color' */
-[color] { color: attr(color) }
-body a[href]:link { color: attr(link x body) }
-body a[href]:visited { color: attr(vlink x body) }
+[color] { color: tcl(::tkhtml::attr color -color) }
+body a[href]:link { color: tcl(::tkhtml::aa body link -color) }
+body a[href]:visited { color: tcl(::tkhtml::aa body vlink -color) }
/* 'width', 'height', 'background-color' and 'font-size' */
-[width] { width: attr(width l) }
-[height] { height: attr(height l) }
-basefont[size] { font-size: attr(size) }
-font[size] { font-size: tcl(::tkhtml::size_to_fontsize) }
-[bgcolor] { background-color: attr(bgcolor) }
+[width] { width: tcl(::tkhtml::attr width -len) }
+[height] { height: tcl(::tkhtml::attr height -len) }
+basefont[size] { font-size: tcl(::tkhtml::attr size) }
+font[size] { font-size: tcl(::tkhtml::attr size) }
+[bgcolor] { background-color: tcl(::tkhtml::attr bgcolor -color) }
-BR[clear] { clear: attr(clear) }
+BR[clear] { clear: tcl(::tkhtml::attr clear) }
BR[clear="all"] { clear: both; }
/* Standard html <img> tags - replace the node with the image at url $src */
-IMG[src] { -tkhtml-replacement-image: attr(src) }
-IMG { -tkhtml-replacement-image: "" }
+IMG[src] { -tkhtml-replacement-image: tcl(::tkhtml::attr src) }
/*
* Properties of table cells (th, td):
@@ -270,30 +203,30 @@ IMG { -tkhtml-replacement-image: "" }
* 'border-spacing'
*/
TABLE[border], TABLE[border] TD, TABLE[border] TH {
- border-top-width: attr(border l table);
- border-right-width: attr(border l table);
- border-bottom-width: attr(border l table);
- border-left-width: attr(border l table);
-
- border-top-style: attr(border x table solid);
- border-right-style: attr(border x table solid);
- border-bottom-style: attr(border x table solid);
- border-left-style: attr(border x table solid);
+ border-top-width: tcl(::tkhtml::aa table border -len);
+ border-right-width: tcl(::tkhtml::aa table border -len);
+ border-bottom-width: tcl(::tkhtml::aa table border -len);
+ border-left-width: tcl(::tkhtml::aa table border -len);
+
+ border-top-style: tcl(::tkhtml::aa table border -if solid);
+ border-right-style: tcl(::tkhtml::aa table border -if solid);
+ border-bottom-style: tcl(::tkhtml::aa table border -if solid);
+ border-left-style: tcl(::tkhtml::aa table border -if solid);
}
TABLE[border=""], TABLE[border=""] td, TABLE[border=""] th {
- border-top-width: attr(border x table solid);
- border-right-width: attr(border x table solid);
- border-bottom-width: attr(border x table solid);
- border-left-width: attr(border x table solid);
+ border-top-width: tcl(::tkhtml::aa table border -if 1px);
+ border-right-width: tcl(::tkhtml::aa table border -if 1px);
+ border-bottom-width: tcl(::tkhtml::aa table border -if 1px);
+ border-left-width: tcl(::tkhtml::aa table border -if 1px);
}
TABLE[cellpadding] td, TABLE[cellpadding] th {
- padding-top: attr(cellpadding l table);
- padding-right: attr(cellpadding l table);
- padding-bottom: attr(cellpadding l table);
- padding-left: attr(cellpadding l table);
+ padding-top: tcl(::tkhtml::aa table cellpadding -len);
+ padding-right: tcl(::tkhtml::aa table cellpadding -len);
+ padding-bottom: tcl(::tkhtml::aa table cellpadding -len);
+ padding-left: tcl(::tkhtml::aa table cellpadding -len);
}
TABLE[cellspacing], table[cellspacing] {
- border-spacing: attr(cellspacing l);
+ border-spacing: tcl(::tkhtml::attr cellspacing -len);
}
/* Map the valign attribute to the 'vertical-align' property for table
@@ -301,43 +234,31 @@ TABLE[cellspacing], table[cellspacing] {
* valign if it is defined.
*/
TD,TH {vertical-align: middle}
-TR[valign]>TD, TR[valign]>TH {vertical-align: attr(valign x tr)}
-TR>TD[valign], TR>TH[valign] {vertical-align: attr(valign)}
+TR[valign]>TD, TR[valign]>TH {vertical-align: tcl(::tkhtml::aa tr valign)}
+TR>TD[valign], TR>TH[valign] {vertical-align: tcl(::tkhtml::attr valign)}
/* Support the "text" attribute on the <body> tag */
-body[text] {color: attr(text)}
+body[text] {color: tcl(::tkhtml::attr text -color)}
/* Allow background images to be specified using the "background" attribute.
* According to HTML 4.01 this is only allowed for <body> elements, but
* many websites use it arbitrarily.
*/
-[background] { background-image: attr(background) }
+[background] {
+ background-image: tcl(format "url(%s)" [::tkhtml::attr background])
+}
/* The vspace and hspace attributes map to margins for elements of type
* <IMG>, <OBJECT> and <APPLET> only. Note that this attribute is
* deprecated in HTML 4.01.
*/
IMG[vspace], OBJECT[vspace], APPLET[vspace] {
- margin-top: attr(vspace l);
- margin-bottom: attr(vspace l);
+ margin-top: tcl(::tkhtml::attr vspace -len);
+ margin-bottom: tcl(::tkhtml::attr vspace -len);
}
IMG[hspace], OBJECT[hspace], APPLET[hspace] {
- margin-left: attr(hspace l);
- margin-right: attr(hspace l);
-}
-
-/* marginheight and marginwidth attributes on <BODY> (netscape compatibility) */
-BODY[marginheight] {
- margin-top: attr(marginheight l);
- margin-bottom: attr(marginheight l);
-}
-BODY[marginwidth] {
- margin-left: attr(marginwidth l);
- margin-right: attr(marginwidth l);
-}
-
-SPAN[spancontent]:after {
- content: attr(spancontent);
+ margin-left: tcl(::tkhtml::attr hspace -len);
+ margin-right: tcl(::tkhtml::attr hspace -len);
}
diff --git a/tests/html1.test b/tests/html1.test
new file mode 100644
index 0000000..043113a
--- /dev/null
+++ b/tests/html1.test
@@ -0,0 +1,181 @@
+#
+# Test script for the Tk HTML widget
+#
+wm withdraw .
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file dirname $argv0]/engine.tcl
+ namespace import ::tcltest::*
+}
+
+::tcltest::test html-1.0 {
+ Verify that all of the entites are displayed correctly.
+} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse {
+<html>
+<h1>Entity and special character test</h1>
+<p>The following list shows each entity of HTML 3.2 in four
+formats: (1) the name, (2) as &entity;, (3) as {, and
+(4) as a raw UTF-8 or Ascii character.</p>
+<ul>
+<li> quot " " " </li>
+<li> amp & & & </li>
+<li> lt < < < </li>
+<li> gt > > > </li>
+<li> nbsp </li>
+<li> iexcl ¡ ¡ ¡ </li>
+<li> cent ¢ ¢ ¢ </li>
+<li> pound £ £ £ </li>
+<li> curren ¤ ¤ ¤ </li>
+<li> yen ¥ ¥ ¥ </li>
+<li> brvbar ¦ ¦ ¦ </li>
+<li> sect § § § </li>
+<li> uml ¨ ¨ ¨ </li>
+<li> copy © © © </li>
+<li> ordf ª ª ª </li>
+<li> laquo « « « </li>
+<li> not ¬ ¬ ¬ </li>
+<li> shy </li>
+<li> reg ® ® ® </li>
+<li> macr ¯ ¯ ¯ </li>
+<li> deg ° ° ° </li>
+<li> plusmn ± ± ± </li>
+<li> sup2 ² ² ² </li>
+<li> sup3 ³ ³ ³ </li>
+<li> acute ´ ´ ´ </li>
+<li> micro µ µ µ </li>
+<li> para ¶ ¶ ¶ </li>
+<li> middot · · · </li>
+<li> cedil ¸ ¸ ¸ </li>
+<li> sup1 ¹ ¹ ¹ </li>
+<li> ordm º º º </li>
+<li> raquo » » » </li>
+<li> frac14 ¼ ¼ ¼ </li>
+<li> frac12 ½ ½ ½ </li>
+<li> frac34 ¾ ¾ ¾ </li>
+<li> iquest ¿ ¿ ¿ </li>
+<li> Agrave À À À </li>
+<li> Aacute Á Á Á </li>
+<li> Acirc    </li>
+<li> Atilde à à à </li>
+<li> Auml Ä Ä Ä </li>
+<li> Aring Å Å Å </li>
+<li> AElig Æ Æ Æ </li>
+<li> Ccedil Ç Ç Ç </li>
+<li> Egrave È È È </li>
+<li> Eacute É É É </li>
+<li> Ecirc Ê Ê Ê </li>
+<li> Euml Ë Ë Ë </li>
+<li> Igrave Ì Ì Ì </li>
+<li> Iacute Í Í Í </li>
+<li> Icirc Î Î Î </li>
+<li> Iuml Ï Ï Ï </li>
+<li> ETH Ð Ð Ð </li>
+<li> Ntilde Ñ Ñ Ñ </li>
+<li> Ograve Ò Ò Ò </li>
+<li> Oacute Ó Ó Ó </li>
+<li> Ocirc Ô Ô Ô </li>
+<li> Otilde Õ Õ Õ </li>
+<li> Ouml Ö Ö Ö </li>
+<li> times × × × </li>
+<li> Oslash Ø Ø Ø </li>
+<li> Ugrave Ù Ù Ù </li>
+<li> Uacute Ú Ú Ú </li>
+<li> Ucirc Û Û Û </li>
+<li> Uuml Ü Ü Ü </li>
+<li> Yacute Ý Ý Ý </li>
+<li> THORN Þ Þ Þ </li>
+<li> szlig ß ß ß </li>
+<li> agrave à à à </li>
+<li> aacute á á á </li>
+<li> acirc â â â </li>
+<li> atilde ã ã ã </li>
+<li> auml ä ä ä </li>
+<li> aring å å å </li>
+<li> aelig æ æ æ </li>
+<li> ccedil ç ç ç </li>
+<li> egrave è è è </li>
+<li> eacute é é é </li>
+<li> ecirc ê ê ê </li>
+<li> euml ë ë ë </li>
+<li> igrave ì ì ì </li>
+<li> iacute í í í </li>
+<li> icirc î î î </li>
+<li> iuml ï ï ï </li>
+<li> eth ð ð ð </li>
+<li> ntilde ñ ñ ñ </li>
+<li> ograve ò ò ò </li>
+<li> oacute ó ó ó </li>
+<li> ocirc ô ô ô </li>
+<li> otilde õ õ õ </li>
+<li> ouml ö ö ö </li>
+<li> divide ÷ ÷ ÷ </li>
+<li> oslash ø ø ø </li>
+<li> ugrave ù ù ù </li>
+<li> uacute ú ú ú </li>
+<li> ucirc û û û </li>
+<li> uuml ü ü ü </li>
+<li> yacute ý ý ý </li>
+<li> thorn þ þ þ </li>
+<li> yuml ÿ ÿ ÿ </li>
+</ul>
+</html>
+}
+ ::tcltest::user-result
+} {0 pass}
+
+::tcltest::test html-1.1 {
+ Verify that all subscripting and superscripting works.
+} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse {
+<html>
+<body>
+<h1>A test of subscripting and superscripting</h1>
+
+<p>Here is sub<sub>script</sub>. And now super<sup>script</sup>.</p>
+<p>Here is sub<sub>sub<sub>script</sub></sub>.
+ And now super<sup>super<sup>script</sup></sup>.</p>
+
+<p>Here is sub<sub>super<sup>script</sup></sub></p>
+
+</body>
+</html>
+}
+ ::tcltest::user-result
+} {0 pass}
+
+::tcltest::test html-1.2 {
+ Verify stylistic markup.
+} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse {
+<html>
+<body>
+<h1>A test of font changing markup</h1>
+
+<p>This is normal text</p>
+<p><b>: <b>bold text</b></p>
+<p><big>: <big>big text</big></p>
+<p><cite>: <cite>cite text</cite></p>
+<p><code>: <code>code text</code></p>
+<p><em>: <em>emphasized text</em></p>
+<p><i>: <i>italic text</i></p>
+<p><kbd>: <kbd>keyboard text</kbd></p>
+<p><s>: <s>strike-thru text</s></p>
+<p><samp>: <samp>sample text</samp></p>
+<p><small>: <small>small text</small></p>
+<p><strike>: <strike>strike-thru text</strike></p>
+<p><strong>: <strong>strong text</strong></p>
+<p><tt>: <tt>teletype text</tt></p>
+<p><u>: <u>underlined text</u></p>
+<p><var>: <var>variable text</var></p>
+<p>This is normal text</p>
+</body>
+</html>
+}
+ ::tcltest::user-result
+} {0 pass}
diff --git a/tests/html2.test b/tests/html2.test
new file mode 100644
index 0000000..79f42a9
--- /dev/null
+++ b/tests/html2.test
@@ -0,0 +1,100 @@
+#
+# Test script for the Tk HTML widget
+#
+wm withdraw .
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file dirname $argv0]/engine.tcl
+ namespace import ::tcltest::*
+ cd [file dirname $argv0]
+}
+
+
+# in image to use for all GIFs.
+#
+image create photo nogifsm -data {
+ R0lGODdhEAAQAPEAAACQkADQ0PgAAAAAACwAAAAAEAAQAAACNISPacHtD4IQz80QJ60as25d
+ 3idKZdR0IIOm2ta0Lhw/Lz2S1JqvK8ozbTKlEIVYceWSjwIAO///
+}
+
+# A callback to handle image requests
+#
+proc ImageCmd {args} {
+ set fn [lindex $args 0]
+ if {[catch {image create photo -file $fn} img]} {
+ set img nogifsm
+ }
+ return $img
+}
+
+# Free all images
+#
+proc FreeImages {} {
+ foreach img [image names] {
+ image delete $img
+ }
+}
+
+# Create the HTML widget to use for all testing.
+#
+set h [tkhtml_test_widget]
+$h config -imagecommand ImageCmd
+
+::tcltest::test html-2.1 {
+ A snapshot of Slashdot on Jan 29, 2000.
+} {
+ set file page1/index.html
+ $h clear
+ set f [open $file r]
+ $h config -base $file
+ $h parse [read $f [file size $file]]
+ close $f
+ set r [::tcltest::user-result]
+ $h clear
+ FreeImages
+ return $r
+} {2 pass}
+
+::tcltest::test html-2.2 {
+ A snapshot of a page from the Scriptics website on Jan 29, 2000.
+} {
+ set file page2/index.html
+ $h clear
+ set f [open $file r]
+ $h config -base $file
+ $h parse [read $f [file size $file]]
+ close $f
+ set r [::tcltest::user-result]
+ $h clear
+ FreeImages
+ return $r
+} {2 pass}
+
+::tcltest::test html-2.3 {
+ A snapshot of freshmeat on Jan 29, 2000
+} {
+ set file page4/index.html
+ $h clear
+ set f [open $file r]
+ $h config -base $file
+ $h parse [read $f [file size $file]]
+ close $f
+ set r [::tcltest::user-result]
+ $h clear
+ FreeImages
+ return $r
+} {2 pass}
+
+::tcltest::test html-2.4 {
+ A slide show about mktclapp
+} {
+ set file page3/index.html
+ $h clear
+ set f [open $file r]
+ $h config -base $file
+ $h parse [read $f [file size $file]]
+ close $f
+ set r [::tcltest::user-result]
+ $h clear
+ FreeImages
+ return $r
+} {2 pass}
diff --git a/tests/html3.test b/tests/html3.test
new file mode 100644
index 0000000..f804f56
--- /dev/null
+++ b/tests/html3.test
@@ -0,0 +1,243 @@
+#
+# Test script for the Tk HTML widget
+#
+wm withdraw .
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file dirname $argv0]/engine.tcl
+ namespace import ::tcltest::*
+}
+
+::tcltest::test html-3.1 {Check the HTML parser for sanity} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse "<p align=center>Test1 \nEnd\n"
+ $h token list 1.0 end
+} {0 {{Markup p align center} {Text Test1} {Space 1 1} {Text End} {Space 1 1}}}
+
+::tcltest::test html-3.2 {Check that markup arguments are parsed correctly} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse {<p align="center" id='"5"' id2 = "'4'">}
+ $h token list 1.0 end
+} {0 {{Markup p align center id {"5"} id2 '4'}}}
+
+::tcltest::test html-3.3 {Check that comments are ignored} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse {<p><!-- This is comment --></p>}
+ $h token list 1.0 end
+} {0 {{Markup p} {Markup /p}}}
+
+::tcltest::test html-3.4 {Check that entities are resolved} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse {& <>H<p>}
+ $h token list 1.0 end
+} {0 {{Text {& <>H}} {Markup p}}}
+
+::tcltest::test html-3.5 {Check that spacing is recorded properly} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse "<pre>\n\tHi\tThere\n</pre>"
+ $h token list 1.0 end
+} {0 {{Markup pre} {Space 1 1} {Space 8 0} {Text Hi} {Space 6 0} {Text There} {Space 1 1} {Markup /pre}}}
+
+::tcltest::test html-3.6 {Script markup should become a single token} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse "<script>Contents of script are not tokenized</script>\n"
+ $h token list 1.0 end
+} {0 {{Markup script} {Space 1 1}}}
+
+::tcltest::test html-3.6b {Style markup should become a single token} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse "<style>Contents of style are not tokenized</style>\n"
+ $h token list 1.0 end
+} {0 {{Markup style} {Space 1 1}}}
+
+::tcltest::test html-3.7 {All markup within listing is normal text} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse "<listing><p>Hello</p></listing>\n"
+ $h token list 1.0 end
+} {0 {{Markup listing} {Text <p>Hello} {Text </p>} {Markup /listing} {Space 1 1}}}
+
+::tcltest::test html-3.8 {All markup within xmp is normal text} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse "<xmp><p>Hello</p></xmp>\n"
+ $h token list 1.0 end
+} {0 {{Markup xmp} {Text <p>Hello} {Text </p>} {Markup /xmp} {Space 1 1}}}
+
+::tcltest::test html-3.9 {All markup within textarea is treated as normal
+text. This is not valid HTML, but it is what Netscape does.} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse "<textarea><p>Hello</p></textarea>\n"
+ $h token list 1.0 end
+} {0 {{Markup textarea} {Text <p>Hello} {Text </p>} {Markup /textarea} {Space 1 1}}}
+
+::tcltest::test html-3.10 {All markup after plaintext become normal text} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse "<plaintext><p>Hello</p></plaintext>\n"
+ $h token list 1.0 end
+} {0 {{Markup plaintext} {Text <p>Hello} {Text </p>} {Text </plaintext>} {Space 1 1}}}
+
+::tcltest::test html-3.11 {Unrecognized markup is ignored} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse "<unknown>Text\n"
+ $h token list 1.0 end
+} {0 {{Text Text} {Space 1 1}}}
+
+::tcltest::test html-3.12 {Entities are resolved within markup arguments} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse {<p id="<hi>">}
+ $h token list 1.0 end
+} {0 {{Markup p id <hi>}}}
+
+::tcltest::test html-3.13 {Entites are resolved within markup arguments} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse {<p id=<hi>>}
+ $h token list 1.0 end
+} {0 {{Markup p id <hi>}}}
+
+::tcltest::test html-3.14 {White space within markup is ignored} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse {<br >}
+ $h token list 1.0 end
+} {0 {{Markup br}}}
+
+::tcltest::test html-3.15 {Whitespace within markup is ignored} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse {<br id = 5>}
+ $h token list 1.0 end
+} {0 {{Markup br id 5}}}
+
+::tcltest::test html-3.16 {Whitespace in markup is ignored} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse {<br id = 5 >}
+ $h token list 1.0 end
+} {0 {{Markup br id 5}}}
+
+::tcltest::test html-3.17 {Whitespace in markup is ignored} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse {<br id =5>}
+ $h token list 1.0 end
+} {0 {{Markup br id 5}}}
+
+::tcltest::test html-3.18 {Whitespace in markup is ignored} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse {<br id= 5 >}
+ $h token list 1.0 end
+} {0 {{Markup br id 5}}}
+
+::tcltest::test html-3.19 {Whitespace in markup is ignored, except when quoted} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse {<br id= " 5 " >}
+ $h token list 1.0 end
+} {0 {{Markup br id { 5 }}}}
+
+::tcltest::test html-3.20 {Tabs in markup are treated like whitespace} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse "<br id\t=\t' 5 '\t>"
+ $h token list 1.0 end
+} {0 {{Markup br id { 5 }}}}
+
+::tcltest::test html-3.21 {Newlines in markup are treated like whitespace} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse "<br id\n=\n\" 5 \"\n>"
+ $h token list 1.0 end
+} {0 {{Markup br id { 5 }}}}
+
+::tcltest::test html-3.22 {Markup arguments without values} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse "<br clear >"
+ $h token list 1.0 end
+} {0 {{Markup br clear {}}}}
+
+::tcltest::test html-3.23 {Markup arguments without values} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse "<br clear id=9>"
+ $h token list 1.0 end
+} {0 {{Markup br clear {} id 9}}}
+
+::tcltest::test html-3.24 {XHTML style / at the end of markup} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse {<br clear="both"/>}
+ $h token list 1.0 end
+} {0 {{Markup br clear both}}}
+
+::tcltest::test html-3.25 {XHTML style / at the end of markup} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse {<br />}
+ $h token list 1.0 end
+} {0 {{Markup br}}}
+
+::tcltest::test html-3.26 {XHTML style / at the end of markup} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse {<br/>}
+ $h token list 1.0 end
+} {0 {{Markup br}}}
+
+::tcltest::test html-3.27 {/ At the end of markup adds a second token} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse {<p />}
+ $h token list 1.0 end
+} {0 {{Markup p} {Markup /p}}}
+
+::tcltest::test html-3.28 {/ at the end of markup adds a second token} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse {<p/>}
+ $h token list 1.0 end
+} {0 {{Markup p} {Markup /p}}}
+
+::tcltest::test html-3.29 {/ not at the end of markup still work} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse "<A href=\"\" /privacy.html=\"/privacy.html\">\n"
+ $h token list 1.0 end
+} {0 {{Markup a href {} /privacy.html /privacy.html} {Space 1 1}}}
+
+::tcltest::test html-3.30 {Incremental parsing} {
+ set h [tkhtml_test_widget]
+ $h clear
+ set txt {<a href="" /privacy.html="none"/>Hello&<p>}
+ set len [string length $txt]
+ for {set i 0} {$i<$len} {incr i} {
+ $h parse [string index $txt $i]
+ }
+ $h token list 1.0 end
+} {0 {{Markup a href {} /privacy.html none} {Markup /a} {Text Hello&} {Markup p}}}
+
+::tcltest::test html-3.31 {Searching for anchors} {
+ set h [tkhtml_test_widget]
+ $h clear
+ $h parse {
+ <a name="one">One</a>
+ <a id="two">Two</a>
+ <a href="three">Three</a>
+ <a name="four" id="vier">Four</a>
+ }
+ update
+ $h names
+} {0 {one two four}}
diff --git a/tests/html4.test b/tests/html4.test
new file mode 100755
index 0000000..2b02342
--- /dev/null
+++ b/tests/html4.test
@@ -0,0 +1,64 @@
+#!/usr/bin/wish
+if {[info commands html] == ""} {
+ if {[file exists libTkhtml2.0.so]} {
+ load ./libTkhtml2.0.so
+ } else {
+ package require Tkhtml
+ }
+}
+package require tcltest
+
+::tcltest::test html-4.1 {textarea space after dot} {
+ set ::RESULT {}
+ proc FormCmd {n cmd args} {
+ if {$cmd != "textarea"} return
+ set ::RESULT [lindex $args end]
+ }
+ html .html -formcommand FormCmd
+ pack .html
+ .html parse {
+ <html><body><form action="submit" method="get">
+ <textarea name="test" cols="20" rows="2">A.B. C. D.</textarea>
+ </form></body></html>
+ }
+ # To force all FormCmd is executed...
+ update
+
+ set ::RESULT
+} {A.B. C. D.}
+
+::tcltest::test html-4.2 {pre space after dot} {
+ catch {destroy .html}
+ pack [html .html]
+ .html parse {<body>BEGIN<pre>A.B. C. D.</pre>END</body>}
+ .html text ascii 1 end
+} {BEGINA.B. C. D.END}
+
+::tcltest::test html-4.3 {SentencePadding A. B. C.} {
+ catch {destroy .html}
+ pack [html .html -sentencepadding 1]
+ .html parse {<h1>A. B. C.</h1>}
+ set result [.html text ascii 1 end]
+ destroy .html
+ set result
+} {A. B. C.}
+
+::tcltest::test html-4.4 {SentencePadding for D.C...} {
+ catch {destroy .html}
+ pack [html .html]
+ catch {.html configure -sentencepadding 1}
+ .html parse {<h1>Today Washington D.C. is ...</h1>}
+ set result [.html text ascii 1 end]
+ destroy .html
+ set result
+} {Today Washington D.C. is ...}
+
+::tcltest::test html-4.5 {No SentencePadding for "A. B."} {
+ catch {destroy .html}
+ pack [html .html]
+ catch {.html configure -sentencepadding 1}
+ .html parse {<h1>A. B.</h1>}
+ set result [.html text ascii 1 end]
+ destroy .html
+ set result
+} {A. B.}
diff --git a/tests/html5.test b/tests/html5.test
new file mode 100755
index 0000000..f0febf4
--- /dev/null
+++ b/tests/html5.test
@@ -0,0 +1,13 @@
+#!/usr/bin/wish
+if {[info commands html] == ""} {
+ if {[file exists libTkhtml2.0.so]} {
+ load ./libTkhtml2.0.so
+ } else {
+ package require Tkhtml
+ }
+}
+package require tcltest
+
+tcltest::test html-5.1 {gzip -> gunzip roundtrip} {
+ html gunzip data [html gzip data abc]
+} {abc}
diff --git a/tests/hv.tcl b/tests/hv.tcl
new file mode 100644
index 0000000..83a2d5d
--- /dev/null
+++ b/tests/hv.tcl
@@ -0,0 +1,505 @@
+
+package provide app-hv3 1.0
+
+catch {
+ memory init on
+ for {set i 0} {$i < 50} {incr i} {
+ memory info
+ }
+}
+
+set auto_path [concat . $auto_path]
+package require Tkhtml 3.0
+# source [file join [file dirname [info script]] tkhtml.tcl]
+
+# Global symbols:
+set ::HTML {} ;# The HTML widget command
+set ::DOCUMENT {} ;# Name of html file to load on startup.
+set ::EXIT 0 ;# True if -exit switch specified
+set ::NODE {} ;# Name of node under the cursor
+set ::WIDGET 1 ;# Counter used to generate unique widget names
+set ::MEMARRAY {} ;# Used by proc layout_engine_report.
+set ::TIMEARRAY {} ;# Used by proc layout_engine_report.
+array set ::ANCHORTONODE {} ;# Map from anchor name to node command
+
+# If possible, load package "Img". Without it the script can still run,
+# but won't be able to load many image formats.
+catch {
+ package require Img
+}
+
+# Background error proc. We don't want to pull up a dialog box for every
+# image that can't be found, so just output the error on stdout.
+#
+proc bgerror {msg} {
+ puts "ERROR: $msg"
+}
+
+proc nodePrint {indent node} {
+ set type [$node tag]
+ set istr [string repeat " " $indent]
+ set ret {}
+
+ if {$type == "text"} {
+ append ret $istr
+ append ret [$node text]
+ append ret "\n"
+ } else {
+ append ret $istr
+ append ret "<[$node tag]>\n"
+ for {set i 0} {$i < [$node nChildren]} {incr i} {
+ append ret [nodePrint [expr $indent + 2] [$node child $i]]
+ }
+ append ret $istr
+ append ret "</[$node tag]>\n"
+ }
+
+ return $ret
+}
+
+proc report_dialog {report} {
+ if {![winfo exists .report]} {
+ toplevel .report
+
+ text .report.text
+ scrollbar .report.scroll
+ .report.text configure -width 100
+ .report.text configure -yscrollcommand {.report.scroll set}
+ .report.scroll configure -command {.report.text yview}
+
+ pack .report.text -fill both -expand true -side left
+ pack .report.scroll -fill y -expand true
+ }
+
+ .report.text delete 0.0 end
+ .report.text insert 0.0 $report
+}
+
+proc layout_primitives_report {} {
+ report_dialog [join [$::HTML layout primitives] "\n"]
+}
+
+proc document_tree_report {} {
+ report_dialog [nodePrint 0 [$::HTML node]]
+}
+
+proc document_summary_report {} {
+ set report {}
+ set node [$::HTML node]
+ set count [count_nodes $node]
+ set primitives [llength [$::HTML layout primitives]]
+ set layout_time [lindex [$::HTML var layout_time] 0]
+ set report "Layout time: $layout_time us\n"
+ append report "Document nodes: [lindex $count 0]"
+ append report " ([lindex $count 1] text)\n"
+ append report "Layout primitives: $primitives\n"
+ report_dialog $report
+}
+
+proc bytes {memreport} {
+ set line [lindex [split $memreport "\n"] 3]
+ return [lindex $line end]
+}
+
+proc layout_engine_report {} {
+ if {[info commands memory] != ""} {
+ lappend ::MEMARRAY [string trim [memory info]]
+ }
+ lappend ::TIMEARRAY [$::HTML var layout_time]
+
+ $::HTML reset
+ if {[info commands memory] != ""} {
+ lappend ::MEMARRAY [string trim [memory info]]
+ } else {
+ lappend ::MEMARRAY N/A
+ lappend ::MEMARRAY N/A
+ }
+
+ load_document $::DOCUMENT {}
+
+ if {[llength $::MEMARRAY] < 8} {
+ after idle layout_engine_report
+ } else {
+ set report_lines {}
+
+ if {[info commands memory] != ""} {
+ set report_lines [split [lindex $::MEMARRAY 0] "\n"]
+ foreach mem [lrange $::MEMARRAY 1 end] {
+ set l 0
+ foreach line [split $mem "\n"] {
+ set number [format {% 8s} [lindex $line end]]
+ lset report_lines $l "[lindex $report_lines $l] $number"
+ incr l
+ }
+ }
+
+ set leaks {}
+ lappend leaks [expr \
+ [bytes [lindex $::MEMARRAY 2]] - [bytes [lindex $::MEMARRAY 0]]]
+ lappend leaks [expr \
+ [bytes [lindex $::MEMARRAY 4]] - [bytes [lindex $::MEMARRAY 2]]]
+ lappend leaks [expr \
+ [bytes [lindex $::MEMARRAY 6]] - [bytes [lindex $::MEMARRAY 4]]]
+ } else {
+ set leaks N/A
+ }
+
+ lappend report_lines {}
+ lappend report_lines "Layout times (us): $::TIMEARRAY"
+ lappend report_lines "Growth (bytes): $leaks"
+ set report [join $report_lines "\n"]
+ report_dialog $report
+ set ::MEMARRAY {}
+ set ::TIMEARRAY {}
+ }
+}
+
+proc scroll_test {{dir 1} {step 0}} {
+ set num_steps 500
+
+ set yview [$::HTML yview]
+ set range [expr 1.0 - ([lindex $yview 1] - [lindex $yview 0])]
+
+
+ set fraction [expr ($range / $num_steps.0) * $step]
+ $::HTML yview moveto $fraction
+
+ incr step $dir
+ if {$step >= 0} {
+ if {$step == $num_steps} {set dir -1}
+ after 1 "scroll_test $dir $step"
+ }
+}
+
+proc resize_test {{x 800} {increment -20}} {
+ wm geometry . "[set x]x600"
+
+ incr x $increment
+ if {$x == 800} return
+ if {$x == 100} {
+ set increment 20
+ }
+
+ after 1 "resize_test $x $increment"
+}
+
+# Update the status bar. The mouse is at screen coordinates (x, y).
+# This proc is tied to a <Motion> event on the main Html widget.
+#
+proc update_status {x y} {
+ # Global variable ::NODE stores the node that the cursor was over last
+ # time this proc was called. If we are still hovering over the same
+ # node, then return early as the status bar is already correct.
+ #
+ set n [$::HTML node $x $y]
+ if {$n == $::NODE} {
+ return
+ }
+ set ::NODE $n
+
+ set status ""
+ set linkto ""
+ for {} {$n != ""} {set n [$n parent]} {
+ if {[$n tag] == "text"} {
+ set status "[$n text]"
+ } else {
+ set status "<[$n tag]>$status"
+ }
+ if {$linkto == "" && [$n tag] == "a" && [$n attr href] != ""} {
+ set linkto [$n attr href]
+ }
+ }
+
+ # If the cursor is hovering over a hyperlink, then set the status bar
+ # to display "link: <url>" and set the cursor to "hand2". Otherwise,
+ # set the status bar to display the node chain and set the cursor to
+ # the default.
+ #
+ if {$linkto != ""} {
+ . configure -cursor hand2
+ set status "link: $linkto"
+ } else {
+ . configure -cursor {}
+ }
+
+ # Trim the status bar string so that it does not cause the GUI window
+ # to grow.
+ #
+ set pixels [expr [winfo width .status] - 30]
+ set letters 10
+ set font [.status cget -font]
+ while {$letters < [string length $status] && [font measure $font [string range $status 0 [expr $letters+10]]] < $pixels} {
+ incr letters 10
+ }
+
+ .status configure -text [string range $status 0 $letters]
+}
+
+# This procedure is called when the user clicks on the html widget. If the
+# mouse is over a hyper-link we load the new document.
+#
+proc click {x y} {
+ set link ""
+ for {set node [$::HTML node $x $y]} {$node!=""} {set node [$node parent]} {
+ if {[$node tag] == "a" && [$node attr href] != ""} {
+ set link [$node attr href]
+ break
+ }
+ }
+
+ if {$link != ""} {
+ set parts [split $link #]
+ set doc [lindex $parts 0]
+ set anchor [lindex $parts 1]
+ if {$doc == "" || [file join $::BASE $doc] == $::DOCUMENT} {
+ if {[info exists ::ANCHORTONODE($anchor)]} {
+ set node $::ANCHORTONODE($anchor)
+ $::HTML yview moveto $node
+ }
+ } else {
+ set ::DOCUMENT [file join $::BASE $doc]
+ load_document $::DOCUMENT $anchor
+ }
+ }
+}
+
+# This procedure is called when a <style> tag is encountered during
+# parsing. The $script parameter holds the entire contents of the node.
+#
+proc handle_style_node {script} {
+ $::HTML style parse author.0 $script
+}
+
+# This procedure is called when a <link> node is encountered while building
+# the document tree. It loads a stylesheet from a file on disk if required.
+#
+proc handle_link_node {node} {
+ if {[$node attr rel] == "stylesheet"} {
+ set fd [open [file join $::BASE [$node attr href]]]
+ set script [read $fd]
+ close $fd
+ }
+ $::HTML style parse author.1 $script
+}
+
+# This procedure is called when a <a> node is encountered while building
+# the document tree. If the <a> has a name attribute, put an entry in the
+# ::ANCHORTONODE map.
+#
+proc handle_a_node {node} {
+ set name [$node attr name]
+ if {$name != ""} {
+ set ::ANCHORTONODE($name) $node
+ }
+}
+
+# Analyse the tree with node $node at it's head and return a two element
+# list. The first element of the list is the total number of nodes in the
+# tree. The second element is the number of "text" nodes in the tree.
+#
+proc count_nodes {node} {
+ if {[$node tag] == "text"} {
+ set ret {1 1}
+ } else {
+ set ret {1 0}
+ }
+
+ for {set i 0} {$i < [$node nChildren]} {incr i} {
+ set c [count_nodes [$node child $i]]
+ lset ret 0 [expr [lindex $ret 0] + [lindex $c 0]]
+ lset ret 1 [expr [lindex $ret 1] + [lindex $c 1]]
+ }
+
+ return $ret
+}
+
+# This procedure is called once at the start of the script to build
+# the GUI used by the application. It also sets up the callbacks
+# supplied by this script to help the widget render html.
+#
+proc build_gui {} {
+ set ::HTML [html .h]
+ scrollbar .vscroll -orient vertical
+ scrollbar .hscroll -orient horizontal
+ label .status -height 1 -anchor w -background white
+
+ . config -menu [menu .m]
+ foreach cascade [list File Tests Reports] {
+ set newmenu [string tolower .m.$cascade]
+ .m add cascade -label $cascade -menu [menu $newmenu]
+ $newmenu configure -tearoff 0
+ }
+
+ .m.reports add command -label {Document Summary} \
+ -command document_summary_report
+ .m.reports add command -label {Document Tree} -command document_tree_report
+ .m.reports add command -label {Layout Primitives} \
+ -command layout_primitives_report
+ .m.reports add command -label {Layout Engine} -command layout_engine_report
+ .m.tests add command -label {Scroll test} -command scroll_test
+ .m.tests add command -label {Resize test} -command resize_test
+ .m.file add command -label {Open...} -command open_document
+ .m.file add command -label {Back} -command go_back
+ .m.file add command -label {Exit} -command exit
+
+ pack .vscroll -fill y -side right
+ pack .status -fill x -side bottom
+ pack .hscroll -fill x -side bottom
+ pack $::HTML -fill both -expand true
+
+ $::HTML configure -yscrollcommand {.vscroll set}
+ $::HTML configure -xscrollcommand {.hscroll set}
+ .vscroll configure -command "$::HTML yview"
+ .hscroll configure -command "$::HTML xview"
+
+ bind $::HTML <Motion> "update_status %x %y"
+ bind $::HTML <KeyPress-q> exit
+ bind $::HTML <KeyPress-Q> exit
+ bind $::HTML <ButtonPress> "click %x %y"
+
+ $::HTML handler script style "handle_style_node"
+ $::HTML handler node link "handle_link_node"
+ $::HTML handler node a "handle_a_node"
+
+ focus $::HTML
+}
+
+# This procedure parses the command line arguments
+#
+proc parse_args {argv} {
+ for {set i 0} {$i < [llength $argv]} {incr i} {
+ if {[lindex $argv $i] == "-exit"} {
+ set ::EXIT 1
+ } else {
+ set ::DOCUMENT [lindex $argv $i]
+ }
+ }
+}
+
+# This proc is called to get the replacement image for a node of type <IMG>
+# with a "src" attribute defined.
+#
+proc replace_img_node {base node} {
+ set imgfile [file join $base [$node attr src]]
+ image create photo -file $imgfile
+}
+
+# This proc is called to get the replacement window for a node of type
+# <INPUT>.
+#
+proc replace_input_node {base node} {
+ set type [string tolower [$node attr type]]
+ if {$type == ""} { set type text }
+ set win ""
+ set winname "$::HTML.formcontrol[incr ::WIDGET]"
+ switch -- $type {
+ text {
+ set win [entry $winname]
+ }
+ password {
+ set win [entry $winname -show true]
+ }
+ submit {
+ set win [button $winname -text [$node attr value]]
+ }
+ button {
+ set win [button $winname -text [$node attr value]]
+ }
+ }
+ return $win
+}
+
+# This proc is called to get the replacement window for a node of type
+# <SELECT>.
+#
+proc replace_select_node {base node} {
+ set options [list]
+ set maxlen 0
+ set win ""
+
+ set winname "$::HTML.formcontrol[incr ::WIDGET]"
+ set menuname "$winname.menu"
+ set radiogroupname "::radio$::WIDGET"
+
+ set menubutton [menubutton $winname]
+ set menu [menu $menuname]
+
+ for {set i 0} {$i < [$node nChildren]} {incr i} {
+ set child [$node child $i]
+ if {[$child tag] == "option"} {
+ set label [$child attr label]
+ if {$label == "" && [$child nChildren] == 1} {
+ set label [[$child child 0] text]
+ }
+ $menu add radiobutton -label $label -variable $radiogroupname
+ if {[string length $label]>$maxlen} {
+ set maxlen [string length $label]
+ set $radiogroupname $label
+ }
+ }
+ }
+
+ $menubutton configure -menu $menu
+ $menubutton configure -textvariable $radiogroupname
+ $menubutton configure -width $maxlen
+ $menubutton configure -relief raised
+
+ return $menubutton
+}
+
+proc go_back {} {
+ set len [llength $::HISTORY]
+ if {$len == 1} return
+ foreach {doc anchor} [lindex $::HISTORY [expr $len-2]] {}
+ set ::HISTORY [lrange $::HISTORY 0 [expr $len-2]]
+ load_document $doc $anchor
+}
+
+proc open_document {} {
+ set doc [tk_getOpenFile]
+ if {$doc != ""} {
+ set ::DOCUMENT $doc
+ load_document $doc {}
+ }
+}
+
+proc load_document {document anchor} {
+ set fd [open $document]
+ set doc [read $fd]
+ close $fd
+
+ lappend ::HISTORY [list $document anchor]
+
+ set base [file dirname $document]
+ set ::BASE $base
+
+ array set ::ANCHORTONODE {}
+ $::HTML reset
+ $::HTML style parse agent.1 [subst -nocommands {
+ IMG[src] {-tkhtml-replace:tcl(replace_img_node $base)}
+ INPUT {-tkhtml-replace:tcl(replace_input_node $base)}
+ SELECT {-tkhtml-replace:tcl(replace_select_node $base)}
+ }]
+ $::HTML parse $doc
+
+ if {$anchor != "" && [info exists ::ANCHORTONODE($anchor)]} {
+ update
+ $::HTML yview moveto $::ANCHORTONODE($anchor)
+ }
+}
+
+if {[info exists argv]} {
+ parse_args $argv
+ build_gui
+ load_document $::DOCUMENT {}
+}
+
+if {$::EXIT} {
+ update
+ catch {
+ memory active mem.out
+ puts [memory info]
+ }
+ exit
+}
+
diff --git a/tests/image.tcl b/tests/image.tcl
new file mode 100644
index 0000000..70cd484
--- /dev/null
+++ b/tests/image.tcl
@@ -0,0 +1,324 @@
+
+catch {memory init on}
+
+proc usage {} {
+ set prog $::argv0
+
+ puts stderr [subst {
+ $prog <html-document1> ?<html-document2>....?
+ $prog -file <filename>
+
+This program renders html documents to jpeg images. If the second syntax
+above is used, then <filename> must be the name of a text file containing
+the names of one or more html document files, each seperated by a newline
+character. Otherwise the documents rendered are those specified directly on
+the command line.
+
+When invoked, the TKHTML_TESTDIR environment variable must be set to the
+name of a directory. This directory is used by the program to store images
+previously rendered. The idea is that if the user has previously inspected
+and approved of the rendering of a document, then the image is saved and
+may be used to verify rendering of the same document at a later stage.
+Thus, automated test suites for the layout engine may be accomplished. It's
+unfortunate that moving caches between machines etc. will probably generate
+false-negatives, due to differences in font configuration.
+
+}]
+
+ exit -1
+}
+
+set IMGFMT bmp
+
+# Load Tkhtml and if possible the Img package. The Img package is required
+# for most image files formats used by web documents. Also to write jpeg
+# files.
+#
+set auto_path [concat . $auto_path]
+package require Tkhtml
+catch {
+ package require Img
+}
+
+
+# Set the global variable ::TESTDIR to the value of the cache directory. If
+# the environment variable is not set, invoke the usage message proc.
+#
+if {![info exists env(TKHTML_TESTDIR)]} usage
+if {![file isdirectory $env(TKHTML_TESTDIR)]} usage
+set TESTDIR $env(TKHTML_TESTDIR)
+
+proc shift {listvar} {
+ upvar $listvar l
+ set ret [lindex $l 0]
+ set l [lrange $l 1 end]
+ return $ret
+}
+
+# Procedure to return the contents of a file-system entry
+proc readFile {fname} {
+ set ret {}
+ catch {
+ set fd [open $fname]
+ set ret [read $fd]
+ close $fd
+ }
+ return $ret
+}
+
+# Procedure to handle text inside a <style> tag.
+proc stylecmd {style} {
+ append ::STYLE_TEXT $style
+ append ::STYLE_TEXT "\n"
+ return ""
+}
+
+# Procedure to handle a <link> tag that imports a stylesheet.
+proc linkcmd {node} {
+ set rel [string tolower [$node attr rel]]
+ set media [string tolower [$node attr media]]
+ set media_list [list all visual screen ""]
+ if {[string compare $rel stylesheet]==0 && [lsearch $media_list $media]!=-1} {
+ set href [$node attr href]
+ set filename [file join $::BASE $href]
+ lappend ::STYLESHEET_FILES $filename
+ }
+}
+
+# Procedure to handle the <title> tag.
+proc titlecmd {title} {
+ wm title . [string trim $title]
+}
+
+proc load_document {css document} {
+
+ set ::STYLESHEET_FILES {}
+ set ::STYLE_TEXT {}
+ set parsetime [time {
+ $::HTML internal parse $document
+ $::HTML internal parsefinal
+ $::HTML style parse agent $css
+ while {[llength $::STYLESHEET_FILES]>0} {
+ set ss [lindex $::STYLESHEET_FILES 0]
+ set ::STYLESHEET_FILES [lrange $::STYLESHEET_FILES 1 end]
+ $::HTML style parse author [readFile $ss]
+ }
+ $::HTML style parse author $::STYLE_TEXT
+ }]
+
+ $::HTML style parse author.1 {
+ img { -tkhtml-replace: tcl(replace_img) }
+ object { -tkhtml-replace: tcl(replace_img) }
+ input { -tkhtml-replace: tcl(replace_input) }
+ select { -tkhtml-replace: tcl(replace_select) }
+ }
+
+ set styletime [time {
+ $::HTML style apply
+ }]
+ puts -nonewline "Parse [lrange $parsetime 0 1] Style [lrange $styletime 0 1]"
+}
+
+# Procedure to handle <input> and <object> tags.
+proc replace_img {node} {
+ if {[$node tag]=="object"} {
+ set filename [file join $::BASE [$node attr data]]
+ } else {
+ set filename [file join $::BASE [$node attr src]]
+ }
+ if [catch { set img [image create photo -file $filename] } msg] {
+ # puts "Error: $msg"
+ error $msg
+ }
+ return $img
+}
+
+# Procedure to handle <input> tags.
+set CONTROL 0
+proc replace_input {node} {
+ set tkname ".control[incr ::CONTROL]"
+ set width [$node attr width]
+ if {$width==""} {
+ set width 20
+ }
+
+ switch -exact [$node attr type] {
+ image {
+ return [replace_img $node]
+ }
+ hidden {
+ return ""
+ }
+ checkbox {
+ return [checkbutton $tkname]
+ }
+ radio {
+ return [checkbutton $tkname]
+ }
+ submit {
+ return [button $tkname -text Submit]
+ }
+ default {
+ entry $tkname -width $width
+ return $tkname
+ }
+ }
+ return ""
+}
+
+# Procedure to handle <select> tags
+proc replace_select {node} {
+ set tkname ".control[incr ::CONTROL]"
+ button $tkname -text Select
+ return $tkname
+}
+
+proc docname_to_imgname {docname} {
+ file join $::TESTDIR [string map {{ } _ / _} [file tail $docname]].$::IMGFMT
+}
+proc docname_to_primname {docname} {
+ return [file join $::TESTDIR [string map {{ } _ / _} $docname].primitives]
+}
+
+proc compare_document_image {docname} {
+ $::HTML layout force -width 800
+ set layouttime [time {set img [$::HTML layout image]}]
+ puts " Layout [lrange $layouttime 0 1]"
+ set filename [docname_to_imgname $docname]
+ $img write tmp.$::IMGFMT -format $::IMGFMT
+ image delete $img
+
+ set data [readFile tmp.$::IMGFMT]
+ set data2 [readFile $filename]
+ if {$data2==""} {
+ return NOIMAGE
+ }
+ if {$data2==$data} {
+ return MATCH
+ }
+ return NOMATCH
+}
+
+proc correct {docname img} {
+ set filename [docname_to_imgname $docname]
+ catch {
+ file delete -force $filename
+ }
+ $img write $filename -format $::IMGFMT
+ set ::CONTINUEFLAG 1
+}
+proc incorrect {docname img} {
+ set filename [docname_to_primname $docname]
+ set fd [open $filename w]
+ puts $fd [join [$::HTML layout primitives] "\n"]
+ close $fd
+ set ::CONTINUEFLAG 1
+}
+
+wm geometry . 800x600
+
+set ::HTML [html .h]
+$::HTML handler script script dummycmd
+$::HTML handler script style stylecmd
+$::HTML handler script title titlecmd
+$::HTML handler node link linkcmd
+
+if {[lindex $argv 0]=="-file"} {
+ set fname [lindex $argv 1]
+ set fdir [file dirname $fname]
+ set fd [open $fname]
+ set ::DOCUMENT_LIST {}
+ while {![eof $fd]} {
+ set doc [gets $fd]
+ if {$doc!="" && ![regexp {^ *#} $doc]} {
+ lappend ::DOCUMENT_LIST [file join $fdir $doc]
+ }
+ }
+ close $fd
+} else {
+ set ::DOCUMENT_LIST $argv
+}
+set ::DEFAULT_CSS [readFile [file join [file dirname [info script]] html.css]]
+
+frame .buttons
+button .buttons.correct -text Correct
+button .buttons.incorrect -text Incorrect
+button .buttons.oldimage -text {Old Image}
+button .buttons.newimage -text {New Image}
+
+pack .buttons.correct .buttons.incorrect -side left
+pack .buttons.oldimage .buttons.newimage -side right
+pack .buttons -side bottom -fill x
+
+scrollbar .s -orient vertical
+scrollbar .s2 -orient horizontal
+canvas .c -background white
+pack .s -side right -fill y
+pack .s2 -side bottom -fill x
+pack .c -fill both -expand true
+
+.c configure -yscrollcommand {.s set}
+.c configure -xscrollcommand {.s2 set}
+.s configure -command {.c yview}
+.s2 configure -command {.c xview}
+
+bind .c <KeyPress-Down> {.c yview scroll 1 units}
+bind .c <KeyPress-Up> {.c yview scroll -1 units}
+focus .c
+
+foreach document $::DOCUMENT_LIST {
+ set ::BASE [file dirname $document]
+ load_document $::DEFAULT_CSS [readFile $document]
+ set res [compare_document_image $document]
+
+ if {$res=="MATCH"} {
+ puts "$document - MATCH"
+ }
+ if {$res=="NOIMAGE"} {
+ .c delete all
+ set img [$::HTML layout image]
+ .c create image 0 0 -anchor nw -image $img
+ catch {
+ .c configure -scrollregion [.c bbox all]
+ }
+ .buttons.correct configure -command "correct $document $img"
+ .buttons.incorrect configure -command "incorrect $document $img"
+ .buttons.oldimage configure -state disabled
+ .buttons.newimage configure -state disabled
+ vwait ::CONTINUEFLAG
+
+ .c delete all
+ image delete $img
+ }
+ if {$res=="NOMATCH"} {
+ set img [$::HTML layout image]
+ set imgold [image create photo -file [docname_to_imgname $document]]
+
+ .c delete all
+ .c create image 0 0 -anchor nw -image $img
+ catch { .c configure -scrollregion [.c bbox all] }
+
+ .buttons.correct configure -command "correct $document $img"
+ .buttons.incorrect configure -command "incorrect $document $img"
+ .buttons.oldimage configure -state normal -command [subst -nocommands {
+ .c delete all
+ .c create image 0 0 -anchor nw -image $imgold
+ catch { .c configure -scrollregion [.c bbox all] }
+ }]
+ .buttons.newimage configure -state normal -command [subst -nocommands {
+ .c delete all
+ .c create image 0 0 -anchor nw -image $img
+ catch { .c configure -scrollregion [.c bbox all] }
+ }]
+ vwait ::CONTINUEFLAG
+ .c delete all
+ image delete $img
+ image delete $imgold
+ }
+
+ $::HTML internal reset
+}
+
+rename $::HTML {}
+exit
+
diff --git a/tests/main.tcl b/tests/main.tcl
new file mode 100644
index 0000000..6c18e00
--- /dev/null
+++ b/tests/main.tcl
@@ -0,0 +1,20 @@
+
+#
+# This is the main.tcl file used to create a starkit from the hv.tcl
+# application.
+#
+
+package require starkit
+if {[starkit::startup] eq "sourced"} return
+
+if {[llength $argv] == 0} {
+ set argv [file join [file dirname [info script]] index.html]
+}
+
+rename exit exit_original
+proc exit {args} {
+ ::tk::htmlexit
+}
+
+package require app-hv3
+
diff --git a/tests/node.bt b/tests/node.bt
index d8394e2..a090b84 100644
--- a/tests/node.bt
+++ b/tests/node.bt
@@ -1,13 +1,13 @@
-::browsertest::do_test node.1 -timeout 10000000 -javascript {
+do_browser_test node.1 -javascript {
return Node.ELEMENT_NODE
-} -expected 1
+}
-::browsertest::do_test node.2 -timeout 10000000 -javascript {
+do_browser_test node.2 -javascript {
Node.prop = "hello"
return Node.prop
-} -expected hello
+}
# This test does not work. Firefox allows the Node.ELEMENT_NODE
# constant to be overwritten, whereas Hv3 throws an exception.
@@ -17,9 +17,7 @@
# return Node.ELEMENT_NODE
# } -expected hello
-::browsertest::do_test node.3 -timeout 10000000 -html {
- <body>
-} -javascript {
+do_browser_test node.3 -javascript {
try {
document.body.nodeType = 10
} catch (e) {
@@ -28,7 +26,7 @@
return ""
}
-::browsertest::do_test node.4 -timeout 10000000 -html {<body>} -javascript {
+do_browser_test node.4 -html {<body>} -javascript {
return "" + document.body.ELEMENT_NODE
}
diff --git a/tests/page1/image1 b/tests/page1/image1
new file mode 100644
index 0000000..31e96b6
Binary files /dev/null and b/tests/page1/image1 differ
diff --git a/tests/page1/image10 b/tests/page1/image10
new file mode 100644
index 0000000..80a8f81
Binary files /dev/null and b/tests/page1/image10 differ
diff --git a/tests/page1/image11 b/tests/page1/image11
new file mode 100644
index 0000000..e8cb01d
Binary files /dev/null and b/tests/page1/image11 differ
diff --git a/tests/page1/image12 b/tests/page1/image12
new file mode 100644
index 0000000..c317bbd
Binary files /dev/null and b/tests/page1/image12 differ
diff --git a/tests/page1/image13 b/tests/page1/image13
new file mode 100644
index 0000000..ac4b3cd
Binary files /dev/null and b/tests/page1/image13 differ
diff --git a/tests/page1/image14 b/tests/page1/image14
new file mode 100644
index 0000000..c3b0255
Binary files /dev/null and b/tests/page1/image14 differ
diff --git a/tests/page1/image2 b/tests/page1/image2
new file mode 100644
index 0000000..da26d70
Binary files /dev/null and b/tests/page1/image2 differ
diff --git a/tests/page1/image3 b/tests/page1/image3
new file mode 100644
index 0000000..d91cdfa
Binary files /dev/null and b/tests/page1/image3 differ
diff --git a/tests/page1/image4 b/tests/page1/image4
new file mode 100644
index 0000000..5fdf70c
Binary files /dev/null and b/tests/page1/image4 differ
diff --git a/tests/page1/image5 b/tests/page1/image5
new file mode 100644
index 0000000..67cd14d
Binary files /dev/null and b/tests/page1/image5 differ
diff --git a/tests/page1/image6 b/tests/page1/image6
new file mode 100644
index 0000000..9e05aa0
Binary files /dev/null and b/tests/page1/image6 differ
diff --git a/tests/page1/image7 b/tests/page1/image7
new file mode 100644
index 0000000..879656d
Binary files /dev/null and b/tests/page1/image7 differ
diff --git a/tests/page1/image8 b/tests/page1/image8
new file mode 100644
index 0000000..8c647c4
Binary files /dev/null and b/tests/page1/image8 differ
diff --git a/tests/page1/image9 b/tests/page1/image9
new file mode 100644
index 0000000..3a77075
Binary files /dev/null and b/tests/page1/image9 differ
diff --git a/tests/page1/index.html b/tests/page1/index.html
new file mode 100644
index 0000000..9efac7f
--- /dev/null
+++ b/tests/page1/index.html
@@ -0,0 +1,115 @@
+<HTML><HEAD><TITLE>Slashdot:News for Nerds. Stuff that Matters.</TITLE> </HEAD>
+<BODY bgcolor="#000000" text="#000000" link="#006666" vlink="#000000">
+<center><a href="http://209.207.224.220/redir.pl?1463" target="_top"><img src="image1" alt="Click Here to enter the Sweepstakes" border="2" width="468" height="60"></a></center> <TABLE BORDER="0" CELLPADDING="0" CELLSPACING="0"><TR><TD WIDTH="1"><SCRIPT LANGUAGE="JAVASCRIPT">
+<!-- now="now" ="" new="new" Date();="Date();" tail="tail" ="" now.getTime();="now.getTime();" document.write("<IMG="document.write("<IMG" SRC="http://209.207.224.245/Slashdot/pc.gif?/slashhead.inc,"+" tail="tail" +="+" "=""" WIDTH="1" HEIGHT="1><BR>");" -->
+</SCRIPT>
+<NOSCRIPT>
+<IMG SRC="image2" WIDTH="1" HEIGHT="1">
+</NOSCRIPT></TD></TR></TABLE><P>
+<TABLE bgcolor="#FFFFFF" cellpadding="0" cellspacing="0" border="0" width="99%" align="center">
+ <TR>
+ <TD valign="top" align="left" valign="top"><A href="http://slashdot.org/"><IMG src="image3" width="275" height="72" border="0" alt="Welcome to Slashdot"></A></TD>
+ <TD><A href="http://slashdot.org/search.pl?topic=linux"><IMG SRC="image4" width="60" height="70" border="0" alt="Linux"></A></TD>
+<TD><A href="http://slashdot.org/search.pl?topic=news"><IMG SRC="image5" width="34" height="44" border="0" alt="News"></A></TD>
+<TD><A href="http://slashdot.org/search.pl?topic=usa"><IMG SRC="image6" width="80" height="61" border="0" alt="United States"></A></TD>
+<TD><A href="http://slashdot.org/search.pl?topic=ed"><IMG SRC="image7" width="87" height="64" border="0" alt="Education"></A></TD>
+<TD><A href="http://slashdot.org/search.pl?topic=space"><IMG SRC="image8" width="73" height="59" border="0" alt="Space"></A></TD>
+
+</TR></TABLE>
+<TABLE width="99%" align="center" cellpadding="0" cellspacing="0" border="0" bgcolor="#FFFFFF"><TR>
+<TD valign="top" rowspan="5"><NOBR><FONT size="2"><B>
+ <A href="/faq.shtml">faq</A> <BR>
+ <A href="/code.shtml">code</A> <BR>
+ <A href="/awards.shtml">awards</A> <BR>
+ <A href="http://Andover.Net/privacy.html">privacy</A> <BR>
+ <A href="http://slashnet.org">slashNET</A> <BR>
+ <A href="/search.pl">older stuff</A> <BR>
+ <A href="http://cmdrtaco.net">rob's page</A> <BR>
+ <A href="/users.pl?op=preferences">preferences</A> <BR>
+ <A href="http://Andover.Net">andover.net</A> <BR>
+ <A href="/submit.pl">submit story</A> <BR>
+ <A href="/advertising.shtml">advertising</A> <BR>
+ <A href="/supporters.shtml">supporters</A> <BR>
+ <A href="/pollBooth.pl">past polls</A> <BR>
+ <A href="/topics.shtml">topics</A> <BR>
+ <A href="/about.shtml">about</A> <BR>
+ <A href="/jobs.shtml">jobs</A> <BR>
+ <A href="/hof.shtml">hof</A>
+
+</B></FONT></NOBR>
+ <P><TABLE border="0" cellpadding="1" cellspacing="0" align="center" bgcolor="#CCCCCC"><TR>
+ <TD><FONT size="2" color="#000000"><B> Sections</B></FONT></TD></TR>
+ <TR><TD><TABLE border="0" cellspacing="1" cellpadding="1" bgcolor="#FFFFFF" width="100%"><TR><TD><FONT color="#000000" size="2"><NOBR>
+1/23<BR>
+<B><A href="http://slashdot.org/index.pl?section=apache">apache</A></B><BR>
+1/29 (3)<BR>
+<B><A href="http://slashdot.org/index.pl?section=askslashdot">askslashdot</A></B><BR>
+1/27<BR>
+<B><A href="http://slashdot.org/index.pl?section=awards">awards</A></B><BR>
+1/29 (2)<BR>
+<B><A href="http://slashdot.org/index.pl?section=books">books</A></B><BR>
+1/27<BR>
+<B><A href="http://slashdot.org/index.pl?section=bsd">bsd</A></B><BR>
+1/28 (2)<BR>
+<B><A href="http://slashdot.org/index.pl?section=features">features</A></B><BR>
+1/28 (2)<BR>
+<B><A href="http://slashdot.org/index.pl?section=interviews">interviews</A></B><BR>
+1/19<BR>
+<B><A href="http://slashdot.org/index.pl?section=radio">radio</A></B><BR>
+1/27 (2)<BR>
+<B><A href="http://slashdot.org/index.pl?section=science">science</A></B><BR>
+1/28 (3)<BR>
+<B><A href="http://slashdot.org/index.pl?section=yro">yro</A></B><BR> </NOBR></FONT></TD></TR></TABLE><TR>
+ <TD><A href="http://andover.net"><FONT size="2" color="#000000"><B>Andover.Net</B></FONT></A></TD></TR>
+ <TR><TD><TABLE border="0" cellspacing="1" cellpadding="1" bgcolor="#FFFFFF"><TR><TD>
+<FONT color="#000000" size="2"><NOBR><A href="http://www.andovernews.com">AndoverNews</A><BR><A href="http://www.askreggie.com">Ask Reggie</A><BR><A href="http://www.davecentral.com">DaveCentral</A><BR><A href="http://www.freecode.com">FreeCode</A><BR><A href="http://www.mediabuilder.com">MediaBuilder</A><BR> </NOBR></FONT></TD></TR></TABLE></TD></TR></TABLE></P>
+ <P></P>
+</TD><TD valign="top" align="left"><FONT color="#000000"> <TABLE width="99%" cellpadding="0" cellspacing="0" border="0"><TR><TD valign="top" bgcolor="#006666"><IMG src="image9" width="13" height="16" alt="" align="top"><FONT size="4" color="#FFFFFF" face="arial,helvetica"><B>Who Bought Linux.Net?</B></FONT></TD> </TR></TABLE><A href="http://slashdot.org/search.pl?topic=linux"><IMG src="image4" width="60" height="70" border="0" align="right" hspace="20" vspace="10" alt="Linux"></A> <B>Posted by <A href="http://CmdrTaco.net">CmdrTaco</A> on Saturday January 29, @10:52AM</B><BR> <FONT size="2"><B>from the this-game-again dept.</B></FONT><BR> So Fred VanKampen (who has to hold the record for most money made by reselling two domain names) e-mailed us to say that the Domain Name for 'Linux.Net' has been sold. He won't say to whom, but it supposedly will be announced at LinuxWorld next week. Of course we have no idea what he got for the entry, but the rumors were that he made several million when he sold <A href="http://www.linux.com">Linux.com</A> to <A href="http://www.valinux.com">VA Linux</A>. Hopefully he'll take me for a ride in his yacht. ;) <P><B>( </B><A href="http://slashdot.org/articles/00/01/29/0837235.shtml"><B>Read More...</B></A> | <B><A href="http://slashdot.org/article.pl?sid=00/01/29/0837235&mode=thread&threshold=0">58</A> of <A href="http://slashdot.org/article.pl?sid=00/01/29/0837235&mode=thread&threshold=-1">62</A> </B>comments <B>)</B> <P><TABLE width="99%" cellpadding="0" cellspacing="0" border="0"><TR><TD valign="top" bgcolor="#006666"><IMG src="image9" width="13" height="16" alt="" align="top"><FONT size="4" color="#FFFFFF" face="arial,helvetica"><B>Book Reviews: E-Mails from (Over?) The Edge</B></FONT></TD> </TR></TABLE><A href="http://slashdot.org/search.pl?topic=news"><IMG src="image5" width="34" height="44" border="0" align="right" hspace="20" vspace="10" alt="News"></A> <B>Posted by <A href="http://hemos.net">Hemos</A> on Saturday January 29, @10:43AM</B><BR> <FONT size="2"><B>from the touching-story dept.</B></FONT><BR> I'd like to thank the author of this book for sending it to me. Nick's written a book that's touching and endearing, and one that's well worth reading for everyone who's ever had social struggles to deal with. As well, his involvement with the fine folks of <a href="http://www.thevenue.org">TheVenue</a>. I'll warn you - it's not a tech text. But it's still worth reading. Click below to read more. <P><B>( </B><A href="http://slashdot.org/books/00/01/24/1146250.shtml"><B>Read More...</B></A> | <A href="http://slashdot.org/article.pl?sid=00/01/24/1146250&mode=nocomment">6197 bytes in body</A> | <B><A href="http://slashdot.org/article.pl?sid=00/01/24/1146250&mode=thread&threshold=0">6</A> of <A href="http://slashdot.org/article.pl?sid=00/01/24/1146250&mode=thread&threshold=-1">22</A> </B>comments <B>)</B> <P><TABLE width="99%" cellpadding="0" cellspacing="0" border="0"><TR><TD valign="top" bgcolor="#006666"><IMG src="image9" width="13" height="16" alt="" align="top"><FONT size="4" color="#FFFFFF" face="arial,helvetica"><B>Linux Kernel 2.3.41</B></FONT></TD> </TR></TABLE><A href="http://slashdot.org/search.pl?topic=linux"><IMG src="image4" width="60" height="70" border="0" align="right" hspace="20" vspace="10" alt="Linux"></A> <B>Posted by <A href="http://CmdrTaco.net">CmdrTaco</A> on Saturday January 29, @10:21AM</B><BR> <FONT size="2"><B>from the download-compile-reboot-repeat dept.</B></FONT><BR> <A href="mailto:bwhitehead at nospam.acm.org">sdriver</A> writes <I>"For those of us who enjoy *panic*, *oops*, and suddenly seeing their video BIOS... the newest version is out! Be the first on your block to submit a new patch! ;) "</I> If you don't know where to get it, you probably should stick to your warm and cuddly 2.2.x kernel *grin*. Now outta my way, I wanna crash my laptop! <P><B>( </B><A href="http://slashdot.org/articles/00/01/29/0834223.shtml"><B>Read More...</B></A> | <B><A href="http://slashdot.org/article.pl?sid=00/01/29/0834223&mode=thread&threshold=0">52</A> of <A href="http://slashdot.org/article.pl?sid=00/01/29/0834223&mode=thread&threshold=-1">57</A> </B>comments <B>)</B> <P><TABLE width="99%" cellpadding="0" cellspacing="0" border="0"><TR><TD valign="top" bgcolor="#006666"><IMG src="image9" width="13" height="16" alt="" align="top"><FONT size="4" color="#FFFFFF" face="arial,helvetica"><B>Congress Still Figuring Out E-Mail</B></FONT></TD> </TR></TABLE><A href="http://slashdot.org/search.pl?topic=usa"><IMG src="image6" width="80" height="61" border="0" align="right" hspace="20" vspace="10" alt="United States"></A> <B>Posted by <A href="mailto:roblimo at slashdot.org">Roblimo</A> on Saturday January 29, @07:28AM</B><BR> <FONT size="2"><B>from the voice-of-the-people-can-get-awfully-loud dept.</B></FONT><BR> Jett writes <I>" <A href="http://www.vote.com/">Vote.com</A> has <A href="http://www.vote.com/magazine/editorials/editorial1843752.phtml">an interesting article</A> in their Webmag Fifth Estate about how congressmen have responded to the popularity of e-mail in their daily operations. Quote: 'Of the 440 voting and non-voting House of Representatives members, 22 have no e-mail at all. Even House Speaker Dennis Hastert is wired only halfway -- his office receives e-mail, but does not respond to it. And while all U.S. senators have e-mail, they, like their House counterparts, routinely shun non-constituent mail -- even though they chair committees whose decisions affect the entire country.'"</I> <P><B>( </B><A href="http://slashdot.org/articles/00/01/28/2311232.shtml"><B>Read More...</B></A> | <B><A href="http://slashdot.org/article.pl?sid=00/01/28/2311232&mode=thread&threshold=0">66</A> of <A href="http://slashdot.org/article.pl?sid=00/01/28/2311232&mode=thread&threshold=-1">66</A> </B>comments <B>)</B> <P><TABLE width="99%" cellpadding="0" cellspacing="0" border="0"><TR><TD valign="top" bgcolor="#006666"><IMG src="image9" width="13" height="16" alt="" align="top"><FONT size="4" color="#FFFFFF" face="arial,helvetica"><B>Ask Slashdot: Sci Fi Literature 101?</B></FONT></TD> </TR></TABLE><A href="http://slashdot.org/search.pl?topic=ed"><IMG src="image7" width="87" height="64" border="0" align="right" hspace="20" vspace="10" alt="Education"></A> <B>Posted by <A href="http://exit118.com/">Cliff</A> on Saturday January 29, @06:56AM</B><BR> <FONT size="2"><B>from the recommendations-wanted dept.</B></FONT><BR> ohlaadee asks: <I>"My niece (she's 13) wants to start reading science fiction. I do too. I gave us both Asimov's </I>_The Foundation_<I> for Christmas. We'll read it together. I suppose we could spend the rest of our lives just reading Asimov, but I'm wondering what books and movies you folks would come up with? What does the /. recommended Science Fiction 101 list include?"</I> <P><B>( </B><A href="http://slashdot.org/askslashdot/00/01/22/1946244.shtml"><B>Read More...</B></A> | <B><A href="http://slashdot.org/article.pl?sid=00/01/22/1946244&mode=thread&threshold=0">345</A> of <A href="http://slashdot.org/article.pl?sid=00/01/22/1946244&mode=thread&threshold=-1">345</A> </B>comments <B>)</B> <P><TABLE width="99%" cellpadding="0" cellspacing="0" border="0"><TR><TD valign="top" bgcolor="#006666"><IMG src="image9" width="13" height="16" alt="" align="top"><FONT size="4" color="#FFFFFF" face="arial,helvetica"><B>Could Distributed.Net Help the Mars Polar Lander?</B></FONT></TD> </TR></TABLE><A href="http://slashdot.org/search.pl?topic=space"><IMG src="image8" width="73" height="59" border="0" align="right" hspace="20" vspace="10" alt="Space"></A> <B>Posted by <A href="mailto:roblimo at slashdot.org">Roblimo</A> on Saturday January 29, @03:35AM</B><BR> <FONT size="2"><B>from the food-for-thought dept.</B></FONT><BR> Anonymous Coward writes <I>"This official JPL <A href="http://mpfwww.jpl.nasa.gov/msp98/news/mpl000127.html">press release</A> describes the current attempt to listen for faint signals from the Mars Lander. They get three windows a day, and it takes 18 hours to process data because the signal is so weak (if it's really there). Too bad they don't have a deal with <A href="http://www.distributed.net"> distributed.net</A>."</I> Interesting thought. Is anyone at distributed.net or JPL interested in pursuing it? <P><B>( </B><A href="http://slashdot.org/articles/00/01/28/2318246.shtml"><B>Read More...</B></A> | <B><A href="http://slashdot.org/article.pl?sid=00/01/28/2318246&mode=thread&threshold=0">99</A> of <A href="http://slashdot.org/article.pl?sid=00/01/28/2318246&mode=thread&threshold=-1">102</A> </B>comments <B>)</B> <P><TABLE width="99%" cellpadding="0" cellspacing="0" border="0"><TR><TD valign="top" bgcolor="#006666"><IMG src="image9" width="13" height="16" alt="" align="top"><FONT size="4" color="#FFFFFF" face="arial,helvetica"><B>iCrave TV Loses Battle against U.S. Broadcasters</B></FONT></TD> </TR></TABLE><A href="http://slashdot.org/search.pl?topic=tv"><IMG src="image10" width="50" height="50" border="0" align="right" hspace="20" vspace="10" alt="Television"></A> <B>Posted by <A href="mailto:roblimo at slashdot.org">Roblimo</A> on Saturday January 29, @12:21AM</B><BR> <FONT size="2"><B>from the shut-down-just-before-the-super-bowl dept.</B></FONT><BR> <A href="mailto:doran at brandx.net">Doran</A> writes <I>"C|Net has <a href="http://news.cnet.com/news/0-1004-200-1535528.html">this story</a> about how the Canadian company <a href="http://www.icravetv.com">iCraveTV.com</a> has lost its latest battle in U.S. courts over whether it can rebroadcast TV signals over the Web. The broadcasters say it's theft, while iCraveTV sez it's just doing what's legal for other cable TV companies in Canada (ie. rebroadcasting TV). Of course, by framing the streaming video iCraveTV is doing more than just rebroadcasting, they're also adding more commercial content, which the broadcasters feel dilutes their TV commercials. "</I> <P><B>( </B><A href="http://slashdot.org/articles/00/01/29/0010203.shtml"><B>Read More...</B></A> | <B><A href="http://slashdot.org/article.pl?sid=00/01/29/0010203&mode=thread&threshold=0">152</A> of <A href="http://slashdot.org/article.pl?sid=00/01/29/0010203&mode=thread&threshold=-1">170</A> </B>comments <B>)</B> <P><TABLE width="99%" cellpadding="0" cellspacing="0" border="0"><TR><TD valign="top" bgcolor="#006666"><IMG src="image9" width="13" height="16" alt="" align="top"><FONT size="4" color="#FFFFFF" face="arial,helvetica"><B>Win2k Security holes found</B></FONT></TD> </TR></TABLE><A href="http://slashdot.org/search.pl?topic=microsoft"><IMG src="image11" width="75" height="55" border="0" align="right" hspace="20" vspace="10" alt="Microsoft"></A> <B>Posted by <A href="mailto:heunique at slashdot.org">HeUnique</A> on Friday January 28, @04:58PM</B><BR> <FONT size="2"><B>from the and-it's-not-even-out-yet dept.</B></FONT><BR> According to a story posted by <a href="http://www.zdnn.com">ZDNN</a>, <a href="http://www.zdnet.com/zdnn/stories/news/0,4586,2429334,00.html?chkpt=zdnntop">two security holes</a> have been found on Windows 2000, and that's even before the official release of Windows 2000! Administrators who rush to incorporate the patch from MS beware - according to one of the talkback posts on ZDNN, the patch creates a new problem with Windows 2000 news server service. <P><B>( </B><A href="http://slashdot.org/articles/00/01/28/1653228.shtml"><B>Read More...</B></A> | <B><A href="http://slashdot.org/article.pl?sid=00/01/28/1653228&mode=thread&threshold=0">510</A> of <A href="http://slashdot.org/article.pl?sid=00/01/28/1653228&mode=thread&threshold=-1">534</A> </B>comments <B>)</B> <P><TABLE width="99%" cellpadding="0" cellspacing="0" border="0"><TR><TD valign="top" bgcolor="#006666"><IMG src="image9" width="13" height="16" alt="" align="top"><FONT size="4" color="#FFFFFF" face="arial,helvetica"><B>Encryption Debate at Mitnick Trial</B></FONT></TD> </TR></TABLE><A href="http://slashdot.org/search.pl?topic=encryption"><IMG src="image12" width="80" height="70" border="0" align="right" hspace="20" vspace="10" alt="Encryption"></A> <B>Posted by <A href="http://hemos.net">Hemos</A> on Friday January 28, @03:33PM</B><BR> <FONT size="2"><B>from the gimmie-the-data dept.</B></FONT><BR> A number of people have written about <A HREF="http://nytimes.com/library/tech/00/01/cyber/cyberlaw/28law.html">the latest twist</a> in the Mitnick case. Kevin wants to get his data back, but the government is refusing to do so until he gives them the key. Apparently, the government is unable to crack the encryption that he's got on it - you'd think after having the data for five years, they'd be able to brute-force the darn thing. It's a NYT article - free login required. <P><B>( </B><A href="http://slashdot.org/articles/00/01/28/1320253.shtml"><B>Read More...</B></A> | <B><A href="http://slashdot.org/article.pl?sid=00/01/28/1320253&mode=thread&threshold=0">504</A> of <A href="http://slashdot.org/article.pl?sid=00/01/28/1320253&mode=thread&threshold=-1">521</A> </B>comments <B>)</B> <P><TABLE width="99%" cellpadding="0" cellspacing="0" border="0"><TR><TD valign="top" bgcolor="#006666"><IMG src="image9" width="13" height="16" alt="" align="top"><FONT size="4" color="#FFFFFF" face="arial,helvetica"><B>Forum: Future Ports of Games to Linux</B></FONT></TD> </TR></TABLE><A href="http://slashdot.org/search.pl?topic=games"><IMG src="image13" width="80" height="56" border="0" align="right" hspace="20" vspace="10" alt="Games"></A> <B>Posted by <A href="http://CmdrTaco.net">CmdrTaco</A> on Friday January 28, @02:26PM</B><BR> <FONT size="2"><B>from the it's-been-awhile dept.</B></FONT><BR> It's been a long time since I posted an open forum like this, but I'm curious what people think on this one. What games do you most want to see ported to Linux in the next few months? Of course, for me personally it's StarCraft and Diablo 2, but I'm curious what games have come out or are due soon that people would most like to see a port of (and note that WINE doesn't count. ;) <P><B>( </B><A href="http://slashdot.org/articles/00/01/28/1257211.shtml"><B>Read More...</B></A> | <B><A href="http://slashdot.org/article.pl?sid=00/01/28/1257211&mode=thread&threshold=0">648</A> of <A href="http://slashdot.org/article.pl?sid=00/01/28/1257211&mode=thread&threshold=-1">652</A> </B>comments <B>)</B> <P></TD><TD width="210" align="center" valign="top"><TABLE cellpadding="1" cellspacing="0" border="0" width="200" align="center"> <TR bgcolor="#006666"> <TD valign="top"><FONT size="4" color="#FFFFFF" face="arial,helvetica"><B><A HREF="/index.pl?section=features"><FONT COLOR="#FFFFFF">Features</FONT></A></B></FONT></TD> </TR><TR><TD bgcolor="#CCCCCC"><FONT color="#000000" size="2"><A href="/vote.pl">Voting has begun</A> for the $100k <A href="/index.pl?section=awards">Slashdot Beanie Awards</A>. Talk amongst yourselves and choose who deserves the cash. <P>The latest installment of <A href="http://www.thesync.com/geeks">Geeks in Space</A> is up at <A href="http://www.thesync.com">The Sync</A>. Listen to CmdrTaco, Hemos, and Nate talk about the latest events to happen - or not happen in the computer world. <P>Perhaps you are seeking Jon Katz's series of articles related to recent events in Colorado. These articles include <A href="/article.pl?sid=99/04/25/1438249">Voices from the Hellmouth</A>, <A href="/article.pl?sid=99/04/27/0310247">More Stories from the Hellmouth</A> or <A href="/article.pl?sid=99/04/29/0124247">The Price of Being Different</A>, <P>For something different, try reading a little essay <A href="/article.pl?sid=99/03/31/0137221">Thoughts from the Furnace</A> about the internet, and flame. <p> And for a bit of an amusing take on the Open Source world, check out <a href="/article.pl?sid=99/08/24/1327256&mode=thread">Open Source as an Ant Farm</a> <P><B>Update: 01/03 03:10</B> by <B><A href="http://cowboyneal.org">CowboyNeal</a></B>: <P align="right"><B><A href="/features/">Past Features</A></B> <!-- end="end" features="features" block="block" --></FONT></TD> </TR> </TABLE><P> <TABLE cellpadding="1" cellspacing="0" border="0" width="200" align="center"> <TR bgcolor="#006666"> <TD valign="top"><FONT size="4" color="#FFFFFF" face="arial,helvetica"><B><A HREF="http://slashdot.org/index.pl?section=askslashdot"><FONT COLOR="#FFFFFF">Ask Slashdot</FONT></A></B></FONT></TD> </TR><TR><TD bgcolor="#CCCCCC"><FONT color="#000000" size="2"><li><A HREF="http://slashdot.org/article.pl?sid=00/01/22/1946244">Sci Fi Literature 101?</A> <li><A HREF="http://slashdot.org/article.pl?sid=00/01/22/192226">Linux and Satellite Internet Services</A> <li><A HREF="http://slashdot.org/article.pl?sid=00/01/22/1843258">Open Defensive Patents?</A> <li><A HREF="http://slashdot.org/article.pl?sid=00/01/22/1825252">Technologies That Shaped the Last Century?</A> <li><A HREF="http://slashdot.org/article.pl?sid=00/01/22/1958212">Disk Repair Tools for Linux?</A> <li><A HREF="http://slashdot.org/article.pl?sid=00/01/22/1955215">Why Can't the Command-Line be More Standardized?</A> <li><A HREF="http://slashdot.org/article.pl?sid=00/01/22/1928235">Packet Radio Networking with PalmOS?</A> <li><A HREF="http://slashdot.org/article.pl?sid=00/01/22/1817211">Cheap Rackmount Enclosures/Systems?</A> <li><A HREF="http://slashdot.org/article.pl?sid=00/01/22/1950249">Open Source Software and Tax Breaks?</A> <li><A HREF="http://slashdot.org/article.pl?sid=00/01/22/1917207">Building an Upgradable Dual Processor System</A> <P> if you have a question for Ask Slashdot, send it to <A href="mailto:askslashdot at slashdot.org">askslashdot at slashdot.org</A></FONT></TD> </TR> </TABLE><P> <TABLE cellpadding="1" cellspacing="0" border="0" width="200" align="center"> <TR bgcolor="#006666"> <TD valign="top"><FONT size="4" color="#FFFFFF" face="arial,helvetica"><B><A HREF="/users.pl"><FONT COLOR="#FFFFFF">Slashdot Login</FONT></A></B></FONT></TD> </TR><TR><TD bgcolor="#CCCCCC"><FONT color="#000000" size="2"><FORM action="/users.pl" METHOD="POST"> <B>Nickname:</B><BR> <INPUT type="text" name="unickname" size="20" value=""><BR> <B>Password:</B><BR> <INPUT type="hidden" name="returnto" value="index.pl"> <INPUT type="password" name="upasswd" size="20"><BR> <INPUT type="submit" name="op" value="userlogin"> </FORM> Don't have an account yet? <A href="/users.pl">Go Create One</A>. A user account will allow you to customize all these <A href="/cheesyportal.shtml">nutty little boxes</A>, tailor the stories you see, as well as remember your comment viewing preferences.</FONT></TD> </TR> </TABLE><P> <TABLE cellpadding="1" cellspacing="0" border="0" width="200" align="center"> <TR bgcolor="#006666"> <TD valign="top"><FONT size="4" color="#FFFFFF" face="arial,helvetica"><B>Slashdot Poll</B></FONT></TD> </TR><TR><TD bgcolor="#CCCCCC"><FONT color="#000000" size="2"><FORM action="http://slashdot.org/pollBooth.pl"> <INPUT type="hidden" name="qid" value="techadvance"> <B>The Tech Advance I Most Want Is:</B><BR><INPUT type="radio" name="aid" value="1">Nanotechnology<BR><INPUT type="radio" name="aid" value="2">Cold Fusion<BR><INPUT type="radio" name="aid" value="3">Powerful Fuel Cells<BR><INPUT type="radio" name="aid" value="4">Hard Wiring my Body<BR><INPUT type="radio" name="aid" value="5">Universal Strong Crypto<BR><INPUT type="radio" name="aid" value="6">Interstellar Travel<BR><INPUT type="radio" name="aid" value="7">Cybernetic Body Armor<BR><INPUT type="radio" name="aid" value="8">ColecoVision<BR><INPUT type="submit" value="Vote"> [ <A href="http://slashdot.org/pollBooth.pl?qid=techadvance&aid=-1"><B>Results</B></A> | <A href="http://slashdot.org/pollBooth.pl?"><B>Polls</B></A> ] <BR>Comments:<B>656</B> | Votes:<B>29121</B></FORM> </FONT></TD> </TR> </TABLE><P> <TABLE cellpadding="1" cellspacing="0" border="0" width="200" align="center"> <TR bgcolor="#006666"> <TD valign="top"><FONT size="4" color="#FFFFFF" face="arial,helvetica"><B>Older Stuff</B></FONT></TD> </TR><TR><TD bgcolor="#CCCCCC"><FONT color="#000000" size="2"><P><B><A href="http://slashdot.org/index.pl?section=&issue=730512&mode=thread"><FONT size="4">Friday</FONT></A> January 28</B> <LI><A href="http://slashdot.org/articles/00/01/28/1110258.shtml">Abstract Programming and GPL Enforcement</A> (235) <LI><A href="http://slashdot.org/interviews/00/01/28/1225206.shtml">Interview: FreeDOS Leader Jim Hall Answers</A> (86) <LI><A href="http://slashdot.org/articles/00/01/28/116240.shtml">Open Source's Achilles Heel</A> (466) <LI><A href="http://slashdot.org/features/00/01/26/1915230.shtml">The Virtue of Communal Instincts</A> (237) <LI><A href="http://slashdot.org/articles/00/01/28/0723223.shtml">Gartner Group Debunking Open Source Myths</A> (165) <LI><A href="http://slashdot.org/yro/00/01/28/0917229.shtml">DoubleClick Taken to Court</A> (310) <LI><A href="http://slashdot.org/articles/00/01/28/0718209.shtml">Updated Slash & Server 51</A> (81) <LI><A href="http://slashdot.org/articles/00/01/28/089230.shtml">XMMS 1.0.0 Released</A> (128) <LI><A href="http://slashdot.org/askslashdot/00/01/22/192226.shtml">Linux and Satellite Internet Services</A> (138) <LI><A href="http://slashdot.org/articles/00/01/27/1811221.shtml">UN Wants to Combat Online Racism</A> (531) <P><B><A href="http://slashdot.org/index.pl?section=&issue=730511&mode=thread"><FONT size="4">Thursday</FONT></A> January 27</B> <LI><A href="http://slashdot.org/yro/00/01/27/2330205.shtml">Crackdowns, Fools and the MPAA</A> (351) <LI><A href="http://slashdot.org/articles/00/01/27/0832215.shtml">Heroes of Might and Magic III Demo Released</A> (157) <LI><A href="http://slashdot.org/science/00/01/27/1345241.shtml">Sandia Labs Venture Into Nanotechnology</A> (117) <LI><A href="http://slashdot.org/articles/00/01/27/0931237.shtml">CA Announces Program Ports to Linux</A> (195) <LI><A href="http://slashdot.org/interviews/00/01/27/1118251.shtml">Interview: Larry Augustin Finally Answers</A> (210) <LI><A href="http://slashdot.org/awards/00/01/27/0855252.shtml">Final Call for Voting in Slashdot's Beanie Awards</A> (178) <LI><A href="http://slashdot.org/features/00/01/26/197211.shtml">Transmeta Code Morphing != Just In Time</A> (449) <LI><A href="http://slashdot.org/books/00/01/24/1150256.shtml">Intrusion Detection</A> (65) <LI><A href="http://slashdot.org/science/00/01/27/0824239.shtml">Using Enzymes to Help Fight CO2 Build-Up</A> (165) <LI><A href="http://slashdot.org/articles/00/01/27/0712217.shtml">Jon Johansen on ABC World News Tonight</A> (415) <P align="right"><BR><A href="http://slashdot.org/search.pl?section=&min=30"><B>Older Articles</B></A><BR><A href="http://slashdot.org/index.pl?section=&mode=thread&issue=730512"><B>Yesterday's Edition</B></A> </FONT></TD> </TR> </TABLE><P> <TABLE cellpadding="1" cellspacing="0" border="0" width="200" align="center"> <TR bgcolor="#006666"> <TD valign="top"><FONT size="4" color="#FFFFFF" face="arial,helvetica"><B><A HREF="/index.pl?section=books"><FONT COLOR="#FFFFFF">Book Reviews</FONT></A></B></FONT></TD> </TR><TR><TD bgcolor="#CCCCCC"><FONT color="#000000" size="2"><p>Jon Katz, Resident Gasbag, has a new, very appropriate book coming out soon, <a href="http://www.thinkgeek.com">Geeks</a>. Preorder now and receive the book early. <p>For probably the best fiction read around, check out Neal Stephenson's <cite><a href="/article.pl?sid=99/06/23/139229&mode=thread">Cryptonomicon</a></cite>, an engaging read about WWII, cryptography and buried treasure. And data vaults. <p>If you've been doing a lot of work in Perl, you've probably figured out you really need <cite><a href="/article.pl?sid=99/05/10/2238254&mode=thread">Perl in a Nutshell</a></cite> or <cite><a href="/article.pl?sid=99/01/29/1035246&mode=thread">The Perl Cookbook</a></cite>. If you're still learning, grab <cite><a href="/books/older/980526096229.shtml">Programming Perl</a></cite>. <p>And if you want to learn more about how to become a better coder, grab <cite><a href="/article.pl?sid=99/06/28/1417229&mode=thread">The Unified Software Development Process</a></cite> or <cite><a href="/article.pl?sid=99/04/08/1512209&mode=thread">The Practice of Programming</cite></a> Additionally, check out <cite><a href="http://slashdot.org/article.pl?sid=99/09/16/1333202&mode=thread">Refactoring: Improving the Design of Existing Code</a></cite> . <p>Developing a large application? Grab Eric Greenberg's excellent <cite><a href="/article.pl?sid=99/07/13/1943258&mode=thread">Network Application Frameworks</cite></a>. <P>Visit <A href="/index.pl?section=books">Our Book Reviews Section</A> for more. <br> <B>Update: 11/12 05:19</B> by <B><A href="mailto:hemos at slashdot.org">H</A></B>:</FONT></TD> </TR> </TABLE><P> <TABLE cellpadding="1" cellspacing="0" border="0" width="200" align="center"> <TR bgcolor="#006666"> <TD valign="top"><FONT size="4" color="#FFFFFF" face="arial,helvetica"><B>Quick Links</B></FONT></TD> </TR><TR><TD bgcolor="#CCCCCC"><FONT color="#000000" size="2"><B>Cool Sites:</B> <LI><A href="http://www.linux.com">Linux.com</A> (What <B>is</B> Linux?) <LI><A href="http://everything.blockstackers.com">Everything</A> (Blow your Mind) <LI><A href="http://www.geekculture.com/geekycomics/Aftery2k/aftery2kmain.html">After Y2k</A> (<I>This</I> is Post-Apocalyptic?) <LI><A href="http://www.userfriendly.org">User Friendly</A> (Laugh) <LI><A href="http://themes.org">Themes.org</A> (Make X Perty) <P><B>Support Slashdot:</B> <LI><A href="http://www.thinkgeek.com">ThinkGeek</A> (Clothe Yourself in Slashdot) <LI><A href="http://cdnow.com/from=sr-302791">CDnow</A> (Support <A href="http://www.cdnow.com/gift/malda@slashdot.org">Rob's Who Habit</A>) <LI><A href="http://adfu.slashdot.org">Slashdot Advertiser Index</A></FONT></TD> </TR> </TABLE><P> <TABLE cellpadding="1" cellspacing="0" border="0" width="200" align="center"> <TR bgcolor="#006666"> <TD valign="top"><FONT size="4" color="#FFFFFF" face="arial,helvetica"><B><A HREF="http://freshmeat.net"><FONT COLOR="#FFFFFF">Freshmeat</FONT></A></B></FONT></TD> </TR><TR><TD bgcolor="#CCCCCC"><FONT color="#000000" size="2"><P><FONT size="4" color="#006666"><B>January</B></FONT><BR> <LI><A href="http://freshmeat.net/news/2000/01/29/949208399.html">We should get this out of the door now</A> <LI><A href="http://freshmeat.net/news/2000/01/29/949159642.html">Is Linux for Crazies?</A> <LI><A href="http://freshmeat.net/news/2000/01/29/949156343.html">SQN Linux 1.6</A> <LI><A href="http://freshmeat.net/news/2000/01/29/949156277.html">Limo 0.3.2</A> <LI><A href="http://freshmeat.net/news/2000/01/29/949156237.html">Fusion GS 1.3</A> <LI><A href="http://freshmeat.net/news/2000/01/29/949145887.html">MMR 1.5.4</A> <LI><A href="http://freshmeat.net/news/2000/01/29/949142835.html">KUPS 0.3.4</A> <LI><A href="http://freshmeat.net/news/2000/01/29/949142815.html">3DSE patch for XMMS 4</A> <LI><A href="http://freshmeat.net/news/2000/01/29/949139763.html">Linux 2.3.41</A> <LI><A href="http://freshmeat.net/news/2000/01/29/949139751.html">Free Code for Linux S/390</A> <FORM METHOD="post" ACTION="http://core.freshmeat.net/search.php3"> <FONT size="3" color="#006666"><B>Search Freshmeat:</B></FONT><BR> <INPUT TYPE="hidden" NAME="link" VALUE="freshmeat.net"> <INPUT TYPE="text" NAME="query"> </FORM> <P align="right"><A href="http://freshmeat.net"><B>More Meat...</B></A></FONT></TD> </TR> </TABLE><P> </FONT></TD>
+ </TR>
+ </TABLE><TABLE cellpadding="0" cellspacing="0" border="0" width="99%" align="center" bgcolor="ffffff">
+ <TR>
+ <TD colspan="4" align="center"><IMG src="image14" alt="" width="80%" height="1" hspace="10" vspace="30"></TD>
+ </TR><TR>
+ <TD align="center"><FONT size="2" face="arial,helvetica">
+ <FORM method="GET" action="http://slashdot.org/search.pl">
+ <INPUT type="name" name="query" value="" width="20" size="20" length="20">
+ <INPUT type="submit" value="Search">
+ </FORM>
+ </FONT>
+ </TD>
+ <TD bgcolor="#ffffff" width="25"> </TD>
+ <TD align="center">
+ <FONT size="2" face="arial,helvetica"><I>Wasn't there something about a PASCAL programmer knowing the value of
+everything and the Wirth of nothing?
+<TD> </TD></I></FONT>
+ </FONT>
+ </TD></TR>
+ <TR><TD colspan="4" align="center">
+ <FONT size="1" color="#006666" face="arial,helvetica">
+
+ All trademarks and copyrights on this
+ page are owned by their respective owners. Comments
+ are owned by the Poster.
+ The Rest © 1997-2000 <A href="http://Andover.Net">Andover.Net</A>.
+</FONT></CENTER>
+ </TD>
+ </TR>
+ </TABLE>
+ <CENTER>
+ <FONT size="2" color="#006666">
+
+ [ <A href="http://slashdot.org/"><Font color="#ffffff">home</FONT></A> |
+ <A href="http://slashdot.org/awards.shtml"><Font color="#ffffff">awards</FONT></A> |
+ <A href="http://slashdot.org/supporters.shtml"><FONT color="#ffffff">supporters</FONT></A> |
+ <A href="http://CmdrTaco.net"><FONT color="#ffffff">rob's homepage</FONT></A> |
+ <A href="http://slashdot.org/submit.pl"><FONT color="#ffffff">contribute story</FONT></A> |
+ <A href="http://slashdot.org/search.pl"><FONT color="#ffffff">older articles</FONT></A> |
+ <A href="http://Andover.Net"><FONT color="#ffffff">Andover.Net</FONT></A> |
+ <A href="http://slashdot.org/advertising.shtml"><FONT color="#ffffff">advertising</FONT></A> |
+ <A href="http://slashdot.org/pollBooth.pl"><FONT color="#ffffff">past polls</FONT></A> |
+ <A href="http://slashdot.org/about.shtml"><FONT color="#ffffff">about</FONT></A> |
+ <A href="http://slashdot.org/faq.shtml"><FONT color="#ffffff">faq</FONT></A> ]
+ </FONT>
+ </CENTER>
+</BODY>
+</HTML>
diff --git a/tests/page2/image1 b/tests/page2/image1
new file mode 100644
index 0000000..2ed6ddc
Binary files /dev/null and b/tests/page2/image1 differ
diff --git a/tests/page2/image10 b/tests/page2/image10
new file mode 100644
index 0000000..3021b68
Binary files /dev/null and b/tests/page2/image10 differ
diff --git a/tests/page2/image11 b/tests/page2/image11
new file mode 100644
index 0000000..41d1fe3
Binary files /dev/null and b/tests/page2/image11 differ
diff --git a/tests/page2/image12 b/tests/page2/image12
new file mode 100644
index 0000000..655a686
Binary files /dev/null and b/tests/page2/image12 differ
diff --git a/tests/page2/image13 b/tests/page2/image13
new file mode 100644
index 0000000..97d5950
Binary files /dev/null and b/tests/page2/image13 differ
diff --git a/tests/page2/image14 b/tests/page2/image14
new file mode 100644
index 0000000..6d73ad8
Binary files /dev/null and b/tests/page2/image14 differ
diff --git a/tests/page2/image15 b/tests/page2/image15
new file mode 100644
index 0000000..90cc3b2
Binary files /dev/null and b/tests/page2/image15 differ
diff --git a/tests/page2/image16 b/tests/page2/image16
new file mode 100644
index 0000000..93aa853
Binary files /dev/null and b/tests/page2/image16 differ
diff --git a/tests/page2/image17 b/tests/page2/image17
new file mode 100644
index 0000000..f46f030
Binary files /dev/null and b/tests/page2/image17 differ
diff --git a/tests/page2/image18 b/tests/page2/image18
new file mode 100644
index 0000000..3badd5e
Binary files /dev/null and b/tests/page2/image18 differ
diff --git a/tests/page2/image19 b/tests/page2/image19
new file mode 100644
index 0000000..bd4f6d9
Binary files /dev/null and b/tests/page2/image19 differ
diff --git a/tests/page2/image2 b/tests/page2/image2
new file mode 100644
index 0000000..7566dda
Binary files /dev/null and b/tests/page2/image2 differ
diff --git a/tests/page2/image20 b/tests/page2/image20
new file mode 100644
index 0000000..358fa95
Binary files /dev/null and b/tests/page2/image20 differ
diff --git a/tests/page2/image21 b/tests/page2/image21
new file mode 100644
index 0000000..c81aa52
Binary files /dev/null and b/tests/page2/image21 differ
diff --git a/tests/page2/image22 b/tests/page2/image22
new file mode 100644
index 0000000..6cbd630
Binary files /dev/null and b/tests/page2/image22 differ
diff --git a/tests/page2/image23 b/tests/page2/image23
new file mode 100644
index 0000000..e8173a7
Binary files /dev/null and b/tests/page2/image23 differ
diff --git a/tests/page2/image24 b/tests/page2/image24
new file mode 100644
index 0000000..bffd4b4
Binary files /dev/null and b/tests/page2/image24 differ
diff --git a/tests/page2/image25 b/tests/page2/image25
new file mode 100644
index 0000000..c656fa4
Binary files /dev/null and b/tests/page2/image25 differ
diff --git a/tests/page2/image26 b/tests/page2/image26
new file mode 100644
index 0000000..bc93fdb
Binary files /dev/null and b/tests/page2/image26 differ
diff --git a/tests/page2/image27 b/tests/page2/image27
new file mode 100644
index 0000000..6ad0eff
Binary files /dev/null and b/tests/page2/image27 differ
diff --git a/tests/page2/image28 b/tests/page2/image28
new file mode 100644
index 0000000..88f0d7c
Binary files /dev/null and b/tests/page2/image28 differ
diff --git a/tests/page2/image29 b/tests/page2/image29
new file mode 100644
index 0000000..e070418
Binary files /dev/null and b/tests/page2/image29 differ
diff --git a/tests/page2/image3 b/tests/page2/image3
new file mode 100644
index 0000000..ac3fa33
Binary files /dev/null and b/tests/page2/image3 differ
diff --git a/tests/page2/image30 b/tests/page2/image30
new file mode 100644
index 0000000..4a41950
Binary files /dev/null and b/tests/page2/image30 differ
diff --git a/tests/page2/image31 b/tests/page2/image31
new file mode 100644
index 0000000..60f13ed
Binary files /dev/null and b/tests/page2/image31 differ
diff --git a/tests/page2/image32 b/tests/page2/image32
new file mode 100644
index 0000000..04ddc4e
Binary files /dev/null and b/tests/page2/image32 differ
diff --git a/tests/page2/image33 b/tests/page2/image33
new file mode 100644
index 0000000..c1ecfff
Binary files /dev/null and b/tests/page2/image33 differ
diff --git a/tests/page2/image34 b/tests/page2/image34
new file mode 100644
index 0000000..3dfd5d7
Binary files /dev/null and b/tests/page2/image34 differ
diff --git a/tests/page2/image35 b/tests/page2/image35
new file mode 100644
index 0000000..aea44f3
Binary files /dev/null and b/tests/page2/image35 differ
diff --git a/tests/page2/image36 b/tests/page2/image36
new file mode 100644
index 0000000..baef0e0
Binary files /dev/null and b/tests/page2/image36 differ
diff --git a/tests/page2/image37 b/tests/page2/image37
new file mode 100644
index 0000000..6c6ba52
Binary files /dev/null and b/tests/page2/image37 differ
diff --git a/tests/page2/image38 b/tests/page2/image38
new file mode 100644
index 0000000..e298e04
Binary files /dev/null and b/tests/page2/image38 differ
diff --git a/tests/page2/image39 b/tests/page2/image39
new file mode 100644
index 0000000..e16e2f1
Binary files /dev/null and b/tests/page2/image39 differ
diff --git a/tests/page2/image4 b/tests/page2/image4
new file mode 100644
index 0000000..9e5e46b
Binary files /dev/null and b/tests/page2/image4 differ
diff --git a/tests/page2/image5 b/tests/page2/image5
new file mode 100644
index 0000000..646a6d9
Binary files /dev/null and b/tests/page2/image5 differ
diff --git a/tests/page2/image6 b/tests/page2/image6
new file mode 100644
index 0000000..7df417c
Binary files /dev/null and b/tests/page2/image6 differ
diff --git a/tests/page2/image7 b/tests/page2/image7
new file mode 100644
index 0000000..0e6ac10
Binary files /dev/null and b/tests/page2/image7 differ
diff --git a/tests/page2/image8 b/tests/page2/image8
new file mode 100644
index 0000000..ba7fb47
Binary files /dev/null and b/tests/page2/image8 differ
diff --git a/tests/page2/image9 b/tests/page2/image9
new file mode 100644
index 0000000..b1cad73
Binary files /dev/null and b/tests/page2/image9 differ
diff --git a/tests/page2/index.html b/tests/page2/index.html
new file mode 100644
index 0000000..7eaf2d2
--- /dev/null
+++ b/tests/page2/index.html
@@ -0,0 +1,433 @@
+<html>
+<head>
+ <title>Tcl Resource Center</title>
+</head>
+
+<body bgcolor="white" text="black">
+
+ <!-- MenuTopLevel Resource Software Extensions -->
+ <table border="0" cellpadding="0" cellspacing="0">
+ <tr>
+ <td width="120" valign="TOP"><a href="/"><img src="image1" width="120" height="79" alt="Scriptics" border="0"></a></td>
+ <td valign="top" width="548">
+
+ <!-- Table to hold tabs -->
+ <table cellpadding="0" cellspacing="0" border="0" width="548">
+ <tr>
+ <td valign="top" align="right" colspan="15" width="548"><a name="TOP"><img src="image2" width="548" height="9" alt="Tcl/Tk" border="0"></a></td>
+ </tr>
+ <tr>
+ <td valign="top" align="right" colspan="15" width="548"><img src="image3" width="482" height="34" alt="Scripting Solutions for eBusiness Integration" border="0"></td>
+ </tr>
+ <tr>
+ <td width="18" valign="TOP"><img src="image4" width="18" height="36" alt="" border="0"></td>
+ <td width="58"><a href="/products/" onMouseOver="msover(4, 'http://images.scriptics.com/images/ProductsMouseOff.gif') ; return true ;" onMouseOut="msover(4, 'http://images.scriptics.com/images/ProductsOff.gif') ; return true ;"><img src="image5" width="58" height="36" alt="Products" border="0"></a></td>
+ <td width="14" valign="TOP"><img src="image6" width="14" height="36" alt="" border="0"></td>
+ <td width="69"><a href="/customers/" onMouseOver="msover(6, 'http://images.scriptics.com/images/CustomersMouseOff.gif') ; return true ;" onMouseOut="msover(6, 'http://images.scriptics.com/images/CustomersOff.gif') ; return true ;"><img src="image7" width="69" height="36" alt="Customers" border="0"></a></td>
+ <td width="14" valign="TOP"><img src="image6" width="14" height="36" alt="" border="0"></td>
+ <td width="60"><a href="/partners/" onMouseOver="msover(8, 'http://images.scriptics.com/images/PartnersMouseOff.gif') ; return true ;" onMouseOut="msover(8, 'http://images.scriptics.com/images/PartnersOff.gif') ; return true ;"><img src="image8" width="60" height="36" alt="Partners" border="0"></a></td>
+ <td width="14" valign="TOP"><img src="image6" width="14" height="36" alt="" border="0"></td>
+ <td width="56"><a href="/services/" onMouseOver="msover(10, 'http://images.scriptics.com/images/ServicesMouseOff.gif') ; return true ;" onMouseOut="msover(10, 'http://images.scriptics.com/images/ServicesOff.gif') ; return true ;"><img src="image9" width="56" height="36" alt="Services" border="0"></a></td>
+ <td width="14" valign="TOP"><img src="image10" width="14" height="36" alt="" border="0"></td>
+ <td width="88"><a href="/resource/" onMouseOver="msover(12, 'http://images.scriptics.com/images/ResourceMouseOn.gif') ; return true ;" onMouseOut="msover(12, 'http://images.scriptics.com/images/ResourceOn.gif') ; return true ;"><img src="image11" width="88" height="36" alt="Tcl Resources" border="0"></a></td>
+ <td width="14" valign="TOP"><img src="image12" width="14" height="36" alt="" border="0"></td>
+ <td width="57"><a href="/company/" onMouseOver="msover(14, 'http://images.scriptics.com/images/CompanyMouseOff.gif') ; return true ;" onMouseOut="msover(14, 'http://images.scriptics.com/images/CompanyOff.gif') ; return true ;"><img src="image13" width="57" height="36" alt="Company" border="0"></a></td>
+ <td width="8" valign="TOP"><img src="image14" width="8" height="36" alt="" border="0"></td>
+ <td width="50" valign="TOP"><img src="image15" width="50" height="36" alt="" border="0"></td>
+ <td width="14" valign="TOP"><img src="image16" width="14" height="36" alt="" border="0"></td>
+ </tr>
+ </table>
+ </td>
+ </tr>
+ </table> <script language="Javascript">
+ <!--
+ function msover(num, file )
+ {
+ old = (((navigator.appName=='Netscape') &&
+ (parseInt(navigator.appVersion)<=3.0 )))
+ if ( !old ) {
+ document.images[num].src=file
+ }
+ }
+ //-->
+ </SCRIPT>
+
+<!-- MenuSubLevel Resource Software Extensions Tk -->
+
+<table cellpadding="0" cellspacing="0" border="0">
+
+<!-- Left Hand Column-->
+
+<tr><td valign="top" width="120"><table cellpadding="0" cellspacing="0" border="0" width="120">
+ <tr>
+ <td width="120" valign="TOP"><img src="image17" width="120" height="4" alt="" border="0"></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><a href="/resource/software/"><img src="image18" width="120" height="11" alt="Software" border="0"></a></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><img src="image19" width="120" height="4" alt="" border="0"></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><a href="/resource/software/tcltk/"><img src="image20" width="120" height="11" alt="Tcl/Tk Core" border="0"></a></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><img src="image19" width="120" height="4" alt="" border="0"></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><a href="/resource/software/applications/"><img src="image21" width="120" height="11" alt="Applications" border="0"></a></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><img src="image22" width="120" height="4" alt="" border="0"></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><a href="/resource/software/extensions/"><img src="image23" width="120" height="11" alt="Extensions" border="0"></a></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><img src="image24" width="120" height="6" alt="" border="0"></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><a href="/resource/software/patches/"><img src="image25" width="120" height="11" alt="Patches" border="0"></a></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><img src="image19" width="120" height="4" alt="" border="0"></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><a href="/resource/software/java/"><img src="image26" width="120" height="11" alt="Tcl & Java" border="0"></a></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><img src="image19" width="120" height="4" alt="" border="0"></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><a href="/resource/software/ports/"><img src="image27" width="120" height="11" alt="Tcl/Tk Ports" border="0"></a></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><img src="image19" width="120" height="4" alt="" border="0"></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><a href="/resource/software/tools/"><img src="image28" width="120" height="11" alt="Tools" border="0"></a></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><img src="image29" width="120" height="6" alt="" border="0"></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><a href="/resource/doc/"><img src="image30" width="120" height="11" alt="Documentation" border="0"></a></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><img src="image31" width="120" height="5" alt="" border="0"></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><a href="/resource/community/"><img src="image32" width="120" height="11" alt="Community" border="0"></a></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><img src="image31" width="120" height="5" alt="" border="0"></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><a href="/live/bydate"><img src="image33" width="120" height="11" alt="What's New" border="0"></a></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><img src="image31" width="120" height="5" alt="" border="0"></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><a href="/forms/urlnote.html"><img src="image34" width="120" height="11" alt="Add URL" border="0"></a></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><img src="image31" width="120" height="5" alt="" border="0"></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><a href="/live/keyword"><img src="image35" width="120" height="11" alt="Keyword Search" border="0"></a></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><img src="image31" width="120" height="5" alt="" border="0"></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><a href="/live/sitemap"><img src="image36" width="120" height="11" alt="Index" border="0"></a></td>
+ </tr>
+ <tr>
+ <td width="120" valign="TOP"><img src="image37" width="120" height="6" alt="" border="0"></td>
+ </tr>
+</table><!-- End Left Column --></td><!-- Right Hand Column --><td valign="top" width="548" align="left"><table cellpadding="0" cellspacing="0" border="0" width="548">
+ <tr>
+ <td width="295" valign="TOP"><img src="image38" width="295" height="42" alt="Resource" border="0"></td>
+ <td width="187" valign="bottom" align="right"><FORM action="/live/keyword"><img src="image39" width="46" height="24" alt="" border="0"><INPUT TYPE="TEXT" SIZE="10" MAXLENGTH="35" NAME="keywords"><INPUT type="IMAGE" border="0" img="img" src="http://images.scriptics.com/images/Go.gif" value="submit" width="33" height="24"></FORM>
+ </tr>
+ </table>
+ <!-- 2 Columns for spacer -->
+ <table cellpadding="0" cellspacing="0" border="0" width="548">
+ <tr>
+ <!-- Spacer Column -->
+ <td valign="top" width="10">
+
+ </td>
+
+
+ <td valign="top" width="548"><font face="Geneva, Helvetica, Arial" size="2"><h1>Tcl Resource Center</h1>
+<font size="+1"><a href="/resource/">Top</a>><a href="/resource/software/" ="">Software Central</a>><a href="/resource/software/extensions/" ="">Extensions</a>>Tk Widgets</font><font size="-1"><br>Viewed by name (<a href="/resource/software/extensions/tk/?sortby=date">By date</a>)</font><br>
+<p>Tk is a toolkit for building graphical user interfaces with Tcl.
+ Your Tcl/Tk scripts run on UNIX, Windows, and Macintosh.<p>
+<font face="Geneva, Helvetica, Arial"><ul></ul></font><dl>
+<dt><b><a href="http://marge.phys.washington.edu/%7Ezager/blt80-unoff-exe.zip" ="">BLT 8.0 Unofficial zip and DLL</a></b>
+<dd>This is a compiled version of BLT 8.0 "unofficial" for
+the Windows platform. <a href="/live/annotate?url=http%3a%2f%2fmarge%2ephys%2ewashington%2eedu%2f%257Ezager%2fblt80%2dunoff%2dexe%2ezip">Edit</a>
+ <i><font size="-1">(September 24, 1999 06:31)</font></i><dt><b><a href="ftp://ftp.neosoft.com/languages/tcl/sorted/unknown/blt8.0p2-unoff.tgz" ="">BLT 8.0p2 Unofficial tar file</a><a name="bltunoff"></a></b>
+<dd>This is a contributed patch to make BLT compatible with Tcl/Tk 8.0p2. While still "unofficial", it is widely used.
+ Make sure you get the 8.0p2 version because the 8.0 version does
+ not compile under windows.
+ There is also a <a href="ftp://ftp.neosoft.com/languages/sorted/devel/blt2.3-8.1.tar.gz">2.3-8.1 version</a> that has been patched to work with 8.1.
+ <a href="ftp://ftp.neosoft.com/languages/tcl/sorted/unknown/blt8.0p2-unoff.README">README file</a>. <a href="/live/annotate?url=ftp%3a%2f%2fftp%2eneosoft%2ecom%2flanguages%2ftcl%2fsorted%2funknown%2fblt8%2e0p2%2dunoff%2etgz">Edit</a>
+ <i><font size="-1">(August 30, 1999 06:38)</font></i><dt><b><a href="http://www.tcltk.com/blt/" ="">BLT Home Page</a></b>
+<dd>
+ Author <b>George Howlett</b>, Version <b>2.3</b>,
+ Works with <b>Tk 4.1 through Tk 8.1</b>
+<br><a href="ftp://ftp.tcltk.com/pub/blt/">Download</a>, <a href="ftp://ftp.tcltk.com/pub/blt/BLT2.3.tar.gz">BLT2.3.tar.gz</a>, <a href="ftp://ftp.tcltk.com/pub/blt/BLT2.4h.tar.gz">BLT2.4h.tar.gz</a>, <a href="ftp://ftp.tcltk.com/pub/blt/BLT2.4i.tar.gz">BLT2.4i.tar.gz</a>, <a href="ftp://ftp.tcltk.com/pub/blt/blt2.4i-for-8.0.exe">blt2.4i-for-8.0.exe</a>, <a href="ftp://ftp.tcltk.com/pub/blt/blt2.4i-for-8.1.exe">blt2.4i-for-8.1.exe</a><br>BLT is a set of widgets for Tk, including a graph widget,
+bar chart, drag&drop, a simple command tracer, and much more.
+The 2.4 release, which is still under development, works with 8.0
+or higher.
+There are also an "<a href="#bltunoff">unofficial</a>" release for 8.0p2
+and 8.1a2 that were not done by the author. <a href="/live/annotate?url=http%3a%2f%2fwww%2etcltk%2ecom%2fblt%2f">Edit</a>
+ <i><font size="-1">(October 26, 1999 09:43)</font></i><dt><b><a href="http://www.unifix-online.com/BWidget/index.html" ="">BWidget</a></b>
+<dd>A set of native Tk 8.x Widgets using Tcl8.x namespaces.
+The ToolKit is available under Unix/X11 and Windows.
+The BWidget(s) have a professional look&feel as in other
+well known Toolkits (Tix or Incr Widget) but the concept is
+radically different because everything is native
+so no platform compilation, no compiled extension
+library are needed. The code is 100 Pure Tcl/Tk.
+More 30 components : Notebook, PageManager, Tree, PanedWindow, ButtonBox,
+ScrollView, ComboBox, SpinBox, ListBox, SelectFont, SelectColor,
+ProgressBare ... <a href="/live/annotate?url=http%3a%2f%2fwww%2eunifix%2donline%2ecom%2fBWidget%2findex%2ehtml">Edit</a>
+ <i><font size="-1">(September 06, 1999 09:58)</font></i><dt><b><a href="http://purl.oclc.org/net/nijtmans/dash.html" ="">Dash Patch for Tk</a></b>
+<dd>This patch has many enhancements to the Tk and its canvas
+widget, including dashed lines, smoothed polygons,
+and performance enhancements. <a href="/live/annotate?url=http%3a%2f%2fpurl%2eoclc%2eorg%2fnet%2fnijtmans%2fdash%2ehtml">Edit</a>
+ <i><font size="-1">(November 21, 1999 06:33)</font></i><dt><b><a href="http://www.hwaci.com/sw/et" ="">Embedded Tk (et)</a></b>
+<dd>
+ Author <b><a href="mailto:drh at acm.org" ="">Richard Hipp</a></b>, Version <b>8.0b5</b>,
+ Works with <b>Tk 4.0, 4.1, 4.2, 8.0</b>
+<br>Download: <a href="http://www.hwaci.com/sw/et/et80b5.tar.gz">et80b5.tar.gz</a><br>Embedded Tk or ``ET'' is tool for making stand-alone executables out of a mixture of C or C++ and Tcl/Tk.
+Using ET you can invoke a short Tcl/Tk script in the middle of a C routine, or you can invoke a C routine in the
+middle of a Tcl/Tk script. ET also bundles external Tcl/Tk scripts (including the standard Tcl/Tk startup scripts)
+into the executable so that the executable can be run on another binary-compatible computer that doesn't have
+Tcl/Tk installed. <a href="/live/annotate?url=http%3a%2f%2fwww%2ehwaci%2ecom%2fsw%2fet">Edit</a>
+ <i><font size="-1">(August 19, 1999 15:35)</font></i><dt><b><a href="http://www.purl.org/net/hobbs/tcl/script/tkcon/" ="">Enhanced Tk Console (TkCon)</a></b>
+<dd>
+ Author <b><a href="mailto:jeffrey.hobbs at oen.siemens.de" ="">Jeff Hobbs</a></b>, Version <b>1.3</b>,
+ Works with <b>Tk 4.1 through Tk 8.1</b>
+<br>Download: <a href="http://www.purl.org/net/hobbs/tcl/script/tkcon/tkcon.tar.gz">tkcon.tar.gz</a><br>TkCon is a replacement for the standard console that comes with Tk (on Windows/Mac, but also works on
+
+Unix). The console itself provides many more features than the standard console. <a href="/live/annotate?url=http%3a%2f%2fwww%2epurl%2eorg%2fnet%2fhobbs%2ftcl%2fscript%2ftkcon%2f">Edit</a>
+ <i><font size="-1">(August 23, 1999 12:06)</font></i><dt><b><a href="http://www.scriptmeridian.org/projects/tk/" ="">Frontier-Tk ScriptMeridian project</a></b>
+<dd>This project seeks to integrate the Tk toolkit
+with the Frontier scripting language. <a href="/live/annotate?url=http%3a%2f%2fwww%2escriptmeridian%2eorg%2fprojects%2ftk%2f">Edit</a>
+ <i><font size="-1">(August 19, 1999 15:36)</font></i><dt><b><a href="http://purl.oclc.org/net/nijtmans/img.html" ="">Img image format extension</a></b>
+<dd>This package enhances Tk, adding support for many other Image formats:
+BMP, XBM, XPM, GIF (with transparency), PNG,
+JPEG, TIFF and postscript.
+This is implemented as a shared library that can be dynamically loaded into
+Tcl/Tk.
+ <a href="/live/annotate?url=http%3a%2f%2fpurl%2eoclc%2eorg%2fnet%2fnijtmans%2fimg%2ehtml">Edit</a>
+ <i><font size="-1">(November 21, 1999 06:35)</font></i><dt><b><a href="http://purl.oclc.org/net/oakley/tcl/mclistbox/index.html" ="">mclistbox - a multi-column listbox widget</a></b>
+<dd>mclistbox is a multi-column listbox that is
+written in pure tcl and runs on all platforms
+that support tcl/tk 8.0 or higher. This widget
+requires no other extensions; it is completely
+standalone. <a href="/live/annotate?url=http%3a%2f%2fpurl%2eoclc%2eorg%2fnet%2foakley%2ftcl%2fmclistbox%2findex%2ehtml">Edit</a>
+ <i><font size="-1">(August 19, 1999 15:37)</font></i><dt><b><a href="http://home.t-online.de/home/dshepherd/tkview.htm" ="">MFC views C++ class for embedding Tk</a></b>
+<dd>The idea of embedding Tk in MFC windows always seemed very enticing but information was sparse and contradictory - on a
+ scale between "very easy" and "not yet possible". The only thing for it was to have a go and lo, it wasn't that hard after all.
+ CTkView is a C++ class which can be used in MFC SDI or MDI applications. An instance of CTkView hosts an embedded Tk
+ toplevel widget and performs some management chores for the widget so that it can size, update and react correctly to Windows
+ events. <a href="/live/annotate?url=http%3a%2f%2fhome%2et%2donline%2ede%2fhome%2fdshepherd%2ftkview%2ehtm">Edit</a>
+ <i><font size="-1">(August 19, 1999 15:38)</font></i><dt><b><a href="http://www.cs.umd.edu/hcil/pad++" ="">Pad++</a></b>
+<dd>
+ Author <b><a href="mailto:pad-info at cs.umd.edu" ="">Ben Bederson et al</a></b>, Version <b>0.9p1</b>,
+ Works with <b>8.0</b>
+<br>Download: <a href="http://www.cs.umd.edu/hcil/pad++/download.html">download.html</a><br>Pad++ is a Tk widget that provides a Zoomable User Interface (ZUI) that supports real-time interactive zoomable graphics in a fashion similar to the Tk Canvas widget. Pad++ supports tens of thousands of objects which include text, images, graphics, portals, lenses, simple html (and more), including transparency and rotation. <a href="/live/annotate?url=http%3a%2f%2fwww%2ecs%2eumd%2eedu%2fhcil%2fpad%2b%2b">Edit</a>
+ <i><font size="-1">(August 19, 1999 15:39)</font></i><dt><b><a href="http://home.t-online.de/home/sesam.com/freeware.htm" ="">Progressbar</a></b>
+<dd>Progressbar is a megawidget written in pure tcl (ie: no compiling required - runs on all platforms Macintosh, Unix, Windows).
+Its primary purpose is to show the progress of any action in percent. <a href="/live/annotate?url=http%3a%2f%2fhome%2et%2donline%2ede%2fhome%2fsesam%2ecom%2ffreeware%2ehtm">Edit</a>
+ <i><font size="-1">(January 24, 2000 09:19)</font></i><dt><b><a href="http://jfontain.free.fr/" ="">scwoop (Simple Composite Widget Object Oriented Package)</a></b>
+<dd>Scwoop is a composite widget (also known as mega widget) extension to the great Tk widget library. Scwoop is
+entirely written in Tcl using the stooop (Simple Tcl Only Object Oriented Programming) extension. <a href="/live/annotate?url=http%3a%2f%2fjfontain%2efree%2efr%2f">Edit</a>
+ <i><font size="-1">(January 09, 2000 02:10)</font></i><dt><b><a href="http://www2.clearlight.com/~oakley/tcl/supertext.html" ="">Supertext - tk text widget with unlimited undo</a></b>
+<dd>
+ Author <b><a href="mailto:oakley at channelpoint.com" ="">Bryan Oakley</a></b>, Version <b>1.0b1</b>,
+ Works with <b>Tcl 8.0</b>
+<br>Download: <a href="http://www2.clearlight.com/~oakley/tcl/supertext.tcl">supertext.tcl</a><br>Supertext is a package that provides a tk text widget with full undo and the ability to execute procedures both before and after a text
+widget command has been processed. Supertext may be used as-is, or for the brave it may be used in place of the standard text
+widget. <a href="/live/annotate?url=http%3a%2f%2fwww2%2eclearlight%2ecom%2f%7eoakley%2ftcl%2fsupertext%2ehtml">Edit</a>
+ <i><font size="-1">(August 23, 1999 12:06)</font></i><dt><b><a href="http://www.hwaci.com/sw/tk/nbpi.html" ="">Tabbed Notebook Widget</a></b>
+<dd>
+ Author <b><a href="mailto:drh at acm.org" ="">Richard Hipp</a></b>, Version <b>1.0</b>,
+ Works with <b>Tk 4.1 or later.</b>
+<br>Download: <a href="http://www.hwaci.com/sw/tk/notebook.tcl">notebook.tcl</a><br>This implements a tabbed notebook using
+a canvas widget and embedded frames.
+This is pure Tcl
+code - not a C extension. <a href="/live/annotate?url=http%3a%2f%2fwww%2ehwaci%2ecom%2fsw%2ftk%2fnbpi%2ehtml">Edit</a>
+ <i><font size="-1">(August 23, 1999 12:08)</font></i><dt><b><a href="http://www.tcltk.com/ellson/ftp/Gdtclft2.0.README" ="">Tcl GD - graphics</a></b>
+<dd>
+ Author <b>John Ellson and Spencer Thomas</b>, Version <b>2.0</b>,
+ Works with <b>8.0 and higher</b>
+<br>Download: <a href="http://www.tcltk.com/ellson/ftp/Gdtclft2.0.tar.gz">Gdtclft2.0.tar.gz</a><br>
+ Thomas Boutell's Gd package provides a convenient way to generate
+ PNG images with a C program. If you prefer Tcl for CGI
+ applications, you'll want the TCL GD extension. <a href="/live/annotate?url=http%3a%2f%2fwww%2etcltk%2ecom%2fellson%2fftp%2fGdtclft2%2e0%2eREADME">Edit</a>
+ <i><font size="-1">(August 19, 1999 14:52)</font></i><dt><b><a href="http://www.stratasys.com/software/metagui" ="">The Meta-GUI Tools</a></b>
+<dd>The Meta-GUI tools provide a framework for quickly building full
+GUI applications. The GUI is rendered by a run-time engine
+based on a hierarchical set of definitions you provide. At the bottom
+of the hierarchy are abstract data types such as length, angle,
+string, etc., and these are used to progressively build up frames,
+dialogs, toolbars, menus, and operations. <a href="/live/annotate?url=http%3a%2f%2fwww%2estratasys%2ecom%2fsoftware%2fmetagui">Edit</a>
+ <i><font size="-1">(August 23, 1999 12:10)</font></i><dt><b><a href="http://jfontain.free.fr/" ="">Tkpiechart Home Page</a></b>
+<dd>Tkpiechart is a Tcl-only extension that allows the programmer to create and dynamically update 2D or 3D pie
+charts in a Tcl/Tk application. This uses the stooop package and builds
+pie charts on a Tk canvas. <a href="/live/annotate?url=http%3a%2f%2fjfontain%2efree%2efr%2f">Edit</a>
+ <i><font size="-1">(January 09, 2000 02:12)</font></i><dt><b><a href="http://www.cygnus.com/~irox/tkprint/" ="">TkPrint</a></b>
+<dd>TkPrint is an extension that allows you to print from a
+ Tk widget. <a href="/live/annotate?url=http%3a%2f%2fwww%2ecygnus%2ecom%2f%7eirox%2ftkprint%2f">Edit</a>
+ <i><font size="-1">(October 11, 1999 09:58)</font></i><dt><b><a href="http://www.purl.org/net/hobbs/tcl/capp/" ="">TkTable Home Page</a></b>
+<dd>The TkTable widget. The <code>table</code> command creates a
+2-dimensional grid of cells. The table can use a Tcl array variable or Tcl
+
+command for data storage and retrieval. <a href="/live/annotate?url=http%3a%2f%2fwww%2epurl%2eorg%2fnet%2fhobbs%2ftcl%2fcapp%2f">Edit</a>
+ <i><font size="-1">(November 18, 1999 09:25)</font></i><dt><b><a href="http://ftp.austintx.net/users/jatucker/TkTextmatrix/default.htm" ="">TkTextMatrix (spreadsheet)</a></b>
+<dd>
+ Author <b><a href="mailto:jatucker at austin.dsccc.com" ="">John Arthur Tucker</a></b>, Version <b>4.1</b>,
+ Works with <b>Tk 4.1</b>
+<br>Download: <a href="http://ftp.austintx.net/users/jatucker/TkTextmatrix/download.htm">download.htm</a>, <a href="http://ftp.austintx.net/users/jatucker/TkTextmatrix/textmatrix4.1.tar.gz">textmatrix4.1.tar.gz</a><br>A Tcl/Tk spreadsheet widget, TkTextmatrix, which is implemented in C++ and is
+ basically a Tk Canvas widget plus extra behavior for manipulating rows and columns of cell
+ items many times faster than with a plain Tk Canvas. It actually inserts text nearly as fast
+ as the Tk Text widget. If you work with or are interested in creating your own Tcl/Tk widgets
+ in C++, you might want to take a look at the C++ widget library included with this
+ distribution. <a href="/live/annotate?url=http%3a%2f%2fftp%2eaustintx%2enet%2fusers%2fjatucker%2fTkTextmatrix%2fdefault%2ehtm">Edit</a>
+ <i><font size="-1">(August 23, 1999 12:14)</font></i><dt><b><a href="http://www.cs.umd.edu/~bederson/Togl.html" ="">ToGL - a Tk Open GL widget</a></b>
+<dd>Togl is a Tk widget for OpenGL rendering. Togl is based on OGLTK, originally written by Benjamin Bederson at the
+University of New Mexico (who has since moved to the University of Maryland). Togl adds the new features:
+<ul>
+<li> color-index mode support including color allocation functions
+<li> support for requesting stencil, accumulation, alpha buffers, etc
+<li> multiple OpenGL drawing widgets
+<li> OpenGL extension testing from Tcl
+<li> simple, portable font support
+<li> overlay plane support
+</ul>
+Togl allows one to create and manage a special Tk/OpenGL widget with Tcl and render into it with a C program. That is,
+a typical Togl program will have Tcl code for managing the user interface and a C program for computations and
+OpenGL rendering. <a href="/live/annotate?url=http%3a%2f%2fwww%2ecs%2eumd%2eedu%2f%7ebederson%2fTogl%2ehtml">Edit</a>
+ <i><font size="-1">(August 23, 1999 12:14)</font></i><dt><b><a href="http://www.hwaci.com/sw/tk/treepi.html" ="">Tree Widget</a></b>
+<dd>This implements a tree display in a canvas widget.
+It is similar in layout to that of the
+Windows explorer file viewer. This is pure Tcl
+code - not a C extension. <a href="/live/annotate?url=http%3a%2f%2fwww%2ehwaci%2ecom%2fsw%2ftk%2ftreepi%2ehtml">Edit</a>
+ <i><font size="-1">(September 29, 1999 14:37)</font></i><dt><b><a href="http://www.du.edu/~mschwart/tcl-tk.htm" ="">Windows Extensions for Tcl/Tk (Michael Schwartz)</a></b>
+<dd>This site has pointers to several extensions specific to the
+Windows platform. The extensions provide printing,
+a MAPI interface to send email, and an interface to manipulate
+.INI files, among other things. <a href="/live/annotate?url=http%3a%2f%2fwww%2edu%2eedu%2f%7emschwart%2ftcl%2dtk%2ehtm">Edit</a>
+ <i><font size="-1">(October 07, 1999 10:50)</font></i><dt><b><a href="http://www.tcltk.com/iwidgets/" ="">[incr Widgets] Home Page</a></b>
+<dd>[incr Widgets] is a set of megawidgets (combo boxes, etc.) that are
+upon the [incr Tcl] object system and the [incr Tk] megawidget
+framework. This comes bundled with the
+<a href="http://www.tcltk.com/itcl/">[incr Tcl]</a> distributions. <a href="/live/annotate?url=http%3a%2f%2fwww%2etcltk%2ecom%2fiwidgets%2f">Edit</a>
+ <i><font size="-1">(September 05, 1999 16:08)</font></i><dt><b><a href="http://www1.clearlight.com/~oakley/tcl/combobox/index.html" ="">combobox</a></b>
+<dd>
+ Author <b><a href="mailto:oakley at channelpoint.com" ="">Bryan Oakley</a></b>, Version <b>1.03</b>,
+ Works with <b>8.x</b>
+<br>Download: <a href="http://www1.clearlight.com/~oakley/tcl/combobox/combobox.tcl">combobox.tcl</a><br>combobox is a pure-tcl implementation of a combobox widget. It is
+entirely self contained and does not require any other OO or megawidget
+extension. It supports both editable and non-editable entries, and
+provides the ability to call a procedure anytime the value of the combobox
+changes. <a href="/live/annotate?url=http%3a%2f%2fwww1%2eclearlight%2ecom%2f%7eoakley%2ftcl%2fcombobox%2findex%2ehtml">Edit</a>
+ <i><font size="-1">(August 23, 1999 12:15)</font></i><dt><b><a href="http://www.multimania.com/droche/rnotebook/index.html" ="">Rnotebook</a></b>
+<dd>
+ Author <b><a href="mailto:dan at lectra.com" ="">Daniel Roche</a></b>, Version <b>1.0</b>,
+ Works with <b>8.0 or higher</b>
+<br>Download: <a href="http://www.multimania.com/droche/rnotebook/index.html">index.html</a><br>This implements a resizeable notebook
+widget in pure tcl/tk <a href="/live/annotate?url=http%3a%2f%2fwww%2emultimania%2ecom%2fdroche%2frnotebook%2findex%2ehtml">Edit</a>
+ <i><font size="-1">(August 19, 1999 15:39)</font></i><dt><b><a href="http://www.tregar.com/samdi.html" ="">saMDI v1.0a1 Multi-Document Interface Extension</a></b>
+<dd>A multi-document interface (MDI) extension for TCL/Tk 8.0.
+This is a common interface format in Microsoft Windows that lets a parent window contain multiple child windows.
+In effect you get a window manager inside a window!
+Uses and includes the STOOOP object-oriented extension by
+Jean-Luc Fontaine.
+saMDI v1.0a1 GPL Copyright 1998 Sam Tregar. <a href="/live/annotate?url=http%3a%2f%2fwww%2etregar%2ecom%2fsamdi%2ehtml">Edit</a>
+ <i><font size="-1">(August 23, 1999 12:07)</font></i><dt><b><a href="http://tix.mne.com/htdocs/tix/index.html" ="">Tix Support Site</a></b>
+<dd>
+ Author <b><a href="mailto:tix at mne.com" ="">Ioi Lam, (adopted by Gregg Squires)</a></b>, Version <b>4.1</b>,
+ Works with <b>Tcl 7.4 through Tcl 8.0</b>
+<br><a href="ftp://ftp.tix.mne.com/pub/tix/">Download</a>, <a href="ftp://ftp.tix.mne.com/pub/tix/Tix4.1.0.006.tar.gz">Tix4.1.0.006.tar.gz</a>, <a href="ftp://ftp.tix.mne.com/pub/tix/Tix41p6.zip">Tix41p6.zip</a>, <a href="ftp://ftp.tix.mne.com/pub/tix/win41p6bin.zip">win41p6bin.zip</a><br><b>Tix has found a new home!</b>
+ <br>
+ Tix provides over 40 new Tk including the
+combo box, file selection dialogs, paned widget,
+notebook, hierarchical list, directory tree, and more.
+ <a href="/live/annotate?url=http%3a%2f%2ftix%2emne%2ecom%2fhtdocs%2ftix%2findex%2ehtml">Edit</a>
+ <i><font size="-1">(August 23, 1999 12:11)</font></i><dt><b><a href="ftp://ftp.archive.eso.org/pub/tree" ="">Tk Tree Widget (C++)</a></b>
+<dd>Tk Tree widget for Tcl8.0.3.
+
+This version contains (optional) support for \[incr Tcl\] and \[incr Tk\]
+version 3.0.
+<br>
+With the tree widget, you can display a tree in a Tk canvas. The nodes
+can be made up of any number of canvas items or even other Tk widgets.
+You create the objects that make up a node and the line that connects
+it to its parent and pass them to the tree widget. After this the tree
+widget manages the positions of the nodes and end points of the tree
+lines. Operations are available for inserting, moving and removing
+nodes and subtrees and for querrying the position of a node in the
+tree. The tree can be displayed horizontally or vertically.
+ <a href="/live/annotate?url=ftp%3a%2f%2fftp%2earchive%2eeso%2eorg%2fpub%2ftree">Edit</a>
+ <i><font size="-1">(August 25, 1999 03:14)</font></i><dt><b><a href="http://www.purl.org/net/hobbs/tcl/script/widget/" ="">widget, simple megawidget package</a></b>
+<dd>
+ Author <b><a href="mailto:jeffrey.hobbs at oen.siemens.de" ="">Jeffrey Hobbs</a></b>, Version <b>0.9</b>,
+ Works with <b>Tcl/Tk 8.0 or higher</b>
+<br>Download: <a href="http://www.purl.org/net/hobbs/tcl/script/widget/widget-0.9.tar.gz">widget-0.9.tar.gz</a><br>This is a package of
+ megawidgets (i.e., compound widgets) that work almost exactly like Tk widgets.
+ You can also build your own new megawidgets.
+Includes: combobox, hierarchy, console, progressbar,
+tabnotebook, validating entry, pane geometry manager, baloon help. <a href="/live/annotate?url=http%3a%2f%2fwww%2epurl%2eorg%2fnet%2fhobbs%2ftcl%2fscript%2fwidget%2f">Edit</a>
+ <i><font size="-1">(August 23, 1999 12:16)</font></i></dl>
+<hr><p><center><font size="-1" face="Geneva, Helvetica, Arial"><br><a href="#TOP"><b>Top</b></a><br><!-- key ResourceSoftwareExtensions --><a href="/">Home</a>
+ | <a href="/products/">Products</a>
+ | <a href="/customers/">Customers</a>
+ | <a href="/partners/">Partners</a>
+ | <a href="/services/">Services</a>
+ | <a href="/resource/">Tcl Resources</a>
+ | <a href="/company/">Company</a>
+<br><a href="/live/keyword">Search</a>
+ | <a href="/live/map">Site Map</a>
+ | <a href="/company/feedback.html?url=%2fresource%2fsoftware%2fextensions%2ftk%2f">Feedback</a>
+ | <a href="/company/contact.html">Contact Us</a>
+ | <a href="mailto:info at scriptics.com">info at scriptics.com</a>
+
+ <SCRIPT LANGUAGE="Javascript">
+<!--
+ browser = (((navigator.appName == "Netscape") &&(parseInt(navigator.appVersion) >= 3 )) || ((navigator.appName =="Microsoft Internet Explorer") && (parseInt(navigator.appVersion) >= 4 )))
+
+ if ( browser )
+ {
+ over = new MakeImageArray(10)
+ over[0].src = "http://images.scriptics.com/images/ProductsMouseOff.gif"
+ over[1].src = "http://images.scriptics.com/images/CustomersMouseOff.gif"
+ over[2].src = "http://images.scriptics.com/images/PartnersMouseOff.gif"
+ over[3].src = "http://images.scriptics.com/images/ServicesMouseOff.gif"
+ over[4].src = "http://images.scriptics.com/images/ResourceMouseOff.gif"
+ over[5].src = "http://images.scriptics.com/images/CompanyMouseOff.gif"
+ over[6].src = "http://images.scriptics.com/images/homeMainRollover1.gif"
+ over[7].src = "http://images.scriptics.com/images/homeMainRollover2.gif"
+ over[8].src = "http://images.scriptics.com/images/homeMainRollover3.gif"
+ over[9].src = "http://images.scriptics.com/images/homeMainRollover3.gif"
+
+ }
+
+ function MakeImageArray(n) {
+ this.length = n
+ for (var i = 0; i<=n; i++)="i++)" {="{" this[i]="this[i]" ="" new="new" Image()="Image()" }="}" return="return" this="this" }="}" //="//" --="--">
+ </SCRIPT><br>
+ <font size="2">
+ © 1998-2000 Scriptics Corporation. All rights reserved.
+ <a href="/legal_notice.html">Legal Notice</a> | <A href="" /privacy.html="/privacy.html">
+ Privacy Statement</a>
+ </td></tr></table></td></tr></table>
+</Body>
+</Html>
\ No newline at end of file
diff --git a/tests/page3/image1 b/tests/page3/image1
new file mode 100644
index 0000000..814d1e8
Binary files /dev/null and b/tests/page3/image1 differ
diff --git a/tests/page3/image10 b/tests/page3/image10
new file mode 100644
index 0000000..45001fa
Binary files /dev/null and b/tests/page3/image10 differ
diff --git a/tests/page3/image11 b/tests/page3/image11
new file mode 100644
index 0000000..7c4c170
Binary files /dev/null and b/tests/page3/image11 differ
diff --git a/tests/page3/image12 b/tests/page3/image12
new file mode 100644
index 0000000..903e734
Binary files /dev/null and b/tests/page3/image12 differ
diff --git a/tests/page3/image13 b/tests/page3/image13
new file mode 100644
index 0000000..226d4f6
Binary files /dev/null and b/tests/page3/image13 differ
diff --git a/tests/page3/image14 b/tests/page3/image14
new file mode 100644
index 0000000..8e8c718
Binary files /dev/null and b/tests/page3/image14 differ
diff --git a/tests/page3/image2 b/tests/page3/image2
new file mode 100644
index 0000000..2ddeb32
Binary files /dev/null and b/tests/page3/image2 differ
diff --git a/tests/page3/image3 b/tests/page3/image3
new file mode 100644
index 0000000..1651ba7
Binary files /dev/null and b/tests/page3/image3 differ
diff --git a/tests/page3/image4 b/tests/page3/image4
new file mode 100644
index 0000000..b565c8d
Binary files /dev/null and b/tests/page3/image4 differ
diff --git a/tests/page3/image5 b/tests/page3/image5
new file mode 100644
index 0000000..e1268b8
Binary files /dev/null and b/tests/page3/image5 differ
diff --git a/tests/page3/image6 b/tests/page3/image6
new file mode 100644
index 0000000..1a6b260
Binary files /dev/null and b/tests/page3/image6 differ
diff --git a/tests/page3/image7 b/tests/page3/image7
new file mode 100644
index 0000000..cec7aa0
Binary files /dev/null and b/tests/page3/image7 differ
diff --git a/tests/page3/image8 b/tests/page3/image8
new file mode 100644
index 0000000..ad0d748
Binary files /dev/null and b/tests/page3/image8 differ
diff --git a/tests/page3/image9 b/tests/page3/image9
new file mode 100644
index 0000000..46ade30
Binary files /dev/null and b/tests/page3/image9 differ
diff --git a/tests/page3/index.html b/tests/page3/index.html
new file mode 100644
index 0000000..914d682
--- /dev/null
+++ b/tests/page3/index.html
@@ -0,0 +1,2787 @@
+<html><body bgcolor="white">
+<hr>
+<h1 align="center">Embedding Tcl in C/C++ Applications</h1>
+
+ <table width="100%">
+ <tr><td valign="top" align="left" width="46%">
+ <b>Presented At:</b>
+ <blockquote>
+ The Tcl2K Conference<br>
+ Austin, Texas<br>
+ <nobr>9:00am, February 15, 2000</nobr><br>
+ </blockquote>
+ </td>
+ <td width="5%"> </td>
+ <td valign="top" align="left" width="46%">
+ <b>Instructor:</b>
+ <blockquote>
+ D. Richard Hipp<br>
+ drh at hwaci.com<br>
+ http://www.hwaci.com/drh/<br>
+ 704.948.4565
+ </blockquote>
+ </td></tr>
+ </table><p>
+ <center><table border="2">
+ <tr><td>
+ <p align="center">
+ Copies of these notes, example source code,<br>and other
+ resources related to this tutorial<br>are available online at
+ <a href="http://www.hwaci.com/tcl2k/">
+ http://www.hwaci.com/tcl2k/</a></p>
+ <p align="center"><small>$Id: index.html,v 1.1.1.1 2002/01/27 17:44:00 cvs Exp $</small></p></td></tr>
+ </table>
+ </center>
+</p>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Tutorial Outline</h2>
+<p><ul><li>Introduction</li>
+<li>Building It Yourself</li>
+<ul><li>"Hello, World!" using Tcl</li>
+<li>Tcl scripts as C strings</li>
+<li>Adding new Tcl commands</li>
+<li>A tour of the Tcl API</li>
+<li>Tcl initialization scripts</li>
+<li>Adding Tk</li>
+</ul><li>Tools Survey</li>
+<li>Mktclapp</li>
+<ul><li>"Hello World" using mktclapp</li>
+<li>Adding C code</li>
+<li>Other Features</li>
+<li>Invoking Tcl from C</li>
+<li>Running mktclapp directly</li>
+<li>Real-world examples</li>
+</ul><li>Summary</li>
+</ul></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">Embedding Tcl in C/C++ Applications</h2>
+<p><ul><li>You know how to program in Tcl/Tk</li></ul><ul><li>You know how to program in C/C++</li></ul><ul><li>This tutorial is about how to do both at the same time.</li></ul></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">Why Mix C With Tcl/Tk?</h2>
+<p><ul><li>Use C for the things C is good at and Tcl for the things
+ Tcl is good at.</li></ul><ul><li>Generate standalone executables.
+ <ul><li>Eliminate the need to install Tcl/Tk.</li>
+ <li>Prevent problems when the wrong version of Tcl/Tk is installed.</li>
+ </ul></li></ul><ul><li>Prevent end users from changing the source code.
+ <ul><li>Keeps users from creating new bugs.</li>
+ <li>Protects proprietary code.</li>
+ </ul></li></ul><ul><li>Office politics</li></ul><ul><li>Use Tcl/Tk as a portability layer for a large C program</li></ul><ul><li>Use Tcl as a testing interface</li></ul></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">Why Mix C With Tcl/Tk?</h2>
+<p><blockquote><big><b>
+ "Use C for the things C is good at and use Tcl/Tk for the things
+ Tcl/Tk is good at."
+ </b></blockquote></p><p>
+
+ <table width="100%">
+ <tr><td valign="top" align="left" width="46%">
+ <b>C is good at:</b>
+ <ul>
+ <li>Speed</li>
+ <li>Complex data structures</li>
+ <li>Computation</li>
+ <li>Interacting with hardware</li>
+ <li>Byte-by-byte data analysis</li>
+ </ul>
+ </td>
+ <td width="5%"> </td>
+ <td valign="top" align="left" width="46%">
+ <b>Tcl/Tk is good at:</b>
+ <ul>
+ <li>Building a user interface</li>
+ <li>Manipulation of strings</li>
+ <li>Portability</li>
+ <li>Opening sockets</li>
+ <li>Handling events</li>
+ </ul>
+ </td></tr>
+ </table>
+<br clear="both"><p><hr></p>
+<h2 align="center">Programming Models</h2>
+<table width="100%">
+<tr><td valign="top" width="49%">
+
+ <p><b>Mainstream Tcl Programming Model:</b></p>
+</td>
+<td width="2%"> </td>
+<td valign="top" width="49%">
+
+ <p><b>Embedded Tcl Programming Model: </b></p>
+</td></tr>
+<tr><td valign="top" width="49%">
+
+ <ul><li>Add bits of C code to a large Tcl program</li></ul>
+</td>
+<td width="2%"> </td>
+<td valign="top" width="49%">
+
+ <ul><li>Add bits of Tcl code to a large C program</li></ul>
+</td></tr>
+<tr><td valign="top" width="49%">
+
+ <ul><li>Main Tcl script loads extensions written in C</li></ul>
+</td>
+<td width="2%"> </td>
+<td valign="top" width="49%">
+
+ <ul><li>Main C procedure invokes the Tcl interpreter</li></ul>
+</td></tr>
+<tr><td valign="top" width="49%">
+
+ <ul><li>Tcl/Tk is a programming language</li></ul>
+</td>
+<td width="2%"> </td>
+<td valign="top" width="49%">
+
+ <ul><li>Tcl/Tk is a C library</li></ul>
+</td></tr>
+<tr><td valign="top" width="49%">
+
+ <center><img src="image1"><br>
+ Most of the Tcl2K conference is about</center>
+</td>
+<td width="2%"> </td>
+<td valign="top" width="49%">
+
+ <center><img src="image1"><br>
+ This tutorial is about</center>
+</td></tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">"Hello, World!" Using The Tcl Library</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>#include <tcl.h></tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Always include <tcl.h></td>
+</tr>
+<tr><td valign="center">
+<small><tt>int main(int argc, char **argv){<br>
+ Tcl_Interp *interp;</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> interp = Tcl_CreateInterp();</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Create a new Tcl interpreter</td>
+</tr>
+<tr><td valign="center">
+<small><tt> Tcl_Eval(interp, "puts {Hello, World!}");</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Execute a Tcl command.</td>
+</tr>
+<tr><td valign="center">
+<small><tt> return 0;<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Compiling "Hello, World!"</h2>
+<p><p><b>Unix:</b></p>
+ <blockquote><tt>
+ $ gcc hello.c -ltcl -lm -ldl<br>
+ $ ./a.out<br>
+ Hello, World!</tt></blockquote>
+
+ <p><b>Windows using Cygwin:</b></p>
+ <blockquote><tt>
+ C:> gcc hello.c -ltcl80 -lm<br>
+ C:> a.exe<br>
+ Hello, World!</tt></blockquote>
+
+ <p><b>Windows using Mingw32:</b></p>
+ <blockquote><tt>
+ C:> gcc -mno-cygwin hello.c -ltcl82 -lm<br>
+ </tt></blockquote>
+<table><tr><td valign="top"><img src="image3"></td>
+<td valign="top"><b>Also works with VC++</b></td></tr></table></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">Where Does <tt>-ltcl</tt> Come From On Unix?</h2>
+<p><p>Build it yourself using these steps:</p></p><p>
+<p><ul><li>Get tcl8.2.2.tar.gz from Scriptics</li></ul><ul><li><tt>zcat tcl8.2.2.tar.gz | tar vx </tt></li></ul><ul><li><tt>cd tcl8.2.2/unix</tt></li></ul><ul><li><tt>./configure --disable-shared</tt></li></ul><ul><li><tt>make</tt></li></ul><ul><li>Move <b>libtcl8.2.a</b> to your lib directory.</li></ul><ul><li>Copy <b>../generic/tcl.h</b> into /usr/include.</li></ul></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">What Other Libraries Are Required For Unix?</h2>
+<p><ul><li>The sequence of <b>-l</b> options after <b>-ltcl</b>
+ varies from system to system</li></ul><ul><li>Observe what libraries the TCL makefile inserts when
+ it is building <b>tclsh</b></li></ul><ul><li>Examples in this talk are for RedHat Linux 6.0 for Intel</li></ul></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">How To Compile Under Unix Without Installing Tcl</h2>
+<p><p>Specify the *.a file directly:</p>
+ <blockquote><pre>
+ $ gcc -I../tcl8.2.2/generic hello.c \
+ ../tcl8.2.2/unix/libtcl8.2.a -lm -ldl
+ $ strip a.out
+ $ ./a.out
+ Hello, World!</pre></blockquote>
+
+ <p>Or, tell the C compiler where to look for *.a files:</p>
+ <blockquote><pre>
+ $ gcc -I../tcl8.2.2/generic hello.c \
+ -L../tcl8.2.2/unix -ltcl -lm -ldl
+ $ strip a.out
+ $ ./a.out
+ Hello, World!</pre></blockquote>
+<table><tr><td valign="top"><img src="image3"></td>
+<td valign="top"><b>The <tt>-I../tcl8.2.2</tt> argument
+ tells the compiler where to
+ find <tt><tcl.h></tt>.</p></b></td></tr></table></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">What's "Cygwin"?</h2>
+<p><ul><li>An implementation of GCC/G++ and all development tools
+ for Windows95/98/NT/2000</li></ul><ul><li>Available for free download at
+ <blockquote>
+ <tt>http://sourceware.cygnus.com/cygwin/</tt>
+ </blockquote></li></ul><ul><li>Also available shrink-wrapped at your local software retailer or
+ online at
+ <blockquote>
+ <tt>http://www.cygnus.com/cygwin/index.html</tt>
+ </blockquote></li></ul><ul><li>Programs compiled using Cygwin require a special
+ DLL (<b>cygwin1.dll</b>) that provides a POSIX system API</li></ul><ul><li>Cygwin1.dll cannot be shipped with proprietary programs
+ without purchasing a license from Cygnus.</li></ul><ul><li>Mingw32 is the same compiler as Cygwin, but generates
+ binaries that do not use cygwin1.dll</li></ul></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">Where Does <tt>-ltcl82</tt> Come From On Windows?</h2>
+<p><p>Build it like this:</p></p><p>
+<p><ul><li>Get <b>tcl82.lib</b> and <b>tcl82.dll</b> from Scriptics.</li></ul><ul><li><tt>echo EXPORTS >tcl82.def</tt></li></ul><ul><li><tt>nm tcl82.lib | grep 'T _' | sed 's/.* T _//' >>tcl82.def</tt></li></ul><ul><li><tt>dlltool --def tcl82.def --dllname tcl82.dll --output-lib libtcl82.a</tt></li></ul><ul><li>Move <b>libtcl82.a</b> to the lib directory and <b>tcl82.dll</b>
+ to the bin directory.</li></ul></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">Where Does Your Code Go?</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>#include <tcl.h><br>
+ <br>
+int main(int argc, char **argv){<br>
+ Tcl_Interp *interp;<br>
+ interp = Tcl_CreateInterp();</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> /* Your application code goes here */</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Insert C code here to do whatever it is your program is
+ suppose to do</td>
+</tr>
+<tr><td valign="center">
+<small><tt> return 0;<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Building A Simple TCLSH</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>#include <tcl.h><br>
+ <br>
+int main(int argc, char **argv){<br>
+ Tcl_Interp *interp;<br>
+ char *z;<br>
+ char zLine[2000];<br>
+ interp = Tcl_CreateInterp();</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> while( fgets(zLine,sizeof(zLine),stdin) ){</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Get one line of input</td>
+</tr>
+<tr><td valign="center">
+<small><tt> Tcl_Eval(interp, zLine);</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Execute the input as Tcl.</td>
+</tr>
+<tr><td valign="center">
+<small><tt> z = Tcl_GetStringResult(interp);<br>
+ if( z[0] ){<br>
+ printf("¸üÿ¿PX¶\n", z);<br>
+ }</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Print result if not empty</td>
+</tr>
+<tr><td valign="center">
+<small><tt> }<br>
+ return 0;<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+<p><table><tr><td valign="top"><img src="image3"></td>
+<td valign="top"><b>What if user types more than 2000 characters?</b></td></tr></table>
+</p>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Building A Simple TCLSH</h2>
+<p>Use TCL to handle input. Allows input lines of unlimited length.</p><p>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>#include <tcl.h><br>
+ <br>
+/* Tcl code to implement the<br>
+** input loop */<br>
+static char zLoop[] = <br>
+ "while {![eof stdin]} {\n"</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> " set line [gets stdin]\n"</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Get one line of input</td>
+</tr>
+<tr><td valign="center">
+<small><tt> " set result [eval $line]\n"</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Execute input as Tcl</td>
+</tr>
+<tr><td valign="center">
+<small><tt> " if {$result!=\"\"} {puts $result}\n"</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Print result</td>
+</tr>
+<tr><td valign="center">
+<small><tt> "}\n"<br>
+;<br>
+ <br>
+<br>
+int main(int argc, char **argv){<br>
+ Tcl_Interp *interp;<br>
+ interp = Tcl_CreateInterp();</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> Tcl_Eval(interp, zLoop);</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Run the Tcl input loop</td>
+</tr>
+<tr><td valign="center">
+<small><tt> return 0;<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+<p><table><tr><td valign="top"><img src="image3"></td>
+<td valign="top"><b>But what about commands that span multiple lines of input?</b></td></tr></table>
+</p>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Better Handling Of Command-Line Input</h2>
+<p>The file "input.tcl"</p><p>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>set line {}<br>
+while {![eof stdin]} {</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> if {$line!=""} {<br>
+ puts -nonewline "> "<br>
+ } else {<br>
+ puts -nonewline "% "<br>
+ }<br>
+ flush stdout</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Prompt for user input. The prompt is normally "%"
+ but changes to ">" if the current line is a continuation.</td>
+</tr>
+<tr><td valign="center">
+<small><tt> append line [gets stdin]<br>
+ if {[info complete $line]} {</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> if {[catch {uplevel #0 $line} result]} {</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">If the command is complete, execute it.</td>
+</tr>
+<tr><td valign="center">
+<small><tt> puts stderr "Error: $result"<br>
+ } elseif {$result!=""} {<br>
+ puts $result<br>
+ }<br>
+ set line {}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> } else {<br>
+ append line \n<br>
+ }</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">If the command is incomplete, append a newline and get
+ another line of text.</td>
+</tr>
+<tr><td valign="center">
+<small><tt>}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Better Handling Of Command-Line Input</h2>
+<p>The file "input.c"</p><p>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>#include <tcl.h><br>
+ <br>
+int main(int argc, char **argv){<br>
+ Tcl_Interp *interp;<br>
+ interp = Tcl_CreateInterp();</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> Tcl_Eval(interp, "source input.tcl");</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Read and execute the input loop</td>
+</tr>
+<tr><td valign="center">
+<small><tt> return 0;<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+<p><table><tr><td valign="top"><img src="image3"></td>
+<td valign="top"><b>But now the program is not standalone!</b></td></tr></table>
+</p>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Converting Scripts Into C Strings</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>static char zInputLoop[] = <br>
+ "set line {}\n"<br>
+ "while {![eof stdin]} {\n"<br>
+ " if {$line!=\"\"} {\n"<br>
+ " puts -nonewline \"> \"\n"<br>
+ " } else {\n"<br>
+ " puts -nonewline \"% \"\n"<br>
+ " }\n"<br>
+ " flush stdout\n"<br>
+ " append line [gets stdin]\n"<br>
+ " if {[info complete $line]} {\n"<br>
+ " if {[catch {uplevel #0 $line} result]} {\n"<br>
+ " puts stderr \"Error: $result\"\n"<br>
+ " } elseif {$result!=\"\"} {\n"<br>
+ " puts $result\n"<br>
+ " }\n"<br>
+ " set line {}\n"<br>
+ " } else {\n"<br>
+ " append line \\n\n"<br>
+ " }\n"<br>
+ "}\n"<br>
+;</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Compile Tcl Scripts Into C Programs</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>#include <tcl.h><br>
+</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt><br>
+static char zInputLoop[] = <br>
+ /* Actual code omitted */<br>
+;</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Copy and paste the converted Tcl script here</td>
+</tr>
+<tr><td valign="center">
+<small><tt><br>
+int main(int argc, char **argv){<br>
+ Tcl_Interp *interp;<br>
+ interp = Tcl_CreateInterp();</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> Tcl_Eval(interp, zInputLoop);</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Execute the Tcl code</td>
+</tr>
+<tr><td valign="center">
+<small><tt> return 0;<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Converting Scripts To Strings<br>Using SED Or TCLSH</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>sed -e 's/\\/\\\\/g' \ </tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Convert <b>\</b> into <b>\\</b></td>
+</tr>
+<tr><td valign="center">
+<small><tt> -e 's/"/\\"/g' \ </tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Convert <b>"</b> into <b>\"</b></td>
+</tr>
+<tr><td valign="center">
+<small><tt> -e 's/^/ "/' \ </tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Add <b>"</b> to start of each line</td>
+</tr>
+<tr><td valign="center">
+<small><tt> -e 's/$/\\n"/' input.tcl</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Add <b>\n"</b> to end of each line</td>
+</tr>
+<tr><td valign="center">
+<small><tt><br>
+ <br>
+<br>
+ <br>
+<br>
+while {![eof stdin]} {<br>
+ set line [gets stdin]</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> regsub -all {\} $line {&&} line</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Convert <b>\</b> into <b>\\</b></td>
+</tr>
+<tr><td valign="center">
+<small><tt> regsub -all {"} $line {\"} line</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Convert <b>"</b> into <b>\"</b></td>
+</tr>
+<tr><td valign="center">
+<small><tt> puts "\"$line\\n\""</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Add <b>"</b> in front and <b>\n"</b> at the end</td>
+</tr>
+<tr><td valign="center">
+<small><tt>}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Converting Scripts Into C Strings</h2>
+<p>You may want to save space by removing comments and extra whitespace
+ from scripts.</p><p>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>static char zInputLoop[] = <br>
+ "set line {}\n"<br>
+ "while {![eof stdin]} {\n"<br>
+ "if {$line!=\"\"} {\n"<br>
+ "puts -nonewline \"> \"\n"<br>
+ "} else {\n"<br>
+ "puts -nonewline \"% \"\n"<br>
+ "}\n"<br>
+ "flush stdout\n"<br>
+ "append line [gets stdin]\n"<br>
+ "if {[info complete $line]} {\n"<br>
+ "if {[catch {uplevel #0 $line} result]} {\n"<br>
+ "puts stderr \"Error: $result\"\n"<br>
+ "} elseif {$result!=\"\"} {\n"<br>
+ "puts $result\n"<br>
+ "}\n"<br>
+ "set line {}\n"<br>
+ "} else {\n"<br>
+ "append line \\n\n"<br>
+ "}\n"<br>
+ "}\n"<br>
+;</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Converting Scripts To Strings</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>sed -e 's/\\/\\\\/g' \ <br>
+ -e 's/"/\\"/g' \ </tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> -e '/^ *#/d' \ </tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Delete lines that begin with #</td>
+</tr>
+<tr><td valign="center">
+<small><tt> -e '/^ *$/d' \ </tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Delete blank lines</td>
+</tr>
+<tr><td valign="center">
+<small><tt> -e 's/^ */ "/' \ </tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Delete leading spaces</td>
+</tr>
+<tr><td valign="center">
+<small><tt> -e 's/$/\\n"/' input.tcl<br>
+ <br>
+<br>
+ <br>
+<br>
+ <br>
+while {![eof stdin]} {<br>
+ set line [gets stdin]</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> set line [string trimleft $line]</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Remove leading space</td>
+</tr>
+<tr><td valign="center">
+<small><tt> if {$line==""} continue</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Delete blank lines</td>
+</tr>
+<tr><td valign="center">
+<small><tt> if {[string index $line 0]=="#"} {<br>
+ continue<br>
+ }</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Delete lines starting with #</td>
+</tr>
+<tr><td valign="center">
+<small><tt> regsub -all {\} $line {&&} line<br>
+ regsub -all {"} $line {\"} line<br>
+ puts "\"$line\\n\""<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Removing Comments Or Leading Space<br>Will Break Some Tcl Scripts!</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>image create bitmap smiley -data {</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt>#define smile_width 15<br>
+#define smile_height 15</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">These lines begin with # but are not comment</td>
+</tr>
+<tr><td valign="center">
+<small><tt>static unsigned char smile_bits[] = {<br>
+ 0xc0, 0x01, 0x30, 0x06, 0x0c, 0x18,<br>
+ 0x04, 0x10, 0x22, 0x22, 0x52, 0x25,<br>
+ 0x01, 0x40, 0x01, 0x40, 0x01, 0x40,<br>
+ 0x12, 0x24, 0xe2, 0x23, 0x04, 0x10,<br>
+ 0x0c, 0x18, 0x30, 0x06, 0xc0, 0x01};<br>
+}<br>
+ <br>
+<br>
+ <br>
+text .t<br>
+pack .t<br>
+.t insert end [string trim {</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt>She walks in beauty, like the night<br>
+ Of cloudless climes and starry skies;<br>
+And all that's best of dark and bright<br>
+ Meet in her aspect and her eyes;</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Indentation is deleted on lines 2
+ and 4</td>
+</tr>
+<tr><td valign="center">
+<small><tt>}] <br>
+ <br>
+</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+<p><table><tr><td valign="top"><img src="image3"></td>
+<td valign="top"><b>Problems like these are rare</b></td></tr></table>
+</p>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Adding A "continue" Command</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>set line {}<br>
+while {![eof stdin]} {<br>
+ if {$line!=""} {<br>
+ puts -nonewline "> "<br>
+ } else {<br>
+ puts -nonewline "% "<br>
+ }<br>
+ flush stdout<br>
+ append line [gets stdin]<br>
+ if {[info complete $line]} {</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> if {[lindex $line 0]=="continue"} {<br>
+ break;</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Break out of the loop if the command
+ is "continue"</td>
+</tr>
+<tr><td valign="center">
+<small><tt> } elseif {[catch {uplevel #0 $line} result]} {<br>
+ puts stderr "Error: $result"<br>
+ } elseif {$result!=""} {<br>
+ puts $result<br>
+ }<br>
+ set line {}<br>
+ } else {<br>
+ append line \n<br>
+ }<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Stop For Tcl Input At Various Points<br>In A C Program</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>#include <tcl.h><br>
+ <br>
+static char zInputLoop[] = <br>
+ /* Tcl Input loop as a C string */<br>
+;<br>
+ <br>
+int main(int argc, char **argv){<br>
+ Tcl_Interp *interp;<br>
+ interp = Tcl_CreateInterp();</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> /* Application C code */</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Do some computation</td>
+</tr>
+<tr><td valign="center">
+<small><tt> Tcl_Eval(interp, zInputLoop);</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Stop for some Tcl input</td>
+</tr>
+<tr><td valign="center">
+<small><tt> /* More application C code */</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Do more computation</td>
+</tr>
+<tr><td valign="center">
+<small><tt> Tcl_Eval(interp, zInputLoop);</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Stop for more Tcl input</td>
+</tr>
+<tr><td valign="center">
+<small><tt> /* Finish up the application */</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Finish the computation</td>
+</tr>
+<tr><td valign="center">
+<small><tt> return 0;<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Using Tcl For Testing</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>#include <tcl.h><br>
+ <br>
+static char zInputLoop[] = <br>
+ /* Tcl Input loop as a C string */<br>
+;<br>
+ <br>
+</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt>int main(int argc, char **argv){<br>
+#ifdef TESTING<br>
+ Tcl_Interp *interp;</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Create interpreter only if TESTING
+ is defined</td>
+</tr>
+<tr><td valign="center">
+<small><tt> interp = Tcl_CreateInterp();<br>
+#endif<br>
+ /* Application C code */</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt>#ifdef TESTING<br>
+ Tcl_Eval(interp, zInputLoop);<br>
+#endif</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Accept command-line input only if TESTING
+ is defined</td>
+</tr>
+<tr><td valign="center">
+<small><tt> /* More application C code */<br>
+#ifdef TESTING<br>
+ Tcl_Eval(interp, zInputLoop);<br>
+#endif<br>
+ /* Finish up the application */<br>
+ return 0;<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Creating A New Tcl Command In C</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>#include <tcl.h><br>
+ <br>
+int NewCmd(</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> void *clientData,<br>
+ Tcl_Interp *interp,<br>
+ int argc,<br>
+ char **argv</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">The Tcl command is implemented as
+ a C function with four arguments.</td>
+</tr>
+<tr><td valign="center">
+<small><tt>){<br>
+ printf("Hello, World!\n");</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> return TCL_OK;</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Returns TCL_OK or TCL_ERROR</td>
+</tr>
+<tr><td valign="center">
+<small><tt>}<br>
+ <br>
+static char zInputLoop[] = <br>
+ /* Tcl code omitted... */<br>
+;<br>
+ <br>
+int main(int argc, char **argv){<br>
+ Tcl_Interp *interp;<br>
+ interp = Tcl_CreateInterp();</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> Tcl_CreateCommand(interp, "helloworld",<br>
+ NewCmd, 0, 0);</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Tell the interpreter which C function to call when the
+ "helloworld" Tcl command is executed</td>
+</tr>
+<tr><td valign="center">
+<small><tt> Tcl_Eval(interp, zInputLoop);<br>
+ return 0;<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Linkage From Tcl To C</h2>
+<p><p align="center"><img src="image4"></p></p><p><ul><li>3rd parameter of Tcl_CreateCommand() is a pointer to the C subroutine
+ that implements the command.</li></ul><ul><li>4th parameter to Tcl_CreateCommand() becomes the 1st parameter to
+ the C routine whenever the Tcl command is executed.</li></ul><ul><li>1st parameter to Tcl_CreateCommand() must be a valid Tcl interpreter.
+ The same pointer appears as the second parameter to the C routine
+ whenever the Tcl command is executed.</li></ul></p>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Linkage From Tcl To C</h2>
+<p><p align="center"><img src="image5"></p></p><p><ul><li>5th parameter of Tcl_CreateCommand() is a pointer to the C subroutine
+ that is called when the Tcl command is deleted.</li></ul><ul><li>4th parameter to Tcl_CreateCommand() becomes the 1st parameter to
+ the C routine.</li></ul></p>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">When To Use A Delete Proc</h2>
+<p>Examples of where the delete proc is used in standard Tcl/Tk:</p><p>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>button .b -text Hello<br>
+pack .b</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt>rename .b {}</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Deleting the <b>.b</b> command causes the button to be destroyed</td>
+</tr>
+<tr><td valign="center">
+<small><tt><br>
+ <br>
+</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt>image create photo smiley \ <br>
+ -file smiley.gif</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt>rename smiley {}</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Deleting the <b>smiley</b> command destroys the image and reclaims the
+ memory used to hold the image</td>
+</tr>
+</table>
+<p><ul><li>Always use a delete proc if the clientData is a pointer to
+ malloced memory or some other resource that needs freeing</li></ul><ul><li>Delete procs are never used in the Tcl core but are used
+ extensively in Tk</li></ul></p>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Linkage From Tcl To C</h2>
+<p>The <tt>argc</tt> and <tt>argv</tt> parameters work just like in
+ <tt>main()</tt></p><p>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>helloworld one {two three} four</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center"><tt>argc = 4<br>
+ argv[0] = "helloworld"<br>
+ argv[1] = "one"<br>
+ argv[2] = "two three"<br>
+ argv[3] = "four"<br>
+ argv[4] = NULL</tt></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">A Short-Cut</h2>
+<p>In a program with many new Tcl commands implemented in C, it becomes
+ tedious to type the same four parameters over and over again. So
+ we define a short-cut.</p><p>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>#define TCLARGS \ <br>
+ void *clientData, \ <br>
+ Tcl_Interp *interp, \ <br>
+ int argc, \ <br>
+ char *argv</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Define TCLARGS once in a header file</td>
+</tr>
+<tr><td valign="center">
+<small><tt> <br>
+ <br>
+ </tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt>int NewCmd(TCLARGS){</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Use the TCLARGS macro to define new C functions
+ that implement Tcl commands.</td>
+</tr>
+<tr><td valign="center">
+<small><tt> /* implementation... */<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+<p><table><tr><td valign="top"><img src="image3"></td>
+<td valign="top"><b>For brevity, we will use the TCLARGS macro during the
+ rest of this talk.</b></td></tr></table>
+</p>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Returning A Value From C Back To Tcl</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>int NewCmd(TCLARGS){</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Note that the C function returns an "int"</td>
+</tr>
+<tr><td valign="center">
+<small><tt> return TCL_OK;</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Return value is TCL_OK or TCL_ERROR</td>
+</tr>
+<tr><td valign="center">
+<small><tt>}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+<p><ul><li>TCL_OK and TCL_ERROR are defined in <tcl.h></li></ul><ul><li>Other valid return values TCL_RETURN, TCL_BREAK and TCL_CONTINUE
+ are rarely used</li></ul><ul><li>Common mistake: forgetting to return TCL_OK</li></ul></p>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Returning A Value From C Back To Tcl</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>int NewCmd(TCLARGS){</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> Tcl_SetResult(interp,"Hello!",TCL_STATIC);</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Set the result to "Hello!"</td>
+</tr>
+<tr><td valign="center">
+<small><tt> return TCL_OK;<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+<p><ul><li>Result should be the text of an error message if you
+ return TCL_ERROR.</li></ul><ul><li>3rd argument to Tcl_SetResult() can be TCL_STATIC,
+ TCL_DYNAMIC, TCL_VOLATILE, or a function pointer.</li></ul><ul><li>Also consider using Tcl_AppendResult().</li></ul><ul><li>Direct access to <tt>interp->result</tt> is deprecated.</li></ul><ul><li>See the man pages for details.</li></ul></p>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">The Tcl_Obj Interface</h2>
+<p><ul><li>A new way to write Tcl commands in C code</li></ul><ul><li>First introduced in Tcl8.0</li></ul><ul><li>Can be much faster, especially for lists or numeric values.</li></ul><ul><li>Able to handle arbitrary binary data.</li></ul><ul><li>More difficult to program.</li></ul></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">The Tcl_Obj Interface</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>int NewObjCmd(<br>
+ void *clientData,<br>
+ Tcl_Interp *interp,<br>
+ int objc,</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> Tcl_Obj *const* objv</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">4th parameter is an array Tcl_Objs, not an array of strings</td>
+</tr>
+<tr><td valign="center">
+<small><tt>){<br>
+ /* Implementation... */<br>
+ return TCL_OK;<br>
+}<br>
+ <br>
+static char zInputLoop[] = <br>
+ /* Tcl code omitted... */<br>
+;<br>
+ <br>
+int main(int argc, char **argv){<br>
+ Tcl_Interp *interp;<br>
+ interp = Tcl_CreateInterp();</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> Tcl_CreateObjCommand(interp, "newcmd",<br>
+ NewObjCmd, 0, 0);</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Use a different function to register the command</td>
+</tr>
+<tr><td valign="center">
+<small><tt> Tcl_Eval(interp, zInputLoop);<br>
+ return 0;<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">The Tcl_Obj Interface</h2>
+<p><ul><li>There are countless access methods for reading information from and
+ placing information in Tcl_Objs. Always use the access methods.</li></ul><ul><li>Details provided at Lee Bernhard's talk this afternoon.</li></ul><ul><li>Definitely use Tcl_Objs if you are writing a new Tcl extension.</li></ul><ul><li>Tcl_Objs address some of the weaknesses of Tcl relative to C/C++.
+ <ul>
+ <li> Tcl_Objs are faster </li>
+ <li> Tcl_Objs work with binary data </li>
+ </ul>
+ But C/C++ is faster still and better for working with binary data.</li></ul><ul><li>When mixing C/C++ with Tcl/Tk the benefits of Tcl_Objs are
+ less important. Using Tcl_Objs in this context may not be
+ worth the extra trouble.</li></ul><ul><li>This talk will focus on the string interface.</li></ul></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">Nickel Tour Of The Tcl API</h2>
+<p><p><b>Memory allocation functions</b></p>
+<center><table width="90%"><tr>
+<td width="32%" valign="top"><small><tt>
+ Tcl_Alloc<br>
+</tt></small></td>
+<td width="32%" valign="top"><small><tt>
+ Tcl_Free<br>
+</tt></small></td>
+<td width="32%" valign="top"><small><tt>
+ Tcl_Realloc<br>
+</tt></small></td>
+</table></center><p><b>Functions useful in the implementation of new Tcl commands</b></p>
+<center><table width="90%"><tr>
+<td width="32%" valign="top"><small><tt>
+ Tcl_AppendElement<br>
+ Tcl_AppendResult<br>
+ Tcl_GetBoolean<br>
+</tt></small></td>
+<td width="32%" valign="top"><small><tt>
+ Tcl_GetDouble<br>
+ Tcl_GetInt<br>
+ Tcl_GetStringResult<br>
+</tt></small></td>
+<td width="32%" valign="top"><small><tt>
+ Tcl_ResetResult<br>
+ Tcl_SetResult<br>
+</tt></small></td>
+</table></center><p><b>Functions for controlling the Tcl interpreter</b></p>
+<center><table width="90%"><tr>
+<td width="32%" valign="top"><small><tt>
+ Tcl_CreateCommand<br>
+ Tcl_CreateInterp<br>
+</tt></small></td>
+<td width="32%" valign="top"><small><tt>
+ Tcl_CreateObjCommand<br>
+ Tcl_DeleteCommand<br>
+</tt></small></td>
+<td width="32%" valign="top"><small><tt>
+ Tcl_DeleteInterp<br>
+ Tcl_Exit<br>
+</tt></small></td>
+</table></center></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">Nickel Tour Of The Tcl API</h2>
+<p><p><b>I/O functions</b></p>
+<center><table width="90%"><tr>
+<td width="32%" valign="top"><small><tt>
+ Tcl_Close<br>
+ Tcl_Eof<br>
+ Tcl_Flush<br>
+ Tcl_GetChannel<br>
+ Tcl_GetChannelMode<br>
+ Tcl_GetChannelName<br>
+</tt></small></td>
+<td width="32%" valign="top"><small><tt>
+ Tcl_Gets<br>
+ Tcl_OpenCommandChannel<br>
+ Tcl_OpenFileChannel<br>
+ Tcl_OpenTcpClient<br>
+ Tcl_OpenTcpServer<br>
+ Tcl_Read<br>
+</tt></small></td>
+<td width="32%" valign="top"><small><tt>
+ Tcl_Seek<br>
+ Tcl_Tell<br>
+ Tcl_Ungets<br>
+ Tcl_Write<br>
+ Tcl_WriteChars<br>
+</tt></small></td>
+</table></center><p><b>Names and meanings of system error codes</b></p>
+<center><table width="90%"><tr>
+<td width="32%" valign="top"><small><tt>
+ Tcl_ErrnoId<br>
+ Tcl_ErrnoMsg<br>
+</tt></small></td>
+<td width="32%" valign="top"><small><tt>
+ Tcl_GetErrno<br>
+ Tcl_SetErrno<br>
+</tt></small></td>
+<td width="32%" valign="top"><small><tt>
+ Tcl_SignalId<br>
+ Tcl_SignalMsg<br>
+</tt></small></td>
+</table></center></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">Nickel Tour Of The Tcl API</h2>
+<p><p><b>General Operating System Calls</b></p>
+<center><table width="90%"><tr>
+<td width="32%" valign="top"><small><tt>
+ Tcl_Access<br>
+ Tcl_Chdir<br>
+ Tcl_GetCwd<br>
+</tt></small></td>
+<td width="32%" valign="top"><small><tt>
+ Tcl_GetHostName<br>
+ Tcl_GetNameOfExecutable<br>
+ Tcl_Sleep<br>
+</tt></small></td>
+<td width="32%" valign="top"><small><tt>
+ Tcl_Stat<br>
+</tt></small></td>
+</table></center><p><b>String Manipulation And Comparison</b></p>
+<center><table width="90%"><tr>
+<td width="32%" valign="top"><small><tt>
+ Tcl_Concat<br>
+ Tcl_Merge<br>
+</tt></small></td>
+<td width="32%" valign="top"><small><tt>
+ Tcl_SplitList<br>
+ Tcl_StringCaseMatch<br>
+</tt></small></td>
+<td width="32%" valign="top"><small><tt>
+ Tcl_StringMatch<br>
+</tt></small></td>
+</table></center><p><b>Dynamically Resizable Strings</b></p>
+<center><table width="90%"><tr>
+<td width="49%" valign="top"><small><tt>
+ Tcl_DStringAppend<br>
+ Tcl_DStringAppendElement<br>
+ Tcl_DStringEndSublist<br>
+ Tcl_DStringInit<br>
+ Tcl_DStringLength<br>
+</tt></small></td>
+<td width="49%" valign="top"><small><tt>
+ Tcl_DStringResult<br>
+ Tcl_DStringSetLength<br>
+ Tcl_DStringStartSublist<br>
+ Tcl_DStringValue<br>
+</tt></small></td>
+</table></center></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">Nickel Tour Of The Tcl API</h2>
+<p><p><b>Event Handlers</b></p>
+<center><table width="90%"><tr>
+<td width="49%" valign="top"><small><tt>
+ Tcl_CancelIdleCall<br>
+ Tcl_CreateChannelHandler<br>
+ Tcl_CreateTimerHandler<br>
+ Tcl_DeleteChannelHandler<br>
+</tt></small></td>
+<td width="49%" valign="top"><small><tt>
+ Tcl_DeleteTimerHandler<br>
+ Tcl_DoOneEvent<br>
+ Tcl_DoWhenIdle<br>
+</tt></small></td>
+</table></center><p><b>Functions For Reading And Writing Tcl Variables</b></p>
+<center><table width="90%"><tr>
+<td width="32%" valign="top"><small><tt>
+ Tcl_GetVar<br>
+ Tcl_GetVar2<br>
+ Tcl_LinkVar<br>
+ Tcl_SetVar<br>
+ Tcl_SetVar2<br>
+</tt></small></td>
+<td width="32%" valign="top"><small><tt>
+ Tcl_TraceVar<br>
+ Tcl_TraceVar2<br>
+ Tcl_UnlinkVar<br>
+ Tcl_UnsetVar<br>
+ Tcl_UnsetVar2<br>
+</tt></small></td>
+<td width="32%" valign="top"><small><tt>
+ Tcl_UntraceVar<br>
+ Tcl_UntraceVar2<br>
+ Tcl_UpdateLinkedVar<br>
+</tt></small></td>
+</table></center><p><b>Functions For Executing Tcl Code</b></p>
+<center><table width="90%"><tr>
+<td width="32%" valign="top"><small><tt>
+ Tcl_Eval<br>
+ Tcl_EvalFile<br>
+</tt></small></td>
+<td width="32%" valign="top"><small><tt>
+ Tcl_EvalObj<br>
+ Tcl_GlobalEval<br>
+</tt></small></td>
+<td width="32%" valign="top"><small><tt>
+ Tcl_GlobalEvalObj<br>
+ Tcl_VarEval<br>
+</tt></small></td>
+</table></center></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">Nickel Tour Of The Tcl API</h2>
+<p><p><b>Functions For Dealing With Unicode</b></p>
+<center><table width="90%"><tr>
+<td width="49%" valign="top"><small><tt>
+ Tcl_NumUtfChars<br>
+ Tcl_UniCharAtIndex<br>
+ Tcl_UniCharIsAlnum<br>
+ Tcl_UniCharIsAlpha<br>
+ Tcl_UniCharIsControl<br>
+ Tcl_UniCharIsDigit<br>
+ Tcl_UniCharIsGraph<br>
+ Tcl_UniCharIsLower<br>
+ Tcl_UniCharIsPrint<br>
+ Tcl_UniCharIsPunct<br>
+ Tcl_UniCharIsSpace<br>
+ Tcl_UniCharIsUpper<br>
+ Tcl_UniCharIsWordChar<br>
+ Tcl_UniCharLen<br>
+ Tcl_UniCharNcmp<br>
+ Tcl_UniCharToLower<br>
+ Tcl_UniCharToTitle<br>
+</tt></small></td>
+<td width="49%" valign="top"><small><tt>
+ Tcl_UniCharToUpper<br>
+ Tcl_UniCharToUtf<br>
+ Tcl_UniCharToUtfDString<br>
+ Tcl_UtfAtIndex<br>
+ Tcl_UtfBackslash<br>
+ Tcl_UtfCharComplete<br>
+ Tcl_UtfFindFirst<br>
+ Tcl_UtfFindLast<br>
+ Tcl_UtfNcasecmp<br>
+ Tcl_UtfNcmp<br>
+ Tcl_UtfNext<br>
+ Tcl_UtfPrev<br>
+ Tcl_UtfToLower<br>
+ Tcl_UtfToTitle<br>
+ Tcl_UtfToUniChar<br>
+ Tcl_UtfToUniCharDString<br>
+ Tcl_UtfToUpper<br>
+</tt></small></td>
+</table></center>
+ <p><b>Functions For Dealing With Tcl_Objs</b></p>
+ <blockquote><i>Too numerous to list...</i></blockquote></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">Documentation Of The Tcl API</h2>
+<p><ul><li>Tcl comes with excellent man pages</li></ul><ul><li>"Use the source, Luke"</li></ul><ul><li>See <tt>tclDecl.h</tt> for a list of API functions</li></ul><ul><li>The header comments on the implementation of API functions usually
+ gives a good description of what the function does and how it should
+ be used.</li></ul><ul><li>Most API functions are used within Tcl and Tk. Use grep to locate
+ examples.</li></ul></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">Initialization Scripts</h2>
+<p><ul><li>Run the mini TCLSH implemented above and execute the <tt>parray</tt> command</li></ul><ul><li>It doesn't work! What's wrong? </p></li></li></ul><ul><li><tt>parray</tt> is really a Tcl proc that is read in when the
+ interpreter is initialized. </p></li></li></ul><ul><li><tt>parray</tt> (and several other commands) are stored in a
+ handful of "Initialization Scripts" </p></li></li></ul><ul><li>All the initialization scripts are stored in the
+ "Tcl Library" - a directory on the host
+ computer. </p></li></li></ul><table><tr><td valign="top"><img src="image3"></td>
+<td valign="top"><b>Invoke the Tcl_Init() function to locate and read the
+ Tcl initialization scripts.</b></td></tr></table></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">The <tt>Tcl_Init()</tt> Function</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>#include <tcl.h><br>
+ <br>
+static char zInputLoop[] = <br>
+ /* Tcl code omitted... */<br>
+;<br>
+ <br>
+int main(int argc, char **argv){<br>
+ Tcl_Interp *interp;<br>
+ interp = Tcl_CreateInterp();</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> Tcl_Init(interp);</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Locate and read the initialization scripts</td>
+</tr>
+<tr><td valign="center">
+<small><tt> /* Call Tcl_CreateCommand()? */<br>
+ Tcl_Eval(interp, zInputLoop);<br>
+ return 0;<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+<p><table><tr><td valign="top"><img src="image3"></td>
+<td valign="top"><b>But Tcl_Init() can fail. We need to check its return value...</b></td></tr></table>
+</p>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">The <tt>Tcl_Init()</tt> Function</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>#include <tcl.h><br>
+ <br>
+static char zInputLoop[] = <br>
+ /* Tcl code omitted... */<br>
+;<br>
+ <br>
+int main(int argc, char **argv){<br>
+ Tcl_Interp *interp;<br>
+ interp = Tcl_CreateInterp();</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> if( Tcl_Init(interp)!=TCL_OK ){<br>
+ fprintf(stderr,"Tcl_Init() failed: ¸üÿ¿PX¶",<br>
+ Tcl_GetStringResult(interp));<br>
+ }</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Print error message if Tcl_Init() fails</td>
+</tr>
+<tr><td valign="center">
+<small><tt> /* Call Tcl_CreateCommand()? */<br>
+ Tcl_Eval(interp, zInputLoop);<br>
+ return 0;<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+<p><table><tr><td valign="top"><img src="image3"></td>
+<td valign="top"><b>But now the program is not standalone.</b></td></tr></table>
+</p>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">How <tt>Tcl_Init()</tt> Works</h2>
+<p><ul><li>Computes the value of variable <tt>tcl_libPath</tt>.</li></ul><ul><li>Invokes the procedure named "<tt>tclInit</tt>"</li></ul><ul><li>A default <tt>tclInit</tt> procedure is built into Tcl.
+ You can define an alternative <tt>tclInit</tt> procedure
+ prior to calling <tt>Tcl_Init()</tt>.</li></ul></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">The Default <tt>initTcl</tt> Procedure</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>set errors {}<br>
+set dirs {}<br>
+if {[info exists tcl_library]} {<br>
+ lappend dirs $tcl_library<br>
+} else {<br>
+ if {[info exists env(TCL_LIBRARY)]} {<br>
+ lappend dirs $env(TCL_LIBRARY)<br>
+ }<br>
+ lappend dirs $tclDefaultLibrary<br>
+ unset tclDefaultLibrary<br>
+ set dirs [concat $dirs $tcl_libPath]<br>
+}<br>
+foreach i $dirs {<br>
+ set tcl_library $i<br>
+ set tclfile [file join $i init.tcl]<br>
+ if {[file exists $tclfile]} {<br>
+ if {![catch {uplevel #0 [list source $tclfile]} msg]} {<br>
+ return<br>
+ } else {<br>
+ append errors "$tclfile: $msg\n$errorInfo\n"<br>
+ }<br>
+ }<br>
+}<br>
+error "Can't find a usable init.tcl ..."</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">The Default Initialization Sequence</h2>
+<p><ul><li>The <tt>tclInit</tt> procedure locates and sources the <tt>init.tcl</tt>
+ script. The directory that contains <tt>init.tcl</tt> is stored in
+ the <tt>tcl_library</tt> variable.</li></ul><ul><li>The <tt>init.tcl</tt> script creates an <tt>unknown</tt> procedure.
+ The <tt>unknown</tt> procedure will run whenever Tcl encounters an
+ unknown command.</li></ul><ul><li>The <tt>unknown</tt> procedure consults the file <tt>tclIndex</tt> in the
+ <tt>tcl_library</tt> directory to see if the command is defined by one of
+ the initialization scripts.</li></ul><ul><li>The <tt>unknown</tt> procedure sources any needed initialization scripts
+ and retries the command.</li></ul><table><tr><td valign="top"><img src="image3"></td>
+<td valign="top"><b>Commands defined in the initialization scripts are loaded
+ on demand.</b></td></tr></table></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">Standalone Initialization Techniques</h2>
+<p><p><b>Manually execute all initialization scripts</b></p>
+<ul><li>Convert all initialization scripts into C strings and
+ put them in the executable.</li></ul><ul><li>Call <tt>Tcl_Eval()</tt> on each initialization script and omit the
+ call to <tt>Tcl_Init()</tt></li></ul><ul><li>Or, redefine <tt>tclInit</tt> so that it does not attempt to source
+ <tt>init.tcl</tt> then call <tt>Tcl_Eval()</tt> on each initialization
+ script after <tt>Tcl_Init()</tt> returns.</li></ul><table><tr><td valign="top"><img src="image3"></td>
+<td valign="top"><b>This approach is not recommended</b></td></tr></table></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">Standalone Initialization Techniques</h2>
+<p><p><b>Redefining the builtin <tt>source</tt> command</b></p>
+<ul><li>Convert all initialization scripts into C strings and
+ put them in the executable.</li></ul><ul><li>Create a new <tt>source</tt> command that
+ calls <tt>Tcl_Eval()</tt> on the appropriate built-in string
+ instead of reading from the disk.</li></ul><ul><li>Read from disk if the named file is not one that is built in.</li></ul></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">Redefining <tt>source</tt></h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>static char zInitTcl[] = "...";<br>
+static char zParrayTcl[] = "...";</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Scripts <tt>init.tcl</tt> and <tt>parray.tcl</tt></td>
+</tr>
+<tr><td valign="center">
+<small><tt><br>
+int NewSourceCmd(TCLARGS){</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> if( !strcmp(argv[1],"/builtin/init.tcl") )<br>
+ return Tcl_Eval(interp, zInitTcl);<br>
+ if( !strcmp(argv[1],"/builtin/parray.tcl") )<br>
+ return Tcl_Eval(interp, zParrayTcl);</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Call <tt>Tcl_Eval()</tt> on builtin strings if the names match</td>
+</tr>
+<tr><td valign="center">
+<small><tt> return Tcl_EvalFile(interp, argv[1]);</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Call <tt>Tcl_EvalFile()</tt> if no match</td>
+</tr>
+<tr><td valign="center">
+<small><tt>}<br>
+ <br>
+int main(int argc, char **argv){<br>
+ Tcl_Interp *interp;</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> setenv("TCL_LIBRARY","/builtin");</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Causes <tt>tclInit</tt> to look for <tt>init.tcl</tt> in <tt>/builtin</tt></td>
+</tr>
+<tr><td valign="center">
+<small><tt> interp = Tcl_CreateInterp();</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> Tcl_CreateCommand(interp, "source",<br>
+ NewSourceCmd, 0, 0);</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Redefine <tt>source</tt></td>
+</tr>
+<tr><td valign="center">
+<small><tt> Tcl_Init(interp);<br>
+ Tcl_Eval(interp, zInputLoop);<br>
+ return 0;<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Redefining <tt>source</tt></h2>
+<p><ul><li>This approach works for all versions of Tcl and Tk.</li></ul><ul><li>Also need to redefine the "<tt>file exists</tt>" Tcl command since it
+ too is used by <tt>tclInit</tt>.</li></ul><ul><li>To verify that the program is really standalone, remove the call
+ to <tt>Tcl_EvalFile()</tt>.</li></ul></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">Standalone Initialization Techniques</h2>
+<p><p><b>Use the <tt>Tcl</tt>*<tt>InsertProc()</tt> functions</b></p>
+<ul><li>Three routines that overload basic file I/O operations:
+ <ul>
+ <li> <tt>TclStatInsertProc()</tt> </li>
+ <li> <tt>TclAccessInsertProc()</tt> </li>
+ <li> <tt>TclOpenFileChannelInsertProc()</tt> </li>
+ </ul></li></ul><ul><li>Allows us to implement a virtual filesystem that overlays the
+ real filesystem.</li></ul><ul><li>The virtual filesystem contains all the initialization scripts
+ as compiled-in strings. The initialization scripts look like
+ they are resident on disk even though they are built in.</li></ul><ul><li>These functions first appeared in Tcl8.0.3.
+ Presumably to support TclPro Wrapper.</li></ul><ul><li>The only documentation is comments on the code.
+ See the Tcl source file <tt>generic/tclIOUtil.c</tt></li></ul></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">The <tt>TclStatInsertProc()</tt> Function</h2>
+<p><ul><li>Sole argument is a pointer to a function whose interface is the
+ same as <tt>stat()</tt></li></ul><ul><li>Functions are stacked. Tcl tries each <tt>stat</tt> function on the
+ list, beginning with the most recently inserted, until one succeeds.</li></ul></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">The <tt>TclStatInsertProc()</tt> Function</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>#include <tclInt.h></tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Rather than <tt><tcl.h></tt>!</td>
+</tr>
+<tr><td valign="center">
+<small><tt><br>
+static int<br>
+BltinFileStat(char *path,struct stat *buf){<br>
+ char *zData;<br>
+ int nData;</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> zData = FindBuiltinFile(path, 0, &nData);</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Check if <tt>path</tt> is a builtin</td>
+</tr>
+<tr><td valign="center">
+<small><tt> if( zData==0 ){<br>
+ return -1;<br>
+ }</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Fail if <tt>path</tt> is not a builtin</td>
+</tr>
+<tr><td valign="center">
+<small><tt> memset(buf, 0, sizeof(*buf));<br>
+ buf->st_mode = 0400;<br>
+ buf->st_size = nData;</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> return 0;</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Success if it is builtin</td>
+</tr>
+<tr><td valign="center">
+<small><tt>}<br>
+ <br>
+int main(int argc, char **argv){<br>
+ Tcl_Interp *interp;</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> TclStatInsertProc(BltinFileStat);</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Register new <tt>stat</tt> function</td>
+</tr>
+<tr><td valign="center">
+<small><tt> interp = Tcl_CreateInterp();<br>
+ Tcl_Init(interp);<br>
+ Tcl_Eval(interp, zInputLoop);<br>
+ return 0;<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">The <tt>TclAccessInsertProc()</tt> Function</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>#include <tclInt.h></tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Rather than <tt><tcl.h></tt>!</td>
+</tr>
+<tr><td valign="center">
+<small><tt><br>
+/* BltinFileStat() not shown... */<br>
+ <br>
+static int<br>
+BltinFileAccess(char *path, int mode){<br>
+ char *zData;</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> if( mode & 3 ) return -1;</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">All builtins are read-only</td>
+</tr>
+<tr><td valign="center">
+<small><tt> zData = FindBuiltinFile(path, 0, &nData);</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Check if <tt>path</tt> is a builtin</td>
+</tr>
+<tr><td valign="center">
+<small><tt> if( zData==0 ) return -1;</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Fail if <tt>path</tt> is not a builtin</td>
+</tr>
+<tr><td valign="center">
+<small><tt> return 0;</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Success if it is builtin</td>
+</tr>
+<tr><td valign="center">
+<small><tt>}<br>
+ <br>
+int main(int argc, char **argv){<br>
+ Tcl_Interp *interp;</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> TclStatInsertProc(BltinFileStat);<br>
+ TclAccessInsertProc(BltinFileAccess);</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Register new <tt>stat</tt> and <tt>access</tt> functions</td>
+</tr>
+<tr><td valign="center">
+<small><tt> interp = Tcl_CreateInterp();<br>
+ Tcl_Init(interp);<br>
+ Tcl_Eval(interp, zInputLoop);<br>
+ return 0;<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">The <tt>TclOpenFileChannelInsertProc()</tt> Function</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>static Tcl_Channel BuiltinFileOpen(<br>
+ Tcl_Interp *interp, /* The TCL interpreter doing the open */<br>
+ char *zFilename, /* Name of the file to open */<br>
+ char *modeString, /* Mode string for the open (ignored) */<br>
+ int permissions /* Permissions for a newly created file (ignored) */<br>
+){<br>
+ char *zData;<br>
+ BuiltinFileStruct *p;<br>
+ int nData;<br>
+ char zName[50];<br>
+ Tcl_Channel chan;<br>
+ static int count = 1;<br>
+ <br>
+ zData = FindBuiltinFile(zFilename, 1, &nData);<br>
+ if( zData==0 ) return NULL;<br>
+ p = (BuiltinFileStruct*)Tcl_Alloc( sizeof(BuiltinFileStruct) );<br>
+ if( p==0 ) return NULL;<br>
+ p->zData = zData;<br>
+ p->nData = nData;<br>
+ p->cursor = 0;<br>
+ sprintf(zName,"etbi_bffffc7c_8049b04",((int)BuiltinFileOpen)>>12,count++);<br>
+ chan = Tcl_CreateChannel(&builtinChannelType, zName, <br>
+ (ClientData)p, TCL_READABLE);<br>
+ return chan;<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">The <tt>TclOpenFileChannelInsertProc()</tt> Function</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>static Tcl_ChannelType builtinChannelType = {<br>
+ "builtin", /* Type name. */<br>
+ NULL, /* Always non-blocking.*/<br>
+ BuiltinFileClose, /* Close proc. */<br>
+ BuiltinFileInput, /* Input proc. */<br>
+ BuiltinFileOutput, /* Output proc. */<br>
+ BuiltinFileSeek, /* Seek proc. */<br>
+ NULL, /* Set option proc. */<br>
+ NULL, /* Get option proc. */<br>
+ BuiltinFileWatch, /* Watch for events on console. */<br>
+ BuiltinFileHandle, /* Get a handle from the device. */<br>
+};</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+<p>
+ <p>For additional information see:</p>
+ <ul>
+ <li>The man page for <tt>Tcl_CreateChannel()</tt></li>
+ <li>Tk source code file <tt>generic/tkConsole.c</tt></li>
+ </ul>
+</p>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Initializing Tk</h2>
+<p><ul><li>All the same initialization script issues as Tcl</li></ul><ul><li>Tk initialization scripts are in a different directory
+ than the Tcl initialization scripts - the "Tk Library"</li></ul><ul><li>Call <tt>Tk_Init()</tt> after <tt>Tcl_Init()</tt></li></ul><ul><li>Must have an event loop or Tk will not work!</li></ul></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">Implementing An Event Loop</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>button .b -text Hello -command exit<br>
+pack .b</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Create a Tk interface</td>
+</tr>
+<tr><td valign="center">
+<small><tt><br>
+</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt>bind . <Destroy> {<br>
+ if {![winfo exists .]} exit<br>
+}</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Close the application when the main window
+ is destroyed</td>
+</tr>
+<tr><td valign="center">
+<small><tt><br>
+</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt>while 1 {vwait forever}</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">The event loop</td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">"Hello, World!" Using Tk</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>#include <tk.h><br>
+ <br>
+</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt>static char zHello[] = </tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">The application code</td>
+</tr>
+<tr><td valign="center">
+<small><tt> "button .b "<br>
+ "-text {Hello, World} "<br>
+ "-command exit\n"<br>
+ "pack .b\n";<br>
+ <br>
+</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt>static char zEventLoop[] =</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">The event loop</td>
+</tr>
+<tr><td valign="center">
+<small><tt> "bind . <Destroy> {\n"<br>
+ " if {![winfo exists .]} exit\n"<br>
+ "}\n"<br>
+ "while 1 {vwait forever}\n";<br>
+ <br>
+<br>
+int main(int argc, char **argv){<br>
+ Tcl_Interp *interp;<br>
+ interp = Tcl_CreateInterp();</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> Tcl_Init(interp);<br>
+ Tk_Init(interp);</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">We really should check the return values of the init functions...</td>
+</tr>
+<tr><td valign="center">
+<small><tt> Tcl_Eval(interp, zHello);</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> Tcl_Eval(interp, zEventLoop);</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">The event loop never returns</td>
+</tr>
+<tr><td valign="center">
+<small><tt> /*NOTREACHED*/<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Compiling "Hello, World!" For Tk</h2>
+<p><p><b>Unix:</b></p>
+ <blockquote><pre>
+ $ gcc hello.c -ltk -L/usr/X11R6/lib \
+ -lX11 -ltcl -lm -ldl
+ $ ./a.out</pre></blockquote>
+
+ <p><b>Windows using Cygwin:</b></p>
+ <blockquote><pre>
+ C:> gcc hello.c -mwindows -ltk80 -ltcl80 -lm
+ C:> a.exe</pre></blockquote>
+
+ <p><b>Windows using Mingw32:</b></p>
+ <blockquote><pre>
+ C:> gcc -mno-cygwin hello.c -mwindows \
+ -ltk82 -ltcl82 -lm
+ C:> a.exe</pre></blockquote></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">Making The Program Standalone</h2>
+<p><p>To make a Tcl application standalone you have to convert the following
+ initialization scripts to C strings and compile them into the
+ executable:</p>
+ <table><tr>
+ <td valign="top"><tt>
+ auto.tcl<br>
+ history.tcl<br>
+ init.tcl
+ </tt></td>
+ <td valign="top"><tt>
+ ldAout.tcl<br>
+ package.tcl
+ </tt></td>
+ <td valign="top"><tt>
+ parray.tcl<br>
+ safe.tcl
+ </tt></td>
+ <td valign="top"><tt>
+ tclIndex<br>
+ word.tcl
+ </tt></td>
+ </tr></table>
+
+ <p>To make a Tk application standalone requires these additional
+ initialization scripts from the Tk Library:</p>
+ <table><tr>
+ <td valign="top"><tt>
+ bgerror.tcl<br>
+ button.tcl<br>
+ clrpick.tcl<br>
+ comdlg.tcl<br>
+ console.tcl<br>
+ dialog.tcl
+ </tt></td>
+ <td valign="top"><tt>
+ entry.tcl<br>
+ focus.tcl<br>
+ listbox.tcl<br>
+ menu.tcl<br>
+ msgbox.tcl<br>
+ optMenu.tcl
+ </tt></td>
+ <td valign="top"><tt>
+ palette.tcl<br>
+ safetk.tcl<br>
+ scale.tcl<br>
+ scrlbar.tcl<br>
+ tclIndex<br>
+ tearoff.tcl
+ </tt></td>
+ <td valign="top"><tt>
+ text.tcl<br>
+ tk.tcl<br>
+ tkfbox.tcl<br>
+ xmfbox.tcl
+ </tt></td>
+ </tr></table>
+
+ <p>Total of about 13K lines and 400K bytes of text or 9K lines and
+ 250K bytes if you strip comments and leading spaces</p></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">A Review Of The Features We Want</h2>
+<p><ol type="A">
+ <li value="1">
+ Combine C/C++ with Tcl/Tk into a single executable.</dd>
+ </li></ol>
+
+ <ol type="A">
+ <li value="2">
+ The executable should be standalone. It must not depend
+ on files not normally found on the system.
+ </li></ol>
+
+ <ol type="A">
+ <li value="3">
+ It should be difficult for end users to alter the program
+ (and introduce bugs).
+ </li></ol></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">Available Programming Aids</h2>
+<p><p>Several tools are available. The chart below shows which tools
+ help achieve which objectives.</p>
+
+ <center><table border="2">
+ <tr>
+ <td></td>
+ <td colspan="3" align="center">
+ <b>Features The Tool Helps To Achieve</b></td>
+ </tr>
+ <tr>
+ <td align="center"><b>Tool Name</b></td>
+ <td align="center">Mix C and Tcl</td>
+ <td align="center">Standalone</td>
+ <td align="center">Hide Source</td>
+ </tr>
+ <tr>
+ <td>SWIG</td>
+ <td align="center"><img src="image6"></td>
+ <td> </td>
+ <td> </td>
+ </tr>
+ <tr>
+ <td>TclPro Wrapper</td>
+ <td> </td>
+ <td align="center"><img src="image6"></td>
+ <td align="center"><img src="image6"></td>
+ </tr>
+ <tr>
+ <td>FreeWrap</td>
+ <td> </td>
+ <td align="center"><img src="image6"></td>
+ <td align="center"><img src="image6"></td>
+ </tr>
+ <tr>
+ <td>Wrap</td>
+ <td> </td>
+ <td align="center"><img src="image6"></td>
+ <td> </td>
+ </tr>
+ <tr>
+ <td>mktclapp</td>
+ <td align="center"><img src="image6"></td>
+ <td align="center"><img src="image6"></td>
+ <td align="center"><img src="image6"></td>
+ </tr>
+ </table></center></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">SWIG</h2>
+<table><tr><td valign="top"><img src="image7"></td>
+<td valign="top"><p><ul><li>Creates an interface between an existing C/C++ library and a high-level
+ programming language. Support for:
+ <ul>
+ <li> Tcl/Tk </li>
+ <li> Perl </li>
+ <li> Python </li>
+ <li> Java </li>
+ <li> Eiffel </li>
+ <li> Guile </li>
+ </ul></li></ul><ul><li>No changes required to C/C++ code. Can be used with legacy libraries.</li></ul><ul><li>Generates an extension, not a standalone binary</li></ul><ul><li>The tutorial on SWIG was yesterday afternoon.</li></ul><ul><li>http://www.swig.org/</li></ul></p></td></tr></table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Wrapper Programs</h2>
+<table><tr><td valign="top"><img src="image8"></td>
+<td valign="top"><p><ul><li>Convert a pure Tcl/Tk program into a standalone binary</li></ul><ul><li>Several wrapper programs are available:
+ <ul>
+ <li> TclPro Wrapper - http://www.scriptics.com/ </li>
+ <li> FreeWrap - http://www.albany.net/~dlabelle/freewrap/freewrap.html </li>
+ <li> Wrap - http://members1.chello.nl/~j.nijtmans/wrap.html </li>
+ </ul></li></ul><ul><li>No C compiler required!</li></ul><ul><li>TclPro will convert Tcl script into bytecode so that it cannot be
+ easily read by the end user. FreeWrap encrypts the scripts.</li></ul><ul><li>FreeWrap uses compression on its executable.
+ Wrap uses compression on both the executable and on the bundled script files.</li></ul><ul><li>Usually include extensions like winico and/or BLT</li></ul></p></td></tr></table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">mktclapp</h2>
+<table><tr><td valign="top"><img src="image9"></td>
+<td valign="top"><p><ul><li>Mix C/C++ with Tcl/Tk into a standalone binary</li></ul>
+<ul><li><tt>mktclapp</tt> generates an application initialization file
+ that contains Tcl scripts as strings and makes all necessary calls
+ to <tt>Tcl_Init</tt>, <tt>Tcl_CreateCommand</tt>,
+ <tt>Tcl</tt>*<tt>InsertProc</tt>, etc.</li></ul><ul><li>Features to make it easier to write new Tcl command in C</li></ul><ul><li><tt>xmktclapp.tcl</tt> provides a GUI interface to <tt>mktclapp</tt></li></ul><ul><li>http://www.hwaci.com/sw/mktclapp/</li></ul></p></td></tr></table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">"Hello, World!" Using Mktclapp</h2>
+<p><ul><li>Download <tt>mktclapp.c</tt> and <tt>xmktclapp.tcl</tt> from
+ http://www.hwaci.com/sw/mktclapp/</li></ul><ul><li>Compile <tt>mktclapp</tt>:
+ <blockquote><pre>
+ cc -o mktclapp mktclapp.c
+ </pre></blockquote></li></ul><ul><li>Create "Hello, World!" as a Tcl script in file <tt>hw.tcl</tt>:
+ <blockquote><pre>
+ button .b -text {Hello, World!} -command exit
+ pack .b
+ </pre></blockquote></li></ul><ul><li>Launch xmktclapp:
+ <blockquote><pre>
+ wish xmktclapp.tcl
+ </pre></blockquote></li></ul></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">"Hello, World!" Using Mktclapp</h2>
+<table width="100%"><tr><td valign="top"><p><ul><li>Set "Command Line Input?" to "None"</li></ul><ul><li>Set "Standalone?" to "Yes"</li></ul><ul><li>Enter "<tt>hw.mta</tt>" for the Configuration File</li></ul><ul><li>Enter "<tt>hw.c</tt>" for the Output C File</li></ul></p></td>
+<td valign="top" align="right"><img src="image10"></td></tr></table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">"Hello, World!" Using Mktclapp</h2>
+<table width="100%"><tr><td valign="top"><p><ul><li>Go to the "Tcl Scripts" page</li></ul><ul><li>Press "Insert" and add <tt>hw.tcl</tt> to the list of
+ Tcl scripts</li></ul><ul><li>Change the "Startup Script" to be <tt>hw.tcl</tt>.</li></ul><ul><li>Select File/Build and File/Exit</li></ul></p></td>
+<td valign="top" align="right"><img src="image11"></td></tr></table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">"Hello, World!" Using Mktclapp</h2>
+<p><ul><li>Mktclapp generates <tt>hw.c</tt>.
+ Compile it something like this:
+ <pre>
+ cc hw.c -ltk -L/usr/X11R6/lib -lX11 -ltcl -lm -ldl
+ </pre></li></ul><ul><li>Or, if using Cygwin:
+ <pre>
+ gcc hw.c -mwindows -ltk80 -ltcl80 -lm
+ </pre></li></ul><ul><li>Or, if using Mingw32:
+ <pre>
+ gcc -mno-cygwin hw.c -mwindows -ltk82 -ltcl82 -lm
+ </pre></li></ul><ul><li>And you're done!</li></ul></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">Adding C Code To Your Program</h2>
+<p>Put the new C code in a new source file named "<tt>add.c</tt>"</p><p>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>#include "hw.h"</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Generated by mktclapp</td>
+</tr>
+<tr><td valign="center">
+<small><tt></tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt>int ET_COMMAND_add(ET_TCLARGS){</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center"><tt>ET_TCLARGS</tt> is a macro defined in <tt>hw.h</tt></td>
+</tr>
+<tr><td valign="center">
+<small><tt> int a, b;<br>
+ char zResult[30];<br>
+ a = atoi(argv[1]);<br>
+ b = atoi(argv[2]);<br>
+ sprintf(zResult, "-1073742724", a+b);<br>
+ Tcl_SetResult(interp, zResult, TCL_VOLATILE);<br>
+ return TCL_OK;<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Adding C Code To Your Program</h2>
+<table width="100%"><tr><td valign="top"><p><ul><li>Go to the "C/C++ Modules" page of xmktclapp.tcl</li></ul>
+<ul><li>Press "Insert" and add <tt>add.c</tt> to the list of
+ C/C++ modules</p></li></ul></li></ul><ul><li>Select File/Build and File/Exit</li></ul></p></td>
+<td valign="top" align="right"><img src="image12"></td></tr></table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Adding C Code To Your Program</h2>
+<p><ul><li>Compile as follows:
+ <pre>
+ cc add.c hw.c -ltk -L/usr/X11R6/lib -ltcl -lm -ldl
+ </pre></li></ul><ul><li>Or construct a Makefile that compiles <tt>add.c</tt> into <tt>add.o</tt>
+ and <tt>hw.c</tt> into <tt>hw.o</tt> and then links them.</li></ul><ul><li>Compile the same way for Windows except use the usual Windows
+ libraries and options...</li></ul><table><tr><td valign="top"><img src="image3"></td>
+<td valign="top"><b>Don't have to worry with <tt>Tcl_CreateCommand()</tt> - Mktclapp takes
+ care of that automatically.</b></td></tr></table></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">Checking Parameters In The <tt>add</tt> Command</h2>
+<p>Modify <tt>add.c</tt> to insure the <tt>add</tt> command
+ is called with exactly two integer arguments</p><p>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>#include "hw.h"<br>
+ <br>
+int ET_COMMAND_add(ET_TCLARGS){<br>
+ int a, b;<br>
+ char zResult[30];</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> if( argc!=3 ){<br>
+ Tcl_AppendResult(interp,<br>
+ "wrong # args: should be: \"",<br>
+ argv[0], " VALUE VALUE\"", 0);<br>
+ return TCL_ERROR;<br>
+ }</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Report an error if there are not exactly
+ 2 arguments</td>
+</tr>
+<tr><td valign="center">
+<small><tt> if( Tcl_GetInt(interp, argv[1], &a)!=TCL_OK ){<br>
+ return TCL_ERROR;<br>
+ }</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Report an error if the first argument is
+ not an integer</td>
+</tr>
+<tr><td valign="center">
+<small><tt> if( Tcl_GetInt(interp, argv[2], &b)!=TCL_OK ){<br>
+ return TCL_ERROR;<br>
+ }</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Do the same for the second argument</td>
+</tr>
+<tr><td valign="center">
+<small><tt> sprintf(zResult, "-1073742724", a+b);<br>
+ Tcl_SetResult(interp, zResult, TCL_VOLATILE);<br>
+ return TCL_OK;<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Using The Tcl_Obj Interface</h2>
+<p>In the file <tt>objadd.c</tt> put this code:</p><p>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>#include "hw.h"</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt><br>
+int ET_OBJCOMMAND_add2(ET_OBJARGS){<br>
+ int a, b;</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Use "<tt>ET_OBJCOMMAND</tt>" instead of "<tt>ET_COMMAND</tt>" and
+ "<tt>ET_OBJARGS</tt>" instead of "<tt>ET_TCLARGS</tt>"</td>
+</tr>
+<tr><td valign="center">
+<small><tt> if( objc!=3 ){<br>
+ Tcl_WrongNumArgs(interp, 1, objv,<br>
+ "number number");<br>
+ return TCL_ERROR;<br>
+ }</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">A special routine for "wrong # args" error</td>
+</tr>
+<tr><td valign="center">
+<small><tt> if( Tcl_GetIntFromObj(interp, objv[1], &a) ){</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Instead of <tt>Tcl_GetInt</tt></td>
+</tr>
+<tr><td valign="center">
+<small><tt> return TCL_ERROR;<br>
+ }<br>
+ if( Tcl_GetIntFromObj(interp, objv[2], &b) ){<br>
+ return TCL_ERROR;<br>
+ }</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> Tcl_SetIntObj(Tcl_GetObjResult(interp), a+b);</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Result stored as integer, not a string</td>
+</tr>
+<tr><td valign="center">
+<small><tt> return TCL_OK;<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Speed Of Tcl_Obj Versus "char*" Interfaces</h2>
+<p><ul><li>Compile both <tt>add</tt> and <tt>add2</tt> into the same executable.</li></ul><ul><li>Compare their speeds:
+ <pre>
+ time {add 123456 654321} 10000
+ <font color="blue">26 microseconds per iteration</font>
+ time {add2 123456 654321} 10000
+ <font color="blue">4 microseconds per iteration</font>
+ </pre></li></ul><ul><li>The Tcl_Obj version is 650 faster!</li></ul><ul><li>Replace the addition with a "real" computation that takes
+ 10 milliseconds.</li></ul><ul><li>Now the Tcl_Obj version is only 0.2 faster!</li></ul><table><tr><td valign="top"><img src="image3"></td>
+<td valign="top"><b>In many real-world problems, the Tcl_Obj interface has no noticeable
+ speed advantage over the string interface.</b></td></tr></table></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">More About Built-in Tcl Scripts</h2>
+<table><tr><td valign="top"><img src="image11"></td>
+<td valign="top"><p><ul><li>Comments and leading white-space are removed from the
+ script by default. Use the "Don't Strip Comments"
+ button to change this.</li></ul><ul><li>The file name must exactly match the name that is
+ used by the <tt>source</tt> command.</li></ul></p></td></tr></table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Locations Of Libraries</h2>
+<table><tr><td valign="top"><img src="image13"></td>
+<td valign="top"><p><ul><li>Tells mktclapp where to look for script libraries.</li></ul><ul><li>All Tcl scripts in the indicated directories are
+ compiled into the <tt>appinit.c</tt> file.</li></ul><ul><li>Comments and extra white-space are removed.
+ There is no way to turn this off.</li></ul></p></td></tr></table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Built-in Binary Data Files</h2>
+<table><tr><td valign="top"><img src="image14"></td>
+<td valign="top"><p><ul><li>Arbitrary files become part of the virtual filesystem</li></ul><ul><li>No comment or white-space removal is attempted</li></ul><ul><li>Useful for images or other binary data</li></ul></p></td></tr></table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">New Commands In Namespaces</h2>
+<p>Two underscores (__) are replaced by two colons (::) in
+ command names, thus giving the ability to define new commands
+ in a namespace</p><p>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>#include <hw.h></tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt><br>
+int ET_COMMAND_adder__add(ET_TCLARGS){<br>
+ int a, b;</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Creates the Tcl command called "<tt>adder::add</tt>"</td>
+</tr>
+<tr><td valign="center">
+<small><tt> char *zResult[30];<br>
+ if( argc!=3 ){<br>
+ Tcl_AppendResult(interp,<br>
+ "wrong # args: should be: \"",<br>
+ argv[0], " VALUE VALUE\"", 0);<br>
+ return TCL_ERROR;<br>
+ }<br>
+ if( Tcl_GetInt(interp, argv[1], &a)!=TCL_OK ){<br>
+ return TCL_ERROR;<br>
+ }<br>
+ if( Tcl_GetInt(interp, argv[1], &b)!=TCL_OK ){<br>
+ return TCL_ERROR;<br>
+ }<br>
+ sprintf(zResult, "-1073742724", a+b);<br>
+ Tcl_SetResult(interp, zResult, TCL_VOLATILE);<br>
+ return TCL_OK;<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Adding Your Own <tt>main()</tt></h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>int main(int argc, char **argv){<br>
+ /* Application specific initialization */</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> Et_Init(argc, argv);</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Never returns!</td>
+</tr>
+<tr><td valign="center">
+<small><tt> /*NOTREACHED*/<br>
+ return 0;<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+<p><table><tr><td valign="top"><img src="image3"></td>
+<td valign="top"><b>The "Autofork" feature is disabled if you supply your own <tt>main()</tt></b></td></tr></table>
+</p>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Initializing The Tcl Interpreter</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>#include <tcl.h><br>
+ <br>
+int counter = 0;<br>
+ <br>
+int main(int argc, char **argv){<br>
+ Et_Init(argc, argv);<br>
+ /*NOTREACHED*/<br>
+ return 0;<br>
+}<br>
+ <br>
+int Et_AppInit(Tcl_Interp *interp){</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> if( Blt_Init(Interp) ){<br>
+ return TCL_ERROR;<br>
+ }</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Example: Initialize an extension</td>
+</tr>
+<tr><td valign="center">
+<small><tt> Tcl_LinkVar(interp, "counter", &counter,<br>
+ TCL_LINK_INT);</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Or link a C variable to a Tcl variable</td>
+</tr>
+<tr><td valign="center">
+<small><tt> return TCL_OK;</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Return TCL_OK if successful</td>
+</tr>
+<tr><td valign="center">
+<small><tt>}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Writing Your Own Event Loop</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>#include <tcl.h><br>
+</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt>void Et_CustomMainLoop(Tcl_Interp *interp){</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Replaces the default event loop</td>
+</tr>
+<tr><td valign="center">
+<small><tt> return;</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Ex: Return without handling any events.</td>
+</tr>
+<tr><td valign="center">
+<small><tt>}<br>
+ <br>
+int main(int argc, char **argv){</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> Et_Init(argc, argv);</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">This now returns after initializing Tcl</td>
+</tr>
+<tr><td valign="center">
+<small><tt> /* Application code here */<br>
+ return 0;<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Writing Your Own Event Loop</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>#include <tcl.h><br>
+ <br>
+void Et_CustomMainLoop(Tcl_Interp *interp){</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> for(;;){<br>
+ Tcl_DoOneEvent(TCL_ALL_EVENTS|TCL_DONT_WAIT);<br>
+ /* Other processing... */<br>
+ }</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Intermix processing and event handling</td>
+</tr>
+<tr><td valign="center">
+<small><tt>}<br>
+ <br>
+int main(int argc, char **argv){</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+<tr><td valign="center">
+<small><tt> Et_Init(argc, argv);</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Never returns</td>
+</tr>
+<tr><td valign="center">
+<small><tt> /*NOTREACHED*/<br>
+ return 0;<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Mktclapp Initialization Sequence</h2>
+<p><ul><li>Initialization starts when the <tt>Et_Init()</tt>
+ function is called either by client code or by
+ the <tt>main()</tt> that mktclapp generates</li></ul><ul><li>Create the main Tcl interpreter</li></ul><ul><li>Construct the virtual filesystem overlay by redefining
+ the <tt>source</tt> command and by using the
+ <tt>Tcl</tt>*<tt>InsertProc()</tt> functions</li></ul><ul><li>Call <tt>Et_PreInit()</tt> if the client defines it</li></ul><ul><li>Call <tt>Tcl_Init()</tt> and <tt>Tk_Init()</tt></li></ul><ul><li>Call <tt>Tcl_CreateCommand()</tt> and <tt>Tcl_CreateObjCommand()</tt>
+ for every <tt>ET_COMMAND_</tt>* and <tt>ET_OBJCOMMAND_</tt>* function
+ in the client code</li></ul><ul><li>Call <tt>Et_AppInit()</tt> if the client defines it</li></ul><ul><li>Run the main Tcl script if there is one</li></ul><ul><li>Call <tt>Et_CustomMainLoop()</tt> if defined by client code or
+ else run the built-in event loop</li></ul></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">Invoking Tcl From C</h2>
+<p><ul><li>Use one of the built-in evaluation functions:
+ <center><table width="80%">
+ <tr><td valign="top" width="50%"><ul>
+ <li> Tcl_Eval() </li>
+ <li> Tcl_VarEval() </li>
+ <li> Tcl_EvalFile() </li>
+ <li> Tcl_GlobalEval() </li>
+ </ul></td>
+ <td valign="top" width="50%"><ul>
+ <li> Tcl_EvalObj() </li>
+ <li> Tcl_GlobalEvalObj() </li>
+ </ul></td></tr>
+ </table></center></li></ul><ul><li>Mktclapp provides evaluation functions with variable argument
+ lists as in <tt>printf()</tt>:
+ <ul>
+ <li> Et_EvalF() </li>
+ <li> Et_GlobalEvalF() </li>
+ </ul></li></ul><ul><li>Mktclapp provides a global variable <tt>Et_Interp</tt> which is
+ a pointer to the main interpreter</li></ul></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">Invoking Tcl From C</h2>
+<p>Example: A C function that pops up an error message dialog box</p><p>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>#include "appinit.h"<br>
+ <br>
+void ErrMsg(char *zMsg){<br>
+ Tcl_SetVar(Et_Interp, "zMsg", zMsg, TCL_GLOBAL_ONLY);<br>
+ Tcl_GlobalEval(Et_Interp, <br>
+ "tk_messageBox -icon error -msg $zMsg -type ok");<br>
+ Tcl_UnsetVar(Et_Interp, "zMsg", TCL_GLOBAL_ONLY);<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Invoking Tcl From C</h2>
+<p>The same C function implemented using <tt>Et_EvalF()</tt> instead
+ of <tt>Tcl_GlobalEval()</tt></p><p>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>#include "appinit.h"<br>
+ <br>
+void ErrMsg(char *zMsg){<br>
+ Et_EvalF(Et_Interp, <br>
+ "tk_messageBox -icon error -msg {¸üÿ¿PX¶} -type ok",<br>
+ zMsg);<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+<p>
+ <ul><li>
+ Suppose the function is called as follows:
+ <blockquote>
+ <tt>ErrMsg("Syntax error near \"}\"");</tt>
+ </blockquote>
+ </li></ul>
+
+ <ul><li>
+ The command that gets executed is:
+ <pre>
+ tk_messageBox -icon error -msg \
+ {Syntax error near "}"} -type ok
+ </pre>
+ </li></ul>
+
+ <ul><li>
+ But this is an ill-formed Tcl command!
+ </li></ul>
+</p>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Invoking Tcl From C</h2>
+<p>Use the "<tt></tt>" format to generate a quoted string</p><p>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt>#include "appinit.h"<br>
+ <br>
+void ErrMsg(char *zMsg){<br>
+ Et_EvalF(Et_Interp, <br>
+ "tk_messageBox -icon error -msg \"%\" -type ok",<br>
+ zMsg);<br>
+}</tt></small></td>
+<td></td><td></td><td></td><td></td>
+</tr>
+</table>
+<p><ul><li>The <tt></tt> puts a backslash before all characters that
+ are special to Tcl</li></ul><ul><li>The Tcl command becomes:
+ <pre>
+ tk_messageBox -icon error -msg \
+ "Syntax error near \"\}\"" -type ok
+ </pre></li></ul></p>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Other Functions Provided By Mktclapp</h2>
+<p><ul><li><tt>void Et_ResultF(Tcl_Interp*, ...);</tt></li></ul><ul><li><tt>char *Et_DStringAppendF(Tcl_DString*, ...);</tt></li></ul><ul><li><tt>int Et_AppendObjF(Tcl_Obj*, ...);</tt></li></ul><ul><li><tt>char *mprintf(const char *format, ...);<br>
+ char *vmprintf(const char *format, va_list);</tt></li></ul><ul><li><tt>void Et_NewBuiltinFile(char *filename, char *data, int amt);</tt></li></ul></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">Operating Mktclapp From The Command Line</h2>
+<p><ul><li>Generate the <tt>appinit.h</tt> header file like this:
+ <blockquote>
+ <tt>mktclapp -header >appinit.h</tt>
+ </blockquote></li></ul><ul><li>Generate the <tt>appinit.c</tt> file like this:
+ <blockquote>
+ <tt>mktclapp -f appinit.mta >appinit.c</tt>
+ </blockquote></li></ul><ul><li>The <tt>*.mta</tt> file is just a list of command-line options</li></ul><ul><li>Enter
+ <blockquote>
+ <tt>mktclapp -help</tt>
+ </blockquote>
+ to get a list of available options</li></ul><ul><li>Look at MTA files generated by xmktclapp.tcl for examples</li></ul></p>
+<br clear="both"><p><hr></p>
+<h2 align="center">Format Of An MTA File</h2>
+<table cellspacing="0" cellpadding="0" border="0">
+<tr><td valign="center">
+<small><tt># Configuration file generated by xmktclapp<br>
+# Hand editing is not recommended<br>
+#</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Comments begin with one #</td>
+</tr>
+<tr><td valign="center">
+<small><tt>## Autofork No<br>
+## CFile:add.c 1<br>
+## CFile:objadd.c 1<br>
+## CmdLine Console<br>
+## ConfigFile hw.mta<br>
+## Data:check.gif 1<br>
+## MainScript hw.tcl<br>
+## Mode Tcl/Tk<br>
+## NoSource No<br>
+## OutputFile hw.c<br>
+## Shroud No<br>
+## Standalone Yes<br>
+## TclFile:hw.tcl 1<br>
+## TclLib /usr/lib/tcl8.0<br>
+## TkLib /usr/lib/tk8.0</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">Lines beginning with two #s are used
+ by xmktclapp.tcl and ignored by mktclapp</td>
+</tr>
+<tr><td valign="center">
+<small><tt>-console<br>
+-main-script "hw.tcl"<br>
+-tcl-library "/usr/lib/tcl8.0"<br>
+-tk-library "/usr/lib/tk8.0"<br>
+"add.c"<br>
+"objadd.c"<br>
+-i "check.gif"<br>
+-strip-tcl "hw.tcl"</tt></small></td>
+<td> </td>
+<td valign="center"><img src="image2"></td>
+<td> </td>
+<td valign="center">All other lines are read by mktclapp and
+ ignored by xmktclapp.tcl</td>
+</tr>
+</table>
+
+<br clear="both"><p><hr></p>
+<h2 align="center">Summary</h2>
+<p><ul><li>Use Tcl for the things Tcl is good at and use C/C++ for the things that
+ C/C++ is good at</li></ul><ul><li>Use wrapper programs to make pure Tcl programs standalone</li></ul><ul><li>Use mktclapp to combine Tcl/Tk with C/C++ into a standalone</li></ul></p>
+<br clear="both"><p><hr></p>
diff --git a/tests/page4/image1 b/tests/page4/image1
new file mode 100644
index 0000000..da26d70
Binary files /dev/null and b/tests/page4/image1 differ
diff --git a/tests/page4/image2 b/tests/page4/image2
new file mode 100644
index 0000000..e176a96
Binary files /dev/null and b/tests/page4/image2 differ
diff --git a/tests/page4/image3 b/tests/page4/image3
new file mode 100644
index 0000000..e829d37
Binary files /dev/null and b/tests/page4/image3 differ
diff --git a/tests/page4/image4 b/tests/page4/image4
new file mode 100644
index 0000000..f14ea13
Binary files /dev/null and b/tests/page4/image4 differ
diff --git a/tests/page4/image5 b/tests/page4/image5
new file mode 100644
index 0000000..4ef6277
Binary files /dev/null and b/tests/page4/image5 differ
diff --git a/tests/page4/image6 b/tests/page4/image6
new file mode 100644
index 0000000..1adb261
Binary files /dev/null and b/tests/page4/image6 differ
diff --git a/tests/page4/image7 b/tests/page4/image7
new file mode 100644
index 0000000..ba0d26e
Binary files /dev/null and b/tests/page4/image7 differ
diff --git a/tests/page4/image8 b/tests/page4/image8
new file mode 100644
index 0000000..8b81d58
Binary files /dev/null and b/tests/page4/image8 differ
diff --git a/tests/page4/image9 b/tests/page4/image9
new file mode 100644
index 0000000..f0a352f
Binary files /dev/null and b/tests/page4/image9 differ
diff --git a/tests/page4/index.html b/tests/page4/index.html
new file mode 100644
index 0000000..99530ce
--- /dev/null
+++ b/tests/page4/index.html
@@ -0,0 +1,768 @@
+<!DOCTYPE HTML="HTML" PUBLIC="PUBLIC" "-//W3C//DTD=""-//W3C//DTD" HTML="HTML" 4.0="4.0" Transitional//EN"="Transitional//EN"">
+<HTML>
+<HEAD>
+<TITLE>[fm] welcome to freshmeat.net</TITLE>
+<STYLE TYPE="text/css"><!-- A:link {text-decoration: none}A:visited{text-decoration:none}A:active{text-decoration:none}--></STYLE>
+</HEAD>
+<BODY MARGINWIDTH="0" MARGINHEIGHT="0" LEFTMARGIN="0" RIGHTMARGIN="0" TOPMARGIN="0" BGCOLOR="#FFFFFF" TEXT="#000000" LINK="#336699" VLINK="#336699" ALINK="#336699">
+<BR><CENTER><TABLE BORDER="0" CELLPADDING="0" CELLSPACING="0"><TR><TD WIDTH="1"><SCRIPT LANGUAGE="JAVASCRIPT">
+<!--
+now = new Date();
+tail = now.getTime();
+document.write("<IMG SRC='http://209.207.224.246/FreshMeat/Core/pc.gif?/index.php3," + tail + "' WIDTH=1 HEIGHT=1><BR>");
+//-->
+</SCRIPT>
+<NOSCRIPT>
+<IMG SRC="image1" WIDTH="1" HEIGHT="1"><BR>
+</NOSCRIPT></TD></TR></TABLE>
+<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="0"><TR><TD WIDTH="468"><SCRIPT LANGUAGE="JAVASCRIPT">
+<!--
+now = new Date();
+tail = now.getTime();
+AltText = "\"Please click here.\"";
+document.write("<A HREF='http://ads.freshmeat.net/cgi-bin/ad_click.pl?index,tsof0001en'>")
+document.write("<IMG SRC='http://ads.freshmeat.net/tsof0001en.gif?" + tail + "' WIDTH=468 HEIGHT=60 ALT=" + AltText + "></A><BR>");
+//-->
+</SCRIPT>
+<NOSCRIPT>
+<A HREF="http://ads.freshmeat.net/cgi-bin/ad_click.pl?index,tsof0001en"><IMG SRC="image2" WIDTH="468" HEIGHT="60" ALT="Please click here."></A><BR>
+</NOSCRIPT></TD></TR></TABLE>
+
+<TABLE CELLSPACING="0" CELLPADDING="2" BORDER="0" WIDTH="97%"><TR>
+<TD ALIGN="left" VALIGN="bottom"><A HREF="/"><IMG SRC="image3" BORDER="0" ALT="freshmeat.net" WIDTH="300" HEIGHT="65"></A></TD>
+<TD VALIGN="bottom" ALIGN="left" ROWSPAN="2"><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+<FORM METHOD="get" ACTION="/search.php3">
+<SMALL>find: <INPUT TYPE="text" SIZE="15" NAME="query"></SMALL></FORM></FONT></TD>
+<TD ALIGN="right" VALIGN="bottom"><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+<A HREF="http://www.linux.com"><FONT COLOR="#000000"><B><SMALL>linux.com partner</SMALL></B></FONT></A><BR>
+<TABLE CELLSPACING="0" CELLPADDING="1" BORDER="0" WIDTH="100%"><TR>
+<TD ALIGN="right"><SMALL><NOBR><FONT FACE="Lucida,Verdana,Helvetica,Arial"><B><A HREF="/">news</A> |<BR>
+<A HREF="/appindex/">appindex</A> |<BR>
+<A HREF="/editorials/">editorials</A> |</B></FONT></NOBR></SMALL></TD>
+<TD ALIGN="right"><SMALL><NOBR><FONT FACE="Lucida,Verdana,Helvetica,Arial"><B><A HREF="/lounge/">lounge</A> |<BR>
+<A HREF="/contrib.php3">contribute</A> |<BR>
+<A HREF="/feedback.php3">feedback</A> |</B></FONT></NOBR></SMALL></TD>
+<TD ALIGN="right"><SMALL><NOBR><FONT FACE="Lucida,Verdana,Helvetica,Arial"><B><A HREF="/about.php3">about</A> |<BR>
+<A HREF="/awards.php3">awards</A> |<BR>
+<A HREF="/faq.php3">FAQ</A> |</B></FONT></NOBR></SMALL></TD>
+</TR></TABLE></TD>
+</TR></TABLE>
+<TABLE WIDTH="100%" CELLPADDING="0" CELLSPACING="0" BORDER="0">
+<TR BGCOLOR="#000000"><TD><IMG SRC="image4" WIDTH="1" HEIGHT="2" ALT=""></TD></TR></TABLE>
+<TABLE CELLSPACING="0" CELLPADDING="3" BORDER="0" WIDTH="100%" BGCOLOR="#BBDDFF">
+<TR><TD ALIGN="center" VALIGN="top">
+<BR>
+<FONT FACE="Lucida,Verdana,Helvetica,Arial">
+
+
+<SMALL><B>sort by: [ <A HREF="/news/2000/01/29/">date</A> | <A HREF="/news/list.php3?day=/2000/01/29/&orderby=name">name</A> | <A HREF="/news/list.php3?day=/2000/01/29/&orderby=urgency">urgency</A> ]</B></SMALL><BR></TD><TD> </TD></TR><TR><TD VALIGN="top" ALIGN="center"><FONT FACE="Lucida,Verdana,Helvetica,Arial"><TABLE CELLSPACING="0" CELLPADDING="2" WIDTH="97%" BORDER="0" BGCOLOR="#000000"><TR><TD COLSPAN="2">
+<TABLE CELLSPACING="0" CELLPADDING="3" WIDTH="100%" BORDER="0" BGCOLOR="#FFFFFF">
+<TR><TD><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+<B><FONT SIZE="+2">We should get this out of the door now</FONT></B><BR>
+<SMALL><B><A HREF="mailto:scoop at freshmeat.net">scoop</A> - January 29th 2000, 23:59 EST</B></SMALL>
+<P>Everyone else is talking about it, so we should announce it ourselves
+before you start to think it's a government hoax. <A HREF="http://server51.freshmeat.net/">Server 51</A> is our new hosting service for Open Source projects, based on Super Cool Space Alien Technology(TM). We hadn't planned to announce it quite so soon, and it's still in the alpha stage as we work day and night at integrating SCSAT with our terrestrial systems, but feel free to take a look around and see what's going on. When we're out of the testing stage and ready to make room for your project, we'll send word via your implants. Be listening.
+
+
+
+<P ALIGN="right"><B>[ <A HREF="/news/2000/01/29/949208399.html">comments (8)</A> ]</B>
+</FONT></TD></TR></TABLE></TD></TR><TR><TD VALIGN="middle">
+ <FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#FFFFFF"><B><SMALL>Category: freshmeat
+</SMALL></B></FONT></FONT></TD><TD ALIGN="right">
+ <A HREF="http://server51.freshmeat.net"><IMG SRC="image5" WIDTH="21" HEIGHT="21" BORDER="0" ALT="homepage"></A>
+</TD></TR></TABLE>
+<HR WIDTH="0" SIZE="0">
+
+
+<TABLE CELLSPACING="0" CELLPADDING="2" WIDTH="97%" BORDER="0" BGCOLOR="#000000"><TR><TD COLSPAN="2">
+<TABLE CELLSPACING="0" CELLPADDING="3" WIDTH="100%" BORDER="0" BGCOLOR="#FFFFFF">
+<TR><TD><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+<B><FONT SIZE="+2">Is Linux for Crazies?</FONT></B><BR>
+<SMALL><B><A HREF="mailto:jeff.covey at pobox.com">jeff covey</A> - January 29th 2000, 23:59 EST</B></SMALL>
+<P>Ray Woodcock writes: "In terms relevant to Linux, this freshmeat
+editorial glances at the tendency of mainstream viewpoints to dismiss
+other viewpoints as 'fringe,' the propensity of dissident movements to
+splinter into factions before they can effectively counter their
+primary adversaries, and the difficulty of creating stability without
+squelching curiosity."
+<P ALIGN="right"><B>[ <A HREF="/news/2000/01/29/949208340.html">comments (2), 2065 words in body</A> ]</B>
+</FONT></TD></TR></TABLE></TD></TR><TR><TD VALIGN="middle">
+ <FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#FFFFFF"><B><SMALL>Category: Editorial
+</SMALL></B></FONT></FONT></TD><TD ALIGN="right">
+
+</TD></TR></TABLE>
+<HR WIDTH="0" SIZE="0">
+
+
+<TABLE CELLSPACING="0" CELLPADDING="2" WIDTH="97%" BORDER="0" BGCOLOR="#000000"><TR><TD COLSPAN="2">
+<TABLE CELLSPACING="0" CELLPADDING="3" WIDTH="100%" BORDER="0" BGCOLOR="#FFFFFF">
+<TR><TD><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+<B><FONT SIZE="+2">RabbIT 2.0.2</FONT></B><BR>
+<SMALL><B><A HREF="mailto:d94-rol at nada.kth.se">Ernimril</A> - January 29th 2000, 18:29 EST</B></SMALL>
+<DIV ALIGN="justify"><P>RabbIt is the mutating, caching webproxy which is used to speed up surfing over slow links like modems. It does this by removing advertising and background images and scaling down images to low quality JPEGs. RabbIT is written in Java and should be able to run on any platform. It does depend upon an image converter if imagescaleing is on. The recommended image converter is "convert" from the ImageMagick package.</DIV>
+<P><B>Changes:</B> Fixes have been made for a few bugs concerning keep alive and the HTTP response header, a bug with NT and cache directories, a bug concerning requests without a response body, a bug in GZIPHandler that caused it to not gzip already compressed (gzip or compress) streams, a bug in HTTPHeader regarding response phrases that are multiline, and a few bugs in ImageHandler and NCache. GZIPHandler has been built as an intermediate(*) to FilterHandler (this means that it is possible to gzip text/plain, etc., without filtering those streams) uuencoding has been added to the Coder, RabbIT now uses HTTP/1.1, HTMLParser now compiles cleanly with Jikes, and GeneralHeader has been created to allow for HTTPFooter (which is useful when sending chunked data).
+<P><B>Urgency:</B> low
+<P ALIGN="right"><B>[ <A HREF="/news/2000/01/29/949188564.html">comments (0)</A> ]</B>
+</FONT></TD></TR></TABLE></TD></TR><TR><TD VALIGN="middle">
+ <FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#FFFFFF"><B><SMALL>License: freely distributable</SMALL></B><BR>
+<B><SMALL> Category: <A HREF="/appindex/daemons/proxy.html"><FONT COLOR="#FFFFFF">Daemons/Proxy</FONT></A></SMALL></B></FONT></FONT></TD><TD ALIGN="right">
+<A HREF="http://apps.freshmeat.net/download/902659138/"><IMG SRC="image6" WIDTH="21" HEIGHT="21" BORDER="0" ALT="download"></A> <A HREF="http://apps.freshmeat.net/homepage/902659138/"><IMG SRC="image5" WIDTH="21" HEIGHT="21" BORDER="0" ALT="homepage"></A> <A HREF="/appindex/1998/08/09/902659138.html"><IMG SRC="image7" WIDTH="21" HEIGHT="21" BORDER="0" ALT="appindex record"></A>
+</TD></TR></TABLE>
+<HR WIDTH="0" SIZE="0">
+
+
+<TABLE CELLSPACING="0" CELLPADDING="2" WIDTH="97%" BORDER="0" BGCOLOR="#000000"><TR><TD COLSPAN="2">
+<TABLE CELLSPACING="0" CELLPADDING="3" WIDTH="100%" BORDER="0" BGCOLOR="#FFFFFF">
+<TR><TD><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+<B><FONT SIZE="+2">nmpg 1.1.3</FONT></B><BR>
+<SMALL><B><A HREF="mailto:narkos at linuxmail.org">Joel Lindau</A> - January 29th 2000, 18:18 EST</B></SMALL>
+<DIV ALIGN="justify"><P>nmpg is a small command-driven frontend and network-jukebox for mpg123.</DIV>
+<P><B>Changes:</B> Bugfixes, better memory managment, a new .nmpgrc parser, and new options.
+<P><B>Urgency:</B> low
+<P ALIGN="right"><B>[ <A HREF="/news/2000/01/29/949187896.html">comments (0)</A> ]</B>
+</FONT></TD></TR></TABLE></TD></TR><TR><TD VALIGN="middle">
+ <FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#FFFFFF"><B><SMALL>License: OpenSource</SMALL></B><BR>
+<B><SMALL> Category: <A HREF="/appindex/console/sound.html"><FONT COLOR="#FFFFFF">Console/Sound</FONT></A></SMALL></B></FONT></FONT></TD><TD ALIGN="right">
+<A HREF="http://apps.freshmeat.net/download/935430877/"><IMG SRC="image6" WIDTH="21" HEIGHT="21" BORDER="0" ALT="download"></A> <A HREF="http://apps.freshmeat.net/homepage/935430877/"><IMG SRC="image5" WIDTH="21" HEIGHT="21" BORDER="0" ALT="homepage"></A> <A HREF="http://apps.freshmeat.net/changelog/935430877/"><IMG SRC="image8" WIDTH="21" HEIGHT="21" BORDER="0" ALT="changelog"></A> <A HREF="/appindex/1999/08/23/935430877.html"><IMG SRC="image7" WIDTH="21" HEIGHT="21" BORDER="0" ALT="appindex record"></A>
+</TD></TR></TABLE>
+<HR WIDTH="0" SIZE="0">
+
+
+<TABLE CELLSPACING="0" CELLPADDING="2" WIDTH="97%" BORDER="0" BGCOLOR="#000000"><TR><TD COLSPAN="2">
+<TABLE CELLSPACING="0" CELLPADDING="3" WIDTH="100%" BORDER="0" BGCOLOR="#FFFFFF">
+<TR><TD><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+<B><FONT SIZE="+2">mod_dtcl 0.7.3</FONT></B><BR>
+<SMALL><B><A HREF="mailto:davidw at prosa.it">David Welton</A> - January 29th 2000, 18:11 EST</B></SMALL>
+<DIV ALIGN="justify"><P>Mod_dtcl is a free/open source implementation of server-parsed Tcl under Apache. It allows you to tightly integrate HTML with Tcl, a widely-used scripting language with many years of development invested in it. There are also many external Tcl modules that you can load into mod_dtcl, to create images, access databases, etc.</DIV>
+<P><B>Changes:</B> A major overhaul of header handling and internal buffering, and the addition of the ability to handle binary data.
+<P><B>Urgency:</B> low
+<P ALIGN="right"><B>[ <A HREF="/news/2000/01/29/949187471.html">comments (0)</A> ]</B>
+</FONT></TD></TR></TABLE></TD></TR><TR><TD VALIGN="middle">
+ <FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#FFFFFF"><B><SMALL>License: GPL</SMALL></B><BR>
+<B><SMALL> Category: <A HREF="/appindex/web/development.html"><FONT COLOR="#FFFFFF">Web/Development</FONT></A></SMALL></B></FONT></FONT></TD><TD ALIGN="right">
+<A HREF="http://apps.freshmeat.net/download/917925309/"><IMG SRC="image6" WIDTH="21" HEIGHT="21" BORDER="0" ALT="download"></A> <A HREF="http://apps.freshmeat.net/homepage/917925309/"><IMG SRC="image5" WIDTH="21" HEIGHT="21" BORDER="0" ALT="homepage"></A> <A HREF="http://apps.freshmeat.net/changelog/917925309/"><IMG SRC="image8" WIDTH="21" HEIGHT="21" BORDER="0" ALT="changelog"></A> <A HREF="/appindex/1999/02/01/917925309.html"><IMG SRC="image7" WIDTH="21" HEIGHT="21" BORDER="0" ALT="appindex record"></A>
+</TD></TR></TABLE>
+<HR WIDTH="0" SIZE="0">
+
+
+<TABLE CELLSPACING="0" CELLPADDING="2" WIDTH="97%" BORDER="0" BGCOLOR="#000000"><TR><TD COLSPAN="2">
+<TABLE CELLSPACING="0" CELLPADDING="3" WIDTH="100%" BORDER="0" BGCOLOR="#FFFFFF">
+<TR><TD><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+<B><FONT SIZE="+2">CoreLinux++ 0.4.6</FONT></B><BR>
+<SMALL><B><A HREF="mailto:frankc at users.sourceforge.net">Frank V. Castellucci</A> - January 29th 2000, 18:07 EST</B></SMALL>
+<DIV ALIGN="justify"><P>CoreLinux++ is an initiative to normalize methods and conventions for OOA/OOD/C++ development for Linux, materialized in a set of Open Source C++ class libraries (libcorelinux++ and libcoreframework++) to support common patterns and exploit the C++ standards.</DIV>
+<P><B>Changes:</B> This release adds AbstractFactory and AssociativeIterator analysis, design, implementations, test code, a CVS daily tarball, a Patch Submission facility and updated FAQ, Web Pages, and defect reporting guidelines.
+<P><B>Urgency:</B> medium
+<P ALIGN="right"><B>[ <A HREF="/news/2000/01/29/949187233.html">comments (0)</A> ]</B>
+</FONT></TD></TR></TABLE></TD></TR><TR><TD VALIGN="middle">
+ <FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#FFFFFF"><B><SMALL>License: LGPL</SMALL></B><BR>
+<B><SMALL> Category: <A HREF="/appindex/development/libraries.html"><FONT COLOR="#FFFFFF">Development/Libraries</FONT></A></SMALL></B></FONT></FONT></TD><TD ALIGN="right">
+<A HREF="http://apps.freshmeat.net/download/944077775/"><IMG SRC="image6" WIDTH="21" HEIGHT="21" BORDER="0" ALT="download"></A> <A HREF="http://apps.freshmeat.net/homepage/944077775/"><IMG SRC="image5" WIDTH="21" HEIGHT="21" BORDER="0" ALT="homepage"></A> <A HREF="http://apps.freshmeat.net/changelog/944077775/"><IMG SRC="image8" WIDTH="21" HEIGHT="21" BORDER="0" ALT="changelog"></A> <A HREF="/appindex/1999/12/01/944077775.html"><IMG SRC="image7" WIDTH="21" HEIGHT="21" BORDER="0" ALT="appindex record"></A>
+</TD></TR></TABLE>
+<HR WIDTH="0" SIZE="0">
+
+
+<TABLE CELLSPACING="0" CELLPADDING="2" WIDTH="97%" BORDER="0" BGCOLOR="#000000"><TR><TD COLSPAN="2">
+<TABLE CELLSPACING="0" CELLPADDING="3" WIDTH="100%" BORDER="0" BGCOLOR="#FFFFFF">
+<TR><TD><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+<B><FONT SIZE="+2">scribe 0.2</FONT></B><BR>
+<SMALL><B><A HREF="mailto:kahlage at logoncafe.net">ChromeBob</A> - January 29th 2000, 12:12 EST</B></SMALL>
+<DIV ALIGN="justify"><P>scribe writes functions prototypes for your C code, so you don't have to. It also compares unique functions between source code files and will 'extern' when appropriate. C++ methods support is also planned.</DIV>
+<P><B>Changes:</B> A fix for an fflush() bug and better documentation.
+<P><B>Urgency:</B> low
+<P ALIGN="right"><B>[ <A HREF="/news/2000/01/29/949165962.html">comments (0)</A> ]</B>
+</FONT></TD></TR></TABLE></TD></TR><TR><TD VALIGN="middle">
+ <FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#FFFFFF"><B><SMALL>License: GPL</SMALL></B><BR>
+<B><SMALL> Category: <A HREF="/appindex/development/tools.html"><FONT COLOR="#FFFFFF">Development/Tools</FONT></A></SMALL></B></FONT></FONT></TD><TD ALIGN="right">
+<A HREF="http://apps.freshmeat.net/download/946661656/"><IMG SRC="image6" WIDTH="21" HEIGHT="21" BORDER="0" ALT="download"></A> <A HREF="http://apps.freshmeat.net/homepage/946661656/"><IMG SRC="image5" WIDTH="21" HEIGHT="21" BORDER="0" ALT="homepage"></A> <A HREF="/appindex/1999/12/31/946661656.html"><IMG SRC="image7" WIDTH="21" HEIGHT="21" BORDER="0" ALT="appindex record"></A>
+</TD></TR></TABLE>
+<HR WIDTH="0" SIZE="0">
+
+
+<TABLE CELLSPACING="0" CELLPADDING="2" WIDTH="97%" BORDER="0" BGCOLOR="#000000"><TR><TD COLSPAN="2">
+<TABLE CELLSPACING="0" CELLPADDING="3" WIDTH="100%" BORDER="0" BGCOLOR="#FFFFFF">
+<TR><TD><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+<B><FONT SIZE="+2">E theme updater 0.1</FONT></B><BR>
+<SMALL><B><A HREF="mailto:hallvar at ii.uib.no">Hallvar Helleseth</A> - January 29th 2000, 12:04 EST</B></SMALL>
+<DIV ALIGN="justify"><P>E theme Updater is a bash script to automatically update all of your Enlightenment themes from e.themes.org.</DIV>
+<P><B>Changes:</B> Initial release.
+
+<P ALIGN="right"><B>[ <A HREF="/news/2000/01/29/949165472.html">comments (0)</A> ]</B>
+</FONT></TD></TR></TABLE></TD></TR><TR><TD VALIGN="middle">
+ <FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#FFFFFF"><B><SMALL>License: GPL</SMALL></B><BR>
+<B><SMALL> Category: <A HREF="/appindex/console/misc.html"><FONT COLOR="#FFFFFF">Console/Misc</FONT></A></SMALL></B></FONT></FONT></TD><TD ALIGN="right">
+<A HREF="http://apps.freshmeat.net/download/949164501/"><IMG SRC="image6" WIDTH="21" HEIGHT="21" BORDER="0" ALT="download"></A> <A HREF="http://apps.freshmeat.net/homepage/949164501/"><IMG SRC="image5" WIDTH="21" HEIGHT="21" BORDER="0" ALT="homepage"></A> <A HREF="/appindex/2000/01/29/949164501.html"><IMG SRC="image7" WIDTH="21" HEIGHT="21" BORDER="0" ALT="appindex record"></A>
+</TD></TR></TABLE>
+<HR WIDTH="0" SIZE="0">
+
+
+<TABLE CELLSPACING="0" CELLPADDING="2" WIDTH="97%" BORDER="0" BGCOLOR="#000000"><TR><TD COLSPAN="2">
+<TABLE CELLSPACING="0" CELLPADDING="3" WIDTH="100%" BORDER="0" BGCOLOR="#FFFFFF">
+<TR><TD><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+<B><FONT SIZE="+2">Powertweak-Linux 0.1.7</FONT></B><BR>
+<SMALL><B><A HREF="mailto:dave at denial.force9.co.uk">Dave Jones</A> - January 29th 2000, 12:03 EST</B></SMALL>
+<DIV ALIGN="justify"><P>Powertweak-Linux is a port of the Microsoft Windows tool of the same name rewritten from the ground up. Its main function is to tune your system to its optimal performance settings. Currently, it tunes PCI chipsets and can set /proc/sys entries.</DIV>
+<P><B>Changes:</B> A major GUI overhaul, the ability to generate configuration files, extended PCI information tabs, extra information support for the Matrox G200, and numerous other bugfixes & improvements.
+<P><B>Urgency:</B> low
+<P ALIGN="right"><B>[ <A HREF="/news/2000/01/29/949165416.html">comments (2)</A> ]</B>
+</FONT></TD></TR></TABLE></TD></TR><TR><TD VALIGN="middle">
+ <FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#FFFFFF"><B><SMALL>License: GPL</SMALL></B><BR>
+<B><SMALL> Category: <A HREF="/appindex/console/system.html"><FONT COLOR="#FFFFFF">Console/System</FONT></A></SMALL></B></FONT></FONT></TD><TD ALIGN="right">
+<A HREF="http://apps.freshmeat.net/download/930836224/"><IMG SRC="image6" WIDTH="21" HEIGHT="21" BORDER="0" ALT="download"></A> <A HREF="http://apps.freshmeat.net/homepage/930836224/"><IMG SRC="image5" WIDTH="21" HEIGHT="21" BORDER="0" ALT="homepage"></A> <A HREF="http://apps.freshmeat.net/changelog/930836224/"><IMG SRC="image8" WIDTH="21" HEIGHT="21" BORDER="0" ALT="changelog"></A> <A HREF="/appindex/1999/07/01/930836224.html"><IMG SRC="image7" WIDTH="21" HEIGHT="21" BORDER="0" ALT="appindex record"></A>
+</TD></TR></TABLE>
+<HR WIDTH="0" SIZE="0">
+
+
+<TABLE CELLSPACING="0" CELLPADDING="2" WIDTH="97%" BORDER="0" BGCOLOR="#000000"><TR><TD COLSPAN="2">
+<TABLE CELLSPACING="0" CELLPADDING="3" WIDTH="100%" BORDER="0" BGCOLOR="#FFFFFF">
+<TR><TD><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+<B><FONT SIZE="+2">Pexeso Beta</FONT></B><BR>
+<SMALL><B><A HREF="mailto:pavolkrigler at pobox.sk">Pavol Krigler</A> - January 29th 2000, 11:55 EST</B></SMALL>
+<DIV ALIGN="justify"><P>pexeso is a simple graphic card game for one or two players.</DIV>
+<P><B>Changes:</B> Initial public release.
+
+<P ALIGN="right"><B>[ <A HREF="/news/2000/01/29/949164956.html">comments (0)</A> ]</B>
+</FONT></TD></TR></TABLE></TD></TR><TR><TD VALIGN="middle">
+ <FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#FFFFFF"><B><SMALL>License: Freeware</SMALL></B><BR>
+<B><SMALL> Category: <A HREF="/appindex/console/games.html"><FONT COLOR="#FFFFFF">Console/Games</FONT></A></SMALL></B></FONT></FONT></TD><TD ALIGN="right">
+<A HREF="http://apps.freshmeat.net/download/949141436/"><IMG SRC="image6" WIDTH="21" HEIGHT="21" BORDER="0" ALT="download"></A> <A HREF="http://apps.freshmeat.net/homepage/949141436/"><IMG SRC="image5" WIDTH="21" HEIGHT="21" BORDER="0" ALT="homepage"></A> <A HREF="/appindex/2000/01/29/949141436.html"><IMG SRC="image7" WIDTH="21" HEIGHT="21" BORDER="0" ALT="appindex record"></A>
+</TD></TR></TABLE>
+<HR WIDTH="0" SIZE="0">
+
+
+<TABLE CELLSPACING="0" CELLPADDING="2" WIDTH="97%" BORDER="0" BGCOLOR="#000000"><TR><TD COLSPAN="2">
+<TABLE CELLSPACING="0" CELLPADDING="3" WIDTH="100%" BORDER="0" BGCOLOR="#FFFFFF">
+<TR><TD><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+<B><FONT SIZE="+2">XZX 2.9.2</FONT></B><BR>
+<SMALL><B><A HREF="mailto:Erik.Kunze at fantasy.muc.de">E. Kunze</A> - January 29th 2000, 11:54 EST</B></SMALL>
+<DIV ALIGN="justify"><P>XZX is a portable emulator of ZX Spectrum 48K/128K/+3 (8-bit home computers made by Sir Clive Sinclair) and Pentagon/Scorpion (Spectrum clones made in Russia) for machines running UNIX and the X Window system. XZX is completely written in C and emulates Spectrum 48K, 128K, +2 and +3, Pentagon and Scorpion, Interface I with up to 8 microdrives, Multiface 128 and Multiface 3, BetaDisk 128 interface by Technology Research Ltd with 4 disk drives, +D interface by Miles Gordon Technology with 2 disk drives, Kempston mouse, Kempston joystick and built-in machine code monitor.</DIV>
+<P><B>Changes:</B> Lots of feature improvement and bug fixes. Most parts of the audio support has been rewritten for different UNICES.
+<P><B>Urgency:</B> low
+<P ALIGN="right"><B>[ <A HREF="/news/2000/01/29/949164896.html">comments (0)</A> ]</B>
+</FONT></TD></TR></TABLE></TD></TR><TR><TD VALIGN="middle">
+ <FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#FFFFFF"><B><SMALL>License: Shareware</SMALL></B><BR>
+<B><SMALL> Category: <A HREF="/appindex/x11/emulators.html"><FONT COLOR="#FFFFFF">X11/Emulators</FONT></A></SMALL></B></FONT></FONT></TD><TD ALIGN="right">
+<A HREF="http://apps.freshmeat.net/download/936956384/"><IMG SRC="image6" WIDTH="21" HEIGHT="21" BORDER="0" ALT="download"></A> <A HREF="http://apps.freshmeat.net/homepage/936956384/"><IMG SRC="image5" WIDTH="21" HEIGHT="21" BORDER="0" ALT="homepage"></A> <A HREF="http://apps.freshmeat.net/changelog/936956384/"><IMG SRC="image8" WIDTH="21" HEIGHT="21" BORDER="0" ALT="changelog"></A> <A HREF="/appindex/1999/09/10/936956384.html"><IMG SRC="image7" WIDTH="21" HEIGHT="21" BORDER="0" ALT="appindex record"></A>
+</TD></TR></TABLE>
+<HR WIDTH="0" SIZE="0">
+
+
+<TABLE CELLSPACING="0" CELLPADDING="2" WIDTH="97%" BORDER="0" BGCOLOR="#000000"><TR><TD COLSPAN="2">
+<TABLE CELLSPACING="0" CELLPADDING="3" WIDTH="100%" BORDER="0" BGCOLOR="#FFFFFF">
+<TR><TD><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+<B><FONT SIZE="+2">DistroLib 0.4</FONT></B><BR>
+<SMALL><B><A HREF="mailto:phir at gcu-squad.org">PhiR</A> - January 29th 2000, 11:54 EST</B></SMALL>
+<DIV ALIGN="justify"><P>DistroLib is an abstraction library designed to make the development of distributed application easier. Its main target is currently compute-bound tasks based on a one server, many clients model (much like distributed.net), but it is quite generic and could be used for any client/server app. It is lightweight, easy-to-use, and relies heavily on threads.</DIV>
+<P><B>Changes:</B> Important bug fixes and command history support.
+<P><B>Urgency:</B> low
+<P ALIGN="right"><B>[ <A HREF="/news/2000/01/29/949164869.html">comments (0)</A> ]</B>
+</FONT></TD></TR></TABLE></TD></TR><TR><TD VALIGN="middle">
+ <FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#FFFFFF"><B><SMALL>License: GPL</SMALL></B><BR>
+<B><SMALL> Category: <A HREF="/appindex/development/libraries.html"><FONT COLOR="#FFFFFF">Development/Libraries</FONT></A></SMALL></B></FONT></FONT></TD><TD ALIGN="right">
+<A HREF="http://apps.freshmeat.net/download/942588431/"><IMG SRC="image6" WIDTH="21" HEIGHT="21" BORDER="0" ALT="download"></A> <A HREF="http://apps.freshmeat.net/homepage/942588431/"><IMG SRC="image5" WIDTH="21" HEIGHT="21" BORDER="0" ALT="homepage"></A> <A HREF="http://apps.freshmeat.net/changelog/942588431/"><IMG SRC="image8" WIDTH="21" HEIGHT="21" BORDER="0" ALT="changelog"></A> <A HREF="/appindex/1999/11/14/942588431.html"><IMG SRC="image7" WIDTH="21" HEIGHT="21" BORDER="0" ALT="appindex record"></A>
+</TD></TR></TABLE>
+<HR WIDTH="0" SIZE="0">
+
+
+<TABLE CELLSPACING="0" CELLPADDING="2" WIDTH="97%" BORDER="0" BGCOLOR="#000000"><TR><TD COLSPAN="2">
+<TABLE CELLSPACING="0" CELLPADDING="3" WIDTH="100%" BORDER="0" BGCOLOR="#FFFFFF">
+<TR><TD><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+<B><FONT SIZE="+2">ToutDoux 1.1.7</FONT></B><BR>
+<SMALL><B><A HREF="mailto:yeupou at altern.org">yeupou</A> - January 29th 2000, 11:54 EST</B></SMALL>
+<DIV ALIGN="justify"><P>ToutDoux is a project manager which lets you design a plan of action using a tree structure, with translations in French and English.</DIV>
+<P><B>Changes:</B> A new menu and XML standard for save files.
+<P><B>Urgency:</B> low
+<P ALIGN="right"><B>[ <A HREF="/news/2000/01/29/949164843.html">comments (0)</A> ]</B>
+</FONT></TD></TR></TABLE></TD></TR><TR><TD VALIGN="middle">
+ <FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#FFFFFF"><B><SMALL>License: GPL</SMALL></B><BR>
+<B><SMALL> Category: <A HREF="/appindex/gnome/tools.html"><FONT COLOR="#FFFFFF">GNOME/Tools</FONT></A></SMALL></B></FONT></FONT></TD><TD ALIGN="right">
+<A HREF="http://apps.freshmeat.net/download/944433411/"><IMG SRC="image6" WIDTH="21" HEIGHT="21" BORDER="0" ALT="download"></A> <A HREF="http://apps.freshmeat.net/homepage/944433411/"><IMG SRC="image5" WIDTH="21" HEIGHT="21" BORDER="0" ALT="homepage"></A> <A HREF="/appindex/1999/12/05/944433411.html"><IMG SRC="image7" WIDTH="21" HEIGHT="21" BORDER="0" ALT="appindex record"></A>
+</TD></TR></TABLE>
+<HR WIDTH="0" SIZE="0">
+
+
+<TABLE CELLSPACING="0" CELLPADDING="2" WIDTH="97%" BORDER="0" BGCOLOR="#000000"><TR><TD COLSPAN="2">
+<TABLE CELLSPACING="0" CELLPADDING="3" WIDTH="100%" BORDER="0" BGCOLOR="#FFFFFF">
+<TR><TD><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+<B><FONT SIZE="+2">goMP 1.0.3</FONT></B><BR>
+<SMALL><B><A HREF="mailto:dioxine at poulet.org">Gautier</A> - January 29th 2000, 11:52 EST</B></SMALL>
+<DIV ALIGN="justify"><P>goMP is a set of CGI scripts that allows you to remotely control, via a Web browser, a computer acting as an MP3 jukebox. This program is very useful for someone who's got a dedicated computer with a lot of MP3 files but that doesn't have any output and input devices except network and sound card. It's main advantages are built-in cataloging, fast access to music, and no special software needed on the client side.</DIV>
+<P><B>Changes:</B> Bugfixes, a password-protected config page, basic search function, easier installation thanks to an install script, and relocation of HTML docs and CGIs to a subdirectory.
+<P><B>Urgency:</B> medium
+<P ALIGN="right"><B>[ <A HREF="/news/2000/01/29/949164772.html">comments (0)</A> ]</B>
+</FONT></TD></TR></TABLE></TD></TR><TR><TD VALIGN="middle">
+ <FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#FFFFFF"><B><SMALL>License: Artistic</SMALL></B><BR>
+<B><SMALL> Category: <A HREF="/appindex/web/tools.html"><FONT COLOR="#FFFFFF">Web/Tools</FONT></A></SMALL></B></FONT></FONT></TD><TD ALIGN="right">
+<A HREF="http://apps.freshmeat.net/download/948492962/"><IMG SRC="image6" WIDTH="21" HEIGHT="21" BORDER="0" ALT="download"></A> <A HREF="http://apps.freshmeat.net/homepage/948492962/"><IMG SRC="image5" WIDTH="21" HEIGHT="21" BORDER="0" ALT="homepage"></A> <A HREF="http://apps.freshmeat.net/changelog/948492962/"><IMG SRC="image8" WIDTH="21" HEIGHT="21" BORDER="0" ALT="changelog"></A> <A HREF="/appindex/2000/01/21/948492962.html"><IMG SRC="image7" WIDTH="21" HEIGHT="21" BORDER="0" ALT="appindex record"></A>
+</TD></TR></TABLE>
+<HR WIDTH="0" SIZE="0">
+
+
+<TABLE CELLSPACING="0" CELLPADDING="2" WIDTH="97%" BORDER="0" BGCOLOR="#000000"><TR><TD COLSPAN="2">
+<TABLE CELLSPACING="0" CELLPADDING="3" WIDTH="100%" BORDER="0" BGCOLOR="#FFFFFF">
+<TR><TD><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+<B><FONT SIZE="+2">APSEND 1.40</FONT></B><BR>
+<SMALL><B><A HREF="mailto:sventek at gmx.net">M.K.</A> - January 29th 2000, 11:50 EST</B></SMALL>
+<DIV ALIGN="justify"><P>APSEND is a TCP/IP packet sender to test firewalls and other network applications. It also includes a syn flood option, the land DoS attack, and a DoS attack against tcpdump running on a UNIX-based system. Future updates will include support for a scripting language to construct TCP packets and a few more options and protocols like UDP and ICMP. A port of APSEND from Perl to C is planned as well.</DIV>
+<P><B>Changes:</B> The stream attack, bugfixes, and rewrites for parts of the code.
+<P><B>Urgency:</B> low
+<P ALIGN="right"><B>[ <A HREF="/news/2000/01/29/949164633.html">comments (0)</A> ]</B>
+</FONT></TD></TR></TABLE></TD></TR><TR><TD VALIGN="middle">
+ <FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#FFFFFF"><B><SMALL>License: GPL</SMALL></B><BR>
+<B><SMALL> Category: <A HREF="/appindex/console/networking.html"><FONT COLOR="#FFFFFF">Console/Networking</FONT></A></SMALL></B></FONT></FONT></TD><TD ALIGN="right">
+<A HREF="http://apps.freshmeat.net/download/941654429/"><IMG SRC="image6" WIDTH="21" HEIGHT="21" BORDER="0" ALT="download"></A> <A HREF="http://apps.freshmeat.net/homepage/941654429/"><IMG SRC="image5" WIDTH="21" HEIGHT="21" BORDER="0" ALT="homepage"></A> <A HREF="http://apps.freshmeat.net/changelog/941654429/"><IMG SRC="image8" WIDTH="21" HEIGHT="21" BORDER="0" ALT="changelog"></A> <A HREF="/appindex/1999/11/03/941654429.html"><IMG SRC="image7" WIDTH="21" HEIGHT="21" BORDER="0" ALT="appindex record"></A>
+</TD></TR></TABLE>
+<HR WIDTH="0" SIZE="0">
+
+
+<TABLE CELLSPACING="0" CELLPADDING="2" WIDTH="97%" BORDER="0" BGCOLOR="#000000"><TR><TD COLSPAN="2">
+<TABLE CELLSPACING="0" CELLPADDING="3" WIDTH="100%" BORDER="0" BGCOLOR="#FFFFFF">
+<TR><TD><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+<B><FONT SIZE="+2">ecasound 1.6.12r10</FONT></B><BR>
+<SMALL><B><A HREF="mailto:kaiv at wakkanet.fi">Kai Vehmanen</A> - January 29th 2000, 11:48 EST</B></SMALL>
+<DIV ALIGN="justify"><P>Ecasound is a software package designed for multitrack audio processing. It can be used for simple tasks like audio playback, recording and format conversions, as well as for multitrack effect processing, mixing, recording and signal recycling. Ecasound supports a wide range of audio inputs, outputs and effect algorithms. Ecasound has a chain-based design that allows effects to be easily combined both in series and in parallel. Oscillators and MIDI-CCs can be used for controlling effect parameters. Includes a versatile console mode interface, a Qt-based X-interface and various command-line utils suitable for batch processing.</DIV>
+<P><B>Changes:</B> Support for 24- and 32-bit audio formats and for ALSA 0.5, multichannel noisegate, a new 2nd order lowpass filter, some ia-mode commands, and various bugfixes and low-level improvements.
+<P><B>Urgency:</B> low
+<P ALIGN="right"><B>[ <A HREF="/news/2000/01/29/949164529.html">comments (0)</A> ]</B>
+</FONT></TD></TR></TABLE></TD></TR><TR><TD VALIGN="middle">
+ <FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#FFFFFF"><B><SMALL>License: GPL</SMALL></B><BR>
+<B><SMALL> Category: <A HREF="/appindex/console/sound.html"><FONT COLOR="#FFFFFF">Console/Sound</FONT></A></SMALL></B></FONT></FONT></TD><TD ALIGN="right">
+<A HREF="http://apps.freshmeat.net/download/931819147/"><IMG SRC="image6" WIDTH="21" HEIGHT="21" BORDER="0" ALT="download"></A> <A HREF="http://apps.freshmeat.net/homepage/931819147/"><IMG SRC="image5" WIDTH="21" HEIGHT="21" BORDER="0" ALT="homepage"></A> <A HREF="http://apps.freshmeat.net/changelog/931819147/"><IMG SRC="image8" WIDTH="21" HEIGHT="21" BORDER="0" ALT="changelog"></A> <A HREF="/appindex/1999/07/12/931819147.html"><IMG SRC="image7" WIDTH="21" HEIGHT="21" BORDER="0" ALT="appindex record"></A>
+</TD></TR></TABLE>
+<HR WIDTH="0" SIZE="0">
+
+
+<TABLE CELLSPACING="0" CELLPADDING="2" WIDTH="97%" BORDER="0" BGCOLOR="#000000"><TR><TD COLSPAN="2">
+<TABLE CELLSPACING="0" CELLPADDING="3" WIDTH="100%" BORDER="0" BGCOLOR="#FFFFFF">
+<TR><TD><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+<B><FONT SIZE="+2">SCEZ 20000129</FONT></B><BR>
+<SMALL><B><A HREF="mailto:m032 at mbsks.franken.de">endergone Zwiebeltuete</A> - January 29th 2000, 11:46 EST</B></SMALL>
+<DIV ALIGN="justify"><P>SCEZ is a library that should make the handling of smart cards (not memory cards) and card readers as simple as possible and be at the same time small and easily portable. Currently supported are Dumb Mouse, CT-API and Towitoko readers and Schlumberger Cryptoflex, Gemplus GPK4000, GSM SIM and Telesec SigG cards. A PKCS#15 implementation is in the design phase. There are ports to PalmOS and MS-Windows available.</DIV>
+<P><B>Changes:</B> More card and reader drivers, and an application to read out GSM SIM card (phone book and SMS) and write it to the card.
+<P><B>Urgency:</B> low
+<P ALIGN="right"><B>[ <A HREF="/news/2000/01/29/949164394.html">comments (0)</A> ]</B>
+</FONT></TD></TR></TABLE></TD></TR><TR><TD VALIGN="middle">
+ <FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#FFFFFF"><B><SMALL>License: BSD type</SMALL></B><BR>
+<B><SMALL> Category: <A HREF="/appindex/development/libraries.html"><FONT COLOR="#FFFFFF">Development/Libraries</FONT></A></SMALL></B></FONT></FONT></TD><TD ALIGN="right">
+<A HREF="http://apps.freshmeat.net/download/939677525/"><IMG SRC="image6" WIDTH="21" HEIGHT="21" BORDER="0" ALT="download"></A> <A HREF="http://apps.freshmeat.net/homepage/939677525/"><IMG SRC="image5" WIDTH="21" HEIGHT="21" BORDER="0" ALT="homepage"></A> <A HREF="/appindex/1999/10/11/939677525.html"><IMG SRC="image7" WIDTH="21" HEIGHT="21" BORDER="0" ALT="appindex record"></A>
+</TD></TR></TABLE>
+<HR WIDTH="0" SIZE="0">
+
+
+<TABLE CELLSPACING="0" CELLPADDING="2" WIDTH="97%" BORDER="0" BGCOLOR="#000000"><TR><TD COLSPAN="2">
+<TABLE CELLSPACING="0" CELLPADDING="3" WIDTH="100%" BORDER="0" BGCOLOR="#FFFFFF">
+<TR><TD><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+<B><FONT SIZE="+2">Comicq 0.2.0</FONT></B><BR>
+<SMALL><B><A HREF="mailto:terminal6 at submail.net">Terminal6</A> - January 29th 2000, 11:45 EST</B></SMALL>
+<DIV ALIGN="justify"><P>COMICQ is a command line ICQ messaging tool that allows a user to connect to ICQ using your UIN and password, then sends a message to the destination UIN.</DIV>
+<P><B>Changes:</B> Several bugfixes, icq99a compliance, and a new option --ip that allows you to get any user's IP by their UIN.
+<P><B>Urgency:</B> low
+<P ALIGN="right"><B>[ <A HREF="/news/2000/01/29/949164350.html">comments (0)</A> ]</B>
+</FONT></TD></TR></TABLE></TD></TR><TR><TD VALIGN="middle">
+ <FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#FFFFFF"><B><SMALL>License: GPL</SMALL></B><BR>
+<B><SMALL> Category: <A HREF="/appindex/console/communication.html"><FONT COLOR="#FFFFFF">Console/Communication</FONT></A></SMALL></B></FONT></FONT></TD><TD ALIGN="right">
+<A HREF="http://apps.freshmeat.net/download/948389309/"><IMG SRC="image6" WIDTH="21" HEIGHT="21" BORDER="0" ALT="download"></A> <A HREF="http://apps.freshmeat.net/homepage/948389309/"><IMG SRC="image5" WIDTH="21" HEIGHT="21" BORDER="0" ALT="homepage"></A> <A HREF="/appindex/2000/01/20/948389309.html"><IMG SRC="image7" WIDTH="21" HEIGHT="21" BORDER="0" ALT="appindex record"></A>
+</TD></TR></TABLE>
+<HR WIDTH="0" SIZE="0">
+
+
+<TABLE CELLSPACING="0" CELLPADDING="2" WIDTH="97%" BORDER="0" BGCOLOR="#000000"><TR><TD COLSPAN="2">
+<TABLE CELLSPACING="0" CELLPADDING="3" WIDTH="100%" BORDER="0" BGCOLOR="#FFFFFF">
+<TR><TD><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+<B><FONT SIZE="+2">senv 0.2</FONT></B><BR>
+<SMALL><B><A HREF="mailto:kojak at ids.pl">Zbyszek Sobiecki</A> - January 29th 2000, 11:44 EST</B></SMALL>
+<DIV ALIGN="justify"><P>Senv allows you to run programs with a specified environment. It can set uid, gid, root directory, working directory, limits, and environment variables. It is useful in init scripts and as a shell for users for setting resource limits and environment variables. You can create sets of configurations and specify the one to use from command line.</DIV>
+<P><B>Changes:</B> Login shell limits and environment setting for users, permanent resource limits for specified groups of users and environment variables, and other minor bugfixes.
+<P><B>Urgency:</B> low
+<P ALIGN="right"><B>[ <A HREF="/news/2000/01/29/949164259.html">comments (0)</A> ]</B>
+</FONT></TD></TR></TABLE></TD></TR><TR><TD VALIGN="middle">
+ <FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#FFFFFF"><B><SMALL>License: GPL</SMALL></B><BR>
+<B><SMALL> Category: <A HREF="/appindex/console/administration.html"><FONT COLOR="#FFFFFF">Console/Administration</FONT></A></SMALL></B></FONT></FONT></TD><TD ALIGN="right">
+<A HREF="http://apps.freshmeat.net/download/944953892/"><IMG SRC="image6" WIDTH="21" HEIGHT="21" BORDER="0" ALT="download"></A> <A HREF="http://apps.freshmeat.net/changelog/944953892/"><IMG SRC="image8" WIDTH="21" HEIGHT="21" BORDER="0" ALT="changelog"></A> <A HREF="/appindex/1999/12/11/944953892.html"><IMG SRC="image7" WIDTH="21" HEIGHT="21" BORDER="0" ALT="appindex record"></A>
+</TD></TR></TABLE>
+<HR WIDTH="0" SIZE="0">
+
+
+<TABLE CELLSPACING="0" CELLPADDING="2" WIDTH="97%" BORDER="0" BGCOLOR="#000000"><TR><TD COLSPAN="2">
+<TABLE CELLSPACING="0" CELLPADDING="3" WIDTH="100%" BORDER="0" BGCOLOR="#FFFFFF">
+<TR><TD><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+<B><FONT SIZE="+2">XZX 2.9.2</FONT></B><BR>
+<SMALL><B><A HREF="mailto:Erik.Kunze at fantasy.muc.de">E. Kunze</A> - January 29th 2000, 10:55 EST</B></SMALL>
+<DIV ALIGN="justify"><P>XZX is a portable emulator of ZX Spectrum 48K/128K/+3 (8-bit home computers made by Sir Clive Sinclair) and Pentagon/Scorpion (Spectrum clones made in Russia) for machines running UNIX and the X Window system. XZX is completely written in C and emulates Spectrum 48K, 128K, +2 and +3, Pentagon and Scorpion, Interface I with up to 8 microdrives, Multiface 128 and Multiface 3, BetaDisk 128 interface by Technology Research Ltd with 4 disk drives, +D interface by Miles Gordon Technology with 2 disk drives, Kempston mouse, Kempston joystick and built-in machine code monitor.</DIV>
+<P><B>Changes:</B> Lots of feature improvement and bug fixes. Most parts of the audio support has been rewritten for different UNICES.
+<P><B>Urgency:</B> low
+<P ALIGN="right"><B>[ <A HREF="/news/2000/01/29/949161354.html">comments (0)</A> ]</B>
+</FONT></TD></TR></TABLE></TD></TR><TR><TD VALIGN="middle">
+ <FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#FFFFFF"><B><SMALL>License: Shareware</SMALL></B><BR>
+<B><SMALL> Category: <A HREF="/appindex/x11/emulators.html"><FONT COLOR="#FFFFFF">X11/Emulators</FONT></A></SMALL></B></FONT></FONT></TD><TD ALIGN="right">
+<A HREF="http://apps.freshmeat.net/download/936956384/"><IMG SRC="image6" WIDTH="21" HEIGHT="21" BORDER="0" ALT="download"></A> <A HREF="http://apps.freshmeat.net/homepage/936956384/"><IMG SRC="image5" WIDTH="21" HEIGHT="21" BORDER="0" ALT="homepage"></A> <A HREF="http://apps.freshmeat.net/changelog/936956384/"><IMG SRC="image8" WIDTH="21" HEIGHT="21" BORDER="0" ALT="changelog"></A> <A HREF="/appindex/1999/09/10/936956384.html"><IMG SRC="image7" WIDTH="21" HEIGHT="21" BORDER="0" ALT="appindex record"></A>
+</TD></TR></TABLE>
+<HR WIDTH="0" SIZE="0">
+
+
+<P><SMALL><CENTER><B>[ <A HREF="/news/2000/01/29/">full page for today</A> | <A HREF="/news/2000/01/28/">yesterday's edition</A> ]</SMALL></B></CENTER></FONT></TD><TD WIDTH="27%" VALIGN="top" ALIGN="center"><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+
+<TABLE BORDER="0" CELLPADDING="1" CELLSPACING="0" BGCOLOR="#000000" WIDTH="97%"><TR><TD>
+<TABLE WIDTH="100%" BORDER="0" CELLSPACING="1" CELLPADDING="3">
+<TR><TD ALIGN="center" BGCOLOR="#EEEEEE"><B><FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#000000">navigator</FONT></FONT></B></TD></TR><TR><TD BGCOLOR="#FFFFFF"><SMALL><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+- <A HREF="/news/2000/01/29/"><FONT COLOR="#000000">full page for today</FONT></A><BR>
+- <A HREF="/news/2000/01/28/"><FONT COLOR="#000000">yesterday's edition</FONT></A><BR>
+- <A HREF="news://news.freshmeat.net/"><FONT COLOR="#000000"><B>new:</B> fm news via NNTP</FONT></A><BR>
+ </FONT></SMALL></TD></TR></TABLE></TD></TR></TABLE><P>
+<TABLE BORDER="0" CELLPADDING="1" CELLSPACING="0" BGCOLOR="#000000" WIDTH="97%"><TR><TD>
+<TABLE WIDTH="100%" BORDER="0" CELLSPACING="1" CELLPADDING="3">
+<TR><TD ALIGN="center" BGCOLOR="#EEEEEE"><B><FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#000000">eye catcher</FONT></FONT></B></TD></TR><TR><TD BGCOLOR="#FFFFFF"><SMALL><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+<B>Free Shirts</B><BR>We give away a free freshmeat t-shirt every week for the best comment added to an application announcement or story posted on freshmeat.
+<P><B>#freshmeat</B><BR>If you want to chat about what's new on freshmeat and hang out with other fm lounge lizards and the fm staff, head over to #freshmeat on irc.freshmeat.net, part of <A HREF="http://openprojects.nu/">The Open Projects Network</A>.
+ </FONT></SMALL></TD></TR></TABLE></TD></TR></TABLE><P>
+<TABLE BORDER="0" CELLPADDING="1" CELLSPACING="0" BGCOLOR="#000000" WIDTH="97%"><TR><TD>
+<TABLE WIDTH="100%" BORDER="0" CELLSPACING="1" CELLPADDING="3">
+<TR><TD ALIGN="center" BGCOLOR="#EEEEEE"><B><FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#000000">site notes</FONT></FONT></B></TD></TR><TR><TD BGCOLOR="#FFFFFF"><SMALL><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+- <A HREF="/news/2000/01/29/949208399.html"><FONT COLOR="#000000">We should get this out of the door now (Jan 29th)</FONT></A><BR>
+- <A HREF="/news/2000/01/01/946704535.html"><FONT COLOR="#000000">freshmeat Y2K report (Jan 01st)</FONT></A><BR>
+- <A HREF="/news/1999/08/16/934862340.html"><FONT COLOR="#000000">Assorted freshmeat notes (Aug 16th)</FONT></A><BR>
+ </FONT></SMALL></TD></TR></TABLE></TD></TR></TABLE><P>
+<TABLE BORDER="0" CELLPADDING="1" CELLSPACING="0" BGCOLOR="#000000" WIDTH="97%"><TR><TD>
+<TABLE WIDTH="100%" BORDER="0" CELLSPACING="1" CELLPADDING="3">
+<TR><TD ALIGN="center" BGCOLOR="#EEEEEE"><B><FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#000000">recent editorials</FONT></FONT></B></TD></TR><TR><TD BGCOLOR="#FFFFFF"><SMALL><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+- <A HREF="/news/2000/01/29/949208340.html"><FONT COLOR="#000000">Is Linux for Crazies? (Jan 29th)</FONT></A><BR>
+- <A HREF="/news/2000/01/22/948603540.html"><FONT COLOR="#000000">A New Business Plan for Free Software (Jan 22nd)</FONT></A><BR>
+- <A HREF="/news/2000/01/15/947998740.html"><FONT COLOR="#000000">Is Linux Going to Reunite the UNIX Market? (Jan 15th)</FONT></A><BR>
+ </FONT></SMALL></TD></TR></TABLE></TD></TR></TABLE><P>
+<TABLE BORDER="0" CELLPADDING="1" CELLSPACING="0" BGCOLOR="#000000" WIDTH="97%"><TR><TD>
+<TABLE WIDTH="100%" BORDER="0" CELLSPACING="1" CELLPADDING="3">
+<TR><TD ALIGN="center" BGCOLOR="#EEEEEE"><B><FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#000000">andover.net</FONT></FONT></B></TD></TR><TR><TD BGCOLOR="#FFFFFF"><SMALL><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+<BR><CENTER><A HREF="http://andover.net"><IMG SRC="image9" BORDER="0" WIDTH="150" HEIGHT="43" ALT="Mirror Logo"></A></CENTER><P>
+- <A HREF="http://www.animfactory.com/"><FONT COLOR="#000000">Animation Factory</FONT></A><BR>
+- <A HREF="http://www.davecentral.com/"><FONT COLOR="#000000">DaveCentral</FONT></A><BR>
+- <A HREF="http://www.freecode.com/"><FONT COLOR="#000000">FreeCode</FONT></A><BR>
+- <A HREF="http://www.InternetTrafficReport.com/"><FONT COLOR="#000000">Internet Traffic Report</FONT></A><BR>
+- <A HREF="http://www.ITManagersJournal.com/"><FONT COLOR="#000000">IT Manager's Journal</FONT></A><BR>
+- <A HREF="http://www.mediabuilder.com/"><FONT COLOR="#000000">MediaBuilder</FONT></A><BR>
+- <A HREF="http://slashdot.org/"><FONT COLOR="#000000">Slashdot</FONT></A><BR>
+- <A HREF="http://www.slaughterhouse.com/"><FONT COLOR="#000000">Slaughterhouse</FONT></A><BR>
+- <A HREF="http://www.techmailings.com/"><FONT COLOR="#000000">TechMailings</FONT></A><BR>
+- <A HREF="http://www.techsightings.com/"><FONT COLOR="#000000">TechSightings</FONT></A><BR>
+<BR><CENTER><B>E-Commerce</B></CENTER><P>
+- <A HREF="http://www.thinkgeek.com"><FONT COLOR="#000000">ThinkGeek (Stuff for smart masses)</FONT></A><BR>
+ </FONT></SMALL></TD></TR></TABLE></TD></TR></TABLE><P>
+<TABLE BORDER="0" CELLPADDING="1" CELLSPACING="0" BGCOLOR="#000000" WIDTH="97%"><TR><TD>
+<TABLE WIDTH="100%" BORDER="0" CELLSPACING="1" CELLPADDING="3">
+<TR><TD ALIGN="center" BGCOLOR="#EEEEEE"><B><FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#000000">supported sites</FONT></FONT></B></TD></TR><TR><TD BGCOLOR="#FFFFFF"><SMALL><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+- <A HREF="http://www.userfriendly.org"><FONT COLOR="#000000">Userfriendly.org</FONT></A><BR>
+- <A HREF="http://www.securityfocus.com"><FONT COLOR="#000000">SecurityFocus</FONT></A><BR>
+- <A HREF="http://copyleft.net"><FONT COLOR="#000000">copyleft</FONT></A><BR>
+- <A HREF="http://filewatcher.org"><FONT COLOR="#000000">Filewatcher</FONT></A><BR>
+- <A HREF="http://www.linux.com"><FONT COLOR="#000000">Linux.com</FONT></A><BR>
+- <A HREF="http://www.linuxtelephony.org"><FONT COLOR="#000000">LinuxTelephony</FONT></A><BR>
+- <A HREF="http://www.linuxtoday.com"><FONT COLOR="#000000">LinuxToday</FONT></A><BR>
+- <A HREF="http://openprojects.nu/services/irc.html"><FONT COLOR="#000000">Openprojects</FONT></A><BR>
+- <A HREF="http://www.32bitsonline.com"><FONT COLOR="#000000">32bitsonline</FONT></A><BR>
+- <A HREF="http://www.gnu.org"><FONT COLOR="#000000">The GNU Project</FONT></A><BR>
+ </FONT></SMALL></TD></TR></TABLE></TD></TR></TABLE><P>
+<TABLE BORDER="0" CELLPADDING="1" CELLSPACING="0" BGCOLOR="#000000" WIDTH="97%"><TR><TD>
+<TABLE WIDTH="100%" BORDER="0" CELLSPACING="1" CELLPADDING="3">
+<TR><TD ALIGN="center" BGCOLOR="#EEEEEE"><B><FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#000000"><a href="/news/2000/01/29/"><font color="#000000">saturday</font></a></FONT></FONT></B></TD></TR><TR><TD BGCOLOR="#FFFFFF"><SMALL><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+- <A HREF="/news/2000/01/29/949208399.html"><FONT COLOR="#000000">We should get this out of the door now</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949208340.html"><FONT COLOR="#000000">Is Linux for Crazies?</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949188564.html"><FONT COLOR="#000000">RabbIT 2.0.2</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949187896.html"><FONT COLOR="#000000">nmpg 1.1.3</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949187471.html"><FONT COLOR="#000000">mod_dtcl 0.7.3</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949187233.html"><FONT COLOR="#000000">CoreLinux++ 0.4.6</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949165962.html"><FONT COLOR="#000000">scribe 0.2</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949165472.html"><FONT COLOR="#000000">E theme updater 0.1</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949165416.html"><FONT COLOR="#000000">Powertweak-Linux 0.1.7</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949164956.html"><FONT COLOR="#000000">Pexeso Beta</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949164896.html"><FONT COLOR="#000000">XZX 2.9.2</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949164869.html"><FONT COLOR="#000000">DistroLib 0.4</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949164843.html"><FONT COLOR="#000000">ToutDoux 1.1.7</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949164772.html"><FONT COLOR="#000000">goMP 1.0.3</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949164633.html"><FONT COLOR="#000000">APSEND 1.40</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949164529.html"><FONT COLOR="#000000">ecasound 1.6.12r10</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949164394.html"><FONT COLOR="#000000">SCEZ 20000129</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949164350.html"><FONT COLOR="#000000">Comicq 0.2.0</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949164259.html"><FONT COLOR="#000000">senv 0.2</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949161354.html"><FONT COLOR="#000000">XZX 2.9.2</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949161036.html"><FONT COLOR="#000000">log4j 0.7.5</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949156343.html"><FONT COLOR="#000000">SQN Linux 1.6</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949156277.html"><FONT COLOR="#000000">Limo 0.3.2</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949156237.html"><FONT COLOR="#000000">Fusion GS 1.3</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949145887.html"><FONT COLOR="#000000">MMR 1.5.4</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949142835.html"><FONT COLOR="#000000">KUPS 0.3.4</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949142815.html"><FONT COLOR="#000000">3DSE patch for XMMS 4</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949139763.html"><FONT COLOR="#000000">Linux 2.3.41</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949139751.html"><FONT COLOR="#000000">Free Code for Linux S/390</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949135979.html"><FONT COLOR="#000000">CircleMUD 3.0 beta patchlevel 17</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949135938.html"><FONT COLOR="#000000">NiL Isn't Liero 000128</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949135913.html"><FONT COLOR="#000000">OpenSSH Unix Port 1.2.2</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949135889.html"><FONT COLOR="#000000">KBoxes! 1.3</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949135867.html"><FONT COLOR="#000000">phpLanParty 0.23</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949135509.html"><FONT COLOR="#000000">DGen/SDL 1.20</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949135482.html"><FONT COLOR="#000000">EdcomLib 1.0 alpha 5</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949135309.html"><FONT COLOR="#000000">Etherboot 4.4.2</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949135205.html"><FONT COLOR="#000000">BLADE 0.18.0</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949135115.html"><FONT COLOR="#000000">Sapphire 0.13.7</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949135070.html"><FONT COLOR="#000000">ippl 1.99.3</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949134977.html"><FONT COLOR="#000000">Saint 1.5patch1</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949134943.html"><FONT COLOR="#000000">Zircon 1.18.232</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949134927.html"><FONT COLOR="#000000">nmap 2.3BETA14</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949134901.html"><FONT COLOR="#000000">xterm patch #124</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949134817.html"><FONT COLOR="#000000">MyThreads-Links v0.5.2</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949134633.html"><FONT COLOR="#000000">sudo 1.6.2p1</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949134552.html"><FONT COLOR="#000000">MIT Photonic-Bands 0.10</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949134246.html"><FONT COLOR="#000000">Launcher 0.86</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949134179.html"><FONT COLOR="#000000">nano 0.8.1</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949134103.html"><FONT COLOR="#000000">Gtk-- 1.1.8</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949134049.html"><FONT COLOR="#000000">tkchooser 0.65</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949133420.html"><FONT COLOR="#000000">XShipWars 1.33a</FONT></A><BR>
+- <A HREF="/news/2000/01/29/949133280.html"><FONT COLOR="#000000">Lamerpad 0.1</FONT></A><BR>
+ </FONT></SMALL></TD></TR></TABLE></TD></TR></TABLE><P>
+<TABLE BORDER="0" CELLPADDING="1" CELLSPACING="0" BGCOLOR="#000000" WIDTH="97%"><TR><TD>
+<TABLE WIDTH="100%" BORDER="0" CELLSPACING="1" CELLPADDING="3">
+<TR><TD ALIGN="center" BGCOLOR="#EEEEEE"><B><FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#000000"><a href="/news/2000/01/28/"><font color="#000000">friday</font></a></FONT></FONT></B></TD></TR><TR><TD BGCOLOR="#FFFFFF"><SMALL><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+- <A HREF="/news/2000/01/28/949117833.html"><FONT COLOR="#000000">fsv 0.9</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949117711.html"><FONT COLOR="#000000">popsneaker 0.1.1</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949114716.html"><FONT COLOR="#000000">eyep-updater.sh 1.0</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949113240.html"><FONT COLOR="#000000">W3Mail 0.5.0</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949113214.html"><FONT COLOR="#000000">The Urgent Decision 0.9.9</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949112269.html"><FONT COLOR="#000000">LTSP 1.02</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949112198.html"><FONT COLOR="#000000">Production BASIC 0.2.12</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949112123.html"><FONT COLOR="#000000">Postfix 19991231-pl03</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949109732.html"><FONT COLOR="#000000">Mp3 Commander 0.7</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949109324.html"><FONT COLOR="#000000">iManager 1.0.1b</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949108399.html"><FONT COLOR="#000000">Eterm 0.9</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949108308.html"><FONT COLOR="#000000">dqd_dirindex 1.0</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949108087.html"><FONT COLOR="#000000">Tidings 1.0.4</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949108026.html"><FONT COLOR="#000000">localscan 2.1</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949107922.html"><FONT COLOR="#000000">WMKeyboard 0.3</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949107834.html"><FONT COLOR="#000000">fcmp 1.0.2</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949107767.html"><FONT COLOR="#000000">Akkord 0.3.1</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949107649.html"><FONT COLOR="#000000">HiM 0.1.1</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949106305.html"><FONT COLOR="#000000">cdrecord 1.8</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949103400.html"><FONT COLOR="#000000">eMixer 0.05.5</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949103187.html"><FONT COLOR="#000000">FreeVSD 1.4.0</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949103096.html"><FONT COLOR="#000000">Common C++ Libraries 0.0</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949095155.html"><FONT COLOR="#000000">Moonshine 1.0beta2</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949095112.html"><FONT COLOR="#000000">swim 0.3.5</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949095009.html"><FONT COLOR="#000000">Xmame/xmess 0.36b15.1</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949094448.html"><FONT COLOR="#000000">pcmcia-cs 3.1.9</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949091509.html"><FONT COLOR="#000000">gPS 0.5.2</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949091415.html"><FONT COLOR="#000000">Snort 1.5.1</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949090436.html"><FONT COLOR="#000000">Pygmy Linux 0.7 beta</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949090237.html"><FONT COLOR="#000000">Intro to Bash Programming HOWTO 0.3</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949084379.html"><FONT COLOR="#000000">GNU Pth 1.3b2</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949084356.html"><FONT COLOR="#000000">Laonux 0.1</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949084304.html"><FONT COLOR="#000000">x-wvdial 0.12</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949084188.html"><FONT COLOR="#000000">Intro to Bash Programming HOWTO 0.3</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949084106.html"><FONT COLOR="#000000">Catalog 1.02</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949084062.html"><FONT COLOR="#000000">harvest 1.5.20-kj-0.9</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949068306.html"><FONT COLOR="#000000">wmseti 0.3.0a</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949057272.html"><FONT COLOR="#000000">RIG 1.02</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949057019.html"><FONT COLOR="#000000">FreeAddr 0.2</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949056939.html"><FONT COLOR="#000000">GtkAda 1.2.5</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949056664.html"><FONT COLOR="#000000">dot.conf 0.6.0</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949055099.html"><FONT COLOR="#000000">dep.pl 1.28.0</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949054980.html"><FONT COLOR="#000000">Prae's Scripts 1.1</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949044301.html"><FONT COLOR="#000000">Project Clock 0.1</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949044285.html"><FONT COLOR="#000000">Xtheater 0.2.1</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949040013.html"><FONT COLOR="#000000">i-no Chart 0.1</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949039945.html"><FONT COLOR="#000000">spliff 0.8.1</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949038953.html"><FONT COLOR="#000000">Regexx 0.95</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949038316.html"><FONT COLOR="#000000">RBook 0.5.0</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949036742.html"><FONT COLOR="#000000">RIG 1.01</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949036714.html"><FONT COLOR="#000000">wchat 1.2.0</FONT></A><BR>
+- <A HREF="/news/2000/01/28/949036428.html"><FONT COLOR="#000000">PCCS MySQLDatabase Admin Tool 1.2.2</FONT></A><BR>
+ </FONT></SMALL></TD></TR></TABLE></TD></TR></TABLE><P>
+<TABLE BORDER="0" CELLPADDING="1" CELLSPACING="0" BGCOLOR="#000000" WIDTH="97%"><TR><TD>
+<TABLE WIDTH="100%" BORDER="0" CELLSPACING="1" CELLPADDING="3">
+<TR><TD ALIGN="center" BGCOLOR="#EEEEEE"><B><FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#000000"><a href="/news/2000/01/27/"><font color="#000000">thursday</font></a></FONT></FONT></B></TD></TR><TR><TD BGCOLOR="#FFFFFF"><SMALL><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+- <A HREF="/news/2000/01/27/949033332.html"><FONT COLOR="#000000">CADUBI 1.1b1</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949032987.html"><FONT COLOR="#000000">Angus' Chess Clock 0.8.1</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949032555.html"><FONT COLOR="#000000">MP3 Report Generator 1.0.0</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949032518.html"><FONT COLOR="#000000">4DOM 0.9.2</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949032386.html"><FONT COLOR="#000000">4XSLT 0.8.2</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949031346.html"><FONT COLOR="#000000">OpenNaken 1.10</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949025747.html"><FONT COLOR="#000000">iManager 1.0b</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949025168.html"><FONT COLOR="#000000">QuakeForge 0.1.0</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949023271.html"><FONT COLOR="#000000">pylice 0.7.0</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949023250.html"><FONT COLOR="#000000">Solfege 0.6.0</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949023151.html"><FONT COLOR="#000000">xinetd 2.1.8.7p1</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949022849.html"><FONT COLOR="#000000">jac 0.13</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949022803.html"><FONT COLOR="#000000">Xmms 1.0.0</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949022319.html"><FONT COLOR="#000000">KSrnd 0.97</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949021877.html"><FONT COLOR="#000000">getpg / UW-IMAP 0.54</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949021849.html"><FONT COLOR="#000000">getpg 0.53</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949021824.html"><FONT COLOR="#000000">setserial 2.17</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949021250.html"><FONT COLOR="#000000">Pan 0.7.3</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949021216.html"><FONT COLOR="#000000">jwhois 2.4.1</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949021126.html"><FONT COLOR="#000000">Kmp3 1.0</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949020964.html"><FONT COLOR="#000000">xPine 0.0.12</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949019905.html"><FONT COLOR="#000000">Avenger's News System 2.1 Alpha</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949019709.html"><FONT COLOR="#000000">RIG 1.0</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949019321.html"><FONT COLOR="#000000">scroller 1.0</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949018347.html"><FONT COLOR="#000000">Perl EyeP Client 0.1</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949017796.html"><FONT COLOR="#000000">sfront 0.54</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949017631.html"><FONT COLOR="#000000">XFrisk 1.2</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949016202.html"><FONT COLOR="#000000">Moffy 0.0.1</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949015348.html"><FONT COLOR="#000000">Solid POP3 0.14</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949014200.html"><FONT COLOR="#000000">php3guest 1.5</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949013630.html"><FONT COLOR="#000000">crUD 01.27.2000</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949013380.html"><FONT COLOR="#000000">crUD 01.27.2000</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949012979.html"><FONT COLOR="#000000">Free Pascal Compiler 0.99.14</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949012771.html"><FONT COLOR="#000000">gtk-font-hack 0.2-gtk-1.2.6</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949009233.html"><FONT COLOR="#000000">Linux 2.2.15pre5</FONT></A><BR>
+- <A HREF="/news/2000/01/27/949005620.html"><FONT COLOR="#000000">krunseti 0.2.1</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948996446.html"><FONT COLOR="#000000">CompuPic 5.0.1036</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948995905.html"><FONT COLOR="#000000">gfontview 0.3.3</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948995819.html"><FONT COLOR="#000000">authlocal 1.0.2</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948995600.html"><FONT COLOR="#000000">bigwig 1.1</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948995501.html"><FONT COLOR="#000000">CAFire 0.0.11</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948995429.html"><FONT COLOR="#000000">ANVLOGIN 2.0</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948994944.html"><FONT COLOR="#000000">sawmill.el 1.9</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948994810.html"><FONT COLOR="#000000">Perlsh 20000127</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948994776.html"><FONT COLOR="#000000">sitescooper 2.1.2</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948994691.html"><FONT COLOR="#000000">MHDns 1.4</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948994419.html"><FONT COLOR="#000000">JChemPaint 0.5</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948994364.html"><FONT COLOR="#000000">Filesystems HOWTO 0.7.3</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948994343.html"><FONT COLOR="#000000">KSnes9x 1.2</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948993513.html"><FONT COLOR="#000000">Mozilla M13</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948993439.html"><FONT COLOR="#000000">edna 0.3</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948993409.html"><FONT COLOR="#000000">GMasqdialer 0.99.8</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948993341.html"><FONT COLOR="#000000">spliff 0.8</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948992808.html"><FONT COLOR="#000000">MultiSeti 0.3</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948970667.html"><FONT COLOR="#000000">rude 0.50</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948970605.html"><FONT COLOR="#000000">cgi-util++ 0.0</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948970479.html"><FONT COLOR="#000000">Cricket 0.72</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948970458.html"><FONT COLOR="#000000">nuni 0.04</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948970379.html"><FONT COLOR="#000000">Ksetiwatch 0.3.0</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948970358.html"><FONT COLOR="#000000">SiteMgrYAP 0.1.2</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948970322.html"><FONT COLOR="#000000">phpLanParty 0.21</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948970285.html"><FONT COLOR="#000000">Glitter Newsreader 0.1</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948970263.html"><FONT COLOR="#000000">Fastresolve 2.4</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948970164.html"><FONT COLOR="#000000">ColdSync 1.1.2</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948970080.html"><FONT COLOR="#000000">DDD 3.2</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948970032.html"><FONT COLOR="#000000">X Northern Captain 4.2.1</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948969919.html"><FONT COLOR="#000000">abcde 1.0.2</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948969659.html"><FONT COLOR="#000000">Gnapster 1.3.2</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948969551.html"><FONT COLOR="#000000">xmix 1.0 Alpha</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948969488.html"><FONT COLOR="#000000">gtktetcolor 0.3</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948969412.html"><FONT COLOR="#000000">muttzilla 0.40</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948969395.html"><FONT COLOR="#000000">muttzilla 0.40</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948969337.html"><FONT COLOR="#000000">asp2php 0.73.6</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948969217.html"><FONT COLOR="#000000">mod_ticket 1.0</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948969078.html"><FONT COLOR="#000000">MegaHAL for Eggdrop .01</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948968456.html"><FONT COLOR="#000000">Jetty 2.3.5</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948968386.html"><FONT COLOR="#000000">xlpotdb 1.0</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948968341.html"><FONT COLOR="#000000">Koala Complete MUD Server 0.1.1a</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948968255.html"><FONT COLOR="#000000">mcountd 0.4</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948967933.html"><FONT COLOR="#000000">cdbackup 0.5.0</FONT></A><BR>
+- <A HREF="/news/2000/01/27/948967908.html"><FONT COLOR="#000000">The Java SSH/Telnet Application/Applet 2.0 RC1</FONT></A><BR>
+ </FONT></SMALL></TD></TR></TABLE></TD></TR></TABLE><P>
+<TABLE BORDER="0" CELLPADDING="1" CELLSPACING="0" BGCOLOR="#000000" WIDTH="97%"><TR><TD>
+<TABLE WIDTH="100%" BORDER="0" CELLSPACING="1" CELLPADDING="3">
+<TR><TD ALIGN="center" BGCOLOR="#EEEEEE"><B><FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#000000"><a href="http://slashdot.org"><font color="#000000">slashdot</font></a></FONT></FONT></B></TD></TR><TR><TD BGCOLOR="#FFFFFF"><SMALL><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+- <A HREF="http://slashdot.org/article.pl?sid=00/01/29/1534255"><FONT COLOR="#000000">Petition Apple for Linux QuickTime</FONT></A><BR>
+- <A HREF="http://slashdot.org/article.pl?sid=00/01/29/1223249"><FONT COLOR="#000000">GNUstep 0.6.5 freeze</FONT></A><BR>
+- <A HREF="http://slashdot.org/article.pl?sid=00/01/28/2324203"><FONT COLOR="#000000">YETI at Home</FONT></A><BR>
+- <A HREF="http://slashdot.org/article.pl?sid=00/01/29/1024215"><FONT COLOR="#000000">Documents Unsealed in Microsoft/Caldera Case</FONT></A><BR>
+- <A HREF="http://slashdot.org/article.pl?sid=00/01/29/0837235"><FONT COLOR="#000000">Who Bought Linux.Net?</FONT></A><BR>
+- <A HREF="http://slashdot.org/article.pl?sid=00/01/24/1146250"><FONT COLOR="#000000">E-Mails from (Over?) The Edge</FONT></A><BR>
+- <A HREF="http://slashdot.org/article.pl?sid=00/01/29/0834223"><FONT COLOR="#000000">Linux Kernel 2.3.41</FONT></A><BR>
+- <A HREF="http://slashdot.org/article.pl?sid=00/01/28/2311232"><FONT COLOR="#000000">Congress Still Figuring Out E-Mail</FONT></A><BR>
+- <A HREF="http://slashdot.org/article.pl?sid=00/01/22/1946244"><FONT COLOR="#000000">Sci Fi Literature 101?</FONT></A><BR>
+- <A HREF="http://slashdot.org/article.pl?sid=00/01/28/2318246"><FONT COLOR="#000000">Could Distributed.Net Help the Mars Polar Lander?</FONT></A><BR>
+ </FONT></SMALL></TD></TR></TABLE></TD></TR></TABLE><P>
+<TABLE BORDER="0" CELLPADDING="1" CELLSPACING="0" BGCOLOR="#000000" WIDTH="97%"><TR><TD>
+<TABLE WIDTH="100%" BORDER="0" CELLSPACING="1" CELLPADDING="3">
+<TR><TD ALIGN="center" BGCOLOR="#EEEEEE"><B><FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#000000"><a href="http://www.securityfocus.com"><font color="#000000">securityfocus</font></a></FONT></FONT></B></TD></TR><TR><TD BGCOLOR="#FFFFFF"><SMALL><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+- <A HREF="http://www.securityfocus.com/level2/?go=news&id=http://www.zdnet.com/zdnn/stories/news/0,4586,2429334,00.html?chkpt=zdnntop"><FONT COLOR="#000000">Win2000 security hole a 'major threat'</FONT></A><BR>
+- <A HREF="http://www.securityfocus.com/level2/?go=news&id=http://www.computerworld.com/home/print.nsf/all/000128e45a"><FONT COLOR="#000000">Visa acknowledges cracker break-ins</FONT></A><BR>
+- <A HREF="http://www.securityfocus.com/level2/?go=news&id=http://www.zdnet.com/sr/stories/column/0,4712,2429536,00.html"><FONT COLOR="#000000">What's Wrong With Microsoft Security?</FONT></A><BR>
+- <A HREF="http://www.securityfocus.com/level2/?go=news&id=http://www.zdnet.com/pcweek/stories/news/0,4153,2429334,00.html"><FONT COLOR="#000000">Microsoft posts first Win2K security patch</FONT></A><BR>
+- <A HREF="http://www.securityfocus.com/level2/?go=tools&id=1018"><FONT COLOR="#000000">Libnids 1.12</FONT></A><BR>
+- <A HREF="http://www.securityfocus.com/level2/?go=news&id=http://www.theregister.co.uk/000127-000005.html"><FONT COLOR="#000000">New hack attack is greater threat than imagined</FONT></A><BR>
+- <A HREF="http://www.securityfocus.com/level2/?go=news&id=http://www.mercurycenter.com/svtech/news/indepth/docs/hacker012700.htm"><FONT COLOR="#000000">Student charged with hacking</FONT></A><BR>
+- <A HREF="http://www.securityfocus.com/level2/?go=library&id=63"><FONT COLOR="#000000">Building and Managing Virtual Private Networks (book)</FONT></A><BR>
+- <A HREF="http://www.securityfocus.com/level2/?go=library&id=111"><FONT COLOR="#000000">Threats, Vulnerabilities and Real-Worl Responses: The Foundations of the TruSecure Process</FONT></A><BR>
+- <A HREF="http://www.securityfocus.com/level2/?go=library&id=1701"><FONT COLOR="#000000">The Hundredth Window : Protecting Your Privacy and Security in the Age of the Internet (boo</FONT></A><BR>
+ </FONT></SMALL></TD></TR></TABLE></TD></TR></TABLE><P>
+<TABLE BORDER="0" CELLPADDING="1" CELLSPACING="0" BGCOLOR="#000000" WIDTH="97%"><TR><TD>
+<TABLE WIDTH="100%" BORDER="0" CELLSPACING="1" CELLPADDING="3">
+<TR><TD ALIGN="center" BGCOLOR="#EEEEEE"><B><FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#000000"><a href="http://www.bebits.com"><font color="#000000">bebits</font></a></FONT></FONT></B></TD></TR><TR><TD BGCOLOR="#FFFFFF"><SMALL><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+- <A HREF="http://www.bebits.com/app/706/"><FONT COLOR="#000000">Pe 3.0a3</FONT></A><BR>
+- <A HREF="http://www.bebits.com/app/757/"><FONT COLOR="#000000">Rarscript 1.5</FONT></A><BR>
+- <A HREF="http://www.bebits.com/app/736/"><FONT COLOR="#000000">CD Manager 0.66a beta</FONT></A><BR>
+- <A HREF="http://www.bebits.com/app/174/"><FONT COLOR="#000000">TraX 1.1</FONT></A><BR>
+- <A HREF="http://www.bebits.com/app/785/"><FONT COLOR="#000000">BeMath 1.2.2</FONT></A><BR>
+- <A HREF="http://www.bebits.com/app/784/"><FONT COLOR="#000000">simple blackjack 1</FONT></A><BR>
+- <A HREF="http://www.bebits.com/app/758/"><FONT COLOR="#000000">HtmlTree 0.5.3</FONT></A><BR>
+- <A HREF="http://www.bebits.com/app/783/"><FONT COLOR="#000000">Yacp 0.1</FONT></A><BR>
+- <A HREF="http://www.bebits.com/app/222/"><FONT COLOR="#000000">TicTacToe 1.5</FONT></A><BR>
+- <A HREF="http://www.bebits.com/app/706/"><FONT COLOR="#000000">Pe 3.0a2</FONT></A><BR>
+ </FONT></SMALL></TD></TR></TABLE></TD></TR></TABLE><P>
+<TABLE BORDER="0" CELLPADDING="1" CELLSPACING="0" BGCOLOR="#000000" WIDTH="97%"><TR><TD>
+<TABLE WIDTH="100%" BORDER="0" CELLSPACING="1" CELLPADDING="3">
+<TR><TD ALIGN="center" BGCOLOR="#EEEEEE"><B><FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#000000"><a href="http://linuxtoday.com"><font color="#000000">linuxtoday</font></a></FONT></FONT></B></TD></TR><TR><TD BGCOLOR="#FFFFFF"><SMALL><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+- <A HREF="http://linuxtoday.com/story.php3?sn=15878"><FONT COLOR="#000000">Linux Journal: KDE--The Next Generation</FONT></A><BR>
+- <A HREF="http://linuxtoday.com/story.php3?sn=15876"><FONT COLOR="#000000">Kernel Cousin gimp-devel #11 Is Out</FONT></A><BR>
+- <A HREF="http://linuxtoday.com/story.php3?sn=15875"><FONT COLOR="#000000">Infoworld: Corel Linux OS ideal for the desktop</FONT></A><BR>
+- <A HREF="http://linuxtoday.com/story.php3?sn=15874"><FONT COLOR="#000000">Technology Evaluation: IBM Jumps on the Linux Bandwagon with Both Feet, Sort Of</FONT></A><BR>
+- <A HREF="http://linuxtoday.com/story.php3?sn=15873"><FONT COLOR="#000000">Tobias Hövekamp: European Union acknowledges</FONT></A><BR>
+- <A HREF=""><FONT COLOR="#000000">&</FONT></A><BR>
+- <A HREF=""><FONT COLOR="#000000">#34;Open Source Software</FONT></A><BR>
+- <A HREF=""><FONT COLOR="#000000">&</FONT></A><BR>
+- <A HREF=""><FONT COLOR="#000000">#34;</FONT></A><BR>
+ </FONT></SMALL></TD></TR></TABLE></TD></TR></TABLE><P>
+<TABLE BORDER="0" CELLPADDING="1" CELLSPACING="0" BGCOLOR="#000000" WIDTH="97%"><TR><TD>
+<TABLE WIDTH="100%" BORDER="0" CELLSPACING="1" CELLPADDING="3">
+<TR><TD ALIGN="center" BGCOLOR="#EEEEEE"><B><FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#000000"><a href="http://www.linuxtelephony.org"><font color="#000000">linuxtelephony</font></a></FONT></FONT></B></TD></TR><TR><TD BGCOLOR="#FFFFFF"><SMALL><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+- <A HREF="http://www.linuxtelephony.org/article.cgi?i=208&r=0"><FONT COLOR="#000000">Traverse Technologies releases NETspider-U in US</FONT></A><BR>
+- <A HREF="http://www.linuxtelephony.org/article.cgi?i=207&r=0"><FONT COLOR="#000000">Quicknet releases new GPL'd Linux Drivers!</FONT></A><BR>
+- <A HREF="http://www.linuxtelephony.org/article.cgi?i=206&r=0"><FONT COLOR="#000000">Natural Microsystems Delivers Carrier-Class Linux</FONT></A><BR>
+- <A HREF="http://www.linuxtelephony.org/article.cgi?i=205&r=0"><FONT COLOR="#000000">Quicknet is hiring programmers of all kinds!</FONT></A><BR>
+- <A HREF="http://www.linuxtelephony.org/article.cgi?i=204&r=0"><FONT COLOR="#000000">Babylon MLPPP Software Released under GPL</FONT></A><BR>
+- <A HREF="http://www.linuxtelephony.org/article.cgi?i=202&r=0"><FONT COLOR="#000000">Linux Telephony Server Project?</FONT></A><BR>
+- <A HREF="http://www.linuxtelephony.org/article.cgi?i=203&r=0"><FONT COLOR="#000000">Vovida Networks to Hire Telephony Software Engineers</FONT></A><BR>
+- <A HREF="http://www.linuxtelephony.org/article.cgi?i=200&r=0"><FONT COLOR="#000000">SPIRO-Linux Introduces Web-Enabled Phone Administration</FONT></A><BR>
+- <A HREF="http://www.linuxtelephony.org/article.cgi?i=199&r=0"><FONT COLOR="#000000">LinuxTelephony sponsors area at LinuxFest 2000</FONT></A><BR>
+- <A HREF="http://www.linuxtelephony.org/article.cgi?i=198&r=0"><FONT COLOR="#000000">GSM-Mobile Switching Center (MSC) with Linux-PC</FONT></A><BR>
+ </FONT></SMALL></TD></TR></TABLE></TD></TR></TABLE><P>
+<TABLE BORDER="0" CELLPADDING="1" CELLSPACING="0" BGCOLOR="#000000" WIDTH="97%"><TR><TD>
+<TABLE WIDTH="100%" BORDER="0" CELLSPACING="1" CELLPADDING="3">
+<TR><TD ALIGN="center" BGCOLOR="#EEEEEE"><B><FONT FACE="Lucida,Verdana,Helvetica,Arial"><FONT COLOR="#000000"><a href="http://www.32bitsonline.com"><font color="#000000">32bitsonline</font></a></FONT></FONT></B></TD></TR><TR><TD BGCOLOR="#FFFFFF"><SMALL><FONT FACE="Lucida,Verdana,Helvetica,Arial">
+- <A HREF="http://www.32bitsonline.com/article.php3?file=issues/200001/homeworld&page=1
+"><FONT COLOR="#000000">Game: Homeworld</FONT></A><BR>
+- <A HREF="http://www.32bitsonline.com/news.php3?news=news/200001/nb200001271a&page=1
+"><FONT COLOR="#000000">DVD Lawsuit Spreads Its Own 'Trade Secrets'</FONT></A><BR>
+- <A HREF="http://www.32bitsonline.com/news.php3?news=news/200001/nb200001272&page=1
+"><FONT COLOR="#000000">Register.com Adds 'One-step' Domain Registration</FONT></A><BR>
+- <A HREF="http://www.32bitsonline.com/article.php3?file=issues/200001/webevent&page=1
+"><FONT COLOR="#000000">WebEvent: Keeping you organized</FONT></A><BR>
+- <A HREF="http://www.32bitsonline.com/news.php3?news=news/200001/nb200001273a&page=1
+"><FONT COLOR="#000000">Y2K Officers Defend $100 Bil Investment</FONT></A><BR>
+- <A HREF="http://www.32bitsonline.com/article.php3?file=issues/200001/jan2000_john_berger&page=1
+"><FONT COLOR="#000000">DON'T BE FOOLED</FONT></A><BR>
+- <A HREF="http://www.32bitsonline.com/news.php3?news=news/200001/nb200001274&page=1
+"><FONT COLOR="#000000">Microsoft Scorns Think-Tank's Breakup Idea</FONT></A><BR>
+- <A HREF="http://www.32bitsonline.com/news.php3?news=news/200001/nb200001275a&page=1
+"><FONT COLOR="#000000">Yahoo Accused Of Stalking Internet Users</FONT></A><BR>
+- <A HREF="http://www.32bitsonline.com/news.php3?news=news/200001/nb200001276a&page=1
+"><FONT COLOR="#000000">eToys.com Settles Spat With Swiss Artist Group</FONT></A><BR>
+- <A HREF="http://www.32bitsonline.com/
+"><FONT COLOR="#000000">[more articles/news]</FONT></A><BR>
+ </FONT></SMALL></TD></TR></TABLE></TD></TR></TABLE><P>
+<BR><BR></FONT>
+</TD></TR></TABLE>
+<TABLE WIDTH="100%" CELLPADDING="0" CELLSPACING="0" BORDER="0">
+<TR BGCOLOR="#000000"><TD><IMG SRC="image4" WIDTH="1" HEIGHT="2" ALT=""></TD></TR></TABLE>
+</CENTER>
+<TABLE CELLSPACING="0" CELLPADDING="2" WIDTH="100%" BORDER="0"><TR>
+<TD VALIGN="top" ALIGN="center"><FONT FACE="Lucida,Verdana,Helvetica,Arial"><SMALL>copyright © 1997-2000 <A HREF="http://andover.net">Andover.Net</A> -
+icons courtesy of <A HREF="mailto:tigert at gimp.org">tigert at gimp.org</A> -
+code revision <A HREF="http://freshmeat.net/ChangeLog">20000101</A> -
+our <A HREF="http://www.andover.net/privacy.html">privacy policy</A></SMALL></FONT></TD>
+</TR></TABLE>
+</BODY>
+</HTML>
+
+
diff --git a/tests/style.bt b/tests/style.bt
index efe73f0..4b1cecc 100644
--- a/tests/style.bt
+++ b/tests/style.bt
@@ -2,7 +2,7 @@
#------------------------------------------------------------------------
# This is a "warm-body" test for the events module.
#
-::browsertest::do_test style.1 -timeout 10000000 -html {
+do_browser_test style.1 -timeout 10000000 -html {
<BODY>
<DIV id="div">
</DIV>
@@ -12,7 +12,7 @@
return div.style.borderTopWidth
} -expected ""
-::browsertest::do_test style.2 -timeout 10000000 -html {
+do_browser_test style.2 -timeout 10000000 -html {
<BODY>
<DIV id="div" style="border-top-width: 22px;">
</DIV>
@@ -22,10 +22,10 @@
return div.style.borderTopWidth
} -expected 22px
-::browsertest::do_test style.3 -timeout 10000000 -javascript {
+do_browser_test style.3 -timeout 10000000 -javascript {
return parseInt("")
} -expected NaN
-::browsertest::do_test style.4 -timeout 10000000 -javascript {
+do_browser_test style.4 -timeout 10000000 -javascript {
var b = 8911
b = b - parseInt("")
return b
diff --git a/tests/style.test b/tests/style.test
index 8c6c531..4d3a3bf 100644
--- a/tests/style.test
+++ b/tests/style.test
@@ -471,5 +471,48 @@ tcltest::test style-10.1 {} -body {
set res
} -result [list normal 10px 130px 2.00 normal]
+#----------------------------------------------------------------------------
+# The following tests - style-10.* - test property and override method.
+#
+tcltest::test style-11.1 {} -body {
+ .h reset
+ .h parse -final {
+ <html>
+ <body>
+ <div id="outer">
+ <h2>foo</h2>
+ <div id="inner" style="background: none repeat scroll 0% 0%">bar</div>
+ baz</div>
+ </body>
+ </html>
+ }
+ pack .h
+ set n [.h search {div[id="inner"]}]
+ # wish: ./src/htmlprop.c:3035: HtmlNodeGetProperty:
+ # Assertion `eProp <= 108' failed.
+ $n property background
+} -result [list none repeat scroll 0% 0%]
+
+tcltest::test style-11.2 {} -body {
+ $n override
+} -result {}
+
+tcltest::test style-11.3 {} -body {
+ # Missusing of trailing ':'
+ set res [$n override {background-color: red}]
+ after idle [list set ::wait 1]
+ vwait ::wait
+ # wish: ./src/htmlprop.c:300: getPropertyDef:
+ # Assertion `eProp >= 0' failed.
+ set res
+} -result {background-color: red}
+
+tcltest::test style-11.4 {} -body {
+ set res [$n override {background-color red}]
+} -result {background-color red}
+
+
+#----------------------------------------------------------------------
+
finish_test
diff --git a/tests/tkhtml.tcl b/tests/tkhtml.tcl
new file mode 100644
index 0000000..04f36b1
--- /dev/null
+++ b/tests/tkhtml.tcl
@@ -0,0 +1,115 @@
+#
+# tkhtml.tcl --
+#
+# This file contains:
+#
+# - The default bindings for the Html widget, and
+# - Some Tcl functions used by the stylesheet html.css.
+#
+# ------------------------------------------------------------------------
+#
+# Copyright (c) 2005 Eolas Technologies Inc.
+# All rights reserved.
+#
+# This Open Source project was made possible through the financial support
+# of Eolas Technologies Inc.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions are met:
+#
+# * Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# * Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+# * Neither the name of the <ORGANIZATION> nor the names of its
+# contributors may be used to endorse or promote products derived from
+# this software without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+# POSSIBILITY OF SUCH DAMAGE.
+#
+
+# Default bindings
+#
+# bind Html <ButtonPress> { focus %W }
+bind Html <KeyPress-Up> { %W yview scroll -1 units }
+bind Html <KeyPress-Down> { %W yview scroll 1 units }
+bind Html <KeyPress-Return> { %W yview scroll 1 units }
+bind Html <KeyPress-Right> { %W xview scroll 1 units }
+bind Html <KeyPress-Left> { %W xview scroll -1 units }
+bind Html <KeyPress-Next> { %W yview scroll 1 pages }
+bind Html <KeyPress-space> { %W yview scroll 1 pages }
+bind Html <KeyPress-Prior> { %W yview scroll -1 pages }
+bind Html <ButtonPress-4> { %W yview scroll -4 units }
+bind Html <ButtonPress-5> { %W yview scroll 4 units }
+
+
+# Some Tcl procs used by html.css
+#
+namespace eval tkhtml {
+ proc len {val} {
+ if {[regexp {^[0-9]+$} $val]} {
+ append val px
+ }
+ return $val
+ }
+
+ proc color {val} {
+ set len [string length $val]
+ if {0==($len % 3) && [regexp {^[0-9a-fA-F]*$} $val]} {
+ return "#$val"
+ }
+ return $val
+ }
+
+ swproc attr {attr {len 0 1} {color 0 1}} {
+ upvar N node
+ set val [$node attr -default "" $attr]
+ if {$val == ""} {error ""}
+ if {$len} {return [len $val]}
+ if {$color} {return [color $val]}
+ return $val
+ }
+
+ swproc aa {tag attr {len 0 1} {if NULL} {color 0 1}} {
+ upvar N node
+ for {} {$node != ""} {set node [$node parent]} {
+ if {[$node tag] == $tag} {
+ if {[catch {$node attr $attr} val]} {error ""}
+
+ if {$if != "NULL"} {return $if}
+ if {$val == ""} {error ""}
+ if {$len} {return [len $val]}
+ if {$color} {return [color $val]}
+ return $val
+ }
+ }
+ error "No such ancestor attribute: $tag $attr"
+ }
+
+ proc create_image_tile {img} {
+ set w [image width $img]
+ set h [image width $img]
+ if {$w <= 0 || $h <= 0} {error "empty image"}
+
+ set tw [expr int(200 / $w) * $w]
+ set th [expr int(200 / $h) * $h]
+ if {$tw == 0} {set tw $w}
+ if {$th == 0} {set th $h}
+
+ set newimg [image create photo]
+ $newimg copy $img -from 0 0 -to 0 0 $tw $th
+ return $newimg
+ }
+}
+
diff --git a/tests/tree.tcl b/tests/tree.tcl
new file mode 100644
index 0000000..b8b27c0
--- /dev/null
+++ b/tests/tree.tcl
@@ -0,0 +1,41 @@
+
+set auto_path [concat . $auto_path]
+package require Tkhtml
+
+# Procedure to return the contents of a file-system entry
+proc readFile {fname} {
+ set ret {}
+ catch {
+ set fd [open $fname]
+ set ret [read $fd]
+ close $fd
+ }
+ return $ret
+}
+
+proc print_tree {node {indent 0}} {
+ if {[$node tag]=="text"} {
+ if {[regexp {^ *$} [$node text]]==0} {
+ puts -nonewline [string repeat " " $indent]
+ puts [$node text]
+ }
+ } else {
+ puts -nonewline [string repeat " " $indent]
+ puts "<[$node tag]>"
+ for {set i 0} {$i < [$node nChildren]} {incr i} {
+ print_tree [$node child $i] [expr $indent+2]
+ }
+ puts -nonewline [string repeat " " $indent]
+ puts "</[$node tag]>"
+ }
+}
+
+html .h
+.h parse [readFile [lindex $argv 0]]
+.h tree build
+set root [.h tree root]
+print_tree $root
+
+exit
+
+
diff --git a/tests/tree1.bt b/tests/tree1.bt
index 2052921..de819b6 100644
--- a/tests/tree1.bt
+++ b/tests/tree1.bt
@@ -3,14 +3,14 @@
# A "warm-body" test to check that the infrastructure is working.
# Count the anchors in a document.
#
-::browsertest::do_test warmbody.1 -timeout 10000000 -html {
+do_browser_test warmbody.1 -html {
<BODY>
<A name="one">One</A>
<A id="two">Two</A> <!-- Not an anchor (no "name" attribute) -->
<A name="three">Three</A>
} -javascript {
return document.anchors.length
-} -expected 2
+}
#----------------------------------------------------------------------
proc body_tree_test {name doc} {
@@ -84,13 +84,21 @@ proc body_tree_test {name doc} {
</SCRIPT>
}
- ::browsertest::do_test $name -timeout 10000000 -html [subst {
+ browsertest $name utf-8 [string trim "
$body_tree_function
$doc
- }] -javascript {
- // return body_tree()
- return dom_tree()
- } -browsers {Hv3 Firefox}
+ <SCRIPT>
+ function browsertest () { return dom_tree() }
+ </SCRIPT>
+ "]
+
+# ::browsertest::do_test $name -timeout 10000000 -html [subst {
+# $body_tree_function
+# $doc
+# }] -javascript {
+# // return body_tree()
+# return dom_tree()
+# } -browsers {Hv3 Firefox}
}
@@ -146,6 +154,11 @@ body_tree_test tables.13 { <BODY> <TBODY><TR><TD><SPAN> }
body_tree_test tables.14 { <BODY> <TABLE><DIV><DIV><SPAN></DIV><SPAN> }
+# This structure is found in the mail.yahoo.com application.
+#
+body_tree_test tables.15 { <TABLE><FORM><TR><TR></TABLE> }
+body_tree_test tables.16 { <TABLE><TBODY><FORM><TR><TR></TABLE> }
+
body_tree_test tree.1 { <BODY> <DIV> }
body_tree_test attr.1 { <BODY> <DIV id="two"> hello }
diff --git a/tools/browsertester.tcl b/tools/browsertester.tcl
new file mode 100644
index 0000000..841ec2c
--- /dev/null
+++ b/tools/browsertester.tcl
@@ -0,0 +1,299 @@
+
+package require Tk
+package require Tkhtml
+
+set ::aBrowser {Hv3 Mozilla}
+array set ::aResult {}
+array set ::anOutstanding {}
+set ::zStatus {}
+
+set ::template {
+HTTP/1.1 200 OK
+Content-type: text/html %ENCODING%
+Cache-Control: no-cache
+
+<HTML>
+ <SCRIPT>
+ function runtest () {
+ var res = browsertest()
+
+ var form = "<FORM action=\"/next\" method=\"GET\" id=\"testform\">"
+ form += "<INPUT type=hidden name=\"testid\" value=\"%TESTID%\"></INPUT>"
+ form += "<INPUT type=hidden name=\"result\" id=\"testresult\"></INPUT>"
+ form += "</FORM>"
+
+ document.body.innerHTML = form
+
+ document.getElementById("testresult").value = res
+ document.getElementById("testform").submit()
+ }
+
+ onload = runtest
+ </SCRIPT>
+
+ %TESTBODY%
+
+</BODY>
+}
+
+set ::template2 {
+HTTP/1.1 200 OK
+Content-type: text/html
+Cache-Control: no-cache
+
+<HTML>
+<BODY>
+
+ Tests finished. <A href="/">Click here</A> to rerun.
+
+</BODY>
+}
+
+proc log {args} {
+ .text.t insert end "[join $args]\n"
+ .text.t yview end
+}
+
+proc listen_for_connections {} {
+ socket -server new_connection -myaddr 127.0.0.1 8080
+}
+
+proc new_connection {channel clientaddr clientport} {
+ fconfigure $channel -translation crlf
+
+ # Read the request line:
+ set request [gets $channel]
+
+ # Read HTTP headers until we figure out which browser this is.
+ #
+ while {[set line [gets $channel]] ne ""} {
+ set idx [string first : $line]
+ if {$idx > 0} {
+ set hdr [string range $line 0 [expr {$idx-1}]]
+ switch -exact -- [string tolower $hdr] {
+ user-agent {
+ foreach browser $::aBrowser {
+ if {[string first $browser $line] >= 0} {
+ set zBrowser $browser
+ break
+ }
+ }
+ # If we couldn't identify the browser, drop the connection.
+ #
+ if {![info exists zBrowser]} {
+ log $line
+ log "Failed to identify browser. Disconnecting."
+ close $channel
+ return
+ }
+ }
+ }
+ }
+ # log $line
+ }
+
+ set zPath [lindex [split $request " "] 1]
+ log "$browser : $zPath "
+
+ fconfigure $channel -encoding binary -translation binary
+ if {$zPath eq "/"} {
+ # Send the first test to the browser.
+ #
+ set ::anOutstanding($zBrowser) [llength $::tests]
+ send_test $channel 0
+ set_status
+ } elseif {[string first /next $zPath] == 0} {
+
+ set idx [string first ? $zPath]
+ set fields [string range $zPath [expr {$idx+1}] end]
+ foreach field [split $fields &] {
+ foreach {name value} [split $field =] break
+ set $name $value
+ }
+
+ set ::aResult($zBrowser,$testid) [::tkhtml::decode $result]
+ log "$zBrowser,$testid \"[::tkhtml::decode $result]\""
+
+ send_test $channel [expr {$testid+1}]
+ incr ::anOutstanding($zBrowser) -1
+ set_status
+
+ } elseif {[string first /tcl $zPath] == 0} {
+
+ array set aParam [list]
+
+ set idx [string first ? $zPath]
+ set fields [string range $zPath [expr {$idx+1}] end]
+ foreach field [split $fields &] {
+ foreach {name value} [split $field =] break
+ set aParam([::tkhtml::decode $name]) [::tkhtml::decode $value]
+ }
+
+ eval $aParam(script) $channel
+ return
+ } else {
+ after idle {error "URI NO GOOD!"}
+ }
+
+ close $channel
+}
+
+proc send_test {channel testid} {
+ if {$testid == [llength $::tests]} {
+ puts -nonewline $channel [string trim $::template2]
+ } else {
+ set enc [lindex $::tests $testid 1]
+ if {$enc ne ""} {set enc "; charset=$enc"}
+ set map [list \
+ %TESTID% $testid \
+ %ENCODING% $enc \
+ %TESTBODY% [lindex $::tests $testid 2] \
+ ]
+ puts -nonewline $channel [string map $map [string trim $::template]]
+ }
+}
+
+proc setup_gui {} {
+ frame .gotos
+ button .gotos.hv3 -text "Signal Hv3" -command [list send hv3_main.tcl {
+ [gui_current hv3] goto http://localhost:8080/ -cachecontrol no-cache
+ }]
+ button .gotos.firefox -text "Signal Firefox" -command [list exec \
+ firefox -remote "openurl(http://localhost:8080/,new-tab)"
+ ]
+ pack .gotos.hv3 -side left
+ pack .gotos.firefox -side left
+
+ frame .text
+ text .text.t
+ scrollbar .text.s -orient vertical
+ .text.t configure -yscrollcommand [list .text.s set]
+ .text.s configure -command [list .text.t yview]
+
+ frame .buttons
+ button .buttons.quit -command press_quit -text "Quit"
+ button .buttons.report -command press_report -text "Report"
+ button .buttons.clear -command [list .text.t delete 0.0 end] -text "Clear"
+ button .buttons.reload -command press_reload -text "Reload"
+ label .buttons.status -textvariable ::zStatus
+
+ pack .buttons.quit -side left
+ pack .buttons.report -side left
+ pack .buttons.clear -side left
+ pack .buttons.reload -side right
+ pack .buttons.status -side left -fill x
+
+ pack .text.t -side left -fill both -expand true
+ pack .text.s -side left -fill y
+
+ pack .gotos -side top -fill x
+ pack .buttons -side bottom -fill x
+ pack .text -side top -fill both -expand true
+}
+
+proc press_quit {} {
+ exit
+}
+
+proc press_report {} {
+ .text.t delete 0.0 end
+ set nMatch 0
+
+ for {set ii 0} {$ii < [llength $::tests]} {incr ii} {
+
+ set result_list [list]
+ foreach {k v} [array get ::aResult "*,$ii"] {lappend result_list $v}
+ set result_list [lsort $result_list]
+ if {
+ [llength $result_list] != [llength $::aBrowser] ||
+ [lindex $result_list 0] ne [lindex $result_list end]
+ } {
+ log "Test [lindex $::tests $ii 0] Failed: "
+ foreach browser $::aBrowser {
+ set res NR
+ if {[info exists ::aResult($browser,$ii)]} {
+ set res "\"$::aResult($browser,$ii)\""
+ }
+ log [format " % -10s %s" "$browser:" $res]
+ }
+ } else {
+ incr nMatch
+ }
+ }
+
+ log ""
+ log "$nMatch tests were successful"
+ log "[expr [llength $::tests] - $nMatch] tests failed"
+}
+
+proc set_status {} {
+ set z "Outstanding requests: "
+ foreach browser $::aBrowser {
+ if {![info exists ::anOutstanding($browser)]} {
+ set ::anOutstanding($browser) [llength $::tests]
+ }
+ append z "$browser - $::anOutstanding($browser) "
+ }
+ set ::zStatus $z
+}
+
+set ::tests [list]
+proc browsertest {name encoding code} {
+ lappend ::tests [list $name $encoding $code]
+}
+proc do_browser_test {name args} {
+
+ # Argument processing:
+ #
+ set opts(-html) ""
+ set opts(-encoding) ""
+ set opts(-timeout) 1000000
+ array set opts $args
+ if {![info exists opts(-javascript)]} {
+ error "Missing mandatory -javascript option"
+ }
+ foreach option [array names opts] {
+ switch -- $option {
+ -browsers {}
+ -timeout {}
+ -html {}
+ -javascript {}
+ -expected {}
+ -encoding {}
+ default {
+ error "Unknown option: $option"
+ }
+ }
+ }
+
+ browsertest $name $opts(-encoding) "
+ <SCRIPT>
+ function browsertest () { $opts(-javascript) }
+ </SCRIPT>
+ $opts(-html)
+ "
+}
+
+setup_gui
+
+proc press_reload {} {
+ .text.t delete 0.0 end
+ array unset ::anOutstanding
+ array unset ::aResult
+ set ::tests [list]
+ foreach zFile $::argv {
+ set nTest [llength $::tests]
+ source $zFile
+ log "Loaded [expr [llength $::tests]-$nTest] from $zFile"
+ }
+
+ log "Loaded 2 internal warmbody tests."
+ do_browser_test warmbody-1 -javascript { return "hello" }
+ do_browser_test warmbody-2 -javascript { return "world" }
+
+ set_status
+}
+
+press_reload
+listen_for_connections
+
diff --git a/tools/changelog_to_list b/tools/changelog_to_list
new file mode 100755
index 0000000..e8f13a6
--- /dev/null
+++ b/tools/changelog_to_list
@@ -0,0 +1,162 @@
+#!/bin/sh
+# -*-tcl-*-
+# the next line restarts using tclsh \
+exec tclsh "${0}" "${@}"
+
+####################################
+# Parse a ChangeLog files into a tcl structure.
+
+proc main {} {
+ global argv
+ set in [lindex $argv 0]
+ set out [cl:parse [read [set fh [open $in r]]][close $fh]]
+
+ #puts [join $out \n] -- Test code
+ #exit
+ puts $out
+}
+
+proc cl:parse {data} {
+ set state unknown
+ set chunk(date) {}
+ set chunk(person) {}
+ set chunk(items) {}
+ set idata {}
+
+ foreach line [split $data \n] {
+ if {[cl:parse:chunk_intro $line date person]} {
+ cl:parse:close_last_item
+ cl:parse:close_last_chunk
+ cl:parse:init_chunk $date $person
+ continue
+ }
+ if {[cl:parse:item_line $line data]} {
+ cl:parse:close_last_item
+ cl:parse:init_item $data
+ continue
+ }
+ if {[cl:parse:item_followup $line data]} {
+ cl:parse:add2item $data
+ continue
+ }
+ # ignore all other lines.
+ }
+
+ cl:parse:close_last_item
+ cl:parse:close_last_chunk
+
+ return $result
+}
+
+proc cl:parse:chunk_intro {line datevar personvar} {
+ if {![regexp "^\[^\t \]" $line]} {
+ return 0
+ }
+
+ upvar $datevar d $personvar p
+
+ if {[regexp -indices -- {^([0-9]+-[0-9-]+)} $line -> di]} {
+ foreach {da de} $di break ; # lassign
+
+ regsub -all "\[ \t\]+" [string trim [string range $line $da $de]] { } d
+ regsub -all "\[ \t\]+" [string trim [string range $line [incr de] end]] { } p
+
+ #puts stderr "$line +--> ($d | $p)"
+
+ return 1
+ }
+
+ regsub -all "\[\t \]+" $line { } line
+
+ set line [split $line]
+ set d [join [lrange $line 0 4]]
+ set p [join [lrange $line 5 end]]
+
+ #puts stderr "$line |--> ($d | $p)"
+
+ return 1
+}
+
+proc cl:parse:close_last_chunk {} {
+ upvar result r chunk c
+
+ if {$c(date) != {}} {
+ lappend r [list $c(date) $c(person) $c(items)]
+ set c(date) {}
+ set c(person) {}
+ set c(items) {}
+
+ }
+ return
+}
+
+proc cl:parse:init_chunk {date person} {
+ upvar chunk c
+ set c(date) $date
+ set c(person) $person
+ set c(items) {}
+ return
+}
+
+proc cl:parse:item_line {line itemvar} {
+ if {![regexp "^\[\t \]+\\*" $line]} {
+ return 0
+ }
+
+ upvar $itemvar i
+
+ set line [string trimleft [string trimright $line] "\t *"]
+ set i $line
+ return 1
+}
+
+if {0} {
+ return 1
+}
+
+proc cl:parse:close_last_item {} {
+ upvar chunk c idata i
+
+ if {$i != {}} {
+ set ke [string first : $i]
+ if {$ke < 0} {
+ set ke -1 ; # No key at all, pure comment
+ }
+
+ set k [string trim [string range $i 0 [incr ke -1]]]
+ set co [string trim [string range $i [incr ke 2] end]]
+
+ lappend c(items) [list $k $co]
+ set i {}
+
+ }
+ return
+}
+
+proc cl:parse:init_item {comment} {
+ upvar idata i
+ set i $comment
+ return
+}
+
+proc cl:parse:item_followup {line commentvar} {
+ upvar $commentvar c
+
+ set line [string trim $line]
+ if {$line == {}} {
+ return 0
+ }
+
+ set c $line
+ return 1
+}
+
+proc cl:parse:add2item {comment} {
+ upvar idata i
+ append i " $comment"
+}
+
+##########################################################
+
+main
+exit 0
diff --git a/tools/check_manifest b/tools/check_manifest
new file mode 100644
index 0000000..a64ad36
--- /dev/null
+++ b/tools/check_manifest
@@ -0,0 +1,30 @@
+#!/usr/local/bin/tclsh
+# -*- tcl -*-
+# check the manifest against the current contents of the directory
+
+set manifest [lindex $argv 0]
+
+rename file ori_file
+proc file {name} {
+ global files
+ set files($name) 1
+ if {! [ori_file exists $name]} {
+ puts stdout "missing: $name"
+ }
+}
+
+# read manifest and check existence of all listed files
+source $manifest
+
+
+# now backwards: find all files and check
+# for files not listed in the manifest
+
+set list [exec find . -print]
+regsub -all "\n" $list { } list
+
+foreach f $list {
+ if {[catch {set files($f)}]} {
+ puts stdout "new: $f"
+ }
+}
diff --git a/tools/crontab.sourceforge b/tools/crontab.sourceforge
new file mode 100755
index 0000000..9490096
--- /dev/null
+++ b/tools/crontab.sourceforge
@@ -0,0 +1,9 @@
+#
+# (c) 2001, Andreas Kupries <andreas_kupries at users.sourceforge.net>
+#
+# Hourly cron job to regenerate the dynamic parts of the
+# memchan website.
+#
+
+28 * * * * /home/groups/m/me/memchan/tools/htdocs_refresh
+17 6 * * * /home/groups/m/me/memchan/tools/watch_cvs
diff --git a/tools/expand b/tools/expand
new file mode 100755
index 0000000..23a4d95
--- /dev/null
+++ b/tools/expand
@@ -0,0 +1,1036 @@
+#!/bin/sh
+# -*-tcl-*-
+# the next line restarts using tclsh\
+exec tclsh "$0" "$@"
+
+#-------------------------------------------------------------------------
+# TITLE:
+# expand.tcl
+#
+# VERSION:
+# 2.0
+#
+# AUTHOR:
+# Will Duquette
+#
+# DESCRIPTION:
+# Usage: tclsh expand.tcl [options] files....
+#
+# Reads files, writing input to output. Most text
+# is output unchanged. Certain text is evaluated as Tcl code;
+# the result of the Tcl code, if any, is output. If the Tcl
+# code results in an error, the error result is output.
+#
+# Before reading any input, expand.tcl reads any exprules.tcl
+# file in the current directory, or alternatively a tcl file
+# specified by the "-rules" command line option. This allows the
+# caller to define special formatting macros for general use
+# and override them as needed. The rules file can also read
+# arguments from the command line, after options are removed but
+# before the files are processed.
+#
+# On an error in a macro, expand can "ignore" the macro,
+# "output" the macro unchanged, "fail" (the default), halting
+# processing, depending on the value of the "-error" option.
+#
+# Output is written to stdout, by default; the "-out" option
+# sends it to a file, instead. If the specified file is "nul",
+# then no output is written at all. The rules can also control
+# the output via the setoutput command.
+#
+# Any text in brackets, e.g., "[" and "]" is treated as a Tcl
+# command, and evaluated. The bracket characters can be changed
+# using ::expand::setbrackets.
+#
+# Normally Expand reads the output files only once; a rules file
+# can choose multiple passes using the ::expand::setpasses command. The
+# ::expand::exppass command returns the number of the current pass,
+# starting at 1.
+#
+# LICENSE:
+# Copyright (C) 2000 by William H. Duquette. See license.txt,
+# distributed with this file, for license information.
+#
+# CHANGE LOG:
+#
+# 06/27/98: Released V1.0 on web.
+# 06/27/98: Changed exp_extract to handle multi-character bracket
+# tokens. Added exp_stripBrackets to remove multi-character
+# bracket tokens.
+# 06/27/98: Added function setbrackets to allow the user to choose the
+# bracket tokens.
+# 06/27/98: Added brand new command line option parser. The new parser
+# can be used by the rules file's begin_hook.
+#
+# 06/28/98: Version 1.1 released.
+#
+# 06/29/98: Added init_hook.
+# 06/29/98: Added setoutput command.
+# 06/29/98: Added setpasses/exppass and multi-pass processing.
+# 06/29/98: Fixed potential bug in exp_getCmd: using "info complete"
+# with changed left and right brackets.
+# 06/30/98: Added -testmode flag: causes error output to go to
+# stdout instead of stderr to aid testing.
+# 07/01/98: Added a tclsh80 starter at the top of the file.
+# 07/01/98: exp_error calls "exit 1" instead of "exit 0" again.
+# 07/02/98: Added expandText and include commands.
+# 07/03/98: Renamed exp_write to expwrite, and made it public,
+# for use with setoutput.
+# 07/07/98: Released Expand V1.2
+#
+# 10/10/99: Added raw_text_hook.
+# 01/15/00: Rewrote popArg, in an attempt to prevent an odd bug
+# that manifests only on certain platforms.
+# 01/15/00: Released Expand V1.3
+#
+# 02/03/00: Found a bug in expandText; it isn't safe to extract
+# the command name from an arbitrary Tcl script using
+# lindex, as many valid scripts aren't valid lists. I
+# now use scan instead of lindex.
+#
+# 04/17/00: Version 2 rewrite begins. The code is cleaned up and
+# placed in the ::expand:: namespace.
+#
+# 05/07/00: Version 2 rewrite ends (for now).
+
+#-------------------------------------------------------------------------
+# Namespace: all of the expand code exists in the ::expand:: namespace,
+# leaving the global namespace for the user's rules.
+
+namespace eval ::expand:: {
+ # Exported Commands
+ namespace export {[a-z]*}
+
+ # Expand Variables
+
+ # Macro bracketing sequences.
+ variable leftBracket "\["
+ variable rightBracket "\]"
+
+ # What to output when an error is detected:
+ # "nothing", "macro", "error", "fail"
+ variable errorOutputMode fail
+
+ # Number of passes to make over the input
+ variable numberOfPasses 1
+
+ # The current output channel
+ variable outputChannel ""
+
+ # A command can push its context onto a stack, causing any text
+ # that follows it to be saved separately. Later on, a paired command
+ # can pop the stack, acquiring the saved text and including it in its own
+ # output.
+ variable level 0
+ variable context
+ variable contextName
+ variable contextData
+ set context($level) ""
+ set contextName($level) ":0"
+
+ # Status variables
+ variable currentFileName ""
+ variable currentPass 0
+}
+
+#-------------------------------------------------------------------------
+# User settings: These commands allow the users to set, and in some
+# cases retrieve, various expansion parameters.
+
+# lb
+#
+# Return the left bracket sequence.
+
+proc ::expand::lb {} {
+ variable leftBracket
+
+ return $leftBracket
+}
+
+# rb
+#
+# Return the right bracket sequence.
+
+proc ::expand::rb {} {
+ variable rightBracket
+
+ return $rightBracket
+}
+
+# setbrackets lb rb
+#
+# Set the bracket sequences
+proc ::expand::setbrackets {lb rb} {
+ variable leftBracket
+ variable rightBracket
+
+ if {$lb == "" || $rb == ""} {
+ error "Empty string specified as left or right bracket."
+ }
+
+ set leftBracket $lb
+ set rightBracket $rb
+
+ return
+}
+
+# setErrorOutputMode mode
+#
+# Set the error output mode
+proc ::expand::setErrorOutputMode {mode} {
+ variable errorOutputMode
+
+ if {![oneOf {fail nothing macro error} $mode]} {
+ error "Invalid error output mode '$mode'"
+ }
+
+ set errorOutputMode $mode
+}
+
+# Return the current file name
+proc ::expand::expfile {} {
+ variable currentFileName
+
+ return $currentFileName
+}
+
+# Return the number of the current pass.
+proc ::expand::exppass {} {
+ variable currentPass
+
+ return $currentPass
+}
+
+# Set the number of passes
+proc ::expand::setpasses {passes} {
+ variable numberOfPasses
+
+ set numberOfPasses $passes
+
+ if {$numberOfPasses < 1} {
+ error "setpasses: must be >= 1"
+ }
+}
+
+#-------------------------------------------------------------------------
+# User hooks: a rule set can redefine these hooks to do anything desired.
+# The init_hook doesn't contribute to the output, but the other hooks do.
+# Since the hooks do nothing by default, and are to be redefined by the
+# user, they are defined in the global name space.
+
+# Initialization Hook: called when the rule set is loaded.
+proc init_hook {} {}
+
+# Begin Hook: Called at the beginning of each pass.
+proc begin_hook {} {}
+
+# End Hook: Called at the end of each pass.
+proc end_hook {} {}
+
+# Begin File Hook: Called before each file is processed.
+proc begin_file_hook {fileName} {}
+
+# End File Hook: Called after each file is processed.
+proc end_file_hook {fileName} {}
+
+# Raw Text Hook: All plain (non-macro) text is passed through this
+# function.
+proc raw_text_hook {text} {return $text}
+
+#-------------------------------------------------------------------------
+# Context: Every expansion takes place in its own context; however,
+# a macro can push a new context, causing the text it returns and all
+# subsequent text to be saved separately. Later, a matching macro can
+# pop the context, acquiring all text saved since the first command,
+# and use that in its own output.
+
+# cpush name
+#
+# pushes an empty context onto the stack. All output text will be added
+# to this context until it is popped.
+
+proc ::expand::cpush {name} {
+ variable level
+ variable context
+ variable contextName
+
+ incr level
+ set context($level) {}
+ set contextName($level) $name
+}
+
+# cis name
+#
+# Returns true if the current context has the given name.
+
+proc ::expand::cis {name} {
+ variable level
+ variable contextName
+
+ return [expr [string compare $name $contextName($level)] == 0]
+}
+
+# cname
+#
+# Returns the current context name.
+
+proc ::expand::cname {} {
+ variable level
+ variable contextName
+
+ return $contextName($level)
+}
+
+# csave name value
+#
+# Save or retrieve value in the current context
+
+proc ::expand::csave {name value} {
+ variable contextData
+ variable level
+
+ set contextData($level-$name) $value
+}
+
+# cget name
+#
+# Get the value of a context variable
+proc ::expand::cget {name} {
+ variable contextData
+ variable level
+
+ if {![info exists contextData($level-$name)]} {
+ error "*** Error, context var $name doesn't exist in this context"
+ }
+
+ return $contextData($level-$name)
+}
+
+# cvar name
+#
+# Get a context variable's real name, e.g., for appending or lappending
+proc ::expand::cvar {name} {
+ variable contextData
+ variable level
+
+ if {![info exists contextData($level-$name)]} {
+ error "*** Error, context var $name doesn't exist in this context"
+ }
+
+ return ::expand::contextData($level-$name)
+}
+
+# cpop
+#
+# Pops a context level off of the stack, returning the accumulated text.
+
+proc ::expand::cpop {name} {
+ variable level
+ variable context
+ variable contextName
+ variable contextData
+
+ if {$level == 0} {
+ error "*** Error, context mismatch: got unexpected '$name'"
+ }
+
+ if {"$contextName($level)" != "$name"} {
+ error \
+ "*** Error, context mismatch: expected $contextName($level), got $name"
+ }
+
+ set result $context($level)
+ set context($level) ""
+ set contextName($level) ""
+
+ foreach name [array names contextData $level-*] {
+ unset contextData($name)
+ }
+
+ incr level -1
+
+ return $result
+}
+
+# ContextAppend text
+#
+# This private command appends text to the current context. It is for
+# use only by the Expand code; macros should return their text.
+
+proc ::expand::ContextAppend {text} {
+ variable context
+ variable level
+
+ append context($level) $text
+}
+
+#-------------------------------------------------------------------------
+# Macro-expansion: The following code is the heart of the program.
+# Given a text string, and the current variable settings, this code
+# returns an expanded string, with all macros replaced.
+#
+# If a fatal error is detected during expansion, expandText throws
+# an error for its caller to handle. An error detected while
+# expanding a particular macro is only fatal if the errorOutputMode
+# is "fail"; otherwise, the result of the expansion attempt is
+# output according to the mode.
+#
+# All non-macro text is passed through the raw_text_hook.
+
+# Expands a string using the current macro definitions and Expand
+# variable settings.
+proc ::expand::expandText {inputString} {
+ variable errorOutputMode
+ global errorInfo
+
+ cpush expandText
+
+ while {[string length $inputString] > 0} {
+ set plainText [ExtractToToken inputString [lb] exclude]
+
+ # FIRST, If there was plain text, append it to the output, and
+ # continue.
+ if {$plainText != ""} {
+ ContextAppend [raw_text_hook $plainText]
+ if {[string length $inputString] == 0} {
+ break
+ }
+ }
+
+ # NEXT, A macro is the next thing; process it.
+ if {[catch "GetMacro inputString" macro]} {
+ error "*** Error reading macro from input: $macro"
+ }
+
+ # Expand the macro, and output the result, or
+ # handle an error.
+ if {![catch "uplevel #0 [list $macro]" result]} {
+ ContextAppend $result
+ continue
+ }
+
+ switch $errorOutputMode {
+ nothing { }
+ macro {
+ ContextAppend "[lb]$macro[rb]"
+ }
+ error {
+ ContextAppend "[lb]$macro[rb]\n"
+ ContextAppend "*** Error in preceding macro: $result\n$errorInfo"
+ }
+ fail {
+ error "*** Error in macro:\n[lb]$macro[rb]\n$result"
+ }
+ }
+ }
+
+ return [cpop expandText]
+}
+
+# ExtractToToken string token mode
+#
+# Extract text from a string, up to or including a particular
+# token. Remove the extracted text from the string.
+# mode determines whether the found token is removed;
+# it should be "include" or "exclude". The string is
+# modified in place, and the extracted text is returned.
+proc ::expand::ExtractToToken {string token mode} {
+ upvar $string theString
+
+ # First, determine the offset
+ switch $mode {
+ include { set offset [expr [string length $token] - 1] }
+ exclude { set offset -1 }
+ default { error "::expand::ExtractToToken: unknown mode $mode" }
+ }
+
+ # Next, find the first occurrence of the token.
+ set tokenPos [string first $token $theString]
+
+ # Next, return the entire string if it wasn't found, or just
+ # the part upto or including the character.
+ if {$tokenPos == -1} {
+ set theText $theString
+ set theString ""
+ } else {
+ set newEnd [expr $tokenPos + $offset]
+ set newBegin [expr $newEnd + 1]
+ set theText [string range $theString 0 $newEnd]
+ set theString [string range $theString $newBegin end]
+ }
+
+ return $theText
+}
+
+# Get the next complete command, removing it from the string.
+proc ::expand::GetMacro {string} {
+ upvar $string theString
+
+ # FIRST, it's an error if the string doesn't begin with a
+ # character.
+ if {[string first [lb] $theString] != 0} {
+ error "::expand::GetMacro: assertion failure, next text isn't a command! '$theString'"
+ }
+
+ # NEXT, extract a full macro
+ set macro [ExtractToToken theString [lb] include]
+ while {[string length $theString] > 0} {
+ append macro [ExtractToToken theString [rb] include]
+
+ # Verify that the command really ends with the [rb] characters,
+ # whatever they are. If not, break because of unexpected
+ # end of file.
+ if {![IsBracketed $macro]} {
+ break;
+ }
+
+ set strippedMacro [StripBrackets $macro]
+
+ if {[info complete "puts \[$strippedMacro\]"]} {
+ return $strippedMacro
+ }
+ }
+
+ if {[string length $macro] > 40} {
+ set macro "[string range $macro 0 39]...\n"
+ }
+ error "*** Error, unexpected EOF in macro:\n$macro"
+}
+
+# Strip left and right bracket tokens from the ends of a macro,
+# provided that it's properly bracketed.
+proc ::expand::StripBrackets {macro} {
+ set llen [string length [lb]]
+ set rlen [string length [rb]]
+ set tlen [string length $macro]
+
+ return [string range $macro $llen [expr $tlen - $rlen - 1]]
+}
+
+# Return 1 if the macro is properly bracketed, and 0 otherwise.
+proc ::expand::IsBracketed {macro} {
+ set llen [string length [lb]]
+ set rlen [string length [rb]]
+ set tlen [string length $macro]
+
+ set leftEnd [string range $macro 0 [expr $llen - 1]]
+ set rightEnd [string range $macro [expr $tlen - $rlen] end]
+
+ if {$leftEnd != [lb]} {
+ return 0
+ } elseif {$rightEnd != [rb]} {
+ return 0
+ } else {
+ return 1
+ }
+}
+
+#-------------------------------------------------------------------------
+# File handling: these routines, some public and some private, handle
+# processing of files.
+
+# expand fileList outputFile
+#
+# This is the basic algorithm of the Expand tool. Given a list of files
+# to expand, it executes the following sequence. Return values of all
+# handlers, except for the initHandlers, is written to the current output
+# file.
+#
+# - For each pass,
+# - Set ::expand::currentPass.
+# - Call the begin_hook.
+# - For each file in the file list,
+# - Set ::expand::currentFileName
+# - Call the begin_file_hook.
+# - read file and expand its contents
+# - Call the end_file_hook.
+# - Call the end_hook.
+# - Close the current output file.
+
+proc ::expand::expand {fileList outputFile} {
+ variable currentPass
+ variable numberOfPasses
+ variable currentFileName
+
+ for {set currentPass 1} {$currentPass <= $numberOfPasses} \
+ {incr currentPass} {
+
+ # First, if this is any pass but the last, set output to nul;
+ # otherwise, set output to the requested output file.
+ if {$currentPass < $numberOfPasses} {
+ setoutput nul
+ } else {
+ setoutput $outputFile
+ }
+
+ # Next, execute the beginning hook
+ set currentFileName ""
+ expwrite [begin_hook]
+
+ # Next, expand each of the files on the command line.
+ foreach file $fileList {
+ if {[catch "ExpandFile [list $file]" result]} {
+ puts stderr $result
+ exit 1
+ }
+ expwrite $result
+ }
+
+ # Next, execute the end hook
+ expwrite [end_hook]
+ }
+
+ # Next, close the output file.
+ setoutput nul
+}
+
+# ExpandFile
+#
+# Helper routine for ::expand::expand. It expands a single file,
+# calling the begin and end file handlers and returning the expanded
+# result.
+
+proc ::expand::ExpandFile {fileName} {
+ variable currentFileName
+
+ # Set the current file
+ set currentFileName $fileName
+
+ # Call the begin_file_hook
+ set output [begin_file_hook $fileName]
+
+ # Expand the file
+ set contents [readFile $fileName]
+
+ if {[catch [list expandText $contents] result]} {
+ error "*** Error expanding $fileName:\n$result"
+ }
+
+ append output $result
+
+ # Call the endFileHandlers
+ append output [end_file_hook $fileName]
+
+ return $output
+}
+
+# include file
+#
+# Reads a file into memory, and expands its contents.
+
+proc ::expand::include {fileName} {
+ # Get the file's contents, and prepare to output it.
+ set contents [readFile $fileName]
+
+ if {[catch [list expandText $contents] result]} {
+ error "*** Error including $fileName:\n$result"
+ }
+
+ return $result
+}
+
+# readFile file
+#
+# Reads a file into memory, returning its contents.
+proc ::expand::readFile {fileName} {
+ # Open the file.
+ if {[catch "open $fileName" fin]} {
+ error "Could not read file '$fileName': $fin"
+ }
+
+ # Read the contents and close the file.
+ set contents [read $fin]
+ close $fin
+
+ return $contents
+}
+
+#-------------------------------------------------------------------------
+# Output Management
+
+# Set the output file
+proc ::expand::setoutput {fileName} {
+ variable outputChannel
+
+ # Close any existing file
+ if {$outputChannel != "" && $outputChannel != "stdout"} {
+ close $outputChannel
+ }
+
+ # Pick stdout, no output at all, or a real file
+ if {$fileName == ""} {
+ set outputChannel stdout
+ } elseif {$fileName == "nul"} {
+ set outputChannel ""
+ } else {
+ if {[catch "open $fileName w" outputChannel]} {
+ error "Could not open output file $fileName"
+ }
+ }
+
+ return
+}
+
+# Output a bunch of text to the output file.
+proc ::expand::expwrite {text} {
+ variable outputChannel
+
+ if {$outputChannel != ""} {
+ puts -nonewline $outputChannel $text
+ }
+}
+
+#-------------------------------------------------------------------------
+# getoptions: command line option parsing
+#
+# The getoptions function parses a list as a command line, removing
+# options and their values. Any remaining tokens and options remain
+# in the list and can be parsed by another call to getoptions or in
+# any other way the caller prefers.
+#
+# getoptions is called as follows:
+#
+# getoptions arglist [-strict] [{optionDef... }]
+#
+# "arglist" is the name of a list variable, typically argv. It is
+# passed by name, and modified in place. If the "-strict" option
+# is specified, unrecognized options are flagged as errors.
+# The call may include any number of option definitions, including
+# none. The call "getoptions argv -strict", for example, will ensure
+# that no options remain in the list contained in "argv".
+#
+# Option definitions may take the following forms. In each, NAME is
+# the option name, which must begin with a "-" character, and VAR is
+# the name of a variable in the caller's scope to receive the option's value.
+#
+# {NAME VAR flag}
+# If the option appears on the command line, the variable
+# is set to 1, otherwise to 0.
+#
+# {NAME VAR enum VAL1 VAL2....}
+# If the option appears on the command line, the next argument
+# must be one of the enumerated values, VAL1, VAL2, etc. The
+# variable is set to the value, or VAL1 if the option does not
+# appear on the command line. If the option's value is not one of
+# the valid choices, an error message will be displayed and the
+# program will halt. None of the enumerated values may begin with
+# a "-" character.
+#
+# {NAME VAR string DEFVALUE}
+# The named variable is set to the value following the option on
+# the command line. If the option doesn't appear, the variable is
+# set to the DEFVALUE. The option's value may not begin with
+# "-" character, as if it does, the most likely explanation is
+# that the option's real value is missing and the next argument is
+# another option name.
+
+# Utility routine: pops an arg off of the front of an arglist.
+proc ::expand::popArg {arglist} {
+ upvar $arglist args
+
+ if {[llength $args] == 0} {
+ set arg ""
+ } elseif {[llength $args] == 1} {
+ set arg $args
+ set args ""
+ } else {
+ set arg [lindex $args 0]
+ set args [lrange $args 1 end]
+ }
+
+ return $arg
+}
+
+proc ::expand::getoptions {arglist strictOrDefs {defsOrNil ""}} {
+ # First, the arglist is called by name.
+ upvar $arglist args
+
+ # Next, strictOrDefs is either the "-strict" option or the
+ # definition list.
+ if {$strictOrDefs == "-strict"} {
+ set strictFlag 1
+ set defList $defsOrNil
+ } else {
+ set strictFlag 0
+ set defList $strictOrDefs
+ }
+
+ # Next, get names of the options
+ set optNames {}
+ set optTypes {flag enum string}
+ set optLens {3 5 4}
+ foreach def $defList {
+ if {[llength $def] < 3} {
+ error "Error in option definition: $def"
+ }
+ lappend optNames [lindex $def 0]
+ set varName [lindex $def 1]
+ set optType [lindex $def 2]
+ set i [lsearch -exact $optTypes $optType]
+
+ if {$i == -1} {
+ error "Unknown option type: $optType"
+ }
+
+ if {[llength $def] < [lindex $optLens $i]} {
+ error "Error in option definition: $def"
+ }
+
+ upvar $varName theVar
+ switch $optType {
+ flag {set theVar 0}
+ enum -
+ string {set theVar [lindex $def 3]}
+ }
+ }
+
+ # Next, process the options on the command line.
+ set errorCount 0
+ set newList {}
+ for {set arg [popArg args]} {$arg != ""} {set arg [popArg args]} {
+ # First, does it look like an option? If not, add it to the
+ # output list.
+ if {[string index $arg 0] != "-"} {
+ lappend newList $arg
+ continue
+ }
+
+ # Next, Is the argument unknown? Flag an error or just skip it.
+ set i [lsearch -exact $optNames $arg]
+ if {$i == -1} {
+ if {$strictFlag} {
+ puts stderr "*** Unknown option: $arg"
+ incr errorCount
+ } else {
+ lappend newList $arg
+ }
+
+ continue
+ }
+
+ # Next, process the argument
+ set def [lindex $defList $i]
+ set varName [lindex $def 1]
+ set optType [lindex $def 2]
+
+ upvar $varName theVar
+ switch $optType {
+ flag {
+ set theVar 1
+ }
+
+ enum {
+ set vals [lreplace $def 0 2]
+ set theVar [popArg args]
+ if {$theVar == "" || [string index $theVar 0] == "-"} {
+ puts stderr "*** Missing option value: $arg"
+ incr errorCount
+ continue
+ }
+ if {[lsearch -exact $vals $theVar] == -1} {
+ puts stderr "*** Invalid option value: $arg $theVar"
+ incr errorCount
+ }
+ }
+
+ string {
+ set theVar [popArg args]
+ if {$theVar == "" || [string index $theVar 0] == "-"} {
+ puts stderr "*** Missing option value: $arg"
+ incr errorCount
+ }
+ }
+ }
+ }
+
+ # Next, if there are any errors, halt.
+ if {$errorCount > 0} {
+ exit 1
+ }
+
+ # Next, return the new argument list.
+ set args $newList
+ return
+}
+
+#-------------------------------------------------------------------------
+# Importing macros into the global namespace
+
+# GlobalizeMacros args
+#
+# args is a list of glob patterns matching the macros to be imported.
+# The prefix ::expand:: is added automatically.
+
+proc ::expand::GlobalizeMacros {args} {
+ set globList {}
+
+ foreach arg $args {
+ lappend globList ::expand::$arg
+ }
+
+ namespace eval :: "namespace import -force $globList"
+}
+
+#-------------------------------------------------------------------------
+# Standard Rule Set:
+#
+# These are the rules that are always available.
+
+proc ::expand::standardRuleSet {} {
+ GlobalizeMacros cget cis cname cpop cpush csave cvar expandText expfile
+ GlobalizeMacros exppass expwrite getoptions include lb popArg rb
+ GlobalizeMacros readFile setErrorOutputMode setbrackets setoutput
+ GlobalizeMacros setpasses textToID
+}
+
+#-------------------------------------------------------------------------
+# Rule Set: Web Rules
+#
+# These macros are for creating HTML pages. They are only defined when
+# webRuleSet is called.
+
+proc ::expand::webRuleSet {} {
+ GlobalizeMacros dot tag link mailto today
+}
+
+# Output a big black dot.
+proc ::expand::dot {} {
+ return "•"
+}
+
+# Format an html tag. name is the tag name, args is a list of
+# of attribute names and values
+proc ::expand::tag {name args} {
+ set result "<$name"
+ foreach {attr val} $args {
+ append result " $attr=\"$val\""
+ }
+ append result ">"
+}
+
+# Format a link. If text is given, use it as the displayed text;
+# otherwise use the url.
+proc ::expand::link {url {text ""}} {
+ if {$text == ""} {
+ set text $url
+ }
+
+ return "[tag a href $url]$text[tag /a]"
+}
+
+# Format an email URL
+proc ::expand::mailto {address {name ""}} {
+ if {$name == ""} {
+ set name $address
+ }
+
+ return "[tag a href mailto:$address]$name[tag /a]"
+}
+
+# Return today's date. Use dd MONTH yyyy unless some other format is
+# proposed.
+proc ::expand::today {{format ""}} {
+ set secs [clock seconds]
+
+ if {$format == ""} {
+ set format "%d %B %Y"
+ }
+ return [string trimleft [clock format $secs -format $format] "0"]
+}
+
+
+#-------------------------------------------------------------------------
+# Miscellaneous utility commands
+
+# oneOf list value
+#
+# Checks to see if a value is in a list.
+
+proc ::expand::oneOf {list value} {
+ return [expr {[lsearch -exact $list $value] != -1}]
+}
+
+# Converts a generic string to an ID string. Leading and trailing
+# whitespace and internal punctuation is removed, internal whitespace
+# is converted to "_", and the text is converted to lower case.
+proc ::expand::textToID {text} {
+ # First, trim any white space and convert to lower case
+ set text [string trim [string tolower $text]]
+
+ # Next, substitute "_" for internal whitespace, and delete any
+ # non-alphanumeric characters (other than "_", of course)
+ regsub -all {[ ]+} $text "_" text
+ regsub -all {[^a-z0-9_]} $text "" text
+
+ return $text
+}
+
+#-------------------------------------------------------------------------
+# Main-line code: This is the implementation of the Expand tool
+# itself. It is executed only if this is the top-level script.
+
+proc ::expand::ShowHelp { } {
+ puts {tclsh expand.tcl [options] files...
+
+ -help Displays this text.
+ -rules file Specify the name of the rules file
+ (exprules.tcl is the default)
+ -out file Specify the name of the output file, or "nul" for
+ no output. Output is to stdout, by default.
+ -errout mode nothing, macro, error, or fail (fail is the default)
+ -web Enable the optional web rule set.
+ files... Names of files to process.}
+}
+
+if {"[info script]" == "$argv0"} {
+
+ # First, parse the command line
+ ::expand::getoptions argv {
+ {-help ::expand::helpFlag flag}
+ {-errout ::expand::errorOutputMode enum fail nothing macro error}
+ {-rules ::expand::rulesFile string "exprules.tcl"}
+ {-web ::expand::webFlag flag}
+ {-out ::expand::outputFile string ""}
+ }
+
+ # Next, if they asked for help or if there are no arguments left,
+ # show help and stop.
+ if {$::expand::helpFlag || [llength $argv] == 0} {
+ ::expand::ShowHelp
+ exit 0
+ }
+
+ # Next, load the standard macros
+ ::expand::standardRuleSet
+
+ # Next, load optional rule sets.
+ if {$::expand::webFlag} {
+ ::expand::webRuleSet
+ }
+
+ # Next, load the rules file. (Should only do it if file exists;
+ # should die if there are any errors)
+ if {[file exists $::expand::rulesFile]} {
+ if {[catch "source $::expand::rulesFile" result]} {
+ puts "*** Error in rules file $::expand::rulesFile: $result"
+ exit 1
+ }
+ } elseif {$::expand::rulesFile != "exprules.tcl"} {
+ puts "*** Rules file $rulesFile not found."
+ exit 1
+ }
+
+ # Next, call the init_hook.
+ if {[catch init_hook result]} {
+ puts "*** Error executing init_hook: $result"
+ exit 1
+ }
+
+ # Next, make sure the command line contains no additional options
+ ::expand::getoptions argv -strict
+
+ # Next, process the files
+ ::expand::expand $argv $::expand::outputFile
+}
+
+
diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl
new file mode 100644
index 0000000..9f83e2e
--- /dev/null
+++ b/tools/genStubs.tcl
@@ -0,0 +1,894 @@
+# genStubs.tcl --
+#
+# This script generates a set of stub files for a given
+# interface.
+#
+#
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: genStubs.tcl,v 1.1 2002/12/17 18:31:05 drh Exp $
+
+namespace eval genStubs {
+ # libraryName --
+ #
+ # The name of the entire library. This value is used to compute
+ # the USE_*_STUB_PROCS macro and the name of the init file.
+
+ variable libraryName "UNKNOWN"
+
+ # interfaces --
+ #
+ # An array indexed by interface name that is used to maintain
+ # the set of valid interfaces. The value is empty.
+
+ array set interfaces {}
+
+ # curName --
+ #
+ # The name of the interface currently being defined.
+
+ variable curName "UNKNOWN"
+
+ # hooks --
+ #
+ # An array indexed by interface name that contains the set of
+ # subinterfaces that should be defined for a given interface.
+
+ array set hooks {}
+
+ # stubs --
+ #
+ # This three dimensional array is indexed first by interface name,
+ # second by platform name, and third by a numeric offset or the
+ # constant "lastNum". The lastNum entry contains the largest
+ # numeric offset used for a given interface/platform combo. Each
+ # numeric offset contains the C function specification that
+ # should be used for the given entry in the stub table. The spec
+ # consists of a list in the form returned by parseDecl.
+
+ array set stubs {}
+
+ # outDir --
+ #
+ # The directory where the generated files should be placed.
+
+ variable outDir .
+}
+
+# genStubs::library --
+#
+# This function is used in the declarations file to set the name
+# of the library that the interfaces are associated with (e.g. "tcl").
+# This value will be used to define the inline conditional macro.
+#
+# Arguments:
+# name The library name.
+#
+# Results:
+# None.
+
+proc genStubs::library {name} {
+ variable libraryName $name
+}
+
+# genStubs::interface --
+#
+# This function is used in the declarations file to set the name
+# of the interface currently being defined.
+#
+# Arguments:
+# name The name of the interface.
+#
+# Results:
+# None.
+
+proc genStubs::interface {name} {
+ variable curName $name
+ variable interfaces
+
+ set interfaces($name) {}
+ return
+}
+
+# genStubs::hooks --
+#
+# This function defines the subinterface hooks for the current
+# interface.
+#
+# Arguments:
+# names The ordered list of interfaces that are reachable through the
+# hook vector.
+#
+# Results:
+# None.
+
+proc genStubs::hooks {names} {
+ variable curName
+ variable hooks
+
+ set hooks($curName) $names
+ return
+}
+
+# genStubs::declare --
+#
+# This function is used in the declarations file to declare a new
+# interface entry.
+#
+# Arguments:
+# index The index number of the interface.
+# platform The platform the interface belongs to. Should be one
+# of generic, win, unix, or mac.
+# decl The C function declaration, or {} for an undefined
+# entry.
+#
+# Results:
+# None.
+
+proc genStubs::declare {args} {
+ variable stubs
+ variable curName
+
+ if {[llength $args] != 3} {
+ puts stderr "wrong # args: declare $args"
+ }
+ lassign $args index platformList decl
+
+ # Check for duplicate declarations, then add the declaration and
+ # bump the lastNum counter if necessary.
+
+ foreach platform $platformList {
+ if {[info exists stubs($curName,$platform,$index)]} {
+ puts stderr "Duplicate entry: declare $args"
+ }
+ }
+ regsub -all "\[ \t\n\]+" [string trim $decl] " " decl
+ set decl [parseDecl $decl]
+
+ foreach platform $platformList {
+ if {$decl != ""} {
+ set stubs($curName,$platform,$index) $decl
+ if {![info exists stubs($curName,$platform,lastNum)] \
+ || ($index > $stubs($curName,$platform,lastNum))} {
+ set stubs($curName,$platform,lastNum) $index
+ }
+ }
+ }
+ return
+}
+
+# genStubs::rewriteFile --
+#
+# This function replaces the machine generated portion of the
+# specified file with new contents. It looks for the !BEGIN! and
+# !END! comments to determine where to place the new text.
+#
+# Arguments:
+# file The name of the file to modify.
+# text The new text to place in the file.
+#
+# Results:
+# None.
+
+proc genStubs::rewriteFile {file text} {
+ if {![file exist $file]} {
+ puts stderr "Cannot find file: $file"
+ return
+ }
+ set in [open ${file} r]
+ set out [open ${file}.new w]
+
+ # Always write out the file with LF termination
+ fconfigure $out -translation lf
+
+ while {![eof $in]} {
+ set line [gets $in]
+ if {[regexp {!BEGIN!} $line]} {
+ break
+ }
+ puts $out $line
+ }
+ puts $out "/* !BEGIN!: Do not edit below this line. */"
+ puts $out $text
+ while {![eof $in]} {
+ set line [gets $in]
+ if {[regexp {!END!} $line]} {
+ break
+ }
+ }
+ puts $out "/* !END!: Do not edit above this line. */"
+ puts -nonewline $out [read $in]
+ close $in
+ close $out
+ file rename -force ${file}.new ${file}
+ return
+}
+
+# genStubs::addPlatformGuard --
+#
+# Wrap a string inside a platform #ifdef.
+#
+# Arguments:
+# plat Platform to test.
+#
+# Results:
+# Returns the original text inside an appropriate #ifdef.
+
+proc genStubs::addPlatformGuard {plat text} {
+ switch $plat {
+ win {
+ return "#ifdef __WIN32__\n${text}#endif /* __WIN32__ */\n"
+ }
+ unix {
+ return "#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */\n${text}#endif /* UNIX */\n"
+ }
+ mac {
+ return "#ifdef MAC_TCL\n${text}#endif /* MAC_TCL */\n"
+ }
+ }
+ return "$text"
+}
+
+# genStubs::emitSlots --
+#
+# Generate the stub table slots for the given interface. If there
+# are no generic slots, then one table is generated for each
+# platform, otherwise one table is generated for all platforms.
+#
+# Arguments:
+# name The name of the interface being emitted.
+# textVar The variable to use for output.
+#
+# Results:
+# None.
+
+proc genStubs::emitSlots {name textVar} {
+ variable stubs
+ upvar $textVar text
+
+ forAllStubs $name makeSlot 1 text {" void *reserved$i;\n"}
+ return
+}
+
+# genStubs::parseDecl --
+#
+# Parse a C function declaration into its component parts.
+#
+# Arguments:
+# decl The function declaration.
+#
+# Results:
+# Returns a list of the form {returnType name args}. The args
+# element consists of a list of type/name pairs, or a single
+# element "void". If the function declaration is malformed
+# then an error is displayed and the return value is {}.
+
+proc genStubs::parseDecl {decl} {
+ if {![regexp {^(.*)\((.*)\)$} $decl all prefix args]} {
+ puts stderr "Malformed declaration: $decl"
+ return
+ }
+ set prefix [string trim $prefix]
+ if {![regexp {^(.+[ ][*]*)([^ *]+)$} $prefix all rtype fname]} {
+ puts stderr "Bad return type: $decl"
+ return
+ }
+ set rtype [string trim $rtype]
+ foreach arg [split $args ,] {
+ lappend argList [string trim $arg]
+ }
+ if {![string compare [lindex $argList end] "..."]} {
+ if {[llength $argList] != 2} {
+ puts stderr "Only one argument is allowed in varargs form: $decl"
+ }
+ set arg [parseArg [lindex $argList 0]]
+ if {$arg == "" || ([llength $arg] != 2)} {
+ puts stderr "Bad argument: '[lindex $argList 0]' in '$decl'"
+ return
+ }
+ set args [list TCL_VARARGS $arg]
+ } else {
+ set args {}
+ foreach arg $argList {
+ set argInfo [parseArg $arg]
+ if {![string compare $argInfo "void"]} {
+ lappend args "void"
+ break
+ } elseif {[llength $argInfo] == 2 || [llength $argInfo] == 3} {
+ lappend args $argInfo
+ } else {
+ puts stderr "Bad argument: '$arg' in '$decl'"
+ return
+ }
+ }
+ }
+ return [list $rtype $fname $args]
+}
+
+# genStubs::parseArg --
+#
+# This function parses a function argument into a type and name.
+#
+# Arguments:
+# arg The argument to parse.
+#
+# Results:
+# Returns a list of type and name with an optional third array
+# indicator. If the argument is malformed, returns "".
+
+proc genStubs::parseArg {arg} {
+ if {![regexp {^(.+[ ][*]*)([^][ *]+)(\[\])?$} $arg all type name array]} {
+ if {$arg == "void"} {
+ return $arg
+ } else {
+ return
+ }
+ }
+ set result [list [string trim $type] $name]
+ if {$array != ""} {
+ lappend result $array
+ }
+ return $result
+}
+
+# genStubs::makeDecl --
+#
+# Generate the prototype for a function.
+#
+# Arguments:
+# name The interface name.
+# decl The function declaration.
+# index The slot index for this function.
+#
+# Results:
+# Returns the formatted declaration string.
+
+proc genStubs::makeDecl {name decl index} {
+ lassign $decl rtype fname args
+
+ append text "/* $index */\n"
+ set line "EXTERN $rtype"
+ set count [expr {2 - ([string length $line] / 8)}]
+ append line [string range "\t\t\t" 0 $count]
+ set pad [expr {24 - [string length $line]}]
+ if {$pad <= 0} {
+ append line " "
+ set pad 0
+ }
+ append line "$fname _ANSI_ARGS_("
+
+ set arg1 [lindex $args 0]
+ switch -exact $arg1 {
+ void {
+ append line "(void)"
+ }
+ TCL_VARARGS {
+ set arg [lindex $args 1]
+ append line "TCL_VARARGS([lindex $arg 0],[lindex $arg 1])"
+ }
+ default {
+ set sep "("
+ foreach arg $args {
+ append line $sep
+ set next {}
+ append next [lindex $arg 0] " " [lindex $arg 1] \
+ [lindex $arg 2]
+ if {[string length $line] + [string length $next] \
+ + $pad > 76} {
+ append text $line \n
+ set line "\t\t\t\t"
+ set pad 28
+ }
+ append line $next
+ set sep ", "
+ }
+ append line ")"
+ }
+ }
+ append text $line
+
+ append text ");\n"
+ return $text
+}
+
+# genStubs::makeMacro --
+#
+# Generate the inline macro for a function.
+#
+# Arguments:
+# name The interface name.
+# decl The function declaration.
+# index The slot index for this function.
+#
+# Results:
+# Returns the formatted macro definition.
+
+proc genStubs::makeMacro {name decl index} {
+ lassign $decl rtype fname args
+
+ set lfname [string tolower [string index $fname 0]]
+ append lfname [string range $fname 1 end]
+
+ set text "#ifndef $fname\n#define $fname"
+ set arg1 [lindex $args 0]
+ set argList ""
+ switch -exact $arg1 {
+ void {
+ set argList "()"
+ }
+ TCL_VARARGS {
+ }
+ default {
+ set sep "("
+ foreach arg $args {
+ append argList $sep [lindex $arg 1]
+ set sep ", "
+ }
+ append argList ")"
+ }
+ }
+ append text " \\\n\t(${name}StubsPtr->$lfname)"
+ append text " /* $index */\n#endif\n"
+ return $text
+}
+
+# genStubs::makeStub --
+#
+# Emits a stub function definition.
+#
+# Arguments:
+# name The interface name.
+# decl The function declaration.
+# index The slot index for this function.
+#
+# Results:
+# Returns the formatted stub function definition.
+
+proc genStubs::makeStub {name decl index} {
+ lassign $decl rtype fname args
+
+ set lfname [string tolower [string index $fname 0]]
+ append lfname [string range $fname 1 end]
+
+ append text "/* Slot $index */\n" $rtype "\n" $fname
+
+ set arg1 [lindex $args 0]
+
+ if {![string compare $arg1 "TCL_VARARGS"]} {
+ lassign [lindex $args 1] type argName
+ append text " TCL_VARARGS_DEF($type,$argName)\n\{\n"
+ append text " " $type " var;\n va_list argList;\n"
+ if {[string compare $rtype "void"]} {
+ append text " " $rtype " resultValue;\n"
+ }
+ append text "\n var = (" $type ") TCL_VARARGS_START(" \
+ $type "," $argName ",argList);\n\n "
+ if {[string compare $rtype "void"]} {
+ append text "resultValue = "
+ }
+ append text "(" $name "StubsPtr->" $lfname "VA)(var, argList);\n"
+ append text " va_end(argList);\n"
+ if {[string compare $rtype "void"]} {
+ append text "return resultValue;\n"
+ }
+ append text "\}\n\n"
+ return $text
+ }
+
+ if {![string compare $arg1 "void"]} {
+ set argList "()"
+ set argDecls ""
+ } else {
+ set argList ""
+ set sep "("
+ foreach arg $args {
+ append argList $sep [lindex $arg 1]
+ append argDecls " " [lindex $arg 0] " " \
+ [lindex $arg 1] [lindex $arg 2] ";\n"
+ set sep ", "
+ }
+ append argList ")"
+ }
+ append text $argList "\n" $argDecls "{\n "
+ if {[string compare $rtype "void"]} {
+ append text "return "
+ }
+ append text "(" $name "StubsPtr->" $lfname ")" $argList ";\n}\n\n"
+ return $text
+}
+
+# genStubs::makeSlot --
+#
+# Generate the stub table entry for a function.
+#
+# Arguments:
+# name The interface name.
+# decl The function declaration.
+# index The slot index for this function.
+#
+# Results:
+# Returns the formatted table entry.
+
+proc genStubs::makeSlot {name decl index} {
+ lassign $decl rtype fname args
+
+ set lfname [string tolower [string index $fname 0]]
+ append lfname [string range $fname 1 end]
+
+ set text " "
+ append text $rtype " (*" $lfname ") _ANSI_ARGS_("
+
+ set arg1 [lindex $args 0]
+ switch -exact $arg1 {
+ void {
+ append text "(void)"
+ }
+ TCL_VARARGS {
+ set arg [lindex $args 1]
+ append text "TCL_VARARGS([lindex $arg 0],[lindex $arg 1])"
+ }
+ default {
+ set sep "("
+ foreach arg $args {
+ append text $sep [lindex $arg 0] " " [lindex $arg 1] \
+ [lindex $arg 2]
+ set sep ", "
+ }
+ append text ")"
+ }
+ }
+
+ append text "); /* $index */\n"
+ return $text
+}
+
+# genStubs::makeInit --
+#
+# Generate the prototype for a function.
+#
+# Arguments:
+# name The interface name.
+# decl The function declaration.
+# index The slot index for this function.
+#
+# Results:
+# Returns the formatted declaration string.
+
+proc genStubs::makeInit {name decl index} {
+ append text " " [lindex $decl 1] ", /* " $index " */\n"
+ return $text
+}
+
+# genStubs::forAllStubs --
+#
+# This function iterates over all of the platforms and invokes
+# a callback for each slot. The result of the callback is then
+# placed inside appropriate platform guards.
+#
+# Arguments:
+# name The interface name.
+# slotProc The proc to invoke to handle the slot. It will
+# have the interface name, the declaration, and
+# the index appended.
+# onAll If 1, emit the skip string even if there are
+# definitions for one or more platforms.
+# textVar The variable to use for output.
+# skipString The string to emit if a slot is skipped. This
+# string will be subst'ed in the loop so "$i" can
+# be used to substitute the index value.
+#
+# Results:
+# None.
+
+proc genStubs::forAllStubs {name slotProc onAll textVar \
+ {skipString {"/* Slot $i is reserved */\n"}}} {
+ variable stubs
+ upvar $textVar text
+
+ set plats [array names stubs $name,*,lastNum]
+ if {[info exists stubs($name,generic,lastNum)]} {
+ # Emit integrated stubs block
+ set lastNum -1
+ foreach plat [array names stubs $name,*,lastNum] {
+ if {$stubs($plat) > $lastNum} {
+ set lastNum $stubs($plat)
+ }
+ }
+ for {set i 0} {$i <= $lastNum} {incr i} {
+ set slots [array names stubs $name,*,$i]
+ set emit 0
+ if {[info exists stubs($name,generic,$i)]} {
+ if {[llength $slots] > 1} {
+ puts stderr "platform entry duplicates generic entry: $i"
+ }
+ append text [$slotProc $name $stubs($name,generic,$i) $i]
+ set emit 1
+ } elseif {[llength $slots] > 0} {
+ foreach plat {unix win mac} {
+ if {[info exists stubs($name,$plat,$i)]} {
+ append text [addPlatformGuard $plat \
+ [$slotProc $name $stubs($name,$plat,$i) $i]]
+ set emit 1
+ } elseif {$onAll} {
+ append text [eval {addPlatformGuard $plat} $skipString]
+ set emit 1
+ }
+ }
+ }
+ if {$emit == 0} {
+ eval {append text} $skipString
+ }
+ }
+
+ } else {
+ # Emit separate stubs blocks per platform
+ foreach plat {unix win mac} {
+ if {[info exists stubs($name,$plat,lastNum)]} {
+ set lastNum $stubs($name,$plat,lastNum)
+ set temp {}
+ for {set i 0} {$i <= $lastNum} {incr i} {
+ if {![info exists stubs($name,$plat,$i)]} {
+ eval {append temp} $skipString
+ } else {
+ append temp [$slotProc $name $stubs($name,$plat,$i) $i]
+ }
+ }
+ append text [addPlatformGuard $plat $temp]
+ }
+ }
+ }
+
+}
+
+# genStubs::emitDeclarations --
+#
+# This function emits the function declarations for this interface.
+#
+# Arguments:
+# name The interface name.
+# textVar The variable to use for output.
+#
+# Results:
+# None.
+
+proc genStubs::emitDeclarations {name textVar} {
+ variable stubs
+ upvar $textVar text
+
+ append text "\n/*\n * Exported function declarations:\n */\n\n"
+ forAllStubs $name makeDecl 0 text
+ return
+}
+
+# genStubs::emitMacros --
+#
+# This function emits the inline macros for an interface.
+#
+# Arguments:
+# name The name of the interface being emitted.
+# textVar The variable to use for output.
+#
+# Results:
+# None.
+
+proc genStubs::emitMacros {name textVar} {
+ variable stubs
+ variable libraryName
+ upvar $textVar text
+
+ set upName [string toupper $libraryName]
+ append text "\n#if defined(USE_${upName}_STUBS) && !defined(USE_${upName}_STUB_PROCS)\n"
+ append text "\n/*\n * Inline function declarations:\n */\n\n"
+
+ forAllStubs $name makeMacro 0 text
+
+ append text "\n#endif /* defined(USE_${upName}_STUBS) && !defined(USE_${upName}_STUB_PROCS) */\n"
+ return
+}
+
+# genStubs::emitHeader --
+#
+# This function emits the body of the <name>Decls.h file for
+# the specified interface.
+#
+# Arguments:
+# name The name of the interface being emitted.
+#
+# Results:
+# None.
+
+proc genStubs::emitHeader {name} {
+ variable outDir
+ variable hooks
+
+ set capName [string toupper [string index $name 0]]
+ append capName [string range $name 1 end]
+
+ emitDeclarations $name text
+
+ if {[info exists hooks($name)]} {
+ append text "\ntypedef struct ${capName}StubHooks {\n"
+ foreach hook $hooks($name) {
+ set capHook [string toupper [string index $hook 0]]
+ append capHook [string range $hook 1 end]
+ append text " struct ${capHook}Stubs *${hook}Stubs;\n"
+ }
+ append text "} ${capName}StubHooks;\n"
+ }
+ append text "\ntypedef struct ${capName}Stubs {\n"
+ append text " int magic;\n"
+ append text " struct ${capName}StubHooks *hooks;\n\n"
+
+ emitSlots $name text
+
+ append text "} ${capName}Stubs;\n"
+
+ append text "\n#ifdef __cplusplus\nextern \"C\" {\n#endif\n"
+ append text "extern ${capName}Stubs *${name}StubsPtr;\n"
+ append text "#ifdef __cplusplus\n}\n#endif\n"
+
+ emitMacros $name text
+
+ rewriteFile [file join $outDir ${name}Decls.h] $text
+ return
+}
+
+# genStubs::emitStubs --
+#
+# This function emits the body of the <name>Stubs.c file for
+# the specified interface.
+#
+# Arguments:
+# name The name of the interface being emitted.
+#
+# Results:
+# None.
+
+proc genStubs::emitStubs {name} {
+ variable outDir
+
+ append text "\n/*\n * Exported stub functions:\n */\n\n"
+ forAllStubs $name makeStub 0 text
+
+ rewriteFile [file join $outDir ${name}Stubs.c] $text
+ return
+}
+
+# genStubs::emitInit --
+#
+# Generate the table initializers for an interface.
+#
+# Arguments:
+# name The name of the interface to initialize.
+# textVar The variable to use for output.
+#
+# Results:
+# Returns the formatted output.
+
+proc genStubs::emitInit {name textVar} {
+ variable stubs
+ variable hooks
+ upvar $textVar text
+
+ set capName [string toupper [string index $name 0]]
+ append capName [string range $name 1 end]
+
+ if {[info exists hooks($name)]} {
+ append text "\nstatic ${capName}StubHooks ${name}StubHooks = \{\n"
+ set sep " "
+ foreach sub $hooks($name) {
+ append text $sep "&${sub}Stubs"
+ set sep ",\n "
+ }
+ append text "\n\};\n"
+ }
+ append text "\n${capName}Stubs ${name}Stubs = \{\n"
+ append text " TCL_STUB_MAGIC,\n"
+ if {[info exists hooks($name)]} {
+ append text " &${name}StubHooks,\n"
+ } else {
+ append text " NULL,\n"
+ }
+
+ forAllStubs $name makeInit 1 text {" NULL, /* $i */\n"}
+
+ append text "\};\n"
+ return
+}
+
+# genStubs::emitInits --
+#
+# This function emits the body of the <name>StubInit.c file for
+# the specified interface.
+#
+# Arguments:
+# name The name of the interface being emitted.
+#
+# Results:
+# None.
+
+proc genStubs::emitInits {} {
+ variable hooks
+ variable outDir
+ variable libraryName
+ variable interfaces
+
+ # Assuming that dependencies only go one level deep, we need to emit
+ # all of the leaves first to avoid needing forward declarations.
+
+ set leaves {}
+ set roots {}
+ foreach name [lsort [array names interfaces]] {
+ if {[info exists hooks($name)]} {
+ lappend roots $name
+ } else {
+ lappend leaves $name
+ }
+ }
+ foreach name $leaves {
+ emitInit $name text
+ }
+ foreach name $roots {
+ emitInit $name text
+ }
+
+ rewriteFile [file join $outDir ${libraryName}StubInit.c] $text
+}
+
+# genStubs::init --
+#
+# This is the main entry point.
+#
+# Arguments:
+# None.
+#
+# Results:
+# None.
+
+proc genStubs::init {} {
+ global argv argv0
+ variable outDir
+ variable interfaces
+
+ if {[llength $argv] < 2} {
+ puts stderr "usage: $argv0 outDir declFile ?declFile...?"
+ exit 1
+ }
+
+ set outDir [lindex $argv 0]
+
+ foreach file [lrange $argv 1 end] {
+ source $file
+ }
+
+ foreach name [lsort [array names interfaces]] {
+ puts "Emitting $name"
+ emitHeader $name
+ }
+
+ emitInits
+}
+
+# lassign --
+#
+# This function emulates the TclX lassign command.
+#
+# Arguments:
+# valueList A list containing the values to be assigned.
+# args The list of variables to be assigned.
+#
+# Results:
+# Returns any values that were not assigned to variables.
+
+proc lassign {valueList args} {
+ if {[llength $args] == 0} {
+ error "wrong # args: lassign list varname ?varname..?"
+ }
+
+ uplevel [list foreach $args $valueList {break}]
+ return [lrange $valueList [llength $args] end]
+}
+
+genStubs::init
diff --git a/tools/getpage.c b/tools/getpage.c
new file mode 100644
index 0000000..7ac3a14
--- /dev/null
+++ b/tools/getpage.c
@@ -0,0 +1,171 @@
+/*
+** This is a simple program used to retrieve an HTML document using
+** HTTP. The program also fetches all images that the document
+** references.
+*/
+#include <stdio.h>
+#include <stdlib.h>
+#include "getpage.h"
+
+#define stricmp strcasecmp
+
+
+/*
+** Each image to be loaded is an instance of the following structure.
+*/
+typedef struct Image Image;
+struct Image {
+ char *zUrl; /* The URL for this image */
+ char *zLocal; /* The local filename */
+ Image *pNext; /* Next in a list of them all */
+};
+
+static FILE *html; /* Html output to this file. */
+static int nImage = 0; /* Number of images loaded so far */
+static Image *pImage; /* List of all images */
+static global_nErr = 0; /* System wide errors */
+static char baseUrl[1000];/* The base URL */
+static int quiet = 0; /* The quiet flag */
+
+/*
+** Make sure the given URL is loaded as a local file. Return the
+** name of the local file.
+*/
+static char *GetImage(char *zUrl){
+ Image *p;
+ for(p=pImage; p; p=p->pNext){
+ if( strcmp(p->zUrl,zUrl)==0 ){
+ return p->zLocal;
+ }
+ }
+ p = malloc( sizeof(*p) + strlen(zUrl) + 100 );
+ p->zUrl = (char*)&p[1];
+ strcpy(p->zUrl, zUrl);
+ p->zLocal = &p->zUrl[strlen(zUrl)+1];
+ sprintf(p->zLocal,"image%d", ++nImage);
+ p->pNext = pImage;
+ pImage = p;
+ HttpFetch(zUrl, p->zLocal, quiet, 0, 0);
+ return p->zLocal;
+}
+
+/*
+** Print a usage comment and exit
+*/
+void usage(char *argv0){
+ fprintf(stderr,"Usage: %s URL\n",argv0);
+ exit(1);
+}
+
+/*
+** Handle anything that isn't markup
+*/
+static void WordHandler(const char *zText, void *notUsed){
+ fprintf(html, zText);
+}
+
+/*
+** Handle all markup that we don't care about.
+*/
+static void DefaultMarkup(int argc, const char **argv, void *notUsed){
+ int i;
+ fprintf(html,"<%s",argv[0]);
+ for(i=1; i<argc-1; i+=2){
+ fprintf(html," %s=\"%s\"", argv[i], argv[i+1]);
+ }
+ fprintf(html,">");
+}
+
+/*
+** Handler for <IMG> markup
+*/
+static void ImageMarkup(int argc, const char **argv, void *notUsed){
+ int i;
+ for(i=1; i<argc-1; i+=2){
+ if( stricmp(argv[i],"src")==0 ){
+ const char *azUrl[2];
+ char *zResolved;
+ azUrl[0] = argv[i+1];
+ azUrl[1] = 0;
+ zResolved = ResolveUrl(baseUrl, azUrl);
+ if( !quiet ){
+ printf("Resolved: (%s) (%s) -> (%s)\n",baseUrl, azUrl[0], zResolved);
+ }
+ argv[i+1] = GetImage(zResolved);
+ /* printf("%s -> %s -> argv[i+1]\n",argv[i+1], zResolved); */
+ free(zResolved);
+ }
+ }
+ DefaultMarkup(argc, argv, 0);
+}
+
+/*
+** Handler for <BASE> markup
+*/
+static void BaseMarkup(int argc, const char **argv, void *notUsed){
+ int i;
+ for(i=1; i<argc-1; i+=2){
+ if( stricmp(argv[i],"href")==0 ){
+ if( !quiet ){
+ printf("Base Href=%s\n",argv[i+1]);
+ }
+ sprintf(baseUrl,"%.*s", sizeof(baseUrl), argv[i+1]);
+ }
+ }
+}
+
+/*
+** Name of a temporary file
+*/
+static char zTemp[] = "index.html.orig";
+
+/*
+** The main routine
+*/
+int main(int argc, char **argv){
+ int i; /* Loop counter */
+ int nErr; /* Number of errors */
+ int rc; /* Result code */
+ char *zUrl = 0; /* The URL */
+ FILE *in; /* For reading the raw html */
+
+ if( argc<2 ) usage(argv[0]);
+ zUrl = 0;
+ for(i=1; i<argc; i++){
+ if( strcmp(argv[i],"-quiet")==0 ){
+ quiet = 1;
+ }else if( argv[i][0]=='-' ){
+ usage(argv[0]);
+ }else{
+ zUrl = argv[i];
+ }
+ }
+ if( zUrl==0 ) usage(argv[0]);
+ rc = HttpFetch(zUrl, zTemp, quiet, sizeof(baseUrl), baseUrl);
+ if( rc!=200 ){
+ unlink(zTemp);
+ fprintf(stderr,"Unable to fetch base page %s\n", zUrl);
+ exit(1);
+ }
+ in = fopen(zTemp,"r");
+ /* unlink(zTemp); */
+ if( in==0 ){
+ perror("can't reopen temporary file!");
+ exit(1);
+ }
+ html = fopen("index.html","w");
+ if( html==0 ){
+ perror("can't open output file \"index.html\"");
+ exit(1);
+ }
+ SgmlWordHandler(WordHandler);
+ SgmlSpaceHandler(WordHandler);
+ SgmlCommentHandler(WordHandler);
+ SgmlDefaultMarkupHandler(DefaultMarkup);
+ SgmlHandler("img", ImageMarkup);
+ SgmlHandler("base", BaseMarkup);
+ SgmlParse(in, 0);
+ fclose(in);
+ fclose(html);
+ return global_nErr;
+}
diff --git a/tools/htdocs_get_sf_stats b/tools/htdocs_get_sf_stats
new file mode 100755
index 0000000..da563e9
--- /dev/null
+++ b/tools/htdocs_get_sf_stats
@@ -0,0 +1,34 @@
+#!/bin/sh
+# -*-tcl-*-
+# the next line restarts using tclsh \
+exec tclsh "${0}" "${@}"
+
+####################################
+
+set memchan 34191
+set mode full
+set no_table 0
+set limit 10
+set flat 1
+set shows 0
+
+set stat_url http://sourceforge.net/export/projhtml.php?group_id=$memchan&mode=$mode&no_table=$no_table
+set news_url http://sourceforge.net/export/projnews.php?group_id=$memchan&limit=$limit&flat=$flat&show_summaries=$shows
+
+set now [clock format [clock seconds]]
+
+foreach {urlvar destination} {
+ stat_url state/statistics
+ news_url state/news
+} {
+ puts "Retrieving [set $urlvar] --> $destination"
+ exec /usr/bin/wget -q -O $destination [set $urlvar] >/dev/null
+}
+
+puts "Remembering time --> state/sn.time"
+puts [set fh [open state/sn.time w]] $now; close $fh
+
+### Future ### Edit the delivered HTML to fit them better into our site.
+### Done inside of the page generation templates !
+
+exit
diff --git a/tools/htdocs_refresh b/tools/htdocs_refresh
new file mode 100755
index 0000000..85923d8
--- /dev/null
+++ b/tools/htdocs_refresh
@@ -0,0 +1,11 @@
+#!/bin/sh
+
+cd `dirname $0`/../htdocs
+
+out=$HOME/logs/crontab
+mkdir -p `dirname $out`
+
+../tools/htdocs_get_sf_stats >> $out 2>&1
+../tools/htdocs_regen >> $out 2>&1
+
+exit
diff --git a/tools/htdocs_regen b/tools/htdocs_regen
new file mode 100755
index 0000000..c7ed7a3
--- /dev/null
+++ b/tools/htdocs_regen
@@ -0,0 +1,12 @@
+#!/bin/sh
+
+# Assume call with pwd = 'htdocs'.
+
+for i in `ls raw/*.exp`
+do
+ echo $i '-->' `basename $i .exp`.html
+ ../tools/expand -rules ../tools/rules/memchan $i > `basename $i .exp`.html
+done
+
+rm index.php
+ln -s index.html index.php
diff --git a/tools/htdocs_setup b/tools/htdocs_setup
new file mode 100755
index 0000000..b29d325
--- /dev/null
+++ b/tools/htdocs_setup
@@ -0,0 +1,42 @@
+#!/bin/sh
+#
+# Called in response to changes in the cvs repository of memchan
+# Assumes that the changed files were already retrieved. Uses them to
+# regenerate the whole website.
+
+# pwd = /home/groups/m/me/memchan/
+
+# Remove old temporary information.
+
+rm -rf doc
+mkdir doc
+
+cp -r memchan/doc/* doc/
+cp -r memchan/htdocs/* htdocs/
+
+# Regenerate the external representatons of all manpages, and the site
+# itself. At last generate bundles of the documentation for download.
+
+out=$HOME/logs/crontab
+mkdir -p `dirname $out`
+rm $out ; touch $out
+
+cd doc ; ../tools/manpage_regen >>$out ; cd ..
+cd htdocs ; ../tools/htdocs_refresh ; cd ..
+
+tar cf - doc/*.n | gzip -9 > memchan.nroff.tar.gz
+tar cf - doc/*.n | bzip2 > memchan.nroff.tar.bz2
+zip memchan.nroff.tar.zip doc/*.n > /dev/null
+tar cf - doc/*.html | gzip -9 > memchan.html.tar.gz
+tar cf - doc/*.html | bzip2 > memchan.html.tar.bz2
+zip memchan.html.tar.zip doc/*.html > /dev/null
+tar cf - doc/*.tmml | gzip -9 > memchan.tmml.tar.gz
+tar cf - doc/*.tmml | bzip2 > memchan.tmml.tar.bz2
+zip memchan.tmml.tar.zip doc/*.tmml > /dev/null
+
+mkdir -p htdocs/doc
+mv memchan.* htdocs/doc/
+
+(sleep 5 ; cp -r memchan/tools/* tools/) &
+
+exit
diff --git a/tools/httpget.c b/tools/httpget.c
new file mode 100644
index 0000000..3532147
--- /dev/null
+++ b/tools/httpget.c
@@ -0,0 +1,188 @@
+/*
+** This file contains code to fetch a single URL into a local file.
+*/
+#include <stdio.h>
+#include <netdb.h>
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <linux/in.h>
+#include "httpget.h"
+
+#define strnicmp strncasecmp
+
+/*
+** Get a URL using HTTP. Return the result code. If a Location: field
+** appears in the header, write it into zLocation[]. Location[] should
+** be at least 200 characters in size.
+*/
+static int
+HttpTryOnce(char *zUrl, char *zLocalFile, int quiet, char *zLocation){
+ int i, j;
+ int nErr = 0; /* Number of errors */
+ char *zPath; /* Pathname to send as second argument to GET */
+ int iPort; /* TCP port for the server */
+ struct hostent *pHost; /* Name information */
+ int s; /* The main communications socket */
+ int c; /* A character read from the remote side */
+ int n; /* Number of characters in header */
+ int rc = 200; /* The result code */
+ FILE *sock; /* FILE corresponding to file descriptor s */
+ FILE *out; /* Write output here */
+ int last_was_nl; /* TRUE if last character received was '\n' */
+ struct sockaddr_in addr; /* The address structure */
+ int nByte = 0;
+ char zIpAddr[400]; /* The IP address of the server to print */
+ char zMsg[1000]; /* Space to hold error messages */
+ char zLine[1000]; /* A single line of the header */
+
+ out = fopen(zLocalFile, "w");
+ if( out==0 ){
+ sprintf(zMsg, "can't open output fule \"%.100s\"", zLocalFile);
+ perror(zMsg);
+ return 1;
+ }
+
+ i = 0;
+ if( strnicmp(zUrl,"http:",5)==0 ){ i = 5; }
+ while( zUrl[i]=='/' ){ i++; }
+ j = 0;
+ while( zUrl[i] && zUrl[i]!=':' && zUrl[i]!='/' ){
+ if( j<sizeof(zIpAddr)-1 ){ zIpAddr[j++] = zUrl[i]; }
+ i++;
+ }
+ zIpAddr[j] = 0;
+ if( zUrl[i]==':' ){
+ iPort = 0;
+ i++;
+ while( isdigit(zUrl[i]) ){
+ iPort = iPort*10 + zUrl[i] - '0';
+ i++;
+ }
+ }else{
+ iPort = 80;
+ }
+ zPath = &zUrl[i];
+
+ addr.sin_family = AF_INET;
+ addr.sin_port = htons(iPort);
+ *(int*)&addr.sin_addr = inet_addr(zIpAddr);
+ if( -1 == *(int*)&addr.sin_addr ){
+ pHost = gethostbyname(zIpAddr);
+ if( pHost==0 ){
+ fprintf(stderr,"can't resolve host name: %s\n",zIpAddr);
+ return 1;
+ }
+ memcpy(&addr.sin_addr,pHost->h_addr_list[0],pHost->h_length);
+ if( !quiet ){
+ fprintf(stderr,"Address resolution: %s -> %d.%d.%d.%d\n",zIpAddr,
+ pHost->h_addr_list[0][0]&0xff,
+ pHost->h_addr_list[0][1]&0xff,
+ pHost->h_addr_list[0][2]&0xff,
+ pHost->h_addr_list[0][3]&0xff);
+ }
+ }
+ s = socket(AF_INET,SOCK_STREAM,0);
+ if( s<0 ){
+ sprintf(zMsg,"can't open socket to %.100s", zIpAddr);
+ perror(zMsg);
+ fclose(out);
+ return 1;
+ }
+ if( connect(s,(struct sockaddr*)&addr,sizeof(addr))<0 ){
+ sprintf(zMsg,"can't connect to host %.100s", zIpAddr);
+ perror(zMsg);
+ fclose(out);
+ return 1;
+ }
+ sock = fdopen(s,"r+");
+ if( *zPath==0 ) zPath = "/";
+ fprintf(sock,"GET %s HTTP/1.0\r\n",zPath);
+ fprintf(sock,"User-Agent: Mozilla/2.0 (X11; U; Linux 0.99p17 i486)\r\n");
+ if( iPort!=80 ){
+ fprintf(sock,"Host: %s:%d\r\n", zIpAddr, iPort);
+ }else{
+ fprintf(sock,"Host: %s\r\n", zIpAddr);
+ }
+ fprintf(sock,"Accept: image/gif, image/x-xbitmap, image/jpeg, */*\r\n");
+ fprintf(sock,"\r\n");
+ fflush(sock);
+ n = 0;
+ rc = 0;
+ while( (c=getc(sock))!=EOF && (c!='\n' || !last_was_nl) ){
+ if( c=='\r' ) continue;
+ last_was_nl = (c=='\n');
+ if( last_was_nl ){
+ zLine[n] = 0;
+ if( strncmp(zLine,"Location:",9)==0 && zLocation ){
+ int j, k;
+ for(j=9; isspace(zLine[j]); j++){}
+ k = 0;
+ while( zLine[j] && !isspace(zLine[j]) && k<199 ){
+ zLocation[k++] = zLine[j++];
+ }
+ zLocation[k] = 0;
+ if( !quiet ) fprintf(stderr,"Location: %s\n", zLocation);
+ }else if( rc==0 ){
+ sscanf(zLine,"HTTP/%*d.%*d %d ",&rc);
+ if( !quiet ) fprintf(stderr,"Status: %d\n", rc);
+ }
+ }
+ if( n<sizeof(zLine)-1 ){ zLine[n++] = c; }
+ if( last_was_nl ){ n = 0; }
+ }
+ if( rc==0 ) rc = 200;
+ if( !quiet ){
+ fprintf(stderr, "Reading %s...", zUrl);
+ }
+ while( (c=getc(sock))!=EOF ){
+ nByte++;
+ putc(c,out);
+ }
+ if( !quiet ){
+ fprintf(stderr, " %d bytes\n", nByte);
+ }
+ fclose(sock);
+ fclose(out);
+ return rc;
+}
+
+/*
+** Get the file. Take up to 7 redirects.
+*/
+int HttpFetch(
+ char *zUrl, /* Fetch this URL */
+ char *zLocalFile, /* Write to this file */
+ int quiet, /* Be quiet if true */
+ int nActual, /* Size of zActual[] */
+ char *zActual /* Write actual URL retrieved here */
+){
+ int i;
+ int rc;
+ char *zOriginalUrl = zUrl;
+ char zLocation[300];
+
+ for(i=0; i<7; i++){
+ if( !quiet ) fprintf(stderr,"HTTP: %s -> %s\n", zUrl, zLocalFile);
+ rc = HttpTryOnce(zUrl, zLocalFile, quiet, zLocation);
+ if( rc==301 || rc==302 ){
+ char *z;
+ const char *az[2];
+ az[0] = zLocation;
+ az[1] = 0;
+ z = ResolveUrl(zUrl, az);
+ if( zUrl!=zOriginalUrl ){
+ free(zUrl);
+ }
+ zUrl = z;
+ }else{
+ break;
+ }
+ }
+ if( nActual>0 && zActual!=0 ){
+ sprintf(zActual, "%.*s", nActual, zUrl);
+ }
+ if( zUrl!=zOriginalUrl ){
+ free(zUrl);
+ }
+ return rc;
+}
diff --git a/tools/importicons.tcl b/tools/importicons.tcl
new file mode 100644
index 0000000..4639087
--- /dev/null
+++ b/tools/importicons.tcl
@@ -0,0 +1,24 @@
+package require base64
+
+set dir /Users/dan/tmp/tango-icon-theme-0.8.1/32x32/
+
+set A(hv3_previmg) actions/go-previous.png
+set A(hv3_nextimg) actions/go-next.png
+set A(hv3_stopimg) actions/process-stop.png
+set A(hv3_newimg) actions/tab-new.png
+set A(hv3_reloadimg) actions/view-refresh.png
+set A(hv3_homeimg) actions/go-home.png
+set A(hv3_bugimg) actions/mail-message-new.png
+
+puts "proc color_icons {} {"
+foreach {key value} [array get A] {
+ set fd [open [file join $dir $value]]
+ fconfigure $fd -translation binary -encoding binary
+ set data [read $fd]
+ close $fd
+
+ puts "image create photo $key -data {"
+ puts [base64 -mode encode $data]
+ puts "}"
+}
+puts "}"
diff --git a/tclconfig/install-sh b/tools/install-sh
similarity index 100%
copy from tclconfig/install-sh
copy to tools/install-sh
diff --git a/tools/makeheaders.c b/tools/makeheaders.c
new file mode 100644
index 0000000..4541e7c
--- /dev/null
+++ b/tools/makeheaders.c
@@ -0,0 +1,3134 @@
+/*
+** This program scans C and C++ source files and automatically generates
+** appropriate header files.
+** %Z% %P% %I% %G% %Z%
+*/
+#include <stdio.h>
+#include <stdlib.h>
+#include <ctype.h>
+#include <memory.h>
+#include <sys/stat.h>
+#include <assert.h>
+#ifndef WIN32
+# include <unistd.h>
+#else
+# include <string.h>
+#endif
+
+/*
+** Macros for debugging.
+*/
+#ifdef DEBUG
+static int debugMask = 0;
+# define debug0(F,M) if( (F)&debugMask ){ fprintf(stderr,M); }
+# define debug1(F,M,A) if( (F)&debugMask ){ fprintf(stderr,M,A); }
+# define debug2(F,M,A,B) if( (F)&debugMask ){ fprintf(stderr,M,A,B); }
+# define debug3(F,M,A,B,C) if( (F)&debugMask ){ fprintf(stderr,M,A,B,C); }
+# define PARSER 0x00000001
+# define DECL_DUMP 0x00000002
+# define TOKENIZER 0x00000004
+#else
+# define debug0(Flags, Format)
+# define debug1(Flags, Format, A)
+# define debug2(Flags, Format, A, B)
+# define debug3(Flags, Format, A, B, C)
+#endif
+
+/*
+** The following macros are purely for the purpose of testing this
+** program on itself. They don't really contribute to the code.
+*/
+#define INTERFACE 1
+#define EXPORT_INTERFACE 1
+#define EXPORT
+
+/*
+** Each token in a source file is represented by an instance of
+** the following structure. Tokens are collected onto a list.
+*/
+typedef struct Token Token;
+struct Token {
+ const char *zText; /* The text of the token */
+ int nText; /* Number of characters in the token's text */
+ int eType; /* The type of this token */
+ int nLine; /* The line number on which the token starts */
+ Token *pComment; /* Most recent block comment before this token */
+ Token *pNext; /* Next token on the list */
+ Token *pPrev; /* Previous token on the list */
+};
+
+/*
+** During tokenization, information about the state of the input
+** stream is held in an instance of the following structure
+*/
+typedef struct InStream InStream;
+struct InStream {
+ const char *z; /* Complete text of the input */
+ int i; /* Next character to read from the input */
+ int nLine; /* The line number for character z[i] */
+};
+
+/*
+** Each declaration in the C or C++ source files is parsed out and stored as
+** an instance of the following structure.
+**
+** A "forward declaration" is a declaration that an object exists that
+** doesn't tell about the objects structure. A typical forward declaration
+** is:
+**
+** struct Xyzzy;
+**
+** Not every object has a forward declaration. If it does, thought, the
+** forward declaration will be contained in the zFwd field for C and
+** the zFwdCpp for C++. The zDecl field contains the complete
+** declaration text.
+*/
+typedef struct Decl Decl;
+struct Decl {
+ char *zName; /* Name of the object being declared. The appearance
+ ** of this name is a source file triggers the declaration
+ ** to be added to the header for that file. */
+ char *zFile; /* File from which extracted. */
+ char *zIf; /* Surround the declaration with this #if */
+ char *zFwd; /* A forward declaration. NULL if there is none. */
+ char *zFwdCpp; /* Use this forward declaration for C++. */
+ char *zDecl; /* A full declaration of this object */
+ struct Include *pInclude; /* #includes that come before this declaration */
+ int flags; /* See the "Properties" below */
+ Token *pComment; /* A block comment associated with this declaration */
+ Token tokenCode; /* Implementation of functions and procedures */
+ Decl *pSameName; /* Next declaration with the same "zName" */
+ Decl *pSameHash; /* Next declaration with same hash but different zName */
+ Decl *pNext; /* Next declaration with a different name */
+};
+
+/*
+** Properties associated with declarations.
+**
+** DP_Forward and DP_Declared are used during the generation of a single
+** header file in order to prevent duplicate declarations and definitions.
+** DP_Forward is set after the object has been given a forward declaration
+** and DP_Declared is set after the object gets a full declarations.
+** (Example: A forward declaration is "typedef struct Abc Abc;" and the
+** full declaration is "struct Abc { int a; float b; };".)
+**
+** The DP_Export and DP_Local flags are more permanent. They mark objects
+** that have EXPORT scope and LOCAL scope respectively. If both of these
+** marks are missing, then the object has library scope. The meanings of
+** the scopes are as follows:
+**
+** LOCAL scope The object is only usable within the file in
+** which it is declared.
+**
+** library scope The object is visible and usable within other
+** files in the same project. By if the project is
+** a library, then the object is not visible to users
+** of the library. (i.e. the object does not appear
+** in the output when using the -H option.)
+**
+** EXPORT scope The object is visible and usable everywhere.
+**
+** The DP_Flag is a temporary use flag that is used during processing to
+** prevent an infinite loop. It's use is localized.
+**
+** The DP_Cplusplus, DP_ExternCReqd and DP_ExternReqd flags are permanent
+** and are used to specify what type of declaration the object requires.
+*/
+#define DP_Forward 0x001 /* Has a forward declaration in this file */
+#define DP_Declared 0x002 /* Has a full declaration in this file */
+#define DP_Export 0x004 /* Export this declaration */
+#define DP_Local 0x008 /* Declare in its home file only */
+#define DP_Flag 0x010 /* Use to mark a subset of a Decl list
+ ** for special processing */
+#define DP_Cplusplus 0x020 /* Has C++ linkage and cannot appear in a
+ ** C header file */
+#define DP_ExternCReqd 0x040 /* Prepend 'extern "C"' in a C++ header.
+ ** Prepend nothing in a C header */
+#define DP_ExternReqd 0x080 /* Prepend 'extern "C"' in a C++ header if
+ ** DP_Cplusplus is not also set. If DP_Cplusplus
+ ** is set or this is a C header then
+ ** prepend 'extern' */
+
+/*
+** Convenience macros for dealing with declaration properties
+*/
+#define DeclHasProperty(D,P) (((D)->flags&(P))==(P))
+#define DeclHasAnyProperty(D,P) (((D)->flags&(P))!=0)
+#define DeclSetProperty(D,P) (D)->flags |= (P)
+#define DeclClearProperty(D,P) (D)->flags &= ~(P)
+
+/*
+** These are state properties of the parser. Each of the values is
+** distinct from the DP_ values above so that both can be used in
+** the same "flags" field.
+**
+** Be careful not to confuse PS_Export with DP_Export or
+** PS_Local with DP_Local. Their names are similar, but the meanings
+** of these flags are very different.
+*/
+#define PS_Extern 0x000800 /* "extern" has been seen */
+#define PS_Export 0x001000 /* If between "#if EXPORT_INTERFACE"
+ ** and "#endif" */
+#define PS_Export2 0x002000 /* If "EXPORT" seen */
+#define PS_Typedef 0x004000 /* If "typedef" has been seen */
+#define PS_Static 0x008000 /* If "static" has been seen */
+#define PS_Interface 0x010000 /* If within #if INTERFACE..#endif */
+#define PS_Method 0x020000 /* If "::" token has been seen */
+#define PS_Local 0x040000 /* If within #if LOCAL_INTERFACE..#endif */
+#define PS_Local2 0x080000 /* If "LOCAL" seen. */
+
+/*
+** The following set of flags are ORed into the "flags" field of
+** a Decl in order to identify what type of object is being
+** declared.
+*/
+#define TY_Class 0x00100000
+#define TY_Subroutine 0x00200000
+#define TY_Macro 0x00400000
+#define TY_Typedef 0x00800000
+#define TY_Variable 0x01000000
+#define TY_Structure 0x02000000
+#define TY_Union 0x04000000
+#define TY_Enumeration 0x08000000
+#define TY_Defunct 0x10000000 /* Used to erase a declaration */
+
+/*
+** Each nested #if (or #ifdef or #ifndef) is stored in a stack of
+** instances of the following structure.
+*/
+typedef struct Ifmacro Ifmacro;
+struct Ifmacro {
+ int nLine; /* Line number where this macro occurs */
+ char *zCondition; /* Text of the condition for this macro */
+ Ifmacro *pNext; /* Next down in the stack */
+ int flags; /* Can hold PS_Export, PS_Interface or PS_Local flags */
+};
+
+/*
+** When parsing a file, we need to keep track of what other files have
+** be #include-ed. For each #include found, we create an instance of
+** the following structure.
+*/
+typedef struct Include Include;
+struct Include {
+ char *zFile; /* The name of file include. Includes "" or <> */
+ char *zIf; /* If not NULL, #include should be enclosed in #if */
+ char *zLabel; /* A unique label used to test if this #include has
+ * appeared already in a file or not */
+ Include *pNext; /* Previous include file, or NULL if this is the first */
+};
+
+/*
+** Identifiers found in a source file that might be used later to provoke
+** the copying of a declaration into the corresponding header file are
+** stored in a hash table as instances of the following structure.
+*/
+typedef struct Ident Ident;
+struct Ident {
+ char *zName; /* The text of this identifier */
+ Ident *pCollide; /* Next identifier with the same hash */
+ Ident *pNext; /* Next identifier in a list of them all */
+};
+
+/*
+** A complete table of identifiers is stored in an instance of
+** the next structure.
+*/
+#define IDENT_HASH_SIZE 2237
+typedef struct IdentTable IdentTable;
+struct IdentTable {
+ Ident *pList; /* List of all identifiers in this table */
+ Ident *apTable[IDENT_HASH_SIZE]; /* The hash table */
+};
+
+/*
+** The following structure holds all information for a single
+** source file named on the command line of this program.
+*/
+typedef struct InFile InFile;
+struct InFile {
+ char *zSrc; /* Name of input file */
+ char *zHdr; /* Name of the generated .h file for this input.
+ ** Will be NULL if input is to be scanned only */
+ int flags; /* One or more DP_, PS_ and/or TY_ flags */
+ InFile *pNext; /* Next input file in the list of them all */
+ IdentTable idTable; /* All identifiers in this input file */
+};
+
+/*
+** An unbounded string is able to grow without limit. We use these
+** to construct large in-memory strings from lots of smaller components.
+*/
+typedef struct String String;
+struct String {
+ int nAlloc; /* Number of bytes allocated */
+ int nUsed; /* Number of bytes used (not counting null terminator) */
+ char *zText; /* Text of the string */
+};
+
+/*
+** The following structure contains a lot of state information used
+** while generating a .h file. We put the information in this structure
+** and pass around a pointer to this structure, rather than pass around
+** all of the information separately. This helps reduce the number of
+** arguments to generator functions.
+*/
+typedef struct GenState GenState;
+struct GenState {
+ String *pStr; /* Write output to this string */
+ IdentTable *pTable; /* A table holding the zLabel of every #include that
+ * has already been generated. Used to avoid
+ * generating duplicate #includes. */
+ const char *zIf; /* If not NULL, then we are within a #if with
+ * this argument. */
+ int nErr; /* Number of errors */
+ const char *zFilename; /* Name of the source file being scanned */
+ int flags; /* Various flags (DP_ and PS_ flags above) */
+};
+
+/*
+** The following text line appears at the top of every file generated
+** by this program. By recognizing this line, the program can be sure
+** never to read a file that it generated itself.
+*/
+const char zTopLine[] =
+ "/* \aThis file was automatically generated. Do not edit! */\n";
+#define nTopLine (sizeof(zTopLine)-1)
+
+/*
+** The name of the file currently being parsed.
+*/
+static char *zFilename;
+
+/*
+** The stack of #if macros for the file currently being parsed.
+*/
+static Ifmacro *ifStack = 0;
+
+/*
+** A list of all files that have been #included so far in a file being
+** parsed.
+*/
+static Include *includeList = 0;
+
+/*
+** The last block comment seen.
+*/
+static Token *blockComment = 0;
+
+/*
+** The following flag is set if the -doc flag appears on the
+** command line.
+*/
+static int doc_flag = 0;
+
+/*
+** If the following flag is set, then makeheaders will attempt to
+** generate prototypes for static functions and procedures.
+*/
+static int proto_static = 0;
+
+/*
+** A list of all declarations. The list is held together using the
+** pNext field of the Decl structure.
+*/
+static Decl *pDeclFirst; /* First on the list */
+static Decl *pDeclLast; /* Last on the list */
+
+/*
+** A hash table of all declarations
+*/
+#define DECL_HASH_SIZE 3371
+static Decl *apTable[DECL_HASH_SIZE];
+
+/*
+** The TEST macro must be defined to something. Make sure this is the
+** case.
+*/
+#ifndef TEST
+# define TEST 0
+#endif
+
+#ifdef NOT_USED
+/*
+** We do our own assertion macro so that we can have more control
+** over debugging.
+*/
+#define Assert(X) if(!(X)){ CantHappen(__LINE__); }
+#define CANT_HAPPEN CantHappen(__LINE__)
+static void CantHappen(int iLine){
+ fprintf(stderr,"Assertion failed on line %d\n",iLine);
+ *(char*)1 = 0; /* Force a core-dump */
+}
+#endif
+
+/*
+** Memory allocation functions that are guaranteed never to return NULL.
+*/
+static void *SafeMalloc(int nByte){
+ void *p = malloc( nByte );
+ if( p==0 ){
+ fprintf(stderr,"Out of memory. Can't allocate %d bytes.\n",nByte);
+ exit(1);
+ }
+ return p;
+}
+static void SafeFree(void *pOld){
+ if( pOld ){
+ free(pOld);
+ }
+}
+static void *SafeRealloc(void *pOld, int nByte){
+ void *p;
+ if( pOld==0 ){
+ p = SafeMalloc(nByte);
+ }else{
+ p = realloc(pOld, nByte);
+ if( p==0 ){
+ fprintf(stderr,
+ "Out of memory. Can't enlarge an allocation to %d bytes\n",nByte);
+ exit(1);
+ }
+ }
+ return p;
+}
+static char *StrDup(const char *zSrc, int nByte){
+ char *zDest;
+ if( nByte<=0 ){
+ nByte = strlen(zSrc);
+ }
+ zDest = SafeMalloc( nByte + 1 );
+ strncpy(zDest,zSrc,nByte);
+ zDest[nByte] = 0;
+ return zDest;
+}
+
+/*
+** Return TRUE if the character X can be part of an identifier
+*/
+#define ISALNUM(X) ((X)=='_' || isalnum(X))
+
+/*
+** Routines for dealing with unbounded strings.
+*/
+static void StringInit(String *pStr){
+ pStr->nAlloc = 0;
+ pStr->nUsed = 0;
+ pStr->zText = 0;
+}
+static void StringReset(String *pStr){
+ SafeFree(pStr->zText);
+ StringInit(pStr);
+}
+static void StringAppend(String *pStr, const char *zText, int nByte){
+ if( nByte<=0 ){
+ nByte = strlen(zText);
+ }
+ if( pStr->nUsed + nByte >= pStr->nAlloc ){
+ if( pStr->nAlloc==0 ){
+ pStr->nAlloc = nByte + 100;
+ pStr->zText = SafeMalloc( pStr->nAlloc );
+ }else{
+ pStr->nAlloc = pStr->nAlloc*2 + nByte;
+ pStr->zText = SafeRealloc(pStr->zText, pStr->nAlloc);
+ }
+ }
+ strncpy(&pStr->zText[pStr->nUsed],zText,nByte);
+ pStr->nUsed += nByte;
+ pStr->zText[pStr->nUsed] = 0;
+}
+#define StringGet(S) ((S)->zText?(S)->zText:"")
+
+/*
+** Compute a hash on a string. The number returned is a non-negative
+** value between 0 and 2**31 - 1
+*/
+static int Hash(const char *z, int n){
+ int h = 0;
+ if( n<=0 ){
+ n = strlen(z);
+ }
+ while( n-- ){
+ h = h ^ (h<<5) ^ *z++;
+ }
+ if( h<0 ) h = -h;
+ return h;
+}
+
+/*
+** Given an identifier name, try to find a declaration for that
+** identifier in the hash table. If found, return a pointer to
+** the Decl structure. If not found, return 0.
+*/
+static Decl *FindDecl(const char *zName, int len){
+ int h;
+ Decl *p;
+
+ if( len<=0 ){
+ len = strlen(zName);
+ }
+ h = Hash(zName,len) % DECL_HASH_SIZE;
+ p = apTable[h];
+ while( p && (strncmp(p->zName,zName,len)!=0 || p->zName[len]!=0) ){
+ p = p->pSameHash;
+ }
+ return p;
+}
+
+/*
+** Install the given declaration both in the hash table and on
+** the list of all declarations.
+*/
+static void InstallDecl(Decl *pDecl){
+ int h;
+ Decl *pOther;
+
+ h = Hash(pDecl->zName,0) % DECL_HASH_SIZE;
+ pOther = apTable[h];
+ while( pOther && strcmp(pDecl->zName,pOther->zName)!=0 ){
+ pOther = pOther->pSameHash;
+ }
+ if( pOther ){
+ pDecl->pSameName = pOther->pSameName;
+ pOther->pSameName = pDecl;
+ }else{
+ pDecl->pSameName = 0;
+ pDecl->pSameHash = apTable[h];
+ apTable[h] = pDecl;
+ }
+ pDecl->pNext = 0;
+ if( pDeclFirst==0 ){
+ pDeclFirst = pDeclLast = pDecl;
+ }else{
+ pDeclLast->pNext = pDecl;
+ pDeclLast = pDecl;
+ }
+}
+
+/*
+** Look at the current ifStack. If anything declared at the current
+** position must be surrounded with
+**
+** #if STUFF
+** #endif
+**
+** Then this routine computes STUFF and returns a pointer to it. Memory
+** to hold the value returned is obtained from malloc().
+*/
+static char *GetIfString(void){
+ Ifmacro *pIf;
+ char *zResult = 0;
+ int hasIf = 0;
+ String str;
+
+ for(pIf = ifStack; pIf; pIf=pIf->pNext){
+ if( pIf->zCondition==0 || *pIf->zCondition==0 ) continue;
+ if( !hasIf ){
+ hasIf = 1;
+ StringInit(&str);
+ }else{
+ StringAppend(&str," && ",4);
+ }
+ StringAppend(&str,pIf->zCondition,0);
+ }
+ if( hasIf ){
+ zResult = StrDup(StringGet(&str),0);
+ StringReset(&str);
+ }else{
+ zResult = 0;
+ }
+ return zResult;
+}
+
+/*
+** Create a new declaration and put it in the hash table. Also
+** return a pointer to it so that we can fill in the zFwd and zDecl
+** fields, and so forth.
+*/
+static Decl *CreateDecl(
+ const char *zName, /* Name of the object being declared. */
+ int nName /* Length of the name */
+){
+ Decl *pDecl;
+
+ pDecl = SafeMalloc( sizeof(Decl) + nName + 1);
+ memset(pDecl,0,sizeof(Decl));
+ pDecl->zName = (char*)&pDecl[1];
+ sprintf(pDecl->zName,"%.*s",nName,zName);
+ pDecl->zFile = zFilename;
+ pDecl->pInclude = includeList;
+ pDecl->zIf = GetIfString();
+ InstallDecl(pDecl);
+ return pDecl;
+}
+
+/*
+** Insert a new identifier into an table of identifiers. Return TRUE if
+** a new identifier was inserted and return FALSE if the identifier was
+** already in the table.
+*/
+static int IdentTableInsert(
+ IdentTable *pTable, /* The table into which we will insert */
+ const char *zId, /* Name of the identifiers */
+ int nId /* Length of the identifier name */
+){
+ int h;
+ Ident *pId;
+
+ if( nId<=0 ){
+ nId = strlen(zId);
+ }
+ h = Hash(zId,nId) % IDENT_HASH_SIZE;
+ for(pId = pTable->apTable[h]; pId; pId=pId->pCollide){
+ if( strncmp(zId,pId->zName,nId)==0 && pId->zName[nId]==0 ){
+ /* printf("Already in table: %.*s\n",nId,zId); */
+ return 0;
+ }
+ }
+ pId = SafeMalloc( sizeof(Ident) + nId + 1 );
+ pId->zName = (char*)&pId[1];
+ sprintf(pId->zName,"%.*s",nId,zId);
+ pId->pNext = pTable->pList;
+ pTable->pList = pId;
+ pId->pCollide = pTable->apTable[h];
+ pTable->apTable[h] = pId;
+ /* printf("Add to table: %.*s\n",nId,zId); */
+ return 1;
+}
+
+/*
+** Check to see if the given value is in the given IdentTable. Return
+** true if it is and false if it is not.
+*/
+static int IdentTableTest(
+ IdentTable *pTable, /* The table in which to search */
+ const char *zId, /* Name of the identifiers */
+ int nId /* Length of the identifier name */
+){
+ int h;
+ Ident *pId;
+
+ if( nId<=0 ){
+ nId = strlen(zId);
+ }
+ h = Hash(zId,nId) % IDENT_HASH_SIZE;
+ for(pId = pTable->apTable[h]; pId; pId=pId->pCollide){
+ if( strncmp(zId,pId->zName,nId)==0 && pId->zName[nId]==0 ){
+ return 1;
+ }
+ }
+ return 0;
+}
+
+/*
+** Remove every identifier from the given table. Reset the table to
+** its initial state.
+*/
+static void IdentTableReset(IdentTable *pTable){
+ Ident *pId, *pNext;
+
+ for(pId = pTable->pList; pId; pId = pNext){
+ pNext = pId->pNext;
+ SafeFree(pId);
+ }
+ memset(pTable,0,sizeof(IdentTable));
+}
+
+#ifdef DEBUG
+/*
+** Print the name of every identifier in the given table, one per line
+*/
+static void IdentTablePrint(IdentTable *pTable, FILE *pOut){
+ Ident *pId;
+
+ for(pId = pTable->pList; pId; pId = pId->pNext){
+ fprintf(pOut,"%s\n",pId->zName);
+ }
+}
+#endif
+
+/*
+** Read an entire file into memory. Return a pointer to the memory.
+**
+** The memory is obtained from SafeMalloc and must be freed by the
+** calling function.
+**
+** If the read fails for any reason, 0 is returned.
+*/
+static char *ReadFile(const char *zFilename){
+ struct stat sStat;
+ FILE *pIn;
+ char *zBuf;
+ int n;
+
+ if( stat(zFilename,&sStat)!=0
+#ifndef WIN32
+ || !S_ISREG(sStat.st_mode)
+#endif
+ ){
+ return 0;
+ }
+ pIn = fopen(zFilename,"r");
+ if( pIn==0 ){
+ return 0;
+ }
+ zBuf = SafeMalloc( sStat.st_size + 1 );
+ n = fread(zBuf,1,sStat.st_size,pIn);
+ zBuf[n] = 0;
+ fclose(pIn);
+ return zBuf;
+}
+
+/*
+** Write the contents of a string into a file. Return the number of
+** errors
+*/
+static int WriteFile(const char *zFilename, const char *zOutput){
+ FILE *pOut;
+ pOut = fopen(zFilename,"w");
+ if( pOut==0 ){
+ return 1;
+ }
+ fwrite(zOutput,1,strlen(zOutput),pOut);
+ fclose(pOut);
+ return 0;
+}
+
+/*
+** Major token types
+*/
+#define TT_Space 1 /* Contiguous white space */
+#define TT_Id 2 /* An identifier */
+#define TT_Preprocessor 3 /* Any C preprocessor directive */
+#define TT_Comment 4 /* Either C or C++ style comment */
+#define TT_Number 5 /* Any numeric constant */
+#define TT_String 6 /* String or character constants. ".." or '.' */
+#define TT_Braces 7 /* All text between { and a matching } */
+#define TT_EOF 8 /* End of file */
+#define TT_Error 9 /* An error condition */
+#define TT_BlockComment 10 /* A C-Style comment at the left margin that
+ * spans multple lines */
+#define TT_Other 0 /* None of the above */
+
+/*
+** Get a single low-level token from the input file. Update the
+** file pointer so that it points to the first character beyond the
+** token.
+**
+** A "low-level token" is any token except TT_Braces. A TT_Braces token
+** consists of many smaller tokens and is assembled by a routine that
+** calls this one.
+**
+** The function returns the number of errors. An error is an
+** unterminated string or character literal or an unterminated
+** comment.
+**
+** Profiling shows that this routine consumes about half the
+** CPU time on a typical run of makeheaders.
+*/
+static int GetToken(InStream *pIn, Token *pToken){
+ int i;
+ const char *z;
+ int cStart;
+ int c;
+ int startLine; /* Line on which a structure begins */
+ int nlisc = 0; /* True if there is a new-line in a ".." or '..' */
+ int nErr = 0; /* Number of errors seen */
+
+ z = pIn->z;
+ i = pIn->i;
+ pToken->nLine = pIn->nLine;
+ pToken->zText = &z[i];
+ switch( z[i] ){
+ case 0:
+ pToken->eType = TT_EOF;
+ pToken->nText = 0;
+ break;
+
+ case '#':
+ if( i==0 || z[i-1]=='\n' || (i>1 && z[i-1]=='\r' && z[i-2]=='\n')){
+ /* We found a preprocessor statement */
+ pToken->eType = TT_Preprocessor;
+ i++;
+ while( z[i]!=0 && z[i]!='\n' ){
+ if( z[i]=='\\' ){
+ i++;
+ if( z[i]=='\n' ) pIn->nLine++;
+ }
+ i++;
+ }
+ pToken->nText = i - pIn->i;
+ }else{
+ /* Just an operator */
+ pToken->eType = TT_Other;
+ pToken->nText = 1;
+ }
+ break;
+
+ case ' ':
+ case '\t':
+ case '\r':
+ case '\f':
+ case '\n':
+ while( isspace(z[i]) ){
+ if( z[i]=='\n' ) pIn->nLine++;
+ i++;
+ }
+ pToken->eType = TT_Space;
+ pToken->nText = i - pIn->i;
+ break;
+
+ case '\\':
+ pToken->nText = 2;
+ pToken->eType = TT_Other;
+ if( z[i+1]=='\n' ){
+ pIn->nLine++;
+ pToken->eType = TT_Space;
+ }else if( z[i+1]==0 ){
+ pToken->nText = 1;
+ }
+ break;
+
+ case '\'':
+ case '\"':
+ cStart = z[i];
+ startLine = pIn->nLine;
+ do{
+ i++;
+ c = z[i];
+ if( c=='\n' ){
+ if( !nlisc ){
+ fprintf(stderr,
+ "%s:%d: (warning) Newline in string or character literal.\n",
+ zFilename, pIn->nLine);
+ nlisc = 1;
+ }
+ pIn->nLine++;
+ }
+ if( c=='\\' ){
+ i++;
+ c = z[i];
+ if( c=='\n' ){
+ pIn->nLine++;
+ }
+ }else if( c==cStart ){
+ i++;
+ c = 0;
+ }else if( c==0 ){
+ fprintf(stderr, "%s:%d: Unterminated string or character literal.\n",
+ zFilename, startLine);
+ nErr++;
+ }
+ }while( c );
+ pToken->eType = TT_String;
+ pToken->nText = i - pIn->i;
+ break;
+
+ case '/':
+ if( z[i+1]=='/' ){
+ /* C++ style comment */
+ while( z[i] && z[i]!='\n' ){ i++; }
+ pToken->eType = TT_Comment;
+ pToken->nText = i - pIn->i;
+ }else if( z[i+1]=='*' ){
+ /* C style comment */
+ int isBlockComment = i==0 || z[i-1]=='\n';
+ i += 2;
+ startLine = pIn->nLine;
+ while( z[i] && (z[i]!='*' || z[i+1]!='/') ){
+ if( z[i]=='\n' ){
+ pIn->nLine++;
+ if( isBlockComment ){
+ if( z[i+1]=='*' || z[i+2]=='*' ){
+ isBlockComment = 2;
+ }else{
+ isBlockComment = 0;
+ }
+ }
+ }
+ i++;
+ }
+ if( z[i] ){
+ i += 2;
+ }else{
+ isBlockComment = 0;
+ fprintf(stderr,"%s:%d: Unterminated comment\n",
+ zFilename, startLine);
+ nErr++;
+ }
+ pToken->eType = isBlockComment==2 ? TT_BlockComment : TT_Comment;
+ pToken->nText = i - pIn->i;
+ }else{
+ /* A divide operator */
+ pToken->eType = TT_Other;
+ pToken->nText = 1;
+ }
+ break;
+
+ case '0':
+ if( z[i+1]=='x' || z[i+1]=='X' ){
+ /* A hex constant */
+ i += 2;
+ while( isxdigit(z[i]) ){ i++; }
+ }else{
+ /* An octal constant */
+ while( isdigit(z[i]) ){ i++; }
+ }
+ pToken->eType = TT_Number;
+ pToken->nText = i - pIn->i;
+ break;
+
+ case '1': case '2': case '3': case '4':
+ case '5': case '6': case '7': case '8': case '9':
+ while( isdigit(z[i]) ){ i++; }
+ if( (c=z[i])=='.' ){
+ i++;
+ while( isdigit(z[i]) ){ i++; }
+ c = z[i];
+ if( c=='e' || c=='E' ){
+ i++;
+ if( ((c=z[i])=='+' || c=='-') && isdigit(z[i+1]) ){ i++; }
+ while( isdigit(z[i]) ){ i++; }
+ c = z[i];
+ }
+ if( c=='f' || c=='F' || c=='l' || c=='L' ){ i++; }
+ }else if( c=='e' || c=='E' ){
+ i++;
+ if( ((c=z[i])=='+' || c=='-') && isdigit(z[i+1]) ){ i++; }
+ while( isdigit(z[i]) ){ i++; }
+ }else if( c=='L' || c=='l' ){
+ i++;
+ c = z[i];
+ if( c=='u' || c=='U' ){ i++; }
+ }else if( c=='u' || c=='U' ){
+ i++;
+ c = z[i];
+ if( c=='l' || c=='L' ){ i++; }
+ }
+ pToken->eType = TT_Number;
+ pToken->nText = i - pIn->i;
+ break;
+
+ case 'a': case 'b': case 'c': case 'd': case 'e': case 'f': case 'g':
+ case 'h': case 'i': case 'j': case 'k': case 'l': case 'm': case 'n':
+ case 'o': case 'p': case 'q': case 'r': case 's': case 't': case 'u':
+ case 'v': case 'w': case 'x': case 'y': case 'z': case 'A': case 'B':
+ case 'C': case 'D': case 'E': case 'F': case 'G': case 'H': case 'I':
+ case 'J': case 'K': case 'L': case 'M': case 'N': case 'O': case 'P':
+ case 'Q': case 'R': case 'S': case 'T': case 'U': case 'V': case 'W':
+ case 'X': case 'Y': case 'Z': case '_':
+ while( isalnum(z[i]) || z[i]=='_' ){ i++; };
+ pToken->eType = TT_Id;
+ pToken->nText = i - pIn->i;
+ break;
+
+ default:
+ pToken->eType = TT_Other;
+ pToken->nText = 1;
+ break;
+ }
+ pIn->i += pToken->nText;
+ return nErr;
+}
+
+/*
+** This routine recovers the next token from the input file which is
+** not a space or a comment or any text between an "#if 0" and "#endif".
+**
+** This routine returns the number of errors encountered. An error
+** is an unterminated token or unmatched "#if 0".
+**
+** Profiling shows that this routine uses about a quarter of the
+** CPU time in a typical run.
+*/
+static int GetNonspaceToken(InStream *pIn, Token *pToken){
+ int nIf = 0;
+ int inZero = 0;
+ const char *z;
+ int value;
+ int startLine;
+ int nErr = 0;
+
+ startLine = pIn->nLine;
+ while( 1 ){
+ nErr += GetToken(pIn,pToken);
+ /* printf("%04d: Type=%d nIf=%d [%.*s]\n",
+ pToken->nLine,pToken->eType,nIf,pToken->nText,
+ pToken->eType!=TT_Space ? pToken->zText : "<space>"); */
+ pToken->pComment = blockComment;
+ switch( pToken->eType ){
+ case TT_Comment:
+ case TT_Space:
+ break;
+
+ case TT_BlockComment:
+ if( doc_flag ){
+ blockComment = SafeMalloc( sizeof(Token) );
+ *blockComment = *pToken;
+ }
+ break;
+
+ case TT_EOF:
+ if( nIf ){
+ fprintf(stderr,"%s:%d: Unterminated \"#if\"\n",
+ zFilename, startLine);
+ nErr++;
+ }
+ return nErr;
+
+ case TT_Preprocessor:
+ z = &pToken->zText[1];
+ while( *z==' ' || *z=='\t' ) z++;
+ if( sscanf(z,"if %d",&value)==1 && value==0 ){
+ nIf++;
+ inZero = 1;
+ }else if( inZero ){
+ if( strncmp(z,"if",2)==0 ){
+ nIf++;
+ }else if( strncmp(z,"endif",5)==0 ){
+ nIf--;
+ if( nIf==0 ) inZero = 0;
+ }
+ }else{
+ return nErr;
+ }
+ break;
+
+ default:
+ if( !inZero ){
+ return nErr;
+ }
+ break;
+ }
+ }
+ /* NOT REACHED */
+}
+
+/*
+** This routine looks for identifiers (strings of contiguous alphanumeric
+** characters) within a preprocessor directive and adds every such string
+** found to the given identifier table
+*/
+static void FindIdentifiersInMacro(Token *pToken, IdentTable *pTable){
+ Token sToken;
+ InStream sIn;
+ int go = 1;
+
+ sIn.z = pToken->zText;
+ sIn.i = 1;
+ sIn.nLine = 1;
+ while( go && sIn.i < pToken->nText ){
+ GetToken(&sIn,&sToken);
+ switch( sToken.eType ){
+ case TT_Id:
+ IdentTableInsert(pTable,sToken.zText,sToken.nText);
+ break;
+
+ case TT_EOF:
+ go = 0;
+ break;
+
+ default:
+ break;
+ }
+ }
+}
+
+/*
+** This routine gets the next token. Everything contained within
+** {...} is collapsed into a single TT_Braces token. Whitespace is
+** omitted.
+**
+** If pTable is not NULL, then insert every identifier seen into the
+** IdentTable. This includes any identifiers seen inside of {...}.
+**
+** The number of errors encountered is returned. An error is an
+** unterminated token.
+*/
+static int GetBigToken(InStream *pIn, Token *pToken, IdentTable *pTable){
+ const char *z, *zStart;
+ int iStart;
+ int nBrace;
+ int c;
+ int nLine;
+ int nErr;
+
+ nErr = GetNonspaceToken(pIn,pToken);
+ switch( pToken->eType ){
+ case TT_Id:
+ if( pTable!=0 ){
+ IdentTableInsert(pTable,pToken->zText,pToken->nText);
+ }
+ return nErr;
+
+ case TT_Preprocessor:
+ if( pTable!=0 ){
+ FindIdentifiersInMacro(pToken,pTable);
+ }
+ return nErr;
+
+ case TT_Other:
+ if( pToken->zText[0]=='{' ) break;
+ return nErr;
+
+ default:
+ return nErr;
+ }
+
+ z = pIn->z;
+ iStart = pIn->i;
+ zStart = pToken->zText;
+ nLine = pToken->nLine;
+ nBrace = 1;
+ while( nBrace ){
+ nErr += GetNonspaceToken(pIn,pToken);
+ /* printf("%04d: nBrace=%d [%.*s]\n",pToken->nLine,nBrace,
+ pToken->nText,pToken->zText); */
+ switch( pToken->eType ){
+ case TT_EOF:
+ fprintf(stderr,"%s:%d: Unterminated \"{\"\n",
+ zFilename, nLine);
+ nErr++;
+ pToken->eType = TT_Error;
+ return nErr;
+
+ case TT_Id:
+ if( pTable ){
+ IdentTableInsert(pTable,pToken->zText,pToken->nText);
+ }
+ break;
+
+ case TT_Preprocessor:
+ if( pTable!=0 ){
+ FindIdentifiersInMacro(pToken,pTable);
+ }
+ break;
+
+ case TT_Other:
+ if( (c = pToken->zText[0])=='{' ){
+ nBrace++;
+ }else if( c=='}' ){
+ nBrace--;
+ }
+ break;
+
+ default:
+ break;
+ }
+ }
+ pToken->eType = TT_Braces;
+ pToken->nText = 1 + pIn->i - iStart;
+ pToken->zText = zStart;
+ pToken->nLine = nLine;
+ return nErr;
+}
+
+/*
+** This routine frees up a list of Tokens. The pComment tokens are
+** not cleared by this. So we leak a little memory when using the -doc
+** option. So what.
+*/
+static void FreeTokenList(Token *pList){
+ Token *pNext;
+ while( pList ){
+ pNext = pList->pNext;
+ SafeFree(pList);
+ pList = pNext;
+ }
+}
+
+/*
+** Tokenize an entire file. Return a pointer to the list of tokens.
+**
+** Space for each token is obtained from a separate malloc() call. The
+** calling function is responsible for freeing this space.
+**
+** If pTable is not NULL, then fill the table with all identifiers seen in
+** the input file.
+*/
+static Token *TokenizeFile(const char *zFile, IdentTable *pTable){
+ InStream sIn;
+ Token *pFirst = 0, *pLast = 0, *pNew;
+ int nErr = 0;
+
+ sIn.z = zFile;
+ sIn.i = 0;
+ sIn.nLine = 1;
+ blockComment = 0;
+
+ while( sIn.z[sIn.i]!=0 ){
+ pNew = SafeMalloc( sizeof(Token) );
+ nErr += GetBigToken(&sIn,pNew,pTable);
+ debug3(TOKENIZER, "Token on line %d: [%.*s]\n",
+ pNew->nLine, pNew->nText<50 ? pNew->nText : 50, pNew->zText);
+ if( pFirst==0 ){
+ pFirst = pLast = pNew;
+ pNew->pPrev = 0;
+ }else{
+ pLast->pNext = pNew;
+ pNew->pPrev = pLast;
+ pLast = pNew;
+ }
+ if( pNew->eType==TT_EOF ) break;
+ }
+ if( pLast ) pLast->pNext = 0;
+ blockComment = 0;
+ if( nErr ){
+ FreeTokenList(pFirst);
+ pFirst = 0;
+ }
+
+ return pFirst;
+}
+
+#if TEST==1
+/*
+** Use the following routine to test or debug the tokenizer.
+*/
+void main(int argc, char **argv){
+ char *zFile;
+ Token *pList, *p;
+ IdentTable sTable;
+
+ if( argc!=2 ){
+ fprintf(stderr,"Usage: %s filename\n",*argv);
+ exit(1);
+ }
+ memset(&sTable,0,sizeof(sTable));
+ zFile = ReadFile(argv[1]);
+ if( zFile==0 ){
+ fprintf(stderr,"Can't read file \"%s\"\n",argv[1]);
+ exit(1);
+ }
+ pList = TokenizeFile(zFile,&sTable);
+ for(p=pList; p; p=p->pNext){
+ int j;
+ switch( p->eType ){
+ case TT_Space:
+ printf("%4d: Space\n",p->nLine);
+ break;
+ case TT_Id:
+ printf("%4d: Id %.*s\n",p->nLine,p->nText,p->zText);
+ break;
+ case TT_Preprocessor:
+ printf("%4d: Preprocessor %.*s\n",p->nLine,p->nText,p->zText);
+ break;
+ case TT_Comment:
+ printf("%4d: Comment\n",p->nLine);
+ break;
+ case TT_BlockComment:
+ printf("%4d: Block Comment\n",p->nLine);
+ break;
+ case TT_Number:
+ printf("%4d: Number %.*s\n",p->nLine,p->nText,p->zText);
+ break;
+ case TT_String:
+ printf("%4d: String %.*s\n",p->nLine,p->nText,p->zText);
+ break;
+ case TT_Other:
+ printf("%4d: Other %.*s\n",p->nLine,p->nText,p->zText);
+ break;
+ case TT_Braces:
+ for(j=0; j<p->nText && j<30 && p->zText[j]!='\n'; j++){}
+ printf("%4d: Braces %.*s...}\n",p->nLine,j,p->zText);
+ break;
+ case TT_EOF:
+ printf("%4d: End of file\n",p->nLine);
+ break;
+ default:
+ printf("%4d: type %d\n",p->nLine,p->eType);
+ break;
+ }
+ }
+ FreeTokenList(pList);
+ SafeFree(zFile);
+ IdentTablePrint(&sTable,stdout);
+}
+#endif
+
+#ifdef DEBUG
+/*
+** For debugging purposes, write out a list of tokens.
+*/
+static void PrintTokens(Token *pFirst, Token *pLast){
+ int needSpace = 0;
+ int c;
+
+ pLast = pLast->pNext;
+ while( pFirst!=pLast ){
+ switch( pFirst->eType ){
+ case TT_Preprocessor:
+ printf("\n%.*s\n",pFirst->nText,pFirst->zText);
+ needSpace = 0;
+ break;
+
+ case TT_Id:
+ case TT_Number:
+ printf("%s%.*s", needSpace ? " " : "", pFirst->nText, pFirst->zText);
+ needSpace = 1;
+ break;
+
+ default:
+ c = pFirst->zText[0];
+ printf("%s%.*s",
+ (needSpace && (c=='*' || c=='{')) ? " " : "",
+ pFirst->nText, pFirst->zText);
+ needSpace = pFirst->zText[0]==',';
+ break;
+ }
+ pFirst = pFirst->pNext;
+ }
+}
+#endif
+
+/*
+** Convert a sequence of tokens into a string and return a pointer
+** to that string. Space to hold the string is obtained from malloc()
+** and must be freed by the calling function.
+**
+** The characters ";\n" are always appended.
+*/
+static char *TokensToString(Token *pFirst, Token *pLast){
+ char *zReturn;
+ String str;
+ int needSpace = 0;
+ int c;
+
+ StringInit(&str);
+ pLast = pLast->pNext;
+ while( pFirst!=pLast ){
+ switch( pFirst->eType ){
+ case TT_Preprocessor:
+ StringAppend(&str,"\n",1);
+ StringAppend(&str,pFirst->zText,pFirst->nText);
+ StringAppend(&str,"\n",1);
+ needSpace = 0;
+ break;
+
+ case TT_Id:
+ if( pFirst->nText==6 && pFirst->zText[0]=='E'
+ && strncmp(pFirst->zText,"EXPORT",6)==0 ){
+ break;
+ }
+ /* Fall thru to the next case */
+ case TT_Number:
+ if( needSpace ){
+ StringAppend(&str," ",1);
+ }
+ StringAppend(&str,pFirst->zText,pFirst->nText);
+ needSpace = 1;
+ break;
+
+ default:
+ c = pFirst->zText[0];
+ if( needSpace && (c=='*' || c=='{') ){
+ StringAppend(&str," ",1);
+ }
+ StringAppend(&str,pFirst->zText,pFirst->nText);
+ /* needSpace = pFirst->zText[0]==','; */
+ needSpace = 0;
+ break;
+ }
+ pFirst = pFirst->pNext;
+ }
+ StringAppend(&str,";\n",2);
+ zReturn = StrDup(StringGet(&str),0);
+ StringReset(&str);
+ return zReturn;
+}
+
+/*
+** This routine is called when we see one of the keywords "struct",
+** "enum", "union" or "class". This might be the beginning of a
+** type declaration. This routine will process the declaration and
+** remove the declaration tokens from the input stream.
+**
+** If this is a type declaration that is immediately followed by a
+** semicolon (in other words it isn't also a variable definition)
+** then set *pReset to ';'. Otherwise leave *pReset at 0. The
+** *pReset flag causes the parser to skip ahead to the next token
+** that begins with the value placed in the *pReset flag, if that
+** value is different from 0.
+*/
+static int ProcessTypeDecl(Token *pList, int flags, int *pReset){
+ Token *pName, *pEnd;
+ Decl *pDecl;
+ String str;
+ int need_to_collapse = 1;
+
+ *pReset = 0;
+ if( pList==0 || pList->pNext==0 || pList->pNext->eType!=TT_Id ){
+ return 0;
+ }
+ pName = pList->pNext;
+
+ /* Catch the case of "struct Foo;" and skip it. */
+ if( pName->pNext && pName->pNext->zText[0]==';' ){
+ *pReset = ';';
+ return 0;
+ }
+
+ for(pEnd=pName->pNext; pEnd && pEnd->eType!=TT_Braces; pEnd=pEnd->pNext){
+ switch( pEnd->zText[0] ){
+ case '(':
+ case '*':
+ case '[':
+ case '=':
+ case ';':
+ return 0;
+ }
+ }
+ if( pEnd==0 ){
+ return 0;
+ }
+
+ /*
+ ** At this point, we know we have a type declaration that is bounded
+ ** by pList and pEnd and has the name pName.
+ */
+
+ /*
+ ** If the braces are followed immedately by a semicolon, then we are
+ ** dealing a type declaration only. There is not variable definition
+ ** following the type declaration. So reset...
+ */
+ if( pEnd->pNext==0 || pEnd->pNext->zText[0]==';' ){
+ *pReset = ';';
+ need_to_collapse = 0;
+ }else{
+ need_to_collapse = 1;
+ }
+
+ if( proto_static==0 && (flags & (PS_Local|PS_Export|PS_Interface))==0 ){
+ /* Ignore these objects unless they are explicitly declared as interface,
+ ** or unless the "-local" command line option was specified. */
+ *pReset = ';';
+ return 0;
+ }
+
+#ifdef DEBUG
+ if( debugMask & PARSER ){
+ printf("**** Found type: %.*s %.*s...\n",
+ pList->nText, pList->zText, pName->nText, pName->zText);
+ PrintTokens(pList,pEnd);
+ printf(";\n");
+ }
+#endif
+ pDecl = CreateDecl(pName->zText,pName->nText);
+ if( (flags & PS_Static) || !(flags & (PS_Interface|PS_Export)) ){
+ DeclSetProperty(pDecl,DP_Local);
+ }
+ switch( *pList->zText ){
+ case 'c': DeclSetProperty(pDecl,TY_Class); break;
+ case 's': DeclSetProperty(pDecl,TY_Structure); break;
+ case 'e': DeclSetProperty(pDecl,TY_Enumeration); break;
+ case 'u': DeclSetProperty(pDecl,TY_Union); break;
+ default: /* Can't Happen */ break;
+ }
+
+ /* The object has a full declaration only if it is contained within
+ ** "#if INTERFACE...#endif" or "#if EXPORT_INTERFACE...#endif" or
+ ** "#if LOCAL_INTERFACE...#endif". Otherwise, we only give it a
+ ** forward declaration.
+ */
+ if( flags & (PS_Local | PS_Export | PS_Interface) ){
+ pDecl->zDecl = TokensToString(pList,pEnd);
+ }else{
+ pDecl->zDecl = 0;
+ }
+ pDecl->pComment = pList->pComment;
+ StringInit(&str);
+ StringAppend(&str,"typedef ",0);
+ StringAppend(&str,pList->zText,pList->nText);
+ StringAppend(&str," ",0);
+ StringAppend(&str,pName->zText,pName->nText);
+ StringAppend(&str," ",0);
+ StringAppend(&str,pName->zText,pName->nText);
+ StringAppend(&str,";\n",2);
+ pDecl->zFwd = StrDup(StringGet(&str),0);
+ StringReset(&str);
+ StringInit(&str);
+ StringAppend(&str,pList->zText,pList->nText);
+ StringAppend(&str," ",0);
+ StringAppend(&str,pName->zText,pName->nText);
+ StringAppend(&str,";\n",2);
+ pDecl->zFwdCpp = StrDup(StringGet(&str),0);
+ StringReset(&str);
+ if( flags & PS_Export ){
+ DeclSetProperty(pDecl,DP_Export);
+ }else if( flags & PS_Local ){
+ DeclSetProperty(pDecl,DP_Local);
+ }
+
+ /* Here's something weird. ANSI-C doesn't allow a forward declaration
+ ** of an enumeration. So we have to build the typedef into the
+ ** definition.
+ */
+ if( pDecl->zDecl && DeclHasProperty(pDecl, TY_Enumeration) ){
+ StringInit(&str);
+ StringAppend(&str,pDecl->zDecl,0);
+ StringAppend(&str,pDecl->zFwd,0);
+ SafeFree(pDecl->zDecl);
+ SafeFree(pDecl->zFwd);
+ pDecl->zFwd = 0;
+ pDecl->zDecl = StrDup(StringGet(&str),0);
+ StringReset(&str);
+ }
+
+ if( pName->pNext->zText[0]==':' ){
+ DeclSetProperty(pDecl,DP_Cplusplus);
+ }
+ if( pName->nText==5 && strncmp(pName->zText,"class",5)==0 ){
+ DeclSetProperty(pDecl,DP_Cplusplus);
+ }
+
+ /*
+ ** Remove all but pList and pName from the input stream.
+ */
+ if( need_to_collapse ){
+ while( pEnd!=pName ){
+ Token *pPrev = pEnd->pPrev;
+ pPrev->pNext = pEnd->pNext;
+ pEnd->pNext->pPrev = pPrev;
+ SafeFree(pEnd);
+ pEnd = pPrev;
+ }
+ }
+ return 0;
+}
+
+/*
+** Given a list of tokens that declare something (a function, procedure,
+** variable or typedef) find the token which contains the name of the
+** thing being declared.
+**
+** Algorithm:
+**
+** The name is:
+**
+** 1. The first identifier that is followed by a "[", or
+**
+** 2. The first identifier that is followed by a "(" where the
+** "(" is followed by another identifier, or
+**
+** 3. The first identifier followed by "::", or
+**
+** 4. If none of the above, then the last identifier.
+**
+** In all of the above, certain reserved words (like "char") are
+** not considered identifiers.
+*/
+static Token *FindDeclName(Token *pFirst, Token *pLast){
+ Token *pName = 0;
+ Token *p;
+ int c;
+
+ if( pFirst==0 || pLast==0 ){
+ return 0;
+ }
+ pLast = pLast->pNext;
+ for(p=pFirst; p && p!=pLast; p=p->pNext){
+ if( p->eType==TT_Id ){
+ static IdentTable sReserved;
+ static int isInit = 0;
+ static char *aWords[] = { "char", "class",
+ "const", "double", "enum", "extern", "EXPORT", "ET_PROC",
+ "float", "int", "long",
+ "register", "static", "struct", "sizeof", "signed", "typedef",
+ "union", "volatile", "virtual", "void", };
+
+ if( !isInit ){
+ int i;
+ for(i=0; i<sizeof(aWords)/sizeof(aWords[0]); i++){
+ IdentTableInsert(&sReserved,aWords[i],0);
+ }
+ isInit = 1;
+ }
+ if( !IdentTableTest(&sReserved,p->zText,p->nText) ){
+ pName = p;
+ }
+ }else if( p==pFirst ){
+ continue;
+ }else if( (c=p->zText[0])=='[' && pName ){
+ break;
+ }else if( c=='(' && p->pNext && p->pNext->eType==TT_Id && pName ){
+ break;
+ }else if( c==':' && p->zText[1]==':' && pName ){
+ break;
+ }
+ }
+ return pName;
+}
+
+/*
+** This routine is called when we see a function or procedure definition.
+** We make an entry in the declaration table that is a prototype for this
+** function or procedure.
+*/
+static int ProcessProcedureDef(Token *pFirst, Token *pLast, int flags){
+ Token *pName;
+ Decl *pDecl;
+ Token *pCode;
+
+ if( pFirst==0 || pLast==0 ){
+ return 0;
+ }
+ if( flags & PS_Method ){
+ return 0;
+ }
+ if( (flags & PS_Static)!=0 && !proto_static ){
+ return 0;
+ }
+ pCode = pLast;
+ while( pLast && pLast!=pFirst && pLast->zText[0]!=')' ){
+ pLast = pLast->pPrev;
+ }
+ if( pLast==0 || pLast==pFirst || pFirst->pNext==pLast ){
+ fprintf(stderr,"%s:%d: Unrecognized syntax.\n",
+ zFilename, pFirst->nLine);
+ return 1;
+ }
+ if( flags & (PS_Interface|PS_Export|PS_Local) ){
+ fprintf(stderr,"%s:%d: Missing \"inline\" on function or procedure.\n",
+ zFilename, pFirst->nLine);
+ return 1;
+ }
+ pName = FindDeclName(pFirst,pLast);
+ if( pName==0 ){
+ fprintf(stderr,"%s:%d: Malformed function or procedure definition.\n",
+ zFilename, pFirst->nLine);
+ return 1;
+ }
+
+ /*
+ ** At this point we've isolated a procedure declaration between pFirst
+ ** and pLast with the name pName.
+ */
+#ifdef DEBUG
+ if( debugMask & PARSER ){
+ printf("**** Found routine: %.*s on line %d...\n", pName->nText,
+ pName->zText, pFirst->nLine);
+ PrintTokens(pFirst,pLast);
+ printf(";\n");
+ }
+#endif
+ pDecl = CreateDecl(pName->zText,pName->nText);
+ pDecl->pComment = pFirst->pComment;
+ if( pCode && pCode->eType==TT_Braces ){
+ pDecl->tokenCode = *pCode;
+ }
+ DeclSetProperty(pDecl,TY_Subroutine);
+ pDecl->zDecl = TokensToString(pFirst,pLast);
+ if( (flags & (PS_Static|PS_Local2))!=0 ){
+ DeclSetProperty(pDecl,DP_Local);
+ }else if( (flags & (PS_Export2))!=0 ){
+ DeclSetProperty(pDecl,DP_Export);
+ }
+
+ if( flags & DP_Cplusplus ){
+ DeclSetProperty(pDecl,DP_Cplusplus);
+ }else{
+ DeclSetProperty(pDecl,DP_ExternCReqd);
+ }
+
+ return 0;
+}
+
+/*
+** This routine is called whenever we see the "inline" keyword. We
+** need to seek-out the inline function or procedure and make a
+** declaration out of the entire definition.
+*/
+static int ProcessInlineProc(Token *pFirst, int flags, int *pReset){
+ Token *pName;
+ Token *pEnd;
+ Decl *pDecl;
+
+ for(pEnd=pFirst; pEnd; pEnd = pEnd->pNext){
+ if( pEnd->zText[0]=='{' || pEnd->zText[0]==';' ){
+ *pReset = pEnd->zText[0];
+ break;
+ }
+ }
+ if( pEnd==0 ){
+ *pReset = ';';
+ fprintf(stderr,"%s:%d: incomplete inline procedure definition\n",
+ zFilename, pFirst->nLine);
+ return 1;
+ }
+ pName = FindDeclName(pFirst,pEnd);
+ if( pName==0 ){
+ fprintf(stderr,"%s:%d: malformed inline procedure definition\n",
+ zFilename, pFirst->nLine);
+ return 1;
+ }
+
+#ifdef DEBUG
+ if( debugMask & PARSER ){
+ printf("**** Found inline routine: %.*s on line %d...\n",
+ pName->nText, pName->zText, pFirst->nLine);
+ PrintTokens(pFirst,pEnd);
+ printf("\n");
+ }
+#endif
+ pDecl = CreateDecl(pName->zText,pName->nText);
+ pDecl->pComment = pFirst->pComment;
+ DeclSetProperty(pDecl,TY_Subroutine);
+ pDecl->zDecl = TokensToString(pFirst,pEnd);
+ if( (flags & (PS_Static|PS_Local|PS_Local2)) ){
+ DeclSetProperty(pDecl,DP_Local);
+ }else if( flags & (PS_Export|PS_Export2) ){
+ DeclSetProperty(pDecl,DP_Export);
+ }
+
+ if( flags & DP_Cplusplus ){
+ DeclSetProperty(pDecl,DP_Cplusplus);
+ }else{
+ DeclSetProperty(pDecl,DP_ExternCReqd);
+ }
+
+ return 0;
+}
+
+/*
+** Determine if the tokens between pFirst and pEnd form a variable
+** definition or a function prototype. Return TRUE if we are dealing
+** with a variable defintion and FALSE for a prototype.
+**
+** pEnd is the token that ends the object. It can be either a ';' or
+** a '='. If it is '=', then assume we have a variable definition.
+**
+** If pEnd is ';', then the determination is more difficult. We have
+** to search for an occurance of an ID followed immediately by '('.
+** If found, we have a prototype. Otherwise we are dealing with a
+** variable definition.
+*/
+static int isVariableDef(Token *pFirst, Token *pEnd){
+ if( pEnd && pEnd->zText[0]=='=' ){
+ return 1;
+ }
+ while( pFirst && pFirst!=pEnd && pFirst->pNext && pFirst->pNext!=pEnd ){
+ if( pFirst->eType==TT_Id && pFirst->pNext->zText[0]=='(' ){
+ return 0;
+ }
+ pFirst = pFirst->pNext;
+ }
+ return 1;
+}
+
+
+/*
+** This routine is called whenever we encounter a ";" or "=". The stuff
+** between pFirst and pLast constitutes either a typedef or a global
+** variable definition. Do the right thing.
+*/
+static int ProcessDecl(Token *pFirst, Token *pEnd, int flags){
+ Token *pName;
+ Decl *pDecl;
+ int isLocal = 0;
+ int isVar;
+ int nErr = 0;
+
+ if( pFirst==0 || pEnd==0 ){
+ return 0;
+ }
+ if( flags & PS_Typedef ){
+ if( (flags & (PS_Export2|PS_Local2))!=0 ){
+ fprintf(stderr,"%s:%d: \"EXPORT\" or \"LOCAL\" ignored before typedef.\n",
+ zFilename, pFirst->nLine);
+ nErr++;
+ }
+ if( (flags & (PS_Interface|PS_Export|PS_Local|DP_Cplusplus))==0 ){
+ /* It is illegal to duplicate a typedef in C (but OK in C++).
+ ** So don't record typedefs that aren't within a C++ file or
+ ** within #if INTERFACE..#endif */
+ return nErr;
+ }
+ if( (flags & (PS_Interface|PS_Export|PS_Local))==0 && proto_static==0 ){
+ /* Ignore typedefs that are not with "#if INTERFACE..#endif" unless
+ ** the "-local" command line option is used. */
+ return nErr;
+ }
+ if( (flags & (PS_Interface|PS_Export))==0 ){
+ /* typedefs are always local, unless within #if INTERFACE..#endif */
+ isLocal = 1;
+ }
+ }else if( flags & (PS_Static|PS_Local2) ){
+ if( proto_static==0 && (flags & PS_Local2)==0 ){
+ /* Don't record static variables unless the "-local" command line
+ ** option was specified or the "LOCAL" keyword is used. */
+ return nErr;
+ }
+ while( pFirst!=0 && pFirst->pNext!=pEnd &&
+ ((pFirst->nText==6 && strncmp(pFirst->zText,"static",6)==0)
+ || (pFirst->nText==5 && strncmp(pFirst->zText,"LOCAL",6)==0))
+ ){
+ /* Lose the initial "static" or local from local variables.
+ ** We'll prepend "extern" later. */
+ pFirst = pFirst->pNext;
+ isLocal = 1;
+ }
+ if( pFirst==0 || !isLocal ){
+ return nErr;
+ }
+ }else if( flags & PS_Method ){
+ /* Methods are declared by their class. Don't declare separately. */
+ return nErr;
+ }
+ isVar = (flags & (PS_Typedef|PS_Method))==0 && isVariableDef(pFirst,pEnd);
+ if( isVar && (flags & (PS_Interface|PS_Export|PS_Local))!=0
+ && (flags & PS_Extern)==0 ){
+ fprintf(stderr,"%s:%d: Can't define a variable in this context\n",
+ zFilename, pFirst->nLine);
+ nErr++;
+ }
+ pName = FindDeclName(pFirst,pEnd->pPrev);
+ if( pName==0 ){
+ fprintf(stderr,"%s:%d: Can't find a name for the object declared here.\n",
+ zFilename, pFirst->nLine);
+ return nErr+1;
+ }
+
+#ifdef DEBUG
+ if( debugMask & PARSER ){
+ if( flags & PS_Typedef ){
+ printf("**** Found typedef %.*s at line %d...\n",
+ pName->nText, pName->zText, pName->nLine);
+ }else if( isVar ){
+ printf("**** Found variable %.*s at line %d...\n",
+ pName->nText, pName->zText, pName->nLine);
+ }else{
+ printf("**** Found prototype %.*s at line %d...\n",
+ pName->nText, pName->zText, pName->nLine);
+ }
+ PrintTokens(pFirst,pEnd->pPrev);
+ printf(";\n");
+ }
+#endif
+
+ pDecl = CreateDecl(pName->zText,pName->nText);
+ if( (flags & PS_Typedef) ){
+ DeclSetProperty(pDecl, TY_Typedef);
+ }else if( isVar ){
+ DeclSetProperty(pDecl,DP_ExternReqd | TY_Variable);
+ if( !(flags & DP_Cplusplus) ){
+ DeclSetProperty(pDecl,DP_ExternCReqd);
+ }
+ }else{
+ DeclSetProperty(pDecl, TY_Subroutine);
+ if( !(flags & DP_Cplusplus) ){
+ DeclSetProperty(pDecl,DP_ExternCReqd);
+ }
+ }
+ pDecl->pComment = pFirst->pComment;
+ pDecl->zDecl = TokensToString(pFirst,pEnd->pPrev);
+ if( isLocal || (flags & (PS_Local||PS_Local2))!=0 ){
+ DeclSetProperty(pDecl,DP_Local);
+ }else if( flags & (PS_Export|PS_Export2) ){
+ DeclSetProperty(pDecl,DP_Export);
+ }
+ if( flags & DP_Cplusplus ){
+ DeclSetProperty(pDecl,DP_Cplusplus);
+ }
+ return nErr;
+}
+
+/*
+** Push an if condition onto the if stack
+*/
+static void PushIfMacro(
+ const char *zPrefix, /* A prefix, like "define" or "!" */
+ const char *zText, /* The condition */
+ int nText, /* Number of characters in zText */
+ int nLine, /* Line number where this macro occurs */
+ int flags /* Either 0, PS_Interface, PS_Export or PS_Local */
+){
+ Ifmacro *pIf;
+ int nByte;
+
+ nByte = sizeof(Ifmacro);
+ if( zText ){
+ if( zPrefix ){
+ nByte += strlen(zPrefix) + 2;
+ }
+ nByte += nText + 1;
+ }
+ pIf = SafeMalloc( nByte );
+ if( zText ){
+ pIf->zCondition = (char*)&pIf[1];
+ if( zPrefix ){
+ sprintf(pIf->zCondition,"%s(%.*s)",zPrefix,nText,zText);
+ }else{
+ sprintf(pIf->zCondition,"%.*s",nText,zText);
+ }
+ }else{
+ pIf->zCondition = 0;
+ }
+ pIf->nLine = nLine;
+ pIf->flags = flags;
+ pIf->pNext = ifStack;
+ ifStack = pIf;
+}
+
+/*
+** This routine is called to handle all preprocessor directives.
+**
+** This routine will recompute the value of *pPresetFlags to be the
+** logical or of all flags on all nested #ifs. The #ifs that set flags
+** are as follows:
+**
+** conditional flag set
+** ------------------------ --------------------
+** #if INTERFACE PS_Interface
+** #if EXPORT_INTERFACE PS_Export
+** #if LOCAL_INTERFACE PS_Local
+**
+** For example, if after processing the preprocessor token given
+** by pToken there is an "#if INTERFACE" on the preprocessor
+** stack, then *pPresetFlags will be set to PS_Interface.
+*/
+static int ParsePreprocessor(Token *pToken, int flags, int *pPresetFlags){
+ const char *zCmd;
+ int nCmd;
+ const char *zArg;
+ int nArg;
+ int nErr = 0;
+ Ifmacro *pIf;
+
+ zCmd = &pToken->zText[1];
+ while( isspace(*zCmd) && *zCmd!='\n' ){
+ zCmd++;
+ }
+ if( !isalpha(*zCmd) ){
+ return 0;
+ }
+ nCmd = 1;
+ while( isalpha(zCmd[nCmd]) ){
+ nCmd++;
+ }
+
+ if( nCmd==5 && strncmp(zCmd,"endif",5)==0 ){
+ /*
+ ** Pop the if stack
+ */
+ pIf = ifStack;
+ if( pIf==0 ){
+ fprintf(stderr,"%s:%d: extra '#endif'.\n",zFilename,pToken->nLine);
+ return 1;
+ }
+ ifStack = pIf->pNext;
+ SafeFree(pIf);
+ }else if( nCmd==6 && strncmp(zCmd,"define",6)==0 ){
+ /*
+ ** Record a #define if we are in PS_Interface or PS_Export
+ */
+ Decl *pDecl;
+ if( !(flags & (PS_Local|PS_Interface|PS_Export)) ){ return 0; }
+ zArg = &zCmd[6];
+ while( *zArg && isspace(*zArg) && *zArg!='\n' ){
+ zArg++;
+ }
+ if( *zArg==0 || *zArg=='\n' ){ return 0; }
+ for(nArg=0; ISALNUM(zArg[nArg]); nArg++){}
+ if( nArg==0 ){ return 0; }
+ pDecl = CreateDecl(zArg,nArg);
+ pDecl->pComment = pToken->pComment;
+ DeclSetProperty(pDecl,TY_Macro);
+ pDecl->zDecl = SafeMalloc( pToken->nText + 2 );
+ sprintf(pDecl->zDecl,"%.*s\n",pToken->nText,pToken->zText);
+ if( flags & PS_Export ){
+ DeclSetProperty(pDecl,DP_Export);
+ }else if( flags & PS_Local ){
+ DeclSetProperty(pDecl,DP_Local);
+ }
+ }else if( nCmd==7 && strncmp(zCmd,"include",7)==0 ){
+ /*
+ ** Record an #include if we are in PS_Interface or PS_Export
+ */
+ Include *pInclude;
+ char *zIf;
+
+ if( !(flags & (PS_Interface|PS_Export)) ){ return 0; }
+ zArg = &zCmd[7];
+ while( *zArg && isspace(*zArg) ){ zArg++; }
+ for(nArg=0; !isspace(zArg[nArg]); nArg++){}
+ if( (zArg[0]=='"' && zArg[nArg-1]!='"')
+ ||(zArg[0]=='<' && zArg[nArg-1]!='>')
+ ){
+ fprintf(stderr,"%s:%d: malformed #include statement.\n",
+ zFilename,pToken->nLine);
+ return 1;
+ }
+ zIf = GetIfString();
+ if( zIf ){
+ pInclude = SafeMalloc( sizeof(Include) + nArg*2 + strlen(zIf) + 10 );
+ pInclude->zFile = (char*)&pInclude[1];
+ pInclude->zLabel = &pInclude->zFile[nArg+1];
+ sprintf(pInclude->zFile,"%.*s",nArg,zArg);
+ sprintf(pInclude->zLabel,"%.*s:%s",nArg,zArg,zIf);
+ pInclude->zIf = &pInclude->zLabel[nArg+1];
+ SafeFree(zIf);
+ }else{
+ pInclude = SafeMalloc( sizeof(Include) + nArg + 1 );
+ pInclude->zFile = (char*)&pInclude[1];
+ sprintf(pInclude->zFile,"%.*s",nArg,zArg);
+ pInclude->zIf = 0;
+ pInclude->zLabel = pInclude->zFile;
+ }
+ pInclude->pNext = includeList;
+ includeList = pInclude;
+ }else if( nCmd==2 && strncmp(zCmd,"if",2)==0 ){
+ /*
+ ** Push an #if. Watch for the special cases of INTERFACE
+ ** and EXPORT_INTERFACE and LOCAL_INTERFACE
+ */
+ zArg = &zCmd[2];
+ while( *zArg && isspace(*zArg) && *zArg!='\n' ){
+ zArg++;
+ }
+ if( *zArg==0 || *zArg=='\n' ){ return 0; }
+ nArg = pToken->nText + (int)pToken->zText - (int)zArg;
+ if( nArg==9 && strncmp(zArg,"INTERFACE",9)==0 ){
+ PushIfMacro(0,0,0,pToken->nLine,PS_Interface);
+ }else if( nArg==16 && strncmp(zArg,"EXPORT_INTERFACE",16)==0 ){
+ PushIfMacro(0,0,0,pToken->nLine,PS_Export);
+ }else if( nArg==15 && strncmp(zArg,"LOCAL_INTERFACE",15)==0 ){
+ PushIfMacro(0,0,0,pToken->nLine,PS_Local);
+ }else{
+ PushIfMacro(0,zArg,nArg,pToken->nLine,0);
+ }
+ }else if( nCmd==5 && strncmp(zCmd,"ifdef",5)==0 ){
+ /*
+ ** Push an #ifdef.
+ */
+ zArg = &zCmd[5];
+ while( *zArg && isspace(*zArg) && *zArg!='\n' ){
+ zArg++;
+ }
+ if( *zArg==0 || *zArg=='\n' ){ return 0; }
+ nArg = pToken->nText + (int)pToken->zText - (int)zArg;
+ PushIfMacro("defined",zArg,nArg,pToken->nLine,0);
+ }else if( nCmd==6 && strncmp(zCmd,"ifndef",6)==0 ){
+ /*
+ ** Push an #ifndef.
+ */
+ zArg = &zCmd[6];
+ while( *zArg && isspace(*zArg) && *zArg!='\n' ){
+ zArg++;
+ }
+ if( *zArg==0 || *zArg=='\n' ){ return 0; }
+ nArg = pToken->nText + (int)pToken->zText - (int)zArg;
+ PushIfMacro("!defined",zArg,nArg,pToken->nLine,0);
+ }else if( nCmd==4 && strncmp(zCmd,"else",4)==0 ){
+ /*
+ ** Invert the #if on the top of the stack
+ */
+ if( ifStack==0 ){
+ fprintf(stderr,"%s:%d: '#else' without an '#if'\n",zFilename,
+ pToken->nLine);
+ return 1;
+ }
+ pIf = ifStack;
+ if( pIf->zCondition ){
+ ifStack = ifStack->pNext;
+ PushIfMacro("!",pIf->zCondition,strlen(pIf->zCondition),pIf->nLine,0);
+ SafeFree(pIf);
+ }else{
+ pIf->flags = 0;
+ }
+ }else{
+ /*
+ ** This directive can be safely ignored
+ */
+ return 0;
+ }
+
+ /*
+ ** Recompute the preset flags
+ */
+ *pPresetFlags = 0;
+ for(pIf = ifStack; pIf; pIf=pIf->pNext){
+ *pPresetFlags |= pIf->flags;
+ }
+
+ return nErr;
+}
+
+/*
+** Parse an entire file. Return the number of errors.
+**
+** pList is a list of tokens in the file. Whitespace tokens have been
+** eliminated, and text with {...} has been collapsed into a
+** single TT_Brace token.
+**
+** initFlags are a set of parse flags that should always be set for this
+** file. For .c files this is normally 0. For .h files it is PS_Interface.
+*/
+static int ParseFile(Token *pList, int initFlags){
+ int nErr = 0;
+ Token *pStart = 0;
+ int flags = initFlags;
+ int presetFlags = initFlags;
+ int resetFlag = 0;
+
+ includeList = 0;
+ while( pList ){
+ switch( pList->eType ){
+ case TT_EOF:
+ goto end_of_loop;
+
+ case TT_Preprocessor:
+ nErr += ParsePreprocessor(pList,flags,&presetFlags);
+ pStart = 0;
+ presetFlags |= initFlags;
+ flags = presetFlags;
+ break;
+
+ case TT_Other:
+ switch( pList->zText[0] ){
+ case ';':
+ nErr += ProcessDecl(pStart,pList,flags);
+ pStart = 0;
+ flags = presetFlags;
+ break;
+
+ case '=':
+ nErr += ProcessDecl(pStart,pList,flags);
+ pStart = 0;
+ while( pList && pList->zText[0]!=';' ){
+ pList = pList->pNext;
+ }
+ if( pList==0 ) goto end_of_loop;
+ flags = presetFlags;
+ break;
+
+ case ':':
+ if( pList->zText[1]==':' ){
+ flags |= PS_Method;
+ }
+ break;
+
+ default:
+ break;
+ }
+ break;
+
+ case TT_Braces:
+ nErr += ProcessProcedureDef(pStart,pList,flags);
+ pStart = 0;
+ flags = presetFlags;
+ break;
+
+ case TT_Id:
+ if( pStart==0 ){
+ pStart = pList;
+ flags = presetFlags;
+ }
+ resetFlag = 0;
+ switch( pList->zText[0] ){
+ case 'c':
+ if( pList->nText==5 && strncmp(pList->zText,"class",5)==0 ){
+ nErr += ProcessTypeDecl(pList,flags,&resetFlag);
+ }
+ break;
+
+ case 'E':
+ if( pList->nText==6 && strncmp(pList->zText,"EXPORT",6)==0 ){
+ flags |= PS_Export2;
+ /* pStart = 0; */
+ }
+ break;
+
+ case 'e':
+ if( pList->nText==4 && strncmp(pList->zText,"enum",4)==0 ){
+ if( pList->pNext && pList->pNext->eType==TT_Braces ){
+ pList = pList->pNext;
+ }else{
+ nErr += ProcessTypeDecl(pList,flags,&resetFlag);
+ }
+ }else if( pList->nText==6 && strncmp(pList->zText,"extern",6)==0 ){
+ pList = pList->pNext;
+ if( pList && pList->nText==3 && strncmp(pList->zText,"\"C\"",3)==0 ){
+ pList = pList->pNext;
+ flags &= ~DP_Cplusplus;
+ }else{
+ flags |= PS_Extern;
+ }
+ pStart = pList;
+ }
+ break;
+
+ case 'i':
+ if( pList->nText==6 && strncmp(pList->zText,"inline",6)==0 ){
+ nErr += ProcessInlineProc(pList,flags,&resetFlag);
+ }
+ break;
+
+ case 'L':
+ if( pList->nText==5 && strncmp(pList->zText,"LOCAL",5)==0 ){
+ flags |= PS_Local2;
+ pStart = pList;
+ }
+ break;
+
+ case 's':
+ if( pList->nText==6 && strncmp(pList->zText,"struct",6)==0 ){
+ if( pList->pNext && pList->pNext->eType==TT_Braces ){
+ pList = pList->pNext;
+ }else{
+ nErr += ProcessTypeDecl(pList,flags,&resetFlag);
+ }
+ }else if( pList->nText==6 && strncmp(pList->zText,"static",6)==0 ){
+ flags |= PS_Static;
+ }
+ break;
+
+ case 't':
+ if( pList->nText==7 && strncmp(pList->zText,"typedef",7)==0 ){
+ flags |= PS_Typedef;
+ }
+ break;
+
+ case 'u':
+ if( pList->nText==5 && strncmp(pList->zText,"union",5)==0 ){
+ if( pList->pNext && pList->pNext->eType==TT_Braces ){
+ pList = pList->pNext;
+ }else{
+ nErr += ProcessTypeDecl(pList,flags,&resetFlag);
+ }
+ }
+ break;
+
+ default:
+ break;
+ }
+ if( resetFlag!=0 ){
+ while( pList && pList->zText[0]!=resetFlag ){
+ pList = pList->pNext;
+ }
+ if( pList==0 ) goto end_of_loop;
+ pStart = 0;
+ flags = presetFlags;
+ }
+ break;
+
+ case TT_Number:
+ break;
+
+ default:
+ pStart = pList;
+ flags = presetFlags;
+ break;
+ }
+ pList = pList->pNext;
+ }
+ end_of_loop:
+
+ /* Verify that all #ifs have a matching "#endif" */
+ while( ifStack ){
+ Ifmacro *pIf = ifStack;
+ ifStack = pIf->pNext;
+ fprintf(stderr,"%s:%d: This '#if' has no '#endif'\n",zFilename,
+ pIf->nLine);
+ SafeFree(pIf);
+ }
+
+ return nErr;
+}
+
+/*
+** Reset the DP_Forward and DP_Declared flags on all Decl structures.
+** Set both flags for anything that is tagged as local and isn't
+** in the file zFilename so that it won't be printing in other files.
+*/
+static void ResetDeclFlags(char *zFilename){
+ Decl *pDecl;
+
+ for(pDecl = pDeclFirst; pDecl; pDecl = pDecl->pNext){
+ DeclClearProperty(pDecl,DP_Forward|DP_Declared);
+ if( DeclHasProperty(pDecl,DP_Local) && pDecl->zFile!=zFilename ){
+ DeclSetProperty(pDecl,DP_Forward|DP_Declared);
+ }
+ }
+}
+
+/*
+** Forward declaration of the ScanText() function.
+*/
+static void ScanText(const char*, GenState *pState);
+
+/*
+** The output in pStr is currently within an #if CONTEXT where context
+** is equal to *pzIf. (*pzIf might be NULL to indicate that we are
+** not within any #if at the moment.) We are getting ready to output
+** some text that needs to be within the context of "#if NEW" where
+** NEW is zIf. Make an appropriate change to the context.
+*/
+static void ChangeIfContext(
+ const char *zIf, /* The desired #if context */
+ GenState *pState /* Current state of the code generator */
+){
+ if( zIf==0 ){
+ if( pState->zIf==0 ) return;
+ StringAppend(pState->pStr,"#endif\n",0);
+ pState->zIf = 0;
+ }else{
+ if( pState->zIf ){
+ if( strcmp(zIf,pState->zIf)==0 ) return;
+ StringAppend(pState->pStr,"#endif\n",0);
+ pState->zIf = 0;
+ }
+ ScanText(zIf, pState);
+ if( pState->zIf!=0 ){
+ StringAppend(pState->pStr,"#endif\n",0);
+ }
+ StringAppend(pState->pStr,"#if ",0);
+ StringAppend(pState->pStr,zIf,0);
+ StringAppend(pState->pStr,"\n",0);
+ pState->zIf = zIf;
+ }
+}
+
+/*
+** Add to the string pStr a #include of every file on the list of
+** include files pInclude. The table pTable contains all files that
+** have already been #included at least once. Don't add any
+** duplicates. Update pTable with every new #include that is added.
+*/
+static void AddIncludes(
+ Include *pInclude, /* Write every #include on this list */
+ GenState *pState /* Current state of the code generator */
+){
+ if( pInclude ){
+ if( pInclude->pNext ){
+ AddIncludes(pInclude->pNext,pState);
+ }
+ if( IdentTableInsert(pState->pTable,pInclude->zLabel,0) ){
+ ChangeIfContext(pInclude->zIf,pState);
+ StringAppend(pState->pStr,"#include ",0);
+ StringAppend(pState->pStr,pInclude->zFile,0);
+ StringAppend(pState->pStr,"\n",1);
+ }
+ }
+}
+
+/*
+** Add to the string pStr a declaration for the object described
+** in pDecl.
+**
+** If pDecl has already been declared in this file, detect that
+** fact and abort early. Do not duplicate a declaration.
+**
+** If the needFullDecl flag is false and this object has a forward
+** declaration, then supply the forward declaration only. A later
+** call to CompleteForwardDeclarations() will finish the declaration
+** for us. But if needFullDecl is true, we must supply the full
+** declaration now. Some objects do not have a forward declaration.
+** For those objects, we must print the full declaration now.
+**
+** Because it is illegal to duplicate a typedef in C, care is taken
+** to insure that typedefs for the same identifier are only issued once.
+*/
+static void DeclareObject(
+ Decl *pDecl, /* The thing to be declared */
+ GenState *pState, /* Current state of the code generator */
+ int needFullDecl /* Must have the full declaration. A forward
+ * declaration isn't enough */
+){
+ Decl *p; /* The object to be declared */
+ int flag;
+ int isCpp; /* True if generating C++ */
+ int doneTypedef = 0; /* True if a typedef has been done for this object */
+
+ /*
+ ** For any object that has a forward declaration, go ahead and do the
+ ** forward declaration first.
+ */
+ isCpp = (pState->flags & DP_Cplusplus) != 0;
+ for(p=pDecl; p; p=p->pSameName){
+ if( p->zFwd ){
+ if( !DeclHasProperty(p,DP_Forward) ){
+ DeclSetProperty(p,DP_Forward);
+ if( strncmp(p->zFwd,"typedef",7)==0 ){
+ if( doneTypedef ) continue;
+ doneTypedef = 1;
+ }
+ ChangeIfContext(p->zIf,pState);
+ StringAppend(pState->pStr,isCpp ? p->zFwdCpp : p->zFwd,0);
+ }
+ }
+ }
+
+ /*
+ ** Early out if everything is already suitably declared.
+ **
+ ** This is a very important step because it prevents us from
+ ** executing the code the follows in a recursive call to this
+ ** function with the same value for pDecl.
+ */
+ flag = needFullDecl ? DP_Declared|DP_Forward : DP_Forward;
+ for(p=pDecl; p; p=p->pSameName){
+ if( !DeclHasProperty(p,flag) ) break;
+ }
+ if( p==0 ){
+ return;
+ }
+
+ /*
+ ** Make sure we have all necessary #includes
+ */
+ for(p=pDecl; p; p=p->pSameName){
+ AddIncludes(p->pInclude,pState);
+ }
+
+ /*
+ ** Go ahead an mark everything as being declared, to prevent an
+ ** infinite loop thru the ScanText() function. At the same time,
+ ** we decide which objects need a full declaration and mark them
+ ** with the DP_Flag bit. We are only able to use DP_Flag in this
+ ** way because we know we'll never execute this far into this
+ ** function on a recursive call with the same pDecl. Hence, recursive
+ ** calls to this function (through ScanText()) can never change the
+ ** value of DP_Flag out from under us.
+ */
+ for(p=pDecl; p; p=p->pSameName){
+ if( !DeclHasProperty(p,DP_Declared)
+ && (p->zFwd==0 || needFullDecl)
+ && p->zDecl!=0
+ ){
+ DeclSetProperty(p,DP_Forward|DP_Declared|DP_Flag);
+ }else{
+ DeclClearProperty(p,DP_Flag);
+ }
+ }
+
+ /*
+ ** Call ScanText() recusively (this routine is called from ScanText())
+ ** to include declarations required to come before these declarations.
+ */
+ for(p=pDecl; p; p=p->pSameName){
+ if( DeclHasProperty(p,DP_Flag) ){
+ if( p->zDecl[0]=='#' ){
+ ScanText(&p->zDecl[1],pState);
+ }else{
+ ScanText(p->zDecl,pState);
+ }
+ }
+ }
+
+ /*
+ ** Output the declarations. Do this in two passes. First
+ ** output everything that isn't a typedef. Then go back and
+ ** get the typedefs by the same name.
+ */
+ for(p=pDecl; p; p=p->pSameName){
+ if( DeclHasProperty(p,DP_Flag) && !DeclHasProperty(p,TY_Typedef) ){
+ if( DeclHasAnyProperty(p,TY_Enumeration) ){
+ if( doneTypedef ) continue;
+ doneTypedef = 1;
+ }
+ ChangeIfContext(p->zIf,pState);
+ if( !isCpp && DeclHasAnyProperty(p,DP_ExternReqd) ){
+ StringAppend(pState->pStr,"extern ",0);
+ }else if( isCpp && DeclHasProperty(p,DP_Cplusplus|DP_ExternReqd) ){
+ StringAppend(pState->pStr,"extern ",0);
+ }else if( isCpp && DeclHasAnyProperty(p,DP_ExternCReqd|DP_ExternReqd) ){
+ StringAppend(pState->pStr,"extern \"C\" ",0);
+ }
+ StringAppend(pState->pStr,p->zDecl,0);
+ if( !isCpp && DeclHasProperty(p,DP_Cplusplus) ){
+ fprintf(stderr,
+ "%s: C code ought not reference the C++ object \"%s\"\n",
+ pState->zFilename, p->zName);
+ pState->nErr++;
+ }
+ DeclClearProperty(p,DP_Flag);
+ }
+ }
+ for(p=pDecl; p && !doneTypedef; p=p->pSameName){
+ if( DeclHasProperty(p,DP_Flag) ){
+ /* This has to be a typedef */
+ doneTypedef = 1;
+ ChangeIfContext(p->zIf,pState);
+ StringAppend(pState->pStr,p->zDecl,0);
+ }
+ }
+}
+
+/*
+** This routine scans the input text given, and appends to the
+** string in pState->pStr the text of any declarations that must
+** occur before the text in zText.
+**
+** If an identifier in zText is immediately followed by '*', then
+** only forward declarations are needed for that identifier. If the
+** identifier name is not followed immediately by '*', we must supply
+** a full declaration.
+*/
+static void ScanText(
+ const char *zText, /* The input text to be scanned */
+ GenState *pState /* Current state of the code generator */
+){
+ int nextValid = 0; /* True is sNext contains valid data */
+ InStream sIn; /* The input text */
+ Token sToken; /* The current token being examined */
+ Token sNext; /* The next non-space token */
+
+ sIn.z = zText;
+ sIn.i = 0;
+ sIn.nLine = 1;
+ while( sIn.z[sIn.i]!=0 ){
+ if( nextValid ){
+ sToken = sNext;
+ nextValid = 0;
+ }else{
+ GetNonspaceToken(&sIn,&sToken);
+ }
+ if( sToken.eType==TT_Id ){
+ int needFullDecl; /* True if we need to provide the full declaration,
+ ** not just the forward declaration */
+ Decl *pDecl; /* The declaration having the name in sToken */
+
+ /*
+ ** See if there is a declaration in the database with the name given
+ ** by sToken.
+ */
+ pDecl = FindDecl(sToken.zText,sToken.nText);
+ if( pDecl==0 ) continue;
+
+ /*
+ ** If we get this far, we've found an identifier that has a
+ ** declaration in the database. Now see if we the full declaration
+ ** or just a forward declaration.
+ */
+ GetNonspaceToken(&sIn,&sNext);
+ if( sNext.zText[0]=='*' ){
+ needFullDecl = 0;
+ }else{
+ needFullDecl = 1;
+ nextValid = sNext.eType==TT_Id;
+ }
+
+ /*
+ ** Generate the needed declaration.
+ */
+ DeclareObject(pDecl,pState,needFullDecl);
+ }else if( sToken.eType==TT_Preprocessor ){
+ sIn.i -= sToken.nText - 1;
+ }
+ }
+}
+
+/*
+** Provide a full declaration to any object which so far has had only
+** a foward declaration.
+*/
+static void CompleteForwardDeclarations(GenState *pState){
+ Decl *pDecl;
+ int progress;
+
+ do{
+ progress = 0;
+ for(pDecl=pDeclFirst; pDecl; pDecl=pDecl->pNext){
+ if( DeclHasProperty(pDecl,DP_Forward)
+ && !DeclHasProperty(pDecl,DP_Declared)
+ ){
+ DeclareObject(pDecl,pState,1);
+ progress = 1;
+ assert( DeclHasProperty(pDecl,DP_Declared) );
+ }
+ }
+ }while( progress );
+}
+
+/*
+** Generate an include file for the given source file. Return the number
+** of errors encountered.
+**
+** if nolocal_flag is true, then we do not generate declarations for
+** objected marked DP_Local.
+*/
+static int MakeHeader(InFile *pFile, FILE *report, int nolocal_flag){
+ int nErr = 0;
+ GenState sState;
+ String outStr;
+ IdentTable includeTable;
+ Ident *pId;
+ char *zNewVersion;
+ char *zOldVersion;
+
+ if( pFile->zHdr==0 || *pFile->zHdr==0 ) return 0;
+ sState.pStr = &outStr;
+ StringInit(&outStr);
+ StringAppend(&outStr,zTopLine,nTopLine);
+ sState.pTable = &includeTable;
+ memset(&includeTable,0,sizeof(includeTable));
+ sState.zIf = 0;
+ sState.nErr = 0;
+ sState.zFilename = pFile->zSrc;
+ sState.flags = pFile->flags & DP_Cplusplus;
+ ResetDeclFlags(nolocal_flag ? "no" : pFile->zSrc);
+ for(pId = pFile->idTable.pList; pId; pId=pId->pNext){
+ Decl *pDecl = FindDecl(pId->zName,0);
+ if( pDecl ){
+ DeclareObject(pDecl,&sState,1);
+ }
+ }
+ CompleteForwardDeclarations(&sState);
+ ChangeIfContext(0,&sState);
+ nErr += sState.nErr;
+ zOldVersion = ReadFile(pFile->zHdr);
+ zNewVersion = StringGet(&outStr);
+ if( report ) fprintf(report,"%s: ",pFile->zHdr);
+ if( zOldVersion==0 ){
+ if( report ) fprintf(report,"updated\n");
+ if( WriteFile(pFile->zHdr,zNewVersion) ){
+ fprintf(stderr,"%s: Can't write to file\n",pFile->zHdr);
+ nErr++;
+ }
+ }else if( strncmp(zOldVersion,zTopLine,nTopLine)!=0 ){
+ if( report ) fprintf(report,"error!\n");
+ fprintf(stderr,
+ "%s: Can't overwrite this file because it wasn't previously\n"
+ "%*s generated by 'makeheaders'.\n",
+ pFile->zHdr, strlen(pFile->zHdr), "");
+ nErr++;
+ }else if( strcmp(zOldVersion,zNewVersion)!=0 ){
+ if( report ) fprintf(report,"updated\n");
+ if( WriteFile(pFile->zHdr,zNewVersion) ){
+ fprintf(stderr,"%s: Can't write to file\n",pFile->zHdr);
+ nErr++;
+ }
+ }else if( report ){
+ fprintf(report,"unchanged\n");
+ }
+ SafeFree(zOldVersion);
+ IdentTableReset(&includeTable);
+ StringReset(&outStr);
+ return nErr;
+}
+
+/*
+** Generate a global header file -- a header file that contains all
+** declarations. If the forExport flag is true, then only those
+** objects that are exported are included in the header file.
+*/
+static int MakeGlobalHeader(int forExport){
+ GenState sState;
+ String outStr;
+ IdentTable includeTable;
+ Decl *pDecl;
+
+ sState.pStr = &outStr;
+ StringInit(&outStr);
+ /* StringAppend(&outStr,zTopLine,nTopLine); */
+ sState.pTable = &includeTable;
+ memset(&includeTable,0,sizeof(includeTable));
+ sState.zIf = 0;
+ sState.nErr = 0;
+ sState.zFilename = "(all)";
+ sState.flags = 0;
+ ResetDeclFlags(0);
+ for(pDecl=pDeclFirst; pDecl; pDecl=pDecl->pNext){
+ if( forExport==0 || DeclHasProperty(pDecl,DP_Export) ){
+ DeclareObject(pDecl,&sState,1);
+ }
+ }
+ ChangeIfContext(0,&sState);
+ printf("%s",StringGet(&outStr));
+ IdentTableReset(&includeTable);
+ StringReset(&outStr);
+ return 0;
+}
+
+#ifdef DEBUG
+/*
+** Return the number of characters in the given string prior to the
+** first newline.
+*/
+static int ClipTrailingNewline(char *z){
+ int n = strlen(z);
+ while( n>0 && (z[n-1]=='\n' || z[n-1]=='\r') ){ n--; }
+ return n;
+}
+
+/*
+** Dump the entire declaration list for debugging purposes
+*/
+static void DumpDeclList(void){
+ Decl *pDecl;
+
+ for(pDecl = pDeclFirst; pDecl; pDecl=pDecl->pNext){
+ printf("**** %s from file %s ****\n",pDecl->zName,pDecl->zFile);
+ if( pDecl->zIf ){
+ printf("If: [%.*s]\n",ClipTrailingNewline(pDecl->zIf),pDecl->zIf);
+ }
+ if( pDecl->zFwd ){
+ printf("Decl: [%.*s]\n",ClipTrailingNewline(pDecl->zFwd),pDecl->zFwd);
+ }
+ if( pDecl->zDecl ){
+ printf("Def: [%.*s]\n",ClipTrailingNewline(pDecl->zDecl),pDecl->zDecl);
+ }
+ if( pDecl->flags ){
+ static struct {
+ int mask;
+ char *desc;
+ } flagSet[] = {
+ { TY_Class, "class" },
+ { TY_Enumeration, "enum" },
+ { TY_Structure, "struct" },
+ { TY_Union, "union" },
+ { TY_Variable, "variable" },
+ { TY_Subroutine, "function" },
+ { TY_Typedef, "typedef" },
+ { TY_Macro, "macro" },
+ { DP_Export, "export" },
+ { DP_Local, "local" },
+ { DP_Cplusplus, "C++" },
+ };
+ int i;
+ printf("flags:");
+ for(i=0; i<sizeof(flagSet)/sizeof(flagSet[0]); i++){
+ if( flagSet[i].mask & pDecl->flags ){
+ printf(" %s", flagSet[i].desc);
+ }
+ }
+ printf("\n");
+ }
+ if( pDecl->pInclude ){
+ Include *p;
+ printf("includes:");
+ for(p=pDecl->pInclude; p; p=p->pNext){
+ printf(" %s",p->zFile);
+ }
+ printf("\n");
+ }
+ }
+}
+#endif
+
+/*
+** When the "-doc" command-line option is used, this routine is called
+** to print all of the database information to standard output.
+*/
+static void DocumentationDump(void){
+ Decl *pDecl;
+ static struct {
+ int mask;
+ char flag;
+ } flagSet[] = {
+ { TY_Class, 'c' },
+ { TY_Enumeration, 'e' },
+ { TY_Structure, 's' },
+ { TY_Union, 'u' },
+ { TY_Variable, 'v' },
+ { TY_Subroutine, 'f' },
+ { TY_Typedef, 't' },
+ { TY_Macro, 'm' },
+ { DP_Export, 'x' },
+ { DP_Local, 'l' },
+ { DP_Cplusplus, '+' },
+ };
+
+ for(pDecl = pDeclFirst; pDecl; pDecl=pDecl->pNext){
+ int i;
+ int nLabel = 0;
+ char *zDecl;
+ char zLabel[50];
+ for(i=0; i<sizeof(flagSet)/sizeof(flagSet[0]); i++){
+ if( DeclHasProperty(pDecl,flagSet[i].mask) ){
+ zLabel[nLabel++] = flagSet[i].flag;
+ }
+ }
+ if( nLabel==0 ) continue;
+ zLabel[nLabel] = 0;
+ zDecl = pDecl->zDecl;
+ if( zDecl==0 ) zDecl = pDecl->zFwd;
+ printf("%s %s %s %d %d %d %d %d %d\n",
+ pDecl->zName,
+ zLabel,
+ pDecl->zFile,
+ pDecl->pComment ? (int)pDecl->pComment/sizeof(Token) : 0,
+ pDecl->pComment ? pDecl->pComment->nText+1 : 0,
+ pDecl->zIf ? strlen(pDecl->zIf)+1 : 0,
+ zDecl ? strlen(zDecl) : 0,
+ pDecl->pComment ? pDecl->pComment->nLine : 0,
+ pDecl->tokenCode.nText ? pDecl->tokenCode.nText+1 : 0
+ );
+ if( pDecl->pComment ){
+ printf("%.*s\n",pDecl->pComment->nText, pDecl->pComment->zText);
+ }
+ if( pDecl->zIf ){
+ printf("%s\n",pDecl->zIf);
+ }
+ if( zDecl ){
+ printf("%s",zDecl);
+ }
+ if( pDecl->tokenCode.nText ){
+ printf("%.*s\n",pDecl->tokenCode.nText, pDecl->tokenCode.zText);
+ }
+ }
+}
+
+/*
+** Given the complete text of an input file, this routine prints a
+** documentation record for the header comment at the beginning of the
+** file (if the file has a header comment.)
+*/
+void PrintModuleRecord(const char *zFile, const char *zFilename){
+ int i;
+ static int addr = 5;
+ while( isspace(*zFile) ){ zFile++; }
+ if( *zFile!='/' || zFile[1]!='*' ) return;
+ for(i=2; zFile[i] && (zFile[i-1]!='/' || zFile[i-2]!='*'); i++){}
+ if( zFile[i]==0 ) return;
+ printf("%s M %s %d %d 0 0 0\n%.*s\n",
+ zFilename, zFilename, addr, i+1, i, zFile);
+ addr += 4;
+}
+
+
+/*
+** Given an input argument to the program, construct a new InFile
+** object.
+*/
+static InFile *CreateInFile(char *zArg, int *pnErr){
+ int nSrc;
+ char *zSrc;
+ InFile *pFile;
+ int i;
+
+ /*
+ ** Get the name of the input file to be scanned
+ */
+ zSrc = zArg;
+ for(nSrc=0; zSrc[nSrc] && zArg[nSrc]!=':'; nSrc++){}
+ pFile = SafeMalloc( sizeof(InFile) );
+ memset(pFile,0,sizeof(InFile));
+ pFile->zSrc = StrDup(zSrc,nSrc);
+
+ /* Figure out if we are dealing with C or C++ code. Assume any
+ ** file with ".c" or ".h" is C code and all else is C++.
+ */
+ if( nSrc>2 && zSrc[nSrc-2]=='.' && (zSrc[nSrc-1]=='c' || zSrc[nSrc-1]=='h')){
+ pFile->flags &= ~DP_Cplusplus;
+ }else{
+ pFile->flags |= DP_Cplusplus;
+ }
+
+ /*
+ ** If a separate header file is specified, use it
+ */
+ if( zSrc[nSrc]==':' ){
+ int nHdr;
+ char *zHdr;
+ zHdr = &zSrc[nSrc+1];
+ for(nHdr=0; zHdr[nHdr] && zHdr[nHdr]!=':'; nHdr++){}
+ pFile->zHdr = StrDup(zHdr,nHdr);
+ }
+
+ /* Look for any 'c' or 'C' in the suffix of the file name and change
+ ** that character to 'h' or 'H' respectively. If no 'c' or 'C' is found,
+ ** then assume we are dealing with a header.
+ */
+ else{
+ int foundC = 0;
+ int i, j;
+ for(i=0, j=-1; zSrc[i]; i++){
+ if( zSrc[i]=='/' && zSrc[i+1] ) j = i;
+ }
+ pFile->zHdr = StrDup(&zSrc[j+1], nSrc-(j+1));
+ for(i = nSrc-1; i>0 && pFile->zHdr[i]!='.'; i--){
+ if( pFile->zHdr[i]=='c' ){
+ foundC = 1;
+ pFile->zHdr[i] = 'h';
+ }else if( pFile->zHdr[i]=='C' ){
+ foundC = 1;
+ pFile->zHdr[i] = 'H';
+ }
+ }
+ if( !foundC ){
+ SafeFree(pFile->zHdr);
+ pFile->zHdr = 0;
+ }
+ }
+
+ /*
+ ** If pFile->zSrc contains no 'c' or 'C' in its extension, it
+ ** must be a header file. In that case, we need to set the
+ ** PS_Interface flag.
+ */
+ pFile->flags |= PS_Interface;
+ for(i=nSrc-1; i>0 && zSrc[i]!='.'; i--){
+ if( zSrc[i]=='c' || zSrc[i]=='C' ){
+ pFile->flags &= ~PS_Interface;
+ break;
+ }
+ }
+
+ /* Done!
+ */
+ return pFile;
+}
+
+/* MS-Windows and MS-DOS both have the following serious OS bug: the
+** length of a command line is severely restricted. But this program
+** occasionally requires long command lines. Hence the following
+** work around.
+**
+** If the parameters "-f FILENAME" appear anywhere on the command line,
+** then the named file is scanned for additional command line arguments.
+** These arguments are substituted in place of the "FILENAME" argument
+** in the original argument list.
+**
+** This first parameter to this routine is the index of the "-f"
+** parameter in the argv[] array. The argc and argv are passed by
+** pointer so that they can be changed.
+**
+** Parsing of the parameters in the file is very simple. Parameters
+** can be separated by any amount of white-space (including newlines
+** and carriage returns.) There are now quoting characters of any
+** kind. The length of a token is limited to about 1000 characters.
+*/
+static void AddParameters(int index, int *pArgc, char ***pArgv){
+ int argc = *pArgc; /* The original argc value */
+ char **argv = *pArgv; /* The original argv value */
+ int newArgc; /* Value for argc after inserting new arguments */
+ char **zNew; /* The new argv after this routine is done */
+ char *zFile; /* Name of the input file */
+ int nNew = 0; /* Number of new entries in the argv[] file */
+ int nAlloc = 0; /* Space allocated for zNew[] */
+ int i; /* Loop counter */
+ int n; /* Number of characters in a new argument */
+ int c; /* Next character of input */
+ int startOfLine = 1; /* True if we are where '#' can start a comment */
+ FILE *in; /* The input file */
+ char zBuf[1000]; /* A single argument is accumulated here */
+
+ if( index+1==argc ) return;
+ zFile = argv[index+1];
+ in = fopen(zFile,"r");
+ if( in==0 ){
+ fprintf(stderr,"Can't open input file \"%s\"\n",zFile);
+ exit(1);
+ }
+ c = ' ';
+ while( c!=EOF ){
+ while( c!=EOF && isspace(c) ){
+ if( c=='\n' ){
+ startOfLine = 1;
+ }
+ c = getc(in);
+ if( startOfLine && c=='#' ){
+ while( c!=EOF && c!='\n' ){
+ c = getc(in);
+ }
+ }
+ }
+ n = 0;
+ while( c!=EOF && !isspace(c) ){
+ if( n<sizeof(zBuf)-1 ){ zBuf[n++] = c; }
+ startOfLine = 0;
+ c = getc(in);
+ }
+ zBuf[n] = 0;
+ if( n>0 ){
+ nNew++;
+ if( nNew + argc > nAlloc ){
+ if( nAlloc==0 ){
+ nAlloc = 100 + argc;
+ zNew = malloc( sizeof(char*) * nAlloc );
+ }else{
+ nAlloc *= 2;
+ zNew = realloc( zNew, sizeof(char*) * nAlloc );
+ }
+ }
+ if( zNew ){
+ int j = nNew + index;
+ zNew[j] = malloc( n + 1 );
+ if( zNew[j] ){
+ strcpy( zNew[j], zBuf );
+ }
+ }
+ }
+ }
+ newArgc = argc + nNew - 1;
+ for(i=0; i<=index; i++){
+ zNew[i] = argv[i];
+ }
+ for(i=nNew + index + 1; i<newArgc; i++){
+ zNew[i] = argv[i + 1 - nNew];
+ }
+ zNew[newArgc] = 0;
+ *pArgc = newArgc;
+ *pArgv = zNew;
+}
+
+#ifdef NOT_USED
+/*
+** Return the time that the given file was last modified. If we can't
+** locate the file (because, for example, it doesn't exist), then
+** return 0.
+*/
+static unsigned int ModTime(const char *zFilename){
+ unsigned int mTime = 0;
+ struct stat sStat;
+ if( stat(zFilename,&sStat)==0 ){
+ mTime = sStat.st_mtime;
+ }
+ return mTime;
+}
+#endif
+
+/*
+** Print a usage comment for this program.
+*/
+static void Usage(const char *argv0, const char *argvN){
+ fprintf(stderr,"%s: Illegal argument \"%s\"\n",argv0,argvN);
+ fprintf(stderr,"Usage: %s [options] filename...\n"
+ "Options:\n"
+ " -h Generate a single .h to standard output.\n"
+ " -H Like -h, but only output EXPORT declarations.\n"
+ " -v (verbose) Write status information to the screen.\n"
+ " -doc Generate no header files. Instead, output information\n"
+ " that can be used by an automatic program documentation\n"
+ " and cross-reference generator.\n"
+ " -local Generate prototypes for \"static\" functions and\n"
+ " procedures.\n"
+ " -f FILE Read additional command-line arguments from the file named\n"
+ " \"FILE\".\n"
+#ifdef DEBUG
+ " -! MASK Set the debugging mask to the number \"MASK\".\n"
+#endif
+ " -- Treat all subsequent comment-line parameters as filenames,\n"
+ " even if they begin with \"-\".\n",
+ argv0
+ );
+}
+
+/*
+** The following text contains a few simple #defines that we want
+** to be available to every file.
+*/
+static char zInit[] =
+ "#define INTERFACE 0\n"
+ "#define EXPORT_INTERFACE 0\n"
+ "#define LOCAL_INTERFACE 0\n"
+ "#define EXPORT\n"
+ "#define LOCAL static\n"
+;
+
+#if TEST==0
+int main(int argc, char **argv){
+ int i; /* Loop counter */
+ int nErr = 0; /* Number of errors encountered */
+ Token *pList; /* List of input tokens for one file */
+ InFile *pFileList = 0;/* List of all input files */
+ InFile *pTail; /* Last file on the list */
+ InFile *pFile; /* for looping over the file list */
+ int h_flag = 0; /* True if -h is present. Output unified header */
+ int H_flag = 0; /* True if -H is present. Output EXPORT header */
+ int v_flag = 0; /* Verbose */
+ int noMoreFlags; /* True if -- has been seen. */
+ FILE *report; /* Send progress reports to this, if not NULL */
+
+ noMoreFlags = 0;
+ for(i=1; i<argc; i++){
+ if( argv[i][0]=='-' && !noMoreFlags ){
+ switch( argv[i][1] ){
+ case 'h': h_flag = 1; break;
+ case 'H': H_flag = 1; break;
+ case 'v': v_flag = 1; break;
+ case 'd': doc_flag = 1; proto_static = 1; break;
+ case 'l': proto_static = 1; break;
+ case 'f': AddParameters(i, &argc, &argv); break;
+ case '-': noMoreFlags = 1; break;
+#ifdef DEBUG
+ case '!': i++; debugMask = strtol(argv[i],0,0); break;
+#endif
+ default: Usage(argv[0],argv[i]); return 1;
+ }
+ }else{
+ pFile = CreateInFile(argv[i],&nErr);
+ if( pFile ){
+ if( pFileList ){
+ pTail->pNext = pFile;
+ pTail = pFile;
+ }else{
+ pFileList = pTail = pFile;
+ }
+ }
+ }
+ }
+ if( h_flag && H_flag ){
+ h_flag = 0;
+ }
+ if( v_flag ){
+ report = (h_flag || H_flag) ? stderr : stdout;
+ }else{
+ report = 0;
+ }
+ if( nErr>0 ){
+ return nErr;
+ }
+ for(pFile=pFileList; pFile; pFile=pFile->pNext){
+ char *zFile;
+
+ zFilename = pFile->zSrc;
+ if( zFilename==0 ) continue;
+ zFile = ReadFile(zFilename);
+ if( zFile==0 ){
+ fprintf(stderr,"Can't read input file \"%s\"\n",zFilename);
+ nErr++;
+ continue;
+ }
+ if( strncmp(zFile,zTopLine,nTopLine)==0 ){
+ pFile->zSrc = 0;
+ }else{
+ if( report ) fprintf(report,"Reading %s...\n",zFilename);
+ pList = TokenizeFile(zFile,&pFile->idTable);
+ if( pList ){
+ nErr += ParseFile(pList,pFile->flags);
+ FreeTokenList(pList);
+ }else if( zFile[0]==0 ){
+ fprintf(stderr,"Input file \"%s\" is empty.\n", zFilename);
+ nErr++;
+ }else{
+ fprintf(stderr,"Errors while processing \"%s\"\n", zFilename);
+ nErr++;
+ }
+ }
+ if( !doc_flag ) SafeFree(zFile);
+ if( doc_flag ) PrintModuleRecord(zFile,zFilename);
+ }
+ if( nErr>0 ){
+ return nErr;
+ }
+#ifdef DEBUG
+ if( debugMask & DECL_DUMP ){
+ DumpDeclList();
+ return nErr;
+ }
+#endif
+ if( doc_flag ){
+ DocumentationDump();
+ return nErr;
+ }
+ zFilename = "--internal--";
+ pList = TokenizeFile(zInit,0);
+ if( pList==0 ){
+ return nErr+1;
+ }
+ ParseFile(pList,PS_Interface);
+ FreeTokenList(pList);
+ if( h_flag || H_flag ){
+ nErr += MakeGlobalHeader(H_flag);
+ }else{
+ for(pFile=pFileList; pFile; pFile=pFile->pNext){
+ if( pFile->zSrc==0 ) continue;
+ nErr += MakeHeader(pFile,report,0);
+ }
+ }
+ return nErr;
+}
+#endif
diff --git a/tools/maketokens.tcl b/tools/maketokens.tcl
new file mode 100644
index 0000000..c61b657
--- /dev/null
+++ b/tools/maketokens.tcl
@@ -0,0 +1,96 @@
+#!/bin/sh
+# This script is a replacement for the maketokens.sh shell script.
+# The shell script required GNU awk. This script should work with
+# any old version of tclsh.
+# \
+exec tclsh "$0" ${1+"$@"}
+
+if {$argc!=1} {
+ puts stderr "Usage: $argv0 tokenlist.txt"
+ exit 1
+}
+if {[catch {open [lindex $argv 0] r} f]} {
+ puts stderr "$argv0: can not open \"[lindex $argv 0]\": $f"
+ exit 1
+}
+set tokenlist {}
+while {![eof $f]} {
+ set line [string trim [gets $f]]
+ if {$line==""} continue
+ if {[string index $line 0]=="#"} continue
+ if {[llength $line]!=2 && [llength $line]!=3} continue
+ lappend tokenlist [lindex $line 0]
+ lappend tokenlist [lindex $line 1]
+ lappend tokenlist [lindex $line 2]
+}
+close $f
+
+# Open the two files that will be generated.
+set h_file [open htmltokens2.h w]
+set c_file [open htmltokens.c w]
+
+set warning {
+/*
+ * DO NOT EDIT!
+ *
+ * The code in this file was automatically generated. See the files
+ * src/tokenlist.txt and tools/maketokens.tcl from the tkhtml source
+ * distribution.
+ */
+}
+puts $h_file $warning
+puts $c_file $warning
+
+puts $h_file {
+#define Html_Text 1
+#define Html_Space 2
+#define Html_Unknown 3
+#define Html_Block 4
+#define HtmlIsMarkup(X) ((X)->base.type>Html_Block)
+}
+
+set count 5
+set fmt {#define %-20s %d}
+
+foreach {name start end} $tokenlist {
+ set upr [string toupper $name]
+ puts $h_file [format $fmt Html_$upr $count]
+ incr count
+ if {$end!=""} {
+ puts $h_file [format $fmt Html_End$upr $count]
+ incr count
+ }
+}
+
+puts $h_file [format $fmt Html_TypeCount [expr $count-1]]
+puts $h_file "#define HTML_MARKUP_HASH_SIZE [expr $count+11]"
+puts $h_file "#define HTML_MARKUP_COUNT [expr $count-5]"
+puts $c_file "HtmlTokenMap HtmlMarkupMap\[\] = {"
+
+set fmt " { %-15s %-25s %-30s },"
+
+foreach {name start end} $tokenlist {
+ set upr [string toupper $name]
+ set nm "\"$name\","
+ set val Html_$upr,
+ if {$start=="0"} {
+ set size "0,"
+ } else {
+ set size "sizeof($start),"
+ }
+ puts $c_file [format $fmt $nm $val $size]
+ if {$end==""} continue
+ set nm "\"/$name\","
+ set val Html_End$upr,
+ if {$end=="0"} {
+ set size "0,"
+ } else {
+ set size "sizeof($end),"
+ }
+ puts $c_file [format $fmt $nm $val $size]
+}
+
+puts $c_file "};"
+
+close $c_file
+close $h_file
diff --git a/tools/manpage_clean b/tools/manpage_clean
new file mode 100755
index 0000000..b445235
--- /dev/null
+++ b/tools/manpage_clean
@@ -0,0 +1,8 @@
+#!/bin/sh
+# Assume call with pwd = 'doc'.
+# Remove all files generated by 'manpage_regen'
+
+rm ../tools/rules/manpages
+rm *.n
+rm *.html
+rm ../htdocs/mp.*.html
diff --git a/tools/manpage_regen b/tools/manpage_regen
new file mode 100755
index 0000000..9757ef0
--- /dev/null
+++ b/tools/manpage_regen
@@ -0,0 +1,31 @@
+#!/bin/sh
+
+# Assume call with pwd = 'doc'.
+
+# Phase I ... List known manpages ...
+
+rm ../tools/rules/manpages
+touch ../tools/rules/manpages
+
+for i in `ls *.man`
+do
+ echo $i '-->' manpages
+ ../tools/expand -rules ../tools/rules/manpage.list $i >> ../tools/rules/manpages
+done
+
+# Phase II .. Generate true output ...
+
+for i in `ls *.man`
+do
+ echo $i '-->' `basename $i .man`.n
+ ../tools/expand -rules ../tools/rules/manpage.nroff $i > `basename $i .man`.n
+
+ echo $i '-->' `basename $i .man`.html
+ ../tools/expand -rules ../tools/rules/manpage.html $i > `basename $i .man`.html
+
+ echo $i '-->' `basename $i .man`.html
+ ../tools/expand -rules ../tools/rules/manpage.html.site $i > ../htdocs/mp.`basename $i .man`.html
+
+ echo $i '-->' `basename $i .man`.tmml
+ ../tools/expand -rules ../tools/rules/manpage.tmml $i > `basename $i .man`.tmml
+done
diff --git a/tools/mkcsstester.tcl b/tools/mkcsstester.tcl
index a438171..8fa703a 100644
--- a/tools/mkcsstester.tcl
+++ b/tools/mkcsstester.tcl
@@ -61,7 +61,7 @@ set TemplateTwo {
<DIV style="float:right">
<INPUT type="button" value="Generate Report" onclick="loadtest(0,0)">
</DIV>
- <H1>Test Case: <SPAN id="testname"> </H1>
+ <H3>Test Case: <SPAN id="testname"> </H3>
<DIV id="container">
<DIV id="testframe_border">
<IFRAME name="testframe">
diff --git a/tools/mkinstalldirs b/tools/mkinstalldirs
new file mode 100755
index 0000000..91f6d04
--- /dev/null
+++ b/tools/mkinstalldirs
@@ -0,0 +1,32 @@
+#!/bin/sh
+# mkinstalldirs --- make directory hierarchy
+# Author: Noah Friedman <friedman at prep.ai.mit.edu>
+# Created: 1993-05-16
+# Last modified: 1994-03-25
+# Public domain
+
+errstatus=0
+
+for file in ${1+"$@"} ; do
+ set fnord `echo ":$file" | sed -ne 's/^:\//#/;s/^://;s/\// /g;s/^#/\//;p'`
+ shift
+
+ pathcomp=
+ for d in ${1+"$@"} ; do
+ pathcomp="$pathcomp$d"
+ case "$pathcomp" in
+ -* ) pathcomp=./$pathcomp ;;
+ esac
+
+ if test ! -d "$pathcomp"; then
+ echo "mkdir $pathcomp" 1>&2
+ mkdir "$pathcomp" || errstatus=$?
+ fi
+
+ pathcomp="$pathcomp/"
+ done
+done
+
+exit $errstatus
+
+# mkinstalldirs ends here
diff --git a/tools/mktclapp.c b/tools/mktclapp.c
new file mode 100644
index 0000000..7595643
--- /dev/null
+++ b/tools/mktclapp.c
@@ -0,0 +1,3206 @@
+/*
+** Copyright (c) 1998, 1999 D. Richard Hipp
+**
+** This program is free software; you can redistribute it and/or
+** modify it under the terms of the GNU General Public
+** License as published by the Free Software Foundation; either
+** version 2 of the License, or (at your option) any later version.
+**
+** This program is distributed in the hope that it will be useful,
+** but WITHOUT ANY WARRANTY; without even the implied warranty of
+** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+** General Public License for more details.
+**
+** You should have received a copy of the GNU General Public
+** License along with this library; if not, write to the
+** Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+** Boston, MA 02111-1307, USA.
+**
+** Author contact information:
+** drh at acm.org
+** http://www.hwaci.com/drh/
+*/
+#include <stdio.h>
+#include <ctype.h>
+#include <stdlib.h>
+#include <string.h>
+#include <sys/stat.h>
+#if defined(_WIN32) || defined(WIN32)
+# include <windows.h>
+# if !defined(R_OK)
+# define R_OK 4
+# endif
+#else
+# include <unistd.h>
+#endif
+#include <time.h>
+#include <assert.h>
+
+/*
+** Version information for this program
+*/
+static char zVersion[] = "mktclapp version 3.5. July 5, 1999";
+
+/*
+** Each new TCL commands discovered while scanning C/C++ source code is
+** stored in an instance of the following structure.
+*/
+typedef struct EtCmd EtCmd;
+struct EtCmd {
+ char *zIf; /* Surrounding #if statement */
+ char *zName; /* Name of the command */
+ int isObj; /* True if this is a Tcl_Obj command */
+ EtCmd *pNext; /* Next command on a list of them all */
+};
+
+/*
+** This is a list of all TCL commands in the scanned source
+*/
+static EtCmd *cmdList = 0;
+
+/*
+** Number of commands and object commands.
+*/
+static int nCmd = 0;
+static int nObjCmd = 0;
+
+/*
+** Each nested "#if" statement is stored as an instance of the
+** following structure.
+*/
+typedef struct IfStmt IfStmt;
+struct IfStmt {
+ char *zArg; /* Argument to the #if. Ex: "defined(DEBUG)" */
+ int invert; /* True to put a "!" in front */
+ int line; /* Line number of the original #if */
+ IfStmt *pNext; /* Next #if statement down on the stack */
+};
+
+/*
+** The nested #if statements
+*/
+static IfStmt *ifStack = 0;
+
+/*
+** Name of this program.
+*/
+static char *Argv0 = "mktclapp";
+
+/*
+** Number of errors
+*/
+static int nError = 0;
+
+/*
+** Surround the call to Et_AppInit() with this #if
+*/
+static char *seenEtAppInit = "0";
+
+/*
+** Surround the call to Et_PreInit() with this #if
+*/
+static char *seenEtPreInit = "0";
+
+/*
+** Surround the implmentation of main() with the inverse of this #if
+*/
+static char *seenMain = "0";
+
+/*
+** Allocate memory. Never fail. If not enough memory is available,
+** print an error message and abort.
+*/
+void *SafeMalloc(int nByte){
+ void *p = malloc(nByte);
+ if( p==0 ){
+ fprintf(stderr,"Out of memory. Can't allocate %d bytes\n", nByte);
+ exit(1);
+ }
+ memset(p, 0, nByte);
+ return p;
+}
+void *SafeRealloc(void *old, int nByte){
+ void *p;
+ if( old==0 ) return SafeMalloc(nByte);
+ p = realloc(old, nByte);
+ if( p==0 ){
+ fprintf(stderr,"Out of memory. Can't allocate %d bytes\n", nByte);
+ exit(1);
+ }
+ return p;
+}
+
+/*
+** The opposite of SafeMalloc(). Free memory previously obtained.
+*/
+void SafeFree(void *pMem){
+ if( pMem ) free(pMem);
+}
+
+/*
+** Return TRUE if the given character can be part of a C identifier.
+*/
+static int IsIdent(int c){
+ return isalnum(c) || c=='_';
+}
+
+/*
+** Create an "#if" argument that captures the state of all nested
+** "#if" statements, ORed with "zExtra". Space to hold
+** the returned string is obtained from SafeMalloc and must be
+** freed by the calling function.
+**
+** If the conditional is always TRUE, then NULL is returned.
+*/
+static char *IfString(char *zExtra){
+ int len = 0;
+ IfStmt *p;
+ char *z;
+ int i;
+ int isStackTrue = 1;
+ int isStackFalse = 0;
+ int isExtraFalse = 0;
+ char *zSep;
+ IfStmt *altStack;
+
+ if( zExtra && *zExtra ){
+ if( zExtra[1]==0 && zExtra[0]=='0' ){
+ isExtraFalse = 1;
+ }else if( zExtra[1]==0 && zExtra[0]=='1' ){
+ return 0;
+ }
+ len = strlen(zExtra) + 10;
+ }else{
+ len = 1;
+ isExtraFalse = 1;
+ }
+ for(p=ifStack; p; p=p->pNext){
+ len += strlen(p->zArg) + 6;
+ if( p->zArg[0]=='0' && p->zArg[1]==0 ){
+ if( !p->invert ){
+ isStackFalse = 1;
+ isStackTrue = 0;
+ break;
+ }
+ }else if( p->zArg[0]=='1' && p->zArg[1]==0 ){
+ if( p->invert ){
+ isStackFalse = 1;
+ isStackTrue = 0;
+ break;
+ }
+ }else{
+ isStackTrue = 0;
+ }
+ }
+ if( isStackTrue ){
+ return 0;
+ }else if( isStackFalse && isExtraFalse ){
+ z = SafeMalloc( 2 );
+ strcpy(z,"0");
+ return z;
+ }
+ z = SafeMalloc( len );
+ if( !isExtraFalse ){
+ sprintf(z,"(%s) || (",zExtra);
+ i = strlen(z);
+ }else{
+ i = 0;
+ }
+ zSep = "";
+ altStack = 0;
+ while( ifStack ){
+ p = ifStack;
+ ifStack = p->pNext;
+ p->pNext = altStack;
+ altStack = p;
+ }
+ for(p=altStack; p; p=p->pNext){
+ if( p->zArg[0]=='0' && p->zArg[1]==0 && p->invert ) continue;
+ if( p->zArg[0]=='1' && p->zArg[1]==0 && !p->invert ) continue;
+ if( p->invert ){
+ sprintf(&z[i],"%s!%s",zSep,p->zArg);
+ }else{
+ sprintf(&z[i],"%s%s",zSep,p->zArg);
+ }
+ i += strlen(&z[i]);
+ zSep = " && ";
+ }
+ while( altStack ){
+ p = altStack;
+ altStack = p->pNext;
+ p->pNext = ifStack;
+ ifStack = p;
+ }
+ if( !isExtraFalse ){
+ sprintf(&z[i],")");
+ }
+ return z;
+}
+
+/*
+** Push a new "#if" onto the if stack.
+*/
+static void PushIf(char *zArg, int line, int isNegated, int isDefined){
+ char *z;
+ IfStmt *p;
+ if( !isDefined ){
+ int i;
+ z = SafeMalloc( strlen(zArg) + 3 );
+ for(i=0; zArg[i] && IsIdent(zArg[i]); i++){}
+ if( zArg[i]==0 ){
+ sprintf(z,"%s",zArg);
+ }else{
+ sprintf(z,"(%s)",zArg);
+ }
+ }else{
+ z = SafeMalloc( strlen(zArg) + 10 );
+ sprintf(z,"defined(%s)",zArg);
+ }
+ p = SafeMalloc( sizeof(IfStmt) );
+ p->zArg = z;
+ p->line = line;
+ p->invert = isNegated;
+ p->pNext = ifStack;
+ ifStack = p;
+}
+
+/*
+** Extract the argument to an #if. Remove all leading and trailing
+** space.
+*/
+static char *GetArg(const char *fileName, char *z, int *pI, int *pLine){
+ int i = *pI;
+ int line = *pLine;
+ int start;
+ char *zResult;
+ int j, k;
+
+ while( isspace(z[i]) && z[i]!='\n' ){ i++; }
+ start = i;
+ if( z[i]=='\n' || z[i]==0 ){
+ fprintf(stderr,"%s: Missing argument to \"#if\" on line %d\n",
+ fileName, *pLine);
+ nError++;
+ line++;
+ }else{
+ while( z[i] && z[i]!='\n' ){
+ if( z[i]=='\\' && z[i+1]!=0 ){
+ i++;
+ }
+ if( z[i]=='\n' ){
+ line++;
+ }
+ i++;
+ }
+ }
+ zResult = SafeMalloc( i + 1 - start );
+ for(j=0, k=start; k<i; k++){
+ if( isspace(z[k]) && j>0 && isspace(zResult[j-1]) ){
+ /* Do nothing */
+ }else if( z[k]=='\\' && z[k+1]=='\n' ){
+ if( j>0 && !isspace(zResult[j-1]) ){
+ zResult[j++] = ' ';
+ }
+ k++;
+ }else if( z[k]=='\\' ){
+ zResult[j++] = z[k++];
+ }
+ zResult[j++] = z[k];
+ }
+ zResult[j] = 0;
+ while( j>0 && isspace(zResult[j-1]) ){
+ j--;
+ zResult[j] = 0;
+ }
+ *pI = i;
+ *pLine = line;
+ return zResult;
+}
+
+
+/*
+** Read the complete text of a file into memory. Return 0 if there
+** is any kind of error.
+*/
+char *ReadFileIntoMemory(const char *fileName){
+ FILE *in; /* Input file stream */
+ char *textBuf; /* A buffer in which to put entire text of input */
+ int toRead; /* Amount of input file read to read */
+ int got; /* Amount read so far */
+ struct stat statBuf; /* Status buffer for the file */
+
+ if( stat(fileName,&statBuf)!=0 ){
+ fprintf(stderr,"%s: no such file: %s\n", Argv0, fileName);
+ return 0;
+ }
+ textBuf = SafeMalloc( statBuf.st_size + 1 );
+ in = fopen(fileName,"rb");
+ if( in==0 ){
+ fprintf(stderr,"%s: can't open for reading: %s\n", Argv0, fileName);
+ SafeFree(textBuf);
+ return 0;
+ }
+ textBuf[statBuf.st_size] = 0;
+ toRead = statBuf.st_size;
+ got = 0;
+ while( toRead ){
+ int n = fread(&textBuf[got],1,toRead,in);
+ if( n<=0 ) break;
+ toRead -= n;
+ got += n;
+ }
+ fclose(in);
+ textBuf[got] = 0;
+ return textBuf;
+}
+
+/*
+** Given the "aaaa" part of the name of an ET_COMMAND_aaaa function,
+** compute the name of the corresponding Tcl command.
+**
+** The name is usually the same, except if there are two underscores
+** in the middle of the command, they are changed to colons. This
+** feature allows namespaces to be used. Example: The function
+** named
+**
+** ET_COMMAND_space1__proc1(ET_TCLARGS){...}
+**
+** will generate a TCL command called
+**
+** space1::proc1
+**
+** Space to hold the TCL command name is obtained from malloc().
+*/
+static char *FuncToProc(char *zFunc){
+ char *zProc;
+ int i;
+
+ zProc = SafeMalloc( strlen(zFunc) + 1 );
+ strcpy(zProc, zFunc);
+ for(i=0; zProc[i]; i++){
+ if( i>0 && zProc[i]=='_' && zProc[i+1]=='_' &&
+ isalnum(zProc[i-1]) && isalnum(zProc[i+2]) ){
+ zProc[i] = ':';
+ zProc[i+1] = ':';
+ }
+ }
+ return zProc;
+}
+
+/*
+** Scan a source file looking for new TCL commands and/or the Et_AppInit()
+** or Et_PreInit() functions.
+**
+** Skip all comments, and any text contained within "#if 0".."#endif"
+*/
+void ScanFile(const char *fileName){
+ char *z; /* Complete text of the file, NULL terminated. */
+ int i, j;
+ int inBrace = 0;
+ int line = 1;
+
+ z = ReadFileIntoMemory(fileName);
+ if( z==0 ){
+ nError++;
+ return;
+ }
+ for(i=0; z[i]; i++){
+ switch( z[i] ){
+ case '\n':
+ line++;
+ break;
+ case '/':
+ /* This might be a comment. If it is, skip it. */
+ if( z[i+1]=='*' ){
+ int start = line;
+ i += 2;
+ while( z[i] && (z[i]!='*' || z[i+1]!='/') ){
+ if( z[i]=='\n' ) line++;
+ i++;
+ }
+ if( z[i]==0 ){
+ fprintf(stderr,"%s: Unterminated comment beginning on line %d\n",
+ fileName, start);
+ nError++;
+ }else{
+ i++;
+ }
+ }else if( z[i+1]=='/' ){
+ while( z[i] && z[i]!='\n' ){ i++; }
+ if( z[i] ){ line++; };
+ }
+ break;
+ case '\'': {
+ /* Skip character literals */
+ int start = line;
+ for(i++; z[i] && z[i]!='\''; i++){
+ if( z[i]=='\n' ){
+ fprintf(stderr,"%s: Newline in character literal on line %d\n",
+ fileName, start);
+ line++;
+ }
+ if( z[i]=='\\' ) i++;
+ }
+ if( z[i]==0 ){
+ fprintf(stderr,"%s: unterminate character literal on line %d\n",
+ fileName, start);
+ nError++;
+ }
+ break;
+ }
+ case '"': {
+ /* Skip over a string */
+ int start = line;
+ for(i++; z[i] && z[i]!='"'; i++){
+ if( z[i]=='\n' ){
+ fprintf(stderr,"%s: Newline in string literal on line %d\n",
+ fileName, start);
+ line++;
+ }
+ if( z[i]=='\\' ) i++;
+ }
+ if( z[i]==0 ){
+ fprintf(stderr,"%s: unterminate string literal on line %d\n",
+ fileName, start);
+ nError++;
+ }
+ break;
+ }
+ case '#':
+ /* This might be a preprocessor macro such as #if 0 or #endif */
+ if( i>0 && z[i-1]!='\n' ) break;
+ for(j=i+1; isspace(z[j]); j++){}
+ if( strncmp(&z[j],"endif",5)==0 ){
+ if( ifStack==0 ){
+ fprintf(stderr,"%s: Unmatched \"#endif\" on line %d\n",
+ fileName, line);
+ nError++;
+ }else{
+ IfStmt *p = ifStack;
+ ifStack = p->pNext;
+ SafeFree(p->zArg);
+ SafeFree(p);
+ }
+ break;
+ }
+ if( strncmp(&z[j],"else",4)==0 ){
+ if( ifStack==0 ){
+ fprintf(stderr,"%s: No \"#if\" to pair with \"#else\" on line %d\n",
+ fileName, line);
+ nError++;
+ }else{
+ ifStack->invert = !ifStack->invert;
+ }
+ break;
+ }
+ if( z[j]!='i' || z[j+1]!='f' ) break;
+ if( strncmp(&z[j+2],"ndef",4)==0 ){
+ char *zArg;
+ int start = line;
+ i = j+6;
+ zArg = GetArg(fileName, z,&i,&line);
+ PushIf(zArg,start,1,1);
+ SafeFree(zArg);
+ }else if( strncmp(&z[j+2],"def",3)==0 ){
+ char *zArg;
+ int start = line;
+ i = j+5;
+ zArg = GetArg(fileName,z,&i,&line);
+ PushIf(zArg,start,0,1);
+ SafeFree(zArg);
+ }else{
+ char *zArg;
+ int start = line;
+ i = j+2;
+ zArg = GetArg(fileName,z,&i,&line);
+ PushIf(zArg,start,0,0);
+ SafeFree(zArg);
+ }
+ break;
+ case '{':
+ inBrace++;
+ break;
+ case '}':
+ inBrace--;
+ break;
+ case 'm':
+ /* Check main() */
+ if( inBrace>0 ) break;
+ if( i>0 && IsIdent(z[i-1]) ) break;
+ if( strncmp(&z[i],"main",4)==0 && !IsIdent(z[i+4]) ){
+ seenMain = IfString(seenMain);
+ }
+ case 'E':
+ /* Check ET_COMMAND_... or Et_AppInit or Et_PreInit */
+ if( inBrace>0 ) break;
+ if( i>0 && IsIdent(z[i-1]) ) break;
+ if( z[i+1]=='T' && strncmp(&z[i],"ET_COMMAND_",11)==0 ){
+ EtCmd *p;
+ for(j=i+11; IsIdent(z[j]); j++){}
+ p = SafeMalloc( sizeof(EtCmd) );
+ p->zIf = IfString(0);
+ p->zName = SafeMalloc( j-(i+9) );
+ sprintf(p->zName,"%.*s",j-(i+11),&z[i+11]);
+ p->pNext = cmdList;
+ cmdList = p;
+ nCmd++;
+ }else if( z[i+1]=='T' && strncmp(&z[i],"ET_OBJCOMMAND_",14)==0 ){
+ EtCmd *p;
+ for(j=i+14; IsIdent(z[j]); j++){}
+ p = SafeMalloc( sizeof(EtCmd) );
+ p->zIf = IfString(0);
+ p->zName = SafeMalloc( j-(i+9) );
+ p->isObj = 1;
+ sprintf(p->zName,"%.*s",j-(i+14),&z[i+14]);
+ p->pNext = cmdList;
+ cmdList = p;
+ nObjCmd++;
+ }else if( z[i+1]=='t' ){
+ if( strncmp(&z[i],"Et_AppInit",10)==0 && !IsIdent(z[i+10]) ){
+ seenEtAppInit = IfString(seenEtAppInit);
+ }
+ if( strncmp(&z[i],"Et_PreInit",10)==0 && !IsIdent(z[i+10]) ){
+ seenEtPreInit = IfString(seenEtPreInit);
+ }
+ }
+ break;
+ default:
+ /* Do nothing. Continue to the next character */
+ break;
+ }
+ }
+ SafeFree(z);
+ while( ifStack ){
+ IfStmt *p = ifStack;
+ fprintf(stderr,"%s: unterminated \"#if\" on line %d\n", fileName, p->line);
+ nError++;
+ ifStack = p->pNext;
+ SafeFree(p->zArg);
+ SafeFree(p);
+ }
+}
+
+/*
+** Set a macro according to the value of an #if argument.
+*/
+static void SetMacro(char *zMacroName, char *zIf){
+ if( zIf==0 || *zIf==0 ){
+ printf("#define %s 1\n",zMacroName);
+ }else if( zIf[0]=='0' && zIf[1]==0 ){
+ printf("#define %s 0\n",zMacroName);
+ }else{
+ printf(
+ "#if %s\n"
+ "# define %s 1\n"
+ "#else\n"
+ "# define %s 0\n"
+ "#endif\n",
+ zIf, zMacroName, zMacroName
+ );
+ }
+}
+
+/*
+** Look at the name of the file given and see if it is a Tcl file
+** or a C or C++ source file. Return TRUE for TCL and FALSE for
+** C or C++.
+*/
+static int IsTclFile(char *zFile){
+ static char *azCSuffix[] = {
+ ".c", ".cc", ".C", ".cpp", ".CPP", ".cxx", ".CXX"
+ };
+ int len = strlen(zFile);
+ int i;
+ for(i=0; i<sizeof(azCSuffix)/sizeof(azCSuffix[0]); i++){
+ int len2 = strlen(azCSuffix[i]);
+ if( len>len2 && strcmp(&zFile[len-len2],azCSuffix[i])==0 ){
+ return 0;
+ }
+ }
+ return 1;
+}
+
+/*
+** Compress a TCL script by removing comments and excess white-space
+*/
+static void CompressTcl(char *z){
+ int i, j, c;
+ int atLineStart = 1;
+ for(i=j=0; (c=z[i])!=0; i++){
+ switch( c ){
+ case ' ':
+ case '\t':
+ if( atLineStart ){
+ c = 0;
+ }
+ break;
+ case '#':
+ if( atLineStart && !isalpha(z[i+1]) ){
+ while( z[i] && z[i]!='\n' ){ i++; }
+ c = 0;
+ if( z[i]==0 ){ i--; }
+ }else{
+ atLineStart = 0;
+ }
+ break;
+ case '\n':
+ if( atLineStart ){
+ c = 0;
+ }else{
+ atLineStart = 1;
+ }
+ break;
+ default:
+ atLineStart = 0;
+ break;
+ }
+ if( c!=0 ){
+ z[j++] = c;
+ }
+ }
+ z[j] = 0;
+}
+
+/*
+** Write the text of the given file as a string. Tcl-style comments
+** are removed if the doCompress flag is true.
+*/
+static void WriteAsString(char *z, int shroud){
+ int c;
+ int xor;
+ int atLineStart = 1;
+ if( shroud>0 ){
+ xor = shroud;
+ }
+ putchar('"');
+ atLineStart = 0;
+ while( (c=*z)!=0 ){
+ z++;
+ if( c=='\r' && *z=='\n' ) continue;
+ if( shroud>0 && c>=0x20 ){ c ^= xor; xor = (xor+1)&0x1f; }
+ if( atLineStart ){
+ putchar('"');
+ atLineStart = 0;
+ }
+ switch( c ){
+ case '"':
+ case '\\':
+ putchar('\\');
+ putchar(c);
+ break;
+ case '\n':
+ putchar('\\');
+ putchar('n');
+ putchar('"');
+ putchar('\n');
+ atLineStart = 1;
+ break;
+ default:
+ if( c<' ' || c>'~' ){
+ putchar('\\');
+ putchar( ((c>>6)&3) + '0' );
+ putchar( ((c>>3)&7) + '0' );
+ putchar( (c&7) + '0' );
+ }else{
+ putchar(c);
+ }
+ break;
+ }
+ }
+ if( !atLineStart ){
+ putchar('"');
+ putchar('\n');
+ }
+}
+
+/*
+** The header string.
+*/
+static char zHeader[] =
+"/* Automatically generated code */\n"
+"/* DO NOT EDIT */\n"
+"#ifndef ET_TCLARGS\n"
+"#include <tcl.h>\n"
+"#ifdef __cplusplus\n"
+"# define ET_EXTERN extern \"C\"\n"
+"#else\n"
+"# define ET_EXTERN extern\n"
+"#endif\n"
+"ET_EXTERN char *mprintf(const char*,...);\n"
+"ET_EXTERN char *vmprintf(const char*,...);\n"
+"ET_EXTERN int Et_EvalF(Tcl_Interp*,const char *,...);\n"
+"ET_EXTERN int Et_GlobalEvalF(Tcl_Interp*,const char *,...);\n"
+"ET_EXTERN int Et_DStringAppendF(Tcl_DString*,const char*,...);\n"
+"ET_EXTERN int Et_ResultF(Tcl_Interp*,const char*,...);\n"
+"ET_EXTERN Tcl_Interp *Et_Interp;\n"
+"#if TCL_RELEASE_VERSION>=8\n"
+"ET_EXTERN int Et_AppendObjF(Tcl_Obj*,const char*,...);\n"
+"#endif\n"
+"#define ET_TCLARGS "
+ "ClientData clientData,Tcl_Interp*interp,int argc,char**argv\n"
+"#define ET_OBJARGS "
+ "ClientData clientData,Tcl_Interp*interp,int objc,Tcl_Obj *CONST objv[]\n"
+"#endif\n"
+;
+
+/*
+** Print a usage comment and die
+*/
+static void Usage(char *argv0){
+ fprintf(stderr,"Usage: %s arguments...\n", argv0);
+ fprintf(stderr,
+ " -header print a header file and exit\n"
+ " -srcdir DIR Prepend DIR to all relative pathnames\n"
+ " -version print the version number of mktclapp and exit\n"
+ " -notk built a Tcl-only program. No GUI\n"
+ " -autofork automatically fork the program into the background\n"
+ " -strip-tcl remove comments and extra white-space from\n"
+ " subsequent TCL files\n"
+ " -dont-strip-tcl stop stripping TCL files\n"
+ " -tcl-library directory holding the TCL script library\n"
+ " -tk-library directory holding the TK script library\n"
+ " -main-script FILE run the script FILE after initialization\n"
+ " -read-stdin read standard input\n"
+ " -console create a console window\n"
+ " -shroud hide compile-in TCL from view\n"
+ " -enable-obj use TCL Obj commands where possible\n"
+ " -standalone make the \"source\" TCL command only work\n"
+ " for builtin scripts\n"
+ " -f FILE read more command-line parameters from FILE\n"
+ " *.c scan this file for new TCL commands\n"
+ " *.tcl compile this file into the generated C code\n"
+ );
+ exit(1);
+}
+
+/*
+** Read one or more characters form "in" that follow a \ and
+** interpret them appropriately. Return the character that
+** results from this interpretation.
+*/
+static int EscapeChar(FILE *in){
+ int c, d;
+ c = getc(in);
+ switch( c ){
+ case 'n':
+ c = '\n';
+ break;
+ case 'r':
+ c = '\r';
+ break;
+ case 'f':
+ c = '\f';
+ break;
+ case 't':
+ c = '\t';
+ break;
+ case 'b':
+ c = '\b';
+ break;
+ case 'a':
+ c = '\a';
+ break;
+ case '0':
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ c -= '0';
+ d = getc(in);
+ if( d<'0' || d>'7' ){
+ ungetc(d,in);
+ break;
+ }
+ c = (c<<3) + (d - '0');
+ if( d<'0' || d>'7' ){
+ ungetc(d,in);
+ break;
+ }
+ c = (c<<3) + (d - '0');
+ break;
+ default:
+ break;
+ }
+ return c;
+}
+
+/* MS-Windows and MS-DOS both have the following serious OS bug: the
+** length of a command line is severely restricted. But this program
+** occasionally requires long command lines. Hence the following
+** work around.
+**
+** If the parameters "-f FILENAME" appear anywhere on the command line,
+** then the named file is scanned for additional command line arguments.
+** These arguments are substituted in place of the "FILENAME" argument
+** in the original argument list.
+**
+** This first parameter to this routine is the index of the "-f"
+** parameter in the argv[] array. The argc and argv are passed by
+** pointer so that they can be changed.
+**
+** Parsing of the parameters in the file is very simple. Parameters
+** can be separated by any amount of white-space (including newlines
+** and carriage returns.) " and ' can be used for quoting strings
+** with embedded spaces. The \ character escapes the following character.
+** The length of a token is limited to about 1000 characters.
+*/
+static void AddParameters(int index, int *pArgc, char ***pArgv){
+ int argc = *pArgc; /* The original argc value */
+ char **argv = *pArgv; /* The original argv value */
+ int newArgc; /* Value for argc after inserting new arguments */
+ char **zNew; /* The new argv after this routine is done */
+ char *zFile; /* Name of the input file */
+ int nNew = 0; /* Number of new entries in the argv[] file */
+ int nAlloc = 0; /* Space allocated for zNew[] */
+ int i; /* Loop counter */
+ int n; /* Number of characters in a new argument */
+ int c; /* Next character of input */
+ int startOfLine = 1; /* True if we are where '#' can start a comment */
+ FILE *in; /* The input file */
+ char zBuf[1000]; /* A single argument is accumulated here */
+
+ if( index+1==argc ) return;
+ zFile = argv[index+1];
+ in = fopen(zFile,"r");
+ if( in==0 ){
+ fprintf(stderr,"Can't open input file \"%s\"\n",zFile);
+ exit(1);
+ }
+ c = ' ';
+ while( c!=EOF ){
+ while( c!=EOF && isspace(c) ){
+ if( c=='\n' ){
+ startOfLine = 1;
+ }
+ c = getc(in);
+ if( startOfLine && c=='#' ){
+ while( c!=EOF && c!='\n' ){
+ c = getc(in);
+ }
+ }
+ }
+ n = 0;
+ if( c=='\'' || c=='"' ){
+ int quote = c;
+ c = getc(in);
+ startOfLine = 0;
+ while( c!=EOF && c!=quote ){
+ if( c=='\\' ) c = EscapeChar(in);
+ if( n<sizeof(zBuf)-1 ){ zBuf[n++] = c; }
+ c = getc(in);
+ }
+ if( c!=EOF ) c = getc(in);
+ }else{
+ while( c!=EOF && !isspace(c) ){
+ if( c=='\\' ) c = EscapeChar(in);
+ if( n<sizeof(zBuf)-1 ){ zBuf[n++] = c; }
+ startOfLine = 0;
+ c = getc(in);
+ }
+ }
+ zBuf[n] = 0;
+ if( n>0 ){
+ nNew++;
+ if( nNew + argc >= nAlloc ){
+ if( nAlloc==0 ){
+ nAlloc = 100 + argc;
+ zNew = malloc( sizeof(char*) * nAlloc );
+ }else{
+ nAlloc *= 2;
+ zNew = realloc( zNew, sizeof(char*) * nAlloc );
+ }
+ }
+ if( zNew ){
+ int j = nNew + index;
+ zNew[j] = malloc( n + 1 );
+ if( zNew[j] ){
+ strcpy( zNew[j], zBuf );
+ }
+ }
+ }
+ }
+ if( nNew>0 ){
+ newArgc = argc + nNew - 1;
+ for(i=0; i<=index; i++){
+ zNew[i] = argv[i];
+ }
+ }else{
+ zNew = argv;
+ }
+ for(i=nNew + index + 1; i<newArgc; i++){
+ zNew[i] = argv[i + 1 - nNew];
+ }
+ zNew[newArgc] = 0;
+ *pArgc = newArgc;
+ *pArgv = zNew;
+}
+
+int main(int argc, char **argv){
+ int i; /* Loop counter */
+ EtCmd *pCmd; /* A new TCL command found in C code */
+ int useTk = 1; /* False if the -notk flag is used */
+ int autoFork = 0; /* True if the -autofork flag is used */
+ int nTcl = 0; /* Number of TCL scripts */
+ char **azTcl; /* Name of all TCL scripts */
+ int *aDoCompress; /* Whether or not to compress each TCL script */
+ int doCompress = 1; /* Current state of the compression flag */
+ char *zTclLib = 0; /* Name of the TCL library */
+ char *zTkLib = 0; /* Name of the TK library */
+ char *zMainScript = 0; /* Name of a script to run first */
+ int shroud = 0; /* True to encrypt the compiled-in TCL */
+ int readStdin = 0; /* True to read TCL commands from STDIN */
+ int enableObj = 0; /* Enable the use of object commands */
+ int standalone = 0; /* True to disable the "source" command */
+ int stringify = 0; /* True to output only strings of the scripts */
+ int console = 0; /* True to put up a debugging console */
+ int nHash; /* Number of entries in hash table */
+ extern char zTail[];
+
+ if( argc>=2 && strcmp(argv[1],"-header")==0 ){
+ printf("%s",zHeader);
+ return 0;
+ }
+ if( argc>=2 && strcmp(argv[1],"-version")==0 ){
+ printf("%s\n",zVersion);
+ return 0;
+ }
+ azTcl = SafeMalloc( sizeof(char*)*(argc + 100) );
+ aDoCompress = SafeMalloc( sizeof(int)*(argc + 100) );
+ for(i=1; i<argc; i++){
+ if( argv[i][0]=='-' ){
+ if( strcmp(argv[i],"-header")==0 ){
+ printf("%s",zHeader);
+ return 0;
+ }else if( strcmp(argv[i],"-notk")==0 ){
+ useTk = 0;
+ }else if( strcmp(argv[i],"-autofork")==0 ){
+ autoFork = 1;
+ }else if( strcmp(argv[i],"-read-stdin")==0 ){
+ readStdin = 1;
+ }else if( strcmp(argv[i],"-console")==0 ){
+ console = 1;
+ }else if( strcmp(argv[i],"-shroud")==0 ){
+ shroud = 1;
+ }else if( strcmp(argv[i],"-strip-tcl")==0 ){
+ doCompress = 1;
+ }else if( strcmp(argv[i],"-dont-strip-tcl")==0 ){
+ doCompress = 0;
+ }else if( strcmp(argv[i],"-enable-obj")==0 ){
+ enableObj = 1;
+ }else if( strcmp(argv[i],"-standalone")==0 ){
+ standalone = 1;
+ }else if( strcmp(argv[i],"-stringify")==0 ){
+ stringify = 1;
+ }else if( i<argc-1 && strcmp(argv[i],"-srcdir")==0 ){
+ chdir(argv[++i]);
+ }else if( i<argc-1 && strcmp(argv[i],"-main-script")==0 ){
+ zMainScript = argv[++i];
+ }else if( i<argc-1 && strcmp(argv[i],"-tcl-library")==0 ){
+ zTclLib = argv[++i];
+ }else if( i<argc-1 && strcmp(argv[i],"-tk-library")==0 ){
+ zTkLib = argv[++i];
+ }else if( strcmp(argv[i],"-f")==0 ){
+ AddParameters(i, &argc, &argv);
+ azTcl = SafeRealloc(azTcl, sizeof(char*)*(argc + 100) );
+ aDoCompress = SafeRealloc(aDoCompress, sizeof(int)*(argc + 100) );
+ }else{
+ Usage(argv[0]);
+ }
+ }else if( IsTclFile(argv[i]) ){
+ if( access(argv[i],R_OK) ){
+ fprintf(stderr,"%s: can't open \"%s\" for reading\n", Argv0, argv[i]);
+ nError++;
+ }else{
+ int len = strlen(argv[i]);
+ azTcl[nTcl] = argv[i];
+ if( len>=9 && strcmp(&argv[i][len-9],"/tclIndex")==0 ){
+ aDoCompress[nTcl] = 0;
+ }else{
+ aDoCompress[nTcl] = doCompress;
+ }
+ nTcl++;
+ }
+ }else{
+ ScanFile(argv[i]);
+ }
+ }
+ if( nError>0 ) return nError;
+ if( stringify ){
+ for(i=0; i<nTcl; i++){
+ char *z;
+ z = ReadFileIntoMemory(azTcl[i]);
+ if( z==0 ) continue;
+ if( aDoCompress[i] ) CompressTcl(z);
+ WriteAsString(z,shroud);
+ printf(";\n");
+ SafeFree(z);
+ }
+ return 0;
+ }
+ if( nObjCmd>0 ) enableObj = 1;
+ printf(
+ "/* This code is automatically generated by \"mktclapp\" */\n"
+ "/* DO NOT EDIT */\n"
+ "#include <tcl.h>\n"
+ "#define INTERFACE 1\n"
+ "#if INTERFACE\n"
+ "#define ET_TCLARGS "
+ "ClientData clientData,Tcl_Interp*interp,int argc,char**argv\n"
+ "#define ET_OBJARGS "
+ "ClientData clientData,Tcl_Interp*interp,int objc,Tcl_Obj*CONST objv[]\n"
+ "#endif\n"
+ );
+ printf("#define ET_ENABLE_OBJ %d\n", enableObj);
+ printf("#define ET_ENABLE_TK %d\n", useTk!=0);
+ printf("#define ET_AUTO_FORK %d\n", autoFork!=0);
+ printf("#define ET_STANDALONE %d\n", standalone!=0);
+ SetMacro("ET_HAVE_APPINIT",seenEtAppInit);
+ SetMacro("ET_HAVE_PREINIT",seenEtPreInit);
+ SetMacro("ET_HAVE_MAIN",seenMain);
+ if( zTclLib ){
+ printf("#define ET_TCL_LIBRARY ");
+ WriteAsString(zTclLib,0);
+ }
+ if( zTkLib ){
+ printf("#define ET_TK_LIBRARY ");
+ WriteAsString(zTkLib,0);
+ }
+ if( zMainScript ){
+ printf("#define ET_MAIN_SCRIPT ");
+ WriteAsString(zMainScript,0);
+ }
+ if( shroud>0 ){
+ shroud = time(0) % 31 + 1;
+ }
+ printf("#define ET_SHROUD_KEY %d\n",shroud);
+ printf("#define ET_READ_STDIN %d\n",readStdin);
+ printf("#define ET_CONSOLE %d\n",console);
+ for(pCmd=cmdList; pCmd; pCmd=pCmd->pNext){
+ if( pCmd->zIf && pCmd->zIf[0]=='0' && pCmd->zIf[1]==0 ) continue;
+ if( pCmd->isObj ){
+ printf("extern int ET_OBJCOMMAND_%s(ET_OBJARGS);\n", pCmd->zName);
+ }else{
+ printf("extern int ET_COMMAND_%s(ET_TCLARGS);\n", pCmd->zName);
+ }
+ }
+ printf(
+ "static struct {\n"
+ " char *zName;\n"
+ " int (*xProc)(ET_TCLARGS);\n"
+ "} Et_CmdSet[] = {\n"
+ );
+ for(pCmd=cmdList; pCmd; pCmd=pCmd->pNext){
+ char *zProc;
+ if( pCmd->isObj ) continue;
+ if( pCmd->zIf ){
+ if( pCmd->zIf[0]=='0' && pCmd->zIf[1]==0 ) continue;
+ printf("#if %s\n",pCmd->zIf);
+ }
+ zProc = FuncToProc(pCmd->zName);
+ printf(" { \"%s\", ET_COMMAND_%s },\n", zProc, pCmd->zName);
+ SafeFree(zProc);
+ if( pCmd->zIf ){
+ printf("#endif\n");
+ }
+ }
+ printf("{0, 0}};\n");
+ if( enableObj ){
+ char *zProc;
+ printf(
+ "static struct {\n"
+ " char *zName;\n"
+ " int (*xProc)(ET_OBJARGS);\n"
+ "} Et_ObjSet[] = {\n"
+ );
+ for(pCmd=cmdList; pCmd; pCmd=pCmd->pNext){
+ if( !pCmd->isObj ) continue;
+ if( pCmd->zIf ){
+ if( pCmd->zIf[0]=='0' && pCmd->zIf[1]==0 ) continue;
+ printf("#if %s\n",pCmd->zIf);
+ }
+ zProc = FuncToProc(pCmd->zName);
+ printf(" { \"%s\", ET_OBJCOMMAND_%s },\n", zProc, pCmd->zName);
+ SafeFree(zProc);
+ if( pCmd->zIf ){
+ printf("#endif\n");
+ }
+ }
+ printf("{0, 0}};\n");
+ }
+ for(i=0; i<nTcl; i++){
+ char *z;
+ printf("static char Et_zFile%d[] = \n",i);
+ z = ReadFileIntoMemory(azTcl[i]);
+ if( z==0 ) continue;
+ if( aDoCompress[i] ) CompressTcl(z);
+ WriteAsString(z,shroud);
+ printf(";\n");
+ SafeFree(z);
+ }
+ printf(
+ "struct EtFile {\n"
+ " char *zName;\n"
+ " char *zData;\n"
+ " int nData;\n"
+ " int shrouded;\n"
+ " struct EtFile *pNext;\n"
+ "};\n"
+ "static struct EtFile Et_FileSet[] = {\n"
+ );
+ for(i=0; i<nTcl; i++){
+ printf(" { \"%s\", Et_zFile%d, sizeof(Et_zFile%d)-1, %d, 0 },\n",
+ azTcl[i], i, i, shroud);
+ }
+ fflush(stdout);
+ nHash = nTcl*2 + 1;
+ if( nHash<71 ){
+ nHash = 71;
+ }
+ printf(
+ "{0, 0}};\n"
+ "static struct EtFile *Et_FileHashTable[%d];\n"
+ "%s",
+ nHash, zTail
+ );
+ return nError;
+}
+
+char zTail[] =
+"/* The following copyright notice applies to code generated by\n"
+"** \"mktclapp\". The \"mktclapp\" program itself is covered by the\n"
+"** GNU Public License.\n"
+"**\n"
+"** Copyright (c) 1998 D. Richard Hipp\n"
+"**\n"
+"** The author hereby grants permission to use, copy, modify, distribute,\n"
+"** and license this software and its documentation for any purpose, provided\n"
+"** that existing copyright notices are retained in all copies and that this\n"
+"** notice is included verbatim in any distributions. No written agreement,\n"
+"** license, or royalty fee is required for any of the authorized uses.\n"
+"** Modifications to this software may be copyrighted by their authors\n"
+"** and need not follow the licensing terms described here, provided that\n"
+"** the new terms are clearly indicated on the first page of each file where\n"
+"** they apply.\n"
+"**\n"
+"** In no event shall the author or the distributors be liable to any party\n"
+"** for direct, indirect, special, incidental, or consequential damages\n"
+"** arising out of the use of this software, its documentation, or any\n"
+"** derivatives thereof, even if the author has been advised of the \n"
+"** possibility of such damage. The author and distributors specifically\n"
+"** disclaim any warranties, including but not limited to the implied\n"
+"** warranties of merchantability, fitness for a particular purpose, and\n"
+"** non-infringment. This software is provided at no fee on an\n"
+"** \"as is\" basis. The author and/or distritutors have no obligation\n"
+"** to provide maintenance, support, updates, enhancements and/or\n"
+"** modifications.\n"
+"**\n"
+"** GOVERNMENT USE: If you are acquiring this software on behalf of the\n"
+"** U.S. government, the Government shall have only \"Restricted Rights\"\n"
+"** in the software and related documentation as defined in the Federal \n"
+"** Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you\n"
+"** are acquiring the software on behalf of the Department of Defense, the\n"
+"** software shall be classified as \"Commercial Computer Software\" and the\n"
+"** Government shall have only \"Restricted Rights\" as defined in Clause\n"
+"** 252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the\n"
+"** author grants the U.S. Government and others acting in its behalf\n"
+"** permission to use and distribute the software in accordance with the\n"
+"** terms specified in this license. \n"
+"*/\n"
+"#include <ctype.h>\n"
+"#include <string.h>\n"
+"#include <stdarg.h>\n"
+"#include <stdio.h>\n"
+"#if ET_ENABLE_TK\n"
+"# include <tk.h>\n"
+"#else\n"
+"# include <tcl.h>\n"
+"#endif\n"
+"#include <stdlib.h>\n"
+"#include <sys/types.h>\n"
+"#include <sys/stat.h>\n"
+"#include <fcntl.h>\n"
+"\n"
+"/*\n"
+"** ET_WIN32 is true if we are running Tk under windows. The\n"
+"** <tcl.h> module will define __WIN32__ for us if we are compiling\n"
+"** for windows.\n"
+"*/\n"
+"#if defined(__WIN32__) && ET_ENABLE_TK\n"
+"# define ET_WIN32 1\n"
+"# include <windows.h>\n"
+"#else\n"
+"# define ET_WIN32 0\n"
+"#endif\n"
+"\n"
+"/*\n"
+"** Always disable ET_AUTO_FORK under windows. Windows doesn't\n"
+"** fork well.\n"
+"*/\n"
+"#if defined(__WIN32__)\n"
+"# undef ET_AUTO_FORK\n"
+"# define ET_AUTO_FORK 0\n"
+"#endif\n"
+"\n"
+"/*\n"
+"** Omit <unistd.h> under windows.\n"
+"*/\n"
+"#if !defined(__WIN32__)\n"
+"# include <unistd.h>\n"
+"#endif\n"
+"\n"
+"/*\n"
+"** The Tcl*InsertProc functions allow the system calls \"stat\",\n"
+"** \"access\" and \"open\" to be overloaded. This in turns allows us\n"
+"** to substituted compiled-in strings for files in the filesystem.\n"
+"** But the Tcl*InsertProc functions are only available in Tcl8.0.3\n"
+"** and later.\n"
+"**\n"
+"** Define the ET_HAVE_INSERTPROC macro if and only if we are dealing\n"
+"** with Tcl8.0.3 or later.\n"
+"*/\n"
+"#if TCL_MAJOR_VERSION==8 && (TCL_MINOR_VERSION>0 || TCL_RELEASE_SERIAL>=3)\n"
+"# define ET_HAVE_INSERTPROC\n"
+"#endif\n"
+"\n"
+"/*\n"
+"** Don't allow Win32 applications to read from stdin. Nor do\n"
+"** programs that automatically go into the background. Force\n"
+"** the use of a console in these cases.\n"
+"*/\n"
+"#if (ET_WIN32 || ET_AUTO_FORK) && ET_READ_STDIN\n"
+"# undef ET_READ_STDIN\n"
+"# undef ET_CONSOLE\n"
+"# define ET_READ_STDIN 0\n"
+"# define ET_CONSOLE 1\n"
+"#endif\n"
+"\n"
+"/*\n"
+"** The console won't work without Tk.\n"
+"*/\n"
+"#if ET_ENABLE_TK==0 && ET_CONSOLE\n"
+"# undef ET_CONSOLE\n"
+"# define ET_CONSOLE 0\n"
+"# undef ET_READ_STDIN\n"
+"# define ET_READ_STDIN 1\n"
+"#endif\n"
+"\n"
+"/*\n"
+"** Set ET_HAVE_OBJ to true if we are able to link against the\n"
+"** new Tcl_Obj interface.\n"
+"*/\n"
+"#if ET_ENABLE_OBJ || TCL_MAJOR_VERSION>=8\n"
+"# define ET_HAVE_OBJ 1\n"
+"#else\n"
+"# define ET_HAVE_OBJ 0\n"
+"#endif\n"
+"\n"
+"/*\n"
+"** The Tcl_GetByteArrayFromObj() only appears in Tcl version 8.1\n"
+"** and later. Substitute Tcl_GetStringFromObj() in Tcl version 8.0.X\n"
+"*/\n"
+"#if ET_HAVE_OBJ && TCL_MINOR_VERSION==0\n"
+"# define Tcl_GetByteArrayFromObj Tcl_GetStringFromObj\n"
+"#endif\n"
+"\n"
+"/*\n"
+"** Tcl code to implement the console.\n"
+"**\n"
+"** This code is written and tested separately, then run through\n"
+"** \"mktclapp -stringify\" and then pasted in here.\n"
+"*/\n"
+"#if ET_CONSOLE\n"
+"static char zEtConsole[] = \n"
+"\"proc console:create {w prompt title} {\\n\"\n"
+"\"upvar #0 $w.t v\\n\"\n"
+"\"if {[winfo exists $w]} {destroy $w}\\n\"\n"
+"\"catch {unset v}\\n\"\n"
+"\"toplevel $w\\n\"\n"
+"\"wm title $w $title\\n\"\n"
+"\"wm iconname $w $title\\n\"\n"
+"\"frame $w.mb -bd 2 -relief raised\\n\"\n"
+"\"pack $w.mb -side top -fill x\\n\"\n"
+"\"menubutton $w.mb.file -text File -menu $w.mb.file.m\\n\"\n"
+"\"menubutton $w.mb.edit -text Edit -menu $w.mb.edit.m\\n\"\n"
+"\"pack $w.mb.file $w.mb.edit -side left -padx 8 -pady 1\\n\"\n"
+"\"set m [menu $w.mb.file.m]\\n\"\n"
+"\"$m add command -label {Source...} -command \\\"console:SourceFile $w.t\\\"\\n\"\n"
+"\"$m add command -label {Save As...} -command \\\"console:SaveFile $w.t\\\"\\n\"\n"
+"\"$m add separator\\n\"\n"
+"\"$m add command -label {Close} -command \\\"destroy $w\\\"\\n\"\n"
+"\"$m add command -label {Exit} -command exit\\n\"\n"
+"\"set m [menu $w.mb.edit.m]\\n\"\n"
+"\"$m add command -label Cut -command \\\"console:Cut $w.t\\\"\\n\"\n"
+"\"$m add command -label Copy -command \\\"console:Copy $w.t\\\"\\n\"\n"
+"\"$m add command -label Paste -command \\\"console:Paste $w.t\\\"\\n\"\n"
+"\"$m add command -label {Clear Screen} -command \\\"console:Clear $w.t\\\"\\n\"\n"
+"\"catch {$m config -postcommand \\\"console:EnableEditMenu $w\\\"}\\n\"\n"
+"\"scrollbar $w.sb -orient vertical -command \\\"$w.t yview\\\"\\n\"\n"
+"\"pack $w.sb -side right -fill y\\n\"\n"
+"\"text $w.t -font fixed -yscrollcommand \\\"$w.sb set\\\"\\n\"\n"
+"\"pack $w.t -side right -fill both -expand 1\\n\"\n"
+"\"bindtags $w.t Console\\n\"\n"
+"\"set v(text) $w.t\\n\"\n"
+"\"set v(history) 0\\n\"\n"
+"\"set v(historycnt) 0\\n\"\n"
+"\"set v(current) -1\\n\"\n"
+"\"set v(prompt) $prompt\\n\"\n"
+"\"set v(prior) {}\\n\"\n"
+"\"set v(plength) [string length $v(prompt)]\\n\"\n"
+"\"set v(x) 0\\n\"\n"
+"\"set v(y) 0\\n\"\n"
+"\"$w.t mark set insert end\\n\"\n"
+"\"$w.t tag config ok -foreground blue\\n\"\n"
+"\"$w.t tag config err -foreground red\\n\"\n"
+"\"$w.t insert end $v(prompt)\\n\"\n"
+"\"$w.t mark set out 1.0\\n\"\n"
+"\"catch {rename puts console:oldputs$w}\\n\"\n"
+"\"proc puts args [format {\\n\"\n"
+"\"if {![winfo exists %s]} {\\n\"\n"
+"\"rename puts {}\\n\"\n"
+"\"rename console:oldputs%s puts\\n\"\n"
+"\"return [uplevel #0 puts $args]\\n\"\n"
+"\"}\\n\"\n"
+"\"switch -glob -- \\\"[llength $args] $args\\\" {\\n\"\n"
+"\"{1 *} {\\n\"\n"
+"\"set msg [lindex $args 0]\\\\n\\n\"\n"
+"\"set tag ok\\n\"\n"
+"\"}\\n\"\n"
+"\"{2 stdout *} {\\n\"\n"
+"\"set msg [lindex $args 1]\\\\n\\n\"\n"
+"\"set tag ok\\n\"\n"
+"\"}\\n\"\n"
+"\"{2 stderr *} {\\n\"\n"
+"\"set msg [lindex $args 1]\\\\n\\n\"\n"
+"\"set tag err\\n\"\n"
+"\"}\\n\"\n"
+"\"{2 -nonewline *} {\\n\"\n"
+"\"set msg [lindex $args 1]\\n\"\n"
+"\"set tag ok\\n\"\n"
+"\"}\\n\"\n"
+"\"{3 -nonewline stdout *} {\\n\"\n"
+"\"set msg [lindex $args 2]\\n\"\n"
+"\"set tag ok\\n\"\n"
+"\"}\\n\"\n"
+"\"{3 -nonewline stderr *} {\\n\"\n"
+"\"set msg [lindex $args 2]\\n\"\n"
+"\"set tag err\\n\"\n"
+"\"}\\n\"\n"
+"\"default {\\n\"\n"
+"\"uplevel #0 console:oldputs%s $args\\n\"\n"
+"\"return\\n\"\n"
+"\"}\\n\"\n"
+"\"}\\n\"\n"
+"\"console:Puts %s $msg $tag\\n\"\n"
+"\"} $w $w $w $w.t]\\n\"\n"
+"\"after idle \\\"focus $w.t\\\"\\n\"\n"
+"\"}\\n\"\n"
+"\"bind Console <1> {console:Button1 %W %x %y}\\n\"\n"
+"\"bind Console <B1-Motion> {console:B1Motion %W %x %y}\\n\"\n"
+"\"bind Console <B1-Leave> {console:B1Leave %W %x %y}\\n\"\n"
+"\"bind Console <B1-Enter> {console:cancelMotor %W}\\n\"\n"
+"\"bind Console <ButtonRelease-1> {console:cancelMotor %W}\\n\"\n"
+"\"bind Console <KeyPress> {console:Insert %W %A}\\n\"\n"
+"\"bind Console <Left> {console:Left %W}\\n\"\n"
+"\"bind Console <Control-b> {console:Left %W}\\n\"\n"
+"\"bind Console <Right> {console:Right %W}\\n\"\n"
+"\"bind Console <Control-f> {console:Right %W}\\n\"\n"
+"\"bind Console <BackSpace> {console:Backspace %W}\\n\"\n"
+"\"bind Console <Control-h> {console:Backspace %W}\\n\"\n"
+"\"bind Console <Delete> {console:Delete %W}\\n\"\n"
+"\"bind Console <Control-d> {console:Delete %W}\\n\"\n"
+"\"bind Console <Home> {console:Home %W}\\n\"\n"
+"\"bind Console <Control-a> {console:Home %W}\\n\"\n"
+"\"bind Console <End> {console:End %W}\\n\"\n"
+"\"bind Console <Control-e> {console:End %W}\\n\"\n"
+"\"bind Console <Return> {console:Enter %W}\\n\"\n"
+"\"bind Console <KP_Enter> {console:Enter %W}\\n\"\n"
+"\"bind Console <Up> {console:Prior %W}\\n\"\n"
+"\"bind Console <Control-p> {console:Prior %W}\\n\"\n"
+"\"bind Console <Down> {console:Next %W}\\n\"\n"
+"\"bind Console <Control-n> {console:Next %W}\\n\"\n"
+"\"bind Console <Control-k> {console:EraseEOL %W}\\n\"\n"
+"\"bind Console <<Cut>> {console:Cut %W}\\n\"\n"
+"\"bind Console <<Copy>> {console:Copy %W}\\n\"\n"
+"\"bind Console <<Paste>> {console:Paste %W}\\n\"\n"
+"\"bind Console <<Clear>> {console:Clear %W}\\n\"\n"
+"\"proc console:Puts {w t tag} {\\n\"\n"
+"\"set nc [string length $t]\\n\"\n"
+"\"set endc [string index $t [expr $nc-1]]\\n\"\n"
+"\"if {$endc==\\\"\\\\n\\\"} {\\n\"\n"
+"\"if {[$w index out]<[$w index {insert linestart}]} {\\n\"\n"
+"\"$w insert out [string range $t 0 [expr $nc-2]] $tag\\n\"\n"
+"\"$w mark set out {out linestart +1 lines}\\n\"\n"
+"\"} else {\\n\"\n"
+"\"$w insert out $t $tag\\n\"\n"
+"\"}\\n\"\n"
+"\"} else {\\n\"\n"
+"\"if {[$w index out]<[$w index {insert linestart}]} {\\n\"\n"
+"\"$w insert out $t $tag\\n\"\n"
+"\"} else {\\n\"\n"
+"\"$w insert out $t\\\\n $tag\\n\"\n"
+"\"$w mark set out {out -1 char}\\n\"\n"
+"\"}\\n\"\n"
+"\"}\\n\"\n"
+"\"$w yview insert\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:Insert {w a} {\\n\"\n"
+"\"$w insert insert $a\\n\"\n"
+"\"$w yview insert\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:Left {w} {\\n\"\n"
+"\"upvar #0 $w v\\n\"\n"
+"\"scan [$w index insert] %d.%d row col\\n\"\n"
+"\"if {$col>$v(plength)} {\\n\"\n"
+"\"$w mark set insert \\\"insert -1c\\\"\\n\"\n"
+"\"}\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:Backspace {w} {\\n\"\n"
+"\"upvar #0 $w v\\n\"\n"
+"\"scan [$w index insert] %d.%d row col\\n\"\n"
+"\"if {$col>$v(plength)} {\\n\"\n"
+"\"$w delete {insert -1c}\\n\"\n"
+"\"}\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:EraseEOL {w} {\\n\"\n"
+"\"upvar #0 $w v\\n\"\n"
+"\"scan [$w index insert] %d.%d row col\\n\"\n"
+"\"if {$col>=$v(plength)} {\\n\"\n"
+"\"$w delete insert {insert lineend}\\n\"\n"
+"\"}\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:Right {w} {\\n\"\n"
+"\"$w mark set insert \\\"insert +1c\\\"\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:Delete w {\\n\"\n"
+"\"$w delete insert\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:Home w {\\n\"\n"
+"\"upvar #0 $w v\\n\"\n"
+"\"scan [$w index insert] %d.%d row col\\n\"\n"
+"\"$w mark set insert $row.$v(plength)\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:End w {\\n\"\n"
+"\"$w mark set insert {insert lineend}\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:Enter w {\\n\"\n"
+"\"upvar #0 $w v\\n\"\n"
+"\"scan [$w index insert] %d.%d row col\\n\"\n"
+"\"set start $row.$v(plength)\\n\"\n"
+"\"set line [$w get $start \\\"$start lineend\\\"]\\n\"\n"
+"\"if {$v(historycnt)>0} {\\n\"\n"
+"\"set last [lindex $v(history) [expr $v(historycnt)-1]]\\n\"\n"
+"\"if {[string compare $last $line]} {\\n\"\n"
+"\"lappend v(history) $line\\n\"\n"
+"\"incr v(historycnt)\\n\"\n"
+"\"}\\n\"\n"
+"\"} else {\\n\"\n"
+"\"set v(history) [list $line]\\n\"\n"
+"\"set v(historycnt) 1\\n\"\n"
+"\"}\\n\"\n"
+"\"set v(current) $v(historycnt)\\n\"\n"
+"\"$w insert end \\\\n\\n\"\n"
+"\"$w mark set out end\\n\"\n"
+"\"if {$v(prior)==\\\"\\\"} {\\n\"\n"
+"\"set cmd $line\\n\"\n"
+"\"} else {\\n\"\n"
+"\"set cmd $v(prior)\\\\n$line\\n\"\n"
+"\"}\\n\"\n"
+"\"if {[info complete $cmd]} {\\n\"\n"
+"\"set rc [catch {uplevel #0 $cmd} res]\\n\"\n"
+"\"if {![winfo exists $w]} return\\n\"\n"
+"\"if {$rc} {\\n\"\n"
+"\"$w insert end $res\\\\n err\\n\"\n"
+"\"} elseif {[string length $res]>0} {\\n\"\n"
+"\"$w insert end $res\\\\n ok\\n\"\n"
+"\"}\\n\"\n"
+"\"set v(prior) {}\\n\"\n"
+"\"$w insert end $v(prompt)\\n\"\n"
+"\"} else {\\n\"\n"
+"\"set v(prior) $cmd\\n\"\n"
+"\"regsub -all {[^ ]} $v(prompt) . x\\n\"\n"
+"\"$w insert end $x\\n\"\n"
+"\"}\\n\"\n"
+"\"$w mark set insert end\\n\"\n"
+"\"$w mark set out {insert linestart}\\n\"\n"
+"\"$w yview insert\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:Prior w {\\n\"\n"
+"\"upvar #0 $w v\\n\"\n"
+"\"if {$v(current)<=0} return\\n\"\n"
+"\"incr v(current) -1\\n\"\n"
+"\"set line [lindex $v(history) $v(current)]\\n\"\n"
+"\"console:SetLine $w $line\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:Next w {\\n\"\n"
+"\"upvar #0 $w v\\n\"\n"
+"\"if {$v(current)>=$v(historycnt)} return\\n\"\n"
+"\"incr v(current) 1\\n\"\n"
+"\"set line [lindex $v(history) $v(current)]\\n\"\n"
+"\"console:SetLine $w $line\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:SetLine {w line} {\\n\"\n"
+"\"upvar #0 $w v\\n\"\n"
+"\"scan [$w index insert] %d.%d row col\\n\"\n"
+"\"set start $row.$v(plength)\\n\"\n"
+"\"$w delete $start end\\n\"\n"
+"\"$w insert end $line\\n\"\n"
+"\"$w mark set insert end\\n\"\n"
+"\"$w yview insert\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:Button1 {w x y} {\\n\"\n"
+"\"global tkPriv\\n\"\n"
+"\"upvar #0 $w v\\n\"\n"
+"\"set v(mouseMoved) 0\\n\"\n"
+"\"set v(pressX) $x\\n\"\n"
+"\"set p [console:nearestBoundry $w $x $y]\\n\"\n"
+"\"scan [$w index insert] %d.%d ix iy\\n\"\n"
+"\"scan $p %d.%d px py\\n\"\n"
+"\"if {$px==$ix} {\\n\"\n"
+"\"$w mark set insert $p\\n\"\n"
+"\"}\\n\"\n"
+"\"$w mark set anchor $p\\n\"\n"
+"\"focus $w\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:nearestBoundry {w x y} {\\n\"\n"
+"\"set p [$w index @$x,$y]\\n\"\n"
+"\"set bb [$w bbox $p]\\n\"\n"
+"\"if {![string compare $bb \\\"\\\"]} {return $p}\\n\"\n"
+"\"if {($x-[lindex $bb 0])<([lindex $bb 2]/2)} {return $p}\\n\"\n"
+"\"$w index \\\"$p + 1 char\\\"\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:SelectTo {w x y} {\\n\"\n"
+"\"upvar #0 $w v\\n\"\n"
+"\"set cur [console:nearestBoundry $w $x $y]\\n\"\n"
+"\"if {[catch {$w index anchor}]} {\\n\"\n"
+"\"$w mark set anchor $cur\\n\"\n"
+"\"}\\n\"\n"
+"\"set anchor [$w index anchor]\\n\"\n"
+"\"if {[$w compare $cur != $anchor] || (abs($v(pressX) - $x) >= 3)} {\\n\"\n"
+"\"if {$v(mouseMoved)==0} {\\n\"\n"
+"\"$w tag remove sel 0.0 end\\n\"\n"
+"\"}\\n\"\n"
+"\"set v(mouseMoved) 1\\n\"\n"
+"\"}\\n\"\n"
+"\"if {[$w compare $cur < anchor]} {\\n\"\n"
+"\"set first $cur\\n\"\n"
+"\"set last anchor\\n\"\n"
+"\"} else {\\n\"\n"
+"\"set first anchor\\n\"\n"
+"\"set last $cur\\n\"\n"
+"\"}\\n\"\n"
+"\"if {$v(mouseMoved)} {\\n\"\n"
+"\"$w tag remove sel 0.0 $first\\n\"\n"
+"\"$w tag add sel $first $last\\n\"\n"
+"\"$w tag remove sel $last end\\n\"\n"
+"\"update idletasks\\n\"\n"
+"\"}\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:B1Motion {w x y} {\\n\"\n"
+"\"upvar #0 $w v\\n\"\n"
+"\"set v(y) $y\\n\"\n"
+"\"set v(x) $x\\n\"\n"
+"\"console:SelectTo $w $x $y\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:B1Leave {w x y} {\\n\"\n"
+"\"upvar #0 $w v\\n\"\n"
+"\"set v(y) $y\\n\"\n"
+"\"set v(x) $x\\n\"\n"
+"\"console:motor $w\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:motor w {\\n\"\n"
+"\"upvar #0 $w v\\n\"\n"
+"\"if {![winfo exists $w]} return\\n\"\n"
+"\"if {$v(y)>=[winfo height $w]} {\\n\"\n"
+"\"$w yview scroll 1 units\\n\"\n"
+"\"} elseif {$v(y)<0} {\\n\"\n"
+"\"$w yview scroll -1 units\\n\"\n"
+"\"} else {\\n\"\n"
+"\"return\\n\"\n"
+"\"}\\n\"\n"
+"\"console:SelectTo $w $v(x) $v(y)\\n\"\n"
+"\"set v(timer) [after 50 console:motor $w]\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:cancelMotor w {\\n\"\n"
+"\"upvar #0 $w v\\n\"\n"
+"\"catch {after cancel $v(timer)}\\n\"\n"
+"\"catch {unset v(timer)}\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:Copy w {\\n\"\n"
+"\"if {![catch {set text [$w get sel.first sel.last]}]} {\\n\"\n"
+"\"clipboard clear -displayof $w\\n\"\n"
+"\"clipboard append -displayof $w $text\\n\"\n"
+"\"}\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:canCut w {\\n\"\n"
+"\"set r [catch {\\n\"\n"
+"\"scan [$w index sel.first] %d.%d s1x s1y\\n\"\n"
+"\"scan [$w index sel.last] %d.%d s2x s2y\\n\"\n"
+"\"scan [$w index insert] %d.%d ix iy\\n\"\n"
+"\"}]\\n\"\n"
+"\"if {$r==1} {return 0}\\n\"\n"
+"\"if {$s1x==$ix && $s2x==$ix} {return 1}\\n\"\n"
+"\"return 2\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:Cut w {\\n\"\n"
+"\"if {[console:canCut $w]==1} {\\n\"\n"
+"\"console:Copy $w\\n\"\n"
+"\"$w delete sel.first sel.last\\n\"\n"
+"\"}\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:Paste w {\\n\"\n"
+"\"if {[console:canCut $w]==1} {\\n\"\n"
+"\"$w delete sel.first sel.last\\n\"\n"
+"\"}\\n\"\n"
+"\"if {[catch {selection get -displayof $w -selection CLIPBOARD} topaste]} {\\n\"\n"
+"\"return\\n\"\n"
+"\"}\\n\"\n"
+"\"set prior 0\\n\"\n"
+"\"foreach line [split $topaste \\\\n] {\\n\"\n"
+"\"if {$prior} {\\n\"\n"
+"\"console:Enter $w\\n\"\n"
+"\"update\\n\"\n"
+"\"}\\n\"\n"
+"\"set prior 1\\n\"\n"
+"\"$w insert insert $line\\n\"\n"
+"\"}\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:EnableEditMenu w {\\n\"\n"
+"\"set m $w.mb.edit.m\\n\"\n"
+"\"switch [console:canCut $w.t] {\\n\"\n"
+"\"0 {\\n\"\n"
+"\"$m entryconf Copy -state disabled\\n\"\n"
+"\"$m entryconf Cut -state disabled\\n\"\n"
+"\"}\\n\"\n"
+"\"1 {\\n\"\n"
+"\"$m entryconf Copy -state normal\\n\"\n"
+"\"$m entryconf Cut -state normal\\n\"\n"
+"\"}\\n\"\n"
+"\"2 {\\n\"\n"
+"\"$m entryconf Copy -state normal\\n\"\n"
+"\"$m entryconf Cut -state disabled\\n\"\n"
+"\"}\\n\"\n"
+"\"}\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:SourceFile w {\\n\"\n"
+"\"set types {\\n\"\n"
+"\"{{TCL Scripts} {.tcl}}\\n\"\n"
+"\"{{All Files} *}\\n\"\n"
+"\"}\\n\"\n"
+"\"set f [tk_getOpenFile -filetypes $types -title \\\"TCL Script To Source...\\\"]\\n\"\n"
+"\"if {$f!=\\\"\\\"} {\\n\"\n"
+"\"uplevel #0 source $f\\n\"\n"
+"\"}\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:SaveFile w {\\n\"\n"
+"\"set types {\\n\"\n"
+"\"{{Text Files} {.txt}}\\n\"\n"
+"\"{{All Files} *}\\n\"\n"
+"\"}\\n\"\n"
+"\"set f [tk_getSaveFile -filetypes $types -title \\\"Write Screen To...\\\"]\\n\"\n"
+"\"if {$f!=\\\"\\\"} {\\n\"\n"
+"\"if {[catch {open $f w} fd]} {\\n\"\n"
+"\"tk_messageBox -type ok -icon error -message $fd\\n\"\n"
+"\"} else {\\n\"\n"
+"\"puts $fd [string trimright [$w get 1.0 end] \\\\n]\\n\"\n"
+"\"close $fd\\n\"\n"
+"\"}\\n\"\n"
+"\"}\\n\"\n"
+"\"}\\n\"\n"
+"\"proc console:Clear w {\\n\"\n"
+"\"$w delete 1.0 {insert linestart}\\n\"\n"
+"\"}\\n\"\n"
+"\"console:create {. at console} {% } {Tcl/Tk Console}\\n\"\n"
+";\n"
+"#endif\n"
+"\n"
+"/*\n"
+"** The \"printf\" code that follows dates from the 1980's. It is in\n"
+"** the public domain. The original comments are included here for\n"
+"** completeness...\n"
+"**\n"
+"** The following modules is an enhanced replacement for the \"printf\" programs\n"
+"** found in the standard library. The following enhancements are\n"
+"** supported:\n"
+"**\n"
+"** + Additional functions. The standard set of \"printf\" functions\n"
+"** includes printf, fprintf, sprintf, vprintf, vfprintf, and\n"
+"** vsprintf. This module adds the following:\n"
+"**\n"
+"** * snprintf -- Works like sprintf, but has an extra argument\n"
+"** which is the size of the buffer written to.\n"
+"**\n"
+"** * mprintf -- Similar to sprintf. Writes output to memory\n"
+"** obtained from malloc.\n"
+"**\n"
+"** * xprintf -- Calls a function to dispose of output.\n"
+"**\n"
+"** * nprintf -- No output, but returns the number of characters\n"
+"** that would have been output by printf.\n"
+"**\n"
+"** * A v- version (ex: vsnprintf) of every function is also\n"
+"** supplied.\n"
+"**\n"
+"** + A few extensions to the formatting notation are supported:\n"
+"**\n"
+"** * The \"=\" flag (similar to \"-\") causes the output to be\n"
+"** be centered in the appropriately sized field.\n"
+"**\n"
+"** * The %b field outputs an integer in binary notation.\n"
+"**\n"
+"** * The %c field now accepts a precision. The character output\n"
+"** is repeated by the number of times the precision specifies.\n"
+"**\n"
+"** * The %' field works like %c, but takes as its character the\n"
+"** next character of the format string, instead of the next\n"
+"** argument. For example, printf(\"%.78'-\") prints 78 minus\n"
+"** signs, the same as printf(\"%.78c\",'-').\n"
+"**\n"
+"** + When compiled using GCC on a SPARC, this version of printf is\n"
+"** faster than the library printf for SUN OS 4.1.\n"
+"**\n"
+"** + All functions are fully reentrant.\n"
+"**\n"
+"*/\n"
+"/*\n"
+"** Undefine COMPATIBILITY to make some slight changes in the way things\n"
+"** work. I think the changes are an improvement, but they are not\n"
+"** backwards compatible.\n"
+"*/\n"
+"/* #define COMPATIBILITY / * Compatible with SUN OS 4.1 */\n"
+"\n"
+"/*\n"
+"** Characters that need to be escaped inside a TCL string.\n"
+"*/\n"
+"static char NeedEsc[] = {\n"
+" 1, 1, 1, 1, 1, 1, 1, 1, 'b', 't', 'n', 1, 'f', 'r', 1, 1,\n"
+" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
+" 0, 0, '\"', 0, '$', 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\n"
+" 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\n"
+" 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\n"
+" 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, '[','\\\\', ']', 0, 0,\n"
+" 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\n"
+" 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1,\n"
+" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
+" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
+" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
+" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
+" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
+" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
+" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
+" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
+"};\n"
+"\n"
+"/*\n"
+"** Conversion types fall into various categories as defined by the\n"
+"** following enumeration.\n"
+"*/\n"
+"enum et_type { /* The type of the format field */\n"
+" etRADIX, /* Integer types. %d, %x, %o, and so forth */\n"
+" etFLOAT, /* Floating point. %f */\n"
+" etEXP, /* Exponentional notation. %e and %E */\n"
+" etGENERIC, /* Floating or exponential, depending on exponent. %g */\n"
+" etSIZE, /* Return number of characters processed so far. %n */\n"
+" etSTRING, /* Strings. %s */\n"
+" etPERCENT, /* Percent symbol. %% */\n"
+" etCHARX, /* Characters. %c */\n"
+" etERROR, /* Used to indicate no such conversion type */\n"
+"/* The rest are extensions, not normally found in printf() */\n"
+" etCHARLIT, /* Literal characters. %' */\n"
+" etTCLESCAPE, /* Strings with special characters escaped. %q */\n"
+" etMEMSTRING, /* A string which should be deleted after use. %z */\n"
+" etORDINAL /* 1st, 2nd, 3rd and so forth */\n"
+"};\n"
+"\n"
+"/*\n"
+"** Each builtin conversion character (ex: the 'd' in \"%d\") is described\n"
+"** by an instance of the following structure\n"
+"*/\n"
+"typedef struct et_info { /* Information about each format field */\n"
+" int fmttype; /* The format field code letter */\n"
+" int base; /* The base for radix conversion */\n"
+" char *charset; /* The character set for conversion */\n"
+" int flag_signed; /* Is the quantity signed? */\n"
+" char *prefix; /* Prefix on non-zero values in alt format */\n"
+" enum et_type type; /* Conversion paradigm */\n"
+"} et_info;\n"
+"\n"
+"/*\n"
+"** The following table is searched linearly, so it is good to put the\n"
+"** most frequently used conversion types first.\n"
+"*/\n"
+"static et_info fmtinfo[] = {\n"
+" { 'd', 10, \"0123456789\", 1, 0, etRADIX, },\n"
+" { 's', 0, 0, 0, 0, etSTRING, }, \n"
+" { 'q', 0, 0, 0, 0, etTCLESCAPE, },\n"
+" { 'z', 0, 0, 0, 0, etMEMSTRING, },\n"
+" { 'c', 0, 0, 0, 0, etCHARX, },\n"
+" { 'o', 8, \"01234567\", 0, \"0\", etRADIX, },\n"
+" { 'u', 10, \"0123456789\", 0, 0, etRADIX, },\n"
+" { 'x', 16, \"0123456789abcdef\", 0, \"x0\", etRADIX, },\n"
+" { 'X', 16, \"0123456789ABCDEF\", 0, \"X0\", etRADIX, },\n"
+" { 'r', 10, \"0123456789\", 0, 0, etORDINAL, },\n"
+" { 'f', 0, 0, 1, 0, etFLOAT, },\n"
+" { 'e', 0, \"e\", 1, 0, etEXP, },\n"
+" { 'E', 0, \"E\", 1, 0, etEXP, },\n"
+" { 'g', 0, \"e\", 1, 0, etGENERIC, },\n"
+" { 'G', 0, \"E\", 1, 0, etGENERIC, },\n"
+" { 'i', 10, \"0123456789\", 1, 0, etRADIX, },\n"
+" { 'n', 0, 0, 0, 0, etSIZE, },\n"
+" { '%', 0, 0, 0, 0, etPERCENT, },\n"
+" { 'b', 2, \"01\", 0, \"b0\", etRADIX, }, /* Binary */\n"
+" { 'p', 10, \"0123456789\", 0, 0, etRADIX, }, /* Pointers */\n"
+" { '\\'', 0, 0, 0, 0, etCHARLIT, }, /* Literal char */\n"
+"};\n"
+"#define etNINFO (sizeof(fmtinfo)/sizeof(fmtinfo[0]))\n"
+"\n"
+"/*\n"
+"** If NOFLOATINGPOINT is defined, then none of the floating point\n"
+"** conversions will work.\n"
+"*/\n"
+"#ifndef etNOFLOATINGPOINT\n"
+"/*\n"
+"** \"*val\" is a double such that 0.1 <= *val < 10.0\n"
+"** Return the ascii code for the leading digit of *val, then\n"
+"** multiply \"*val\" by 10.0 to renormalize.\n"
+"**\n"
+"** Example:\n"
+"** input: *val = 3.14159\n"
+"** output: *val = 1.4159 function return = '3'\n"
+"**\n"
+"** The counter *cnt is incremented each time. After counter exceeds\n"
+"** 16 (the number of significant digits in a 64-bit float) '0' is\n"
+"** always returned.\n"
+"*/\n"
+"static int et_getdigit(double *val, int *cnt){\n"
+" int digit;\n"
+" double d;\n"
+" if( (*cnt)++ >= 16 ) return '0';\n"
+" digit = (int)*val;\n"
+" d = digit;\n"
+" digit += '0';\n"
+" *val = (*val - d)*10.0;\n"
+" return digit;\n"
+"}\n"
+"#endif\n"
+"\n"
+"#define etBUFSIZE 1000 /* Size of the output buffer */\n"
+"\n"
+"/*\n"
+"** The root program. All variations call this core.\n"
+"**\n"
+"** INPUTS:\n"
+"** func This is a pointer to a function taking three arguments\n"
+"** 1. A pointer to anything. Same as the \"arg\" parameter.\n"
+"** 2. A pointer to the list of characters to be output\n"
+"** (Note, this list is NOT null terminated.)\n"
+"** 3. An integer number of characters to be output.\n"
+"** (Note: This number might be zero.)\n"
+"**\n"
+"** arg This is the pointer to anything which will be passed as the\n"
+"** first argument to \"func\". Use it for whatever you like.\n"
+"**\n"
+"** fmt This is the format string, as in the usual print.\n"
+"**\n"
+"** ap This is a pointer to a list of arguments. Same as in\n"
+"** vfprint.\n"
+"**\n"
+"** OUTPUTS:\n"
+"** The return value is the total number of characters sent to\n"
+"** the function \"func\". Returns -1 on a error.\n"
+"**\n"
+"** Note that the order in which automatic variables are declared below\n"
+"** seems to make a big difference in determining how fast this beast\n"
+"** will run.\n"
+"*/\n"
+"int vxprintf(\n"
+" void (*func)(void*,char*,int),\n"
+" void *arg,\n"
+" const char *format,\n"
+" va_list ap\n"
+"){\n"
+" register const char *fmt; /* The format string. */\n"
+" register int c; /* Next character in the format string */\n"
+" register char *bufpt; /* Pointer to the conversion buffer */\n"
+" register int precision; /* Precision of the current field */\n"
+" register int length; /* Length of the field */\n"
+" register int idx; /* A general purpose loop counter */\n"
+" int count; /* Total number of characters output */\n"
+" int width; /* Width of the current field */\n"
+" int flag_leftjustify; /* True if \"-\" flag is present */\n"
+" int flag_plussign; /* True if \"+\" flag is present */\n"
+" int flag_blanksign; /* True if \" \" flag is present */\n"
+" int flag_alternateform; /* True if \"#\" flag is present */\n"
+" int flag_zeropad; /* True if field width constant starts with zero */\n"
+" int flag_long; /* True if \"l\" flag is present */\n"
+" int flag_center; /* True if \"=\" flag is present */\n"
+" unsigned long longvalue; /* Value for integer types */\n"
+" double realvalue; /* Value for real types */\n"
+" et_info *infop; /* Pointer to the appropriate info structure */\n"
+" char buf[etBUFSIZE]; /* Conversion buffer */\n"
+" char prefix; /* Prefix character. \"+\" or \"-\" or \" \" or '\\0'. */\n"
+" int errorflag = 0; /* True if an error is encountered */\n"
+" enum et_type xtype; /* Conversion paradigm */\n"
+" char *zMem; /* String to be freed */\n"
+" char *zExtra; /* Extra memory used for etTCLESCAPE conversions */\n"
+" static char spaces[] = \" \"\n"
+" \" \";\n"
+"#define etSPACESIZE (sizeof(spaces)-1)\n"
+"#ifndef etNOFLOATINGPOINT\n"
+" int exp; /* exponent of real numbers */\n"
+" double rounder; /* Used for rounding floating point values */\n"
+" int flag_dp; /* True if decimal point should be shown */\n"
+" int flag_rtz; /* True if trailing zeros should be removed */\n"
+" int flag_exp; /* True to force display of the exponent */\n"
+" int nsd; /* Number of significant digits returned */\n"
+"#endif\n"
+"\n"
+" fmt = format; /* Put in a register for speed */\n"
+" count = length = 0;\n"
+" bufpt = 0;\n"
+" for(; (c=(*fmt))!=0; ++fmt){\n"
+" if( c!='%' ){\n"
+" register int amt;\n"
+" bufpt = (char *)fmt;\n"
+" amt = 1;\n"
+" while( (c=(*++fmt))!='%' && c!=0 ) amt++;\n"
+" (*func)(arg,bufpt,amt);\n"
+" count += amt;\n"
+" if( c==0 ) break;\n"
+" }\n"
+" if( (c=(*++fmt))==0 ){\n"
+" errorflag = 1;\n"
+" (*func)(arg,\"%\",1);\n"
+" count++;\n"
+" break;\n"
+" }\n"
+" /* Find out what flags are present */\n"
+" flag_leftjustify = flag_plussign = flag_blanksign = \n"
+" flag_alternateform = flag_zeropad = flag_center = 0;\n"
+" do{\n"
+" switch( c ){\n"
+" case '-': flag_leftjustify = 1; c = 0; break;\n"
+" case '+': flag_plussign = 1; c = 0; break;\n"
+" case ' ': flag_blanksign = 1; c = 0; break;\n"
+" case '#': flag_alternateform = 1; c = 0; break;\n"
+" case '0': flag_zeropad = 1; c = 0; break;\n"
+" case '=': flag_center = 1; c = 0; break;\n"
+" default: break;\n"
+" }\n"
+" }while( c==0 && (c=(*++fmt))!=0 );\n"
+" if( flag_center ) flag_leftjustify = 0;\n"
+" /* Get the field width */\n"
+" width = 0;\n"
+" if( c=='*' ){\n"
+" width = va_arg(ap,int);\n"
+" if( width<0 ){\n"
+" flag_leftjustify = 1;\n"
+" width = -width;\n"
+" }\n"
+" c = *++fmt;\n"
+" }else{\n"
+" while( isdigit(c) ){\n"
+" width = width*10 + c - '0';\n"
+" c = *++fmt;\n"
+" }\n"
+" }\n"
+" if( width > etBUFSIZE-10 ){\n"
+" width = etBUFSIZE-10;\n"
+" }\n"
+" /* Get the precision */\n"
+" if( c=='.' ){\n"
+" precision = 0;\n"
+" c = *++fmt;\n"
+" if( c=='*' ){\n"
+" precision = va_arg(ap,int);\n"
+"#ifndef etCOMPATIBILITY\n"
+" /* This is sensible, but SUN OS 4.1 doesn't do it. */\n"
+" if( precision<0 ) precision = -precision;\n"
+"#endif\n"
+" c = *++fmt;\n"
+" }else{\n"
+" while( isdigit(c) ){\n"
+" precision = precision*10 + c - '0';\n"
+" c = *++fmt;\n"
+" }\n"
+" }\n"
+" /* Limit the precision to prevent overflowing buf[] during conversion */\n"
+" if( precision>etBUFSIZE-40 ) precision = etBUFSIZE-40;\n"
+" }else{\n"
+" precision = -1;\n"
+" }\n"
+" /* Get the conversion type modifier */\n"
+" if( c=='l' ){\n"
+" flag_long = 1;\n"
+" c = *++fmt;\n"
+" }else{\n"
+" flag_long = 0;\n"
+" }\n"
+" /* Fetch the info entry for the field */\n"
+" infop = 0;\n"
+" for(idx=0; idx<etNINFO; idx++){\n"
+" if( c==fmtinfo[idx].fmttype ){\n"
+" infop = &fmtinfo[idx];\n"
+" break;\n"
+" }\n"
+" }\n"
+" /* No info entry found. It must be an error. */\n"
+" if( infop==0 ){\n"
+" xtype = etERROR;\n"
+" }else{\n"
+" xtype = infop->type;\n"
+" }\n"
+" zExtra = 0;\n"
+"\n"
+" /*\n"
+" ** At this point, variables are initialized as follows:\n"
+" **\n"
+" ** flag_alternateform TRUE if a '#' is present.\n"
+" ** flag_plussign TRUE if a '+' is present.\n"
+" ** flag_leftjustify TRUE if a '-' is present or if the\n"
+" ** field width was negative.\n"
+" ** flag_zeropad TRUE if the width began with 0.\n"
+" ** flag_long TRUE if the letter 'l' (ell) prefixed\n"
+" ** the conversion character.\n"
+" ** flag_blanksign TRUE if a ' ' is present.\n"
+" ** width The specified field width. This is\n"
+" ** always non-negative. Zero is the default.\n"
+" ** precision The specified precision. The default\n"
+" ** is -1.\n"
+" ** xtype The class of the conversion.\n"
+" ** infop Pointer to the appropriate info struct.\n"
+" */\n"
+" switch( xtype ){\n"
+" case etORDINAL:\n"
+" case etRADIX:\n"
+" if( flag_long ) longvalue = va_arg(ap,long);\n"
+" else longvalue = va_arg(ap,int);\n"
+"#ifdef etCOMPATIBILITY\n"
+" /* For the format %#x, the value zero is printed \"0\" not \"0x0\".\n"
+" ** I think this is stupid. */\n"
+" if( longvalue==0 ) flag_alternateform = 0;\n"
+"#else\n"
+" /* More sensible: turn off the prefix for octal (to prevent \"00\"),\n"
+" ** but leave the prefix for hex. */\n"
+" if( longvalue==0 && infop->base==8 ) flag_alternateform = 0;\n"
+"#endif\n"
+" if( infop->flag_signed ){\n"
+" if( *(long*)&longvalue<0 ){\n"
+" longvalue = -*(long*)&longvalue;\n"
+" prefix = '-';\n"
+" }else if( flag_plussign ) prefix = '+';\n"
+" else if( flag_blanksign ) prefix = ' ';\n"
+" else prefix = 0;\n"
+" }else prefix = 0;\n"
+" if( flag_zeropad && precision<width-(prefix!=0) ){\n"
+" precision = width-(prefix!=0);\n"
+" }\n"
+" bufpt = &buf[etBUFSIZE];\n"
+" if( xtype==etORDINAL ){\n"
+" long a,b;\n"
+" a = longvalue%10;\n"
+" b = longvalue%100;\n"
+" bufpt -= 2;\n"
+" if( a==0 || a>3 || (b>10 && b<14) ){\n"
+" bufpt[0] = 't';\n"
+" bufpt[1] = 'h';\n"
+" }else if( a==1 ){\n"
+" bufpt[0] = 's';\n"
+" bufpt[1] = 't';\n"
+" }else if( a==2 ){\n"
+" bufpt[0] = 'n';\n"
+" bufpt[1] = 'd';\n"
+" }else if( a==3 ){\n"
+" bufpt[0] = 'r';\n"
+" bufpt[1] = 'd';\n"
+" }\n"
+" }\n"
+" {\n"
+" register char *cset; /* Use registers for speed */\n"
+" register int base;\n"
+" cset = infop->charset;\n"
+" base = infop->base;\n"
+" do{ /* Convert to ascii */\n"
+" *(--bufpt) = cset[longvalue%base];\n"
+" longvalue = longvalue/base;\n"
+" }while( longvalue>0 );\n"
+" }\n"
+" length = (long)&buf[etBUFSIZE]-(long)bufpt;\n"
+" for(idx=precision-length; idx>0; idx--){\n"
+" *(--bufpt) = '0'; /* Zero pad */\n"
+" }\n"
+" if( prefix ) *(--bufpt) = prefix; /* Add sign */\n"
+" if( flag_alternateform && infop->prefix ){ /* Add \"0\" or \"0x\" */\n"
+" char *pre, x;\n"
+" pre = infop->prefix;\n"
+" if( *bufpt!=pre[0] ){\n"
+" for(pre=infop->prefix; (x=(*pre))!=0; pre++) *(--bufpt) = x;\n"
+" }\n"
+" }\n"
+" length = (long)&buf[etBUFSIZE]-(long)bufpt;\n"
+" break;\n"
+" case etFLOAT:\n"
+" case etEXP:\n"
+" case etGENERIC:\n"
+" realvalue = va_arg(ap,double);\n"
+"#ifndef etNOFLOATINGPOINT\n"
+" if( precision<0 ) precision = 6; /* Set default precision */\n"
+" if( precision>etBUFSIZE-10 ) precision = etBUFSIZE-10;\n"
+" if( realvalue<0.0 ){\n"
+" realvalue = -realvalue;\n"
+" prefix = '-';\n"
+" }else{\n"
+" if( flag_plussign ) prefix = '+';\n"
+" else if( flag_blanksign ) prefix = ' ';\n"
+" else prefix = 0;\n"
+" }\n"
+" if( infop->type==etGENERIC && precision>0 ) precision--;\n"
+" rounder = 0.0;\n"
+"#ifdef COMPATIBILITY\n"
+" /* Rounding works like BSD when the constant 0.4999 is used. Wierd! */\n"
+" for(idx=precision, rounder=0.4999; idx>0; idx--, rounder*=0.1);\n"
+"#else\n"
+" /* It makes more sense to use 0.5 */\n"
+" for(idx=precision, rounder=0.5; idx>0; idx--, rounder*=0.1);\n"
+"#endif\n"
+" if( infop->type==etFLOAT ) realvalue += rounder;\n"
+" /* Normalize realvalue to within 10.0 > realvalue >= 1.0 */\n"
+" exp = 0;\n"
+" if( realvalue>0.0 ){\n"
+" int k = 0;\n"
+" while( realvalue>=1e8 && k++<100 ){ realvalue *= 1e-8; exp+=8; }\n"
+" while( realvalue>=10.0 && k++<100 ){ realvalue *= 0.1; exp++; }\n"
+" while( realvalue<1e-8 && k++<100 ){ realvalue *= 1e8; exp-=8; }\n"
+" while( realvalue<1.0 && k++<100 ){ realvalue *= 10.0; exp--; }\n"
+" if( k>=100 ){\n"
+" bufpt = \"NaN\";\n"
+" length = 3;\n"
+" break;\n"
+" }\n"
+" }\n"
+" bufpt = buf;\n"
+" /*\n"
+" ** If the field type is etGENERIC, then convert to either etEXP\n"
+" ** or etFLOAT, as appropriate.\n"
+" */\n"
+" flag_exp = xtype==etEXP;\n"
+" if( xtype!=etFLOAT ){\n"
+" realvalue += rounder;\n"
+" if( realvalue>=10.0 ){ realvalue *= 0.1; exp++; }\n"
+" }\n"
+" if( xtype==etGENERIC ){\n"
+" flag_rtz = !flag_alternateform;\n"
+" if( exp<-4 || exp>precision ){\n"
+" xtype = etEXP;\n"
+" }else{\n"
+" precision = precision - exp;\n"
+" xtype = etFLOAT;\n"
+" }\n"
+" }else{\n"
+" flag_rtz = 0;\n"
+" }\n"
+" /*\n"
+" ** The \"exp+precision\" test causes output to be of type etEXP if\n"
+" ** the precision is too large to fit in buf[].\n"
+" */\n"
+" nsd = 0;\n"
+" if( xtype==etFLOAT && exp+precision<etBUFSIZE-30 ){\n"
+" flag_dp = (precision>0 || flag_alternateform);\n"
+" if( prefix ) *(bufpt++) = prefix; /* Sign */\n"
+" if( exp<0 ) *(bufpt++) = '0'; /* Digits before \".\" */\n"
+" else for(; exp>=0; exp--) *(bufpt++) = et_getdigit(&realvalue,&nsd);\n"
+" if( flag_dp ) *(bufpt++) = '.'; /* The decimal point */\n"
+" for(exp++; exp<0 && precision>0; precision--, exp++){\n"
+" *(bufpt++) = '0';\n"
+" }\n"
+" while( (precision--)>0 ) *(bufpt++) = et_getdigit(&realvalue,&nsd);\n"
+" *(bufpt--) = 0; /* Null terminate */\n"
+" if( flag_rtz && flag_dp ){ /* Remove trailing zeros and \".\" */\n"
+" while( bufpt>=buf && *bufpt=='0' ) *(bufpt--) = 0;\n"
+" if( bufpt>=buf && *bufpt=='.' ) *(bufpt--) = 0;\n"
+" }\n"
+" bufpt++; /* point to next free slot */\n"
+" }else{ /* etEXP or etGENERIC */\n"
+" flag_dp = (precision>0 || flag_alternateform);\n"
+" if( prefix ) *(bufpt++) = prefix; /* Sign */\n"
+" *(bufpt++) = et_getdigit(&realvalue,&nsd); /* First digit */\n"
+" if( flag_dp ) *(bufpt++) = '.'; /* Decimal point */\n"
+" while( (precision--)>0 ) *(bufpt++) = et_getdigit(&realvalue,&nsd);\n"
+" bufpt--; /* point to last digit */\n"
+" if( flag_rtz && flag_dp ){ /* Remove tail zeros */\n"
+" while( bufpt>=buf && *bufpt=='0' ) *(bufpt--) = 0;\n"
+" if( bufpt>=buf && *bufpt=='.' ) *(bufpt--) = 0;\n"
+" }\n"
+" bufpt++; /* point to next free slot */\n"
+" if( exp || flag_exp ){\n"
+" *(bufpt++) = infop->charset[0];\n"
+" if( exp<0 ){ *(bufpt++) = '-'; exp = -exp; } /* sign of exp */\n"
+" else { *(bufpt++) = '+'; }\n"
+" if( exp>=100 ){\n"
+" *(bufpt++) = (exp/100)+'0'; /* 100's digit */\n"
+" exp %= 100;\n"
+" }\n"
+" *(bufpt++) = exp/10+'0'; /* 10's digit */\n"
+" *(bufpt++) = exp%10+'0'; /* 1's digit */\n"
+" }\n"
+" }\n"
+" /* The converted number is in buf[] and zero terminated. Output it.\n"
+" ** Note that the number is in the usual order, not reversed as with\n"
+" ** integer conversions. */\n"
+" length = (long)bufpt-(long)buf;\n"
+" bufpt = buf;\n"
+"\n"
+" /* Special case: Add leading zeros if the flag_zeropad flag is\n"
+" ** set and we are not left justified */\n"
+" if( flag_zeropad && !flag_leftjustify && length < width){\n"
+" int i;\n"
+" int nPad = width - length;\n"
+" for(i=width; i>=nPad; i--){\n"
+" bufpt[i] = bufpt[i-nPad];\n"
+" }\n"
+" i = prefix!=0;\n"
+" while( nPad-- ) bufpt[i++] = '0';\n"
+" length = width;\n"
+" }\n"
+"#endif\n"
+" break;\n"
+" case etSIZE:\n"
+" *(va_arg(ap,int*)) = count;\n"
+" length = width = 0;\n"
+" break;\n"
+" case etPERCENT:\n"
+" buf[0] = '%';\n"
+" bufpt = buf;\n"
+" length = 1;\n"
+" break;\n"
+" case etCHARLIT:\n"
+" case etCHARX:\n"
+" c = buf[0] = (xtype==etCHARX ? va_arg(ap,int) : *++fmt);\n"
+" if( precision>=0 ){\n"
+" for(idx=1; idx<precision; idx++) buf[idx] = c;\n"
+" length = precision;\n"
+" }else{\n"
+" length =1;\n"
+" }\n"
+" bufpt = buf;\n"
+" break;\n"
+" case etSTRING:\n"
+" case etMEMSTRING:\n"
+" zMem = bufpt = va_arg(ap,char*);\n"
+" if( bufpt==0 ) bufpt = \"(null)\";\n"
+" length = strlen(bufpt);\n"
+" if( precision>=0 && precision<length ) length = precision;\n"
+" break;\n"
+" case etTCLESCAPE:\n"
+" {\n"
+" int i, j, n, c, k;\n"
+" char *arg = va_arg(ap,char*);\n"
+" if( arg==0 ) arg = \"(NULL)\";\n"
+" for(i=n=0; (c=arg[i])!=0; i++){\n"
+" k = NeedEsc[c&0xff];\n"
+" if( k==0 ){\n"
+" n++;\n"
+" }else if( k==1 ){\n"
+" n+=4;\n"
+" }else{\n"
+" n+=2;\n"
+" }\n"
+" }\n"
+" n++;\n"
+" if( n>etBUFSIZE ){\n"
+" bufpt = zExtra = Tcl_Alloc( n );\n"
+" }else{\n"
+" bufpt = buf;\n"
+" }\n"
+" for(i=j=0; (c=arg[i])!=0; i++){\n"
+" k = NeedEsc[c&0xff];\n"
+" if( k==0 ){\n"
+" bufpt[j++] = c;\n"
+" }else if( k==1 ){\n"
+" bufpt[j++] = '\\\\';\n"
+" bufpt[j++] = ((c>>6) & 3) + '0';\n"
+" bufpt[j++] = ((c>>3) & 7) + '0';\n"
+" bufpt[j++] = (c & 7) + '0';\n"
+" }else{\n"
+" bufpt[j++] = '\\\\';\n"
+" bufpt[j++] = k;\n"
+" }\n"
+" }\n"
+" bufpt[j] = 0;\n"
+" length = j;\n"
+" if( precision>=0 && precision<length ) length = precision;\n"
+" }\n"
+" break;\n"
+" case etERROR:\n"
+" buf[0] = '%';\n"
+" buf[1] = c;\n"
+" errorflag = 0;\n"
+" idx = 1+(c!=0);\n"
+" (*func)(arg,\"%\",idx);\n"
+" count += idx;\n"
+" if( c==0 ) fmt--;\n"
+" break;\n"
+" }/* End switch over the format type */\n"
+" /*\n"
+" ** The text of the conversion is pointed to by \"bufpt\" and is\n"
+" ** \"length\" characters long. The field width is \"width\". Do\n"
+" ** the output.\n"
+" */\n"
+" if( !flag_leftjustify ){\n"
+" register int nspace;\n"
+" nspace = width-length;\n"
+" if( nspace>0 ){\n"
+" if( flag_center ){\n"
+" nspace = nspace/2;\n"
+" width -= nspace;\n"
+" flag_leftjustify = 1;\n"
+" }\n"
+" count += nspace;\n"
+" while( nspace>=etSPACESIZE ){\n"
+" (*func)(arg,spaces,etSPACESIZE);\n"
+" nspace -= etSPACESIZE;\n"
+" }\n"
+" if( nspace>0 ) (*func)(arg,spaces,nspace);\n"
+" }\n"
+" }\n"
+" if( length>0 ){\n"
+" (*func)(arg,bufpt,length);\n"
+" count += length;\n"
+" }\n"
+" if( xtype==etMEMSTRING && zMem ){\n"
+" Tcl_Free(zMem);\n"
+" }\n"
+" if( flag_leftjustify ){\n"
+" register int nspace;\n"
+" nspace = width-length;\n"
+" if( nspace>0 ){\n"
+" count += nspace;\n"
+" while( nspace>=etSPACESIZE ){\n"
+" (*func)(arg,spaces,etSPACESIZE);\n"
+" nspace -= etSPACESIZE;\n"
+" }\n"
+" if( nspace>0 ) (*func)(arg,spaces,nspace);\n"
+" }\n"
+" }\n"
+" if( zExtra ){\n"
+" Tcl_Free(zExtra);\n"
+" }\n"
+" }/* End for loop over the format string */\n"
+" return errorflag ? -1 : count;\n"
+"} /* End of function */\n"
+"\n"
+"/*\n"
+"** The following section of code handles the mprintf routine, that\n"
+"** writes to memory obtained from malloc().\n"
+"*/\n"
+"\n"
+"/* This structure is used to store state information about the\n"
+"** write to memory that is currently in progress.\n"
+"*/\n"
+"struct sgMprintf {\n"
+" char *zBase; /* A base allocation */\n"
+" char *zText; /* The string collected so far */\n"
+" int nChar; /* Length of the string so far */\n"
+" int nAlloc; /* Amount of space allocated in zText */\n"
+"};\n"
+"\n"
+"/* \n"
+"** The xprintf callback function. \n"
+"**\n"
+"** This routine add nNewChar characters of text in zNewText to\n"
+"** the sgMprintf structure pointed to by \"arg\".\n"
+"*/\n"
+"static void mout(void *arg, char *zNewText, int nNewChar){\n"
+" struct sgMprintf *pM = (struct sgMprintf*)arg;\n"
+" if( pM->nChar + nNewChar + 1 > pM->nAlloc ){\n"
+" pM->nAlloc = pM->nChar + nNewChar*2 + 1;\n"
+" if( pM->zText==pM->zBase ){\n"
+" pM->zText = Tcl_Alloc(pM->nAlloc);\n"
+" if( pM->zText && pM->nChar ) memcpy(pM->zText,pM->zBase,pM->nChar);\n"
+" }else{\n"
+" pM->zText = Tcl_Realloc(pM->zText, pM->nAlloc);\n"
+" }\n"
+" }\n"
+" if( pM->zText ){\n"
+" memcpy(&pM->zText[pM->nChar], zNewText, nNewChar);\n"
+" pM->nChar += nNewChar;\n"
+" pM->zText[pM->nChar] = 0;\n"
+" }\n"
+"}\n"
+"\n"
+"/*\n"
+"** mprintf() works like printf(), but allocations memory to hold the\n"
+"** resulting string and returns a pointer to the allocated memory.\n"
+"*/\n"
+"char *mprintf(const char *zFormat, ...){\n"
+" va_list ap;\n"
+" struct sgMprintf sMprintf;\n"
+" char *zNew;\n"
+" char zBuf[200];\n"
+"\n"
+" sMprintf.nChar = 0;\n"
+" sMprintf.nAlloc = sizeof(zBuf);\n"
+" sMprintf.zText = zBuf;\n"
+" sMprintf.zBase = zBuf;\n"
+" va_start(ap,zFormat);\n"
+" vxprintf(mout,&sMprintf,zFormat,ap);\n"
+" va_end(ap);\n"
+" sMprintf.zText[sMprintf.nChar] = 0;\n"
+" if( sMprintf.zText==sMprintf.zBase ){\n"
+" zNew = Tcl_Alloc( sMprintf.nChar+1 );\n"
+" if( zNew ) strcpy(zNew,zBuf);\n"
+" }else{\n"
+" zNew = Tcl_Realloc(sMprintf.zText,sMprintf.nChar+1);\n"
+" }\n"
+" return zNew;\n"
+"}\n"
+"\n"
+"/* This is the varargs version of mprintf. \n"
+"*/\n"
+"char *vmprintf(const char *zFormat, va_list ap){\n"
+" struct sgMprintf sMprintf;\n"
+" char zBuf[200];\n"
+" sMprintf.nChar = 0;\n"
+" sMprintf.zText = zBuf;\n"
+" sMprintf.nAlloc = sizeof(zBuf);\n"
+" sMprintf.zBase = zBuf;\n"
+" vxprintf(mout,&sMprintf,zFormat,ap);\n"
+" sMprintf.zText[sMprintf.nChar] = 0;\n"
+" if( sMprintf.zText==sMprintf.zBase ){\n"
+" sMprintf.zText = Tcl_Alloc( strlen(zBuf)+1 );\n"
+" if( sMprintf.zText ) strcpy(sMprintf.zText,zBuf);\n"
+" }else{\n"
+" sMprintf.zText = Tcl_Realloc(sMprintf.zText,sMprintf.nChar+1);\n"
+" }\n"
+" return sMprintf.zText;\n"
+"}\n"
+"\n"
+"/*\n"
+"** Add text output to a Tcl_DString.\n"
+"**\n"
+"** This routine is called by vxprintf(). It's job is to add\n"
+"** nNewChar characters of text from zNewText to the Tcl_DString\n"
+"** that \"arg\" is pointing to.\n"
+"*/\n"
+"static void dstringout(void *arg, char *zNewText, int nNewChar){\n"
+" Tcl_DString *str = (Tcl_DString*)arg;\n"
+" Tcl_DStringAppend(str,zNewText,nNewChar);\n"
+"}\n"
+"\n"
+"/*\n"
+"** Append formatted output to a DString.\n"
+"*/\n"
+"char *Et_DStringAppendF(Tcl_DString *str, const char *zFormat, ...){\n"
+" va_list ap;\n"
+" va_start(ap,zFormat);\n"
+" vxprintf(dstringout,str,zFormat,ap);\n"
+" va_end(ap);\n"
+" return Tcl_DStringValue(str);\n"
+"}\n"
+"\n"
+"/*\n"
+"** Make this variable true to trace all calls to EvalF\n"
+"*/\n"
+"int Et_EvalTrace = 0;\n"
+"\n"
+"/*\n"
+"** Eval the results of a string.\n"
+"*/\n"
+"int Et_EvalF(Tcl_Interp *interp, const char *zFormat, ...){\n"
+" char *zCmd;\n"
+" va_list ap;\n"
+" int result;\n"
+" va_start(ap,zFormat);\n"
+" zCmd = vmprintf(zFormat,ap);\n"
+" if( Et_EvalTrace ) printf(\"%s\\n\",zCmd);\n"
+" result = Tcl_Eval(interp,zCmd);\n"
+" if( Et_EvalTrace ) printf(\"%d %s\\n\",result,interp->result);\n"
+" Tcl_Free(zCmd);\n"
+" return result;\n"
+"}\n"
+"int Et_GlobalEvalF(Tcl_Interp *interp, const char *zFormat, ...){\n"
+" char *zCmd;\n"
+" va_list ap;\n"
+" int result;\n"
+" va_start(ap,zFormat);\n"
+" zCmd = vmprintf(zFormat,ap);\n"
+" if( Et_EvalTrace ) printf(\"%s\\n\",zCmd);\n"
+" result = Tcl_GlobalEval(interp,zCmd);\n"
+" if( Et_EvalTrace ) printf(\"%d %s\\n\",result,interp->result);\n"
+" Tcl_Free(zCmd);\n"
+" return result;\n"
+"}\n"
+"\n"
+"/*\n"
+"** Set the result of an interpreter using printf-like arguments.\n"
+"*/\n"
+"void Et_ResultF(Tcl_Interp *interp, const char *zFormat, ...){\n"
+" Tcl_DString str;\n"
+" va_list ap;\n"
+"\n"
+" Tcl_DStringInit(&str);\n"
+" va_start(ap,zFormat);\n"
+" vxprintf(dstringout,&str,zFormat,ap);\n"
+" va_end(ap);\n"
+" Tcl_DStringResult(interp,&str); \n"
+"}\n"
+"\n"
+"#if ET_HAVE_OBJ\n"
+"/*\n"
+"** Append text to a string object.\n"
+"*/\n"
+"int Et_AppendObjF(Tcl_Obj *pObj, const char *zFormat, ...){\n"
+" va_list ap;\n"
+" int rc;\n"
+"\n"
+" va_start(ap,zFormat);\n"
+" rc = vxprintf((void(*)(void*,char*,int))Tcl_AppendToObj, pObj, zFormat, ap);\n"
+" va_end(ap);\n"
+" return rc;\n"
+"}\n"
+"#endif\n"
+"\n"
+"\n"
+"#if ET_WIN32\n"
+"/*\n"
+"** This array translates all characters into themselves. Except\n"
+"** for the \\ which gets translated into /. And all upper-case\n"
+"** characters are translated into lower case. This is used for\n"
+"** hashing and comparing filenames, to work around the Windows\n"
+"** but of ignoring filename case and using the wrong separator\n"
+"** character for directories.\n"
+"**\n"
+"** The array is initialized by FilenameHashInit().\n"
+"**\n"
+"** We also define a macro ET_TRANS() that actually does\n"
+"** the character translation. ET_TRANS() is a no-op under\n"
+"** unix.\n"
+"*/\n"
+"static char charTrans[256];\n"
+"#define ET_TRANS(X) (charTrans[0xff&(int)(X)])\n"
+"#else\n"
+"#define ET_TRANS(X) (X)\n"
+"#endif\n"
+"\n"
+"/*\n"
+"** Hash a filename. The value returned is appropriate for\n"
+"** indexing into the Et_FileHashTable[] array.\n"
+"*/\n"
+"static int FilenameHash(char *zName){\n"
+" int h = 0;\n"
+" while( *zName ){\n"
+" h = h ^ (h<<5) ^ ET_TRANS(*(zName++));\n"
+" }\n"
+" if( h<0 ) h = -h;\n"
+" return h % (sizeof(Et_FileHashTable)/sizeof(Et_FileHashTable[0]));\n"
+"}\n"
+"\n"
+"/*\n"
+"** Compare two filenames. Return 0 if they are the same and\n"
+"** non-zero if they are different.\n"
+"*/\n"
+"static int FilenameCmp(char *z1, char *z2){\n"
+" int diff;\n"
+" while( (diff = ET_TRANS(*z1)-ET_TRANS(*z2))==0 && *z1!=0){\n"
+" z1++;\n"
+" z2++;\n"
+" }\n"
+" return diff;\n"
+"}\n"
+"\n"
+"/*\n"
+"** Initialize the file hash table\n"
+"*/\n"
+"static void FilenameHashInit(void){\n"
+" int i;\n"
+"#if ET_WIN32\n"
+" for(i=0; i<sizeof(charTrans); i++){\n"
+" charTrans[i] = i;\n"
+" }\n"
+" for(i='A'; i<='Z'; i++){\n"
+" charTrans[i] = i + 'a' - 'A';\n"
+" }\n"
+" charTrans['\\\\'] = '/';\n"
+"#endif\n"
+" for(i=0; i<sizeof(Et_FileSet)/sizeof(Et_FileSet[0]) - 1; i++){\n"
+" struct EtFile *p;\n"
+" int h;\n"
+" p = &Et_FileSet[i];\n"
+" h = FilenameHash(p->zName);\n"
+" p->pNext = Et_FileHashTable[h];\n"
+" Et_FileHashTable[h] = p;\n"
+" }\n"
+"}\n"
+"\n"
+"/*\n"
+"** Locate the text of a built-in file given its name. \n"
+"** Return 0 if not found. Return this size of the file (not\n"
+"** counting the null-terminator in *pSize if pSize!=NULL.\n"
+"**\n"
+"** If deshroud==1 and the file is shrouded, then descramble\n"
+"** the text.\n"
+"*/\n"
+"static char *FindBuiltinFile(char *zName, int deshroud, int *pSize){\n"
+" int h;\n"
+" struct EtFile *p;\n"
+"\n"
+" h = FilenameHash(zName);\n"
+" p = Et_FileHashTable[h];\n"
+" while( p && FilenameCmp(p->zName,zName)!=0 ){ p = p->pNext; }\n"
+"#if ET_SHROUD_KEY>0\n"
+" if( p && p->shrouded && deshroud ){\n"
+" char *z;\n"
+" int xor = ET_SHROUD_KEY;\n"
+" for(z=p->zData; *z; z++){\n"
+" if( *z>=0x20 ){ *z ^= xor; xor = (xor+1)&0x1f; }\n"
+" }\n"
+" p->shrouded = 0;\n"
+" }\n"
+"#endif\n"
+" if( p && pSize ){\n"
+" *pSize = p->nData;\n"
+" }\n"
+" return p ? p->zData : 0;\n"
+"}\n"
+"\n"
+"/*\n"
+"** Add a new file to the list of built-in files.\n"
+"**\n"
+"** This routine makes a copy of zFilename. But it does NOT make\n"
+"** a copy of zData. It just holds a pointer to zData and uses\n"
+"** that for all file access. So after calling this routine,\n"
+"** you should never change zData!\n"
+"*/\n"
+"void Et_NewBuiltinFile(\n"
+" char *zFilename, /* Name of the new file */\n"
+" char *zData, /* Data for the new file */\n"
+" int nData /* Number of bytes in the new file */\n"
+"){\n"
+" int h;\n"
+" struct EtFile *p;\n"
+"\n"
+" p = (struct EtFile*)Tcl_Alloc( sizeof(struct EtFile) + strlen(zFilename) + 1);\n"
+" if( p==0 ) return;\n"
+" p->zName = (char*)&p[1];\n"
+" strcpy(p->zName, zFilename);\n"
+" p->zData = zData;\n"
+" p->nData = nData;\n"
+" p->shrouded = 0;\n"
+" h = FilenameHash(zFilename);\n"
+" p->pNext = Et_FileHashTable[h];\n"
+" Et_FileHashTable[h] = p;\n"
+"}\n"
+"\n"
+"/*\n"
+"** A TCL interface to the Et_NewBuiltinFile function. For Tcl8.0\n"
+"** and later, we make this an Obj command so that it can deal with\n"
+"** binary data.\n"
+"*/\n"
+"#if ET_HAVE_OBJ\n"
+"static int Et_NewBuiltinFileCmd(ET_OBJARGS){\n"
+" char *zData, *zNew;\n"
+" int nData;\n"
+" if( objc!=3 ){\n"
+" Tcl_WrongNumArgs(interp, 1, objv, \"filename data\");\n"
+" return TCL_ERROR;\n"
+" }\n"
+" zData = Tcl_GetByteArrayFromObj(objv[2], &nData);\n"
+" zNew = Tcl_Alloc( nData );\n"
+" if( zNew ){\n"
+" memcpy(zNew, zData, nData);\n"
+" Et_NewBuiltinFile(Tcl_GetByteArrayFromObj(objv[1], 0), zNew, nData);\n"
+" }\n"
+" return TCL_OK;\n"
+"}\n"
+"#else\n"
+"static int Et_NewBuiltinFileCmd(ET_TCLARGS){\n"
+" char *zData;\n"
+" int nData;\n"
+" if( argc!=3 ){\n"
+" Et_ResultF(interp,\"wrong # args: should be \\\"%s FILENAME DATA\\\"\", argv[0]);\n"
+" return TCL_ERROR;\n"
+" }\n"
+" nData = strlen(argv[2]) + 1;\n"
+" zData = Tcl_Alloc( nData );\n"
+" if( zData ){\n"
+" strcpy(zData, argv[2]);\n"
+" Et_NewBuiltinFile(argv[1], zData, nData);\n"
+" }\n"
+" return TCL_OK;\n"
+"}\n"
+"#endif\n"
+"\n"
+"/*\n"
+"** The following section implements the InsertProc functionality. The\n"
+"** new InsertProc feature of Tcl8.0.3 and later allows us to overload\n"
+"** the usual system call commands for file I/O and replace them with\n"
+"** commands that operate on the built-in files.\n"
+"*/\n"
+"#ifdef ET_HAVE_INSERTPROC\n"
+"\n"
+"/* \n"
+"** Each open channel to a built-in file is an instance of the\n"
+"** following structure.\n"
+"*/\n"
+"typedef struct Et_FileStruct {\n"
+" char *zData; /* All of the data */\n"
+" int nData; /* Bytes of data, not counting the null terminator */\n"
+" int cursor; /* How much of the data has been read so far */\n"
+"} Et_FileStruct;\n"
+"\n"
+"/*\n"
+"** Close a previously opened built-in file.\n"
+"*/\n"
+"static int Et_FileClose(ClientData instanceData, Tcl_Interp *interp){\n"
+" Et_FileStruct *p = (Et_FileStruct*)instanceData;\n"
+" Tcl_Free((char*)p);\n"
+" return 0;\n"
+"}\n"
+"\n"
+"/*\n"
+"** Read from a built-in file.\n"
+"*/\n"
+"static int Et_FileInput(\n"
+" ClientData instanceData, /* The file structure */\n"
+" char *buf, /* Write the data read here */\n"
+" int bufSize, /* Read this much data */\n"
+" int *pErrorCode /* Write the error code here */\n"
+"){\n"
+" Et_FileStruct *p = (Et_FileStruct*)instanceData;\n"
+" *pErrorCode = 0;\n"
+" if( p->cursor+bufSize>p->nData ){\n"
+" bufSize = p->nData - p->cursor;\n"
+" }\n"
+" memcpy(buf, &p->zData[p->cursor], bufSize);\n"
+" p->cursor += bufSize;\n"
+" return bufSize;\n"
+"}\n"
+"\n"
+"/*\n"
+"** Writes to a built-in file always return EOF.\n"
+"*/\n"
+"static int Et_FileOutput(\n"
+" ClientData instanceData, /* The file structure */\n"
+" char *buf, /* Read the data from here */\n"
+" int toWrite, /* Write this much data */\n"
+" int *pErrorCode /* Write the error code here */\n"
+"){\n"
+" *pErrorCode = 0;\n"
+" return 0;\n"
+"}\n"
+"\n"
+"/*\n"
+"** Move the cursor around within the built-in file.\n"
+"*/\n"
+"static int Et_FileSeek(\n"
+" ClientData instanceData, /* The file structure */\n"
+" long offset, /* Offset to seek to */\n"
+" int mode, /* One of SEEK_CUR, SEEK_SET or SEEK_END */\n"
+" int *pErrorCode /* Write the error code here */\n"
+"){\n"
+" Et_FileStruct *p = (Et_FileStruct*)instanceData;\n"
+" switch( mode ){\n"
+" case SEEK_CUR: offset += p->cursor; break;\n"
+" case SEEK_END: offset += p->nData; break;\n"
+" default: break;\n"
+" }\n"
+" if( offset<0 ) offset = 0;\n"
+" if( offset>p->nData ) offset = p->nData;\n"
+" p->cursor = offset;\n"
+" return offset;\n"
+"}\n"
+"\n"
+"/*\n"
+"** The Watch method is a no-op\n"
+"*/\n"
+"static void Et_FileWatch(ClientData instanceData, int mask){\n"
+"}\n"
+"\n"
+"/*\n"
+"** The Handle method always returns an error.\n"
+"*/\n"
+"static int Et_FileHandle(ClientData notUsed, int dir, ClientData *handlePtr){\n"
+" return TCL_ERROR;\n"
+"}\n"
+"\n"
+"/*\n"
+"** This is the channel type that will access the built-in files.\n"
+"*/\n"
+"static Tcl_ChannelType builtinChannelType = {\n"
+" \"builtin\", /* Type name. */\n"
+" NULL, /* Always non-blocking.*/\n"
+" Et_FileClose, /* Close proc. */\n"
+" Et_FileInput, /* Input proc. */\n"
+" Et_FileOutput, /* Output proc. */\n"
+" Et_FileSeek, /* Seek proc. */\n"
+" NULL, /* Set option proc. */\n"
+" NULL, /* Get option proc. */\n"
+" Et_FileWatch, /* Watch for events on console. */\n"
+" Et_FileHandle, /* Get a handle from the device. */\n"
+"};\n"
+"\n"
+"/*\n"
+"** This routine attempts to do an open of a built-in file.\n"
+"*/\n"
+"static Tcl_Channel Et_FileOpen(\n"
+" Tcl_Interp *interp, /* The TCL interpreter doing the open */\n"
+" char *zFilename, /* Name of the file to open */\n"
+" char *modeString, /* Mode string for the open (ignored) */\n"
+" int permissions /* Permissions for a newly created file (ignored) */\n"
+"){\n"
+" char *zData;\n"
+" Et_FileStruct *p;\n"
+" int nData;\n"
+" char zName[50];\n"
+" Tcl_Channel chan;\n"
+"\n"
+" zData = FindBuiltinFile(zFilename, 1, &nData);\n"
+" if( zData==0 ) return NULL;\n"
+" p = (Et_FileStruct*)Tcl_Alloc( sizeof(Et_FileStruct) );\n"
+" if( p==0 ) return NULL;\n"
+" p->zData = zData;\n"
+" p->nData = nData;\n"
+" p->cursor = 0;\n"
+" sprintf(zName,\"builtin%08x\",(unsigned int)zData);\n"
+" chan = Tcl_CreateChannel(&builtinChannelType, zName, \n"
+" (ClientData)p, TCL_READABLE);\n"
+" return chan;\n"
+"}\n"
+"\n"
+"/*\n"
+"** This routine does a stat() system call for a built-in file.\n"
+"*/\n"
+"static int Et_FileStat(char *path, struct stat *buf){\n"
+" char *zData;\n"
+" int nData;\n"
+"\n"
+" zData = FindBuiltinFile(path, 0, &nData);\n"
+" if( zData==0 ){\n"
+" return -1;\n"
+" }\n"
+" memset(buf, 0, sizeof(*buf));\n"
+" buf->st_mode = 0400;\n"
+" buf->st_size = nData;\n"
+" return 0;\n"
+"}\n"
+"\n"
+"/*\n"
+"** This routien does an access() system call for a built-in file.\n"
+"*/\n"
+"static int Et_FileAccess(char *path, int mode){\n"
+" char *zData;\n"
+"\n"
+" if( mode & 3 ){\n"
+" return -1;\n"
+" }\n"
+" zData = FindBuiltinFile(path, 0, 0);\n"
+" if( zData==0 ){\n"
+" return -1;\n"
+" }\n"
+" return 0; \n"
+"}\n"
+"#endif /* ET_HAVE_INSERTPROC */\n"
+"\n"
+"/*\n"
+"** An overloaded version of \"source\". First check for the file\n"
+"** is one of the built-ins. If it isn't a built-in, then check the\n"
+"** disk. But if ET_STANDALONE is set (which corresponds to the\n"
+"** \"Strict\" option in the user interface) then never check the disk.\n"
+"** This gives us a quick way to check for the common error of\n"
+"** sourcing a file that exists on the development by mistake, \n"
+"** and only discovering the mistake when you move the program\n"
+"** to your customer's machine.\n"
+"*/\n"
+"static int Et_Source(ET_TCLARGS){\n"
+" char *z;\n"
+"\n"
+" if( argc!=2 ){\n"
+" Et_ResultF(interp,\"wrong # args: should be \\\"%s FILENAME\\\"\", argv[0]);\n"
+" return TCL_ERROR;\n"
+" }\n"
+" z = FindBuiltinFile(argv[1], 1, 0);\n"
+" if( z ){\n"
+" int rc;\n"
+" rc = Tcl_Eval(interp,z);\n"
+" if (rc == TCL_ERROR) {\n"
+" char msg[200];\n"
+" sprintf(msg, \"\\n (file \\\"%.150s\\\" line %d)\", argv[1],\n"
+" interp->errorLine);\n"
+" Tcl_AddErrorInfo(interp, msg);\n"
+" } else {\n"
+" rc = TCL_OK;\n"
+" }\n"
+" return rc;\n"
+" }\n"
+"#if ET_STANDALONE\n"
+" Et_ResultF(interp,\"no such file: \\\"%s\\\"\", argv[1]);\n"
+" return TCL_ERROR;\n"
+"#else\n"
+" return Tcl_EvalFile(interp,argv[1]);\n"
+"#endif\n"
+"}\n"
+"\n"
+"#ifndef ET_HAVE_INSERTPROC\n"
+"/*\n"
+"** An overloaded version of \"file exists\". First check for the file\n"
+"** in the file table, then go to disk.\n"
+"**\n"
+"** We only overload \"file exists\" if we don't have InsertProc() \n"
+"** procedures. If we do have InsertProc() procedures, they will\n"
+"** handle this more efficiently.\n"
+"*/\n"
+"static int Et_FileExists(ET_TCLARGS){\n"
+" int i, rc;\n"
+" Tcl_DString str;\n"
+" if( argc==3 && strncmp(argv[1],\"exis\",4)==0 ){\n"
+" if( FindBuiltinFile(argv[2], 0, 0)!=0 ){\n"
+" interp->result = \"1\";\n"
+" return TCL_OK;\n"
+" }\n"
+" }\n"
+" Tcl_DStringInit(&str);\n"
+" Tcl_DStringAppendElement(&str,\"Et_FileCmd\");\n"
+" for(i=1; i<argc; i++){\n"
+" Tcl_DStringAppendElement(&str, argv[i]);\n"
+" }\n"
+" rc = Tcl_Eval(interp, Tcl_DStringValue(&str));\n"
+" Tcl_DStringFree(&str);\n"
+" return rc;\n"
+"}\n"
+"#endif\n"
+"\n"
+"/*\n"
+"** This is the main Tcl interpreter. It's a global variable so it\n"
+"** can be accessed easily from C code.\n"
+"*/\n"
+"Tcl_Interp *Et_Interp = 0;\n"
+"\n"
+"\n"
+"#if ET_WIN32\n"
+"/*\n"
+"** Implement the Et_MessageBox command on Windows platforms. We\n"
+"** use the MessageBox() function from the Win32 API so that the\n"
+"** error message will be displayed as a dialog box. Writing to\n"
+"** standard error doesn't do anything on windows.\n"
+"*/\n"
+"int Et_MessageBox(ET_TCLARGS){\n"
+" char *zMsg = \"(Empty Message)\";\n"
+" char *zTitle = \"Message...\";\n"
+"\n"
+" if( argc>1 ){\n"
+" zTitle = argv[1];\n"
+" }\n"
+" if( argc>2 ){\n"
+" zMsg = argv[2];\n"
+" }\n"
+" MessageBox(0, zMsg, zTitle, MB_ICONSTOP | MB_OK);\n"
+" return TCL_OK;\n"
+"}\n"
+"#endif\n"
+"\n"
+"/*\n"
+"** A default implementation for \"bgerror\"\n"
+"*/\n"
+"static char zBgerror[] = \n"
+" \"proc Et_Bgerror err {\\n\"\n"
+" \" global errorInfo tk_library\\n\"\n"
+" \" if {[info exists errorInfo]} {\\n\"\n"
+" \" set ei $errorInfo\\n\"\n"
+" \" } else {\\n\"\n"
+" \" set ei {}\\n\"\n"
+" \" }\\n\"\n"
+" \" if {[catch {bgerror $err}]==0} return\\n\"\n"
+" \" if {[string length $ei]>0} {\\n\"\n"
+" \" set err $ei\\n\"\n"
+" \" }\\n\"\n"
+" \" if {[catch {Et_MessageBox {Error} $err}]} {\\n\"\n"
+" \" puts stderr $err\\n\"\n"
+" \" }\\n\"\n"
+" \" exit\\n\"\n"
+" \"}\\n\"\n"
+";\n"
+"\n"
+"/*\n"
+"** Do the initialization.\n"
+"**\n"
+"** This routine is called after the interpreter is created, but\n"
+"** before Et_PreInit() or Et_AppInit() have been run.\n"
+"*/\n"
+"static int Et_DoInit(Tcl_Interp *interp){\n"
+" int i;\n"
+" extern int Et_PreInit(Tcl_Interp*);\n"
+" extern int Et_AppInit(Tcl_Interp*);\n"
+"\n"
+" /* Insert our alternative stat(), access() and open() procedures\n"
+" ** so that any attempt to work with a file will check our built-in\n"
+" ** scripts first.\n"
+" */\n"
+"#ifdef ET_HAVE_INSERTPROC\n"
+" extern int TclStatInsertProc(int (*)(char*, struct stat *));\n"
+" extern int TclAccessInsertProc(int (*)(char*, int));\n"
+" extern int TclOpenFileChannelInsertProc(Tcl_Channel (*)(Tcl_Interp*,char*,\n"
+" char*,int));\n"
+" TclStatInsertProc(Et_FileStat);\n"
+" TclAccessInsertProc(Et_FileAccess);\n"
+" TclOpenFileChannelInsertProc(Et_FileOpen);\n"
+"#endif\n"
+"\n"
+" /* Initialize the hash-table for built-in scripts\n"
+" */\n"
+" FilenameHashInit();\n"
+"\n"
+" /* The Et_NewBuiltFile command is inserted for use by FreeWrap\n"
+" ** and similar tools.\n"
+" */\n"
+"#if ET_HAVE_OBJ\n"
+" Tcl_CreateObjCommand(interp,\"Et_NewBuiltinFile\",Et_NewBuiltinFileCmd,0,0);\n"
+"#else\n"
+" Tcl_CreateCommand(interp,\"Et_NewBuiltinFile\",Et_NewBuiltinFileCmd,0,0);\n"
+"#endif\n"
+"\n"
+" /* Overload the \"file\" and \"source\" commands\n"
+" */\n"
+"#ifndef ET_HAVE_INSERTPROC\n"
+" {\n"
+" static char zRename[] = \"rename file Et_FileCmd\";\n"
+" Tcl_Eval(interp,zRename);\n"
+" Tcl_CreateCommand(interp,\"file\",Et_FileExists,0,0);\n"
+" }\n"
+"#endif\n"
+" Tcl_CreateCommand(interp,\"source\",Et_Source,0,0);\n"
+"\n"
+" Et_Interp = interp;\n"
+"#ifdef ET_TCL_LIBRARY\n"
+" Tcl_SetVar(interp,\"tcl_library\",ET_TCL_LIBRARY,TCL_GLOBAL_ONLY);\n"
+" Tcl_SetVar(interp,\"tcl_libPath\",ET_TCL_LIBRARY,TCL_GLOBAL_ONLY);\n"
+" Tcl_SetVar2(interp,\"env\",\"TCL_LIBRARY\",ET_TCL_LIBRARY,TCL_GLOBAL_ONLY);\n"
+"#endif\n"
+"#ifdef ET_TK_LIBRARY\n"
+" Tcl_SetVar(interp,\"tk_library\",ET_TK_LIBRARY,TCL_GLOBAL_ONLY);\n"
+" Tcl_SetVar2(interp,\"env\",\"TK_LIBRARY\",ET_TK_LIBRARY,TCL_GLOBAL_ONLY);\n"
+"#endif\n"
+"#if ET_WIN32\n"
+" Tcl_CreateCommand(interp,\"Et_MessageBox\",Et_MessageBox, 0, 0);\n"
+"#endif \n"
+" Tcl_Eval(interp,zBgerror);\n"
+"#if ET_HAVE_PREINIT\n"
+" if( Et_PreInit(interp) == TCL_ERROR ){\n"
+" goto initerr;\n"
+" }\n"
+"#endif\n"
+" if( Tcl_Init(interp) == TCL_ERROR ){\n"
+" goto initerr;\n"
+" }\n"
+" Et_GlobalEvalF(interp,\"set dir $tcl_library;source $dir/tclIndex;unset dir\");\n"
+"#if ET_ENABLE_TK\n"
+" if( Tk_Init(interp) == TCL_ERROR ){\n"
+" goto initerr;\n"
+" }\n"
+" Tcl_StaticPackage(interp,\"Tk\", Tk_Init, 0);\n"
+" Et_GlobalEvalF(interp,\"set dir $tk_library;source $dir/tclIndex;unset dir\");\n"
+"#endif\n"
+" /* Tcl_SetVar(interp, \"tcl_rcFileName\", \"~/.wishrc\", TCL_GLOBAL_ONLY); */\n"
+" for(i=0; i<sizeof(Et_CmdSet)/sizeof(Et_CmdSet[0]) - 1; i++){\n"
+" Tcl_CreateCommand(interp, Et_CmdSet[i].zName, Et_CmdSet[i].xProc, 0, 0);\n"
+" }\n"
+"#if ET_ENABLE_OBJ\n"
+" for(i=0; i<sizeof(Et_ObjSet)/sizeof(Et_ObjSet[0]) - 1; i++){\n"
+" Tcl_CreateObjCommand(interp, Et_ObjSet[i].zName, Et_ObjSet[i].xProc, 0, 0);\n"
+" }\n"
+"#endif\n"
+" Tcl_LinkVar(interp,\"Et_EvalTrace\",(char*)&Et_EvalTrace,TCL_LINK_BOOLEAN);\n"
+"#if ET_HAVE_APPINIT\n"
+" if( Et_AppInit(interp) == TCL_ERROR ){\n"
+" goto initerr;\n"
+" }\n"
+"#endif\n"
+"#if ET_CONSOLE\n"
+" Tcl_Eval(interp,zEtConsole);\n"
+"#endif\n"
+"#ifdef ET_MAIN_SCRIPT\n"
+" if( Et_EvalF(interp,\"source \\\"%q\\\"\", ET_MAIN_SCRIPT)!=TCL_OK ){\n"
+" goto initerr;\n"
+" }\n"
+"#endif\n"
+" return TCL_OK;\n"
+"\n"
+"initerr:\n"
+" Et_EvalF(interp,\"Et_Bgerror \\\"%q\\\"\", interp->result);\n"
+" return TCL_ERROR;\n"
+"}\n"
+"\n"
+"\n"
+"#if ET_READ_STDIN==0 || ET_AUTO_FORK!=0\n"
+"/*\n"
+"** Initialize everything.\n"
+"*/\n"
+"static int Et_Local_Init(int argc, char **argv){\n"
+" Tcl_Interp *interp;\n"
+" char *args;\n"
+" char buf[100];\n"
+" static char zWaitForever[] = \"while 1 {vwait forever}\";\n"
+"\n"
+" Tcl_FindExecutable(argv[0]);\n"
+" interp = Tcl_CreateInterp();\n"
+" args = Tcl_Merge(argc-1, argv+1);\n"
+" Tcl_SetVar(interp, \"argv\", args, TCL_GLOBAL_ONLY);\n"
+" ckfree(args);\n"
+" sprintf(buf, \"%d\", argc-1);\n"
+" Tcl_SetVar(interp, \"argc\", buf, TCL_GLOBAL_ONLY);\n"
+" Tcl_SetVar(interp, \"argv0\", argv[0], TCL_GLOBAL_ONLY);\n"
+" Tcl_SetVar(interp, \"tcl_interactive\", \"0\", TCL_GLOBAL_ONLY);\n"
+" Et_DoInit(interp);\n"
+" Tcl_Eval(interp,zWaitForever);\n"
+" /* Tcl_DeleteInterp(interp); */\n"
+" /* Tcl_Exit(0); */\n"
+" return 0;\n"
+"}\n"
+"#endif\n"
+"\n"
+"/*\n"
+"** This routine is called to do the complete initialization.\n"
+"*/\n"
+"int Et_Init(int argc, char **argv){\n"
+"#ifdef ET_TCL_LIBRARY\n"
+" putenv(\"TCL_LIBRARY=\" ET_TCL_LIBRARY);\n"
+"#endif\n"
+"#ifdef ET_TK_LIBRARY\n"
+" putenv(\"TK_LIBRARY=\" ET_TK_LIBRARY);\n"
+"#endif\n"
+"#if ET_CONSOLE || !ET_READ_STDIN\n"
+" Et_Local_Init(argc, argv);\n"
+"#else\n"
+"# if ET_ENABLE_TK\n"
+" Tk_Main(argc,argv,Et_DoInit);\n"
+"# else\n"
+" Tcl_Main(argc, argv, Et_DoInit);\n"
+"# endif\n"
+"#endif\n"
+" return 0;\n"
+"}\n"
+"\n"
+"#if !ET_HAVE_MAIN\n"
+"/*\n"
+"** Main routine for UNIX programs. If the user has supplied\n"
+"** their own main() routine in a C module, then the ET_HAVE_MAIN\n"
+"** macro will be set to 1 and this code will be skipped.\n"
+"*/\n"
+"int main(int argc, char **argv){\n"
+"#if ET_AUTO_FORK\n"
+" int rc = fork();\n"
+" if( rc<0 ){\n"
+" perror(\"can't fork\");\n"
+" exit(1);\n"
+" }\n"
+" if( rc>0 ) return 0;\n"
+" close(0);\n"
+" open(\"/dev/null\",O_RDONLY);\n"
+" close(1);\n"
+" open(\"/dev/null\",O_WRONLY);\n"
+"#endif\n"
+" return Et_Init(argc,argv)!=TCL_OK;\n"
+"}\n"
+"#endif\n"
+;
diff --git a/tools/nroff_regen b/tools/nroff_regen
new file mode 100755
index 0000000..f218587
--- /dev/null
+++ b/tools/nroff_regen
@@ -0,0 +1,22 @@
+#!/bin/sh
+
+# Assume call with pwd = 'doc'.
+
+# Phase I ... List known manpages ...
+
+rm -f ../tools/rules/manpages
+touch ../tools/rules/manpages
+
+for i in `ls *.man`
+do
+ echo $i '-->' manpages
+ ../tools/expand -rules ../tools/rules/manpage.list $i >> ../tools/rules/manpages
+done
+
+# Phase II .. Generate true output ...
+
+for i in `ls *.man`
+do
+ echo $i '-->' `basename $i .man`.n
+ ../tools/expand -rules ../tools/rules/manpage.nroff $i > `basename $i .man`.n
+done
diff --git a/tools/rules/formatting b/tools/rules/formatting
new file mode 100644
index 0000000..a63f867
--- /dev/null
+++ b/tools/rules/formatting
@@ -0,0 +1,128 @@
+# -*- tcl -*-
+# Helper rules for the creation of the memchan website from the .exp files.
+# General formatting instructions ...
+
+proc state {} [list return [file join [pwd] state]]
+
+proc use_bg {} {
+ set c [bgcolor]
+ #puts stderr "using $c"
+ if {$c == {}} {return ""}
+ return bgcolor=$c
+}
+
+
+proc nbsp {} {return " "}
+proc p {} {return <p>}
+proc ptop {} {return "<p valign=top>"}
+proc td {} {return "<td [use_bg]>"}
+proc trtop {} {return "<tr valign=top [use_bg]>"}
+proc tr {} {return "<tr [use_bg]>"}
+proc sect {s} {return "<b>$s</b><br><hr>"}
+proc link {text url} {return "<a href=\"$url\">$text</a>"}
+proc table {} {return "<table [border] width=100% cellspacing=0 cellpadding=0>"}
+proc btable {} {return "<table border=1 width=100% cellspacing=0 cellpadding=0>"}
+proc stable {} {return "<table [border] cellspacing=0 cellpadding=0>"}
+
+
+proc tcl_cmd {cmd} {return "<b>\[$cmd]</b>"}
+proc wget {url} {exec /usr/bin/wget -q -O - $url 2>/dev/null}
+
+proc url {tag text url} {
+ set body {
+ switch -exact -- $what {
+ link {return {<a href="%url%">%text%</a>}}
+ text {return {%text%}}
+ url {return {%url%}}
+ }
+ }
+ proc $tag {{what link}} [string map [list %text% $text %url% $url] $body]
+}
+
+proc img {tag alt img} {
+ proc $tag {} [list return "<img alt=\"$alt\" src=\"$img\">"]
+}
+
+proc header {title} {
+ proc pagetitle {} [list return $title]
+ return "<html><head><title>[sfproject] @ SourceForge : $title</title><meta name=\"Author\" content=[author]></head><body [use_bg]>"
+}
+
+proc trailer {} {
+ return "<hr>[table][tr]<td align=left><address>[copyright][me]</address></td><td align=right>Last update at [clock format [clock seconds]]</td></tr></table></body></html>"
+}
+
+proc protect {text} {return [string map [list & "&" < "<" > ">"] $text]}
+
+proc get_changelog {} {
+ set cl [exec [file join [here] .. changelog_to_list] [file join [pwd] .. memchan ChangeLog]]
+ proc get_changelog {} [list return $cl]
+ return $cl
+}
+
+proc changelog {} {
+ set cl [get_changelog]
+ set html "<ul>"
+
+ foreach chunk $cl {
+ foreach {date person items} $chunk break ; # lassign
+ append html "<li><hr><b>[protect $date]</b><p align=right>[protect $person] ...<hr>[p][changelog_items $items][p]\n"
+ }
+
+ return $html</ul>
+}
+
+proc changelog_items {items} {
+ set dlopen 0
+ set onlykey 0
+
+ set html ""
+ foreach item $items {
+ set key [set com {}]
+ foreach {key com} $item break
+
+ if {$key != {}} {
+ if {!$dlopen} {
+ if {$onlykey} {
+ append html [p]
+ set onlykey 0
+ }
+ append html <dl>\n
+ }
+ set dlopen 1
+
+ append html <dt><i>[protect $key]</i></dt>
+ if {$com != {}} {
+ append html <dd>[protect $com]</dd>\n
+ }
+ } else {
+ if {$com != {}} {
+ if {$dlopen} {append html </dl>[p]\n}
+ set dlopen 0
+ append html [protect $com]
+ set onlykey 1
+ }
+ }
+
+ }
+ if {$dlopen} {append html </dl>\n}
+ return $html
+}
+
+proc news {} {
+ set nfile [file join [state] news]
+ set data [read [set fh [open $nfile r]]][close $fh]
+ return [string trim $data]\n
+}
+
+proc stats {} {
+ set nfile [file join [state] statistics]
+ set data [read [set fh [open $nfile r]]][close $fh]
+
+ set data [string trim $data]
+
+ regsub -all {BGCOLOR="[^"]*"} $data "[use_bg]" data
+ regsub -all {bgcolor="[^"]*"} $data "[use_bg]" data
+
+ return [string trim $data]\n
+}
diff --git a/tools/rules/manpage.api b/tools/rules/manpage.api
new file mode 100644
index 0000000..ed8c607
--- /dev/null
+++ b/tools/rules/manpage.api
@@ -0,0 +1,35 @@
+# -*- tcl -*-
+# rules/manpage.api
+#
+# (c) 2001 Andreas Kupries <andreas_kupries at sourceforge.net>
+
+# Defines the procedures a manpage rules file has to support for good
+# manpages. The procedures here return errors.
+
+proc __ {command} {return "return -code error \"Unimplemented command $command\""}
+################################################################
+
+proc manpage_begin {command section version module shortdesc description} [__ manpage]
+
+proc manpage_end {} [__ manpage_end]
+proc require {pkg {version {}}} [__ require]
+proc description {} [__ description]
+proc section {name} [__ section]
+proc para {} [__ para]
+proc list_begin {what} [__ list_begin]
+proc list_end {} [__ list_end]
+proc lst_item {{text {}}} [__ lst_item]
+proc call {cmd args} [__ call]
+proc bullet {} [__ bullet]
+proc enum {} [__ enum]
+proc see_also {args} [__ see_also]
+proc keywords {args} [__ keywords]
+proc nl {} [__ nl]
+proc arg {text} [__ arg]
+proc cmd {text} [__ cmd]
+proc opt {text} [__ opt]
+proc emph {text} [__ emph]
+proc strong {text} [__ strong]
+
+################################################################
+rename __ {}
diff --git a/tools/rules/manpage.api.spec b/tools/rules/manpage.api.spec
new file mode 100644
index 0000000..b7bf0a5
--- /dev/null
+++ b/tools/rules/manpage.api.spec
@@ -0,0 +1,83 @@
+Specification of the API a manpage/tcl has to conform to so that rule
+files are able to process it properly.
+======================================================================
+
+The available commands are listed in the file 'manpage.api' too. The
+definitions in that file return errors. They should be loaded before
+the actual definitions so that usage of an unimplemented command
+causes a proper error message.
+
+----------------------------------------------------------------------
+
+The main commands are "manpage_begin", "manpage_end" and
+"description". All three are required. The first two are the first and
+last commands in a manpage. Neither text nor other commands may
+precede "manpage_begin" nor follow "manpage_end". The command
+"description" separates header and body of the manpage and may not be
+omitted.
+
+The only allowed text between "manpage_begin" and "description" is the
+command "require". Other commands or normal text are not
+permitted. "require" is used to list the packages the described
+command(s) depend(s) on for its operation. This list can be empty.
+
+After "description" text all other commands are allowed. The text can
+be separated into highlevel blocks using named "section"s. Each block
+can be further divided into paragraphs via "para".
+
+The commands "see_also" and "keywords" define whole sections named
+"SEE ALSO" and "KEYWORDS". They can occur everywhere in the manpage
+but making them the last section is the usual thing to do. They can be
+omitted.
+
+There are four commands available to mark words, "arg", "cmd", "emph"
+and "strong". The first two are used to mark words as command
+arguments and as command names. The other two are visual markup to
+emphasize words.
+
+Another set of four commands is available to construct (nested)
+lists. These are "list_begin", "list_end", "lst_item" and "call". The
+first two of these begin and end a list respectively. The argument to
+the first command is either 'bullet' or 'enum' denoting the type of
+the list (unordered vs. ordered). The third command starts list
+items. Each item has some text directly associated with the bullet but
+the major bulk of the item is the text following the item until the
+next list command.
+
+The last list command, "call" is special. It is used to describe the
+syntax of a command and its arguments. It should not only cause the
+appropriate markup of a list item at its place but also add the syntax
+to the table of contents (synopsis) if supported by the output format
+in question. nroff and HTML for example do. A logical format like TMML
+doesn't.
+
+
+I currently use the ?...? notation in my example to mark optional
+arguments. This should better be done through a command. This command
+is "opt". _Not_ "optarg" as it may span several arguments.
+
+======================================================================
+
+ [list_begin "bullet"] --
+ Starts a bulleted (unordered) list.
+ [bullet] --
+ Starts a new item in a bulleted list.
+
+ [list_begin "enum"] --
+ Starts a numbered list.
+ [enum] --
+ Starts a new item in a numbered (ordered) list. Successive list
+ items are numbered [1], [2], ... etc.
+
+ [list_begin "definitions"] --
+ Starts a definition list.
+ [lst_item _text_] --
+ Starts a new entry in a definition list. _text_ is
+ the list item header.
+
+ [list_begin commands] --
+ Starts a command list, for describing the syntax of a
+ command and its arguments.
+ [call _cmd_ ? _arg_ _arg_ ... ? ] --
+ Starts an entry in a command list. In addition, adds the
+ command syntax summary "_cmd_ _args_..." to the SYNOPSIS section.
diff --git a/tools/rules/manpage.html b/tools/rules/manpage.html
new file mode 100644
index 0000000..7509256
--- /dev/null
+++ b/tools/rules/manpage.html
@@ -0,0 +1,182 @@
+# -*- tcl -*-
+# rules/manpage-html
+#
+# (c) 2001 Andreas Kupries <andreas_kupries at sourceforge.net>
+#
+# [expand] definitions to convert a tcl based manpage definition into
+# a manpage based upon HTML markup. Additional definition files allow
+# the conversion into nroff and XML.
+#
+# This conversion is for standalone manpages ...
+#
+################################################################
+
+proc here {} [list return [file dirname [info script]]]
+
+source [file join [here] manpage.api] ; # api, defines all required commands with errors.
+source [file join [here] formatting] ; # HTML basic formatting
+
+proc bgcolor {} {return ""}
+proc border {} {return 0}
+
+# Called before the first pass
+proc init_hook {} {setpasses 2}
+
+# Called before the first output.
+proc begin_hook {} {
+ # Reset the syn flag
+ global state
+ set state(syn) 0
+ set state(req) 0
+ return
+}
+
+# Called after the last output.
+proc end_hook {} {}
+
+################################################################
+## Backend for *roff markup
+
+proc manpage_begin {command section version module shortdesc description} {
+ set hdr ""
+ append hdr "<html><head><title>$command - $shortdesc </title></head>"
+ append hdr "[ht_comment {}]\n"
+ append hdr "[ht_comment {Copyright (c) 2000 Andreas Kupries}]\n"
+ append hdr "[ht_comment {All right reserved}]\n"
+ append hdr "[ht_comment {}]\n"
+ append hdr "[ht_comment "CVS: \$Id\$ $command.$section"]\n"
+ append hdr "[ht_comment {}]\n"
+ append hdr "<h1> [string trimleft $command :]($section) $version $module \"$shortdesc\"</h1>\n"
+ append hdr "[section NAME]\n"
+ append hdr "[para] $command - $description"
+ return $hdr
+}
+
+proc manpage_end {} {return </body></html>}
+
+proc section {name} {return "<h2>$name</h2>"}
+proc para {} {return <p>}
+
+global state
+array set state {req 0 syn 0 call {}}
+
+proc require {pkg {version {}}} {
+ global state
+ set state(req) 1
+ set result "[x_synopsis]package require <b>$pkg"
+ if {$version != {}} {
+ append result " $version"
+ }
+ append result "</b><br>"
+ return $result
+}
+
+proc call {cmd args} {
+ global state
+ if {[exppass] == 1} {
+ append state(call) "[trtop][td]$cmd [join $args " "]</td></tr>\n"
+ }
+ return "[lst_item "$cmd [join $args " "]"]\n"
+}
+
+proc description {} {
+ global state
+
+ set result ""
+ if {$state(call) != {}} {
+ append result [x_synopsis]
+ if {$state(req)} {append result <br>}
+
+ proc bgcolor {} {return lightyellow}
+
+ append result [btable][tr][td][table]$state(call)</table></td></tr></table>\n
+
+ proc bgcolor {} {return ""}
+ }
+ append result [section DESCRIPTION]
+ return $result
+}
+
+proc x_synopsis {} {
+ global state
+ if {!$state(syn)} {
+ set state(syn) 1
+ return [section SYNOPSIS]\n
+ } else {
+ return ""
+ }
+}
+
+################################################################
+
+global list_state
+array set list_state {level -1}
+
+proc list_begin {what} {
+ global list_state
+
+ switch -exact -- $what {
+ enum {set result <ol>}
+ bullet {set result <ul>}
+ definitions {set result <dl>}
+ default {return -code error "Unknown list type $what"}
+ }
+
+ incr list_state(level)
+ set list_state(l,$list_state(level)) $what
+
+ return $result
+}
+
+proc list_end {} {
+ global list_state
+
+ set what $list_state(l,$list_state(level))
+ catch {unset list_state(l,$list_state(level))}
+
+ incr list_state(level) -1
+
+ switch -exact -- $what {
+ enum {set result </ol>}
+ bullet {set result </ul>}
+ definitions {set result </dl>}
+ }
+ return $result
+}
+
+proc lst_item {text} {return <dt>$text<dd>}
+proc bullet {} {return <li>}
+proc enum {} {return <li>}
+
+################################################################
+
+proc see_also {args} {return "[section {SEE ALSO}]\n[join $args ", "]"}
+proc keywords {args} {return "[section KEYWORDS]\n[join $args ", "]"}
+
+proc nl {} {return <br>}
+proc arg {text} {return <i>$text</i>}
+proc cmd {text} {return <b>$text</b>}
+proc emph {text} {return <i>$text</i>}
+proc strong {text} {return <b>$text</b>}
+proc opt {text} {return ?$text?}
+
+################################################################
+# HTML specific commands
+
+proc ht_comment {text} {return "<! -- $text -->"}
+
+################################################################
+
+proc setx {v string} {
+ upvar $v _
+ set _ $string
+ return
+}
+
+proc appendx {v string} {
+ upvar $v _
+ append _ $string
+ return
+}
+
+################################################################
diff --git a/tools/rules/manpage.html.site b/tools/rules/manpage.html.site
new file mode 100644
index 0000000..6edeab7
--- /dev/null
+++ b/tools/rules/manpage.html.site
@@ -0,0 +1,183 @@
+# -*- tcl -*-
+# rules/manpage-html
+#
+# (c) 2001 Andreas Kupries <andreas_kupries at sourceforge.net>
+#
+# [expand] definitions to convert a tcl based manpage definition into
+# a manpage based upon HTML markup. Additional definition files allow
+# the conversion into nroff and XML.
+#
+# This conversion is for standalone manpages ...
+#
+################################################################
+
+proc here {} [list return [file dirname [info script]]]
+
+source [file join [here] manpage.api] ; # api, defines all required commands with errors.
+source [file join [here] memchan] ; # site pages policy and memchan configuration
+
+proc state {} [list return [file join [file dirname [state]] .. htdocs state]]
+
+# Called before the first pass
+proc init_hook {} {setpasses 2}
+
+# Called before the first output.
+proc begin_hook {} {
+ # Reset the syn flag
+ global state
+ set state(syn) 0
+ set state(req) 0
+ return
+}
+
+# Called after the last output.
+proc end_hook {} {}
+
+################################################################
+## Backend for *roff markup
+
+
+proc manpage_begin {command section version module shortdesc description} {
+ set hdr ""
+ append hdr "[ht_comment {}]\n"
+ append hdr "[ht_comment {Copyright (c) 2000 Andreas Kupries}]\n"
+ append hdr "[ht_comment {All right reserved}]\n"
+ append hdr "[ht_comment {}]\n"
+ append hdr "[ht_comment "CVS: \$Id\$ $command.$section"]\n"
+ append hdr "[ht_comment {}]\n"
+ append hdr [page_begin mem/mp/$command][nav_link [mem/sf/txt]]<br>[site_xref]<br>[mp_xref]
+ append hdr [page_content]
+ append hdr "<hr><h2> $module $version -- [string trimleft $command :]($section)</h2>\n"
+ append hdr "[section NAME]\n"
+ append hdr "[para] $command - $description"
+ return $hdr
+}
+
+proc manpage_end {} {return [page_end]}
+
+proc section {name} {return "<h2>$name</h2>"}
+proc para {} {return <p>}
+
+global state
+array set state {req 0 syn 0 call {}}
+
+proc require {pkg {version {}}} {
+ global state
+ set state(req) 1
+ set result "[x_synopsis]package require <b>$pkg"
+ if {$version != {}} {
+ append result " $version"
+ }
+ append result "</b><br>\n"
+ return $result
+}
+
+proc call {cmd args} {
+ global state
+ if {[exppass] == 1} {
+ set oldcolor [bgcolor]
+ proc bgcolor {} {return lightyellow}
+ append state(call) "[trtop][td]$cmd [join $args " "]</td></tr>\n"
+ proc bgcolor {} [list return $oldcolor]
+ }
+ return "[lst_item "$cmd [join $args " "]"]"
+}
+
+proc description {} {
+ global state
+
+ set result ""
+ if {$state(call) != {}} {
+ append result [x_synopsis]
+ if {$state(req)} {append result <br>}
+ append result [btable][tr][td][table]$state(call)</table></td></tr></table>\n
+ }
+ append result [section DESCRIPTION]
+
+ return $result
+}
+
+proc x_synopsis {} {
+ global state
+ if {!$state(syn)} {
+ global oldcolor
+ set state(syn) 1
+ return [section SYNOPSIS]\n
+ } else {
+ return ""
+ }
+}
+
+################################################################
+
+global list_state
+array set list_state {level -1}
+
+proc list_begin {what} {
+ global list_state
+
+ switch -exact -- $what {
+ enum {set result <ol>}
+ bullet {set result <ul>}
+ definitions {set result <dl>}
+ default {return -code error "Unknown list type $what"}
+ }
+
+ incr list_state(level)
+ set list_state(l,$list_state(level)) $what
+
+ return $result
+}
+
+proc list_end {} {
+ global list_state
+
+ set what $list_state(l,$list_state(level))
+ catch {unset list_state(l,$list_state(level))}
+
+ incr list_state(level) -1
+
+ switch -exact -- $what {
+ enum {set result </ol>}
+ bullet {set result </ul>}
+ definitions {set result </dl>}
+ }
+ return $result
+}
+
+proc lst_item {text} {return <dt>$text<dd>}
+proc bullet {} {return <li>}
+proc enum {} {return <li>}
+
+################################################################
+
+proc see_also {args} {return "[section {SEE ALSO}]\n[join $args ", "]"}
+proc keywords {args} {return "[section KEYWORDS]\n[join $args ", "]"}
+
+proc nl {} {return <br>}
+proc arg {text} {return <i>$text</i>}
+proc cmd {text} {return <b>$text</b>}
+proc emph {text} {return <i>$text</i>}
+proc strong {text} {return <b>$text</b>}
+proc opt {text} {return ?$text?}
+
+################################################################
+# HTML specific commands
+
+proc ht_comment {text} {return "<! -- $text -->"}
+
+################################################################
+
+proc setx {v string} {
+ upvar $v _
+ set _ $string
+ return
+}
+
+proc appendx {v string} {
+ upvar $v _
+ append _ $string
+ return
+}
+
+################################################################
diff --git a/tools/rules/manpage.list b/tools/rules/manpage.list
new file mode 100644
index 0000000..96e70d8
--- /dev/null
+++ b/tools/rules/manpage.list
@@ -0,0 +1,42 @@
+# -*- tcl -*-
+# rules/manpage.api
+#
+# (c) 2001 Andreas Kupries <andreas_kupries at sourceforge.net>
+
+# Defines the procedures a manpage rules file has to support for good
+# manpages. The procedures here return errors.
+
+################################################################
+
+proc manpage_begin {command section version module shortdesc description} {
+ puts [list manpage mem/mp/$command $command mp.$command.html]
+ setoutput nul
+ return
+}
+
+################################################################
+
+proc manpage_end {} {}
+proc require {pkg {version {}}} {}
+proc description {} {}
+proc section {name} {}
+proc para {} {}
+proc call {cmd args} {}
+proc list_begin {what} {}
+proc list_end {} {}
+proc lst_item {text} {}
+proc see_also {args} {}
+proc keywords {args} {}
+proc nl {} {}
+proc bullet {} {}
+proc enum {} {}
+proc arg {text} {}
+proc cmd {text} {}
+proc emph {text} {}
+proc strong {text} {}
+proc setx {v string} {}
+proc appendx {v string} {}
+proc opt {text} {}
+
+################################################################
+
diff --git a/tools/rules/manpage.nroff b/tools/rules/manpage.nroff
new file mode 100644
index 0000000..a96018f
--- /dev/null
+++ b/tools/rules/manpage.nroff
@@ -0,0 +1,205 @@
+# -*- tcl -*-
+# rules/manpage-nroff
+#
+# (c) 2001 Andreas Kupries <andreas_kupries at sourceforge.net>
+#
+# [expand] definitions to convert a tcl based manpage definition into
+# a manpage based upon *roff markup. Additional definition files allow
+# the conversion into HTML and XML.
+#
+################################################################
+
+proc here {} [list return [file dirname [info script]]]
+
+source [file join [here] manpage.api] ; # api, defines all required commands with errors.
+
+# Called before the first pass
+proc init_hook {} {setpasses 2}
+
+# Called before the first output.
+proc begin_hook {} {
+ # Reset the syn flag
+ global state
+ set state(syn) 0
+ return
+}
+
+# Called after the last output.
+proc end_hook {} {}
+
+################################################################
+## Backend for *roff markup
+
+
+proc manpage_begin {command section version module shortdesc description} {
+ cpush mp
+ set hdr ""
+ append hdr "[nr_comment {}]\n"
+ append hdr "[nr_comment {Copyright (c) 2000 Andreas Kupries}]\n"
+ append hdr "[nr_comment {All right reserved}]\n"
+ append hdr "[nr_comment {}]\n"
+ append hdr "[nr_comment "CVS: \$Id\$ $command.$section"]\n"
+ append hdr "[nr_comment {}]\n"
+ append hdr ".so man.macros\n"
+ append hdr ".TH \"[string trimleft $command :]\" $section $version $module \"$shortdesc\"\n"
+ append hdr ".BS\n"
+ append hdr "[nr_comment {Note: do not modify the .SH NAME line immediately below!}]\n"
+ append hdr ".SH NAME\n"
+ append hdr "$command \\- $description"
+ return $hdr
+}
+
+proc manpage_end {} {
+ # Strip empty lines out of the generated nroff source. They mess
+ # up the nroff formatting.
+ regsub -all "\[\t \]*\n(\[\t \]*\n)*\[\t \]*" [cpop mp] "\n" data
+ return $data
+}
+
+proc section {name} {return ".SH \"$name\""}
+proc para {} {nr_p}
+
+
+global state
+array set state {syn 0 call {}}
+
+proc require {pkg {version {}}} {
+ if {$version != {}} {
+ return "[x_synopsis]package require [nr_bld]$pkg $version[nr_rst]\n[nl]"
+ } else {
+ return "[x_synopsis]package require [nr_bld]$pkg[nr_rst]\n[nl]"
+ }
+}
+
+proc call {cmd args} {
+ global state
+ if {[exppass] == 1} {
+ append state(call) "$cmd [join $args " "][nr_rst]\n[nl]\n"
+ }
+ return "[lst_item "$cmd [join $args " "][nr_rst]"]"
+}
+
+proc description {} {
+ global state
+ if {$state(call) == {}} {
+ return .BE\n[section DESCRIPTION]
+ } else {
+ return [x_synopsis]$state(call).BE\n[section DESCRIPTION]
+ }
+}
+
+proc x_synopsis {} {
+ global state
+ if {!$state(syn)} {
+ set state(syn) 1
+ return [section SYNOPSIS]\n
+ } else {
+ return ""
+ }
+}
+
+################################################################
+
+global list_state
+array set list_state {level -1}
+
+proc list_begin {what} {
+ global list_state
+
+ switch -exact -- $what {
+ enum - bullet - definitions {}
+ default {return -code error "Unknown list type $what"}
+ }
+
+ incr list_state(level)
+ set list_state(l,$list_state(level)) $what
+ set list_state(l,$list_state(level),id) 0
+
+ if {$list_state(level) > 0} {
+ return [nr_in]
+ } else {
+ return {}
+ }
+}
+
+proc list_end {} {
+ global list_state
+ catch {unset list_state(l,$list_state(level))}
+ catch {unset list_state(l,$list_state(level),id)}
+
+ incr list_state(level) -1
+
+ if {$list_state(level) >= 0} {
+ return [nr_out]
+ } else {
+ return {}
+ }
+}
+
+proc bullet {} {
+ global list_state
+ switch -exact -- $list_state(l,$list_state(level)) {
+ bullet {return ".TP\n*"}
+ default {return -code error "Illegal use of bullet in non-bullet list"}
+ }
+}
+
+proc enum {} {
+ global list_state
+ switch -exact -- $list_state(l,$list_state(level)) {
+ enum {return ".IP \[[incr list_state(l,$list_state(level),id)]\]\n"}
+ default {return -code error "Illegal use of bullet in non-bullet list"}
+ }
+}
+
+proc lst_item {text} {
+ global list_state
+ switch -exact -- $list_state(l,$list_state(level)) {
+ definitions {return ".TP\n$text"}
+ default {return -code error "Illegal use of bullet in non-bullet list"}
+ }
+}
+
+################################################################
+
+proc see_also {args} {return "[section {SEE ALSO}]\n[join $args ", "]"}
+proc keywords {args} {return "[section KEYWORDS]\n[join $args ", "]"}
+
+proc nl {} {nr_vspace}
+proc arg {text} {return [nr_ul]$text[nr_rst]}
+proc cmd {text} {return [nr_bld]$text[nr_rst]}
+proc emph {text} {return [nr_ul]$text[nr_rst]}
+proc strong {text} {return [nr_bld]$text[nr_rst]}
+proc opt {text} {return ?$text?}
+
+################################################################
+# nroff specific commands
+
+proc nr_bld {} {return \\fB}
+proc nr_ul {} {return \\fI}
+proc nr_rst {} {return \\fR}
+proc nr_p {} {return .PP}
+proc nr_comment {text} {return "'\\\" $text"}
+proc nr_enum {num} {return ".IP \[$num\]"}
+proc nr_vspace {} {return .sp}
+proc nr_blt {text} {return ".TP\n$text"}
+proc nr_bltn {n text} {return ".TP $n\n$text"}
+
+proc nr_in {} {return .RS}
+proc nr_out {} {return .RE}
+
+################################################################
+
+proc setx {v string} {
+ upvar $v _
+ set _ $string
+ return
+}
+
+proc appendx {v string} {
+ upvar $v _
+ append _ $string
+ return
+}
+
+################################################################
diff --git a/tools/rules/manpage.tmml b/tools/rules/manpage.tmml
new file mode 100644
index 0000000..e54f447
--- /dev/null
+++ b/tools/rules/manpage.tmml
@@ -0,0 +1,183 @@
+# -*- tcl -*-
+#
+# $Id: manpage.tmml,v 1.1 2002/12/17 18:31:05 drh Exp $
+#
+# [expand] definitions to convert a tcl based manpage definition
+# into TMML.
+#
+# Copyright (C) 2001 Joe English <jenglish at sourceforge.net>.
+# Freely redistributable.
+#
+# See also <URL: http://tmml.sourceforge.net>
+#
+# BUGS:
+# + XML markup characters in [expand] macro arguments
+# are not properly escaped. (Plain text outside of
+# [...] is handled correctly however.)
+#
+# + Text must be preceded by [para] or one of the
+# list item macros, or else the output will be invalid.
+#
+######################################################################
+
+proc here {} [list return [file dirname [info script]]]
+source [file join [here] manpage.api]
+source [file join [here] xmlrules.tcl]
+
+######################################################################
+# Utilities.
+#
+
+proc NOP {args} { } ;# do nothing
+proc NYI {{message {}}} {
+ return -code error [append $message " Not Yet Implemented"]
+}
+
+set this [file tail [info script]]
+proc provenance {} {
+ return "Generated from [expand::expfile] by EXPAND with $::this"
+}
+
+######################################################################
+# Expand hooks.
+#
+proc init_hook {} { setpasses 2 }
+proc raw_text_hook {text} { xmlEscape $text }
+proc begin_hook {} { setPassProcs [expand::exppass] }
+
+######################################################################
+# Conversion specification.
+#
+# Two-pass processing. The first pass collects text for the
+# SYNOPSIS, SEE ALSO, and KEYWORDS sections, and the second pass
+# produces output.
+#
+
+holdBuffers synopsis see_also keywords
+
+proc nl {} { emptyElement br }
+proc arg {text} { wrap $text m }
+proc cmd {text} { wrap $text cmd }
+proc emph {text} { wrap $text emph }
+proc strong {text} { wrap $text emph }
+proc opt {text} { wrap $text o }
+
+pass 1 manpage_begin {args} NOP
+pass 2 manpage_begin {command section version module shortdesc description} {
+ sequence \
+ [xmlComment [provenance]] \
+ [start manpage \
+ id [file root [file tail [expand::expfile]]] \
+ cat cmd \
+ title $command \
+ version $version \
+ package $module] \
+ [start namesection] \
+ [wrap $command name] \
+ [wrap $description desc] \
+ [end namesection] \
+ ;
+}
+
+pass 1 description {} NOP
+pass 2 description {} {
+ sequence \
+ [xmlContext manpage] \
+ [wrapLines? [held synopsis] syntax synopsis] \
+ [start section] \
+ [wrap "DESCRIPTION" title] \
+ ;
+}
+
+pass 1 section {name} NOP
+pass 2 section {name} {
+ sequence \
+ [xmlContext manpage] \
+ [start section] \
+ [wrap [string toupper $name] title] \
+ ;
+}
+pass 1 para {} NOP
+pass 2 para {} { sequence [xmlContext section] [start p] }
+
+array set listTypes {
+ bullet ul
+ enum ol
+ definitions dl
+}
+pass 1 list_begin {what} NOP
+pass 1 list_end {} NOP
+pass 2 list_begin {what} {
+ sequence \
+ [xmlContext {section dd li}] \
+ [start $::listTypes($what)] \
+ ;
+}
+pass 2 list_end {} {
+ sequence \
+ [xmlContext {ul ol dl}] \
+ [end] \
+ ;
+}
+
+pass 1 bullet {} NOP
+pass 1 enum {} NOP
+pass 2 bullet {} { sequence [xmlContext {ul ol}] [start li] }
+pass 2 enum {} { sequence [xmlContext {ul ol}] [start li] }
+
+pass 1 lst_item {text} NOP
+pass 2 lst_item {text} {
+ sequence \
+ [xmlContext dl] \
+ [start dle] \
+ [wrap $text dt] \
+ [start dd] \
+ ;
+}
+
+pass 1 call {cmd args} { hold synopsis [formatCall $cmd $args] }
+pass 2 call {cmd args} {
+ sequence \
+ [xmlContext dl] \
+ [start dle] \
+ [wrap [formatCall $cmd $args] dt] \
+ [start dd] \
+ ;
+}
+proc formatCall {cmd arglist} {
+ return "$cmd [join $arglist { }]" ;# OR: wrap "..." command
+}
+
+pass 1 require {pkg {version {}}} {
+ hold synopsis [formatRequire $pkg $version]
+}
+pass 2 require {pkg {version {}}} NOP
+proc formatRequire {pkg version} {
+ return "package require [wrap $pkg package] [wrap? $version l]"
+}
+
+pass 1 see_also {args} { holdWrapped see_also $args ref }
+pass 1 keywords {args} { holdWrapped keywords $args keyword }
+pass 2 see_also {args} NOP
+pass 2 keywords {args} NOP
+
+# holdWrapped --
+# Common factor of [see_also] and [keywords].
+#
+proc holdWrapped {buffer arglist gi} {
+ foreach arg $arglist { hold $buffer [wrap $arg $gi] }
+ return
+}
+
+pass 1 manpage_end {} NOP
+pass 2 manpage_end {} {
+ sequence \
+ [xmlContext manpage] \
+ [wrapLines? [held see_also] seealso] \
+ [wrapLines? [held keywords] keywords] \
+ [end manpage] \
+ ;
+}
+
+#*EOF*
+
diff --git a/tools/rules/memchan b/tools/rules/memchan
new file mode 100644
index 0000000..088dc53
--- /dev/null
+++ b/tools/rules/memchan
@@ -0,0 +1,54 @@
+# -*- tcl -*-
+# configures the site policy with some variant information, like colors.
+
+# Rules for the creation of the memchan website from the .exp files.
+
+proc here {} [list return [file dirname [info script]]]
+
+source [file join [here] site] ; # load policy, defines template interface too.
+source [file join [here] references] ; # load references used by the site.
+source [file join [here] manpages] ; # load list of known manpages.
+
+
+proc sfproject {} {return Memchan}
+proc sfgroup {} {return 34191}
+
+proc bgcolor {} {return lightsteelblue}
+proc hlcolor {} {return lightyellow}
+
+proc author {} {return "\"Andreas Kupries,,,\""}
+proc border {} {return border=0}
+
+# Declare the pages of this site upfront ...
+
+sitepage mem/home "Homepage" index.html
+sitepage mem/releases "Releases" [releases/url]
+sitepage mem/images "Logos" images.html
+sitepage mem/anim "Animations" animations.html
+sitepage mem/doc "Documentation" documentation.html
+sitepage mem/clog "ChangeLog" changelog.html
+sitepage mem/copyright "© Disclaimer" disclaimer.html
+sitepage mem/event/gen "Event generation" mem_event.html
+
+# memchan specific commands
+
+proc mem/latest-release {} {
+ set nfile [file join [state] latest.release]
+ foreach {version date} [split [read [set fh [open $nfile r]]][close $fh] \n] break ; # lassign
+
+ set releasepage [wget [releases/url]]
+
+ regexp {release_id=([0-9]+)} $releasepage -> release_id
+
+ return "[link "version $version" [releases/url]&release_id=$release_id] as of $date"
+}
+
+url mc/doc/nroff/gz "Archive" doc/memchan.nroff.tar.gz
+url mc/doc/nroff/bz "Archive" doc/memchan.nroff.tar.bz2
+url mc/doc/nroff/zip "Archive" doc/memchan.nroff.tar.zip
+url mc/doc/html/gz "Archive" doc/memchan.html.tar.gz
+url mc/doc/html/bz "Archive" doc/memchan.html.tar.bz2
+url mc/doc/html/zip "Archive" doc/memchan.html.tar.zip
+url mc/doc/tmml/gz "Archive" doc/memchan.tmml.tar.gz
+url mc/doc/tmml/bz "Archive" doc/memchan.tmml.tar.bz2
+url mc/doc/tmml/zip "Archive" doc/memchan.tmml.tar.zip
diff --git a/tools/rules/references b/tools/rules/references
new file mode 100644
index 0000000..e7345c5
--- /dev/null
+++ b/tools/rules/references
@@ -0,0 +1,56 @@
+# -*- tcl -*-
+# Helper rules for the creation of the memchan website from the .exp files.
+
+proc releases/url {} {return http://sourceforge.net/project/showfiles.php?group_id=[sfgroup]}
+
+img sf/logo "SourceForge Logo" http://sourceforge.net/sflogo.php?group_id=34191
+img tcl/logo "Tcl Logo" http://tcl.sourceforge.net/images/logo125.gif
+
+img mem/logo/520 "Memchan Logo" art/logo520.jpg
+img mem/logo/100 "Memchan Logo" art/logo100.gif
+img mem/logo/64 "Memchan Logo" art/logo64.gif
+img mem/logo/100a "Animated Memchan Logo" art/logo100a.gif
+img mem/logo/64a "Animated Memchan Logo" art/logo64a.gif
+
+url sf/img [sf/logo] http://sourceforge.net
+url tcl/sf/img [tcl/logo] http://sourceforge.net/projects/tcl
+url tcl/sf/txt Tcl http://sourceforge.net/projects/tcl
+url tcl/sf/txt/home "Tcl Homepage" http://sourceforge.net/projects/tcl
+url trf/txt Trf http://www.purl.org/net/akupries/soft/trf
+url trf/txt/home "Trf Homepage" http://www.purl.org/net/akupries/soft/trf
+
+url mem/sf/txt "Memchan SF Project" http://sourceforge.net/projects/memchan
+url mem/txt Memchan http://www.purl.org/net/akupries/soft/memchan
+url mem/txt/old "Old Memchan page" http://www.purl.org/net/akupries/soft/memchan
+url mem/txt/old/2 "old Memchan homepage" http://www.purl.org/net/akupries/soft/memchan
+
+url copyright "©" disclaimer.html
+
+if {0} {
+ url mem/images "Logos" images.html
+ url mem/home "Homepage" index.html
+ url mem/anim "Animations" animations.html
+ url mem/releases "Releases" [releases/url]
+ url mem/doc "Documentation" documentation.html
+ url mem/clog "ChangeLog" changelog.html
+}
+
+url tcl/foundry "Tcl Foundry" http://sourceforge.net/foundry/tcl-foundry/
+
+
+url me "Andreas Kupries" http://www.purl.org/net/akupries/
+
+## Future ## Try to make this automatic ...
+
+url andreas_kupries/home "Andreas Kupries" http://www.purl.org/net/akupries/
+url stevel/home "Steve Landers" http://www.digital-smarties.com/
+
+
+url jo "John Ousterhout" http://www.scriptics.com/people/john.ousterhout
+url jcw "Jean-Claude Wippler" http://www.equi4.com/jcw/
+url tclwiki "Tcl'ers Wiki" http://www.purl.org/tcl/wiki/
+url lvirden "Larry W. Virden" http://www.purl.org/net/lvirden/
+url jan "Jan Nijtmans" http://www.purl.org/net/nijtmans/
+
+url tcl/io/fevent "Interaction of I/O system and notifier in the Tcl core" \
+ http://sourceforge.net/docman/display_doc.php?docid=6710&group_id=10894
\ No newline at end of file
diff --git a/tools/rules/site b/tools/rules/site
new file mode 100644
index 0000000..cd66366
--- /dev/null
+++ b/tools/rules/site
@@ -0,0 +1,121 @@
+# -*- tcl -*-
+# site wide definitions _____________________________
+# the general layout of the website. Change this to
+# adjust the layout. also imposes the interfaces between
+# site policy and templates
+
+source [file join [here] formatting] ; # Make general formatting available.
+
+# Rules for the creation of the website from the .exp files.
+#
+# General layout __________________________
+
+# Header | [page_begin tag]
+# - Navigation - |
+# Interlude | [page_content]
+# - Content - |
+# Footer | [page_end]
+
+
+proc sitepage {tag text url} {
+ global pages
+ if {[info exists pages(t,$tag)]} {
+ error "Page $tag already defined"
+ }
+
+ set pages(t,$tag) .
+ lappend pages(tags) $tag
+
+ url $tag $text $url
+ return
+}
+
+proc manpage {tag text url} {
+ global pages
+ if {[info exists pages(t,$tag)]} {
+ error "Page $tag already defined"
+ }
+
+ set pages(t,$tag) .
+ lappend pages(mp) $tag
+ url $tag $text $url
+ return
+}
+
+proc page_begin {tag} {
+ global pages
+ if {![info exists pages(t,$tag)]} {
+ error "Unknown page $tag"
+ }
+
+ set title [$tag text]
+ set pages(_) $tag
+
+ set data [header $title]
+ append data "[table][trtop]"
+ append data "[td]<h1>[sfproject]</h1><hr></td>[td][nbsp]</td>[td]<h1>[pagetitle]</h1></td></tr>"
+ append data [page_navigation_begin]
+}
+
+proc page_content {} {
+ global pages
+ unset pages(_)
+ page_navigation_end
+}
+
+proc page_end {} {
+ set last_update [readFile [file join [state] sn.time]]
+
+ set data "<tr><td colspan=3 [use_bg]><hr></td></tr>"
+ append data "<tr><td [use_bg] colspan=3><b>Last updated @ $last_update</b></td></tr>"
+ append data "<tr><td [use_bg] colspan=3>"
+ append data "[table][trtop][td][news]</td>[td][stats]</td></tr></table>"
+ append data "</td></tr>"
+ append data "</table></td></tr></table>[trailer]"
+ return $data
+}
+
+proc page_navigation_begin {} {
+ set data "[trtop][td][table][trtop]<td>[table][trtop]"
+ append data "[td]<p align=center>[sf/img]<br><br>[mem/logo/100]<br><br>[tcl/sf/img]</td>"
+ append data "[td][nbsp]</td>[td][sect Crossreferences]"
+ return $data
+}
+
+proc page_navigation_end {} {
+ return "</td></tr></table></td></tr></table></td>[td][nbsp]</td>[td]"
+}
+
+proc nav_link {link} {
+ return $link<br>
+}
+
+proc site_xref {} {
+ global pages
+
+ set data ""
+ foreach tag $pages(tags) {
+ if {0 == [string compare $tag $pages(_)]} {
+ append data [nav_link "<font color=[hlcolor]><b>[$tag text]</b></font>"]
+ } else {
+ append data [nav_link [$tag]]
+ }
+ }
+
+ return $data
+}
+
+proc mp_xref {} {
+ global pages
+
+ set data "<hr>[sect Manpages]"
+ foreach tag $pages(mp) {
+ if {0 == [string compare $tag $pages(_)]} {
+ append data [nav_link "<font color=[hlcolor]><b>[$tag text]</b></font>"]
+ } else {
+ append data [nav_link [$tag]]
+ }
+ }
+
+ return $data
+}
diff --git a/tools/rules/xmlrules.tcl b/tools/rules/xmlrules.tcl
new file mode 100644
index 0000000..6f0560d
--- /dev/null
+++ b/tools/rules/xmlrules.tcl
@@ -0,0 +1,201 @@
+# -*- tcl -*-
+#
+# $Id: xmlrules.tcl,v 1.1 2002/12/17 18:31:05 drh Exp $
+#
+# [expand] utilities for generating XML.
+#
+# Copyright (C) 2001 Joe English <jenglish at sourceforge.net>.
+# Freely redistributable.
+#
+######################################################################
+
+# xmlEscape text --
+# Replaces XML markup characters in $text with the
+# appropriate entity references.
+#
+variable textMap { & & < < > > }
+variable attvalMap { & & < < > > {"} " } ; # "
+
+proc xmlEscape {text} {
+ variable textMap
+ string map $textMap $text
+}
+
+# startTag gi ?attname attval ... ? --
+# Return start-tag for element $gi with specified attributes.
+#
+proc startTag {gi args} {
+ variable attvalMap
+ if {[llength $args] == 1} { set args [lindex $args 0] }
+ set tag "<$gi"
+ foreach {name value} $args {
+ append tag " $name='[string map $attvalMap $value]'"
+ }
+ return [append tag ">"]
+}
+
+# endTag gi --
+# Return end-tag for element $gi.
+#
+proc endTag {gi} {
+ return "</$gi>"
+}
+
+# emptyElement gi ?attribute value ... ?
+# Return empty-element tag.
+#
+proc emptyElement {gi args} {
+ variable attvalMap
+ if {[llength $args] == 1} { set args [lindex $args 0] }
+ set tag "<$gi"
+ foreach {name value} $args {
+ append tag " $name='[string map $attvalMap $value]'"
+ }
+ return [append tag "/>"]
+}
+
+# xmlComment text --
+# Return XML comment declaration containing $text.
+# NB: if $text includes the sequence "--", it will be mangled.
+#
+proc xmlComment {text} {
+ return "<!-- [string map {-- { - - }} $text] -->"
+}
+
+# wrap content gi --
+# Returns $content wrapped inside <$gi> ... </$gi> tags.
+#
+proc wrap {content gi} {
+ return "<$gi>$content</$gi>"
+}
+
+# wrap? content gi --
+# Same as [wrap], but returns an empty string if $content is empty.
+#
+proc wrap? {content gi} {
+ if {![string length [string trim $content]]} { return "" }
+ return "<$gi>$content</$gi>"
+}
+
+# wrapLines? content gi ? gi... ?
+# Same as [wrap?], but separates entries with newlines
+# and supports multiple nesting levels.
+#
+proc wrapLines? {content args} {
+ if {![string length $content]} { return "" }
+ foreach gi $args {
+ set content [join [list <$gi> $content </$gi>] "\n"]
+ }
+ return $content
+}
+
+# sequence args --
+# Handy combinator.
+#
+proc sequence {args} { join $args "\n" }
+
+######################################################################
+# XML context management.
+#
+
+variable elementStack [list]
+
+# start gi ?attribute value ... ? --
+# Return start-tag for element $gi
+# As a side-effect, pushes $gi onto the element stack.
+#
+proc start {gi args} {
+ variable elementStack
+ lappend elementStack $gi
+ return [startTag $gi $args]
+}
+
+# xmlContext {gi1 ... giN} --
+# Pops elements off the element stack until one of
+# the specified element types is found.
+#
+# Returns: sequence of end-tags for each element popped.
+#
+proc xmlContext {gis} {
+ variable elementStack
+ set endTags [list]
+ while { [llength $elementStack]
+ && [lsearch $gis [set current [lindex $elementStack end]]] < 0
+ } {
+ lappend endTags "</$current>"
+ set elementStack [lreplace $elementStack end end]
+ }
+ return [join $endTags \n]
+}
+
+# end ? gi ? --
+# Generate markup to close element $gi, including end-tags
+# for any elements above it on the element stack.
+#
+# If element name is omitted, closes the current element.
+#
+proc end {{gi {}}} {
+ variable elementStack
+ if {![string length $gi]} {
+ set gi [lindex $elementStack end]
+ }
+ set prefix [xmlContext $gi]
+ set elementStack [lreplace $elementStack end end]
+ return [join [list $prefix </$gi>] "\n"]
+}
+
+######################################################################
+# Utilities for multi-pass processing.
+#
+# Not really XML-related, but I find them handy.
+#
+
+variable PassProcs
+variable Buffers
+
+# pass $passNo procName procArgs { body } --
+# Specifies procedure definition for pass $n.
+#
+proc pass {pass proc args body} {
+ variable PassProcs
+ lappend PassProcs($pass) $proc $args $body
+}
+
+proc setPassProcs {pass} {
+ variable PassProcs
+ foreach {proc args body} $PassProcs($pass) {
+ proc $proc $args $body
+ }
+}
+
+# holdBuffers buffer ? buffer ...? --
+# Declare a list of hold buffers,
+# to collect data in one pass and output it later.
+#
+proc holdBuffers {args} {
+ variable Buffers
+ foreach arg $args {
+ set Buffers($arg) [list]
+ }
+}
+
+# hold buffer text --
+# Append text to named buffer
+#
+proc hold {buffer entry} {
+ variable Buffers
+ lappend Buffers($buffer) $entry
+ return
+}
+
+# held buffer --
+# Returns current contents of named buffer and empty the buffer.
+#
+proc held {buffer} {
+ variable Buffers
+ set content [join $Buffers($buffer) "\n"]
+ set Buffers($buffer) [list]
+ return $content
+}
+
+#*EOF*
diff --git a/tools/setversion b/tools/setversion
new file mode 100755
index 0000000..c71c15f
--- /dev/null
+++ b/tools/setversion
@@ -0,0 +1,112 @@
+#!/bin/sh
+# -*- tcl -*- \
+exec tclsh "$0" ${1+"$@"}
+
+# Insert version and other information into a number of files.
+
+global trouble
+set trouble 0
+
+# ============================================================
+# Generate the substitution map.
+
+proc mapdef {k v} {
+ global map
+ set map(@${k}@) $v
+ return
+}
+
+proc map {} {
+ global map
+ set res [list]
+ foreach k [lsort [array names map]] {
+ lappend res $k $map($k)
+ }
+ return $res
+}
+
+# ============================================================
+
+proc svfile {fname patternlist} {
+ global trouble subst out
+ if {![file exists $fname]} {
+ puts stderr "File $fname: Does not exist"
+ set trouble 1
+ return
+ }
+
+ puts "Updating file $fname ..."
+
+ set fh [open $fname r]
+ set contents [read $fh]
+ close $fh
+
+ puts $out "svfile [list $fname] \{"
+
+ foreach {pattern current} $patternlist {
+ set newvalue [string map $subst $pattern]
+
+ puts $out " [list $pattern]"
+ puts $out " [list $newvalue]"
+
+ set contents [string map [list $current $newvalue] $contents]
+ }
+
+ puts $out "\}"
+
+ if {[catch {
+ set fh [open ${fname}.new w]
+ puts -nonewline $fh $contents
+ close $fh
+ }]} {
+ file delete -force ${fname}.new
+ puts stderr "Unable to write new contents of $fname"
+ set trouble 1
+ return
+ }
+ file rename -force ${fname}.new $fname
+ return
+}
+
+proc extension {name data} {
+ global pname
+ set pname $name
+}
+
+# ============================================================
+
+set v [lindex $argv 0]
+if {$v == {}} {
+ puts stderr "Usage: $argv0 major.minor(\[abp.\]patchlevel)?"
+ exit -1
+}
+
+regexp {([0-9]+)\.([0-9+])(([abp.])([0-9]+))?} $v \
+ -> major minor __ detail patchlevel
+
+source DESCRIPTION
+
+mapdef mDate [string toupper \
+ [clock format \
+ [clock seconds] -format "%b-%d-%Y"]]
+mapdef mFullVersion $v
+mapdef mMajor $major
+mapdef mMinor $minor
+mapdef mShortDosVersion $major$minor
+mapdef mVersion ${major}.$minor
+mapdef mName $pname
+
+
+# ============================================================
+
+set flistfile [file join [file dirname [info script]] svfiles]
+set newflist ${flistfile}.new
+set out [open ${flistfile}.new w]
+set subst [map]
+source $flistfile
+close $out
+
+## set trouble 1 ; # enforce that new file does not overwrite old
+if {!$trouble} {
+ file rename -force ${flistfile}.new ${flistfile}
+}
diff --git a/tools/sgmlparse.c b/tools/sgmlparse.c
new file mode 100644
index 0000000..d85806e
--- /dev/null
+++ b/tools/sgmlparse.c
@@ -0,0 +1,207 @@
+/*
+** This file contains code used to tokenize SGML.
+*/
+#include <stdio.h>
+#include <ctype.h>
+#include <string.h>
+#include <stdlib.h>
+#include <assert.h>
+#include "sgmlparse.h"
+
+#define stricmp strcasecmp
+
+/* These three pointers define certain special handlers. All whitespace
+** is sent to xSpaceHandler. Non-whitespace is given to xWordHandler.
+** Any markup that isn't specifically directed elsewhere is given
+** to xDefaultMarkupHandlers.
+*/
+static void (*xSpaceHandler)(const char*,void*);
+static void (*xWordHandler)(const char*,void*);
+static void (*xCommentHandler)(const char*,void*);
+static void (*xDefaultMarkupHandler)(int, const char**, void*);
+
+/* Each handler is stored in a hash table as an instance of the
+** following structure.
+*/
+typedef struct sgHandler Handler;
+struct sgHandler {
+ char *zName; /* Name of markup to handle */
+ void (*xHandler)(int, const char**, void*); /* Routine to do the work */
+ Handler *pCollide; /* Next handler with same hash */
+};
+
+/* The size of the handler hash table.
+** For best results, this should be a prime number which is larger than
+** the number of markups in the hash table.
+*/
+#define SGML_HASH_SIZE 203
+
+/* The handler hash table */
+static Handler *apHandler[SGML_HASH_SIZE];
+
+/* Hash a handler name */
+static int SgmlHash(const char *zName){
+ int h = 0;
+ char c;
+ while( (c=*zName)!=0 ){
+ if( isupper(c) ) c = tolower(c);
+ h = h<<5 ^ h ^ c;
+ zName++;
+ }
+ if( h<0 ) h = -h;
+ return h % SGML_HASH_SIZE;
+}
+
+/* Given a pointer to an input file, read and parse that file
+** as if it were SGML.
+**
+** This is not a true SGML parser because it handles some unusual
+** cases differently, and ignores the & operator completely.
+*/
+void SgmlParse(FILE *in, void *pArg){
+ int c;
+ int i, j;
+ int argc;
+ Handler *pHandler;
+ char *argv[100];
+ char zBuf[10000];
+
+ c = getc(in);
+ while( c!=EOF ){
+ if( isspace(c) ){
+ /* Case 1: spaces */
+ zBuf[0] = c;
+ i = 1;
+ while( i<sizeof(zBuf)-2 && (c=getc(in))!=EOF && isspace(c) ){
+ zBuf[i++] = c;
+ }
+ zBuf[i] = 0;
+ /* Dispose of space */
+ if( xSpaceHandler ){
+ (*xSpaceHandler)(zBuf,pArg);
+ }
+ }else if( c=='<' ){
+ int cQuote = 0;
+ i = 0;
+ zBuf[i++] = c;
+ while( (c=getc(in))!=EOF && (cQuote || c!='>') ){
+ if( i<sizeof(zBuf)-3 ) zBuf[i++] = c;
+ if( cQuote ){
+ if( cQuote==c ) cQuote = 0;
+ }else if( c=='"' || c=='\'' ){
+ cQuote = c;
+ }
+ }
+ if( c=='>' ) c = getc(in);
+ zBuf[i] = 0;
+ if( strncmp(zBuf,"<!--",4)==0 ){
+ zBuf[i++] = '>';
+ zBuf[i] = 0;
+ if( xCommentHandler ){
+ (*xCommentHandler)(zBuf,pArg);
+ }
+ continue;
+ }
+ argc = 0;
+ argv[0] = &zBuf[1];
+ for(j=1; zBuf[j] && !isspace(zBuf[j]); j++){}
+ if( zBuf[j] ){
+ zBuf[j++] = 0;
+ while( argc<(sizeof(argv)/sizeof(argv[0])) - 4 && zBuf[j] ){
+ while( isspace(zBuf[j]) ) j++;
+ argv[++argc] = &zBuf[j];
+ while( zBuf[j] && !isspace(zBuf[j]) && zBuf[j]!='=' ) j++;
+ if( zBuf[j]!='=' ){
+ argv[argc+1] = argv[argc];
+ argc++;
+ if( zBuf[j] ) zBuf[j++] = 0;
+ continue;
+ }
+ zBuf[j++] = 0;
+ if( zBuf[j]=='"' || zBuf[j]=='\'' ){
+ cQuote = zBuf[j++];
+ }else{
+ cQuote = 0;
+ }
+ argv[++argc] = &zBuf[j];
+ if( cQuote ){
+ while( zBuf[j] && zBuf[j]!=cQuote ) j++;
+ }else{
+ while( zBuf[j] && !isspace(zBuf[j]) ) j++;
+ }
+ if( zBuf[j] ) zBuf[j++] = 0;
+ }
+ }
+ argv[++argc] = 0;
+ /* Despose of a markup */
+ pHandler = apHandler[SgmlHash(argv[0])];
+ while( pHandler && stricmp(pHandler->zName,argv[0])!=0 ){
+ pHandler = pHandler->pCollide;
+ }
+ if( pHandler ){
+ if( pHandler->xHandler ){
+ (*pHandler->xHandler)(argc,(const char**)argv,pArg);
+ }
+ }else if( xDefaultMarkupHandler ){
+ (*xDefaultMarkupHandler)(argc,(const char**)argv,pArg);
+ }
+ }else{
+ zBuf[0] = c;
+ i = 1;
+ while( i<sizeof(zBuf)-2 && (c=getc(in))!=EOF && c!='<' && !isspace(c) ){
+ zBuf[i++] = c;
+ }
+ zBuf[i] = 0;
+ /* Dispose of a word */
+ if( xWordHandler ){
+ (*xWordHandler)(zBuf,pArg);
+ }
+ }
+ }
+}
+
+/*
+** Clear out the handler hash table
+*/
+void SgmlHandlerReset(void){
+ Handler *pHandler;
+ int i;
+
+ for(i=0; i<SGML_HASH_SIZE; i++){
+ Handler *pNext;
+ for(pHandler=apHandler[i]; pHandler; pHandler=pNext){
+ pNext = pHandler->pCollide;
+ free(pHandler);
+ }
+ apHandler[i] = 0;
+ }
+}
+
+/* Install a new handler
+*/
+void SgmlHandler(const char *zName, void (*xFunc)(int,const char**,void*)){
+ int h = SgmlHash(zName);
+ extern void *malloc();
+ Handler *pNew = malloc( sizeof(Handler) + strlen(zName) + 1 );
+ if( pNew==0 ) return;
+ pNew->zName = (char*)&pNew[1];
+ strcpy(pNew->zName,zName);
+ pNew->pCollide = apHandler[h];
+ pNew->xHandler = xFunc;
+ apHandler[h] = pNew;
+}
+
+/* Install the default handlers
+*/
+void SgmlWordHandler(void (*xWord)(const char*,void*)){
+ xWordHandler = xWord;
+}
+void SgmlSpaceHandler(void (*xSpace)(const char*,void*)){
+ xSpaceHandler = xSpace;
+}
+void SgmlCommentHandler(void (*xComment)(const char*,void*)){
+ xCommentHandler = xComment;
+}
+void SgmlDefaultMarkupHandler(void (*xMarkup)(int,const char**,void*)){
+ xDefaultMarkupHandler = xMarkup;
+}
diff --git a/tools/structure b/tools/structure
new file mode 100755
index 0000000..329aa11
--- /dev/null
+++ b/tools/structure
@@ -0,0 +1,10 @@
+
+/home/groups/m/me/memchan/
+ htdocs
+ art
+ raw
+ state
+ tools
+
+ memchan - cvs watch copy
+
diff --git a/tools/svfiles b/tools/svfiles
new file mode 100644
index 0000000..66b8182
--- /dev/null
+++ b/tools/svfiles
@@ -0,0 +1,110 @@
+svfile DESCRIPTION {
+ { version @mFullVersion@}
+ { version 2.2a4}
+ { date {@mDate@}}
+ { date {AUG-20-2002}}
+}
+svfile LSM {
+ {Version: @mFullVersion@}
+ {Version: 2.2a4}
+ {Entered-date: @mDate@}
+ {Entered-date: AUG-20-2002}
+}
+svfile ANNOUNCE {
+ {I hereby announce @mName@ @mFullVersion at .}
+ {I hereby announce memchan 2.2a4.}
+ { @mDate@}
+ { AUG-20-2002}
+}
+svfile ANNOUNCE.MAIL {
+ {Subject: @mName@ @mFullVersion@}
+ {Subject: memchan 2.2a4}
+}
+svfile README {
+ { (Version @mFullVersion@ / @mDate@)}
+ { (Version 2.2a4 / AUG-20-2002)}
+ {Memchan @mFullVersion@ is developed for}
+ {Memchan 2.2a4 is developed for}
+}
+svfile win/README {
+ { (Version @mFullVersion@ / @mDate@)}
+ { (Version 2.2a4 / AUG-20-2002)}
+ { Memchan @mFullVersion@ Source Distribution}
+ { Memchan 2.2a4 Source Distribution}
+}
+svfile mac/README {
+ { (Version @mFullVersion@ / @mDate@)}
+ { (Version 2.2a4 / AUG-20-2002)}
+}
+svfile unix/configure.in {
+ MEMCHAN_VERSION=@mFullVersion@
+ MEMCHAN_VERSION=2.2a4
+ MEMCHAN_MAJOR_VERSION=@mMajor@
+ MEMCHAN_MAJOR_VERSION=2
+ MEMCHAN_MINOR_VERSION=@mMinor@
+ MEMCHAN_MINOR_VERSION=2
+}
+svfile unix/Makefile.in {
+ {# This file is a Makefile for MEMCHAN @mFullVersion at .}
+ {# This file is a Makefile for MEMCHAN 2.2a4.}
+ {# Distribution as of @mDate@}
+ {# Distribution as of AUG-20-2002}
+ {VERSION = @mFullVersion@}
+ {VERSION = 2.2a4}
+}
+svfile configure.in {
+ {# Configure script for package '@mName@', as distributed at @mDate at .}
+ {# Configure script for package 'memchan', as distributed at AUG-20-2002.}
+ MAJOR_VERSION=@mMajor@
+ MAJOR_VERSION=2
+ MINOR_VERSION=@mMinor@
+ MINOR_VERSION=2
+}
+svfile pkgIndex.tcl {
+ {bin Memchan at mShortDosVersion@}
+ {bin Memchan22}
+ {dir libMemchan at mVersion@}
+ {dir libMemchan2.2}
+ {ifneeded Memchan @mVersion@}
+ {ifneeded Memchan 2.2}
+}
+svfile win/mc.rc {
+ {VALUE "OriginalFilename", "Memchan at mShortDosVersion@.dll\0"}
+ {VALUE "OriginalFilename", "Memchan22.dll\0"}
+ {VALUE "FileVersion", "@mVersion@"}
+ {VALUE "FileVersion", "2.2"}
+ {VALUE "ProductName", "Memchan @mVersion@ for Windows\0"}
+ {VALUE "ProductName", "Memchan 2.2 for Windows\0"}
+ {VALUE "ProductVersion", "@mVersion@"}
+ {VALUE "ProductVersion", "2.2"}
+}
+svfile win/Makefile.gnu {
+ {Memchan @mFullVersion@ (as of @mDate@)}
+ {Memchan 2.2a4 (as of AUG-20-2002)}
+ {VERSION = @mFullVersion@}
+ {VERSION = 2.2a4}
+ {MEMCHAN_DLL_FILE= memchan at mShortDosVersion@.dll}
+ {MEMCHAN_DLL_FILE= memchan22.dll}
+}
+svfile win/makefile.vc {
+ {makefile for memchan @mFullVersion@ (as of @mDate@)}
+ {makefile for memchan 2.2a4 (as of AUG-20-2002)}
+ {MC = memchan at mShortDosVersion@}
+ {MC = memchan22}
+ {DMEMCHAN_VERSION=\"@mFullVersion@\"}
+ {DMEMCHAN_VERSION=\"2.2a4\"}
+}
+svfile win/makefile.vc5 {
+ {makefile for Memchan @mFullVersion@ (@mDate@)}
+ {makefile for Memchan 2.2a4 (AUG-20-2002)}
+ {MC = memchan at mShortDosVersion@}
+ {MC = memchan22}
+ {DMEMCHAN_VERSION=\"@mFullVersion@\"}
+ {DMEMCHAN_VERSION=\"2.2a4\"}
+}
+svfile win/pkgIndex.tcl {
+ {ifneeded Memchan @mVersion@}
+ {ifneeded Memchan 2.2}
+ {dir memchan at mShortDosVersion@}
+ {dir memchan22}
+}
diff --git a/tools/url.c b/tools/url.c
new file mode 100644
index 0000000..677cbba
--- /dev/null
+++ b/tools/url.c
@@ -0,0 +1,268 @@
+/*
+** This file contains code use for resolving relative URLs
+*/
+#include <stdlib.h>
+#include "url.h"
+
+#if INTERFACE
+/*
+** A parsed URI is held in an instance of the following structure.
+** Each component is recorded in memory obtained from malloc().
+**
+** The examples are from the URI
+**
+** http://192.168.1.1:8080/cgi-bin/printenv?name=xyzzy&addr=none#frag
+*/
+typedef struct Url Url;
+struct Url {
+ char *zScheme; /* Ex: "http" */
+ char *zAuthority; /* Ex: "192.168.1.1:8080" */
+ char *zPath; /* Ex: "cgi-bin/printenv" */
+ char *zQuery; /* Ex: "name=xyzzy&addr=none" */
+ char *zFragment; /* Ex: "frag" */
+};
+#endif
+
+/*
+** Return the length of the next component of the URL in z[] given
+** that the component starts at z[0]. The initial sequence of the
+** component must be zInit[]. The component is terminated by any
+** character in zTerm[]. The length returned is 0 if the component
+** doesn't exist. The length includes the zInit[] string, but not
+** the termination character.
+**
+** Component zInit zTerm
+** ---------- ------- -------
+** scheme "" ":/?#"
+** authority "//" "/?#"
+** path "/" "?#"
+** query "?" "#"
+** fragment "#" ""
+*/
+static int ComponentLength(const char *z, const char *zInit, const char *zTerm){
+ int i, n;
+ for(n=0; zInit[n]; n++){
+ if( zInit[n]!=z[n] ) return 0;
+ }
+ while( z[n] ){
+ for(i=0; zTerm[i]; i++){
+ if( z[n]==zTerm[i] ) return n;
+ }
+ n++;
+ }
+ return n;
+}
+
+/*
+** Duplicate a string of length n.
+*/
+static char *StrNDup(const char *z, int n){
+ char *zResult;
+ if( n<=0 ){
+ n = strlen(z);
+ }
+ zResult = malloc( n + 1 );
+ if( zResult ){
+ memcpy(zResult, z, n);
+ zResult[n] = 0;
+ }
+ return zResult;
+}
+
+/*
+** Parse a text URI into an Url structure.
+*/
+Url *ParseUrl(const char *zUri){
+ Url *p;
+ int n;
+
+ p = malloc( sizeof(*p) );
+ if( p==0 ) return 0;
+ memset(p, 0, sizeof(*p));
+ if( zUri==0 || zUri[0]==0 ) return p;
+ while( isspace(zUri[0]) ){ zUri++; }
+ n = ComponentLength(zUri, "", ":/?# ");
+ if( n>0 && zUri[n]==':' ){
+ p->zScheme = StrNDup(zUri, n);
+ zUri += n+1;
+ }
+ n = ComponentLength(zUri, "//", "/?# ");
+ if( n>0 ){
+ p->zAuthority = StrNDup(&zUri[2], n-2);
+ zUri += n;
+ }
+ n = ComponentLength(zUri, "", "?# ");
+ if( n>0 ){
+ p->zPath = StrNDup(zUri, n);
+ zUri += n;
+ }
+ n = ComponentLength(zUri, "?", "# ");
+ if( n>0 ){
+ p->zQuery = StrNDup(&zUri[1], n-1);
+ zUri += n;
+ }
+ n = ComponentLength(zUri, "#", " ");
+ if( n>0 ){
+ p->zFragment = StrNDup(&zUri[1], n-1);
+ }
+ return p;
+}
+
+/*
+** Delete an Url structure.
+*/
+void FreeUrl(Url *p){
+ if( p==0 ) return;
+ if( p->zScheme ) free(p->zScheme);
+ if( p->zAuthority ) free(p->zAuthority);
+ if( p->zPath ) free(p->zPath);
+ if( p->zQuery ) free(p->zQuery);
+ if( p->zFragment ) free(p->zFragment);
+ free(p);
+}
+
+/*
+** Create a string to hold the given URI. Memory to hold the string
+** is obtained from malloc() and must be freed by the calling
+** function.
+*/
+char *BuildUrl(Url *p){
+ int n = 1;
+ char *z;
+ if( p->zScheme ) n += strlen(p->zScheme)+1;
+ if( p->zAuthority ) n += strlen(p->zAuthority)+2;
+ if( p->zPath ) n += strlen(p->zPath)+1;
+ if( p->zQuery ) n += strlen(p->zQuery)+1;
+ if( p->zFragment ) n += strlen(p->zFragment)+1;
+ z = malloc( n );
+ if( z==0 ) return 0;
+ n = 0;
+ if( p->zScheme ){
+ sprintf(z, "%s:", p->zScheme);
+ n = strlen(z);
+ }
+ if( p->zAuthority ){
+ sprintf(&z[n], "//%s", p->zAuthority);
+ n += strlen(&z[n]);
+ }
+ if( p->zPath ){
+ sprintf(&z[n], "%s", p->zPath);
+ n += strlen(&z[n]);
+ }
+ if( p->zQuery ){
+ sprintf(&z[n], "?%s", p->zQuery);
+ n += strlen(&z[n]);
+ }
+ if( p->zFragment ){
+ sprintf(&z[n], "#%s", p->zFragment);
+ }
+ return z;
+}
+
+/*
+** Replace the string in *pzDest with the string in zSrc
+*/
+static void ReplaceStr(char **pzDest, const char *zSrc){
+ if( *pzDest!=0 ) free(*pzDest);
+ if( zSrc==0 ){
+ *pzDest = 0;
+ }else{
+ *pzDest = StrNDup(zSrc, -1);
+ }
+}
+
+/*
+** Remove leading and trailing spaces from the given string. Return
+** a new string obtained from malloc().
+*/
+static char *Trim(char *z){
+ int i;
+ char *zNew;
+ while( isspace(*z) ) z++;
+ i = strlen(z);
+ zNew = malloc( i+1 );
+ if( zNew==0 ) return 0;
+ strcpy(zNew, z);
+ if( i>0 && isspace(zNew[i-1]) ){
+ i--;
+ zNew[i] = 0;
+ }
+ return zNew;
+}
+
+/*
+** Resolve a sequence of URLs. Return the result in space obtained
+** from malloc().
+*/
+char *ResolveUrl(
+ char *zBase, /* The base URL */
+ const char **azSeries /* A list of relatives. NULL terminated */
+){
+ Url *base;
+ Url *term;
+ char *z;
+
+ base = ParseUrl(zBase);
+ while( azSeries[0] ){
+ term = ParseUrl(azSeries[0]);
+ azSeries++;
+ if( term->zScheme==0 && term->zAuthority==0 && term->zPath==0
+ && term->zQuery==0 && term->zFragment ){
+ ReplaceStr(&base->zFragment, term->zFragment);
+ }else if( term->zScheme ){
+ Url temp;
+ temp = *term;
+ *term = *base;
+ *base = temp;
+ }else if( term->zAuthority ){
+ ReplaceStr(&base->zAuthority, term->zAuthority);
+ ReplaceStr(&base->zPath, term->zPath);
+ ReplaceStr(&base->zQuery, term->zQuery);
+ ReplaceStr(&base->zFragment, term->zFragment);
+ }else if( term->zPath && term->zPath[0]=='/' ){
+ ReplaceStr(&base->zPath, term->zPath);
+ ReplaceStr(&base->zQuery, term->zQuery);
+ ReplaceStr(&base->zFragment, term->zFragment);
+ }else if( term->zPath && base->zPath ){
+ char *zBuf;
+ int i, j;
+ zBuf = malloc( strlen(base->zPath) + strlen(term->zPath) + 2 );
+ if( zBuf ){
+ sprintf(zBuf,"%s", base->zPath);
+ for(i=strlen(zBuf)-1; i>=0 && zBuf[i]!='/'; i--){ zBuf[i] = 0; }
+ strcat(zBuf, term->zPath);
+ for(i=0; zBuf[i]; i++){
+ if( zBuf[i]=='/' && zBuf[i+1]=='.' && zBuf[i+2]=='/' ){
+ strcpy(&zBuf[i+1], &zBuf[i+3]);
+ i--;
+ continue;
+ }
+ if( zBuf[i]=='/' && zBuf[i+1]=='.' && zBuf[i+2]==0 ){
+ zBuf[i+1] = 0;
+ continue;
+ }
+ if( i>0 && zBuf[i]=='/' && zBuf[i+1]=='.' && zBuf[i+2]=='.'
+ && (zBuf[i+3]=='/' || zBuf[i+3]==0) ){
+ for(j=i-1; j>=0 && zBuf[j]!='/'; j--){}
+ if( zBuf[i+3] ){
+ strcpy(&zBuf[j+1], &zBuf[i+4]);
+ }else{
+ zBuf[j+1] = 0;
+ }
+ i = j-1;
+ if( i<-1 ) i = -1;
+ continue;
+ }
+ }
+ free(base->zPath);
+ base->zPath = zBuf;
+ }
+ ReplaceStr(&base->zQuery, term->zQuery);
+ ReplaceStr(&base->zFragment, term->zFragment);
+ }
+ FreeUrl(term);
+ }
+ z = BuildUrl(base);
+ FreeUrl(base);
+ return z;
+}
diff --git a/tools/watch_cvs b/tools/watch_cvs
new file mode 100755
index 0000000..e25825a
--- /dev/null
+++ b/tools/watch_cvs
@@ -0,0 +1,28 @@
+#!/bin/sh
+# Watch the CVS repository for changes in memchan, retrieve the
+# changed files and invoke the handler script which propagate the
+# changes to other parts of the system.
+
+cd `dirname $0`/..
+
+export CVSROOT
+CVSROOT=:pserver:anonymous at cvs.memchan.sourceforge.net:/cvsroot/memchan
+
+if [ 0 -lt `cvs diff memchan 2>/dev/null | wc -l` ]
+then
+ out=$HOME/logs/memchan
+ mkdir -p `dirname $out`
+
+ cvs co memchan >$out 2>&1
+ mkdir -p memchan/htdocs/state
+
+ # Use a new htdocs_setup script immediately.
+ # Without this copying it would take effect
+ # only after with the change after the current
+ # one.
+
+ cp ./memchan/tools/htdocs_setup ./tools_setup
+
+ (sleep 60 ; ./tools/htdocs_setup ) &
+fi
+exit
diff --git a/webpage/common.tcl b/webpage/common.tcl
index d5c81a7..ec4065f 100644
--- a/webpage/common.tcl
+++ b/webpage/common.tcl
@@ -48,9 +48,12 @@ proc getTabs {idx} {
Home index.html "Front page of this site" \
Standards support.html "Summary of support for CSS and HTML standards" \
"Tkhtml3" tkhtml.html "Unix style manual page for the Tkhtml3 widget." \
- Hv3 hv3.html {
+ "Hv3" hv3.html {
Page for the web browser application hv3. Screenshots and
starpacks for windows and linux are available here. } \
+ "Hv3 Widget" hv3_widget.html {
+ Page for the Hv3 mega-widget, a Snit based pure Tcl widget
+ that adds some commonly requested functionality to Tkhtml3. } \
FFAQ ffaq.html "tkhtml.tcl.tk FFAQ" \
Cvstrac http://tkhtml.tcl.tk/cvstrac/timeline {
Cvstrac is used for project change-log, wiki and bug
diff --git a/webpage/mkffaqpage.tcl b/webpage/mkffaqpage.tcl
index 1425b5d..b7d19e2 100644
--- a/webpage/mkffaqpage.tcl
+++ b/webpage/mkffaqpage.tcl
@@ -91,7 +91,7 @@ puts [subst {
</head>
<body>
-[getTabs 4]
+[getTabs 5]
<div id="body">
<h1>tkhtml.tcl.tk FFAQ</h1>
diff --git a/webpage/mksupportpage.tcl b/webpage/mksupportpage.tcl
index 79689ff..1bbbd18 100644
--- a/webpage/mksupportpage.tcl
+++ b/webpage/mksupportpage.tcl
@@ -85,11 +85,11 @@ SECTION "CSS Property Support"
P {
<p>
- The tables in this section compare CSS property support in Tkhtml3 with
- the <a href="http://www.w3.org/TR/CSS21/">CSS level 2.1</a>
- specification. Property names in blue are supported, those in grey
- are unsupported. Of course, there may be bugs in the support of
- any or all of these. If you find a bug, <i>please report it</i>!
+ The tables in this section compare CSS property support in Tkhtml3
+ with the <a href="http://www.w3.org/TR/CSS21/">CSS level 2.1</a>
+ specification. Of course, there may be bugs in the support of
+ any or all of the properties listed as supported below. If you find a
+ bug, <i>please report it</i>!
</p>
}
@@ -130,10 +130,7 @@ SUPPORTTABLE {Text Properties} \
Value 'blink' is not supported. Also, multiple decorations
(e.g. an underline and an overline) are not supported.
} \
- [CSSREF text vertical-align] {
- No support for the following values: 'top', 'bottom'.
- All other symbolic values, percentages and lengths work.
- } \
+ [CSSREF text vertical-align] {} \
[CSSREF text text-transform nosupport] {No support.} \
[CSSREF text text-align] {} \
[CSSREF text text-indent] {} \
@@ -220,9 +217,12 @@ SUPPORTTABLE {Generated Content Properties} \
[CSSREF generate list-style-image] {} \
[CSSREF generate list-style-position] {} \
[CSSREF generate list-style] {} \
- [CSSREF generate content] {String values only. } \
- [CSSREF generate counter-increment nosupport] {No support.} \
- [CSSREF generate counter-reset nosupport] {No support.} \
+ [CSSREF generate content] {String, attr(), counter() and counters()
+ values work. There is no support for url(), or the keywords
+ for automatic quotes generation.
+ } \
+ [CSSREF generate counter-increment] {} \
+ [CSSREF generate counter-reset] {} \
[CSSREF generate quotes nosupport] {No support.}
# List of CSS 2.1 properties considered out of scope for Tkhtml.
@@ -257,7 +257,6 @@ P {
the following pseudo-elements:
</p>
<ul>
- <li> :first-child
<li> :first-letter
<li> :first-line
<li> :lang
--
Render HTML and CSS content with tk
More information about the debian-science-commits
mailing list