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

install.tcl

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

  1 # install.tcl --
  2 #
  3 #       FIXME: This file needs a description here.
  4 #
  5 # Copyright (c) 1998-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/mplug/install.tcl,v 1.6 2002/02/03 04:27:54 lim Exp $
 32 
 33 
 34 Class MPlugInstaller
 35 
 36 MPlugInstaller public init { mimetype script_name script } {
 37         $self next
 38 
 39         # create a button
 40         button .b -text "Install" -command [list $self do $mimetype \
 41                         $script_name $script]
 42         pack .b -expand 1 -fill both
 43 }
 44 
 45 
 46 MPlugInstaller private do { mimetype script_name script } {
 47         $self install $mimetype $script_name $script
 48         .b config -text "Done" -state disabled
 49 }
 50 
 51 
 52 MPlugInstaller private install { mimetype script_name script } {
 53         # write the script to disk in ~/.mash/scripts/$script_name
 54     global env
 55     if {![info exists env(HOME)]} {
 56         new ErrorWindow {Your HOME environment variable must be set.}
 57         exit 1
 58     }
 59         set mash [file join $env(HOME) .mash]
 60         if {![file exists $mash]} {
 61                 file mkdir $mash
 62         }
 63         if {![file exists [file join $mash scripts]]} {
 64                 file mkdir [file join $mash scripts]
 65         }
 66 
 67         set f [open [file join $mash scripts $script_name] w 0644]
 68         puts $f $script
 69         close $f
 70 
 71         set f [open [file join $mash prefs-mplug] a+ 0644]
 72         puts $f "script.$mimetype: [file join $mash scripts $script_name]"
 73         close $f
 74 }
 75 
 76

~ [ 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.

Open Mash Cross Reference mash/tcl/mplug/install.tcl

Open Mash Cross Reference
mash/tcl/mplug/install.tcl