Merge commit '7c621da28f07e449ad90c387344f07a453927569' as 'tcllib'

10 files changed, 1798 insertions, 0 deletions

diff --git a/tcllib/modules/exif/ChangeLog b/tcllib/modules/exif/ChangeLog
new file mode 100644
index 0000000..e305b89
--- /dev/null
+++ b/tcllib/modules/exif/ChangeLog
@@ -0,0 +1,176 @@
+2013-02-01  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.15 ========================
+	* 
+
+2011-12-13  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.14 ========================
+	* 
+
+2011-01-24  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.13 ========================
+	* 
+
+2009-12-07  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.12 ========================
+	* 
+
+2008-12-12  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.11.1 ========================
+	* 
+
+2008-10-16  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.11 ========================
+	* 
+
+2008-06-14  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* exif.pcx: New file. Syntax definitions for the public commands
+	  of the exif package.
+
+2007-09-12  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.10 ========================
+	* 
+
+2007-03-21  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* exif.man: Fixed all warnings due to use of now deprecated
+	  commands. Added a section about how to give feedback.
+
+2006-10-03  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.9 ========================
+	* 
+
+2006-09-27  Andreas Kupries <andreask@activestate.com>
+
+	* exif.test: [SF Tcllib Bug 1272798]. Using 'format' to get
+	  results with a deterministic precision.
+
+2006-01-22  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* exif.test: More boilerplate simplified via use of test support.
+
+2006-01-19  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* exif.test: Hooked into the new common test support code.
+
+2005-10-21  Andreas Kupries <andreask@activestate.com>
+
+	* exif.test: Fixed typo.
+
+2005-10-06  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.8 ========================
+	* 
+
+2004-10-05  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.7 ========================
+	* 
+
+Wed Sep 29 15:11:35 2004  Andreas Kupries <andreask@activestate.com>
+
+	* exif.tcl (makerNote): Fixed [Tcllib SF Bug 1028668]. There are
+ 	* exif.test:            images in the wild which do not provide
+	                        AFPoint information in the makerNote Exif
+				data. Test suite is new.
+
+2004-05-23  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.6.1 ========================
+	* 
+
+2004-02-15  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.6 ========================
+	* 
+
+2003-05-09  Andreas Kupries  <andreask@activestate.com>
+
+	* exif.tcl (::exif::makerNote): Added missing logical operator to
+	  if condition for field 34. Procheck report.
+
+2003-05-05  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.4 ========================
+	* 
+
+2003-04-11  Andreas Kupries  <andreask@activestate.com>
+
+	* exif.tcl:
+	* exif.man:
+	* pkgIndex.tcl: Fixed bug #614591. Set version of the package to
+	  to 1.1.
+
+2003-04-01  Andreas Kupries  <andreask@activestate.com>
+
+	* exif.man:
+	* exif.tcl: Applied patch for SF tcllib bug #665737 provided by
+	  Tim J. Edwards <timje@users.sourceforge.net>. This not only
+	  fixes the bug mentioned above, but also corrects some spelling
+	  mistakes, adds support for a number of additional EXIF tags, and
+	  provides functionality to dump a thumbnail image contained in
+	  the data to a file.
+
+	  The change in the interface of 'analyze' (stream -> file) was
+	  reverted and an additional file based command provided
+	  instead. This command is a wrapper around the stream interface.
+
+	  Updated the documentation.
+
+2003-02-06  David N. Welton  <davidw@dedasys.com>
+
+	* exif.tcl (exif::makerNote): Use string match instead of regexp.
+
+2002-08-16  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* exif.tcl: Applied patch for bug report SF #530907 partially.
+
+	  Parts of the patch are accepted and applied
+	  * FlashPixVersion
+	  * Construction of FlashMode
+
+	  Not applied parts:
+	  * SubjectDistance. Patch assumes that unit is millimeter and
+	    converts to meter. Spec says that unit _is_ meter. (*). Is it
+	    possible that the specific camera of the submitter implements
+	    the standard incorrectly ?
+
+	  * ShutterSpeedValue. Instead of logical inversion (1/value
+	    seconds) I added the proper unit for frequency (Hz).
+
+	  (*) http://www.media.mit.edu/pia/Research/deepview/exif.html
+	  	0x9206 SubjectDistance  signed rational 1  Distance to focus point, unit is meter 
+
+	* exif.tcl: Applied patch SF #582828 provided by Anselm Lingnau
+	  <lingnau@users.sourceforge.net> to make the module work with
+	  Digital IXUS.
+
+2002-03-25  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* exif.man: Fixed formatting errors in the doctools manpage.
+
+2002-02-18  Andreas Kupries  <andreas_kupries@users.sourceforge.net>  
+
+	* Added module on behalf of Darren New.
+
diff --git a/tcllib/modules/exif/exif.html b/tcllib/modules/exif/exif.html
new file mode 100644
index 0000000..a98d4e5
--- /dev/null
+++ b/tcllib/modules/exif/exif.html
@@ -0,0 +1,147 @@
+<html><head><title>The EXIF documentation file: The EXIF Package</title>
+<meta http-equiv="Expires" content="Tue, 12 Feb 2002 23:41:06 +0000">
+<STYLE type='text/css'>
+    .title { color: #990000; font-size: 22px; line-height: 22px; font-weight: bold; text-align: right;
+             font-family: helvetica, arial, sans-serif }
+    .filename { color: #666666; font-size: 18px; line-height: 28px; font-weight: bold; text-align: right;
+                  font-family: helvetica, arial, sans-serif }
+    p.copyright { color: #000000; font-size: 10px;
+                  font-family: verdana, charcoal, helvetica, arial, sans-serif }
+    p { margin-left: 2em; margin-right: 2em; }
+    li { margin-left: 3em;  }
+    ol { margin-left: 2em; margin-right: 2em; }
+    ul.text { margin-left: 2em; margin-right: 2em; }
+    pre { margin-left: 3em; color: #333333 }
+    ul.toc { color: #000000; line-height: 16px;
+             font-family: verdana, charcoal, helvetica, arial, sans-serif }
+    H3 { color: #333333; font-size: 16px; line-height: 16px; font-family: helvetica, arial, sans-serif }
+    H4 { color: #000000; font-size: 14px; font-family: helvetica, arial, sans-serif }
+    TD.header { color: #ffffff; font-size: 10px; font-family: arial, helvetica, san-serif; valign: top }
+    TD.author-text { color: #000000; font-size: 10px;
+                     font-family: verdana, charcoal, helvetica, arial, sans-serif }
+    TD.author { color: #000000; font-weight: bold; margin-left: 4em; font-size: 10px; font-family: verdana, charcoal, helvetica, arial, sans-serif }
+    A:link { color: #990000; font-size: 10px; text-transform: uppercase; font-weight: bold;
+             font-family: MS Sans Serif, verdana, charcoal, helvetica, arial, sans-serif }
+    A:visited { color: #333333; font-weight: bold; font-size: 10px; text-transform: uppercase;
+                font-family: MS Sans Serif, verdana, charcoal, helvetica, arial, sans-serif }
+    A:name { color: #333333; font-weight: bold; font-size: 10px; text-transform: uppercase;
+             font-family: MS Sans Serif, verdana, charcoal, helvetica, arial, sans-serif }
+    .link2 { color:#ffffff; font-weight: bold; text-decoration: none;
+             font-family: monaco, charcoal, geneva, MS Sans Serif, helvetica, monotype, verdana, sans-serif;
+             font-size: 9px }
+    .RFC { color:#666666; font-weight: bold; text-decoration: none;
+           font-family: monaco, charcoal, geneva, MS Sans Serif, helvetica, monotype, verdana, sans-serif;
+           font-size: 9px }
+    .hotText { color:#ffffff; font-weight: normal; text-decoration: none;
+               font-family: charcoal, monaco, geneva, MS Sans Serif, helvetica, monotype, verdana, sans-serif;
+               font-size: 9px }
+</style>
+</head>
+<body bgcolor="#ffffff" text="#000000" alink="#000000" vlink="#666666" link="#990000">
+<table border="0" cellpadding="0" cellspacing="2" width="30" height="15" align="right"><tr><td bgcolor="#990000" align="center" width="30" height="15"><a href="#toc" CLASS="link2"><font face="monaco, MS Sans Serif" color="#ffffff" size="1"><b>&nbsp;TOC&nbsp;</b></font></a><br></td></tr></table>
+<table width="66%" border="0" cellpadding="0" cellspacing="0"><tr><td><table width="100%" border="0" cellpadding="2" cellspacing="1">
+<tr valign="top"><td width="33%" bgcolor="#666666" class="header">The EXIF documentation file</td><td width="33%" bgcolor="#666666" class="header">D. New</td></tr>
+<tr valign="top"><td width="33%" bgcolor="#666666" class="header">&nbsp;</td><td width="33%" bgcolor="#666666" class="header">February 12, 2002</td></tr>
+</table></td></tr></table>
+<div align="right"><font face="monaco, MS Sans Serif" color="#990000" size="+3"><b><br><span class="title">The EXIF Package</span></b></font></div>
+<font face="verdana, helvetica, arial, sans-serif" size="2">
+
+<h3>Abstract</h3>
+
+<p>
+
+        Tcl EXIF extracts and parses EXIF fields from digital images.
+
+</p>
+<a name="toc"><br><hr size="1" shade="0"></a>
+<table border="0" cellpadding="0" cellspacing="2" width="30" height="15" align="right"><tr><td bgcolor="#990000" align="center" width="30" height="15"><a href="#toc" CLASS="link2"><font face="monaco, MS Sans Serif" color="#ffffff" size="1"><b>&nbsp;TOC&nbsp;</b></font></a><br></td></tr></table>
+<h3>Table of Contents</h3>
+<ul compact class="toc">
+<b><a href="#anchor1">1.</a>&nbsp;
+Synopsis<br></b>
+<b><a href="#anchor2">2.</a>&nbsp;
+Details<br></b>
+<b><a href="#anchor3">3.</a>&nbsp;
+Copyrights<br></b>
+<b><a href="#anchor4">4.</a>&nbsp;
+Acknowledgements<br></b>
+</ul>
+<br clear="all">
+
+<a name="anchor1"><br><hr size="1" shade="0"></a>
+<table border="0" cellpadding="0" cellspacing="2" width="30" height="15" align="right"><tr><td bgcolor="#990000" align="center" width="30" height="15"><a href="#toc" CLASS="link2"><font face="monaco, MS Sans Serif" color="#ffffff" size="1"><b>&nbsp;TOC&nbsp;</b></font></a><br></td></tr></table>
+<h3>1.&nbsp;Synopsis</h3>
+</font><pre>
+    package provide exif 1.0
+</pre><font face="verdana, helvetica, arial, sans-serif" size="2">
+
+<p>
+The EXIF package is a recoding of Chris Breeze's Perl package to do the same
+    thing. This version accepts a channel as input and returns a serialized
+    array with all the recognised fields parsed out. 
+</p>
+
+<p>
+ There is also a function to obtain a list of all possible field names that
+    might be present, which is useful in building GUIs that present such
+    information. 
+</p>
+
+<a name="anchor2"><br><hr size="1" shade="0"></a>
+<table border="0" cellpadding="0" cellspacing="2" width="30" height="15" align="right"><tr><td bgcolor="#990000" align="center" width="30" height="15"><a href="#toc" CLASS="link2"><font face="monaco, MS Sans Serif" color="#ffffff" size="1"><b>&nbsp;TOC&nbsp;</b></font></a><br></td></tr></table>
+<h3>2.&nbsp;Details</h3>
+</font><pre>
+    array set answer [exif::analyze $channel]
+</pre><font face="verdana, helvetica, arial, sans-serif" size="2">
+
+<p>
+ $channel should be an open file handle rewound 
+    to the start. It does not need to be seekable.
+    $channel will be set to binary mode and is left
+    wherever it happens to stop being parsed, usually
+    at the end of the file or the start of the image
+    data. You must open and close the stream yourself.
+    If no error is thrown, the return value is a 
+    serialized array with informative English text
+    about what was found in the EXIF block. Failure
+    during parsing or I/O throw errors. 
+</p>
+</font><pre>
+    set names [exif::fieldnames]
+</pre><font face="verdana, helvetica, arial, sans-serif" size="2">
+
+<p>
+ This returns a list of all possible field names.
+    That is, the array returned by exif::analyze will
+    not contain keys that are not listed in the return
+    from exif::fieldnames. Of course, if information is
+    missing in the image file, exif::analyze may not
+    return all the fields listed in the return from
+    exif::fieldnames. This function is expected to be
+    primarily useful for building GUIs to display results.
+    N.B.: Read the implementation of exif::fieldnames
+    before modifying the implementation of exif::analyze.
+
+</p>
+
+<a name="anchor3"><br><hr size="1" shade="0"></a>
+<table border="0" cellpadding="0" cellspacing="2" width="30" height="15" align="right"><tr><td bgcolor="#990000" align="center" width="30" height="15"><a href="#toc" CLASS="link2"><font face="monaco, MS Sans Serif" color="#ffffff" size="1"><b>&nbsp;TOC&nbsp;</b></font></a><br></td></tr></table>
+<h3>3.&nbsp;Copyrights</h3>
+
+<p>
+(c) 2002 Darren New
+</p>
+
+<p>
+Hold harmless the author, and any lawful use is allowed.
+</p>
+
+<a name="anchor4"><br><hr size="1" shade="0"></a>
+<table border="0" cellpadding="0" cellspacing="2" width="30" height="15" align="right"><tr><td bgcolor="#990000" align="center" width="30" height="15"><a href="#toc" CLASS="link2"><font face="monaco, MS Sans Serif" color="#ffffff" size="1"><b>&nbsp;TOC&nbsp;</b></font></a><br></td></tr></table>
+<h3>4.&nbsp;Acknowledgements</h3>
+
+<p>
+ This code is a direct translation of version 1.3 of exif.pl by Chris
+    Breeze. See the source for full headers, references, etc. 
+</p>
+</font></body></html>
diff --git a/tcllib/modules/exif/exif.man b/tcllib/modules/exif/exif.man
new file mode 100644
index 0000000..62c6682
--- /dev/null
+++ b/tcllib/modules/exif/exif.man
@@ -0,0 +1,80 @@
+[manpage_begin exif n 1.1.2]
+[keywords exif]
+[keywords jpeg]
+[keywords {maker note}]
+[keywords tiff]
+[moddesc   {EXIF parsing}]
+[titledesc {Tcl EXIF extracts and parses EXIF fields from digital images}]
+[category  {File formats}]
+[require Tcl 8.2]
+[require exif [opt 1.1.2]]
+[description]
+[para]
+
+The EXIF package is a recoding of Chris Breeze's Perl package to do
+the same thing.  This version accepts a channel as input and returns a
+serialized array with all the recognised fields parsed out.
+
+[para]
+
+There is also a function to obtain a list of all possible field names
+that might be present, which is useful in building GUIs that present
+such information.
+
+[section COMMANDS]
+
+[list_begin definitions]
+
+[call [cmd exif::analyze] [arg channel] [opt [arg thumbnail]]]
+
+[arg channel] should be an open file handle rewound to the start.  It
+does not need to be seekable.  [arg channel] will be set to binary
+mode and is left wherever it happens to stop being parsed, usually at
+the end of the file or the start of the image data.  You must open and
+close the stream yourself.  If no error is thrown, the return value is
+a serialized array with informative English text about what was found
+in the EXIF block.  Failure during parsing or I/O throw errors.
+
+[para]
+
+If [arg thumbnail] is present and not the empty string it will be
+interpreted as the name of a file, and the thumbnail image contained
+in the exif data will be written into it.
+
+[call [cmd exif::analyzeFile] [arg filename] [opt [arg thumbnail]]]
+
+This is a file-based wrapper around [cmd exif::analyze]. Instead of
+taking a stream it takes a [arg filename] and analyzes the contents of
+the specified file.
+
+[call [cmd exif::fieldnames]]
+
+This returns a list of all possible field names.  That is, the array
+returned by [cmd exif::analyze] will not contain keys that are not
+listed in the return from [cmd exif::fieldnames].  Of course, if
+information is missing in the image file, [cmd exif::analyze] may not
+return all the fields listed in the return from exif::fieldnames.
+This function is expected to be primarily useful for building GUIs to
+display results.
+
+[para]
+
+N.B.: Read the implementation of [cmd exif::fieldnames] before
+modifying the implementation of [cmd exif::analyze].
+
+[list_end]
+
+[section COPYRIGHTS]
+
+(c) 2002 Darren New
+
+Hold harmless the author, and any lawful use is allowed.
+
+[section ACKNOWLEDGEMENTS]
+
+This code is a direct translation of version 1.3 of exif.pl by Chris
+Breeze.  See the source for full headers, references, etc.
+
+[vset CATEGORY exif]
+[include ../doctools2base/include/feedback.inc]
+[manpage_end]
diff --git a/tcllib/modules/exif/exif.pcx b/tcllib/modules/exif/exif.pcx
new file mode 100644
index 0000000..cd69941
--- /dev/null
+++ b/tcllib/modules/exif/exif.pcx
@@ -0,0 +1,34 @@
+# -*- tcl -*- exif.pcx
+# Syntax of the commands provided by package exif.
+#
+# For use by TclDevKit's static syntax checker (v4.1+).
+# See http://www.activestate.com/solutions/tcl/
+# See http://aspn.activestate.com/ASPN/docs/Tcl_Dev_Kit/4.0/Checker.html#pcx_api
+# for the specification of the format of the code in this file.
+#
+
+package require pcx
+pcx::register exif
+pcx::tcldep   1.1.2 needs tcl 8.3
+
+namespace eval ::exif {}
+
+#pcx::message FOO {... text ...} type
+#pcx::scan <VERSION> <NAME> <RULE>
+
+pcx::check 1.1.2 std ::exif::analyze \
+    {checkSimpleArgs 1 2 {
+	checkChannelID
+	checkFileName
+    }}
+pcx::check 1.1.2 std ::exif::analyzeFile \
+    {checkSimpleArgs 1 2 {
+	checkFileName
+	checkFileName
+    }}
+pcx::check 1.1.2 std ::exif::fieldnames \
+    {checkAtEnd}
+
+# Initialization via pcx::init.
+# Use a ::exif::init procedure for non-standard initialization.
+pcx::complete
diff --git a/tcllib/modules/exif/exif.tcl b/tcllib/modules/exif/exif.tcl
new file mode 100644
index 0000000..adb5709
--- /dev/null
+++ b/tcllib/modules/exif/exif.tcl
@@ -0,0 +1,937 @@
+# EXIF parser in Tcl
+# Author: Darren New <dnew@san.rr.com>
+# Translated directly from the Perl version
+# by Chris Breeze <chris@breezesys.com>
+# http://www.breezesys.com
+# See the original comment block, reproduced
+# at the bottom.
+# Most of the inline comments about the meanings of fields
+# are copied verbatim and without understanding from the
+# original, unless "DNew" is there.
+# Much of the structure is preserved, except in
+# makerNote, where I got tired of typing as verbosely
+# as the original Perl. But thanks for making it so
+# readable that even someone who doesn't know Perl
+# could translate it, Chris! ;-)
+# PLEASE read and understand exif::fieldnames
+# BEFORE making any changes here! Thanks!
+
+# Usage of this version:
+#     exif::analyze $stream ?$thumbnail?
+# Stream should be an open file handle
+# rewound to the start. It gets set to
+# binary mode and is left at EOF or 
+# possibly pointing at image data.
+# You have to open and close the
+# stream yourself.
+# The return is a serialized array
+# (a la [array get]) with informative
+# english text about what was found.
+# Errors in parsing or I/O or whatever
+# throw errors.
+#     exif::allfields
+# returns a list of all possible field names.
+# Added by DNew. Funky implementation.
+#
+# New
+#     exif::analyzeFile $filename ?$thumbnail?
+#
+# If you find any mistakes here, feel free to correct them
+# and/or send them to me. I just cribbed this - I don't even
+# have a camera that puts this kind of info into the file.
+
+# LICENSE: Standard BSD License.
+
+# There's probably something here I'm using without knowing it.
+package require Tcl 8.3
+
+package provide exif 1.1.2 ; # first release
+
+namespace eval ::exif {
+    namespace export analyze analyzeFile fieldnames
+    variable debug 0 ; # set to 1 for puts of debug trace
+    variable cameraModel ; # used internally to understand options
+    variable jpeg_markers ; # so we only have to do it once
+    variable intel ; # byte order - so we don't have to pass to every read
+    variable cached_fieldnames ; # just what it says
+    array set jpeg_markers {
+        SOF0  \xC0
+        DHT   \xC4
+        SOI   \xD8
+        EOI   \xD9
+        SOS   \xDA
+        DQT   \xDB
+        DRI   \xDD
+        APP1  \xE1
+    }
+}
+
+proc ::exif::debug {str} {
+    variable debug
+    if {$debug} {puts $str}
+}
+
+proc ::exif::streq {s1 s2} {
+    return [string equal $s1 $s2]
+}
+
+proc ::exif::analyzeFile {file {thumbnail {}}} {
+    set stream [open $file]
+    set res [analyze $stream $thumbnail]
+    close $stream
+    return $res
+}
+
+proc ::exif::analyze {stream {thumbnail {}}} {
+    variable jpeg_markers
+    array set result {}
+    fconfigure $stream -translation binary -encoding binary
+    while {![eof $stream]} {
+        set ch [read $stream 1]
+        if {1 != [string length $ch]} {error "End of file reached @1"}
+        if {![streq "\xFF" $ch]} {break} ; # skip image data
+        set marker [read $stream 1]
+        if {1 != [string length $marker]} {error "End of file reached @2"}
+        if {[streq $marker $jpeg_markers(SOI)]} {
+            debug "SOI"
+        } elseif {[streq $marker $jpeg_markers(EOI)]} {
+            debug "EOI"
+        } else {
+            set msb [read $stream 1]
+            set lsb [read $stream 1]
+            if {1 != [string length $msb] || 1 != [string length $lsb]} {
+                error "File truncated @1"
+            }
+            scan $msb %c msb ; scan $lsb %c lsb
+            set size [expr {256 * $msb + $lsb}]
+            set data [read $stream [expr {$size-2}]]
+	    debug "read [expr {$size - 2}] bytes of data"
+            if {[expr {$size-2}] != [string length $data]} {
+                error "File truncated @2"
+            }
+            if {[streq $marker $jpeg_markers(APP1)]} {
+                debug "APP1\t$size"
+                array set result [app1 $data $thumbnail]
+            } elseif {[streq $marker $jpeg_markers(DQT)]} {
+                debug "DQT\t$size"
+            } elseif {[streq $marker $jpeg_markers(SOF0)]} {
+                debug "SOF0\t$size"
+            } elseif {[streq $marker $jpeg_markers(DHT)]} {
+                debug "DHT\t$size"
+            } elseif {[streq $marker $jpeg_markers(SOS)]} {
+                debug "SOS\t$size"
+            } else {
+                binary scan $marker H* x
+                debug "UNKNOWN MARKER $x"
+            }
+        }
+    }
+    return [array get result]
+}
+
+proc ::exif::app1 {data thumbnail} {
+    variable intel
+    variable cameraModel
+    array set result {}
+    if {![string equal [string range $data 0 5] "Exif\0\0"]} {
+        error "APP1 does not contain EXIF"
+    }
+    debug "Reading EXIF data"
+    set data [string range $data 6 end]
+    set t [string range $data 0 1]
+    if {[streq $t "II"]} {
+        set intel 1
+        debug "Intel byte alignment"
+    } elseif {[streq $t "MM"]} {
+        set intel 0
+        debug "Motorola byte alignment"
+    } else {
+        error "Invalid byte alignment: $t"
+    }
+    if {[readShort $data 2]!=0x002A} {error "Invalid tag mark"}
+    set curoffset [readLong $data 4] ; # just called "offset" in the Perl - DNew
+    debug "Offset to first IFD: $curoffset"
+    set numEntries [readShort $data $curoffset]
+    incr curoffset 2
+    debug "Number of directory entries: $numEntries"
+    for {set i 0} {$i < $numEntries} {incr i} {
+        set head [expr {$curoffset + 12 * $i}]
+        set entry [string range $data $head [expr {$head+11}]]
+        set tag [readShort $entry 0]
+        set format [readShort $entry 2]
+        set components [readLong $entry 4]
+        set offset [readLong $entry 8]
+        set value [readIFDEntry $data $format $components $offset]
+        if {$tag==0x010e} {
+            set result(ImageDescription) $value
+        } elseif {$tag==0x010f} {
+            set result(CameraMake) $value
+        } elseif {$tag==0x0110} {
+            set result(CameraModel) $value
+            set cameraModel $value
+        } elseif {$tag==0x0112} {
+            set result(Orientation) $value
+        } elseif {$tag == 0x011A} {
+            set result(XResolution) $value
+        } elseif {$tag == 0x011B} {
+            set result(YResolution) $value
+        } elseif {$tag == 0x0128} {
+            set result(ResolutionUnit) "unknown"
+            if {$value==2} {set result(ResolutionUnit) "inch"}
+            if {$value==3} {set result(ResolutionUnit) "centimeter"}
+        } elseif {$tag==0x0131} {
+            set result(Software) $value
+        } elseif {$tag==0x0132} {
+            set result(DateTime) $value
+        } elseif {$tag==0x0213} {
+            set result(YCbCrPositioning) "unknown"
+            if {$value==1} {set result(YCbCrPositioning) "Center of pixel array"}
+            if {$value==2} {set result(YCbCrPositioning) "Datum point"}
+        } elseif {$tag==0x8769} {
+            # EXIF sub IFD
+	    debug "==CALLING exifSubIFD=="
+            array set result [exifSubIFD $data $offset]
+        } else {
+            debug "Unrecognized entry: Tag=$tag, value=$value"
+        }
+    }
+    set offset [readLong $data [expr {$curoffset + 12 * $numEntries}]]
+    debug "Offset to next IFD: $offset"
+    array set thumb_result [exifSubIFD $data $offset]
+
+    if {$thumbnail != {}} {
+	set jpg [string range $data \
+		$thumb_result(JpegIFOffset) \
+		[expr {$thumb_result(JpegIFOffset) + $thumb_result(JpegIFByteCount) - 1}]]
+
+        set         to [open $thumbnail w]
+        fconfigure $to -translation binary -encoding binary
+	puts       $to $jpg
+        close      $to
+
+        #can be used (with a JPG-aware TK) to add the image to the result array
+	#set result(THUMB) [image create photo -file $thumbnail]
+    }
+
+    return [array get result]
+}
+
+# Extract EXIF sub IFD info
+proc ::exif::exifSubIFD {data curoffset} {
+    debug "EXIF: offset=$curoffset"
+    set numEntries [readShort $data $curoffset]
+    incr curoffset 2
+    debug "Number of directory entries: $numEntries"
+    for {set i 0} {$i < $numEntries} {incr i} {
+        set head [expr {$curoffset + 12 * $i}]
+        set entry [string range $data $head [expr {$head+11}]]
+        set tag [readShort $entry 0]
+        set format [readShort $entry 2]
+        set components [readLong $entry 4]
+        set offset [readLong $entry 8]
+        if {$tag==0x9000} {
+            set result(ExifVersion) [string range $entry 8 11]
+        } elseif {$tag==0x9101} {
+            set result(ComponentsConfigured) [format 0x%08x $offset]
+        } elseif {$tag == 0x927C} {
+            array set result [makerNote $data $offset]
+        } elseif {$tag == 0x9286} {
+            # Apparently, this doesn't usually work.
+            set result(UserComment) "$offset - [string range $data $offset [expr {$offset+8}]]"
+            set result(UserComment) [string trim $result(UserComment) "\0"]
+        } elseif {$tag==0xA000} {
+            set result(FlashPixVersion) [string range $entry 8 11]
+        } elseif {$tag==0xA300} {
+            # 3 means digital camera
+            if {$offset == 3} {
+                set result(FileSource) "3 - Digital camera"
+            } else {
+                set result(FileSource) $offset
+            }
+        } else {
+            set value [readIFDEntry $data $format $components $offset]
+            if {$tag==0x829A} {
+                if {0.3 <= $value} {
+                    # In seconds...
+                    set result(ExposureTime) "$value seconds"
+                } else {
+                    set result(ExposureTime) "1/[expr {1.0/$value}] seconds"
+                }
+            } elseif {$tag == 0x829D} {
+                set result(FNumber) $value
+            } elseif {$tag == 0x8827} {
+                # D30 stores ISO here, G1 uses MakerNote Tag 1 field 16
+                set result(ISOSpeedRatings) $value
+            } elseif {$tag == 0x9003} {
+                set result(DateTimeOriginal) $value
+            } elseif {$tag == 0x9004} {
+                set result(DateTimeDigitized) $value
+            } elseif {$tag == 0x9102} {
+                if {$value == 5} {
+                    set result(ImageQuality) "super fine"
+                } elseif {$value == 3} {
+                    set result(ImageQuality) "fine"
+                } elseif {$value == 2} {
+                    set result(ImageQuality) "normal"
+                } else {
+                    set result(CompressedBitsPerPixel) $value
+                }
+            } elseif {$tag == 0x9201} {
+                # Not very accurate, use Exposure time instead.
+                #  (That's Chris' comment. I don't know what it means.)
+                set value [expr {pow(2,$value)}]
+                if {$value < 4} {
+                    set value [expr {1.0 / $value}]
+                    set value [expr {int($value * 10 + 0.5) / 10.0}]
+                } else {
+                    set value [expr {int($value + 0.49)}]
+                }
+                set result(ShutterSpeedValue) "$value Hz"
+            } elseif {$tag == 0x9202} {
+                set value [expr {int(pow(sqrt(2.0), $value) * 10 + 0.5) / 10.0}]
+                set result(AperatureValue) $value
+            } elseif {$tag == 0x9204} {
+                set value [compensationFraction $value]
+                set result(ExposureBiasValue) $value
+            } elseif {$tag == 0x9205} {
+                set value [expr {int(pow(sqrt(2.0), $value) * 10 + 0.5) / 10.0}]
+            } elseif {$tag == 0x9206} {
+                # May need calibration
+                set result(SubjectDistance) "$value m"
+            } elseif {$tag == 0x9207} {
+                set result(MeteringMode) "other"
+                if {$value == 0} {set result(MeteringMode) "unknown"} 
+                if {$value == 1} {set result(MeteringMode) "average"} 
+                if {$value == 2} {set result(MeteringMode) "center weighted average"} 
+                if {$value == 3} {set result(MeteringMode) "spot"} 
+                if {$value == 4} {set result(MeteringMode) "multi-spot"} 
+                if {$value == 5} {set result(MeteringMode) "multi-segment"} 
+                if {$value == 6} {set result(MeteringMode) "partial"} 
+            } elseif {$tag == 0x9209} {
+                if {$value == 0} {
+                    set result(Flash) no
+                } elseif {$value == 1} {
+                    set result(Flash) yes
+                } else {
+                    set result(Flash) "unknown: $value"
+                }
+            } elseif {$tag == 0x920a} {
+                set result(FocalLength) "$value mm"
+            } elseif {$tag == 0xA001} {
+                set result(ColorSpace) $value
+            } elseif {$tag == 0xA002} {
+                set result(ExifImageWidth) $value
+            } elseif {$tag == 0xA003} {
+                set result(ExifImageHeight) $value
+            } elseif {$tag == 0xA005} {
+                set result(ExifInteroperabilityOffset) $value
+            } elseif {$tag == 0xA20E} {
+                set result(FocalPlaneXResolution) $value
+            } elseif {$tag == 0xA20F} {
+                set result(FocalPlaneYResolution) $value
+            } elseif {$tag == 0xA210} {
+                set result(FocalPlaneResolutionUnit) "none"
+                if {$value == 2} {set result(FocalPlaneResolutionUnit) "inch"}
+                if {$value == 3} {set result(FocalPlaneResolutionUnit) "centimeter"} 
+            } elseif {$tag == 0xA217} {
+                # 2 = 1 chip color area sensor
+                set result(SensingMethod) $value
+            } elseif {$tag == 0xA401} {
+		#TJE
+		set result(SensingMethod) "normal"
+                if {$value == 1} {set result(SensingMethod) "custom"}
+            } elseif {$tag == 0xA402} {
+		#TJE
+                set result(ExposureMode) "auto"
+                if {$value == 1} {set result(ExposureMode) "manual"}
+                if {$value == 2} {set result(ExposureMode) "auto bracket"}
+            } elseif {$tag == 0xA403} {
+		#TJE
+                set result(WhiteBalance) "auto"
+                if {$value == 1} {set result(WhiteBalance) "manual"}
+            } elseif {$tag == 0xA404} {
+                # digital zoom not used if number is zero
+		set result(DigitalZoomRatio) "not used"
+                if {$value != 0} {set result(DigitalZoomRatio) $value}
+            } elseif {$tag == 0xA405} {
+		set result(FocalLengthIn35mmFilm) "unknown"
+                if {$value != 0} {set result(FocalLengthIn35mmFilm) $value}
+            } elseif {$tag == 0xA406} {
+                set result(SceneCaptureType) "Standard"
+                if {$value == 1} {set result(SceneCaptureType) "Landscape"} 
+                if {$value == 2} {set result(SceneCaptureType) "Portrait"}
+                if {$value == 3} {set result(SceneCaptureType) "Night scene"}
+            } elseif {$tag == 0xA407} {
+                set result(GainControl) "none"
+                if {$value == 1} {set result(GainControl) "Low gain up"} 
+                if {$value == 2} {set result(GainControl) "High gain up"}
+                if {$value == 3} {set result(GainControl) "Low gain down"}
+                if {$value == 4} {set result(GainControl) "High gain down"}
+            } elseif {$tag == 0x0103} {
+		#TJE
+		set result(Compression) "unknown"
+		if {$value == 1} {set result(Compression) "none"}
+		if {$value == 6} {set result(Compression) "JPEG"}
+            } elseif {$tag == 0x011A} {
+		#TJE
+		set result(XResolution) $value
+            } elseif {$tag == 0x011B} {
+		#TJE
+		set result(YResolution) $value
+            } elseif {$tag == 0x0128} {
+		#TJE
+		set result(ResolutionUnit) "unknown"
+		if {$value == 1} {set result(ResolutionUnit) "inch"}
+		if {$value == 6} {set result(ResolutionUnit) "cm"}
+            } elseif {$tag == 0x0201} {
+		#TJE
+		set result(JpegIFOffset) $value
+		debug "offset = $value"
+            } elseif {$tag == 0x0202} {
+		#TJE
+		set result(JpegIFByteCount) $value
+		debug "bytecount = $value"
+            } else {
+                error "Unrecognized EXIF Tag: $tag (0x[string toupper [format %x $tag]])"
+            }
+        }
+    }
+    return [array get result]
+}
+
+# Canon proprietary data that I didn't feel like translating to Tcl yet.
+proc ::exif::makerNote {data curoffset} {
+    variable cameraModel
+    debug "MakerNote: offset=$curoffset"
+
+    array set result {}
+    set numEntries [readShort $data $curoffset]
+    incr curoffset 2
+    debug "Number of directory entries: $numEntries"
+    for {set i 0} {$i < $numEntries} {incr i} {
+        set head [expr {$curoffset + 12 * $i}]
+        set entry [string range $data $head [expr {$head+11}]]
+        set tag [readShort $entry 0]
+        set format [readShort $entry 2]
+        set components [readLong $entry 4]
+        set offset [readLong $entry 8]
+        debug "$i)\tTag: $tag, format: $format, components: $components"
+
+        if {$tag==6} {
+            set value [readIFDEntry $data $format $components $offset]
+            set result(ImageFormat) $value
+        } elseif {$tag==7} {
+            set value [readIFDEntry $data $format $components $offset]
+            set result(FirmwareVersion) $value
+        } elseif {$tag==8} {
+            set value [string range $offset 0 2]-[string range $offset 3 end]
+            set result(ImageNumber) $value
+        } elseif {$tag==9} {
+            set value [readIFDEntry $data $format $components $offset]
+            set result(Owner) $value
+        } elseif {$tag==0x0C} {
+            # camera serial number
+            set msw [expr {($offset >> 16) & 0xFFFF}]
+            set lsw [expr {$offset & 0xFFFF}]
+            set result(CameraSerialNumber) [format %04X%05d $msw $lsw]
+        } elseif {$tag==0x10} {
+            set result(UnknownTag-0x10) $offset
+        } else {
+            if {$format == 3 && 1 < $components} {
+                debug "MakerNote $i: TAG=$tag"
+                catch {unset field}
+                array set field {}
+                for {set j 0} {$j < $components} {incr j} {
+                    set field($j) [readShort $data [expr {$offset+2*$j}]]
+                    debug "$j : $field($j)"
+                }
+                if {$tag == 1} {
+                    if {![string match -nocase "*Pro90*" $cameraModel]} {
+                        if {$field(1)==1} {
+                            set result(MacroMode) macro
+                        } else {
+                            set result(MacroMode) normal
+                        }
+                    }
+                    if {0 < $field(2)} {
+                        set result(SelfTimer) "[expr {$field(2)/10.0}] seconds"
+                    }
+                    set result(ImageQuality) [switch $field(3) {
+                        2 {format Normal}
+                        3 {format Fine}
+                        4 {format "CCD Raw"}
+                        5 {format "Super fine"}
+                        default {format ""}
+                    }]
+                    set result(FlashMode) [switch $field(4) {
+                        0 {format off}
+                        1 {format auto}
+                        2 {format on}
+                        3 {format "red eye reduction"}
+                        4 {format "slow synchro"}
+                        5 {format "auto + red eye reduction"}
+                        6 {format "on + red eye reduction"}
+                        default {format ""}
+                    }]
+                    if {$field(5)} {
+                        set result(ShootingMode) "Continuous"
+                    } else {
+                        set result(ShootingMode) "Single frame"
+                    }
+                    # Field 6 - don't know what it is.
+                    set result(AutoFocusMode) [switch $field(7) {
+                        0 {format "One-shot"}
+                        1 {format "AI servo"}
+                        2 {format "AI focus"}
+                        3 - 6 {format "MF"}
+                        5 {format "Continuous"}
+                        4 {
+                            # G1: uses field 32 to store single/continuous,
+                            # and always sets 7 to 4.
+                            if {[info exists field(32)] && $field(32)} {
+                                format "Continuous"
+                            } else {
+                                format "Single"
+                            }
+                        }
+                        default {format unknown}
+                    }]
+                    # Field 8 and 9 are unknown
+                    set result(ImageSize) [switch $field(10) {
+                        0 {format "large"}
+                        1 {format "medium"}
+                        2 {format "small"}
+                        default {format "unknown"}
+                    }]
+                    # Field 11 - easy shooting - see field 20
+                    # Field 12 - unknown
+                    set NHL {
+                        0 {format "Normal"}
+                        1 {format "High"}
+                        65536 {format "Low"}
+                        default {format "Unknown"}
+                    }
+                    set result(Contrast) [switch $field(13) $NHL]
+                    set result(Saturation) [switch $field(14) $NHL]
+		    set result(Sharpness) [switch $field(15) $NHL]
+                    set result(ISO) [switch $field(16) {
+                        15 {format Auto}
+                        16 {format 50}
+                        17 {format 100}
+                        18 {format 200}
+                        19 {format 400}
+                        default {format "unknown"}
+                    }]
+                    set result(MeteringMode) [switch $field(17) {
+                        3 {format evaluative}
+                        4 {format partial}
+                        5 {format center-weighted}
+                        default {format unknown}
+                    }]
+                    # Field 18 - unknown
+		    if {[info exists field(19)]} {
+			set result(AFPoint) [switch -- [expr {$field(19)-0x3000}] {
+			    0 {format none}
+			    1 {format auto-selected}
+			    2 {format right}
+			    3 {format center}
+			    4 {format left}
+			    default {format unknown}
+			}] ; # {}
+		    }
+		    if {[info exists field(20)]} {
+			if {$field(20) == 0} {
+			    set result(ExposureMode) [switch $field(11) {
+				0 {format auto}
+				1 {format manual}
+				2 {format landscape}
+				3 {format "fast shutter"}
+				4 {format "slow shutter"}
+				5 {format "night scene"}
+				6 {format "black and white"}
+				7 {format sepia}
+				8 {format portrait}
+				9 {format sports}
+				10 {format close-up}
+				11 {format "pan focus"}
+				default {format unknown}
+			    }] ; # {}
+			} elseif {$field(20) == 1} {
+			    set result(ExposureMode) program
+			} elseif {$field(20) == 2} {
+			    set result(ExposureMode) Tv
+			} elseif {$field(20) == 3} {
+			    set result(ExposureMode) Av
+			} elseif {$field(20) == 4} {
+			    set result(ExposureMode) manual
+			} elseif {$field(20) == 5} {
+			    set result(ExposureMode) A-DEP
+			} else {
+			    set result(ExposureMode) unknown
+			}
+		    }
+                    # Field 21 and 22 are unknown
+                    # Field 23: max focal len, 24 min focal len, 25 units per mm
+		    if {[info exists field(23)] && [info exists field(25)]} {
+			set result(MaxFocalLength) \
+				"[expr {1.0 * $field(23) / $field(25)}] mm"
+		    }
+                    if {[info exists field(24)] && [info exists field(25)]} {
+			set result(MinFocalLength) \
+				"[expr {1.0 * $field(24) / $field(25)}] mm"
+		    }
+                    # Field 26-28 are unknown.
+		    if {[info exists field(29)]} {
+			if {$field(29) & 0x0010} {
+			    lappend result(FlashMode) "FP_sync_enabled"
+			}
+			if {$field(29) & 0x0800} {
+			    lappend result(FlashMode) "FP_sync_used"
+			}
+			if {$field(29) & 0x2000} {
+			    lappend result(FlashMode) "internal_flash"
+			}
+			if {$field(29) & 0x4000} {
+			    lappend result(FlashMode) "external_E-TTL"
+			}
+		    }
+                    if {[info exists field(34)] && \
+			    [string match -nocase "*pro90*" $cameraModel]} {
+                        if {$field(34)} {
+                            set result(ImageStabilisation) on
+                        } else {
+                            set result(ImageStabilisation) off
+                        }
+                    }
+                } elseif {$tag == 4} {
+                    set result(WhiteBalance) [switch $field(7) {
+                        0 {format Auto}
+                        1 {format Daylight}
+                        2 {format Cloudy}
+                        3 {format Tungsten}
+                        4 {format Fluorescent}
+                        5 {format Flash}
+                        6 {format Custom}
+                        default {format Unknown}
+                    }]
+                    if {$field(14) & 0x07} {
+                        set result(AFPointsUsed) \
+                            [expr {($field(14)>>12) & 0x0F}]
+                        if {$field(14)&0x04} {
+                            append result(AFPointsUsed) " left"
+                        }
+                        if {$field(14)&0x02} {
+                            append result(AFPointsUsed) " center"
+                        }
+                        if {$field(14)&0x01} {
+                            append result(AFPointsUsed) " right"
+                        }
+                    }
+		    if {[info exists field(15)]} {
+			set v $field(15)
+			if {32768 < $v} {incr v -65536}
+			set v [compensationFraction [expr {$v / 32.0}]]
+			set result(FlashExposureCompensation) $v
+		    }
+		    if {[info exists field(19)]} {
+			set result(SubjectDistance) "$field(19) m"
+		    }
+                } elseif {$tag == 15} {
+                    foreach k [array names field] {
+                        set func [expr {($field($k) >> 8) & 0xFF}]
+                        set v [expr {$field($k) & 0xFF}]
+                        if {$func==1 && $v} {
+                            set result(LongExposureNoiseReduction) on
+                        } elseif {$func==1 && !$v} {
+                            set result(LongExposureNoiseReduction) off
+                        } elseif {$func==2} {
+                            set result(Shutter/AE-Lock) [switch $v {
+                                0 {format "AF/AE lock"}
+                                1 {format "AE lock/AF"}
+                                2 {format "AF/AF lock"}
+                                3 {format "AE+release/AE+AF"}
+                                default {format "Unknown"}
+                            }]
+                        } elseif {$func==3} {
+                            if {$v} {
+                                set result(MirrorLockup) enable
+                            } else {
+                                set result(MirrorLockup) disable
+                            }
+                        } elseif {$func==4} {
+                            if {$v} {
+                                set result(Tv/AvExposureLevel) "1/3 stop"
+                            } else {
+                                set result(Tv/AvExposureLevel) "1/2 stop"
+                            }
+                        } elseif {$func==5} {
+                            if {$v} {
+                                set result(AFAssistLight) off
+                            } else {
+                                set result(AFAssistLight) on
+                            }
+                        } elseif {$func==6} {
+                            if {$v} {
+                                set result(ShutterSpeedInAVMode) "Fixed 1/200"
+                            } else {
+                                set result(ShutterSpeedInAVMode) "Auto"
+                            }
+                        } elseif {$func==7} {
+                            set result(AEBSeq/AutoCancel) [switch $v {
+                                0 {format "0, -, + enabled"}
+                                1 {format "0, -, + disabled"}
+                                2 {format "-, 0, + enabled"}
+                                3 {format "-, 0, + disabled"}
+                                default {format unknown}
+                            }]
+                        } elseif {$func==8} {
+                            if {$v} {
+                                set result(ShutterCurtainSync) "2nd curtain sync"
+                            } else {
+                                set result(ShutterCurtainSync) "1st curtain sync"
+                            }
+                        } elseif {$func==9} {
+                            set result(LensAFStopButtonFnSwitch) [switch $v {
+                                0 {format "AF stop"}
+                                1 {format "operate AF"}
+                                2 {format "lock AE and start timer"}
+                                default {format unknown}
+                            }]
+                        } elseif {$func==10} {
+                            if {$v} {
+                                set result(AutoReductionOfFillFlash) disable
+                            } else {
+                                set result(AutoReductionOfFillFlash) enable
+                            }
+                        } elseif {$func==11} {
+                            if {$v} {
+                                set result(MenuButtonReturnPosition) previous
+                            } else {
+                                set result(MenuButtonReturnPosition) top
+                            }
+                        } elseif {$func==12} {
+                            set result(SetButtonFuncWhenShooting) [switch $v {
+                                0 {format "not assigned"}
+                                1 {format "change quality"}
+                                2 {format "change ISO speed"}
+                                3 {format "select parameters"}
+                                default {format unknown}
+                            }]
+                        } elseif {$func==13} {
+                            if {$v} {
+                                set result(SensorCleaning) enable
+                            } else {
+                                set result(SensorCleaning) disable
+                            }
+                        } elseif {$func==0} {
+                            # Discovered by DNew?
+                            set result(CameraOwner) $v
+                        } else {
+                            append result(UnknownCustomFunc) "$func=$v "
+                        }
+                    }
+                }
+            } else {
+                debug [format "makerNote: Unrecognized TAG: 0x%x" $tag]
+            }
+        }
+    }
+    return [array get result]
+}
+
+proc ::exif::readShort {data offset} {
+    variable intel
+    if {[string length $data] < [expr {$offset+2}]} {
+        error "readShort: end of string reached"
+    }
+    set ch1 [string index $data $offset]
+    set ch2 [string index $data [expr {$offset+1}]]
+    scan $ch1 %c ch1 ; scan $ch2 %c ch2
+    if {$intel} {
+        return [expr {$ch1 + 256 * $ch2}]
+    } else {
+        return [expr {$ch2 + 256 * $ch1}]
+    }
+}
+
+proc ::exif::readLong {data offset} {
+    variable intel
+    if {[string length $data] < [expr {$offset+4}]} {
+        error "readLong: end of string reached"
+    }
+    set ch1 [string index $data $offset]
+    set ch2 [string index $data [expr {$offset+1}]]
+    set ch3 [string index $data [expr {$offset+2}]]
+    set ch4 [string index $data [expr {$offset+3}]]
+    scan $ch1 %c ch1 ; scan $ch2 %c ch2
+    scan $ch3 %c ch3 ; scan $ch4 %c ch4
+    if {$intel} {
+        return [expr {(((($ch4 * 256) + $ch3) * 256) + $ch2) * 256 + $ch1}]
+    } else {
+        return [expr {(((($ch1 * 256) + $ch2) * 256) + $ch3) * 256 + $ch4}]
+    }
+}
+
+proc ::exif::readIFDEntry {data format components offset} {
+    variable intel
+    if {$format == 2} {
+        # ASCII string
+        set value [string range $data $offset [expr {$offset+$components-1}]]
+        return [string trimright $value "\0"]
+    } elseif {$format == 3} {
+        # unsigned short
+        if {!$intel} {
+            set offset [expr {0xFFFF & ($offset >> 16)}]
+        }
+        return $offset
+    } elseif {$format == 4} {
+        # unsigned long
+        return $offset
+    } elseif {$format == 5} {
+        # unsigned rational
+        # This could be messy, if either is >2**31
+        set numerator [readLong $data $offset]
+        set denominator [readLong $data [expr {$offset + 4}]]
+        return [expr {(1.0*$numerator)/$denominator}]
+    } elseif {$format == 10} {
+        # signed rational
+        # Should work normally, since everything in Tcl is signed
+        set numerator [readLong $data $offset]
+        set denominator [readLong $data [expr {$offset + 4}]]
+        return [expr {(1.0*$numerator)/$denominator}]
+    } else {
+        set x [format %08x $format]
+        error "Invalid IFD entry format: $x"
+    }
+}
+
+proc ::exif::compensationFraction {value} {
+    if {$value==0} {return 0}
+    if {$value < 0} {
+        set result "-"
+        set value [expr {0-$value}]
+    } else {
+        set result "+"
+    }
+    set value [expr {int(0.5 + $value * 6)}]
+    set integer [expr {int($value / 6)}]
+    set sixths [expr {$value % 6}]
+    if {$integer != 0} {
+        append result $integer
+        if {$sixths != 0} {
+            append result " "
+        }
+    }
+    if {$sixths == 2} {
+        append result "1/3"
+    } elseif {$sixths == 3} {
+        append result "1/2" 
+    } elseif {$sixths == 4} {
+        append result "2/3"
+    } else {
+        # Added by DNew
+        append result "$sixths/6"
+    }
+    return $result
+}
+
+# This returns the list of all possible fieldnames
+# that analyze might return.
+proc ::exif::fieldnames {} {
+    variable cached_fieldnames 
+    if {[info exists cached_fieldnames]} {
+        return $cached_fieldnames
+    }
+    # Otherwise, parse the source to find the fieldnames.
+    # Cool, huh? Don'tcha just love Tcl?
+    # Because of this, "result(...)" should only appear
+    # in these functions when "..." is the literal name
+    # of a field to be returned.
+    array set namelist {}
+    foreach proc {analyze app1 exifSubIFD makerNote} {
+        set body [info body ::exif::$proc]
+        foreach line [split $body \n] {
+            if {[regexp {result\(([^)]+)\)} $line junk name]} {
+                set namelist($name) {}
+            }
+        }
+    }
+    set cached_fieldnames [lsort -dictionary [array names namelist]]
+    return $cached_fieldnames
+}
+
+
+
+# # # # # # # # # # # # # #
+# What follows is the original header comments
+# from the Perl code from which this is 
+# translated. Any changes I made directly
+# are marked by "DNew".
+
+# PERL script to extract EXIF information from JPEGs generated by Canon
+# digital cameras.
+# This software is free and you may do anything like with it except sell it.
+#
+# Current version: 1.3
+# Author: Chris Breeze
+# email: chris@breezesys.com
+# Web: http://www.breezesys.com
+#
+# Based on experimenting with my G1 and information from:
+# http://www.ba.wakwak.com/~tsuruzoh/Computer/Digicams/exif-e.html
+#
+# Also Canon MakerNote from David Burren's page:
+# http://www.burren.cx/david/canon.html
+#
+# More EXIF info and specs:
+# http://exif.org
+#
+# Warnings: 
+# 1) The Subject distance is unreliable. It seems reasonably accurate
+# for the G1 but on the D30 it is highly dependent on the lens fitted.
+#
+# Perl for Windows is available for free from:
+# http://www.activestate.com
+#
+# History
+# 11 Jan 2001
+# v0.1: Initial version
+#
+# 14 Jan 2001
+# v0.2: Updated with data from David Burren's page
+#
+# 15 Jan 2001
+# v0.3: Added more info for D30 (supplied by David Burren)
+# 1) D30 stores ISO in EXIF tag 0x8827, G1 uses MakerNote 0x1/16
+# 2) MakerNote 0x1/10, ImageSize appears to be large, medium, small
+# 3) D30 allows 1/2 or 1/3 stop exposure compensation
+# 4) Added D30 custom function details, but can't test them
+#
+# 17 Jan 2001
+# v1.0 Tidied up AutoFocusMode for G1 vs D30 + added manual auto focus point (D30)
+#
+# 18 Jan 2001
+# v1.1 Removed some debug code left in by mistake
+#
+# 29 Jan 2001
+# v1.2 Added flash mode (MakerNote Tag 1, field 4)
+#
+# 7 Mar 2001
+# v1.3 Added ImageQuality (MakerNote Tag 1, field 3)
+#
+# 21 Apr 2001
+# v1.4 added ImageStabilisation for Pro90 IS
+#
+# 17 Sep 2001
+# v1.5 Incorporated D30 improvements from Jim Leonard
+
+if {0} {
+    # Trivial usage example
+    set x [exif::fieldnames]
+    puts "fieldnames = $x"
+    set f [open [lindex $argv 0]]
+    array set v [exif::analyze $f]
+    close $f
+    parray v
+}
+
diff --git a/tcllib/modules/exif/exif.test b/tcllib/modules/exif/exif.test
new file mode 100644
index 0000000..05e72fa
--- /dev/null
+++ b/tcllib/modules/exif/exif.test
@@ -0,0 +1,42 @@
+# -*- tcl -*-
+# exif.test:  tests for the exif structure.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 2001-2006 by Andreas Kupries <a.kupries@westend.com>
+# All rights reserved.
+#
+# RCS: @(#) $Id: exif.test,v 1.6 2006/10/09 21:41:40 andreas_kupries Exp $
+
+# -------------------------------------------------------------------------
+
+source [file join \
+	[file dirname [file dirname [file join [pwd] [info script]]]] \
+	devtools testutilities.tcl]
+
+testsNeedTcl     8.3
+testsNeedTcltest 1.0
+
+testing {
+    useLocal exif.tcl exif
+}
+
+# -------------------------------------------------------------------------
+
+test exif-makernote-19.0 {makernote field 19 (afpoint) is optional} {
+    # AFPoint == AutoFocus Point
+
+    set f [open [file join $::tcltest::testsDirectory noafpoint.jpg] r]
+    fconfigure $f -translation binary
+    array set resa [exif::analyze $f]
+    close $f
+    set resa(FocalPlaneXResolution) [format %13.8f $resa(FocalPlaneXResolution)]
+    set resa(FocalPlaneYResolution) [format %13.8f $resa(FocalPlaneYResolution)]
+    set res [dictsort [array get resa]]
+    unset resa
+    set res
+} {AFPointsUsed {3 right} AperatureValue 7.1 AutoFocusMode {AI servo} CameraMake Canon CameraModel {Canon PowerShot S100} ColorSpace 1 ComponentsConfigured 0x00030201 Contrast Normal DateTime {2004:09:06 05:22:56} DateTimeDigitized {2004:09:06 05:22:56} DateTimeOriginal {2004:09:06 05:22:56} ExifImageHeight 1200 ExifImageWidth 1600 ExifInteroperabilityOffset 1088 ExifVersion 0210 ExposureBiasValue 0 ExposureTime {1/250.0 seconds} FNumber 7.1 FileSource {3 - Digital camera} FirmwareVersion {Firmware Version 1.0} Flash no FlashMode auto FlashPixVersion 0100 FocalLength {5.40625 mm} FocalPlaneResolutionUnit inch FocalPlaneXResolution 7766.99029126 FocalPlaneYResolution 7741.93548387 ISO unknown ImageFormat {IMG:JPEG file} ImageNumber 140-4060 ImageQuality Fine ImageSize large MacroMode normal MeteringMode unknown Orientation 1 Owner Irochka ResolutionUnit inch Saturation Normal SensingMethod 2 Sharpness Normal ShootingMode {Single frame} ShutterSpeedValue {250 Hz} SubjectDistance {3.358 m} UnknownTag-0x10 100925440 UserComment {554 - } WhiteBalance Auto XResolution 180.0 YCbCrPositioning {Center of pixel array} YResolution 180.0}
+
+testsuiteCleanup
diff --git a/tcllib/modules/exif/exif.txt b/tcllib/modules/exif/exif.txt
new file mode 100644
index 0000000..33b8961
--- /dev/null
+++ b/tcllib/modules/exif/exif.txt
@@ -0,0 +1,280 @@
+
+
+The EXIF documentation file                                       D. New
+                                                       February 12, 2002
+
+
+                            The EXIF Package
+
+
+Abstract
+
+   Tcl EXIF extracts and parses EXIF fields from digital images.
+
+Table of Contents
+
+   1. Synopsis . . . . . . . . . . . . . . . . . . . . . . . . . . . . 2
+   2. Details  . . . . . . . . . . . . . . . . . . . . . . . . . . . . 3
+   3. Copyrights . . . . . . . . . . . . . . . . . . . . . . . . . . . 4
+   4. Acknowledgements . . . . . . . . . . . . . . . . . . . . . . . . 5
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+New                                                             [Page 1]
+
+EXIF                        The EXIF Package               February 2002
+
+
+1. Synopsis
+
+       package provide exif 1.0
+
+   The EXIF package is a recoding of Chris Breeze's Perl package to do
+   the same thing.  This version accepts a channel as input and returns
+   a serialized array with all the recognised fields parsed out.
+
+   There is also a function to obtain a list of all possible field names
+   that might be present, which is useful in building GUIs that present
+   such information.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+New                                                             [Page 2]
+
+EXIF                        The EXIF Package               February 2002
+
+
+2. Details
+
+       array set answer [exif::analyze $channel]
+
+   $channel should be an open file handle rewound to the start.  It does
+   not need to be seekable.  $channel will be set to binary mode and is
+   left wherever it happens to stop being parsed, usually at the end of
+   the file or the start of the image data.  You must open and close the
+   stream yourself.  If no error is thrown, the return value is a
+   serialized array with informative English text about what was found
+   in the EXIF block.  Failure during parsing or I/O throw errors.
+
+       set names [exif::fieldnames]
+
+   This returns a list of all possible field names.  That is, the array
+   returned by exif::analyze will not contain keys that are not listed
+   in the return from exif::fieldnames.  Of course, if information is
+   missing in the image file, exif::analyze may not return all the
+   fields listed in the return from exif::fieldnames.  This function is
+   expected to be primarily useful for building GUIs to display results.
+   N.B.: Read the implementation of exif::fieldnames before modifying
+   the implementation of exif::analyze.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+New                                                             [Page 3]
+
+EXIF                        The EXIF Package               February 2002
+
+
+3. Copyrights
+
+   (c) 2002 Darren New
+
+   Hold harmless the author, and any lawful use is allowed.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+New                                                             [Page 4]
+
+EXIF                        The EXIF Package               February 2002
+
+
+4. Acknowledgements
+
+   This code is a direct translation of version 1.3 of exif.pl by Chris
+   Breeze.  See the source for full headers, references, etc.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+New                                                             [Page 5]
+
diff --git a/tcllib/modules/exif/exif.xml b/tcllib/modules/exif/exif.xml
new file mode 100644
index 0000000..5d960ac
--- /dev/null
+++ b/tcllib/modules/exif/exif.xml
@@ -0,0 +1,100 @@
+<?xml version="1.0"?>
+<!DOCTYPE rfc SYSTEM "rfc2629.dtd">
+
+<?rfc compact="no"?>
+<?rfc toc="yes"?>
+<?rfc private="The EXIF documentation file"?>
+<?rfc header="EXIF"?>
+
+<rfc>
+<front>
+<title>The EXIF Package</title>
+
+<author initials="D." surname="New" fullname="Darren New">
+<organization/>
+<address>
+<postal>
+<street>5390 Caminito Exquisito</street>
+<city>San Diego</city> <region>CA</region> <code>92130</code>
+<country>US</country>
+</postal>
+<email>dnew@san.rr.com</email>
+</address>
+</author>
+
+<date month="February" year="2002" />
+
+<abstract><t>
+        Tcl EXIF extracts and parses EXIF fields from digital images.
+</t></abstract>
+</front>
+
+<middle>
+
+<section title="Synopsis">
+<figure><artwork><![CDATA[
+    package provide exif 1.0
+]]></artwork></figure>
+
+<t>The EXIF package is a recoding of Chris Breeze's Perl package to do the same
+    thing. This version accepts a channel as input and returns a serialized
+    array with all the recognised fields parsed out. </t>
+
+<t> There is also a function to obtain a list of all possible field names that
+    might be present, which is useful in building GUIs that present such
+    information. </t>
+
+</section>
+
+<section title="Details">
+
+<figure><artwork><![CDATA[
+    array set answer [exif::analyze $channel]
+]]></artwork></figure>
+
+<t> $channel should be an open file handle rewound 
+    to the start. It does not need to be seekable.
+    $channel will be set to binary mode and is left
+    wherever it happens to stop being parsed, usually
+    at the end of the file or the start of the image
+    data. You must open and close the stream yourself.
+    If no error is thrown, the return value is a 
+    serialized array with informative English text
+    about what was found in the EXIF block. Failure
+    during parsing or I/O throw errors. </t>
+
+<figure><artwork><![CDATA[
+    set names [exif::fieldnames]
+]]></artwork></figure>
+
+<t> This returns a list of all possible field names.
+    That is, the array returned by exif::analyze will
+    not contain keys that are not listed in the return
+    from exif::fieldnames. Of course, if information is
+    missing in the image file, exif::analyze may not
+    return all the fields listed in the return from
+    exif::fieldnames. This function is expected to be
+    primarily useful for building GUIs to display results.
+    N.B.: Read the implementation of exif::fieldnames
+    before modifying the implementation of exif::analyze.
+</t>
+
+</section>
+
+<section title="Copyrights">
+<t>(c) 2002 Darren New</t>
+
+<t>Hold harmless the author, and any lawful use is allowed.</t>
+</section>
+
+<section title="Acknowledgements">
+
+<t> This code is a direct translation of version 1.3 of exif.pl by Chris
+    Breeze. See the source for full headers, references, etc. </t>
+
+</section>
+
+</middle>
+
+</rfc>
+
diff --git a/tcllib/modules/exif/noafpoint.jpg b/tcllib/modules/exif/noafpoint.jpg
new file mode 100644
index 0000000..106c73c
--- /dev/null
+++ b/tcllib/modules/exif/noafpoint.jpg
diff --git a/tcllib/modules/exif/pkgIndex.tcl b/tcllib/modules/exif/pkgIndex.tcl
new file mode 100644
index 0000000..dc87584
--- /dev/null
+++ b/tcllib/modules/exif/pkgIndex.tcl
@@ -0,0 +1,2 @@
+if {![package vsatisfies [package provide Tcl] 8.3]} {return}
+package ifneeded exif 1.1.2 [list source [file join $dir exif.tcl]]