## -*-Tcl-*- # ################################################################### # Vince's Additions - an extension package for Alpha # # FILE: "bibAdditions.tcl" # created: 6/8/95 {4:23:11 pm} # last update: 31/1/1999 {2:34:46 pm} # Author: Vince Darley # E-mail: # mail: Division of Applied Sciences, Harvard University # Oxford Street, Cambridge MA 02138, USA # www: # # This file is part of the package "Vince's Additions". # See its documentation for more details. # # This file contains basic utility proedures used by # the bibliography tools so they work both under Alpha # and under more general (e.g. Unix) Tcl interpreters. # # Bug reports and feature requests to: # # ################################################################### ## ## # in case we wish to use auto-loading: just call this procedure # to ensure 'bibAdditions.tcl' is loaded. ## proc dummyBibAdditions {} {} # check if we're using Alpha, and if so sort out the interface if {![catch {alpha::package exists Alpha}]} { # only do this first time we're sourced set vince_usingAlpha [alpha::package exists Alpha] } else { set vince_usingAlpha 0 } ## # Given an input file name, an output extension, a set of possible input # extensions, a possible output file name, and a possible mapping from # abbreviated input extensions to full extensions, this procedure will # make sure the input file exists (either as given or with one of the # extensions attached), will generate the output file name if necessary, # and will return the full extension of the input file. # # See my 'proc bibConvert' for an example of using this procedure. ## proc vince_parseFileNames { fin outextension extensionlist { fout default } { abbrev "" } } { global bibconv::use_alpha bibconv::pr bibconv::types bibconv::extensions set extension [file extension $fin] if { $extension != "" } { if { ![file exists $fin] } { ${bibconv::pr} "Input file '$fin' does not exist" return } else { # have an extension, and file exists. # we don't care if it's in the extensionlist, but do care # if it's in the abbreviation list. if { $abbrev != "" } { upvar $abbrev extarray set e [string range $extension 1 end] if {[info exists extarray($e)]} { set extension .$extarray($e) } } } } else { # No extension was supplied, we must generate our own if { $abbrev != "" } { set fe [vince_findFile $fin $abbrev 1] } else { set fe [vince_findFile $fin $extensionlist 0] } if { $fe == "" } { vince_print "Couldn't find an appropriate existing extension for '$fin'" return } set fin [lindex $fe 0] set extension [lindex $fe 1] } # now we have both 'fin' and 'extension' # just need 'fout' if { $fout == "default" } { set fout [string range ${fin} 0 \ [expr [string length ${fin}] - \ [string length [file extension ${fin}]] - 1]].${outextension} } return [list $fin $fout [string range $extension 1 end] ] } ## # Used by the above procedure. # # Given an input file name and a set of possible extensions or # abbreviated extension mappings, this procedure will find the # correct input file if it exists. ## proc vince_findFile { fin extlist isarray } { if {$isarray} { upvar $extlist ext_abbreviations # if we have an abbreviation list foreach suf [array names ext_abbreviations] { if {[file exists ${fin}.${suf} ]} { return [list ${fin}.${suf} .$ext_abbreviations($suf) ] } } } else { # else use the full extensions foreach suf $extlist { if {[file exists ${fin}.${suf} ]} { return [list ${fin}.${suf} .$suf ] } } } return "" } ## # The following procedures are here so that this code can be used # without Alpha being present (perhaps under Tickle or on a unix # workstation). ## proc vince_print { str } { global vince_usingAlpha if { $vince_usingAlpha } { message $str } else { puts $str } } proc vince_edit { file } { global vince_usingAlpha if { $vince_usingAlpha } { edit $file } } proc vince_askyesno { text } { global vince_usingAlpha if { $vince_usingAlpha } { return [askyesno $text] } else { puts $text gets stdin yes return $yes } } proc vince_getFile { text { action "" } } { global vince_usingAlpha if { $vince_usingAlpha } { # find window set fname [win::Current] if { $fname == "" } { set fname [getfile $text ] if { $fname == "" } { return } if { $action == "edit" } { edit $fname } } # add a colon to workaround an Alpha bug cd "[file dirname $fname]:" } else { puts $text gets stdin fname cd "[file dirname $fname]" } set fin [file tail $fname] return $fin } .