summaryrefslogtreecommitdiff
path: root/systems/mac/support/alpha/tcl/extensions/bibAdditions.tcl
blob: fd3995713304709120941642aebef45070307582 (plain)
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
}