Version 6 of GnoWS - Gnocl Workspaces

Updated 2011-03-27 13:31:53 by tb

tb 2011-03-26 - Here is a little tool I made up. I use it to explore Gnocl et. al. interactively. It uses gnocl::webKit to browse the online Gnocl documentation and gnocl::sourceView for code editing.

Screenshot:

http://87.106.31.55/images/GnoWS.png


Code:

 #
 # Gnocl Workspaces (GnoWS)
 # 
 # Author      : Shin
 # Version     : 0.1
 # Description :
 #
 #  A workspace simply is a text editor with two special
 #  options in its context menu. The first option is "Do It",
 #  which can be used to evaluate a selected block of code.
 #  Another option is "Print It", to be used to evaluate code
 #  AND print out the evaluation result in the workspace.
 #            

 package require Gnocl
 package require GnoclSourceView
 package require GnoclWebKit

 namespace eval ::gnows {
  namespace export workspace
  namespace ensemble create

  variable wsCount 0

  proc workspace {{wname ""}} {
    # please note that wname has to be prefixed with its fully qualified namespace.
    # If wname is empty, then create a unique name.
    if {"$wname" == ""} {
      set wname ::ws_[clock clicks]
    }
    upvar $wname ws
    array set ws {
      menu {} opt1 {} opt2 {} opt3 {} opt4 {} opt5 {}
      win {} ws {} box {} jump {} procs {}
      fname {} fpath {} mod 0
    }
    set ws(menu) [::gnocl::menu \
      -title "Workspace Menu" \
      -tearoff 0]
    set ws(opt1) [::gnocl::menuItem \
      -text "Do It" \
      -onClicked [list ::gnows::doIt $wname]]
    set ws(opt2) [::gnocl::menuItem \
      -text "Print It" \
      -onClicked [list ::gnows::printIt $wname]]
    set ws(opt3) [::gnocl::menuItem \
       -text "%#Cut" \
       -onClicked [list ::gnows::cutIt $wname]]
    set ws(opt4) [::gnocl::menuItem \
      -text "%#Copy" \
      -onClicked [list ::gnows::copyIt $wname]]
    set ws(opt5) [::gnocl::menuItem \
      -text "%#Paste" \
      -onClicked [list ::gnows::pasteIt $wname]]
    $ws(menu) add $ws(opt1)
    $ws(menu) add $ws(opt2)
    $ws(menu) add [::gnocl::menuSeparator]
    $ws(menu) add $ws(opt3)
    $ws(menu) add $ws(opt4)
    $ws(menu) add $ws(opt5)
    set ws(win) [::gnocl::window \
      -title "Workspace" \
      -onDestroy [list ::gnows::destroy $wname] \
      -defaultWidth 600 \
      -defaultHeight 400]
    set ws(box) [::gnocl::box \
      -orientation vertical \
      -borderWidth 0 \
      -spacing 0]
    set ws(tbar) [gnocl::toolBar \
      -style both]
    $ws(tbar) add item -icon "%#New" \
      -tooltip "Create a new workspace" \
      -onClicked [list ::gnows::workspace]
    $ws(tbar) add item -icon "%#Open" \
      -tooltip "Open a file" \
      -onClicked [list ::gnows::openFile $wname]
    $ws(tbar) add item -icon "%#SaveAs" \
      -tooltip "Save workspace as..." \
      -onClicked [list ::gnows::saveFileAs $wname]
    $ws(tbar) add space
    $ws(tbar) add item -icon "%#Execute" \
      -tooltip "Evaluate selected code" \
      -onClicked [list ::gnows::doIt $wname]
    $ws(tbar) add item -icon "%#Print" \
      -tooltip "Evaluate selected code and return the result" \
      -onClicked [list ::gnows::printIt $wname]
    $ws(tbar) add space
    $ws(tbar) addEnd item -icon "%#Info" \
      -tooltip "About this ..." \
      -onClicked ::gnows::about
    $ws(tbar) addEnd item -icon "%#Help" \
      -tooltip "Open Online Help ..." \
      -onClicked ::gnows::help
    $ws(tbar) add item -icon "%#Quit" \
      -tooltip "Quit all workspaces" \
      -onClicked ::gnows::quit
    set ws(ws) [gnocl::sourceView \
      -onButtonPress [list ::gnows::handleButtonPress %b $wname %X %Y] \
      -showLineNumbers 1 \
      -highlightCurrentLine 1 \
      -insertSpace 0 \
      -showLineMarks 1 \
      -rightMargin 72 \
      -showRightMargin 0 \
      -tabWidth 4 \
      -baseColor #FFfe00 \
      -baseFont "Mono 10" \
    ]
    set ws(sbar) [::gnocl::statusBar -resizeGrip 1]
    $ws(box) add $ws(tbar)
    $ws(box) add $ws(ws) -expand 1 -fill {1 1}
    $ws(box) add $ws(sbar)
    $ws(win) configure -child $ws(box)
    $ws(win) show
    incr ::gnows::wsCount
    return $ws(win)
  }

  proc handleButtonPress {btn wname x y} {
    upvar $wname ws
    if {$btn == 3} {
      catch {$ws(menu) popup $x $y}
    }
  }

  proc cutIt {wname} {
    upvar $wname ws
    ::gnocl::clipboard clear
    ::gnocl::clipboard setText [$ws(ws) get selectionStart selectionEnd]
    $ws(ws) erase selectionStart selectionEnd
  }

  proc copyIt {wname} {
    upvar $wname ws
    ::gnocl::clipboard setText [$ws(ws) get selectionStart selectionEnd]
  }

  proc pasteIt {wname} {
    upvar $wname ws
    $ws(ws) erase selectionStart selectionEnd
    $ws(ws) insert cursor [::gnocl::clipboard getText]
  }

  proc doIt {wname} {
    upvar $wname ws
    set cmd [$ws(ws) get selectionStart selectionEnd]
    return [eval "$cmd"]
  }

  proc printIt {wname} {
    upvar $wname ws
    set result [::gnows::doIt $wname]
    set rsize [expr [string length $result] + 1]
    $ws(ws) insert selectionEnd+1 $result
    ::gnocl::update
    $ws(ws) select selectionEnd selectionEnd+$rsize
  }

  proc openFile {wname} {
    upvar $wname ws
    if {"$wname" == "::GnoWS"} {
      ::gnocl::dialog -type info -title "GnoWS - Info" -text "Files don't open in the Transcript."
      return
    }
    set fn [::gnocl::fileChooserDialog \
      -action open \
      -title "Load a file into this workspace"]
    if {"$fn" != ""} {
      set ws(fname) [lindex [file split $fn] end]
      set ws(fpath) [file dirname $fn]
      $ws(ws) erase "0 0" end
      set fd [open $fn r]
      $ws(ws) insert end [read $fd]
      close $fd
      $ws(win) configure -title "Workspace: $ws(fname)"
    }
  }

  proc saveFile {wname} {
    upvar $wname ws
    set fn [file join $ws(fpath) $ws(fname)]
    if {"$fn" != ""} {
      set fd [open $fn w]
      puts $fd [$ws(ws) get {0 0} end]
      close $fd
      $ws(sbar) push "Workspace saved to $fn."
    }
    set ws(mod) 0
  }

  proc saveFileAs {wname} {
    upvar $wname ws
    set fn [::gnocl::fileChooserDialog \
      -action save \
      -title "Save this workspace as..." \
      -currentName $ws(fname) \
      -currentFolder $ws(fpath)]
    if {"$fn" != ""} {
      set ws(fname) [lindex [file split $fn] end]
      set ws(fpath) [file dirname $fn]
      set fd [open $fn w]
      puts $fd [$ws(ws) get start end]
      close $fd
      $ws(sbar) push "Workspace saved to $fn."
    }
    set ws(mod) 0
  }

  proc destroy {wname} {
    if {$::gnows::wsCount == 1} {
      exit
    } else {
      incr ::gnows::wsCount -1
    }
  }

  proc quit {} {
    set ok [gnocl::dialog \
      -type question \
      -text "Really quit all workspaces?" \
      -buttons "%#Yes %#No"]
    if {$ok==Yes} {
      #catch [file delete -force /tmp/doc]
      exit
    }
  }

  proc about {} {
    gnocl::aboutDialog \
      -programName "GnoWS" \
      -artists {Shin} \
      -authors {Shin} \
      -name "GnoWS" \
      -comments "Gnocl Workspaces" \
      -copyright "Copy left by Thomas Braun." \
      -version "Version 0.1" \
      -logo "%//tmp/GnoWS_Icon.png" \
      -license "Copyleft by Thomas Braun"
  }

  proc loadPage {w url} {
    if { [string compare -length 7 "http://" $url] != 0 } {
      set url "http://$url"
    }
    $w load $url
    return $url
  }

  proc help {} {
    set url "http://sites.google.com/site/gnocltclgtk/gnocl-user-documentation"
    set w [::gnocl::window \
      -title "Gnocl Online Help" \
      -defaultHeight 600 \
      -defaultWidth 800 \
      -child [set br [::gnocl::webKit]] \
    ]
    loadPage $br $url
    return $w
  }

  proc unwrap {} {
    file copy -force [file join $::starkit::topdir img GnoWS_Icon.png] /tmp
    file copy -force [file join $::starkit::topdir doc] /tmp
  }

 }; # end of namespace


 # GO!
 #::gnows::unwrap

 gnows workspace ::GnoWS
 $::GnoWS(win) configure -title "GnoWS 0.1"
 $::GnoWS(ws) tag create bigred
 $::GnoWS(ws) tag create cursive
 $::GnoWS(ws) insert end "Welcome to GnoWS 0.1\n" -tags bigred
 $::GnoWS(ws) insert end "\t...running on Tcl/Tk v.$::tcl_patchLevel\n" -tags cursive
 $::GnoWS(ws) insert end "\t...using Gnocl v.[package version Gnocl]\n" -tags cursive
 $::GnoWS(ws) insert end "\t...using GnoclSourceView v.[package version GnoclSourceView]\n" -tags cursive
 $::GnoWS(ws) insert end "\t...using GnoclWebKit v.[package version GnoclWebKit]\n\n" -tags cursive
 $::GnoWS(ws) tag configure bigred \
  -fontFamily Times \
  -fontSize 20 \
  -fontStyle italic \
  -fontWeight bold \
  -foreground \#cc0000
 $::GnoWS(ws) tag configure cursive -fontStyle italic

 # No bgerror without Tk yet!
 package require Tk
 wm withdraw .

 # EOF

tb 2011-03-27 - I just noticed all error messages hitting the console. I added Tk, so errors will popup Tk's bgerror dialog.