#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# TkSnapshot (Version 0.3), 2001-04-30
#
# Copyright (C) 2000-2001 by Tom Sato <VEF00200@nifty.ne.jp>
#
# http://member.nifty.ne.jp/tsato/tkdeskset/
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
# See the GNU General Public License for more details.

set program_name "TkSnapshot"
set title "$program_name  (Version 0.3)"

# set default parameters

set lang "C"
if { ! [ catch { kanji code "abc" } ] } {
    catch { set lang $env(LANG) }
    catch { set lang $env(LC_ALL) }
    catch { set lang $env(LC_MESSAGES) }
    set env(LC_MESSAGES) "C"
}

set opt(type)         window
set opt(delay)        0

set opt(destination)  printer
set opt(printer)      lp
set opt(paper)        a4
set opt(orientation)  upright
set opt(position)     center
set opt(scale)        100

set paper_width(a4)     595 ; set paper_height(a4)    842
set paper_width(a5)     420 ; set paper_height(a5)    595
set paper_width(b5)     516 ; set paper_height(a4)    729
set paper_width(letter) 612 ; set paper_height(leter) 792

set cur_folder [ pwd ]
set filename "snapshot.xwd"

set tmpfile "/tmp/tksnapshot[pid].xwd"

# set commands to snap images
set magick 1
if { [ catch { set cmd [ exec which import ] } ] \
	|| ! [ file executable $cmd ] } {
    set magick 0
}

if { $magick } {
    set prog(snap_screen) 	 "import -window root $tmpfile"
    set prog(snap_window) 	 "import -frame -descend -window %s $tmpfile" 
    set prog(snap_region) 	 "import $tmpfile"
    set prog(display)            "display $tmpfile"
    set prog(convert)            "convert %s %s"
    set prog(convert-gif)        "convert %s gif:- | giftopnm | ppmtogif 2> /dev/null > %s"
    if { [ catch { set cmd [ exec which ppmtogif ] } ] \
	    || ! [ file executable $cmd ] } {
	set prog(convert-gif)        "convert %s gif:%s"
    }
    set format "Automatic"
} else {
    set prog(snap_screen) 	 "xwd -root > $tmpfile"
    set prog(snap_window) 	 "xwd -frame -id %s > $tmpfile" 
    set prog(snap_region) 	 "xsnap -noshow -xwd > $tmpfile"
    if { [ catch { set cmd [ exec which xsnap ] } ] \
	    || ! [ file executable $cmd ] } {
	set prog(snap_region) ""
    }
    set prog(display)     "xwud -in $tmpfile"
    set prog(convert)     "cp %s %s"
    set format "XWD"
}


# For Japanese locale, translate messages to Japanese.
#
proc gettext msg {
    global lang

    if [ regexp {^ja_|^japanese|^ja$} $lang junk ] {
	switch -glob $msg {
	    "Click window to be snapped" \
		    { return "スナップするウィンドウをクリックして下さい" }
	    "Delaying... %s" \
		    { return "遅延中... %s" }
	    "Snapping screen... " \
		    { return "スクリーンのスナップ..." }
	    "Snapping window... " \
		    { return "ウィンドウのスナップ..." }
	    "Specify region to be snapped" \
		    { return "スナップする領域を指定して下さい" }
	    "Snap failed." \
		    { return "スナップ失敗。" }
	    "Snap succeeded." \
		    { return "スナップ成功。" }
	    "Starting image viewer..." \
		    { return "イメージ・ビューアを起動..." }
	    "Current Directory:" \
		    { return "現在のディレクトリ" }
	    "Save as:" \
		    { return "保存先:" }
	    "Format:" \
		    { return "フォーマット:" }
	    "Save" \
		    { return "保存" }
	    "Cancel" \
		    { return "取り消し" }
	    "Load from:" \
		    { return "ロード:" }
	    "Load" \
		    { return "ロード" }
	    "No such file: %s" \
		    { return "ファイルが存在しません: %s" }
	    "Not a plain file: %s" \
		    { return "普通のファイルではありません: %s" }
	    "Can't read: %s" \
		    { return "読み込めません: %s" }
	    "Loaded." \
		    { return "読み込み成功。" }
	    "File \"%s\" already exists.\
		    \nDo you really want to overwrite the file?" \
		    { return "ファイル \"%s\" は既に存在しています。\
		    \nそのファイルに上書きしますか？" }
	    "Done." \
		    { return "完了。" }
	    "Saved." \
		    { return "保存完了。" }
	    "Can't output to printer \"%s\"" \
		    { return "プリンタ \"%s\" へ出力できません" }
	    "Print failed." \
		    { return "印刷失敗。" }
	    "Can't save to file \"%s\"" \
		    { return "ファイル \"%s\" に保存できません" }
	    "Save failed." \
		    { return "保存失敗。" }
	    "Printer:" \
		    { return "プリンタ:" }
	    "Print" \
		    { return "印刷" }
	    "File:" \
		    { return "ファイル:" }
	    "Printer" \
		    { return "プリンタ" }
	    "File" \
		    { return "ファイル" }
	    "Upright" \
		    { return "縦" }
	    "Sideways" \
		    { return "横" }
	    "Center" \
		    { return "中央" }
	    "Lower-left" \
		    { return "左下" }
	    "Load..." \
		    { return "ロード..." }
	    "Save..." \
		    { return "保存..." }
	    "Print..." \
		    { return "印刷..." }
	    "Snap Type:" \
		    { return "スナップ領域:" }
	    "Window" \
		    { return "ウィンドウ" }
	    "Region" \
		    { return "領域指定" }
	    "Screen" \
		    { return "スクリーン" }
	    "Snap Delay:" \
		    { return "遅延秒数:" }
	    "seconds" \
		    { return "秒" }
	    "Beep During Countdown" \
		    { return "秒読み中に警告音を出す" }
	    "Hide Window During Capture" \
		    { return "スナップ中にウィンドウを隠す" }
	    "Snap" \
		    { return "スナップ" }
	    "View..." \
		    { return "表示..." }
	    "Destination:" \
		    { return "出力先:" }
	    "Printer:" \
		    { return "プリンタ:" }
	    "Paper Size:" \
		    { return "用紙サイズ:" }
	    "Orientation:" \
		    { return "方向:" }
	    "Position:" \
		    { return "位置:" }
	    "Scaling (%):" \
		    { return "スケーリング (%):" }
	    "Automatic:" \
		    { return "自動" }
	    default \
		    { return $msg }
        }
    }
    return $msg
}



################################################################
# Snap the image on the screen

proc snap mode {
    global magick prog tmpfile opt

    .image.snap configure -state disabled

    set wid ""
    if { $mode == "window" } {
	.message configure -text [ gettext "Click window to be snapped" ]
	update
	if [ catch [
	    set f [ open "| xwininfo " r ]
	    while { 0 <= [ gets $f line ] } {
		regexp {Window id: *([^ ]+)} $line junk wid
	    }
	    close $f
	    ] ] {
		.message configure -text [ gettext "Snap failed." ]
		.image.snap configure -state normal
		update
	    }
    }

    set geometry [ winfo geometry . ]
    if { $opt(hide) } {	wm withdraw . }

    if { $mode != "region" && 0 < $opt(delay) } {
	for { set t $opt(delay) } { 0 < $t } { incr t -1 } {
	    .message configure -text [ format [ gettext "Delaying... %s" ] $t ]
	    update
	    if { $opt(beep) } {
		bell
		update
	    }
	    after 1000
	}
    }
    switch $mode {
	screen { set msg [ gettext "Snapping screen... " ] }
	window { set msg [ gettext "Snapping window... " ] }
	region { set msg [ gettext "Specify region to be snapped" ] }
    }
    .message configure -text $msg
    update

    if [ catch [ eval exec [ format $prog(snap_$mode) $wid ] ] ] {
	.message configure -text [ gettext "Snap failed." ]
    } else {
	.message configure -text [ gettext "Snap succeeded." ]
	.command.save configure -state normal
	.image.view configure -state normal
	if { $magick } { .command.print configure -state normal }
    }
    if { $opt(hide) } {
	wm deiconify .
	wm geometry . $geometry
    }

    .image.snap configure -state normal
    update
}


################################################################
# View snapped image

set display_pid 0

proc view {} {
    global prog tmpfile display_pid

    if [ file exists $tmpfile ] {
	.message configure -text [ gettext "Starting image viewer..." ]

	kill_viewer

	.image.view configure -state disabled
	update
	set display_pid [ eval exec $prog(display) & ]
	after 300 { .image.view configure -state normal }
    }
}

proc kill_viewer {} {
    global display_pid

    if { 0 < $display_pid } {
	catch { exec kill -KILL $display_pid }
	set display_pid 0
    }
}

################################################################
# File browser

proc browser mode {
    global cur_folder filename magick

    .message configure -text ""

    if [ winfo exists .dir ] { destroy .dir }

    toplevel .dir
    if { $mode == "save" } {
	wm title .dir "TkSnapshot - Save"
    } else {
	wm title .dir "TkSnapshot - Load"
    }
    wm transient .dir .

    frame .dir.filename
    frame .dir.bottom_frame
    label .dir.folder_label -text [ gettext "Current Directory:" ]
    entry .dir.cur_folder -textvariable cur_folder -width 30
    bind .dir.cur_folder <Return> { refresh_directroy }

    listbox .dir.list -width 30 -height 10 -selectmode single \
	    -yscrollcommand ".dir.scroll set"
    scrollbar .dir.scroll -orient vertical -command ".dir.list yview"

    if { $mode == "save" } {
	label .dir.filename.label -text [ gettext "Save as:" ]
	entry .dir.filename.value -textvariable filename

	frame .dir.format
	label .dir.format.label -text [ gettext "Format:" ]
	if { $magick } {
	    tk_optionMenu .dir.format.menubutton format "Automatic" \
		    "Sun Raster" "GIF" "PNG" "PPM" "TIFF" "BMP" "XBM" "XWD" "EPSF"
	} else {
	    tk_optionMenu .dir.format.menubutton format "XWD"
	}

	pack .dir.format.label .dir.format.menubutton -side left -anchor w

	button .dir.save -text [ gettext "Save" ] \
		-command { save_image $cur_folder $filename }
	button .dir.cancel -text [ gettext "Cancel" ] -command { destroy .dir }
	pack .dir.save .dir.cancel -in .dir.bottom_frame -side left -padx 1m
    } else {
	label .dir.filename.label -text [ gettext "Load from:" ]
	entry .dir.filename.value -textvariable filename

	button .dir.load -text [ gettext "Load" ] \
		-command { load_image "$cur_folder/$filename" }
	button .dir.cancel -text [ gettext "Cancel" ] -command { destroy .dir }
	pack .dir.load .dir.cancel -in .dir.bottom_frame -side left -padx 1m
    }

    pack .dir.folder_label -side top -anchor w
    pack .dir.cur_folder -side top -anchor w -padx 6m -fill x
    pack .dir.filename.label -side left
    pack .dir.filename.value -side left -fill x -expand true
    pack .dir.bottom_frame -side bottom -pady 2m
    if [ winfo exists .dir.format ] {
	pack .dir.format -side bottom -pady 1m -fill x
    }
    pack .dir.filename -side bottom -pady 1m -fill x

    pack .dir.list -side left -pady 3m -fill both -expand true
    pack .dir.scroll -side right -pady 3m -fill y

    bind .dir.list <ButtonRelease> { refresh_directroy }

    set_geometry .dir .
    refresh_directroy
}

proc refresh_directroy {} {
    global cur_folder filename

    if { $cur_folder == "" } { set cur_folder "/" }
    catch { cd $cur_folder }

    set n [ .dir.list curselection ]

    if { 0 <= $n } {
	set s [ .dir.list get $n ]
	if [ string match "..*" $s ] {
	    cd ..
	} elseif [ file isdirectory $s ] {
	    cd $s
	} else {
	    set filename $s
	    return
	}
    }
    .dir.list delete 0 end
    set cur_folder [ pwd ]
    if { $cur_folder != "/" } { .dir.list insert end ".." }
    catch {
	foreach f [ lsort [ glob * ] ] {
	    if [ file isdirectory $f ] {
		.dir.list insert end "$f/"
	    }
	}
	foreach f [ lsort [ glob * ] ] {
	    if { ! [ file isdirectory $f ] } {
		.dir.list insert end $f
	    }
	}
    }
}

proc load_image filename {
    global tmpfile

    if { ! [ file exists $filename ] } {
	show_error [ format [ gettext "No such file: %s" ] $filename ] .dir
    } elseif { ! [ file isfile $filename ] } {
	show_error [ format [ gettext "Not a plain file: %s" ] $filename ] .dir
    } elseif { ! [ file readable $filename ] } {
	show_error [ format [ gettext "Can't read: %s" ] $filename ] .dir
    } else {
	exec convert $filename $tmpfile
	.message configure -text [ gettext "Loaded." ]
	destroy .dir
	.command.save configure -state normal
	.image.view configure -state normal
    }
}

proc save_image { dir filename } {
    global tmpfile format prog magick

    if [ regexp {^[^/]} $filename ] { set filename "$dir/$filename" }

    if [ file exists $filename ] {
	bell
	if { [ tk_messageBox -title "TkSnapshot - Overwrite?" \
		-type yesno -icon question \
		-message [ format [ gettext "File \"%s\" already exists.\
		\nDo you really want to overwrite the file?" ] $filename ] ] != "yes" } {
	    return
	}
    }

    set gif 0
    if { $format == "GIF" } { set gif 1 }
    if { $format == "Automatic" && [ regexp {\.gif$} $filename ] } { set gif 1 }
    if { $gif && $prog(convert-gif) != "" } {
	eval exec [ format $prog(convert-gif) $tmpfile $filename ]
    } else {
	if { $magick && $format != "Automatic" } {
	    regsub { .*$} $format "" s1
	    set filename "$s1:$filename"
	}
	eval exec [ format $prog(convert) $tmpfile $filename ]
    }

    .message configure -text [ gettext "Saved." ]
    destroy .dir
}

# Popup a window and show given error message.
#
proc show_error { msg { parent . } } {
    if [ winfo exists .error ] { destroy .error }

    toplevel .error
    wm title .error "TkSnapshot - Error"
    wm transient .error .

    frame .error.top -relief raised -bd 1
    frame .error.bot -relief raised -bd 1

    pack .error.top -side top -fill both -expand true
    pack .error.bot -side bottom -fill both

    label .error.mark -bitmap warning
    label .error.message -text [ gettext $msg ] -justify left -wraplength 400
    pack .error.mark .error.message -in .error.top \
            -side left -padx 3m -pady 3m -fill both -expand true

    button .error.ok -text [ gettext "OK" ] -command { destroy .error }
    pack .error.ok -in .error.bot -side bottom -pady 1m

    set_geometry .error $parent
    bell
}

# Set window geometry
#
proc set_geometry { window { parent . } } {
    if { ! [ winfo exists $parent ] } { set parent . }

    set x [ expr [ winfo rootx $parent ] + [ winfo width $parent ] / 4 ]
    set y [ expr [ winfo rooty $parent ] + [ winfo height $parent ] / 4 ]
    wm geometry $window "+$x+$y"

    update
    set x1 [ expr [ winfo screenwidth $parent ] - [ winfo width $window ] - 10 ]
    set y1 [ expr [ winfo screenheight $parent ] - [ winfo height $window ] - 15 ]
    if { $x1 < 0 } { set x1 0 }
    if { $y1 < 0 } { set y1 0 }
    if { $x1 < $x || $y1 < $y } {
	if { $x1 < $x } { set x $x1 }
	if { $y1 < $y } { set y $y1 }
	wm geometry $window "+$x+$y"
    }
}

################################################################
# Print the image to printer

proc do_print {} {
    global opt paper_width paper_height tmpfile 

    .print.command.print configure -state disabled
    update

    set arg ""
    if { $opt(orientation) == "sideways" } { append arg " -rotate -90" }

    set dx 0
    set dy 0
    set scale [ expr $opt(scale) / 100.0 ]

    if { $opt(destination) == "printer" } {
	set dest ""
	if { $opt(printer) != "" } { set dest "-P$opt(printer)" }
	if [ catch { set out [ open "| lpr $dest" w ] } ] {
	    show_error [ format [ gettext "Can't output to printer \"%s\"" ] \
		    $opt(printer) ]
	    .message configure -text [ gettext "Print failed." ]
	    set out 0
	}
    } else {
	if [ catch { set out [ open $opt(printer) w ] } ] {
	    show_error [ format [ gettext "Can't save to file \"%s\"" ] \
		    $opt(printer) ]
	    .message configure -text [ gettext "Save failed." ]
	    set out 0
	}
    }
    if { $out != 0 } {
	set in [ open [ format "| convert -page +0+0 %s %s ps:-" $arg $tmpfile ] r ]

	while { 0 <= [ gets $in line ] } {
	    if { [ scan $line "%%%%BoundingBox: %d %d %d %d" x1 y1 x2 y2 ] == 4 } {
		set x2 [ expr int($x2 * $scale) ]
		set y2 [ expr int($y2 * $scale) ]
		if { $opt(position) == "center" } {
		    set dx [ expr int(($paper_width($opt(paper)) - $x2) / 2) ]
		    set dy [ expr int(($paper_height($opt(paper)) - $y2) / 2) ]
		    set x1 $dx
		    set y1 $dy
		    set x2 [ expr $x2 + $dx ]
		    set y2 [ expr $y2 + $dy ]
		}
		puts $out [ format "%%BoundingBox: %d %d %d %d" $x1 $y1 $x2 $y2 ]
	    } else {
		puts $out $line
		if [ string match $line "%%EndProlog" ] {
		    if { $dx != 0 || $dy != 0 || $scale != 1 } {
			puts $out "%%BeginSetup"
			if { $dx != 0 || $dy != 0 } { puts $out "$dx $dy translate" }
			if { $scale != 1 } { puts $out "$scale $scale scale" }
			puts $out "%%EndSetup"
		    }
		}
	    }
	}
	close $in
	close $out
	.message configure -text [ gettext "Done." ]
    }

    update
    after 1000
    .print.command.print configure -state normal
}

set print_row 0

proc destination_changed {} {
    global opt

    if { $opt(destination) == "printer" } {
	.print.printer_l configure -text [ gettext "Printer:" ]
	.print.command.print configure -text [ gettext "Print" ]
    } else {
	.print.printer_l configure -text [ gettext "File:" ]
	.print.command.print configure -text [ gettext "Save" ]
    }
}

proc make_print_item { key label } {
    global print_row

    incr print_row
    label .print.${key}_l -text [ gettext $label ]
    grid .print.${key}_l -sticky e -row $print_row
    frame .print.${key}
    grid .print.${key} -sticky w -row $print_row -column 1
}

proc print {} {
    global cur_folder filename magick
    global print_row

    .message configure -text ""

    if [ winfo exists .print ] { destroy .print }

    toplevel .print -borderwidth 10
    wm title .print "TkSnapshot - Print"
    wm transient .print .

    make_print_item destination "Destination:"
    make_print_item printer "Printer:"
    make_print_item vspace1 ""
    make_print_item paper "Paper Size:"
    make_print_item orientation "Orientation:"
    make_print_item position "Position:"
    make_print_item scale "Scaling (%):"
    make_print_item vspace2 ""
    incr print_row
    frame .print.command
    grid .print.command -row $print_row -column 0 -columnspan 2

    radiobutton .print.destination.printer -text [ gettext "Printer" ] \
	    -variable opt(destination) -value printer -command { destination_changed }
    radiobutton .print.destination.file -text [ gettext "File" ] \
	    -variable opt(destination) -value file -command { destination_changed }
    pack .print.destination.printer .print.destination.file -side left

    entry .print.printer.printer -textvariable opt(printer)
    pack .print.printer.printer

    radiobutton .print.orientation.upright -text [ gettext "Upright" ] \
	    -variable opt(orientation) -value upright
    radiobutton .print.orientation.sideways -text [ gettext "Sideways" ] \
	    -variable opt(orientation) -value sideways
    pack .print.orientation.upright .print.orientation.sideways -side left

    radiobutton .print.paper.a4 -text [ gettext "A4" ] \
	    -variable opt(paper) -value a4
    radiobutton .print.paper.a5 -text [ gettext "A5" ] \
	    -variable opt(paper) -value a5
    radiobutton .print.paper.b5 -text [ gettext "B5" ] \
	    -variable opt(paper) -value b5
    radiobutton .print.paper.letter -text [ gettext "Letter" ] \
	    -variable opt(paper) -value letter
    pack .print.paper.a4 .print.paper.a5 .print.paper.b5 .print.paper.letter -side left

    radiobutton .print.position.center -text [ gettext "Center" ] \
	    -variable opt(position) -value center
    radiobutton .print.position.lowerleft -text [ gettext "Lower-left" ] \
	    -variable opt(position) -value lowerleft
    pack .print.position.center .print.position.lowerleft -side left

    scale .print.scale.value -orient horizontal -length 150 -from 10 -to 300 \
	    -variable opt(scale)
    pack .print.scale.value -side left

    button .print.command.print -text [ gettext "Print" ] -command { do_print }
    button .print.command.cancel -text [ gettext "Cancel" ] -command { destroy .print }
    pack .print.command.print .print.command.cancel -side left -padx 2m

    destination_changed
    set_geometry .print .
}

################################################################
# The main routine.

proc snap_type_changed {} {
    global opt

    set state disabled
    if { $opt(type) != "region" } { set state normal }

    .snap_delay.delay0 configure -state $state
    .snap_delay.delay2 configure -state $state
    .snap_delay.delay4 configure -state $state
    .snap_delay.delay8 configure -state $state
    .snap_delay.delay16 configure -state $state

    if { $opt(delay) == 0 } { set state disabled }
    .option.beep configure -state $state
}


wm title . $title
wm iconname . $program_name

wm protocol . WM_DELETE_WINDOW {
    kill_viewer
    catch { exec rm $tmpfile }
    exit 0
}

option add *Dialog.msg.wrapLength     6i

frame .command
button .command.load -text [ gettext "Load..." ] -command { browser load }
button .command.save -text [ gettext "Save..." ] -command { browser save } \
	-state disabled
button .command.print -text [ gettext "Print..." ] -command { print } \
	-state disabled
pack .command.load .command.save .command.print -side left -pady 4m -padx 2m

frame .snap_type
label .snap_type.label -text [ gettext "Snap Type:" ]
radiobutton .snap_type.window -text [ gettext "Window" ] \
	-variable opt(type) -value window -command { snap_type_changed }
radiobutton .snap_type.region -text [ gettext "Region" ] \
	-variable opt(type) -value region -command { snap_type_changed }
radiobutton .snap_type.screen -text [ gettext "Screen" ] \
	-variable opt(type) -value screen -command { snap_type_changed }
pack .snap_type.label .snap_type.window .snap_type.region .snap_type.screen \
	-side left

if { $prog(snap_region) == "" } {
    .snap_type.region configure -state disabled
}

frame .snap_delay
label .snap_delay.label -text [ gettext "Snap Delay:" ]
radiobutton .snap_delay.delay0 -text 0 -variable opt(delay) -value 0 \
	-command { snap_type_changed }
radiobutton .snap_delay.delay2 -text 2 -variable opt(delay) -value 2 \
	-command { snap_type_changed }
radiobutton .snap_delay.delay4 -text 4 -variable opt(delay) -value 4 \
	-command { snap_type_changed }
radiobutton .snap_delay.delay8 -text 8 -variable opt(delay) -value 8 \
	-command { snap_type_changed }
radiobutton .snap_delay.delay16 -text 16 -variable opt(delay) -value 16 \
	-command { snap_type_changed }
label .snap_delay.unit -text [ gettext "seconds" ]
pack .snap_delay.label .snap_delay.delay0 .snap_delay.delay2 \
	.snap_delay.delay4 .snap_delay.delay8 .snap_delay.delay16 .snap_delay.unit \
	-side left

frame .option
checkbutton .option.beep -text [ gettext "Beep During Countdown" ] \
	-variable opt(beep)
checkbutton .option.hide -text [ gettext "Hide Window During Capture" ] \
	-variable opt(hide)
pack .option.beep .option.hide -side top -anchor w

frame .image
button .image.snap -text [ gettext "Snap" ] -command { snap $opt(type) }
button .image.view -text [ gettext "View..." ] -command { view } \
	-state disabled
pack .image.snap .image.view  -side left -pady 4m -padx 2m

frame .bottom
label .message
pack .message -in .bottom -side left

pack .command -anchor w
pack .snap_type .snap_delay -anchor w -padx 4m
pack .option .image
pack .bottom -anchor w

snap_type_changed