faxview.tcl

涉及Fax/Mail/Voice通讯编程的一个程序

	    }
	}

    } else {

	set f $files

	set first [lindex $files 0]

	set d "[file dirname $first]"
	set n "[file tail $first] ..."

	eval "log_entry $log"

	set res [catch "eval exec $command"]

	if {$res != 0} {

	    eval "log_entry $log -- failed"
	}
    }
}


proc do_view {} {

    global view_command view_single

    spawn view_command $view_single .button.view {$n: Viewing file}
}


proc do_print {} {

    global print_command print_single

    spawn print_command $print_single .button.print {$n: Printing file}
}


proc do_remove {} {

    set files [filenames]

    if {$files == ""} {

	return
    }

    foreach f $files {

	lappend n [file tail $f]
    }

    set b [xdialog Question "Do you really want to remove `[join $n {', `}]'?"]

    if {$b == 0} {

	set command {rm -f $f >/dev/null}

	spawn command 0 .button.remove {$n: Removing file}

	.button.update invoke
    }
}


proc do_update {} {

    global curr_dir
    global file_type
    global multi_page

    # We got the power ...
    #
    if [regexp {^[~/]} $file_type] {

	set path $file_type

    } else {

	if {$curr_dir == "/"} {

	    set path /$file_type

	} else {

	    set path $curr_dir/$file_type
	}
    }

    if [file isdirectory $path] {

	regsub {/?$} $path {&*} path
    }

    set directory [file dirname $path]

    if ![file readable $directory] {

	log_entry "$directory: Access denied\n"

	return 0
    }

    set curr_dir $directory
    set file_type [file tail $path]

    set match [lsort -command "compare {file mtime}" [glob -nocomplain $path]]

    .dialog.files.list delete 0 end
    .dialog.dirs.list delete 0 end

    if $multi_page {

	set pages {}

	foreach f $match {

	    if [file isdirectory $f] {

		continue
	    }

	    while 1 {

		if ![llength $pages] {

		    set name [file tail $f]
		    set base [file rootname $name]

		    if {$directory == "/"} {

			set root /$base

		    } else {

			set root $directory/$base
		    }

		    set ext [expr [string length $root] + 1]
		}

		if {[string first . $name] < 0} {

		    .dialog.files.list insert end $name

		    break;
		}

		if [string match $root.* $f] {

		    lappend pages [string range $f $ext end]

		    break;
		}

		if {[llength $pages] == 1} {

		    .dialog.files.list insert end $name

		} else {

		    .dialog.files.list insert end $base.\{[join $pages ,]\}
		}

		set pages {}
	    }
	}

	if {[llength $pages] == 1} {

	    .dialog.files.list insert end $name

	} elseif {[llength $pages] > 1} {

	    .dialog.files.list insert end $base.\{[join $pages ,]\}
	}

    } else {

	foreach f $match {

	    if ![file isdirectory $f] {

		.dialog.files.list insert end [file tail $f]
	    }
	}
    }

    if {$curr_dir != "/"} {

	.dialog.dirs.list insert end ".."
    }

    foreach f [lsort $match] {

	if [file isdirectory $f] {

	    set f [file tail $f]

	    if {$f != "." && $f != ".."} {

		.dialog.dirs.list insert end $f
	    }
	}
    }
}


proc do_home {} {

    global curr_dir
    global curr_name
    global home_dir

    set curr_dir $home_dir
    set curr_name ""

    .button.update invoke
}


proc set_name {} {

    global curr_name

    regsub -all "\n" [selection get] " " curr_name
}


proc set_dir {} {

    global curr_name
    global curr_dir

    # We should be able to go up, too.
    #
    if {$curr_dir == "."} {

	set dir [pwd]

    } else {

	set dir $curr_dir
    }

    # Apply the selection.
    #
    set sel [selection get]

    if {$sel == ".."} {

	set dir [file dirname $dir]

    } else {

	if {$dir != "/"} {

	    set dir "$dir/$sel"

	} else {

	    set dir "/$sel"
	}
    }

    # Check it out!
    #
    if ![file readable $dir] {

	return 0
    }

    # Deselect the filename.
    #
    set curr_dir $dir
    set curr_name ""
}


# Build the user interface.
#
. configure \
	-borderwidth 4

pack [frame .dialog] \
	-fill both -pady 4

xentry .dialog.name {Selected filenames:} curr_name
xentry .dialog.glob {Type of file:} file_type

pack .dialog.name [frame .dialog.gap -height 8] .dialog.glob \
	-fill x -padx 4

pack [frame .dialog.listboxes] \
	-fill both

xlistbox .dialog.files Files: -width 32 -height 8 -selectmode extended
xlistbox .dialog.dirs Directories: -width 32 -height 8 -selectmode single

pack .dialog.files .dialog.dirs \
	-in .dialog.listboxes \
	-side left -padx 4

checkbutton .dialog.files.multi_page \
	-text {Collect pages} -variable multi_page -command do_update

place .dialog.files.multi_page \
	-in .dialog.files.list \
	-relx 1.0 -y -2 -anchor se

pack [frame .command -borderwidth 4] \
	-fill both

pack [xentry .command.view {Viewing command:} view_command] \
	-fill x

checkbutton .command.view_single \
	-text {Single filenames} -variable view_single

place .command.view_single \
	-in .command.view.entry \
	-relx 1.0 -y -2 -anchor se

pack [xentry .command.print {Printing command:} print_command] \
	-fill x

checkbutton .command.print_single \
	-text {Single filenames} -variable print_single

place .command.print_single \
	-in .command.print.entry \
	-relx 1.0 -y -2 -anchor se

pack [frame .log -borderwidth 4] \
	-fill both

pack [label .log.label -text {Process information:}] \
	-fill x

text .log.text \
	-width 0 -height 6 \
	-padx 2 -state disabled \
	-relief sunken -borderwidth 2 \
	-yscrollcommand {.log.scrollbar set}

scrollbar .log.scrollbar \
	-command {.log.text yview}

pack .log.text \
	-side left -fill both -expand 1

pack .log.scrollbar [frame .log.gap -width 4] \
	-side right -fill y

checkbutton .log.wrap_lines \
	-text {Wrap lines} -variable wrap_lines -command set_wrap

place .log.wrap_lines \
	-in .log.text \
	-relx 1.0 -y -2 -anchor se

proc set_wrap {} {

    global wrap_lines

    if $wrap_lines {

	.log.text configure -wrap word

    } else {

	.log.text configure -wrap none
    }
}

set_wrap

proc buttons {args} {

    pack [frame .button] \
	    -side bottom -fill both

    while {[llength $args] > 1} {

	set t [lindex $args 0]
	set c [lindex $args 1]

	pack [button .button.[string tolower $t] -text $t -command $c] \
		-side left -padx 4 -pady 4

	set args [lrange $args 2 end]
    }

    pack [frame .seperator -height 8] \
	    -side bottom -fill x
}

buttons	View do_view \
	Print do_print \
	Remove do_remove \
	Update do_update \
	Home do_home \
	Exit exit

.button.update invoke

bind .dialog.name.entry <Return> {.button.view invoke}
bind .dialog.name.entry <Escape> {.button.exit invoke}
bind .dialog.glob.entry <Return> {.button.update invoke}
bind .dialog.glob.entry <Escape> {.button.exit invoke}
bind .command.view.entry <Return> {.button.view invoke}
bind .command.view.entry <Escape> {.button.exit invoke}
bind .command.print.entry <Return> {.button.print invoke}
bind .command.print.entry <Escape> {.button.exit invoke}

bind .dialog.files.list <ButtonRelease-1> \
	{set_name}
bind .dialog.files.list <Double-Button-1> \
	{set_name; .button.view invoke}
bind .dialog.dirs.list <Double-Button-1> \
	{set_dir; .button.update invoke}

log_entry {Starting session}
.log.text yview 0


# faxview.tcl ends here