~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

Open Mash Cross Reference
mash/tcl/applications/rover/app-rover.tcl

Component: ~ [ mash ] ~ [ apps ] ~ [ gsm ] ~ [ lib ] ~ [ otcl ] ~ [ srm ] ~ [ tcl8.3 ] ~ [ tclcl ] ~ [ tk8.3 ] ~ [ tutorials ] ~

  1 # app-rover.tcl --
  2 #
  3 #       FIXME: This file needs a description here.
  4 #
  5 # Copyright (c) 1997-2002 The Regents of the University of California.
  6 # All rights reserved.
  7 #
  8 # Redistribution and use in source and binary forms, with or without
  9 # modification, are permitted provided that the following conditions are met:
 10 #
 11 # A. Redistributions of source code must retain the above copyright notice,
 12 #    this list of conditions and the following disclaimer.
 13 # B. Redistributions in binary form must reproduce the above copyright notice,
 14 #    this list of conditions and the following disclaimer in the documentation
 15 #    and/or other materials provided with the distribution.
 16 # C. Neither the names of the copyright holders nor the names of its
 17 #    contributors may be used to endorse or promote products derived from this
 18 #    software without specific prior written permission.
 19 #
 20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
 21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 23 # ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
 24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
 26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
 27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
 28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 30 #
 31 # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/applications/rover/app-rover.tcl,v 1.13 2002/02/03 04:22:30 lim Exp $
 32 
 33 
 34 import SSAC_Client MSP_Application
 35 
 36 
 37 # This application is exactly the same as msp, but is for interfacing
 38 # with the mars archive servent, run on AS1.  Instead of using RTSP to communicate with the server, as msp does, we use SSAC.
 39 
 40 # Status: pre-alpha
 41 
 42 Class MSP_Application/Rover -superclass MSP_Application
 43 
 44 
 45 
 46 MSP_Application/Rover public init { w argv } {
 47 
 48 
 49         $self instvar ui_ net_ session_ delta_ history_
 50         $self tkvar   offset_
 51 
 52         set   net_ [new SSAC_Client]
 53         $net_ init_vars $self
 54 
 55         $self next $w $argv
 56 
 57 
 58 }
 59 
 60 # Catalog file passed from netscape is parsed here.
 61 # For now, ignore bookmarks, add them in later
 62 MSP_Application/Rover private parse_msp { msp } {
 63         set o [split $msp]
 64 
 65         set filename [lindex [split [lindex $o 1]] 1]
 66         #puts "Filename $filename"
 67         $self add_default defaultAddr $filename
 68         $self add_default defaultDesc $msp
 69         $self add_default autoStart "true"
 70 }
 71 
 72 # Catalog file which resides locally is parsed here
 73 # For now, ignore bookmarks, add them in later
 74 MSP_Application/Rover private parse_file { sFile } {
 75         #$self instvar name_ spurts_ acolor_ uname_ bookmarks_
 76         #$self instvar ui_
 77 
 78         if {$sFile == ""} {
 79                 return 0
 80         }
 81         set fd [open $sFile "r"]
 82         if { $fd <  0 } {
 83                 puts "$name_: error opening $sFile"
 84                 exit 1
 85         }
 86 
 87         set inpd 0
 88         while { [gets $fd line] > 0 } {
 89                 append pd "$line\n"
 90                 #lappend pd $line
 91         }
 92         close $fd
 93 
 94         #set filename [lindex [split [lindex $pd 1]] 1]
 95         set filename [lindex $pd 2]
 96         $self add_default defaultAddr $filename
 97         $self add_default defaultDesc $pd
 98         $self add_default autoStart "true"
 99         #$self parse_pd $pd
100 
101 
102         return 1
103 }
104 
105 
106 MSP_Application private read_bookmarks { } {
107         $self instvar ui_ bookmarks_
108         $self tkvar url_
109 
110         if [file exists ~/.msp/bookmarks.bm] {
111                 set fd [open ~/.msp/bookmarks.bm]
112                 while { [gets $fd line] > 0 } {
113                         set f [split $line "^"]
114 
115                         set addr   [lindex $f 0]
116                         set offset [lindex $f 1]
117                         set name   [lindex $f 2]
118                         set color  [string trim [lindex $f 3]]
119                         if {$color == ""} {
120                                 set color "black"
121                         }
122                         if {$url_ == $addr} {
123 
124 
125                                 set b  [new Bookmark $name $addr $offset $color]
126                                 set bookmarks_($addr:$offset) $b
127                                 set idx "$addr:$offset"
128 
129                                 set ef [$self get_option entryFont]
130                                 $ui_(main).menubar.bookmarks.list add command -font $ef \
131                                                 -label "$name ($addr:$offset)" \
132                                                 -command "[list $self jump-to $idx]"
133 
134                         }
135                 }
136                 close $fd
137         }
138 }
139 
140 
141 MSP_Application/Rover instproc build_menubar { path } {
142 
143         $self instvar net_ history_
144 
145         frame $path.menubar  -relief sunken
146         pack $path.menubar -fill x
147 
148         menubutton      $path.menubar.file -text "File" -m $path.menubar.file.x -width 5
149         pack            $path.menubar.file -side left
150         menu            $path.menubar.file.x -tearoff no
151 
152 
153         $path.menubar.file.x add command -label "Exit"        -command "$self exit"
154 
155 
156         menubutton      $path.menubar.bookmarks -text "Bookmarks" -m $path.menubar.bookmarks.list -width 10
157         pack            $path.menubar.bookmarks -side left
158 
159 
160 
161         menubutton      $path.menubar.help -text "Help" -m $path.menubar.help.help -width 5
162         pack            $path.menubar.help -side left
163 
164 
165         menu            $path.menubar.bookmarks.list -tearoff no
166         $path.menubar.bookmarks.list add command -label "Add Bookmark" -command "$self edit_bookmark .bookmark"
167         $path.menubar.bookmarks.list add separator
168         menu            $path.menubar.help.help -tearoff no
169         $path.menubar.help.help add command -label "Help"    -command " "
170 }
171 
172 MSP_Application/Rover instproc init_resources o {
173 
174         $o add_default iconPrefix "MARS Rover "
175         $self next $o
176 }
177 
178 MSP_Application/Rover instproc init_UI { path } {
179 
180         $self instvar ui_ id_
181         wm title . "MARS Rover"
182 
183         set id_ 0
184         set ui_(main) $path
185         frame $path  -relief sunken
186         pack  $path -fill x
187 
188         $self build_menubar     $path
189         $self build_ctrlpanel   $path
190         $self build_slider      $path
191         $self build_title       $path
192 }
193 
194 #
195 MSP_Application/Rover instproc open { {off 0} } {
196         $self instvar net_ history_ ui_
197         $self tkvar url_
198         $self instvar desc_
199         $self clean-up
200         # Update the history list
201         set ef [$self get_option entryFont]
202         set h $url_
203 
204         if {![info exists desc_]} {
205                 set desc_ ""
206         }
207         set err [$net_ open $url_ $desc_]
208         if { $err != "" } {
209                 Dialog transient MessageBox -type ok -text $err \
210                         -image Icons(warning)
211         }
212         return
213 }
214 
215 import MPlug/ScrolledUI
216 
217 Class MSP_Application/Rover/MPlug -superclass MSP_Application/Rover
218 
219 MSP_Application/Rover/MPlug public init { argv } {
220         $self instvar mplug_
221 
222         $self start_mplug
223 
224         # Start up mui embedded in the browser.
225         set root [$mplug_ root]
226         $self next $root.[pid] $argv
227 }
228 
229 #
230 # Starts MPlug using a scrollable window.
231 #
232 MSP_Application/Rover/MPlug public start_mplug {} {
233         $self instvar mplug_
234 
235         if { ![info exists mplug_] } {
236                 set mplug_ [new MPlug/ScrolledUI]
237         }
238 }
239 
240 
241 MSP_Application/MPlug private do_error { msg } {
242         $self instvar mplug_
243         label .label -text $msg -justify left -anchor w
244         pack .label  -fill both -expand 1 -padx 10 -pady 10
245         vwait forever
246 }
247 
248 
249 Class MSP_Application/Rover/MPlug/MSPMime \
250                 -superclass MSP_Application/Rover/MPlug
251 
252 MSP_Application/Rover/MPlug/MSPMime public init {argv} {
253         $self instvar mplug_
254         $self start_mplug
255 
256         # on success, the following function returns NPRES_DONE which is
257         # defined to 0 in a .h file
258         # FIXME: how do I pull in constants defined in .h files into tcl?
259         if { [$mplug_ wait_for_stream] } {
260                 puts stderr "Could not retrieve stream"
261                 exit
262         }
263 
264         if { [$mplug_ get mimetype] != "x-mash/x-msp" } {
265                 $self do_error "msp cannot handle mimetype:\
266                         [$mplug_ get mimetype]"
267         }
268 
269         lappend argv -msp [$mplug_ get stream]
270         $self next $argv
271         vwait forever
272 }
273 
274 

~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

This page was automatically generated by the LXR engine.
Visit the LXR main site for more information.