Man, I would really like to see a native Tcl implementation of identify. Should be easy.
This is a Tcl/Tk based-GUI to ImageMagick's identify command. This was really my first 'large' Tcl/Tk application, so I would love to see input on how to improve the code and style. This program lets you browse to a file or a directory, and outputs identify's data as tagged XML based upon the options checked.
#!/usr/local/ActiveTcl/bin/wish -f
#
# idimage.tcl --
#
# This file is a Tcl/Tk based GUI for ImageMagick's identify utility.
#
# RCS:
#
# $RCSfile: 4277,v $
# $Date: 2006-11-12 19:00:35 $
# $Revision: 1.5 $
package require Tclx
package require xmlgen
namespace import ::xmlgen::*
set run_time [clock format [clock scan now] -format {%D %T} ]
# Specify the identify format flag descriptions and flag values. See
# http://www.imagemagick.org/script/command-line-options.php#format
# for -format flag descriptions and values.
set format(File_Size) %b
set format(Comment) %c
set format(Directory) %d
set format(Filename_Extension) %e
set format(Filename) %f
set format(Unique_Colors) %k
set format(Label) %l
set format(Magick) %m
set format(Number_of_Scenes) %n
set format(Output_Filename) %o
set format(Page_Number) %p
set format(Quantum_Depth) %q
set format(Scene_Number) %s
set format(Top_of_Filename) %t
set format(Temporary_Filename) %u
set format(X_Y_Resolution) "%x %y"
set format(Geometry) %wx%h
set format(Signature) %#
# Declare tags used for XML output
declaretag Images
declaretag Image
declaretag Input_Filename
# Iterate through format flags and declare tags
foreach format_element [array names format] {
declaretag $format_element
}
# Set a title for the window
wm title . "Tcl/Tk Identify"
# Construct a frame which holds the menubar
frame .mbar -relief raised -bd 2
pack .mbar -side top -fill x
#######################################
#
# Configure the menubar
#
#######################################
# Top-level menu items: File, Options
menubutton .mbar.file -text File -menu .mbar.file.menu -underline 0
menubutton .mbar.options -text Options -menu .mbar.options.menu -underline 0
pack .mbar.file .mbar.options -side left
# File menu
menu .mbar.file.menu -tearoff 0
.mbar.file.menu add command -label Open -underline 0 -accelerator "Ctrl+O" \
-command "file_dialog"
.mbar.file.menu add command -label "Identify All" -underline 9 -accelerator \
"Ctrl+A" -command "dir_dialog"
.mbar.file.menu add command -label Quit -underline 0 -accelerator "Ctrl+Q" \
-command exit
# Keyboard shortcuts for file menu options
bind all <Control-o> {file_dialog}
bind all <Control-a> {dir_dialog}
bind all <Control-q> {exit}
# Options menu
menu .mbar.options.menu -tearoff 1
# Populate the options menu
foreach format_element [array names format] {
# Substitute " " for "_" for display in options menu
regsub -all "_" $format_element " " gui_format_element
.mbar.options.menu add checkbutton -label "$gui_format_element" -variable \
$format_element
}
#######################################
#
# Text widget to display output
#
#######################################
text .text -relief flat -bd 2 -yscrollcommand ".scroll set" -font \
-adobe-courier-medium-r-*-*-12-*-*-*-*-*-*-*
# Enable gridding in the text widget
.text configure -setgrid 1
scrollbar .scroll -command ".text yview"
pack .scroll -side right -fill y
# Pack the text widget so it fills both axes and will expand to fill screen
pack .text -side left -fill both -expand 1
# Procedure: file_dialog --
#
# Produce a dialog box that will allow the user open an individual file.
#
# Arguments:
# None
#
# Results:
# Passes a file name to the identify_file procedure.
proc file_dialog {} {
# This is used as an attribute value for the Images tag
global run_time
set types {
{{All Files} {*}}
}
set file [tk_getOpenFile -filetypes $types]
if {$file != ""} {
# Clear contents of text area
.text delete 0.0 end
set id_out [identify_file $file]
set xml_out [Images date=$run_time $id_out]
.text insert end $xml_out
}
}
# Procedure: identify_file --
#
# Execute identify using the user designated options and show the results in
# the text widget.
#
# Arguments:
# Name of file to identify.
#
# Results:
# Identify results written to text widget.
proc identify_file {thisfile} {
set flags [identify_options]
set result [catch {exec identify -format "$flags" $thisfile} msg]
if {$result==0} {
set id_out [Image $msg]
return $id_out
} else {
# An error has occurred, so inform user and continue
.text insert end "An exception has occurred:\n$msg"
}
}
# Procedure: identify_options --
#
# Creates a string of -format flags based upon what the user checks in the
# Options menu.
#
# Arguments:
# None
#
# Results:
# A string of -format flags and additional formatting elements.
proc identify_options {} {
# Make format array available to this proc
global format
# Input filename is the default flag
set flags " [Input_Filename {%i}]\n"
foreach format_element [array names format] {
global $format_element
set format_element_checked $$format_element
regsub -all "_" $format_element " " gui_format_element
if [expr $format_element_checked] {
append flags [$format_element $format($format_element)]\n
}
}
return $flags
}
# Procedure: dir_dialog --
#
# Open a directory chooser dialog box
#
# Arguments:
# None
#
# Results:
# A directory name passed to the identify_all procedure.
proc dir_dialog {} {
set dir [tk_chooseDirectory -mustexist 1]
if {$dir != ""} {
# Clear contents of text area
.text delete 0.0 end
# Readdir puts the names of all files in the target dir in a list.
set files [readdir $dir]
identify_all $dir $files
}
}
# Procedure: identify_all --
#
#
#
# Arguments:
# A directory name.
#
# Results:
# Pass each filename within the target directory to the identify_file
# procedure.
proc identify_all {dir files} {
# This is used as an attribute value for the Images tag
global run_time
# Identify each file and append results to id_out
foreach file $files {
append id_out [identify_file $dir/$file]
}
set xml_out [Images date=$run_time $id_out]
.text insert end $xml_out
}