# fshow.tcl --
 #    A simple user-interface to the F compiler,
 #    just to show that such things can be done in
 #    what is essentially an OS-independent way
 #

 # showMain --
 #    Show the main window
 # Arguments:
 #    None
 # Result:
 #    None
 # Side effect:
 #    The main window is filled
 #
 proc showMain {} {

    #
    # Set up the (simple) menu bar
    set  mw    .menu
    menu       $mw
    menu       $mw.file  -tearoff false
    menu       $mw.edit  -tearoff false
    menu       $mw.view  -tearoff false
    menu       $mw.help  -tearoff false

    $mw add cascade -label File   -menu $mw.file
    $mw add cascade -label Edit   -menu $mw.edit
    $mw add cascade -label View   -menu $mw.view
    $mw add cascade -label Help   -menu $mw.help

    . configure -menu $mw

    #
    # Set up the "File" menu
    #
    $mw.file add command -label New -underline 0 \
       -command [list NewFile .tedit]
    $mw.file add command -label Open -underline 0 \
       -command [list OpenFile .tedit 1]
    $mw.file add separator
    $mw.file add command -label Save -underline 0 \
       -command [list SaveFile .tedit 0]
    $mw.file add command -label "Save as ..." -underline 1 \
       -command [list SaveFile .tedit 1]
    $mw.file add separator
    $mw.file add command -label Exit -underline 1 \
       -command ExitGui

    #
    # Set up the "Edit" menu
    #
    $mw.edit add command -label "Insert text" -underline 0 \
       -command [list InsertBlock .tedit Text]

    $mw.edit add command -label "Insert code" -underline 0 \
       -command [list InsertBlock .tedit Code]

    #
    # Set up the "View" menu
    #
    set ::hidden 0
    $mw.view add checkbutton -label "Hide text" -underline 0 \
       -variable ::hidden -onvalue 1 -offvalue 0 \
       -command [list ShowHide .tedit]

    #
    # Set up the "Help" menu
    #
    $mw.help add command -label Overview -underline 0 \
       -command ShowHelp
    $mw.help add command -label About -underline 0 \
       -command {tk_messageBox -message "Fshow - a basic IDE\nBy Arjen Markus"}

    #
    # Set up the rest of the user-interface
    #
    text   .tmessage -bg white -fg black -height 4 -font "Helvetica 12"
    ScrolledText .tedit   16 normal
    ScrolledText .toutput 8 disabled
    button .run   -text Run   -command {RunProgram .tedit .toutput}
    button .clean -text Clear -command {CleanOutput .toutput}

    grid .tmessage -sticky news
    grid .tedit    -sticky news
    grid .run      -sticky w
    grid .toutput  -sticky news

    grid columnconfigure . 0 -weight 1
    grid rowconfigure . 1 -weight 1

    FillMessage .tmessage
    OpenFile    .tedit 0
    CleanOutput .toutput
 }

 # FillMessage --
 #    Fill the message window with some useful text
 # Arguments:
 #    name      Name of the widget to fill
 # Result:
 #    None
 # Side effect:
 #    Text widget filled
 #
 proc FillMessage {name} {
    $name insert end \
 "Welcome to the F workbench:
 Type in your F program and press the Run button,
 to see the result."
    $name configure -state disabled
 }

 # CleanOutput --
 #    Clean the output window
 # Arguments:
 #    name      Name of the widget to clean
 # Result:
 #    None
 # Side effect:
 #    Text widget cleaned
 #
 proc CleanOutput {name} {
    $name.text configure -state normal
    $name.text delete 1.0 end
    $name.text configure -state disabled
 }

 # ShowOutput --
 #    Show output in the output window
 # Arguments:
 #    name      Name of the output widget
 #    text      Text to be shown
 # Result:
 #    None
 # Side effect:
 #    Text updated
 #
 proc ShowOutput {name text} {
    $name.text configure -state normal
    $name.text insert end $text
    $name.text configure -state disabled
 }

 # ScrolledText --
 #    Create a scrolled text widget
 # Arguments:
 #    name      Name of the widget (public)
 #    height    Height in lines
 #    state     Initial state
 # Result:
 #    None
 # Side effect:
 #    Text widget and scrollbar created
 #
 proc ScrolledText {name height state} {
    set tf [frame $name]
    set tw "$name.text"
    scrollbar $tf.scrollx -orient horiz -command "$tw xview"
    scrollbar $tf.scrolly               -command "$tw yview"
    text      $tw         -yscrollcommand "$tf.scrolly set" \
                          -xscrollcommand "$tf.scrollx set" \
                          -font "Courier 10" \
                          -fg black -bg white \
                          -height $height \
                          -state  $state

    grid      $tw         $tf.scrolly
    grid      $tf.scrollx x
    grid      $tw         -sticky news
    grid      $tf.scrolly -sticky ns
    grid      $tf.scrollx -sticky ew

    grid columnconfigure $tf 0 -weight 1
    grid rowconfigure    $tf 0 -weight 1

    # Quick hack: tags
    $tw tag configure Text -font "Helvetica 10" -background lightgrey
    $tw tag configure Code -font "Courier 10"
    $tw tag configure Anchor -elide 1
    $tw tag configure Help -font "Helvetica 12"
 }

 # InsertBlock --
 #    Insert an empty block with the correct tags
 # Arguments:
 #    name      Name of the widget containing the program code
 #    tag       The tag to be inserted
 # Result:
 #    None
 # Side effect:
 #    Added empty lines
 #
 proc InsertBlock {name tag} {
    $name.text insert "insert linestart" " \n \n \n" $tag
    if { $tag == "Text" } {
       $name.text insert "insert linestart" "\n" {Text Anchor}

       # TODO: move the cursor
    }
 }

 # ShowHide --
 #    Show or hide the descriptive text in the edit window
 # Arguments:
 #    name      Name of the widget containing the program code
 # Result:
 #    None
 # Side effect:
 #    Shows/hides the text
 #
 proc ShowHide {name} {
    $name.text tag configure Text -elide $::hidden
 }

 # RunProgram --
 #    Run the program
 # Arguments:
 #    name      Name of the widget containing the program code
 #    outname   Name of the output widget
 # Result:
 #    None
 # Side effect:
 #    Lots
 #
 proc RunProgram {name outname} {
    global srcfile
    CleanOutput $outname
    $name.text configure -state disabled
    SaveContents $name $srcfile

 # Quick hack: make it run Tcl scripts
 #   set result [RunCompiler $srcfile $outname]
 #
 #  if { [lindex $result 0] == "OK" } {
 #     ExecProgram [lindex $result 1] $outname
 #  }
 #  $name.text configure -state normal

    ExecProgram $srcfile $outname
    $name.text configure -state normal
 }

 # RunCompiler --
 #    Run the compiler
 # Arguments:
 #    srcfile   Name of the source file
 #    outname   Name of the output widget
 # Result:
 #    None
 # Side effect:
 #    Compiler is run, error messages (if any) are caught
 #
 proc RunCompiler {srcfile outname} {
    global fcommand
    global fcmp
    global extexe

    set exefile "[file rootname $srcfile]$extexe"
    set rc [catch {
       eval $fcommand $srcfile -o $exefile
    } msg]

    if { $rc != 0 } {
       ShowOutput $outname $msg
       return "Error"
    } else {
       return "OK $exefile"
    }
 }

 # ExecProgram --
 #    Actually run the program
 # Arguments:
 #    exefile   Name of the executable file
 #    outname   Name of the output widget
 # Result:
 #    The string "OK" or "Error" - not used right now
 # Side effect:
 #    The program is run, output to screen (if any) is caught
 #
 proc ExecProgram {exefile outname} {
    set rc [catch {
       set output [exec tclsh $exefile]
    } msg]

    if { $rc != 0 } {
       ShowOutput $outname $msg
       return "Error"
    } else {
       ShowOutput $outname $output
       return "OK"
    }
 }

 # ExitGui --
 #    Exit the GUI
 # Arguments:
 #    None
 # Result:
 #    None
 # Side effect:
 #    The user-interface stops (maybe save the source?)
 #
 proc ExitGui {} {
    exit
 }

 # NewFile --
 #    Clean the input window (start with a new file)
 # Arguments:
 #    name      Name of the input window
 # Result:
 #    None
 #
 proc NewFile {name} {
    $name.text delete 1.0 end
 }

 # OpenFile --
 #    Clean the input window and load in an existing file
 # Arguments:
 #    name      Name of the input window
 #    askname   Ask for a file name or not
 # Result:
 #    None
 #
 proc OpenFile {name askname} {
    global srcfile
    if { $askname } {
       set newfile \
              [tk_getOpenFile -defaultextension $::fext \
                              -filetypes [list [list "F files" $::fext] \
                                               {{All files} *}] \
                              -title "Select an existing file"]
    } else {
       set newfile ""
    }
    if { $newfile != "" } {
       set srcfile $newfile
       $name.text delete 1.0 end
       GetContents $name $srcfile
    }
 }

 # SaveFile --
 #    Save the current file
 # Arguments:
 #    name      Name of the input window
 #    askname   Ask for a new file name or not
 # Result:
 #    None
 #
 proc SaveFile {name askname} {
    global srcfile
    set newfile $srcfile
    if { $askname } {
       set newfile \
          [tk_getSaveFile -defaultextension $::fext \
                          -filetypes [list [list "F files" $::fext] \
                                           {{All files} *}] \
                          -title "Type a new name"]
    }
    if { $newfile != "" } {
       set srcfile $newfile
       SaveContents $name $srcfile
    }
 }

 # GetContents --
 #    Get the contents of the given file and add it with proper tags
 #    to the edit window
 # Arguments:
 #    name        Name of the edit window
 #    filename    Name of the file to read
 # Result:
 #    None
 #
 proc GetContents {name filename} {
    set infile [open $filename "r"]

    #
    # Read the file line by line
    #
    set current_tag "Code"
    set first       [expr {[string length $::fcomment]+1}]

    while { [gets $infile line] >= 0 } {
       if { [string first "$::fcomment <text>" $line] == 0 } {
          set current_tag "Text"
          continue
       }
       # TODO: C-like comments
       if { [string first "$::fcomment </text>" $line] == 0 } {
          set current_tag "Code"
          continue
       }

       if { $current_tag == "Text" } {
          set line [string range $line $first end]
       }

       $name.text insert end "$line\n" $current_tag
    }
    close $infile
 }

 # SaveContents --
 #    Save the contents of the edit window to the given file
 # Arguments:
 #    name        Name of the edit window
 #    filename    Name of the file to save the contents to
 # Result:
 #    None
 #
 proc SaveContents {name filename} {
    set outfile [open $filename "w"]

    #
    # Get the contents and analyse it
    #
    set src [$name.text dump -all 1.0 end]

    set current_tag "Code"

    foreach {key value index} $src {
       switch -- $key {
       "text" {
          if { $current_tag == "Code" } {
             puts -nonewline $outfile $value
          }
          if { $current_tag == "Text" } {
             puts -nonewline $outfile "$::fcomment $value"
          }
       }
       "tagon" {
          set current_tag $value
          if { $value == "Text" } {
             puts $outfile "$::fcomment <text>"
          }
       }
       "tagoff" {
          set current_tag $value
          if { $value == "Text" } {
             puts $outfile "$::fcomment </text>"
          }
       }
       default {
          # Do nothing
       }
       }
    }

    close $outfile
 }
 # main --
 #    Main code
 #
 #
 # Set up the various variables:
 # - Names of executables
 # - Path to the executables
 #
 # -- removed these parts for the benefit of the Wiki
 if { 0 } {
 set sysdir [file dirname [info script]]
 source [file join $sysdir "fshowsys.tcl"]
 source [file join $sysdir "fshowhlp.tcl"]
 if { [file exists "fshow.set"] } {
    source "fshow.set"
 }

 #
 # One final check
 #
 sanityCheck
 } ;# -- end removed

 set fcomment "#!"
 set extexe   ".tcl"
 set fext     ".tcl"
 set fcmd     "exec tclsh"
 set srcfile "runtest.tcl"

 #
 # Now set up the user-interface
 #
 showMain

• Ability to have Tcl procedures handled as objects, with a fast way to select what procedure to edit (including 'toplevel')
• 4 spaces tab
• a checkbox to select if the window in the bottom should display the "stdout" output or instead the result of the evaluation of the script.

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References