tcldoc update (new PDF doc + tlpkg-ctan-check)

git-svn-id: svn://tug.org/texlive/trunk@21959 c570f23f-e606-0410-a88d-b1316a301751

5 files changed, 2100 insertions, 0 deletions

diff --git a/Master/texmf-dist/doc/latex/tcldoc/examples/README.txt b/Master/texmf-dist/doc/latex/tcldoc/examples/README.txt
new file mode 100644
index 00000000000..2d3d8abe5da
--- /dev/null
+++ b/Master/texmf-dist/doc/latex/tcldoc/examples/README.txt
@@ -0,0 +1,40 @@
+README for the parsetcl and writepdf packages:
+==============================================
+
+The parsetcl package implements basic parsing
+of Tcl scripts, and is written completely in
+Tcl. To generate parsetcl.tcl, run LaTeX on
+parsetcl.ins. To typeset the documentation, 
+run LaTeX on parsetcl.dtx. To see an example
+of what it does, you can try the following 
+commands in a Tcl shell:
+
+   source parsetcl.tcl
+   auto_load parray
+   set tree [parsetcl::simple_parse_script [info body parray]]
+   parsetcl::format_tree $tree {} {   }
+
+The tree variable will be set to a parser tree
+for the body of the parray procedure. The last 
+command reformats this tree (mostly replacing 
+whitespace between list elements) to make the 
+structure more visible.
+
+
+The writepdf package is written completely in 
+Tcl and provides basic commands for writing 
+well-formed PDF files. To generate writepdf.tcl, 
+run LaTeX on pdf.ins. To typeset the 
+documentation, run LaTeX on pdf.dtx. To see an 
+example of what it does, you can try the following 
+commands in a Tcl shell:
+
+   source writepdf.tcl
+   source hellopdf.tcl
+
+This will generate a file hello.pdf that contains
+a single page with the two words "Hello world!".
+
+
+Lars Hellström,
+20 July 2003
diff --git a/Master/texmf-dist/doc/latex/tcldoc/examples/parsetcl.dtx b/Master/texmf-dist/doc/latex/tcldoc/examples/parsetcl.dtx
new file mode 100644
index 00000000000..22609d6fa4e
--- /dev/null
+++ b/Master/texmf-dist/doc/latex/tcldoc/examples/parsetcl.dtx
@@ -0,0 +1,1155 @@
+%
+% \iffalse
+%<*driver>
+\documentclass{tclldoc}
+
+\newcommand{\ParseTcl}{Parse\Tcllogo}
+\providecommand{\href}[2]{#2}
+
+\begin{document}
+\DocInput{parsetcl.dtx}
+\end{document}
+%</driver>
+% \fi
+%
+% 
+% \title{\ParseTcl\ --- a parser for \Tcllogo\ code}
+% \author{Lars Hellstr\"om}
+% 
+% \maketitle
+% 
+% 
+% \begin{abstract}
+%   \ParseTcl\ is a \Tcllogo\ package for parsing \Tcllogo\ code. 
+%   It is written completely in \Tcllogo, and make heavy use of some 
+%   new additions in \Tcllogo\,8.4.
+% \end{abstract}
+% 
+% \begin{tcl}
+%<*pkg>
+namespace eval parsetcl {}
+package require Tcl 8.4
+package provide parsetcl 0.1
+% \end{tcl}
+% \setnamespace{parsetcl}
+% 
+% \tableofcontents
+% 
+% \section{Parser results}
+% 
+% The values returned by the parser are conceptually rooted trees, but 
+% technically the return values are lists. The general format of a 
+% subtree is
+% \begin{quote}
+%   \word{type} \word{interval} \word{text} \word{subtree}\regstar
+% \end{quote}
+% where there is one \word{subtree} for each component that remains if 
+% the root of the subtree under consideration is deleted. The 
+% \word{type} specifies what kind of construction the subtree 
+% corresponds to. The \word{interval} is a list with the structure
+% \begin{quote}
+%   \word{first} \word{last}
+% \end{quote}
+% where \word{first} and \word{last} are integers; the indices into 
+% the input string of the first and last respectively character that 
+% corresponds to this part of the parser tree. The \word{text} is, 
+% depending on the \word{type}, either empty or the explicit string 
+% that corresponds to this subtree.
+% 
+% The \word{type}s are generally two-character strings, where the first 
+% letter specifies a major category and the second letter an exact type 
+% within that category, but this system is not enforced by any code.
+% \begin{description}
+%   \item[Null types]
+%     The \emph{null} types all begin with an |N|. These correspond to 
+%     information which isn't part of the script proper, but still is 
+%     useful to include in the parse result. It is generally possible 
+%     to add or remove subtrees of this type without changing the 
+%     meaning of the reconstruction of the script.
+%     \begin{enumerate}
+%       \item[\texttt{Nc}] \describestring[subtree type]{Nc}
+%         This type is for comments, and it normally appears only in 
+%         places where one would expect a command subtree. The 
+%         \word{interval} includes the |#| beginning the comment, but not 
+%         the newline ending it. The \word{text} is the text in the 
+%         comment (initial |#| not included).
+%       \item[\texttt{Ne}] \describestring[subtree type]{Ne}
+%         This type is for syntax errors; rather than stopping at every 
+%         error, the parser routines will try to recover as best they can, 
+%         and an error item will be inserted in the parser tree. This 
+%         type of item generally appears as a \word{subtree} of whatever 
+%         was being parsed when the error was detected. The \word{text} is 
+%         a human-readable error message. The \word{interval} specifies 
+%         the erroneous characters; if the error is that some character(s) 
+%         is missing then the end of the interval is the index of the 
+%         character before that which is missing, and the start of the 
+%         interval is the character after that which is missing.
+%       \item[\texttt{Np}] \describestring[subtree type]{Np}
+%         This type is merely a placeholder; both the \word{interval} and 
+%         the \word{text} are empty strings. It is used when there was 
+%         nothing to return, but call syntax requires that a subtree is 
+%         returned. If some call returns an item of this type then it 
+%         usually means that its caller also has reached the end of 
+%         whatever that was parsing.
+%     \end{enumerate}
+%     
+%   \item[Literate types]
+%     The literate, or verbatim, types all begin with an |L|. Words (of 
+%     a command) where no variable or command substitution will happen 
+%     usually belong in this category. There are three types of 
+%     literates: \describestring[subtree type]{Lb}|Lb|s are delimited by 
+%     braces and \describestring[subtree type]{Lq}|Lq|s are delimited by 
+%     quotes, whereas \describestring[subtree type]{Lr}|Lr|s have no 
+%     particular delimiters. In each case, the \word{text} is the string 
+%     that this interval of the input gets parsed into.
+%     
+%     Backslash--newline substitution is silently performed, but other 
+%     types of substitution will result in that the item is considered 
+%     to consist of one or more parts, each of which will be 
+%     represented as a separate \word{subtree}. The delimiting quotes 
+%     of an |Lq| is never included in the \word{interval} of any 
+%     \word{subtree}. An |Lb| never has any \word{subtree}s due to 
+%     substitution, since it can only be subject to backslash--newline 
+%     substitution, but it may have |Ne| subtrees.
+%     
+%   \item[Merge types]
+%     The merge types all begin with an |M|. They are similar to the 
+%     literate types, but are used for intervals of the input for which 
+%     the \emph{text} cannot be completely determined. 
+%     \describestring[subtree type]{Mq}|Mq|s are delimited by quotes, 
+%     whereas \describestring[subtree type]{Mr}|Mr|s have no particular 
+%     delimiters. The \word{text} is set to an empty string. There is 
+%     always at least one \word{subtree}.
+%     
+%   \item[Substitution types]
+%     The substitution types all begin with an |S|. As the name 
+%     indicates, they are used for intervals of the input that will be 
+%     substituted by a \Tcllogo\ parser.
+%     \begin{enumerate}
+%       \item[\texttt{Sb}] \describestring[subtree type]{Sb}
+%         This type is for backslash substitution. The \word{text} is 
+%         the character produced by this substitution. There is always 
+%         an |Lr| subtree for the text following the initial backslash.
+%       \item[\texttt{Sv}] \describestring[subtree type]{Sv}
+%         This type is for scalar variable substitution. The 
+%         \word{text} is empty, and there is one \word{subtree} for the 
+%         name of the variable being substituted. The type of this 
+%         subtree is either |Lr| or |Lb|, depending on whether the name 
+%         is surrounded by braces or not.
+%       \item[\texttt{Sa}] \describestring[subtree type]{Sa}
+%         This type is for array variable substitution. The 
+%         \word{text} is empty, and there are two \word{subtree}s: one 
+%         for the name of the array (always an |Lr|) and one for the 
+%         index into the array (either an |Lr| or an |Mr|).
+%       \item[\texttt{Sc}] \describestring[subtree type]{Sc}
+%         This type is for command substitution. The \word{text} is 
+%         empty, and there is one \word{subtree} for each command in 
+%         the script.
+%     \end{enumerate}
+%     
+%   \item[The command type]
+%     The \describestring[subtree type]{Cd}|Cd| type is for complete 
+%     commands. The \word{text} is empty, and each word in the command 
+%     has its own \word{subtree} (naturally, these are in the order of 
+%     the words in the command).
+%     
+%   \item[Root types]
+%     The root types are used for the root in a parser tree, but they 
+%     may also appear as proper subtrees if the parser is invoked 
+%     recursively. This is for example what one does with the body 
+%     argument of the |while| command: technically it is a string just 
+%     like any other string, but it makes most sense to parse that 
+%     string as a script and replace the original literate item by the 
+%     entire tree generated by parsing this string.
+%     
+%     The root types all begin with an |R|. They are
+%     \begin{enumerate}
+%       \item[\texttt{Rs}] \describestring[subtree type]{Rs}
+%         This type is for script parsing. The \word{text} is usually 
+%         empty, and each \word{subtree} is a command of the script.
+%       \item[\texttt{Rx}] \describestring[subtree type]{Rx}
+%         This type is for |expr| expression parsing.
+%     \end{enumerate}
+%   
+% \end{description}
+% 
+% \subsection{Some examples}
+% 
+% The script
+% \begin{quote}
+%   |set a "b\nc"|
+% \end{quote}
+% will be parsed as the list
+%\begin{verbatim}
+%   Rs {0 11} {} \
+%      {Cd {0 11} {}
+%         {Lr {0 2} set}
+%         {Lr {4 4} a}
+%         {Lq {6 11} b\nc
+%            {Lr {7 7} b}
+%            {Sb {8 9} \n {Lr {9 9} n}}
+%            {Lr {10 10} c}
+%         }
+%      }
+%\end{verbatim}
+% NB: This is not the canonical string representation, but one that was 
+% chosen for clarity of exposition. The |parsetcl::format_tree| 
+% procedure can be used to reformat a parser tree with indentation as 
+% shown above.
+% 
+% 
+% \section{Basic script parsing}
+% 
+% Basic script parsing makes a purely syntactic parsing of a script. It 
+% does not make any assumptions about the meaning of the commands used 
+% in the script, and hence it will not try to parse as scripts any  
+% argument of a commands (not even the byte-compiled commands).
+% 
+% The parsing relies on a set of procedures which parses the next item 
+% of a particular sort, and returns the corresponding parse subtree. 
+% These procedures can call each other recursively in complicated ways, 
+% following the actual structure of the script that is being parsed. 
+% The general syntax for calling such a procedure is
+% \begin{quote}
+%   \word{proc name} \word{string} \word{index-var-name} 
+%   \word{extra}\regstar
+% \end{quote}
+% where \word{string} is the string from which something should be 
+% parsed and \word{index-var-name} is the name of a variable in the 
+% local context of the caller which holds the index of the first 
+% character that hasn't been parsed yet (or possibly the last character 
+% that has been parsed, it may depend on what is most convenient for 
+% that particular procedure). There are two reasons for using this 
+% set-up. One is that the calling procedure usually needs to continue 
+% parsing the string after the part that it made a recursive call to 
+% have parsed, and for that purpose this variable provides a convenient 
+% method of returning the value. The other reason is one of efficiency: 
+% If the script as a whole is passed as an argument to all procedures 
+% that are involved in the parsing process, as opposed to passing only 
+% the part that hasn't been parsed yet, then the need to copy the data 
+% decreases drastically.
+% 
+% 
+% \subsection{Commands and scripts}
+% 
+% \begin{proc}{flush_whitespace}
+%   The |flush_whitespace| procedure advances the index past a 
+%   whitespace sequence. The syntax is
+%   \begin{quote}
+%     |parsetcl::flush_whitespace| \word{script} \word{index-var-name}
+%       \word{cmdsep}
+%   \end{quote}
+%   where \word{cmdsep} is |1| if command separators (newlines and 
+%   semicolons) should be flushed as well, but |0| if they should be 
+%   treated separately. The return value is the number of characters 
+%   that were flushed.
+%   \begin{tcl}
+proc parsetcl::flush_whitespace {script index_var cmdsep} {
+   upvar 1 $index_var index
+   if {[
+      if {$cmdsep} then {
+        regexp -start $index -- {\A([ \t-\r;]|\\\n)+} $script match
+      } else {
+        regexp -start $index -- {\A([ \t\v\f\r]|\\\n)+} $script match
+      }
+   ]} then {
+      incr index [string length $match]
+      return [string length $match]
+   } else {
+      return 0
+   }
+}
+%   \end{tcl}
+% \end{proc}
+% 
+% \begin{proc}{parse_command}
+%   The |parse_command| procedure parses the next command, returning a 
+%   |Cd|, |Nc|, or |Np| item to its caller. The syntax is
+%   \begin{quote}
+%     |parsetcl::parse_command| \word{script} \word{index-var-name}
+%     \word{nested}
+%   \end{quote}
+%   The \word{nested} argument is |1| if the context is that of command 
+%   substitution (in which case |]| acts as command terminator), and |0| 
+%   otherwise. Upon return, the index variable generally points to the 
+%   character that terminates the command.
+%   
+%   The procedure skips past any whitespace or command separators in front 
+%   of the actual command.
+%   \begin{tcl}
+proc parsetcl::parse_command {script index_var nested} {
+   upvar 1 $index_var index
+%   \end{tcl}
+%   The first step is to scan past the whitespace in front of the 
+%   command.
+%   \begin{tcl}
+   flush_whitespace $script index 1
+%   \end{tcl}
+%   Then there are two ``not a command'' cases to take care of: there 
+%   might be a comment or the command sequence might have ended. In the 
+%   former case, the extent of the comment is determined and a 
+%   corresponding |Nc| item is returned. Backslash--newline 
+%   substitution adds a bit complexity to the problem of finding the end 
+%   of the comment, since an escaped newline may be part of the comment, 
+%   although a backslash is only escaping if it isn't itself escaped.
+%   \begin{tcl}
+   switch -- "[string index $script $index]$nested" {#0} - {#1} {
+      regexp -start $index -indices -- {\A#([^\n\\]|\\.)*(\\$)?}\
+        $script interval
+      incr index
+      regsub -all -- {\\\n[ \t]*}\
+        [string range $script $index [lindex $interval 1]]\
+        { } text
+      set index [expr {[lindex $interval 1] + 1}]
+      return [list Nc $interval $text]
+   } 0 - 1 - \]1 {
+%   \end{tcl}
+%   In the latter case, an |Np| item is returned. It happens if 
+%   |$index| is past the last character in the string, but also if 
+%   |$index| is at a right bracket and the command is \word{nested}.
+%   \begin{tcl}
+      return [list Np "" ""]
+   }
+%   \end{tcl}
+%   But if we get this far, then there is a command to parse. One only 
+%   has to parse all the words.
+%   \begin{tcl}
+   set res [list Cd [list $index ""] ""]
+   set next [parse_word $script index $nested]
+   while {[lindex $next 0] ne "Np"} {
+      lappend res $next
+      set next [parse_word $script index $nested]
+   }
+   lset res 1 1 [lindex $res end 1 1]
+   return $res
+}
+%   \end{tcl}
+% \end{proc}
+% 
+% \begin{proc}{basic_parse_script}
+%   The |basic_parse_script| procedure parses a script (that is to say, a 
+%   sequence of commands) and returns the corresponding |Rs| item. 
+%   The syntax is
+%   \begin{quote}
+%     |parsetcl::basic_parse_script| \word{script}
+%   \end{quote}
+%   \begin{tcl}
+proc parsetcl::basic_parse_script {script} {
+   set index 0
+   set res [list Rs [list $index ""] ""]
+   while {[lindex [set next [parse_command $script index 0]] 0] ne "Np"} {
+      lappend res $next
+   }
+   incr index -1
+   lset res 1 1 $index
+   return $res
+}
+%   \end{tcl}
+% \end{proc}
+% 
+% 
+% \subsection{Parsing words}
+% 
+% \begin{proc}{parse_word}
+%   The |parse_word| procedure parses the next command word, returning 
+%   an |Lb|, |Lq|, |Lr|, |Mq|, |Mr|, or |Np| item to its caller. The 
+%   syntax is
+%   \begin{quote}
+%     |parsetcl::parse_word| \word{script} \word{index-var-name}
+%     \word{nested}
+%   \end{quote}
+%   The \word{nested} argument is |1| if the context is that of command 
+%   substitution (in which case |]| acts as command terminator), and |0| 
+%   otherwise. It is assumed that the index variable points to the first 
+%   character of the word when this procedure is called. Upon return, 
+%   the index variable points to the first none-whitespace character 
+%   (or command separator) after the word that was parsed.
+%   
+%   Most of the actual work is done by the helper procedures 
+%   |parse_raw_word|, |parse_quoted_word|, and |parse_braced_word|.
+%   \begin{tcl}
+proc parsetcl::parse_word {script index_var nested} {
+   upvar 1 $index_var index
+   switch -- [string index $script $index] \{ {
+      parse_braced_word $script index $nested
+   } \" {
+      parse_quoted_word $script index $nested
+   } "" - \; - \n {
+      list Np "" ""
+   } \] {
+      if {$nested} then {
+         list Np "" ""
+      } else {
+         parse_raw_word $script index $nested
+      }
+   } default {
+      parse_raw_word $script index $nested
+   }
+}
+%   \end{tcl}
+% \end{proc}
+% 
+% \begin{proc}{parse_braced_word}
+%   The |parse_braced_word| procedure parses a brace-delimited word and  
+%   returns the corresponding |Lb| item to its caller. The syntax is
+%   \begin{quote}
+%     |parsetcl::parse_braced_word| \word{script} \word{index-var-name}
+%     \word{nested}
+%   \end{quote}
+%   where the arguments and call conventions are as for |parse_word|. 
+%   In case the braced word is followed by some non-whitespace 
+%   characters, then this will be interpreted as though a space was 
+%   missing after the brace. A corresponding |Ne| subtree will be 
+%   attached to the |Lb| item returned, and the index variable will be 
+%   pointed to that none-whitespace character after the brace.
+%   \begin{tcl}
+proc parsetcl::parse_braced_word {script index_var nested} {
+   upvar 1 $index_var index
+   set res [list Lb [list $index ""]]
+   set depth 1
+   set text ""
+   incr index
+   while {$depth>0} {
+%   \end{tcl}
+%   Each iteration of this loop takes care of one non-trivial character 
+%   combination and whatever piece of trivial material that preceeds 
+%   it. Braces which are not escaped obviously constitute non-trivial 
+%   material (because they change the nesting depth), but escaped 
+%   newlines are also non-trivial (because they are subject to 
+%   substitution).
+%   \begin{tcl}
+      regexp -start $index -- {\A([^{}\\]|\\[^\n])*} $script match
+      append text $match
+      incr index [string length $match]
+      switch -- [string index $script $index] \{ {
+         incr depth
+         incr index
+      } \} {
+         incr depth -1
+         incr index
+      } \\ {
+         if {[regexp -start $index -- {\A\\\n[ \t]*} $script match]}\
+         then {
+            incr index [string length $match]
+            append text { }
+         } else {
+%   \end{tcl}
+%   In this (rather curious) case, the \word{script} ended with an 
+%   escaping backslash, but there is nothing to escape. This is 
+%   interpreted as just the backslash. However, there will be an error 
+%   since the braces apparently haven't been properly balanced.
+%   \begin{tcl}
+            append text \\
+            break
+         }
+      } "" {
+         break
+      }
+   }
+   if {$depth>0} then {
+      lset res 1 1 $index
+      lappend res $text [list Ne [list "" $index] {missing close-brace}]
+      lset res 3 1 0 [incr index]
+      return $res
+   }
+   lset res 1 1 [expr {$index - 1}]
+   lappend res $text
+%   \end{tcl}
+%   What remains now is to check that there aren't any stray characters 
+%   following the close-brace. If there is whitespace to flush then 
+%   everything is alright. Things are also alright if the next character 
+%   is a command terminator or we're at the end of the string.
+%   \begin{tcl}
+   if {[flush_whitespace $script index 0]} then {return $res}
+   switch -- [string index $script $index] \n - \; - {} {
+      return $res
+   } \] {
+      if {$nested} then {return $res}
+   }
+%   \end{tcl}
+%   But if that is not the case then there is an error, and an |Ne| item 
+%   should be appended to |res|. The exact appearence of this item does 
+%   however depend on how the parser attempts to recover from the error, 
+%   and that is not immediately obvious. The \Tcllogo\ parser makes no 
+%   attempt to recover---and can therefore report the error as ``extra 
+%   characters after close-brace''---but the best way to recover rather 
+%   seems to be to assume that a space is missing. That is why the 
+%   following error message is non-standard.
+%   \begin{tcl}
+   lappend res [list Ne [list $index [expr {$index - 1}]]\
+     {missing space after close-brace}]
+   return $res
+}
+%   \end{tcl}
+% \end{proc}
+% 
+% \begin{proc}{parse_quoted_word}
+%   The |parse_quoted_word| procedure parses a quote-delimited word and  
+%   returns the corresponding |Lq| or |Mq| item to its caller. The 
+%   syntax is
+%   \begin{quote}
+%     |parsetcl::parse_quoted_word| \word{script} \word{index-var-name}
+%     \word{nested}
+%   \end{quote}
+%   where the arguments and call conventions are as for |parse_word|. 
+%   In case the quoted word is followed by some non-whitespace 
+%   characters, then this will be interpreted as though a space was 
+%   missing after the last quote. A corresponding |Ne| subtree will 
+%   be be put last in the |Lq| or |Mq| item returned, and the index 
+%   variable will be pointed to that none-whitespace character after 
+%   the quote.
+%   \begin{tcl}
+proc parsetcl::parse_quoted_word {script index_var nested} {
+   upvar 1 $index_var index
+   set res [list Lq [list $index ""] ""]
+   set text ""
+   incr index
+   while {1} {
+%   \end{tcl}
+%   Each iteration of this loop adds one subtree to |res| and the 
+%   corresponding literate material to |text|. If some substitution 
+%   happens which does not produce literate material then the |Lq| 
+%   in |res| is changed to an |Mq|.
+%   \begin{tcl}
+      switch -- [string index $script $index] \\ {
+         lappend res [parse_backslash $script index]
+         append text [lindex $res end 2]
+      } \$ {
+         lappend res [parse_dollar $script index]
+         lset res 0 Mq
+      } \[ {
+         lappend res [parse_bracket $script index]
+         lset res 0 Mq
+      } \" {
+         incr index
+         break
+      } "" {
+         lappend res [list Ne [list $index [expr {$index - 1}]]\
+           {missing close-quote}]
+         break
+      } default {
+         regexp -start $index -- {[^\\$\["]*} $script match
+         set t $index
+         incr index [string length $match]
+         lappend res [list Lr [list $t [expr {$index - 1}]] $match]
+         append text $match
+      }
+   }
+   lset res 1 1 [expr {$index - 1}]
+   if {[lindex $res 0] eq "Lq"} then {
+      lset res 2 $text
+%   \end{tcl}
+%   An |Lq| item that has precisely one subtree that furthermore is of 
+%   type |Lr| can do without that subtree, since all the interesting 
+%   information is in the |text|.
+%   \begin{tcl}
+      if {[llength $res] == 4 && [lindex $res 3 0] eq "Lr"} then {
+         set res [lrange $res 0 2]
+      }
+   }
+%   \end{tcl}
+%   What remains now is to check that there aren't any stray characters 
+%   following the close-quote. If there is whitespace to flush then 
+%   everything is alright. Things are also alright if the next character 
+%   is a command terminator or we're at the end of the string.
+%   \begin{tcl}
+   if {[flush_whitespace $script index 0]} then {return $res}
+   switch -- [string index $script $index] \n - \; - {} {
+      return $res
+   } \] {
+      if {$nested} then {return $res}
+   }
+%   \end{tcl}
+%   But if that is not the case then there is an error, and an |Ne| item 
+%   should be appended to |res|. As with characters after close-quotes, 
+%   it is assumed that a space is missing.
+%   \begin{tcl}
+   lappend res [list Ne [list $index [expr {$index - 1}]]\
+     {missing space after close-quote}]
+   return $res
+}
+%   \end{tcl}
+% \end{proc}
+% 
+% \begin{proc}{parse_raw_word}
+%   The |parse_raw_word| procedure parses a whitespace-delimited word 
+%   of a command and returns the corresponding |Lr| or |Mr| item to its 
+%   caller. The syntax is
+%   \begin{quote}
+%     |parsetcl::parse_raw_word| \word{script} \word{index-var-name}
+%     \word{nested}
+%   \end{quote}
+%   where the arguments and call conventions are as for |parse_word|. 
+%   \begin{tcl}
+proc parsetcl::parse_raw_word {script index_var nested} {
+   upvar 1 $index_var index
+   set res [list]
+   set type Lr
+   set interval [list $index]
+   set text ""
+   while {1} {
+%   \end{tcl}
+%   Each iteration of this loop adds one subtree to |res| and the 
+%   corresponding literate material to |text|. If some substitution 
+%   happens which does not produce literate material then |type| is set 
+%   to an |Mr|.
+%   \begin{tcl}
+      switch -- [string index $script $index] \\ {
+         if {[string index $script [expr {$index+1}]] eq "\n"} then {
+            break
+         }
+         lappend res [parse_backslash $script index]
+         append text [lindex $res end 2]
+         continue
+      } \$ {
+         lappend res [parse_dollar $script index]
+         set type Mr
+         continue
+      } \[ {
+         lappend res [parse_bracket $script index]
+         set type Mr
+         continue
+      } \t - \n - \v - \f - \r - " " - \; - "" {
+         break
+      }
+      if {$nested} then {
+         if {![
+            regexp -start $index -- {\A[^\\$\[\]\t-\r ;]+} $script match
+         ]} then {break}
+      } else {
+         regexp -start $index -- {\A[^\\$\[\t-\r ;]+} $script match
+      }
+      set t $index
+      incr index [string length $match]
+      lappend res [list Lr [list $t [expr {$index - 1}]] $match]
+      append text $match
+   }
+%   \end{tcl}
+%   In case there is only a single element in |res| then that will be 
+%   the result.
+%   \begin{tcl}
+   if {[llength $res]==1} then {
+      set res [lindex $res 0]
+   } else {
+      lappend interval [expr {$index - 1}]
+      if {$type ne "Lr"} then {set text ""}
+      set res [linsert $res 0 $type $interval $text]
+   }
+   flush_whitespace $script index 0
+   return $res
+}
+%   \end{tcl}
+% \end{proc}
+% 
+% 
+% \subsection{Parsing substitutions}
+% 
+% \begin{proc}{parse_backslash}
+%   The |parse_backslash| procedure parses a backslash sequence and 
+%   returns the corresponding |Sb| item. The syntax is
+%   \begin{quote}
+%     |parsetcl::parse_backslash| \word{script} \word{index-var-name}
+%   \end{quote}
+%   and it is assumed that the index character in \word{script} is the 
+%   initial backslash in the sequence. Upon return, the index character 
+%   is the first character after the backslash sequence.
+%   \begin{tcl}
+proc parsetcl::parse_backslash {script index_var} {
+   upvar 1 $index_var index
+   set start $index
+   incr index
+   set ch [string index $script $index]
+   set res [list Lr [list $index $index] $ch]
+   switch -- $ch a {
+      set res [list Sb [list $start $index] \a $res]
+   } b {
+      set res [list Sb [list $start $index] \b $res]
+   } f {
+      set res [list Sb [list $start $index] \f $res]
+   } n {
+      set res [list Sb [list $start $index] \n $res]
+   } r {
+      set res [list Sb [list $start $index] \r $res]
+   } t {
+      set res [list Sb [list $start $index] \t $res]
+   } v {
+      set res [list Sb [list $start $index] \v $res]
+   } x {
+      if {[regexp -start [expr {$index + 1}] -- {\A[0-9A-Fa-f]+}\
+        $script match]} then {
+         scan [string range $match end-1 end] %x code
+         incr index [string length $match]
+         lset res 1 1 $index
+         lset res 2 "x$match"
+         set res [list Sb [list $start $index]\
+           [format %c $code] $res]
+      } else {
+         set res [list Sb [list $start $index] x $res]
+      }
+   } u {
+      if {[regexp -start [expr {$index + 1}] -- {\A[0-9A-Fa-f]{1,4}}\
+        $script match]} then {
+         scan $match %x code
+         incr index [string length $match]
+         lset res 1 1 $index
+         lset res 2 "u$match"
+         set res [list Sb [list $start $index]\
+           [format %c $code] $res]
+      } else {
+         set res [list Sb [list $start $index] u $res]
+      }
+   } \n {
+      regexp -start [expr {$index + 1}] -- {\A[ \t]*} $script match
+      incr index [string length $match]
+      lset res 1 1 $index
+      lset res 2 "\n$match"
+      set res [list Sb [list $start $index] " " $res]
+   } "" {
+      return [list Sb [list $start $start] \\]
+   } default {
+      if {[regexp -start $index -- {\A[0-7]{1,3}} $script match]} then {
+         scan $match %o code
+         incr index [expr {[string length $match]-1}]
+         lset res 1 1 $index
+         lset res 2 $match
+         set res [list Sb [list $start $index] [format %c $code] $res]
+      } else {
+         set res [list Sb [list $start $index] $ch $res]
+      }
+      
+   }
+   incr index
+   return $res
+}
+%   \end{tcl}
+% \end{proc}
+% 
+% \begin{proc}{parse_bracket}
+%   The |parse_bracket| procedure parses one pair of command 
+%   substitution brackets and returns the corresponding |Sc| item. 
+%   The syntax is
+%   \begin{quote}
+%     |parsetcl::parse_bracket| \word{script} \word{index-var-name}
+%   \end{quote}
+%   and it is assumed that the index character in \word{script} is the 
+%   initial bracket in the sequence. Upon return, the index character 
+%   is the first character after the close-bracket.
+%   \begin{tcl}
+proc parsetcl::parse_bracket {script index_var} {
+   upvar 1 $index_var index
+   set res [list Sc [list $index ""] ""]
+   incr index
+   while {[lindex [set next [parse_command $script index 1]] 0] ne "Np"} {
+      lappend res $next
+   }
+   if {[string index $script $index] eq "\]"} then {
+      lset res 1 1 $index
+      incr index
+      return $res
+   } else {
+      lappend res [list Ne [list $index [expr {$index-1}]]\
+        {missing close-bracket}]
+      lset res 1 1 [expr {$index-1}]
+      return $res
+   }
+}
+%   \end{tcl}
+% \end{proc}
+% 
+% \begin{variable}{varname_RE}
+%   The |varname_RE| is the regular expression used with |$| 
+%   substitution for grabbing the name of the variable.
+%   \begin{tcl}
+set parsetcl::varname_RE {\A(\w|::)+}
+%   \end{tcl}
+%   The reason for factoring this out into a variable is that 
+%   \Tcllogo\ isn't using the natural (Unicode) definition of an 
+%   alphanumeric character here, but relies on a locale-dependent 
+%   C~library function to perform this test. They generally agree on 
+%   ASCII characters, but outside that one probably cannot rely on that 
+%   the test produces sensible results. Hence if a script needs to be 
+%   parsed where some non-Unicode behaviour of this library function is 
+%   significant, then you might need to change the above regexp.
+%   
+%   There is a \Tcllogo\ bug report~\cite{Letter-bug} on the matter, 
+%   and hopefully there will be no need to ever change this regexp 
+%   once that has been resolved.
+% \end{variable}
+% 
+% \begin{proc}{parse_dollar}
+%   The |parse_dollar| procedure parses one |$|-sequence and returns 
+%   the corresponding |Sv|, |Sa|, or |Lr| item. The syntax is
+%   \begin{quote}
+%     |parsetcl::parse_dollar| \word{script} \word{index-var-name}
+%   \end{quote}
+%   and it is assumed that the index character in \word{script} is the 
+%   initial |$| in the sequence. Upon return, the index character 
+%   is the first character after the parsed sequence.
+%   \begin{tcl}
+proc parsetcl::parse_dollar {script index_var} {
+   upvar 1 $index_var index
+   set res [list "" [list $index ""] ""]
+   incr index
+%   \end{tcl}
+%   If the first character after the |$| is a left brace, then the 
+%   variable is scalar and its name is terminated by the next right 
+%   brace. Note that braces do not nest in this case.
+%   \begin{tcl}
+   if {[string index $script $index] eq "\{"} then {
+      lset res 0 Sv
+      set end [string first \} $script $index]
+      if {$end<0} then {
+         set end [expr {[string length $script] - 1}]
+         lappend res [list Lb [list $index $end]\
+           [string range $script [expr {$index + 1}] end]]\
+           [list Ne [list [expr {$end+1}] $end]\
+             {missing close-brace for variable name}]
+      } else {
+         lappend res [list Lb [list $index $end]\
+           [string range $script [expr {$index + 1}] [expr {$end-1}]]]
+      }
+      lset res 1 1 $end
+      set index [expr {$end + 1}]
+      return $res
+   }
+%   \end{tcl}
+%   Otherwise see if there is something which can be interpreted as an 
+%   alphanumeric variable name. First treat the case when there isn't; 
+%   in that case the |$| is just a literate |$| and it is returned as an 
+%   |Lr| iterm. Then treat the case that the variable is scalar.
+%   \begin{tcl}
+   variable varname_RE
+   if {![regexp -start $index -- $varname_RE $script match]} then {
+      if {[string index $script $index] eq "("} then {
+         set match ""
+      } else {
+         return [list Lr [list [lindex $res 1 0] [lindex $res 1 0]] \$]
+      }
+   }
+   set t $index
+   incr index [string length $match]
+   lappend res [list Lr [list $t [expr {$index-1}]] $match]
+   if {[string index $script $index] ne "("} then {
+      lset res 0 Sv
+      lset res 1 1 [lindex $res 3 1 1]
+      return $res
+   }
+%   \end{tcl}
+%   What remains is to treat the case of an array variable. This is 
+%   very much like |parse_quoted_word|, but it is the right parenthesis 
+%   rather than |"| that acts as terminator.
+%   \begin{tcl}
+   lset res 0 Sa
+   incr index
+   set subres [list Lr [list $index ""] ""]
+   lappend res ""
+   set text ""
+   while {1} {
+%   \end{tcl}
+%   Each iteration of this loop adds one subtree to |subres| and the 
+%   corresponding literate material to |text|. If some substitution 
+%   happens which does not produce literate material then the |Lr| 
+%   in |subres| is changed to an |Mr|.
+%   \begin{tcl}
+      switch -- [string index $script $index] \\ {
+         lappend subres [parse_backslash $script index]
+         append text [lindex $subres end 2]
+      } \$ {
+         lappend subres [parse_dollar $script index]
+         lset subres 0 Mr
+      } \[ {
+         lappend subres [parse_bracket $script index]
+         lset subres 0 Mr
+      } ) {
+         lset subres 1 1 [expr {$index - 1}]
+         break
+      } "" {
+         lappend res\
+           [list Ne [list $index [incr index -1]] {missing )}]
+         lset subres 1 1 $index
+         break
+      } default {
+         regexp -start $index -- {[^\\$\[)]*} $script match
+         set t $index
+         incr index [string length $match]
+         lappend subres [list Lr [list $t [expr {$index - 1}]] $match]
+         append text $match
+      }
+   }
+   if {[lindex $subres 0] eq "Lr"} then {lset subres 2 $text}
+   if {[llength $subres] == 4} then {set subres [lindex $subres 3]}
+   lset res 1 1 $index
+   incr index
+   lset res 4 $subres
+   return $res
+}
+%   \end{tcl}
+% \end{proc}
+% 
+% 
+% 
+% \section{Some utility procdures}
+% 
+% \subsection{Viewing parser trees}
+% 
+% It is useful to have a surveyable presentation of parser trees. An 
+% easy step towards this would be to ensure that nesting depth is 
+% mirrored in the indentation.
+% 
+% \begin{proc}{format_tree}
+%   The |format_tree| procedure takes a parser tree, a base indentation 
+%   (string of whitespace), and an indentation step (string of whitespace) 
+%   as argument. It returns a string that is list-wise equivalent to 
+%   |[list]| of the original tree, but has indentation mirroring the 
+%   nesting depth.
+%   \begin{tcl}
+proc parsetcl::format_tree {tree base step} {
+   set res $base
+   append res \{ [lrange $tree 0 1] { }
+%   \end{tcl}
+%   The following is a trick to make a list element string 
+%   representation for the \word{text} that does not contain any sort 
+%   of newline: making the element unbalanced with respect to braces 
+%   forces escape-quoting also for newlines.
+%   \begin{tcl}
+   if {[regexp {[\n\r]} [lindex $tree 2]]} then {
+      append res [string range [list "[lindex $tree 2]\{"] 0 end-2]
+   } else {
+      append res [lrange $tree 2 2]
+   }
+   if {[llength $tree]<=3} then {
+      append res \}
+      return $res
+   } elseif {[llength $tree] == 4 &&\
+     [string match {S[bv]} [lindex $tree 0]]} then {
+%   \end{tcl}
+%   This is a slight optimization: |Sb| and |Sv| trees look better on 
+%   one line than on three.
+%   \begin{tcl}
+      append res " " [format_tree [lindex $tree 3] "" ""] \}
+      return $res
+   }
+   append res \n
+   foreach subtree [lrange $tree 3 end] {
+      append res [format_tree $subtree $base$step $step] \n
+   }
+   append res $base \}
+}
+%   \end{tcl}
+% \end{proc}
+% 
+% 
+% \subsection{Offsetting intervals}
+% 
+% \begin{proc}{offset_intervals}
+%   This procedure modifies a \word{tree} by adding \word{offset} to 
+%   all endpoints of each interval in that tree, and returns the 
+%   modified tree. The syntax is
+%   \begin{quote}
+%     |parsetcl::offset_intervals| \word{tree} \word{offset}
+%   \end{quote}
+%   \begin{tcl}
+proc parsetcl::offset_intervals {tree offset} {
+   set res [lrange $tree 0 2]
+   foreach i {0 1} {
+      lset res 1 $i [expr {[lindex $res 1 $i] + $offset}]
+   }
+   foreach subtree [lrange $tree 3 end] {
+      lappend res [offset_intervals $subtree $offset]
+   }
+   return $res
+}
+%   \end{tcl}
+% \end{proc}
+% 
+% \begin{proc}{reparse_Lb_as_script}
+%   The |reparse_Lb_as_script| procedure replaces an |Lb| node from an 
+%   existing parser tree with the |Rs| node produced by parsing the text 
+%   between the braces as a script. The syntax is
+%   \begin{quote}
+%     |parsetcl::reparse_Lb_as_script| \word{tree-var} \word{node-index} 
+%     \word{parsed string}
+%   \end{quote}
+%   where \word{tree-var} is the name in the caller's local context of 
+%   the variable in which the tree to substitute is stored and 
+%   \word{node-index} is the index list of the node to replace. The 
+%   procedure returns |2| if the node was an |Lb| node, |1| if is was 
+%   an |Lr| or |Lq| node, and |0| if the node was not of any of these 
+%   types. In the last case, the tree is not modified. In the case that 
+%   |1| is returned, the node has been substituted, but the intervals 
+%   may be slightly off since the string to parse was taken from the 
+%   \word{text} part of the substituted node. The normal case is that |2| 
+%   is returned, and in this case the intervals unambiguously refer to 
+%   positions in the \word{parsed string}.
+%   \begin{tcl}
+proc parsetcl::reparse_Lb_as_script {tree_var index parsed} {
+   upvar 1 $tree_var tree
+   set node [lindex $tree $index]
+   switch -- [lindex $node 0] Lb - Lr - Lq {
+      set base [expr {[lindex $node 1 0] + 1}]
+      if {[lindex $node 0] eq "Lb"} then {
+         set script [string range $parsed $base\
+           [expr {[lindex $node 1 1] - 1}]]
+      } else {
+         set script [lindex $node 2]
+      }
+      lset tree $index\
+        [offset_intervals [basic_parse_script $script] $base]
+      if {[lindex $node 0] eq "Lb"} then {
+         return 2
+      } else {
+         return 1
+      }
+   } default {
+      return 0
+   }
+}
+%   \end{tcl}
+% \end{proc}
+
+
+% 
+% 
+% \subsection{Traversing parser trees}
+% 
+% \begin{proc}{walk_tree}
+%   The |walk_tree| procedure has the syntax
+%   \begin{quote}
+%     |parsetcl::walk_tree| \word{tree-var} \word{index-var} 
+%     \begin{regblock}[\regplus]\word{type-pattern} 
+%     \word{body}\end{regblock}
+%   \end{quote}
+%   It walks through each node in the tree stored in the 
+%   \word{tree-var} in the order that they appear in the string, i.e., 
+%   first the root of a tree, then it walks through each subtree in 
+%   sequence. When visiting a node, the type of the node is 
+%   regexp-matched against the \word{type-pattern}s, and the first 
+%   matching \word{body} is evaluated (entirely using |switch -regexp|) 
+%   in the local context of the caller. While walking, the procedure is 
+%   updating the \word{index-var} variable so that it always contains 
+%   the index list specifying the current node in the tree.
+%   
+%   It is OK to modify the tree while walking through it, provided that 
+%   the index list of the current node remains valid throughout. It is 
+%   particular possible to change the contents of the current node (add 
+%   or remove children) without messing things up.
+%   
+%   There is no particular return value from this procedure.
+%   \begin{tcl}
+proc parsetcl::walk_tree {tree_var index_var args} {
+   upvar 1 $tree_var tree $index_var idxL
+   set idxL [list]
+   set i 0
+   while {$i>=0} {
+      if {$i==0} then {
+         uplevel 1 [list switch -regexp --\
+           [lindex [lindex $tree $idxL] 0] $args]
+         set i 3
+      } elseif {$i < [llength [lindex $tree $idxL]]} then {
+         lappend idxL $i
+         set i 0
+      } elseif {[llength $idxL]} then {
+         set i [lindex $idxL end]
+         set idxL [lrange $idxL 0 end-1]
+         incr i
+      } else {
+         set i -1
+      }
+   }
+}
+%   \end{tcl}
+% \end{proc}
+% 
+% \begin{proc}{simple_parse_script}
+%   The |simple_parse_script| procedure is similar to 
+%   |basic_parse_script|, but it tries to recognise some common control 
+%   structures (|if|, |for|, etc.) and reparses those arguments that 
+%   (for standard command definitions) are scripts. The syntax is
+%   \begin{quote}
+%     |parsetcl::simple_parse_script| \word{script}
+%   \end{quote}
+%   and it returns the parsed script.
+%   \begin{tcl}
+proc parsetcl::simple_parse_script {script} {
+   set tree [parsetcl::basic_parse_script $script]
+   walk_tree tree indices Cd {
+      switch -- [lindex [lindex $tree $indices] 3 2] if {
+         for {set i 3} {$i < [llength [lindex $tree $indices]]}\
+           {incr i} {
+            switch -- [lindex [lindex $tree $indices] $i 2]\
+              if - elseif {
+               incr i; continue
+            } then - else {
+               incr i
+            }
+            parsetcl::reparse_Lb_as_script tree\
+              [linsert $indices end $i] $script
+         }
+      } while {
+         parsetcl::reparse_Lb_as_script tree [linsert $indices end 5]\
+           $script
+      } for {
+         parsetcl::reparse_Lb_as_script tree [linsert $indices end 4]\
+           $script
+         parsetcl::reparse_Lb_as_script tree [linsert $indices end 6]\
+           $script
+         parsetcl::reparse_Lb_as_script tree [linsert $indices end 7]\
+           $script
+      } foreach {
+         parsetcl::reparse_Lb_as_script tree [linsert $indices end end]\
+           $script
+      } catch {
+         parsetcl::reparse_Lb_as_script tree [linsert $indices end 4]\
+           $script
+      } proc {
+         parsetcl::reparse_Lb_as_script tree [linsert $indices end 6]\
+           $script
+      }
+   }
+   return $tree
+}
+%   \end{tcl}
+% \end{proc}
+% 
+% \section{Parsing expressions}
+% 
+% This hasn't been implemented yet.
+% 
+% 
+% \section{Advanced script parsing}
+% 
+% Most of the meaning of a \Tcllogo\ script depends on its commands 
+% rather than being given by the syntax---there is e.g. nothing in the 
+% general syntax that makes the last argument of a |foreach| command 
+% more likely to contain a script than any of the other arguments---and 
+% therefore any higher level parsing of \Tcllogo\ scripts must employ a 
+% table of commands 
+% 
+% This hasn't been implemented yet.
+% 
+% 
+% \section{Script reconstruction}
+% 
+% This hasn't been implemented yet, but the parser trees contain 
+% the necessary information. Applications of script reconstruction 
+% includes writing a |proc|-like command that inlines code in the body 
+% argument before the procedure is created.
+% 
+% 
+% \begin{thebibliography}{9}
+% \bibitem{Letter-bug}
+%   Kevin B. Kenny and Jeffrey Hobbs:
+%   \textit{Dollar-substitution and non-Latin-1},
+%   \Tcllogo~project bug \#408568 (2001, still open April~2003);
+%   \href{https://sourceforge.net/tracker/^^A
+%     ?func=detail&aid=408568&group_id=10894&atid=110894}^^A
+%     {\textsc{https}:/\slash \texttt{sourceforge.net}\slash
+%      \texttt{tracker}\slash 
+%      \texttt{?func=detail\&}\penalty\exhyphenpenalty
+%      \texttt{aid=408568\&}\penalty\exhyphenpenalty
+%      \texttt{group\_id=10894\&}\penalty\exhyphenpenalty
+%      \texttt{atid=110894}.}
+%   
+% \end{thebibliography}
+% 
+\endinput
\ No newline at end of file
diff --git a/Master/texmf-dist/doc/latex/tcldoc/examples/parsetcl.ins b/Master/texmf-dist/doc/latex/tcldoc/examples/parsetcl.ins
new file mode 100644
index 00000000000..645dc77f8a8
--- /dev/null
+++ b/Master/texmf-dist/doc/latex/tcldoc/examples/parsetcl.ins
@@ -0,0 +1,54 @@
+% parsetcl.ins --- DOCSTRIP installation script for parsetcl.
+\input docstrip
+
+% Redefine the \MetaPrefix; it should be something which starts a
+% until-end-of-line comment:
+\edef\MetaPrefix{\string#\string#}
+
+
+% Redefine the file preamble and postamble; this is necessary because 
+% otherwise the old \metaPrefix is inserted at the beginning of these 
+% lines.
+\preamble
+
+In other words:
+ ***************************************
+ * This Source is not the True Source. *
+ ***************************************
+The True Source is parsetcl.dtx in 
+  http://ftp.ctan.org/tex-archive/macros/latex/contrib/tclldoc/examples
+
+It is preferred that you apply the distribution and modification 
+conditions of the LaTeX Project Public License (LPPL) for this file, 
+but you may alternatively choose to apply BSD/Tcl-style license 
+conditions (either is OK). The latest version of the LPPL is in
+   http://www.latex-project.org/lppl.txt
+and version 1.2 or later is part of all distributions of LaTeX 
+version 1999/12/01 or later.
+
+\endpreamble
+
+\postamble
+\endpostamble
+
+
+% Actually make the files:
+\generate{
+   \file{parsetcl.tcl}{\from{parsetcl.dtx}{pkg}}
+}
+
+
+\Msg{}
+\Msg{************************************************}
+\Msg{*}
+\Msg{*  To complete installation,}
+\Msg{*  place parsetcl.tcl in a Tcl library directory}
+\Msg{*  and run pkg_mkIndex to rebuild the package}
+\Msg{*  index.}
+\Msg{*}
+\Msg{************************************************}
+\Msg{}
+
+
+\end
+
diff --git a/Master/texmf-dist/doc/latex/tcldoc/examples/pdf.dtx b/Master/texmf-dist/doc/latex/tcldoc/examples/pdf.dtx
new file mode 100644
index 00000000000..249a28ee6c3
--- /dev/null
+++ b/Master/texmf-dist/doc/latex/tcldoc/examples/pdf.dtx
@@ -0,0 +1,796 @@
+% 
+% \iffalse
+%<*driver>
+\documentclass{tclldoc}
+\PageIndex\CodelineNumbered
+\IndexPrologue{%
+   \section*{Index}%
+   All numbers in this index are page numbers.
+   Underlined entries refer to places where the item in
+   question is defined.%
+}
+\setcounter{IndexColumns}{2}
+\begin{document}
+\DocInput{pdf.dtx}
+\end{document}
+%</driver>
+% \fi
+% 
+% \title{A simple PDF writer in \Tcllogo}
+% \author{Lars Hellstr\"om}
+% \maketitle
+% 
+% \begin{abstract}
+%   This file contains some basic routines that allow a \Tcllogo\ 
+%   script to write PDF files.
+% \end{abstract}
+% 
+% \tableofcontents
+% 
+% \section{PDF files and objects}
+% 
+% A Portable Document Format (PDF) file is, when compared with for example 
+% a PostScript file or HTML file, a rather disorganised document. This 
+% is because at the basic level, a PDF file is a heap rather than a 
+% text; it \emph{can} be ``disorganised'' since its logical structure 
+% is based on cross-referencing rather than on sequentiality. The first 
+% step is therefore to provide support for writing well-formed heaps.
+% 
+% \changes{0.0}{2003/01/02}{Initial version. (LH)}
+% 
+% \begin{tcl}
+%<*pkg>
+package require Tcl 8.1
+package provide writepdf 0.1
+namespace eval pdf {}
+% \end{tcl}
+% \setnamespace{pdf}
+% 
+% 
+% \subsection{Building objects}
+% 
+% The independent units in a PDF file are called objects. An 
+% \emph{object} is essentially a value (which includes a type). The 
+% procedures below construct strings of PDF code that encode objects of 
+% various types. The strings returned are generally such that one must 
+% insert whitespace between two such strings if the data is to be 
+% properly encoded. The strings may contain newlines if some building 
+% routine thinks the lines should otherwise be too long.
+% 
+% \begin{proc}{boolean_obj}
+%   The |boolean_obj| procedure returns a boolean object, corresponding 
+%   to the string passed as its only argument. Most of it is about 
+%   parsing this string: \texttt{true}, \texttt{yes}, \texttt{on}, and 
+%   nonzero numbers are interpreted as boolean true, whereas 
+%   \texttt{false}, \texttt{no}, \texttt{off}, and the zero number is 
+%   interpreted as boolean false. The matching is case-insensitive.
+%   \begin{tcl}
+proc pdf::boolean_obj {value} {
+   switch -nocase -- $value {
+     true - yes - on {return true}
+     false - no - off {return false}
+     default {
+       if {$value} then {return true} else {return false}
+     }
+   }
+}
+%   \end{tcl}
+% \end{proc}
+% 
+% \begin{proc}{int_obj}
+%   The |int_obj| procedure returns the PDF object corresponding to 
+%   the integer supplied as argument.
+%   \begin{tcl}
+proc pdf::int_obj {value} {format %d $value}
+%   \end{tcl}
+% \end{proc}
+% 
+% \begin{proc}{real_obj}
+% \begin{variable}{precision}
+%   The |real_obj| procedure returns the PDF object corresponding to 
+%   the real number supplied as argument. The syntax is
+%   \begin{quote}
+%     |pdf::real_obj| \word{value} \word{precision}\regopt
+%   \end{quote}
+%   where \word{precision} is the number of decimals that will be 
+%   included in the object. If omitted, the value of the |precision| 
+%   variable is used, and that defaults to $3$.
+%   \begin{tcl}
+set pdf::precision 3
+proc pdf::real_obj {value {precision -1}} {
+   if {$precision<0} then {
+      unset precision
+      variable precision
+   }
+   format %.[format %d $precision]f $value
+}
+%   \end{tcl}
+% \end{variable}\end{proc}
+% 
+% \begin{proc}{string_obj}
+%   The |string_obj| procedure returns the PDF string object 
+%   corresponding to the argument. Backslashes and parentheses are 
+%   escaped. Control characters are converted to escape sequences. 
+%   Characters with character code above 255 cause an error to be 
+%   thrown (PDF strings correspond more to \Tcllogo\ byte arrays than to 
+%   general strings). If the string produced is longer than 100 
+%   characters, then backslash--newline sequences are inserted in 
+%   suitable places.
+%   \begin{tcl}
+proc pdf::string_obj {str} {
+   if {[regexp "\[^\n\r -\xff\]" $str]} then {
+      set estr [string map [list \\ \\\\ ( \\( ) \\) \r \\r \n \\n] $str]
+      set str "("
+      set len 1
+      foreach ch [split $estr {}] {
+         scan $ch %c code
+         if {$code==92} then {
+            append str \\
+            incr len
+            continue
+         } elseif {$code<32} then {
+            append str "\\[format %03o $code]"
+            incr len 4
+         } elseif {$code<256} then {
+            append str $ch
+            incr len
+         } else {
+            error "Bad character $ch [format (U+%04x) $code]\
+              in PDF string."
+         }
+         if {$len > 100} then {
+            append str \\\n
+            set len 0
+         }
+      }
+      append str ")"
+   } else {
+      set L [list]
+      while {[string length $str]>=100} {
+         lappend L [string map [list \\ \\\\ ( \\( ) \\) \r \\r \n \\n]\
+           [string range $str 0 99]]
+         set str [string range $str 100 end]
+      }
+      if {[string length $str]} then {
+         lappend L\
+           [string map [list \\ \\\\ ( \\( ) \\) \r \\r \n \\n] $str]
+      }
+      set str ([join $L \\\n])
+   }
+   return $str
+} 
+%   \end{tcl}
+% \end{proc}
+% 
+% \begin{proc}{hexstring_obj}
+%   The |hexstring_obj| procedure returns the PDF string object, 
+%   encoded as hexadecimal digits, that corresponds to the argument. 
+%   If the string is longer than 31 characters then it will be broken 
+%   on several lines.
+%   \begin{tcl}
+proc pdf::hexstring_obj {str} {
+   set hstr "<"
+   set len 1
+   foreach ch [split $str {}] {
+      scan $ch %c code
+      if {$len>=63} then {
+         append hstr \n
+         set len 0
+      }
+      if {$code<256} then {
+         append hstr [format %02x $code]
+         incr len 2
+      } else {
+         error "Bad character $ch [format (U+%04x) $code]\
+           in PDF string."
+      }
+   }
+   append hstr ">"
+}
+%   \end{tcl}
+% \end{proc}
+% 
+% \begin{proc}{text_obj}
+%   The |text_obj| procedure returns the PDF string object, encoded as 
+%   hexadecimal digits, that corresponds to the argument string. This is 
+%   meant to be used for \emph{text strings} 
+%   (see~\cite[Ssec.~4.4.1]{PDFspec}), which are \Tcllogo-style strings 
+%   rather than byte arrays. Text strings may contain general Unicode 
+%   characters, although they will then be encoded using UTF-16BE.
+%   
+%   The implementation constructs the 8-bit and 16-bits encodings of the 
+%   string in parallel, and only when it is done will it decide which to 
+%   return.
+%   \begin{tcl}
+proc pdf::text_obj {str} {
+   set hstr "<"
+   set ustr "<FEFF"
+   set lenh 1
+   set lenu 5
+   set eight_ok 1
+   foreach {chh chl} [split [encoding convertto unicode $str] {}] {
+      scan $chh %c codeh
+      scan $chl %c codel
+      if {$lenu>=62} then {
+         append ustr \n
+         set lenu 0
+      }
+      append ustr [format %02x%02x $codeh $codel]
+      incr lenu 4
+      if {$codeh>0} then {set eight_ok 0}
+      if {!$eight_ok} then {continue}
+      if {$lenh>=63} then {
+         append hstr \n
+         set lenh 0
+      }
+      append hstr [format %02x $codel]
+      incr lenh 2
+   }
+   append hstr ">"
+   append ustr ">"
+   if {$eight_ok && ![string match {<feff*} $hstr]} then {
+      return $hstr
+   } else {
+      return $ustr
+   }
+}
+%   \end{tcl}
+% \end{proc}
+% 
+% \begin{proc}{name_obj}
+%   The |name_obj| procedure returns the PDF name object corresponding 
+%   to its argument. It is useful mainly for names with strange 
+%   characters in them (such as spaces), but most names (e.g.\ dictionary 
+%   keys) appearing in PDF files do not require any quoting and can 
+%   therefore just as well be written as explicit PDF code.
+%   \begin{tcl}
+proc pdf::name_obj {str} {
+   if {[string length $str]>126} then {
+      error "String too long to be a PDF name."
+   }
+   set res /
+   foreach ch [split $str {}] {
+      switch -glob -- $ch {
+         ( - ) - < - > - \\[ - \\] - \{ - \} - / - % - # {
+            scan $ch %c code
+            append res [format #%02x $code]
+         }
+         [!-~] {append res $ch}
+         default {
+            scan $ch %c code
+            append res [format #%02x $code]
+         }
+      }
+   }
+   return $res
+}
+%   \end{tcl}
+% \end{proc}
+% 
+% \begin{proc}{array_obj}
+%   The |array_obj| procedure builds an array object of the objects it 
+%   is given as arguments. The syntax is
+%   \begin{quote}
+%     |pdf::array_obj| \word{object}\regstar
+%   \end{quote}
+%   Newlines are inserted between the objects if it does not appear as 
+%   if the object would fit on a single (100 character) line.
+%   \begin{tcl}
+proc pdf::array_obj {args} {
+   set res \[
+   set len 1
+   foreach item $args {
+      if {[string length $item] + $len >= 100} then {
+         append res \n
+         set len 0
+      } elseif {[string length $res]>1} then {
+         append res " "
+         incr len
+      }
+      append res $item
+      incr len [string length $item]
+   }
+   if {$len >= 100} then {
+      append res \n
+   }
+   append res \]
+}
+%   \end{tcl}
+% \end{proc}
+% 
+% \begin{proc}{dict_obj}
+%   The |dict_obj| procedure builds a dictionary object from its 
+%   arguments. The syntax is
+%   \begin{quote}
+%     |pdf::dict_obj| 
+%     \begin{regexp}[\regstar]\word{key} \word{value}\end{regexp}
+%   \end{quote}
+%   where each \word{key} must be a name object and each \word{value} 
+%   must be an object. It is checked that the number of elements is 
+%   correct and that the keys begin with a slash.
+%   \begin{tcl}
+proc pdf::dict_obj {args} {
+   if {[llength $args] % 2 != 0} then {
+      error "Not the same number of keys and values."
+   }
+   set res "<<\n"
+   foreach {key value} $args {
+      if {![string match {/*} $key]} then {
+         error "'$key' isn't a name object."
+      }
+      if {[string length $key] + [string length $value]>99} then {
+         append res $key \n $value \n
+      } else {
+         append res $key { } $value \n
+      }
+   }
+   append res ">>"
+}
+%   \end{tcl}
+% \end{proc}
+% 
+% \begin{proc}{null_obj}
+%   The |null_obj| procedure returns a null object. It has no arguments.
+%   \begin{tcl}
+proc pdf::null_obj {} {return null}
+%   \end{tcl}
+% \end{proc}
+% 
+% 
+% Objects can also be \emph{streams}, but those have a special relation 
+% to the file structure and are therefore best treated in conjunction 
+% with that. In particular, streams cannot be used as arguments of 
+% |array_obj| or |dict_obj|. The arguments of these procedures can 
+% however be \emph{indirect references} to objects of any type, but 
+% these too are best treated in the context of the basic PDF file 
+% structure.
+% 
+% 
+% \subsection{File structure}
+% 
+% The body of a PDF file consists of a sequence of \emph{indirect 
+% objects}, which are mainly a sort of declarations: a pair of integers 
+% are associated with an object value. Since any composite object can 
+% (and in several cases must) contain a reference to any indirect object, 
+% this makes it possible to build up arbitrary data structures. It is 
+% however also a complication, since it requires that there is a 
+% mechanism for allocating these numbers.
+% 
+% \begin{arrayvar}{file\meta{fnum}}
+%   Every file that \Tcllogo\ opens gets a unique identifier which is 
+%   used in calls to |puts| and such. This identifier is also used as 
+%   the name of an array in the |pdf| namespace, in which the 
+%   procedures below store all auxiliary information they need to create 
+%   a proper PDF file.
+% \end{arrayvar}
+% 
+% \begin{arrayentry}{file\meta{fnum}}{!\meta{reference label}}
+% \begin{arrayentry}{file\meta{fnum}}{last_object_num}
+%   In this API, references to indirect objects can be arbitrary 
+%   strings, called \emph{reference labels}. The correspondence to the 
+%   object numbers actually found in the file is given by the 
+%   \texttt{!}\meta{reference label} entries in the array of the file in 
+%   question. The entries in this array are lists with the structure
+%   \begin{quote}
+%     \word{object number} \word{generation number} \word{file 
+%     position}\regopt
+%   \end{quote}
+%   where the \word{file position} is present only if the indirect 
+%   object in question has been written to file already. The 
+%   \word{object number} is the number of the object referred to. The 
+%   \word{generation number} is currently always zero; it appears that 
+%   it can only be nonzero for files that have incrementally updated, 
+%   and this API only supports creating a file from scratch. The 
+%   \word{file position} is the position in the file of the beginning 
+%   of the indirect object begin referred to.
+%   
+%   The |last_object_num| entry in the array holds the most recently 
+%   allocated object number. It is incremented whenever a new reference 
+%   label is encountered.
+% \end{arrayentry}\end{arrayentry}
+% 
+% \begin{proc}{obj_ref}
+%   The |obj_ref| procedure returns PDF code for an indirect reference 
+%   to an object. The syntax is
+%   \begin{quote}
+%     |pdf::obj_ref| \word{file} \word{reference label}
+%   \end{quote}
+%   where \word{file} is the indentifier of the PDF file in question. 
+%   If the \word{reference label} has not been encountered before for 
+%   this particular file, then a new object number is allocated for it.
+%   \begin{tcl}
+proc pdf::obj_ref {F label} {
+   upvar #0 [namespace current]::$F A
+   if {![info exists A(!$label)]} then {
+      incr A(last_object_num)
+      set A(!$label) [list $A(last_object_num) 0]
+   }
+   format {%d %d R} [lindex $A(!$label) 0] [lindex $A(!$label) 1]
+}
+%   \end{tcl}
+% \end{proc}
+% 
+% \begin{proc}{begin_stream}
+% \begin{proc}{end_stream}
+%   The |begin_stream| and |end_stream| procedures delimit the creation 
+%   of a \emph{stream object}. Between two such commands, it is possible 
+%   to write arbitrary text (usually page descriptors or some sort of 
+%   embedded data) to the PDF file and have it inserted correctly into 
+%   the file as the data stored in the stream object.
+%   
+%   The syntax for |begin_stream| is
+%   \begin{quote}
+%     |pdf::begin_stream| \word{file} \word{reference label}
+%     \begin{regexp}[\regstar]\word{key} \word{value}\end{regexp}
+%   \end{quote}
+%   where \word{file} of course is the file to write to and 
+%   \word{reference label} is the string that should be used to 
+%   reference this object. Each stream consists of one dictionary part 
+%   and one data part, where the primary task of the dictionary part is 
+%   to specify how the data part should be interpreted. The most 
+%   important element in the dictionary is the \texttt{/Length} key and 
+%   its value---these are inserted by the |begin_stream| and 
+%   |end_stream| commands, so one needs not worry about those---but if 
+%   for example the data part is encoded in some special way (for 
+%   example, it might be compressed) then it is necessary to include 
+%   additional elements in the dictionary. This is what the \word{key} 
+%   and \word{value} arguments are for.
+%   
+%   \begin{arrayentry}{file\meta{fnum}}{current_stream}
+%     The |current_stream| entry in a PDF file array is set if and only 
+%     if the current position in that file is inside a stream. It is 
+%     not possible to begin a new stream when this entry is set. The 
+%     value of this entry is a list with the structure
+%     \begin{quote}
+%       \word{reference label} \word{start}
+%     \end{quote}
+%     where \word{reference label} is the reference label of the stream 
+%     and \word{start} is the position in the file of the first byte in 
+%     the stream data. Both of these are needed at |end_stream| to 
+%     record the length of the stream data.
+%   \end{arrayentry}
+%   
+%   \begin{arrayentry}{file\meta{fnum}}{?\meta{reference label}}
+%     This kind of entry is used for indirect objects that are lengths 
+%     of the stream whose reference label is the \meta{reference label}. 
+%     They have the same syntax as their |!| ordinary counterparts.
+%   \end{arrayentry}
+%   
+%   \begin{tcl}
+proc pdf::begin_stream {F label args} {
+   upvar #0 [namespace current]::$F A
+   if {[info exists A(current_stream)]} then {
+      error "There is already a stream ([lindex $A(current_stream) 0])\
+        being written to in this file."
+   }
+   if {![info exists A(!$label)]} then {
+      incr A(last_object_num)
+      set A(!$label) [list $A(last_object_num) 0]
+   }
+   set A(?$label) [list [incr A(last_object_num)] 0]
+   lappend A(!$label) [tell $F]
+   puts $F\
+     [format {%d %d obj} [lindex $A(!$label) 0] [lindex $A(!$label) 1]]
+   puts $F [eval\
+     [list dict_obj /Length [format {%d 0 R} $A(last_object_num)]]\
+     $args]
+   puts $F stream
+   set A(current_stream) [list $label [tell $F]]
+}
+%   \end{tcl}
+%   
+%   The |end_stream| procedure takes the target file as its only argument. 
+%   It finishes off the stream as necessary. It also evaluates 
+%   everything that has been placed in the backlog of the file.
+%   
+%   \begin{arrayentry}{file\meta{fnum}}{backlog}
+%     It is not possible to output a new indirect object when a stream 
+%     is being written to, but it can still be at such a time that the 
+%     need for such an object is discovered. The |backlog| entry 
+%     provides a way around that limitation---this entry is a script 
+%     that is evaluated (and cleared) at the end of every |end_stream|, 
+%     hence commands can be delayed by appending them to this script, 
+%     instead of evaluating them immediately.
+%     
+%     New commands are appended to the |backlog|, and must be preceeded 
+%     by a command separator.
+%   \end{arrayentry}
+%   
+%   \begin{tcl}
+proc pdf::end_stream {F} {
+   upvar #0 [namespace current]::$F A
+   if {![info exists A(current_stream)]} then {
+      error "There is no stream to end."
+   }
+   set length [expr {[tell $F] - [lindex $A(current_stream) 1]}]
+   set label [lindex $A(current_stream) 0]
+   unset A(current_stream)
+   puts $F "endstream endobj"
+   lappend A(?$label) [tell $F]
+   puts $F [format {%d %d obj %d endobj} [lindex $A(?$label) 0]\
+     [lindex $A(?$label) 1] $length]
+   eval "set A(backlog) {}; $A(backlog)"
+}
+%   \end{tcl}
+% \end{proc}\end{proc}
+% 
+% \begin{proc}{put_obj}
+%   The |put_obj| procedure writes a direct object to a PDF file. The 
+%   syntax is
+%   \begin{quote}
+%     |pdf::put_obj| \word{file} \word{reference label} \word{object}
+%   \end{quote}
+%   \begin{tcl}
+proc pdf::put_obj {F label obj} {
+   upvar #0 [namespace current]::$F A
+   if {[info exists A(current_stream)]} then {
+      append A(backlog) \n [list put_obj $F $label $obj]
+      return
+   }
+   if {![info exists A(!$label)]} then {
+      incr A(last_object_num)
+      set A(!$label) [list $A(last_object_num) 0]
+   }
+   lappend A(!$label) [tell $F]
+   puts $F\
+     [format {%d %d obj} [lindex $A(!$label) 0] [lindex $A(!$label) 1]]
+   puts $F $obj
+   puts $F endobj
+}
+%   \end{tcl}
+% \end{proc}
+% 
+% \begin{proc}{rewrite_pdf}
+%   The |rewrite_pdf| procedure opens a new PDF file for writing and 
+%   initialises the associated data structures. The syntax is
+%   \begin{quote}
+%     |pdf::rewrite_pdf| \word{file name} \meta{options}
+%   \end{quote}
+%   and the return value is the identifier of the file opened. The 
+%   \word{file name} is of course the name of that file. The 
+%   \meta{options} is zero or more of
+%   \begin{quote}
+%     |-permissions| \word{integer}\\
+%     |-header| \word{string}
+%   \end{quote}
+%   The permissions are the default permissions for the file in question. 
+%   If this is not specified, then no such value is specified to |open|, 
+%   The header is a string that will be put first in the file (as header). 
+%   It defaults to
+%   \begin{quote}
+%     \texttt{\%PDF-1.3}\\
+%     \texttt{\%\r{a}\"a\"o}
+%   \end{quote}
+%   where the first line is a standard header line, and the second line 
+%   is there to help some software understand that the file should be 
+%   treated as a binary file. \textbf{Note} that no newline is inserted 
+%   after this string; be sure to include it in the string if necessary.
+%   \begin{tcl}
+proc pdf::rewrite_pdf {name args} {
+   set Opt(-header) %PDF-1.3\n%\xe5\xe4\xf6\n
+   array set Opt $args
+   if {[info exists Opt(-permissions)]} then {
+      set F [open $name w $Opt(-permissions)]
+   } else {
+      set F [open $name w]
+   }
+   fconfigure $F -translation binary
+   puts -nonewline $F $Opt(-header)
+   upvar #0 [namespace current]::$F A
+   array unset A
+   set A(last_object_num) 0
+   set A(backlog) ""
+   return $F
+}
+%   \end{tcl}
+% \end{proc}
+% 
+% 
+% \begin{proc}{close_pdf}
+%   The |close_pdf| procedure performs the non-trivial task of finishing 
+%   off the PDF file and closing it. The syntax is
+%   \begin{quote}
+%     |pdf::close_pdf| \word{file} \word{catalog label}
+%     \begin{regexp}[\regstar]\word{key} \word{value}\end{regexp}
+%   \end{quote}
+%   and the return value is a report detailing any problems 
+%   encountered (such as objects that are referred to but never 
+%   defined). This is a report rather than an error, because there is 
+%   in many cases no sharp distinction. If the return value is 
+%   non-empty, then there is probably a bug in your program that needs 
+%   to be fixed.
+%   
+%   The \word{file} is the identifier of the file to write. The 
+%   \word{catalog label} is the reference label of the Catalog object 
+%   in the document. The remaining arguments can be used to insert 
+%   additional information (such as a reference to the Info dictionary 
+%   of the document) in the trailer dictionary.
+%   
+%   \begin{tcl}
+proc pdf::close_pdf {F label args} {
+   upvar #0 [namespace current]::$F A
+   set reportL [list]
+%   \end{tcl}
+%   The first step is to compile the cross-reference table of the 
+%   document. I originally made one subsection for each range of defined 
+%   indirect objects, giving the mandatory free entry \#0 a separate 
+%   subsection, but for some reason Adobe software didn't like that at 
+%   all.\footnote{Whether this means Adobe isn't following their own 
+%   standard I leave to others to decide. Neither GhostScript nor 
+%   Quartz (the PDF-based graphics system in Mac~OS~X) seemed to have 
+%   any problems with this arrangement.} Hence the current 
+%   implementation is to make a cross-reference table with only one 
+%   subsection, with an explicit free entry for every missing item.
+%   
+%   \changes{0.1}{2003/02/24}{Changed cross-reference section to avoid 
+%      what is probably a bug in Adobe PDF readers. (LH)}
+%    
+%   The |xrA| array constructed below is a prototype for the 
+%   cross-reference section. It is indexed by object number and the 
+%   entries have the list structure
+%   \begin{quote}
+%     \word{file position} \word{generation number} \word{type}
+%   \end{quote}
+%   Just as in a PDF file, the \word{type} is either \texttt{f} or 
+%   \texttt{n} depending on whether the entry is ``free'' or 
+%   ``in use''. The \word{file position} and \word{generation number} 
+%   are however not padded with zeros, and the \word{file position} is 
+%   initially an empty string in the ``free'' entries.
+%   
+%   This first round simply collects the information and detects 
+%   collisions.
+%   \begin{tcl}
+   set xrA(0) [list "" 65535 f]
+   foreach lbl [array names A {[!?]*}] {
+      set idx [lindex $A($lbl) 0]
+      set ent [list [lindex $A($lbl) 2] [lindex $A($lbl) 1] n]
+      if {[llength $A($lbl)]<3} then {
+         lappend reportL "There is no indirect object with label:\
+           [string range $lbl 1 end]"
+         set ent [replace $ent 2 2 f]
+      } elseif {[llength $A($lbl)]>3} then {
+         lappend reportL "Multiple indirect objects for label\
+           [string range $lbl 1 end]; at\
+           [join [lrange $A($lbl) 2 end]]."
+      }
+      if {![info exists xrA($idx)]} then {
+         set xrA($idx) $ent
+      } elseif {[lindex $xrA($idx) 2]=="f" && [lindex $ent 2]=="n"}\
+      then {
+         lappend reportL "This shouldn't happen:\
+           There are several reference labels for\
+           indirect object $idx. Using that with label:\
+           [string range $lbl 1 end]"
+         set xrA($idx) $ent
+      } else {
+         lappend reportL "This shouldn't happen:\
+           There are several reference labels for\
+           indirect object $idx. Ignoring that with label:\
+           [string range $lbl 1 end]"
+      }
+   }
+%   \end{tcl}
+%   The second round makes sure that there is a contiguous sequence of 
+%   reference numbers and constructs the linked list of free entries.
+%   \begin{tcl}
+   set last_free 0
+   set maxidx [lindex [lsort -integer -decreasing [array names xrA]] 0]
+   for {set n $maxidx} {$n>=0} {incr n -1} {
+      if {![info exists xrA($n)]} then {
+         set xrA($n) [list "" 0 f]
+         lappend reportL "This shouldn't happen:\
+           Object number $n was allocated, but not\
+           assigned a reference label."
+      }
+      if {[lindex $xrA($n) 2]=="f"} then {
+         set xrA($n) [lreplace $xrA($n) 0 0 $last_free]
+         set last_free $n
+      }
+   }
+%   \end{tcl}
+%   Now the cross-reference section can be written to file.
+%   \begin{tcl}
+   set startxref [tell $F]
+   puts $F xref
+   puts $F [format {%d %d} 0 [expr {$maxidx + 1}]]
+   for {set n 0} {$n<=$maxidx} {incr n} {
+      puts $F [eval [list format {%010d %05d %1s }] $xrA($n)]
+   }
+%   \end{tcl}
+%   Having completed the cross-reference table, the second step is 
+%   to write the trailer.
+%   \begin{tcl}
+   puts $F trailer
+   if {[info exists A(!$label)]} then {
+      lappend args /Root [format {%d %d R} [lindex $A(!$label) 0]\
+        [lindex $A(!$label) 1]]
+   } else {
+      lappend reportL "ERROR: The document does not have a catalog."\
+        "There is no indirect object with label: $label"
+   }
+   lappend args /Size [array size xrA]
+   puts $F [eval [list dict_obj] $args]
+   puts $F "startxref\n${startxref}\n%%EOF"
+%   \end{tcl}
+%   The final step is to close the file and compile the report.
+%   \begin{tcl}
+   close $F
+   join $reportL \n
+}
+%</pkg>
+%   \end{tcl}
+% \end{proc}
+% 
+% 
+% \subsection{Hello World}
+% 
+% The code below creates a PDF file matching the basic ``Hello World'' 
+% example \cite[Sec.~A.2]{PDFspec}.
+% 
+% \begin{tcl}
+%<*example1>
+set F [pdf::rewrite_pdf hello.pdf]
+pdf::put_obj $F "The catalog" [pdf::dict_obj\
+%
+  /Type /Catalog\
+%
+  /Pages [pdf::obj_ref $F "The pages"]\
+%
+  /Outlines [pdf::obj_ref $F "The outlines"]]
+pdf::put_obj $F "The outlines"\
+  [pdf::dict_obj /Type /Outlines /Count [pdf::int_obj 0]]
+pdf::put_obj $F "The pages" [pdf::dict_obj\
+%
+  /Type /Pages\
+%
+  /Count [pdf::int_obj 1]\
+%
+  /Kids [pdf::array_obj [pdf::obj_ref $F "Page 1"]]]
+pdf::put_obj $F "Page 1" [pdf::dict_obj\
+%
+  /Type /Page\
+%
+  /Parent [pdf::obj_ref $F "The pages"]\
+%
+  /Resources [pdf::dict_obj\
+%
+    /Font [pdf::dict_obj /F1 [pdf::obj_ref $F "Helvetica"]]\
+%
+    /ProcSet [pdf::obj_ref $F "The procs"]]\
+%
+  /MediaBox [pdf::array_obj [pdf::int_obj 0] [pdf::int_obj 0]\
+    [pdf::int_obj 612] [pdf::int_obj 792]]\
+%
+  /Contents [pdf::obj_ref $F "Page 1 contents"]]
+pdf::begin_stream $F "Page 1 contents"
+puts $F {BT}
+puts $F {/F1 24 Tf}
+puts $F {100 100 Td (Hello World) Tj}
+puts $F {ET}
+pdf::end_stream $F
+pdf::put_obj $F "The procs" [pdf::array_obj /PDF /Text]
+pdf::put_obj $F "Helvetica" [pdf::dict_obj\
+  /Type /Font /Subtype /Type1\
+  /Name /F1 /BaseFont /Helvetica /Encoding /MacRomanEncoding]
+pdf::close_pdf $F "The catalog"
+%</example1>
+% \end{tcl}
+% 
+% 
+% \begin{thebibliography}{9}
+% \bibitem{PDFspec}
+%   Adobe Systems Incorporated:
+%   \textit{Portable Document Format Reference Manual},
+%   version~1.3 (second edition), Addison--Wesley, 1999;
+%   ISBN 0-201-61588-6;
+%   \textsc{http:}/\slash \texttt{partners.adobe.com}\slash
+%   \texttt{asn}\slash \texttt{developer}\slash \texttt{acrosdk}\slash
+%   \texttt{docs}\slash \texttt{filefmtspecs}\slash 
+%   \texttt{PDFReference13.pdf}.
+%   \emph{Note:} There is now a version~1.4 of this specification.
+% \end{thebibliography}
+% 
+% \PrintIndex
+% 
+% 
+\endinput
\ No newline at end of file
diff --git a/Master/texmf-dist/doc/latex/tcldoc/examples/pdf.ins b/Master/texmf-dist/doc/latex/tcldoc/examples/pdf.ins
new file mode 100644
index 00000000000..00bea9f775e
--- /dev/null
+++ b/Master/texmf-dist/doc/latex/tcldoc/examples/pdf.ins
@@ -0,0 +1,55 @@
+% pdf.ins --- DOCSTRIP installation script for writepdf.
+\input docstrip
+
+% Redefine the \MetaPrefix; it should be something which starts a
+% until-end-of-line comment:
+\edef\MetaPrefix{\string#\string#}
+
+
+% Redefine the file preamble and postamble; this is necessary because 
+% otherwise the old \metaPrefix is inserted at the beginning of these 
+% lines.
+\preamble
+
+In other words:
+ ***************************************
+ * This Source is not the True Source. *
+ ***************************************
+The True Source is pdf.dtx in 
+  http://ftp.ctan.org/tex-archive/macros/latex/contrib/tclldoc/examples
+
+It is preferred that you apply the distribution and modification 
+conditions of the LaTeX Project Public License (LPPL) for this file, 
+but you may alternatively choose to apply BSD/Tcl-style license 
+conditions (either is OK). The latest version of the LPPL is in
+   http://www.latex-project.org/lppl.txt
+and version 1.2 or later is part of all distributions of LaTeX 
+version 1999/12/01 or later.
+
+\endpreamble
+
+\postamble
+\endpostamble
+
+
+% Actually make the files:
+\generate{
+   \file{writepdf.tcl}{\from{pdf.dtx}{pkg}}
+   \file{hellopdf.tcl}{\from{pdf.dtx}{example1}}
+}
+
+
+\Msg{}
+\Msg{************************************************}
+\Msg{*}
+\Msg{*  To complete installation,}
+\Msg{*  place pdfwrite.tcl in a Tcl library directory}
+\Msg{*  and run pkg_mkIndex to rebuild the package}
+\Msg{*  index.}
+\Msg{*}
+\Msg{************************************************}
+\Msg{}
+
+
+\end
+