view release on metacpan or  search on metacpan

bin/consult  view on Meta::CPAN

#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

################################################################################
# To do
# -----
# Save defaults for program to run, text colour etc
################################################################################

package require cmdline

################################################################################
# Some global variables
################################################################################

set display_information 1
set filehandle ""
set filename ""
set program "simpleshell"
set error ""
set choice ""

toplevel .askme
wm withdraw .askme

################################################################################
# The question asking dialog
################################################################################

proc ask_the_user {message argv} {
	# Restore the toplevel item so that we can 
	# put the dialog box together

	wm deiconify .askme
	wm title .askme "What I want to know is?"

	# Set the question text

	label .askme.l -text $message -padx 10 -pady 10 -wraplength 300
	pack .askme.l -side top -anchor n

	# The is where the users choice will go
	global choice
	set choice ""

	# Set up each button
	set counter 1
	foreach option $argv {
		button .askme.$counter -text $option -command [list set choice $counter]
		pack .askme.$counter -side top -anchor n -fill x
		incr counter
	}

	vwait choice

	# Our option has been set, now dismantel the 
	# contents of the toplevel so we can build it
	# up again from scratch next time.

	wm withdraw .askme
	destroy .askme.l
	set counter 1
	foreach option $argv {
		destroy .askme.$counter
		incr counter
	}

	return $choice
}

################################################################################
# Setting up the window
################################################################################

proc main {} {
	wm title . "Simple Inference Engine"
	wm geometry . 500x500

	# The top frame holds the buttons

bin/consult  view on Meta::CPAN

proc do_save {} {
	status "Save the output..."

	set types { {{Text Files} {.txt} } {{All Files} * } }

	set filename [tk_getSaveFile -filetypes $types -title "Save the results of a run" -initialfile "Results.txt"]

	if {$filename != ""} {
		if {[file isfile $filename] == 0} {
			status "The file you selected is not really a file"
		} elseif {[file writeable $filename] == 0} {
			status "The file you selected in not writeable"
		} else {
			status "Saving the output to $filename"
			set handle [open $filename "w"]
			puts $handle [.text get 0.1 end]
			close $handle
		}
	} {
		status "No file was selected"
	}
}

################################################################################
# Utility functions
################################################################################

proc status      {text} { mymessage $text is_status }
proc question    {text} { mymessage $text is_question }
proc response    {text} { mymessage $text is_response }
proc answer      {text} { mymessage $text is_answer }

proc information {text} {
	global display_information
	if {$display_information == 1} {
		mymessage $text is_information
	}
}

proc mymessage {text tag} {
	.text insert end "$text\n" $tag
	.text see end
	update
}

################################################################################
# The program starts here
################################################################################

# Was there a filename on the command line

set p_count 0

while {[set err [cmdline::getopt argv {f.arg p.arg} opt val]] > 0} {
	switch -- $opt {
		f {
			if {$filename == ""} {
				set filename $val
			} {
				set error "The $opt switch should only be used once"
			}
		}
		p {
			if {$p_count == 0} {
				set program $val
				incr p_count
				if {[file executable $program] != 1} {
					set error "The program '$program' is not runable"
				}
			} {
				set error "The $opt switch should only be used once"
			}
		}
	}
}

if {$err < 0} {
	puts "There was an error: $val"
	exit
}\
elseif {$error != ""} {
	puts "There was an error: $error"
	exit
}

main