faxmail.tcl

使用Mail发送传真的程序

      puts stderr "$fsBoxResult"
    }
  }
  set fsBoxElementList [lsort $fsBoxResult]

  foreach fsBoxCounter [winfo children .fsBox.pattern.patterns.patterns] {
    if {[string length [info commands XFDestroy]] > 0} {
      catch {XFDestroy $fsBoxCounter}
    } {
      catch {destroy $fsBoxCounter}
    }
  }
  menu .fsBox.pattern.patterns.patterns.menu
  catch ".fsBox.pattern.patterns.patterns.menu config $tmpButtonOpt"

  if {$fsBox(extensions)} {
    .fsBox.pattern.patterns.patterns.menu add command  -label "*"  -command {
        global fsBox
        set fsBox(pattern) "*"
        .fsBox.pattern.pattern delete 0 end
        .fsBox.pattern.pattern insert 0 $fsBox(pattern)
        FSBoxFSShow [.fsBox.path.path get] $fsBox(pattern)  $fsBox(all)}
  }

  if {"$fsBoxPath" != "/"} {
    .fsBox.files.files insert end "../"
  }
  foreach fsBoxCounter $fsBoxElementList {
    if {[string match $fsBoxPattern $fsBoxCounter] ||
        [IsADir [string trimright $fsBoxPath/$fsBoxCounter "/@"]]} {
      if {"$fsBoxCounter" != "../" &&
          "$fsBoxCounter" != "./"} {
        .fsBox.files.files insert end $fsBoxCounter
      }
    }

    if {$fsBox(extensions)} {
      catch "file rootname $fsBoxCounter" fsBoxRootName
      catch "file extension $fsBoxCounter" fsBoxExtension
      set fsBoxExtension [string trimright $fsBoxExtension "/*@"]
      if {"$fsBoxExtension" != "" && "$fsBoxRootName" != ""} {
        set fsBoxInsert 1
        set fsBoxLast [.fsBox.pattern.patterns.patterns.menu index last]
        for {set fsBoxCounter1 0} {$fsBoxCounter1 <= $fsBoxLast} {incr fsBoxCounter1 1} {
          if {"*$fsBoxExtension" ==  "[lindex [.fsBox.pattern.patterns.patterns.menu entryconfigure  $fsBoxCounter1 -label] 4]"} {
            set fsBoxInsert 0
          }
        }
	if {$fsBoxInsert} {
          .fsBox.pattern.patterns.patterns.menu add command  -label "*$fsBoxExtension"  -command "
              global fsBox
              set fsBox(pattern) \"*$fsBoxExtension\"
              .fsBox.pattern.pattern delete 0 end
              .fsBox.pattern.pattern insert 0 \$fsBox(pattern)
              FSBoxFSShow \[.fsBox.path.path get\] \$fsBox(pattern)  \$fsBox(all)"
        }
      }
    }
  }
  if {$fsBox(extensions)} {
    .fsBox.pattern.patterns.patterns.menu add separator
  }
  if {$fsBox(extensions) || 
      "[.fsBox.pattern.patterns.patterns.menu index last]" == "none"} {
    .fsBox.pattern.patterns.patterns.menu add checkbutton  -label "Scan extensions"  -variable "fsBox(extensions)"  -command {
        global fsBox
        FSBoxFSShow [.fsBox.path.path get]  [.fsBox.pattern.pattern get] $fsBox(all)}
  }
}


# Procedure: IsADir
proc IsADir { pathName} {
# xf ignore me 5
##########
# Procedure: IsADir
# Description: check if name is a directory (including symbolic links)
# Arguments: pathName - the path to check
# Returns: 1 if its a directory, otherwise 0
# Sideeffects: none
##########

  if {[file isdirectory $pathName]} {
    return 1
  } {
    catch "file type $pathName" fileType
    if {"$fileType" == "link"} {
      if {[catch "file readlink $pathName" linkName]} {
        return 0
      }
      catch "file type $linkName" fileType
      while {"$fileType" == "link"} {
        if {[catch "file readlink $linkName" linkName]} {
          return 0
        }
        catch "file type $linkName" fileType
      }
      return [file isdirectory $linkName]
    }
  }
  return 0
}


# Procedure: IsAFile
proc IsAFile { fileName} {
# xf ignore me 5
##########
# Procedure: IsAFile
# Description: check if filename is a file (including symbolic links)
# Arguments: fileName - the filename to check
# Returns: 1 if its a file, otherwise 0
# Sideeffects: none
##########

  if {[file isfile $fileName]} {
    return 1
  } {
    catch "file type $fileName" fileType
    if {"$fileType" == "link"} {
      if {[catch "file readlink $fileName" linkName]} {
        return 0
      }
      catch "file type $linkName" fileType
      while {"$fileType" == "link"} {
        if {[catch "file readlink $linkName" linkName]} {
          return 0
        }
        catch "file type $linkName" fileType
      }
      return [file isfile $linkName]
    }
  }
  return 0
}


# Procedure: IsASymlink
proc IsASymlink { fileName} {
# xf ignore me 5
##########
# Procedure: IsASymlink
# Description: check if filename is a symbolic link
# Arguments: fileName - the path/filename to check
# Returns: none
# Sideeffects: none
##########

  catch "file type $fileName" fileType
  if {"$fileType" == "link"} {
    return 1
  }
  return 0
}


# Procedure: about
proc about {} {
    toplevel .about
    label .about.msg -text "FaxMail Ver 2.3"
    label .about.msg2 -text ""
    label .about.msg3 -text "By David Burns, Shyamal Somaroo, Matthew Davey."
    label .about.msg4 -text "Copyright (c) 1995 - 1998"
    label .about.msg5 -text ""
    label .about.msg6 -text "Homepage: http://wol.ra.phy.cam.ac.uk/FaxMail/"
    wm title .about "About FaxMail"
    button .about.b -text "EXIT" -command {destroy .about} -foreground red
    pack .about.msg .about.msg2 .about.msg3 .about.msg4 .about.msg5 .about.msg6 .about.b
    grab set .about
    tkwait window .about
}


# Procedure: addr_clear
proc addr_clear {} {
global addr_book

set w .address.frame11
set addr_book(modified) 1

$w.entry23 delete 0 end
$w.entry24 delete 0 end
$w.entry25 delete 0 end
$w.entry26 delete 0 end
$w.entry27 delete 0 end
$w.entry28 delete 0 end
}


# Procedure: addr_close
proc addr_close {} {
global addr_book
global yesno

if { $addr_book(modified) == 1 } {
  ShowWindow.yesno
  .yesno.message configure -text "Save changes to address book?"
   tkwait variable yesno(result)
   if {$yesno(result) == "yes"} {
     addr_write }
}
   destroy .address
}


# Procedure: addr_delete
proc addr_delete {} {
global addr_book

set lbox .address.frame12.frame.listbox1
if {[$lbox curselect] == ""} return
set addr_book(modified) 1
for {set ix [$lbox curselect]} {$ix < [expr [$lbox index end] - 1]} {incr ix 1} {
   set iy [expr $ix + 1]
   set addr_book($ix,alias) $addr_book($iy,alias)
   set addr_book($ix,country) $addr_book($iy,country)
   set addr_book($ix,local) $addr_book($iy,local)
   set addr_book($ix,fax) $addr_book($iy,fax)
   set addr_book($ix,name) $addr_book($iy,name)
   set addr_book($ix,org) $addr_book($iy,org)
   set addr_book($ix,email) $addr_book($iy,email)
}
   unset addr_book($ix,alias) 
   unset addr_book($ix,country) 
   unset addr_book($ix,local) 
   unset addr_book($ix,fax) 
   unset addr_book($ix,name)
   unset addr_book($ix,org) 
   unset addr_book($ix,email)
set ix [$lbox curselection]
$lbox delete $ix
$lbox select set [expr $ix - 1]
if {[$lbox index end]} {
 addr_set
} else {
 set w .address.frame11
 addr_clear
 $w.addr_title_frame.alias configure -text ""
 $w.entry23 configure -state disabled
 $w.entry24 configure -state disabled
 $w.entry25 configure -state disabled
 $w.entry26 configure -state disabled
 $w.entry27 configure -state disabled
 $w.entry28 configure -state disabled
}
}


# Procedure: addr_name
proc addr_name {} {
global addr_book
global prompt

set alist .address.frame12.frame.listbox1
if {[$alist curselection] == ""} return
ShowWindow.entry
set ix [$alist curselection]
.entry.m configure -text "Enter alias name:"
.entry.entry delete 0 end
.entry.entry insert 0 $addr_book($ix,alias)
focus .entry.entry
grab .entry
tkwait variable prompt(ok)
destroy .entry
if {$prompt(ok)} {
 set addr_book(modified) 1
 set addr_book($ix,alias) $prompt(result)
 $alist delete $ix
 $alist insert $ix $prompt(result)
 $alist select set $ix
 .address.frame11.addr_title_frame.alias configure -text $prompt(result)
}
}


# Procedure: addr_new
proc addr_new {} {
global prompt
global addr_book

ShowWindow.entry
.entry.m configure -text "Enter alias name:"
.entry.entry delete 0 end
focus .entry.entry
grab .entry
tkwait variable prompt(ok)
destroy .entry
set alist .address.frame12.frame.listbox1
if {$prompt(ok)} {
    set addr_book(modified) 1
    $alist insert end $prompt(result)
    $alist select clear 0 end
    $alist select set end
    set ix_end [expr [$alist index end] - 1]
    set addr_book($ix_end,alias) $prompt(result)
    set addr_book($ix_end,country) ""
    set addr_book($ix_end,local) ""
    set addr_book($ix_end,fax) ""
    set addr_book($ix_end,name) ""
    set addr_book($ix_end,org) ""
    set addr_book($ix_end,email) ""
    if {$ix_end == 0} {
	set w .address.frame11
	$w.entry23 configure -state normal
	$w.entry24 configure -state normal
	$w.entry25 configure -state normal
	$w.entry26 configure -state normal
	$w.entry27 configure -state normal
	$w.entry28 configure -state normal
    }
    addr_set
}
}


# Procedure: addr_select
proc addr_select {} {
global addr_book
global recipient

set ix [.address.frame12.frame.listbox1 curselection]
if {$ix == ""} return
set recipient(country) $addr_book($ix,country)
set recipient(local) $addr_book($ix,local)
set recipient(number) $addr_book($ix,fax)
set recipient(name) $addr_book($ix,name)
set recipient(organisation) $addr_book($ix,org)
set recipient(email) $addr_book($ix,email)
checknum 0
}


# Procedure: addr_set
proc addr_set {} {
global address
global addr_book

set alist .address.frame12.frame.listbox1
set index [$alist curselection]
if {$index >= 0} {
 .address.frame11.addr_title_frame.alias configure -text $addr_book($index,alias)
 .address.frame11.entry23 configure -textvariable addr_book($index,country)
 .address.frame11.entry24 configure -textvariable addr_book($index,local)
 .address.frame11.entry25 configure -textvariable addr_book($index,fax)
 .address.frame11.entry26 configure -textvariable addr_book($index,name)
 .address.frame11.entry27 configure -textvariable addr_book($index,org)
 .address.frame11.entry28 configure -textvariable addr_book($index,email)
# addr_select
}
}


# Procedure: addr_write
proc addr_write {} {
global addr_book

set f [open ~/.fax_addr w]
for {set i 0} {$i < [.address.frame12.frame.listbox1 index end]} {incr i 1} {
puts $f [list $addr_book($i,alias) $addr_book($i,country)  $addr_book($i,local) $addr_book($i,fax)  $addr_book($i,name) $addr_book($i,org)  $addr_book($i,email) ]
}
 close $f
}


# Procedure: addresses
proc addresses {} {
global address
global addr_book

set addr_book(modified) 0
if { [file exists ~/.fax_addr ] == 0 } {
   set f [open ~/.fax_addr w]
#  puts $f ""
   close $f
}
set count 0
set f [open ~/.fax_addr r]
while { [gets $f addr_line ] >= 0 } {
   set addr_book($count,alias) [lindex $addr_line 0]
   set addr_book($count,country) [lindex $addr_line 1]
   set addr_book($count,local) [lindex $addr_line 2]
   set addr_book($count,fax) [lindex $addr_line 3]
   set addr_book($count,name) [lindex $addr_line 4]
   set addr_book($count,org) [lindex $addr_line 5]
   set addr_book($count,email) [lindex $addr_line 6]
   set count [expr {$count + 1} ]
}
close $f
ShowWindow.address
tkwait visibility .address
set alist .address.frame12.frame.listbox1 
$alist delete 0 end
for {set i 0} {$i < $count} {incr i 1} {
  $alist insert end $addr_book($i,alias)
}
$alist select clear 0 end
$alist select set 0
if {$count > 0} {
 addr_set
} else {   
 set addr_book($count,alias) ""
 set addr_book($count,country) ""
 set addr_book($count,local) ""
 set addr_book($count,fax) ""
 set addr_book($count,name) ""
 set addr_book($count,org) "" 
 set addr_book($count,email) ""
 $alist insert end $addr_book($i,alias)
 $alist select clear 0 end
 $alist select set 0 
 addr_delete
 set addr_book(modified) 0
}
}


# Procedure: clear
proc clear {} {
    global recipient

    .tt.t delete 1.0 end
    .p.list.box delete 0 end
    set recipient(country) ""
    set recipient(local) ""
    set recipient(number) ""
    set recipient(name) ""
    set recipient(organisation) ""
    set recipient(department) ""
    set recipient(email) ""