File: appletalk.tcl

package info (click to toggle)
tkchooser 2.0652-7
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 432 kB
  • ctags: 272
  • sloc: tcl: 3,344; makefile: 76; sh: 13
file content (314 lines) | stat: -rw-r--r-- 8,982 bytes parent folder | download | duplicates (3)
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
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
## This is the appletalk module for tkchooser2
## This file defines and provides a higher-level
## API to the underlying software layer (Netatalk, in this case)
## and handles non service-specific stuff
## Ideally a plugin relying on appletalk doesn't need to know
## what the underlying appletalk layer is built with. A
## CAP appletalk module could drop in and replace this one
## without the plugins caring at all.
##
## Major protocol modules must provide a start function,
## a setcurrzone function, and an unload function
##
## Ethan Gold <etgold@cs.vassar.edu> 2/24/98
##
#### appletalk module plugin API spec (function followed by description):
##
## proc appletalk.nbplkup {entity}
#### Function to lookup a given appletalk entity.
#### name:type@zone or =:=@* for wildcards.
#### Returns an unordered list of raw output from
#### the nbplkup program. Not very platform independant.
#### Should be used in conjunction with namesfromlkup.
##
## proc appletalk.getcurrzone {}
#### function to return the current zone
#### returns a "*" if none is set or there are no zones.
##
## proc appletalk.namesfromlkup {results}
#### function to parse names out of entity lists
#### takes results from nbplkup and returns just the names
#### in dictionary sorted order.
##
## proc appletalk.print {printer filename}
#### function to send a file to the printer using
#### whatever the printer-talking utility is called.
#### This MIGHT have to move into the plugin if all
#### sorts of happy printer options are to be supported.


if {[debug]} {
    puts "Loading netatalk appletalk module..."
}

#### Appletalk global variables ####
## global "appletalkdir" defined in the config file
set atalk_currzone ""
set atalk_defzone ""
set atalk_zonelist ""
if {![info exists atalk_phase1]} {
    set atalk_phase1 0
}
if {$debug && $atalk_phase1} {
    puts "appletalk: configuring for phase1 network only"
}

## delay between zonelist refreshed in milliseconds
## this doesn't need to happen very often
set atalk_zonedelay 60000
set atalk_afterID ""

## external program names
set getzones "getzones"
set nbplkup "nbplkup"
set print "pap"
set appletalk_dependancies "$getzones $nbplkup $print"
#### End Appletalk global variables ####

############ Required functions - API to main ##############

## startup procedure
proc appletalk.start {} {
    if {[debug]} {
	puts "appletalk: starting appletalk module"
    }
    appletalk.delzones
    appletalk.delentities
    appletalk.setzones
    ## call once to get the default zone
    appletalk.setdefzone
    appletalk.setcurrzone [appletalk.getdefzone]
    appletalk.refresh
    ## call again to make sure it's active in the listbox
    appletalk.setdefzone
}

## shutdown procedure
proc appletalk.stop {} {
    global atalk_afterID
    if {[debug]} {
	puts "appletalk: stopping appletalk module"
    }
    after cancel $atalk_afterID
    appletalk.delentities
}

## procedure to set the current zone
proc appletalk.setcurrzone {newzone} {
    global atalk_currzone
    set atalk_currzone $newzone
}

############ End Required functions - API to main ##############
############ Function API for plugins ##############

## Function to lookup a given entity.
## Returns an unordered list of raw output from
## the nbplkup program. Not very platform independant.
## Should be used in conjunction with namesfromlkup.
proc appletalk.nbplkup {entity} {
    global nbplkup
    set results [list]

    if {[debug]} { puts "appletalk: looking up up entity $entity" }

    ## put quotes around the name so the caller doesn't have to
    set lkupfd [open "|$nbplkup \"$entity\"" r]
    while { [gets $lkupfd line] != -1 } {
	#set results [lappend $results, $line]
	lappend results $line
    }
    if {[debug]} { puts "nbplkup results: $results" }
    #return [lsort $results]
    return $results
}

## function to return the current zone
## returns a "*" if none is set or there are no zones.
proc appletalk.getcurrzone {} {
    global atalk_currzone
    if {[string compare $atalk_currzone ""] == 0} { return "*" }
    return $atalk_currzone
}

## function to parse names out of entity lists
## takes results from nbplkup and returns just the names
## in dictionary sorted order.
proc appletalk.namesfromlkup {results} {
    set names [list]
    foreach result $results {
	set name [lindex [split $result :] 0]
	set name [string trim $name \ ]
	lappend names $name
    }
    ## kludge in case our tcl version is too old to
    ## support the -dictionary sorting option
    if { [catch {set newnames [lsort -dictionary $names]}] !=0 } {
	set newnames [lsort -ascii $names]
    }
    return $newnames
}

## function to send a file to the printer using
## whatever the printer-talking utility is called.
## This MIGHT have to move into the plugin if all
## sorts of happy printer options are to be supported.
proc appletalk.print {printer filename filterflag} {
    global print printfilterfile
    set plugframe [plug_frame]

    if {!$filterflag} {
	if {[debug]} {puts "appletalk: executing $print \
		-p \"$printer\" $filename"}
	set pipefd [open "|$print -p \"$printer\" \
		$filename" r]
    } else {
	if {[file readable $printfilterfile]} {
	    ## read in filter command
	    set filtfd [open "$printfilterfile" r]
	    gets $filtfd filtcmd
	    close $filtfd
	    if {[debug]} {puts "appletalk: executing: $filtcmd $filename | \
		    $print -p \"$printer\""}
	    set pipefd [open "|$filtcmd $filename | $print \
		    -p \"$printer\"" r]
	} else {
	    error "appletalk" "Could not find the printfilter file \
		    $printfilterfile. Please uncheck the filter \
		    option and try again."
	    return ""
	}
    }
    set result ""
    while {[gets $pipefd line] != -1} {
	set result "$result\n$line"
	$plugframe.status configure -text $line
    }
    catch {close $pipefd}
    return $result
}

#########  End Function API for plugins  ############

######### begin general utility functions ###########
## function to return zones
proc appletalk.getzones {} {
    global getzones atalk_phase1
    set atalk_zonelist [list]
    if {!$atalk_phase1} {
	set zonefd [open "|$getzones" r]
	while { [gets $zonefd line] != -1 } {
	    lappend atalk_zonelist $line
	}
	catch {close $zonefd}
    }
    return $atalk_zonelist
}

proc appletalk.getdefzone {} {
    global getzones atalk_phase1
    if {$atalk_phase1} {return "*"}
    set fd [open "|$getzones -m" r]
    while { [gets $fd line] != -1 } {
	return $line
    }
}

## procedure to show current zonelist
proc appletalk.setzones {} {
    foreach name [appletalk.getzones] {
	.leftside.bot.zones insert end $name
    }
}

## procedure to set the default zone (at startup)
proc appletalk.setdefzone {} {
    set thezone [appletalk.getdefzone]
    set size [.leftside.bot.zones size]

    for {set i 0} {$i<$size} {incr i} {
	set name [.leftside.bot.zones get $i]
	if {[string compare $name $thezone] == 0} {
	    .leftside.bot.zones selection set $i
	    update
	    return
	}
    }
    
}

## procedure to delete zone listings
proc appletalk.delzones {} {
    .leftside.bot.zones del 0 end
}

proc appletalk.delentities {} {
    set pluglist [plug_list]
    $pluglist delete 0 end
}

## looping procedure to refresh zone listings
proc appletalk.refresh {} {
    global atalk_zonedelay atalk_afterID

    if {[debug]} { puts "appletalk: refreshing zonelist" }
    appletalk.delzones
    appletalk.setzones
    set atalk_afterID [after $atalk_zonedelay {appletalk.refresh}]
}

############# End general utility functions ###############

## make sure we can find everything we need. if not,
## unset our global flag! we only need one of the dependancies
## in this case, so check separately
## this is a really ugly attempt at streamlining
#set atalk_ok 1
#if {[info exists appletalkdir]} {
#    foreach item $appletalk_dependancies {
#	set loc $appletalkdir/bin/$item
#	if {[file executable $loc]} {
#	    lappend locs $loc
#	} else {set atalk_ok 0}
#    }
#}
## assume they're all in the same place - if not
## who knows what will happen anyway
#if {!$atalk_ok} {
#    puts "appletalk: could not find $appletalk_dependancies in \
#	    $appletalkdir/bin. Check chooser.cfg and netatalk installation."
#    set locs [check_deps $appletalk_dependancies]
#    set atalk_ok 1
#}

set locs [check_deps $appletalk_dependancies]
set atalk_ok 1

## make sure we found them all
foreach item $locs {
    if {![file executable $item]} {
	set atalk_ok 0
	break
    }
}
if {!$atalk_ok} {
    puts "appletalk: Can't find required programs: \
	    $appletalk_dependancies."
    puts "appletalk: Netatalk may not be installed or your \
	    PATH may be incorrect. Disabling appletalk."
    set appletalkflag 0
}

if {$appletalkflag} {
    if {[debug]} {puts "appletalk: found $locs"}
    set getzones [lindex $locs 0]
    set nbplkup [lindex $locs 1]
    set print [lindex $locs 2]
}
catch {unset item}
catch {unset locs}
catch {unset loc}

if {[debug]} { puts "Finished loading netatalk appletalk module." }