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

# TkPrintTool (Version 0.21), 2000-08-29
#
# Copyright (C) 2000 by T.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 "TkPrintTool"
set title "$program_name  (Version 0.21)"

wm title . $title
wm iconname . $program_name

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 banner 1

set default_printer "lp"
catch {
    set f [ open "| lpstat -d" r ]
    gets $f line
    close $f
    regexp {: *([^ ]+)} $line junk default_printer
}
catch { set default_printer $env(LPDEST) }
catch { set default_printer $env(PRINTER) }

if { [ catch { set cmd [ exec which lpstat ] } ] \
	|| ! [ file executable $cmd ] } {
    set prog(lpq)       "lpq"
    set prog(lpq-arg)   "lpq -P%s"
    set prog(lpr)       "lpr -#%d"
    set prog(lpr-arg)   "lpr -P%s -#%d"
    set prog(lprm)      "lprm"
    set opts(nobanner)   "-h"
} else {
    set prog(lpq)       "lpstat"
    set prog(lpq-arg)   "lpstat -d%s"
    set prog(lprm)      "cancel"
    set prog(lpr)       "lp -s -n %d"
    set prog(lpr-arg)   "lp -s -d %s -n %d"
    set opts(nobanner)   "-o nobanner"
}

set folder_image [image create bitmap -data {
    #define folder_width 32
    #define folder_height 16
    static unsigned char folder_bits[] = {
	0x00, 0x00, 0x00, 0x00, 0xc0, 0x03, 0x00, 0x00, 0x20, 0x04, 0x00, 0x00,
	0x18, 0xf8, 0x00, 0x00, 0x04, 0x00, 0x01, 0x00, 0x04, 0x00, 0x03, 0x00,
	0x04, 0x00, 0x03, 0x00, 0x04, 0x00, 0x03, 0x00, 0x04, 0x00, 0x03, 0x00,
	0x04, 0x00, 0x03, 0x00, 0x04, 0x00, 0x03, 0x00, 0x04, 0x00, 0x03, 0x00,
	0x04, 0x00, 0x33, 0x33, 0xfc, 0xff, 0x33, 0x33, 0xf0, 0xff, 0x03, 0x00,
	0x00, 0x00, 0x00, 0x00, };
    } ]

proc gettext msg {
    global lang

    if [ regexp {^ja_|^japanese|^ja$} $lang junk ] {
	switch -glob $msg {
	    "New..." \
		    { return "追加..." }
	    "Edit..." \
		    { return "編集..." }
	    "Delete" \
		    { return "削除" }
	    "Close" \
		    { return "閉じる" }
	    "Pattern:" \
		    { return "パターン:" }
	    "Filter:" \
		    { return "フィルタ:" }
	    "OK" \
		    { return "OK" }
	    "Cancel" \
		    { return "取り消し" }
	    "Printing %s..." \
		    { return "%s を印刷中..." }
	    "Printing %s... done." \
		    { return "%s を印刷中... 完了。" }
	    "No such file or the file is not readable: %s" \
		    { return "ファイルがないか、読み込み可能ではありません: %s" }
	    "Checking printer..." \
		    { return "プリンタの状態をチェック中..." }
	    "Checking printer... done." \
		    { return "プリンタの状態をチェック中... 完了。" }
	    "Canceling %s..." \
		    { return "要求 %s の取り消し..." }
	    "Canceling %s... done." \
		    { return "要求 %s の取り消し... 完了。" }
	    "Printer: %s\n" \
		    { return "プリンタ: %s\n" }
	    "Device: %s" \
		    { return "デバイス: %s\n" }
	    "Remote Host: %s\n" \
		    { return "リモート・ホスト: %s\n" }
	    "Remote Printer: %s\n" \
		    { return "リモート・プリンタ: %s\n" }
	    "Filename:" \
		    { return "ファイル名:" }
	    "Configure..." \
		    { return "設定..." }
	    "Copies:" \
		    { return "部数:" }
	    "Option:" \
		    { return "オプション:" }
	    "Print Banner Page" \
		    { return "バナー・ページを印刷" }
	    "Print" \
		    { return "印刷" }
	    "Printer:" \
		    { return "プリンタ:" }
	    "Information..." \
		    { return "情報..." }
	    "Status" \
		    { return "ステータス" }
	    "Stop Printing" \
		    { return "要求の取り消し" }
	    default \
		    { return $msg }
        }
    }
    return $msg
}

################################################################
# Procedures to manipulate filters

proc read_filters {} {
    global argv0 env binding

    # system level configuration file, like "/usr/local/lib/tkprinttool.bind"
    regsub {(bin)?/[^/]+$} $argv0 "" conf_file
    append conf_file "lib/tkprinttool.bind"

    set binding {}
    set bind_patterns {}
    foreach file [ concat $env(HOME)/.tkprinttool.bind $conf_file ] {
	if [ file readable $file ] {
	    set f [ open $file r ]
	    while { 0 <= [ gets $f line ] } {
		scan $line "%s %\[^\n\]" s1 s2
		if { [ lsearch -exact $bind_patterns $s1 ] < 0 } {
		    lappend binding [ list $s1 $s2 ]
		    lappend bind_patterns $s1
		}
	    }
	    close $f
	}
    }
}

proc save_filters {} {
    global env binding

    set f [ open [ concat $env(HOME)/.tkprinttool.bind ] w ]
    for { set i 0 } { $i < [ llength $binding ] } { incr i } {
	set s [ lindex $binding $i ]
	puts $f [ format "%s %s" [ lindex $s 0 ] [ lindex $s 1 ] ]
    }
    close $f
}

proc configure_filters {} {
    global binding

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

    toplevel .conf -border 2m
    wm title .conf "TkPrintTool - Configure Filters"
    wm transient .conf .

    frame .conf.filter
    listbox .conf.filter.list -width 50 -height 8 \
	    -selectmode single -exportselection false \
	    -yscrollcommand ".conf.filter.scroll set" -font fixed
    bind .conf.filter.list <ButtonRelease> { filter_selected }
    scrollbar .conf.filter.scroll -orient vertical \
	-command ".conf.filter.list yview"
    pack .conf.filter.list -side left -fill both -expand true
    pack .conf.filter.scroll -side right -fill y

    frame .conf.buttons
    button .conf.buttons.new -text [ gettext "New..." ] -command { edit_filter new }
    button .conf.buttons.edit -text [ gettext "Edit..." ] -command { edit_filter edit }
    button .conf.buttons.delete -text [ gettext "Delete" ] -command { edit_filter delete }
    button .conf.buttons.close -text [ gettext "Close" ] -command { destroy .conf }
    pack .conf.buttons.new .conf.buttons.edit .conf.buttons.delete \
	    -side left -padx 1m
    pack .conf.buttons.close -side right

    pack .conf.filter -side top -fill both -expand true -pady 2m
    pack .conf.buttons -side bottom -fill x -expand true

    set_geometry .conf
    refresh_filter_list
}

proc filter_selected {} {
    if { 0 <= [ .conf.filter.list curselection ] } {
	.conf.buttons.edit configure -state normal
	.conf.buttons.delete configure -state normal
    } else {
	.conf.buttons.edit configure -state disabled
	.conf.buttons.delete configure -state disabled
    }
}

proc edit_filter op {
    global binding edit_index edit_pattern edit_filter

    if { $op == "delete" } {
	set n [ .conf.filter.list curselection ]
	if { 0 <= $n } {
	    set binding [ lreplace $binding $n $n ]
	    save_filters
	    refresh_filter_list
	}
    } else {
	if [ winfo exists .edit ] { destroy .edit }

	toplevel .edit -border 2m
	wm title .edit "TkPrintTool - Edit Filter"
	wm transient .edit .
	
	label .edit.pattern_l -text [ gettext "Pattern:" ]
	entry .edit.pattern_v -width 25 -textvariable edit_pattern
	label .edit.filter_l -text [ gettext "Filter:" ]
	entry .edit.filter_v -textvariable edit_filter
	frame .edit.buttons
	button .edit.ok -text [ gettext "OK" ] -command { filter_ok }
	button .edit.cancel -text [ gettext "Cancel" ] -command { destroy .edit }
	pack .edit.ok .edit.cancel -in .edit.buttons -side left -padx 1m
	grid .edit.pattern_l -row 0 -sticky e -pady 1m
	grid .edit.pattern_v -row 0 -column 1 -sticky ew -padx 1m
	grid .edit.filter_l -row 1 -sticky e -pady 1m
	grid .edit.filter_v -row 1 -column 1 -sticky ew -padx 1m
	grid .edit.buttons -row 2 -columnspan 2 -padx 1m -pady 2m

	set_geometry .edit .conf.buttons

	set edit_index [ .conf.filter.list curselection ]
	set edit_pattern ""
	set edit_filter ""
	if { $op == "edit" } {
	    if { 0 <= $edit_index } {
		set s [ lindex $binding $edit_index ]
		set edit_pattern [ lindex $s 0 ]
		set edit_filter [ lindex $s 1 ]
	    }
	}
    }
}

proc filter_ok {} {
    global binding edit_index edit_pattern edit_filter

    regsub {^ +| +$} $edit_pattern "" edit_pattern
    regsub {^ +| +$} $edit_filter "" edit_filter

    if { $edit_pattern != "" && $edit_filter != "" } {
	if { $edit_index == "" } {
	    set binding [ linsert $binding -1 \
		    [ list $edit_pattern $edit_filter ] ]
	} else {
	    set binding [ lreplace $binding $edit_index $edit_index \
		    [ list $edit_pattern $edit_filter ] ]
	}
	save_filters
	refresh_filter_list
	destroy .edit
    }
}

proc refresh_filter_list {} {
    global binding

    .conf.filter.list delete 0 end
    for { set i 0 } { $i < [ llength $binding ] } { incr i } {
	set s [ lindex $binding $i ]
	set pattern [ lindex $s 0 ]
	set filter [ lindex $s 1 ]
	.conf.filter.list insert end [ format "%-10s %s" $pattern $filter ]
    }
    filter_selected
}


proc find_filter {} {
    global filename filter binding

    for { set i 0 } { $i < [ llength $binding ] } { incr i } {
	set s [ lindex $binding $i ]
	set pattern [ lindex $s 0 ]
	if [ string match $pattern $filename ] {
	    set filter [ lindex $s 1 ]
	    return
	}
    }
}

################################################################
# Send request to the printer

proc print {} {
    global prog opts filename copies filter banner

    .message configure -text ""
    .print configure -state disabled
    after 2000 { .print configure -state normal }
    update

    if [ file readable $filename ] {
	.message configure -text [ format [ gettext "Printing %s..." ] $filename ]
	update

	set cmd [ format $prog(lpr) $copies ]
	set inx [ .printer_v.list curselection ]
	if { 1 <= $inx } {
	    set printer [ .printer_v.list get $inx ]
	    set cmd [ format $prog(lpr-arg) $printer $copies ]
	}

	set options ""
	if { ! $banner } { append options " $opts(nobanner)" }

	regsub {^ +| +$} $filter "" filter
	if { $filter == "" } {
	    eval exec "$cmd $options $filename"
	} else {
	    eval exec "[ format $filter $filename ] | $cmd $options"
	}
	lpq

	after 500
	.message configure -text [ format [ gettext "Printing %s... done." ] $filename ]
    } else {
	tk_messageBox -title "TkPrintTool - Error" \
		-type ok -icon error \
		-message [ format [ gettext "No such file or the file is not readable: %s" ] \
		$filename ]
    }
}

################################################################
# "lpq" results:
#     lp is ready and printing
#     Rank   Owner      Job  Files                        Total Size
#     active tsato      8    (standard input)            1693 bytes
#     1st    tsato      9    (standard input)             324 bytes
#
# "lpstat" results:
#     scheduler is running
#     system default destination: lp
#     device for lp: /dev/ecpp0
#     lp accepting requests since Oct 27 17:16 1996
#     printer lp now printing lp-1767. enabled since Oct 27 17:16 1996. available.
#     lp-1767      tsato    29449   Oct 27 12:02 on lp
#     lp-1768      tsato     1817   Oct 27 12:05

proc lpq {} {
    global prog

    .message configure -text [ gettext "Checking printer..." ]
    update

    set cmd $prog(lpq)
    set inx [ .printer_v.list curselection ]
    if { 1 <= $inx } {
	set printer [ .printer_v.list get $inx ]
	set cmd [ format $prog(lpq-arg) $printer ]
    }
    .status.list delete 0 end
    catch {
	set f [ open "| $cmd " r ]
	while { 0 <= [ gets $f line ] } {
	    .status.list insert end $line
	}
	close $f
    }
    .status.list see end
    list_selected

    .message configure -text [ gettext "Checking printer... done." ]
}

proc lprm {} {
    global prog

    .message configure -text ""

    set jobs ""
    foreach i [ .status.list curselection ] {
	set s1 [ .status.list get $i ]
	switch -glob $prog(lpq) {
	    "lpq*" {
		set job [ lindex $s1 2 ]
		if [ regexp {^[0-9]+$} $job ] { append jobs " $job" }
	    }
	    "lpstat*" {
		set job [ lindex $s1 0 ]
		if { [ regexp {^[0-9]+$} [ lindex $s1 2 ] ] \
			&& regexp {^[^ ]+-[0-9]+$} $job ] } { append jobs " $job" }
	    }
	    default {
		puts "tkprinttool: $prog(lpq) should \"lpq\" or \"lpstat\""
	    }
	}
    }
    if { $jobs != "" } {
	.message configure -text [ format [ gettext "Canceling %s..." ] $jobs ]
	update

	eval exec $prog(lprm) $jobs
	lpq

	.message configure -text [ format [ gettext "Canceling %s... done." ] $jobs ]
    }
}

proc list_selected {} {
    if { [ .status.list curselection ] != "" } {
	.command.stop configure -state normal
    } else {
	.command.stop configure -state disabled
    }
}

################################################################
# List printers

proc list_printers {} {
    global printer_info default_printer

    if [ file readable "/etc/printcap" ] {
	set f [ open "/etc/printcap" r ]
	while { 0 <= [ gets $f line ] } {
	    if [ regexp {^[ \t]*[^ \t#]} $line junk ] {
		regsub {[:|].*$} $line "" printer_name
		.printer_v.list insert end $printer_name

		regsub {:.*$} $line "" s1
		if { 0 <= [ lsearch -exact [ split $s1 {|} ] $default_printer ] } {
		    .printer_v.list selection set end
		}

		regsub {:.*$} $line "" s1
		regsub {\|} $s1 ", " s1
		set info [ format [ gettext "Printer: %s\n" ] $s1 ]
		while { [ regexp {\\$} $line junk ] && 0 <= [ gets $f line ] } {
		    if [ regexp {lp=([^:]+)} $line junk s1 ] {
			append info [ format [ gettext "Device: %s" ] $s1 ]
		    }
		    if [ regexp {rm=([^:]+)} $line junk s1 ] {
			append info [ format [ gettext "Remote Host: %s\n" ] $s1 ]
		    }
		    if [ regexp {rp=([^:]+)} $line junk s1 ] {
			append info [ format [ gettext "Remote Printer: %s\n" ] $s1 ]
		    }
		}
		set printer_info($printer_name) $info
	    }
	}
	close $f
    } else {
	catch {
	    set f [ open "| lpstat -v" r ]
	    while { 0 <= [ gets $f line ] } {
		if [ regexp {.* ([^ ]+):} $line junk printer_name ] {
		    .printer_v.list insert end $printer_name
		    if { $printer_name == $default_printer } {
			.printer_v.list selection set end
		    }
		    set printer_info($printer_name) $line
		}
	    }
	    close $f
	}
    }
}

proc show_info {} {
    global printer_info

    set inx [ .printer_v.list curselection ]
    set msg $printer_info([ .printer_v.list get $inx ])

    if [ winfo exists .info ] { destroy .info }
    
    toplevel .info
    wm title .info "TkPrintTool - Information"
    wm transient .info .
    
    frame .info.top -relief raised -bd 1
    frame .info.bot -relief raised -bd 1
    pack .info.top -side top -fill both -expand true
    pack .info.bot -side bottom -fill both
    
    label .info.message -justify left -text $msg
    pack .info.message -in .info.top -padx 4m -pady 4m
    
    button .info.ok -text [ gettext "Close" ] -command { destroy .info }
    pack .info.ok -in .info.bot -side bottom -pady 1m

    set_geometry .info
}

################################################################
# 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"
    }
}

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

frame .top
pack .top -side top -fill x -anchor w -pady 3m -padx 3m

set row 0

label .filename_l -text [ gettext "Filename:" ]
frame .filename_v
entry .filename_entry -textvariable filename -width 30
bind .filename_entry <Return> { find_filter }
button .filename_button -image $folder_image -pady 1 \
	-command { set filename [ tk_getOpenFile ]; find_filter }
pack .filename_entry -in .filename_v -side left -fill x -expand true
pack .filename_button -in .filename_v -side right
grid .filename_l -in .top -padx 2m -sticky e -row $row
grid .filename_v -in .top -padx 2m -sticky w -row $row -column 1 -columnspan 2
incr row

label .filter_l -text [ gettext "Filter:" ]
entry .filter_v -textvariable filter -width 30
button .set_filter -text [ gettext "Configure..." ] -command { configure_filters }
grid .filter_l   -in .top -padx 2m -sticky e -row $row
grid .filter_v   -in .top -padx 2m -sticky we -row $row -column 1
grid .set_filter -in .top -padx 2m -sticky w -row $row -column 2
incr row


label .copies_l -text [ gettext "Copies:" ]
tk_optionMenu .copies_v copies 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
grid .copies_l   -in .top -padx 2m -sticky e -row $row
grid .copies_v   -in .top -padx 2m -sticky w -row $row -column 1
incr row

label .option_l -text [ gettext "Option:" ]
checkbutton .banner -text [ gettext "Print Banner Page" ] -variable banner
button .print -text [ gettext "Print" ] -command { print }
grid .option_l   -in .top -padx 2m -sticky e -row $row
grid .banner     -in .top -padx 2m -sticky w -row $row -column 1
grid .print      -in .top -padx 2m -sticky e -row $row -column 2
incr row

label .printer_l -text [ gettext "Printer:" ]
frame .printer_v
listbox .printer_v.list -width 20 -height 4 \
	-selectmode single -exportselection false \
	-yscrollcommand ".printer_v.scroll set"
scrollbar .printer_v.scroll -orient vertical -command ".printer_v.list yview"
pack .printer_v.list -side left -fill both
pack .printer_v.scroll -side right -fill y
button .printer_info -text [ gettext "Information..." ] -command { show_info }
grid .printer_l    -in .top -padx 2m -sticky en -row $row           -pady 6m
grid .printer_v    -in .top -padx 2m -sticky wn -row $row -column 1 -pady 6m
grid .printer_info -in .top -padx 2m -sticky en -row $row -column 2 -pady 6m
incr row

frame .status
label .status.label -text [ gettext "Status" ]
listbox .status.list -width 30 -height 6 -font { fixed } \
	-selectmode extended -exportselection false \
	-yscrollcommand ".status.scroll set"
bind .status.list <ButtonRelease> { list_selected }
scrollbar .status.scroll -orient vertical -command ".status.list yview"
pack .status.label -side top -anchor w
pack .status.list -side left -fill both -expand true
pack .status.scroll -side right -fill y
pack .status -side top -fill both -expand true -padx 3m
incr row

frame .command
button .command.status -text [ gettext "Status" ] -command { lpq }
button .command.stop -text [ gettext "Stop Printing" ] -command { lprm }
pack .command.status .command.stop -side left -padx 2m
pack .command -side top -pady 2m

label .message
pack .message -side top -anchor w

read_filters
list_printers
list_selected