faxmail.tcl

使用Mail发送传真的程序

    set recipient(subject) ""

#     pack .b.b1 .b.b4 .b.b3 .b.b6 .b.b5 .b.b7 -side left
#     pack .b.b2 -side right
#     pack .b .label0 
    
#     pack .www.label9 .www.entry16 -side left
#     pack .www -after .b
    
#     pack .p.buttons.add .p.buttons.del -side top -fill x
#     pack .p.list.sy -side right -fill y
#     pack .p.list.box -side left -fill both -expand true

#     pack .p.label1 .p.list -side left
#     pack configure .p.buttons -anchor e  -side right
#     pack .p -after .www
    
#     pack .tt.f.b2 -side right
#     pack .tt.f.label3 -anchor w -side left
#     pack .tt.f -expand 1 -fill x
#     pack .tt.scroll -fill y -side right
#     pack .tt.t -anchor w
#     pack .tt -after .p
    
#     pack .w.top.left.label .w.top.left.entry -side top -anchor w
#     pack .w.top.right.label .w.top.right.entry -side top -anchor w
#     pack .w.bot.label .w.bot.entry -side top -anchor w
#     pack configure .w.bot.check -side top -fill y -anchor center
#     pack .w.top.left .w.top.right -side left -expand true -fill x
#     pack .w.top -side top -fill x
#     pack .w.bot -side top -fill y
    
#     pack .ww.label5 .ww.entry5 .ww.label6 .ww.entry6 .ww.label8 .ww.entry8 -anchor w
    
#     pack .w -side left -after .tt
#     pack .ww -side right -after .w

    update idletasks
}


# Procedure: coverage
proc coverage {} {
    global recipient
    global covfile
    global valprog

    toplevel .cov
    frame .cov.f
    message .cov.msg -text "COVERAGE LIST" -width 10i
    button .cov.f.b -text "EXIT" -command {destroy .cov} -foreground red
    set num $recipient(country)$recipient(local)$recipient(number)
    set num2 $recipient(country)-$recipient(local)-$recipient(number)   

    wm title .cov "Coverage and Number Validation"
    
    if { [string compare $recipient(number) ""] * [string compare $recipient(country) ""] * [string compare $recipient(local) ""] == 0} {
    set response " Incomplete number provided."
    } else {
    set ans [exec $valprog $num]
    if {$ans == "Number covered!"} {
    set response "Number $num2 is accessible!"
    } else {
    set response "Number $num2 is not covered at present."
    } 
    }
    message .cov.f.msg -relief raised -text $response -width 70i -foreground blue
    text .cov.doc -relief sunken -bd 2 -yscrollcommand ".cov.scroll set"
    scrollbar .cov.scroll -command ".cov.doc yview"
    pack .cov.msg
    pack .cov.f.msg -side left -fill x -expand 1
    pack .cov.f.b -side right 
    pack .cov.f -side top -expand 1 -fill x
    pack .cov.scroll -side right -fill y
    pack .cov.doc -side left
    bind .cov.doc <Button-1> {.cov.doc config -state normal} 
    set f [open $covfile]
    while {![eof $f]} { .cov.doc insert end [read $f 1000] }
    close $f
    grab set .cov
    tkwait window .cov
}


# Procedure: done
proc done {} {
 
    global user

    set f [open ~/.faxinit w]
    puts $f $user(fax)
    puts $f $user(tel)
    puts $f $user(name)
    puts $f $user(organisation)
    puts $f $user(department)
    puts $f $user(email)

    close $f
    destroy .pref
}


# Procedure: error
proc error { text} {
    toplevel .error
#    label .error.msg -text "File not found"
    message .error.msg2 -text $text -width 10i
#    label .error.msg3 -text "FAX NOT SENT"
    button .error.b -text "OK" -command {destroy .error}
    label .error.label -bitmap warning
#    pack .error.label .error.msg .error.msg2 .error.msg3 .error.b
    pack .error.label .error.msg2 .error.b 
    grab set .error
    tkwait window .error
}

# Procedure: checknum
proc checknum {mode} {
    global recipient
    
    set response ""
    if {$recipient(country) == ""} {
	set response "$response Must set COUNTRY CODE\n"
    } else {
	if {![regexp {^[0-9]+$} $recipient(country)]} {
	    set response "$response Remove punctuation from COUNTRY CODE\n"
	}
    }
    if {$recipient(local) == ""} {
	set response "$response Must set LOCAL CODE\n"
    } else {
	if {![regexp {^[0-9]+$} $recipient(local)]} {
	    set response "$response Remove punctuation from LOCAL CODE\n"
	}
    }
    if {[string compare $recipient(number) ""]==0} {
	set response "$response Must set FAX NUMBER\n"
    } else {
	if {![regexp {^[0-9]+$} $recipient(number)]} {
	    set response "$response Remove punctuation from FAX NUMBER\n"
	}
    }
    if { $response == "" } {
	if { $mode == 1 } {
	coverage
	}
	return 1
    } else {
	error $response
	return 0
    }
}
# Procedure: fax
proc fax {} {
    
    global recipient
    global user
    global mailer
    global tmp
    
    if { ![checknum 0] } return

    
    set addr remote-printer@$recipient(country)$recipient(local)$recipient(number).iddd.tpc.int
    
    set message [.tt.t get 1.0 end]
    
    if {$message == "\n"} {
	if {[.p.list.box index end] == 0} {
	    no {TEXT or POSTSCRIPT that you wish to send}
	    return
	}
    }
    set f [open "$tmp/.fax$user(name)" w]
    
    puts $f "Subject:      $recipient(subject)"
    puts $f "MIME-Version: 1.0"
    puts $f "Content-Type: Multipart/mixed; boundary=xxxDsZYb46dwyf6tr431jhbgxxx"
    puts $f ""
    puts $f ""
    puts $f "--xxxDsZYb46dwyf6tr431jhbgxxx"
    puts $f "Content-Type: application/remote-printing"
    puts $f ""
    puts $f "Recipient:    $recipient(name)"
    puts $f "Title:        "
    puts $f "Organization: $recipient(organisation)"
    puts $f "Address:      "
    puts $f "Telephone:     "
    puts $f "Facsimile:    +$recipient(country) $recipient(local) $recipient(number)"
    puts $f "Email:        $recipient(email)" 
    puts $f ""
    puts $f "Originator:   $user(name)"
    puts $f "Organization: $user(organisation)"
    puts $f "Telephone:    $user(tel)"
    puts $f "Facsimile:    $user(fax)"
    puts $f "Email:        $user(email)" 
    
    if {$message == "\n"} {
    } else {
	puts $f "--xxxDsZYb46dwyf6tr431jhbgxxx"
	puts $f "Content-Type: text/plain"
	puts $f ""
	puts $f $message
    }

    foreach attach [.p.list.box get 0 end] {
	set filename [lindex $attach end] 
	if [file exists $filename] {
	    if [regexp {^\(plain} $attach] {
		set mimetype "text/plain"
		set coding "7bit"
		set f2 [open $filename r]
	    } elseif [regexp {^\(postscript} $attach] {
		set mimetype "application/postscript"
		set coding "7bit"
		set f2 [open $filename r]
	    } elseif [regexp {^\(image} $attach] {
		set mimetype "application/postscript"
		set coding "7bit"
		if { [catch {exec convert $filename /tmp/faxtmp.ps} ] } {
		    error "FAX NOT SENT\nCouldn't recognise image file\n$filename, please check"
		    return  
		} else {
		    set f2 [open "/tmp/faxtmp.ps" r]
		}
	    } else {
		error "FAX NOT SENT\nProblem with file attachements, please check"
		return
	    }
	    puts $f "--xxxDsZYb46dwyf6tr431jhbgxxx"
	    puts $f "Content-Type: $mimetype"
	    puts $f "Content-Transfer-Encoding: $coding"
	    puts $f ""
	    while {[gets $f2 line] >= 0} {
		puts $f $line
	    }
	} else {
	    error "FAX NOT SENT\n File not found\n \"$element\""
	    return
	}
	close $f2
	puts $f ""
	puts $f ""
	if [regexp {^\(image} $attach] {
	    exec rm /tmp/faxtmp.ps
	}
    }

    puts $f "--xxxDsZYb46dwyf6tr431jhbgxxx--"
    close $f
    
    exec $mailer -oi $addr < $tmp/.fax$user(name)
    sent
}


# Procedure: init
proc init {} {
    global user
    global covfile
    global valprog
    global mailer
    global tmp
    global address
    global argv

    set mailer [lindex $argv 0]
    set valprog [lindex $argv 1]
    set covfile [lindex $argv 2]
    set tmp [lindex $argv 3]
    
    if [file exists ~/.faxinit] {
        set f [open ~/.faxinit r]
    gets $f user(fax)
    gets $f user(tel)
    gets $f user(name)
    gets $f user(organisation)
    gets $f user(department)
    gets $f user(email)
    close $f
    if {$user(fax) == "Your Fax Number"} {
         set user(fax) "Sender's Fax Number"
   	 set f [open ~/.faxinit w]
  	  puts $f $user(fax)
   	  puts $f $user(tel)
    	  puts $f $user(name)
    	  puts $f $user(organisation)
    	  puts $f $user(department)
   	  puts $f $user(email)
         close $f
         preferences
        }
    } else {
        preferences
    }
}


# Procedure: no
proc no { text} {
    toplevel .error
    label .error.msg -text "The $text must be set"
    label .error.msg2 -text "FAX NOT SENT"
    button .error.b -text "OK" -command {destroy .error}
    label .error.label -bitmap warning
    pack .error.label .error.msg .error.msg2 .error.b
    grab set .error
    tkwait window .error
}

# Procedure: punctuation
proc punctuation { text} {
    toplevel .error
    label .error.msg -text "No punctuation allowed in $text "
    label .error.msg2 -text "FAX NOT SENT"
    button .error.b -text "OK" -command {destroy .error}
    label .error.label -bitmap warning
    pack .error.label .error.msg .error.msg2 .error.b
    grab set .error
    tkwait window .error
}

# Procedure: preferences
proc preferences {} {
    global user

    if [file exists ~/.faxinit] {
	set f [open ~/.faxinit r]
	gets $f user(fax)
	gets $f user(tel)
	gets $f user(name)
	gets $f user(organisation)
	gets $f user(department)
	gets $f user(email)


	close $f
    }
    
    toplevel .pref
    label .pref.label0 -text "SENDER'S COVER-SHEET\n DETAILS"
    label .pref.label1 -text ""
    label .pref.label2 -text "FAX NUMBER:"
    label .pref.label3 -text "TEL NUMBER:"
    label .pref.label5 -text "NAME:"
    label .pref.label6 -text "ORGANISATION:"
    label .pref.label7 -text "DEPARTMENT:"
    label .pref.label8 -text "EMAIL:"

    wm title .pref "Sender's Cover Sheet Details"
    
    entry .pref.entry10 -width 40 -relief sunken -bd 2 -textvariable user(fax)
    entry .pref.entry11 -width 40 -relief sunken -bd 2 -textvariable user(tel)
    entry .pref.entry12 -width 40 -relief sunken -bd 2 -textvariable user(name)
    entry .pref.entry13 -width 40 -relief sunken -bd 2 -textvariable user(organisation)
    entry .pref.entry14 -width 40 -relief sunken -bd 2 -textvariable user(department)
    entry .pref.entry15 -width 40 -relief sunken -bd 2 -textvariable user(email)
    
    button .pref.b1 -command done -text "OK" -foreground red
    
    pack .pref.label0 
    pack .pref.label1 
    pack .pref.label5 .pref.entry12 -anchor w 
    pack .pref.label6 .pref.entry13 -anchor w
    pack .pref.label7 .pref.entry14 -anchor w
    pack .pref.label2 .pref.entry10 -anchor w
    pack .pref.label3 .pref.entry11 -anchor w
    pack .pref.label8 .pref.entry15 -anchor w
    
    pack .pref.b1 
    
    grab set .pref
    tkwait window .pref
}


# Procedure: ps_browse
proc file_add {type ext} {
    global {fsBox}
    
    set fsBox(pattern) "*$ext"
    set file_name [FSBox]
    if { $file_name == "" } return
    if { ![file readable $file_name] || ![file isfile $file_name] } {
	error "\"$file_name\" is not a readable file."
    } else {
	.p.list.box insert end "$type $file_name"
    }
}


# Procedure: quit
proc quit {} {
    destroy .
}


# Procedure: sent
proc sent {} {
    global user
    global mailer
    global tmp
    toplevel .sent
    
    frame .sent.bbb
    label .sent.msg -text "FAX SENT"
    label .sent.msg2 -text ""
    label .sent.msg3 -text "Copy to inbox?"

    button .sent.bbb.yes -text "YES" -command {
	exec $mailer -oi  $user(email) < $tmp/.fax$user(name)
	exec rm $tmp/.fax$user(name)
	destroy .sent
    }

    button .sent.bbb.no -text "NO" -command {
	exec rm $tmp/.fax$user(name)
	destroy .sent
    }

    label .sent.label -bitmap warning
    pack .sent.bbb.yes .sent.bbb.no
    pack .sent.label .sent.msg .sent.msg2 .sent.msg3 .sent.bbb
    grab set .sent
    tkwait window .sent
}


# User de