1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
|
## -*-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: <darley@fas.harvard.edu>
# mail: Division of Applied Sciences, Harvard University
# Oxford Street, Cambridge MA 02138, USA
# www: <http://www.fas.harvard.edu/~darley/>
#
# 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:
# <mailto:darley@fas.harvard.edu>
# ###################################################################
##
##
# 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
}
|