
# Generic stuff.

# Copyright (c) 1993, 1994 Pacific Marketing and Consulting
# Author:  Wayne A. Christopher, wayne@pmac.com
#          Pacific Marketing and Consulting, Berkeley, California

## <h2>External commands</h2>
## These commands are used to run external programs or perform OS-dependent
## things.  Unless otherwise noted they behave similarly to the corresponding
## UNIX commands.
## All names begin with cmd_.

if [info exists tcl_platform(platform)] {
    set is_win [string compare $tcl_platform(platform) unix]
} else {
    set is_win [expr ![file exists /etc/passwd]]
}

## Remove the named files.

proc cmd_rm {args} {
    if {$args != ""} {
	if [catch {eval file delete -force -- $args} res] {
	    user_error $res
	}
    }
}

## Remove the named directories.

proc cmd_rmdir {args} {
    if {$args != ""} {
	if [catch {eval file delete -force -- $args} res] {
	    user_error $res
	}
    }
}

## Remove the named files or directories.

proc cmd_rm_r {args} {
    if {$args != ""} {
	if [catch {eval file delete -force -- $args} res] {
	    user_error $res
	}
    }
}

## Copy the first files into the last named directory, or rename a file.
proc cmd_cp {args} {
    if [catch {eval file copy -force -- $args} res] {
	mess "$res\n" red
	return 0
    } else {
	return 1
    }
}

## Recursively copy the first files into the last named directory.
proc cmd_cp_r {args} {
    if [catch {eval file copy -force -- $args} res] {
	mess "$res\n" red
	return 0
    } else {
	return 1
    }
}

## Move the first files into the last named directory.
proc cmd_mv {args} {
    if [catch {eval file rename -force -- $args} res] {
	mess "$res\n" red
	return 0
    } else {
	return 1
    }
}

## Rename <b>old</b> to <b>new</b>
proc cmd_rename {old new} {
    if [catch {file rename -force $old $new} res] {
	mess "$res\n" red
	return 0
    } else {
	return 1
    }
}

## Make a new directory with the given name.
proc cmd_mkdir {dir}      {
    if [catch {file mkdir $dir} res] {
	mess "$res\n" red
	return 0
    } else {
	return 1
    }
}

## Return the current date.
proc cmd_date {} {
    return [clock format [clock seconds]]
}

## Change the file permisssions to the given octal <b>mod</b>
proc cmd_chmod {mod file} {
    global is_win
    if !$is_win {
        if [catch {file attributes $file -permissions 0$mod} res] {
	    user_error $res
	}
    }
}

## Send a signal to the process.  On UNIX the <b>sig</b> argument gives
## the signal number.
proc cmd_kill {pid {sig 15}} {
    global is_win env

    if [catch {
	if $is_win {
            exec [win_shortname $env(ICEM_ACN)/bin/kill.exe] $pid
	} else {
	    exec [get_path kill] -$sig $pid
	}
    } res] { user_error $res }


    if 0 {
	if [catch {
	    if {[info commands win_kill_process] == "win_kill_process"} {
		# This actually works on unix also
		win_kill_process $pid $sig
	    } else {
		exec [get_path kill] -$sig $pid
	    }
	} res] { user_error $res }
    }
}

## Return the current computer's name
proc cmd_uname_n {} {
    return [info hostname]
}

if $is_win {

## Return the current user name
    proc cmd_whoami {} {
	global env
	if [info exists env(USERNAME)] {
	    return $env(USERNAME)
	} else {
	    return "user"
	}
    }
    
## Return information about the current OS
    proc cmd_uname_a {} {
	return Windows
    }
    
## Return a file that begins with <b>fn</b> that doesn't currently exist
    proc cmd_tempfile {fn {suff ""}} {
	global options
	
	if {[info exists options(temporary_directory)] && $options(temporary_directory) != ""} {
	    set pref $options(temporary_directory)/
	} else {
	    set pref ""
	}
	for {set i 0} {[file exists $pref$fn$i$suff]} {incr i} {}
    return $pref$fn$i$suff
    }
    
## Run gzip with the given args
    proc cmd_gzip {args}      { return [eval exec gzip -f $args] }
    
## Append <b>f1</b> onto the end of <b>f2</b>
    proc cmd_cat_onto {f1 f2} { return [exec cat $f1 >>$f2] }
    
## Run tar with the given args
    proc cmd_tar {args}       {
	set nargs ""
	foreach a $args {
	    regsub -all \\\\ $a / a
	    regsub -all // $a / a
	    #if [string match ?:* $a] { set a [string range $a 2 end] }
	    lappend nargs $a
	}
	puts "args $nargs"
	return [eval exec tar $nargs]
    }
    
## Run uuencode with the given args
    proc cmd_uuencode {f u {f2 ""}} {
	if {$f2 == ""} { set f2 $f }
	set stuff [exec start uuencode $f $f]
	set fp [open $u w]; puts $fp $stuff; close $fp
    }
    
## Run uudecode on the given file
    proc cmd_uudecode {uu}    { return [exec start uudecode $uu] }
    
## Run grep with the given args
    proc cmd_grep {args}      { return [eval exec grep $args] }
    
## Change the priority of process <b>pid</b> to <b>pri</b>
    proc cmd_renice {pri pid} { return "" }
    
## Run wc on the given file
    proc cmd_wc {file}        { return [exec wc $file] }
    
## Open up an Xterm or a windows command prompt in the current directory
    proc cmd_xterm {args}     {
	global bindir
	if { [ info exists bindir ] && [file exists $bindir/start.bat] } {
	    return [exec $bindir/start.bat cmd]
	} else {
	    return [exec start cmd]
	}
    }
    
## Either symbolically link <b>from</b> to <b>to</b>, or on windows, copy it
    proc cmd_ln_s {from to}   { return [file copy $from $to] }
    
    proc edit_file {{file ""} {back 0}} {
	global env
	
	if {$file == ""} {
	    set file [file_select "Filename?" [pwd]/ File 0 1]
	    if {$file == ""} { return "" }
	}
	
	catch {set env(Path) $env(PATH)}
	
	set edit notepad
	if [info exists env(EDITOR)] {set edit $env(EDITOR)}
	if [catch {
	    if $back {
		exec start $edit $file
	    } else {
		exec start /wait $edit $file
	    }
	} res] { user_error $res }
	return $file
    }
    
    proc print_file {filename} {
	global printer_name
	
	user_error "Can't print files on this system yet"
    }
    
    proc check_process_exists {pid} {
	if {[info commands win_check_process] != ""} {
	    return [win_check_process $pid]
	}
	set output [exec tlist $pid]
	if {[string trim $output] == ""} {
	    return 0
	} else {
	    return 1
	}
    }
    
## Return the current page size on the system
    proc cmd_pagesize {} {
	return 4096
    }
    
## Return the amount of free memory, if possible
    proc cmd_freemem {} {
	return 0
    }

} else {
    
    proc cmd_whoami {} {
	global env
	if {[info exists env(USER)] && ($env(USER) != "")} {
	    return $env(USER)
	} elseif {[info exists env(LOGNAME)] && ($env(LOGNAME) != "")} {
	    return $env(LOGNAME)
	} else {
	    if ![catch {exec [get_path whoami]} res] {
		set env(USER) $res
		return $res
	    } elseif {[set home [glob -nocomplain ~]] != ""} {
		return [file tail $home]
	    } else {
		return user
	    }
	}
    }
    proc cmd_uname_a {}       { return [exec [get_path uname] -a] }
    proc cmd_tempfile {fn {suff ""}} {
	global options
	
	if {[info exists options(temporary_directory)] && $options(temporary_directory) != ""} {
	    set pref $options(temporary_directory)/
	} else {
	    set pref ""
	}
	if [info exists cmd_tempfile_dir] {
	    set pref $cmd_tempfile_dir/
	} else {
	    set pref /tmp/
	}
	if [string match */* $fn] { set pref "" }
	
	for {set i 0} {[file exists $pref$fn$i$suff]} {incr i} {}
	return $pref$fn$i$suff
    }
    proc cmd_gzip {args}      { return [eval exec [get_path gzip] -f $args] }
    proc cmd_cat_onto {f1 f2} { return [exec [get_path cat] $f1 >>$f2] }
    proc cmd_tar {args}       { return [eval exec [get_path tar] $args] }
    proc cmd_uuencode {f u {f2 ""}} {
	if {$f2 == ""} { set f2 $f }
	return [exec [get_path uuencode] $f $f2 >$u]
    }
    proc cmd_uudecode {uu}    { return [exec [get_path uudecode] $uu] }
    proc cmd_grep {args}      { return [eval exec [get_path grep] $args] }
    proc cmd_renice {pri pid} {
 	catch {exec [get_path renice] $pri $pid} res
 	return $res
    }
    proc cmd_wc {file}        { return [exec [get_path wc] $file] }
    proc cmd_xterm {args}     { return [eval exec [get_path xterm] $args] }
    proc cmd_ln_s {from to}   { exec [get_path ln] -fs $from $to }
    
    proc cmd_echo {args}  { eval exec echo $args }
    
    proc edit_file {{file ""} {back 0}} {
	global env job_xterm_opts
	
	if {$file == ""} {
	    set file [file_select "Filename?" [pwd]/ File 0 1]
	    if {$file == ""} { return "" }
	}
	
	set opts ""
	if [info exists job_xterm_opts] { set opts $job_xterm_opts }
	
	set ed ""
	if [info exists env(EDITOR)] { set ed $env(EDITOR) }
	if {($ed == "") && [file exists /usr/sbin/jot]} { set ed /usr/sbin/jot }
	if {$ed == ""} { set ed [get_path vi 1] }
	if {$ed == ""} { set ed ed }
	if [catch {
	    if [string match *vi $ed] {
		if $back {
		    eval exec [get_path xterm] -geometry =80x60+0+0 \
			-title \"$file\" $opts -e [get_path vi] \"$file\" &
		} else {
		    eval exec [get_path xterm] -geometry =80x60+0+0 \
			-title \"$file\" $opts -e [get_path vi] \"$file\"
		}
	    } elseif [string match *jot $ed] {
		if $back {
		    exec $ed $file
		} else {
		    exec $ed -f $file
		}
	    } else {
		if $back {
		    exec $ed $file &
		} else {
		    exec $ed $file
		}
	    }
	} res] { user_error $res }
	
	return $file
    }
    
    proc print_file {filename} {
	global printer_name
	
	if [catch {eval exec lp -d$printer_name $filename} ret] {
	    mess "Error: Couldn't print the file: $ret\n" red
	} else {
	    mess "Sending file \"$filename\" to printer.\n"
	}
    }
    proc cmd_pagesize {} {
	if {[string match IRIX* [exec uname]] &&
	    (![catch {exec sysconf | grep PAGE_SIZE} res] || \
		 ![catch {exec sysconf | grep PAGESIZE} res])} {
	    return [lindex $res 1]
	} elseif ![catch {exec pagesize} res] {
	    return $res
	} else {
	    return 4096
	}
    }
    
    proc check_process_exists {pid} {
	# On SGI we do this a lot when we might not be able to fork because
	# of memory problems.  So ...
	#if [file exists /proc/$pid] { return 1 }
	
	set ret [catch {exec [get_path ps] -p $pid} res]
	if $ret {
	    #puts "Process fails: [get_path ps] -p $pid --> $res"
	}
	return [expr !$ret]
    }
    
    proc cmd_freemem {} {
	if {[string match IRIX* [exec uname]] && [file exists /usr/bin/sar]} {
	    if [catch {exec /usr/bin/sar -r 1} ret] { return 0 }
	    foreach l [split $ret \n] {
		if {[string trim $l] != ""} {
		    set m1 [lindex $l 1]
		    set m2 [lindex $l 2]
		}
	    }
	    if ![info exists m1] { return 0 }
	    
	    set ps [cmd_pagesize]
	    
	    # Better force this to be floating point and not int
	    set bs 512.0
	    return [expr $m1 * ($ps + 0.0) + $m2 * $bs]
	}
	    
	return 0
    }
}

## Edit the file with the user's default text editor.  If <b>back</b> is 1
## then return immediately, otherwise wait until the editor finishes
## The return value is the file that was selected (if the original file
## was blank).
proc cmd_edit_file {{file ""} {back 0}} { return [edit_file $file $back] }

## Print the file on the user's default printer.
proc cmd_print_file {filename} { print_file $filename }

## Return 1 if the process exists on the current machine, 0 otherwise
proc cmd_check_process_exists {pid} { return [check_process_exists $cmd] }

proc tmp_filename {} {
    global env is_win
    
    if [info exists env(TMPDIR)] {
	set pref $env(TMPDIR)/
    } elseif $is_win {
	set pref [pwd]/
    } else {
	set pref /tmp/
    }
    for {set i 0} 1 {incr i} {
	set file ${pref}tmp[pid].$i
	if ![file exists $file] { return $file }
    }
}

proc win_drives {} {
    global env
    
    if {[info command win_list_drives] != ""} { return [win_list_drives] }
    if {[info exists env(ICEM_ACN)] && \
	    [file exists $env(ICEM_ACN)/bin/win_list_drives.exe]} {
	return [exec $env(ICEM_ACN)/bin/win_list_drives]
    }
    set ok "A:"
    
    foreach d {C D E F G H I J K L M N O P Q R S T U V W X Y Z} {
	if {[glob -nocomplain $d:*] != ""} { lappend ok $d: }
    }
    return $ok
}

proc glob_fixed {args} {
    global is_win
    
    if $is_win { return [eval glob -nocomplain $args] }
    
    set res ""
    foreach pat $args {
	if {$pat == "~"} {
	    lappend res [glob -nocomplain ~]
	} else {
	    set dir [file dirname $pat]
	    set mat [file tail $pat]
	    if ![catch {exec /bin/ls -a $dir} files] {
		foreach f $files {
		    if [string match $mat $f] { lappend res $dir/$f }
		}
	    }
	}
    }
    return $res
}
