A bit more windows look for IDE

Started by HPW, April 28, 2004, 01:18:58 PM

Previous topic - Next topic

HPW

Some seperators and a other button-look make it more look-alike.

Don't know how it display on other paltforms.



proc SetupConsole {} {

global Ide IDEversion txt FontSizeMenu FontNameMenu commandHistory

wm title . $IDEversion

set txt [text .console ]

set buttonFrame [SetupConsoleToolbar $txt]

$txt config -fg $Ide(consoleForeground) -bg $Ide(consoleBackground)
$txt config -width $Ide(consoleWidth) -height $Ide(consoleHeight) -setgrid true
$txt config -yscrollcommand { .scroll set }
$txt config -insertofftime 0 -insertwidth 4
$txt config -exportselection true
scrollbar .scroll -command {$txt yview }

set sep1  [Separator .sep1 -orient horizontal]
set sep2  [Separator .sep2 -orient horizontal]

grid $sep1 -row 0 -columnspan 4 -sticky ew -pady 1

grid $buttonFrame -row 1 -columnspan 2 -sticky ew

grid $sep2 -row 2 -columnspan 4 -sticky ew -pady 1

grid $txt -row 3 -column 0 -sticky news
grid .scroll -row 3 -column 1 -sticky news

# setup main window menu

menu .menubar
. config -menu .menubar
foreach m {File Options Help} {
set $m [menu .menubar.m$m -tearoff 0]
.menubar add cascade -label $m -menu .menubar.m$m
}

.menubar insert 2 command -label Edit -command CodeBrowser
.menubar insert 3 command -label Clear -command ClearConsoleScreen
.menubar insert 4 command -label Debug -command {Debugger}



$File add command -label {Load ...} -accelerator {Ctrl-O} -underline 1 -command LoadFile
$File add command -label {Reload} -accelerator {Ctrl-R} -underline 0 -command ReLoadFile
$File add command -label {Save All as ...} -accelerator {Ctrl-S} -underline 0 -command SaveAllFile
$File add separator
$File add command -label Exit -underline 1 -command exit

set FontSizeMenu [menu .menubar.mOptions.sFontSize -tearoff 0]
set FontNameMenu [menu .menubar.mOptions.sFontName -tearoff 0]

$Options add cascade -label "Font Size" -underline 3 -menu $FontSizeMenu
$Options add cascade -label "Font Name" -underline 5 -menu $FontNameMenu
$Options add command -label {Background ...} -underline 0 -command "SetConsoleColors consoleBackground"
$Options add command -label {Foreground ...} -underline 0 -command "SetConsoleColors consoleForeground"
$Options add separator
$Options add command -label {Save settings} -underline 0 -command "SaveSettings"


$Help add command -label {Manual & Reference} -underline 0 -command HelpAction
$Help add command -label {newLISP-tk} -underline 9 -command HelpAction-tk
$Help add separator
$Help add command -label About -underline 0 -command AboutBox

MakeFontSizeMenu $FontSizeMenu
MakeFontNameMenu $FontNameMenu

ResetFont fontSize $Ide(fontSize) $FontSizeMenu
ResetFont fontName $Ide(fontName) $FontNameMenu

# setup console popup menu

set consolePopup [menu .console.popup]
SetupPopupMenu $consolePopup

# setup status bar

frame .statusBar
label .statusBar.label -textvariable statusText -relief sunken -bd 1 -font "Helvetica 10" -anchor w
grid .statusBar.label -sticky ew
grid columnconfigure .statusBar 0 -weight 1
grid .statusBar -row 4 -column 0 -columnspan 2 -sticky ew

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

# setup marks and key handling in console window

$txt mark set cmdStart insert
$txt mark gravity cmdStart left

# initialize command history

for {set i 1 } {$i <= $Ide(maxHistory)} {incr i} {
set commandHistory($i) "" }

bind $txt <Return> { ProcessConsoleInput; break }
bind $txt <Key-Up> { PutPriorCommand ; break }
bind $txt <Key-Down> { PutNextCommand ; break }
bind $txt <Home> { $txt mark set insert cmdStart; break }
bind $txt <Double-1> {HighlightExpression %W }
bind $txt <Tab> { $txt insert insert "  "; break }
bind $txt <Control-l> { ClearConsoleScreen; break }
bind $txt <Control-a> { $txt mark set insert cmdStart; break }

bind $txt <Shift-KeyPress> {if { "%A" == "("} { EditShowMatchingPar %W 0 } else {
if { "%A" == ")"} { EditShowMatchingPar %W 1 }}}

bind $txt <Button-3> "tk_popup $consolePopup %X %Y 0"

bind $txt <Control-x> { CutCopyText %W }
bind $txt <Control-c> { CutCopyText %W }
bind $txt <Control-v> { PasteText %W }
bind $txt <Control-o> LoadFile
bind $txt <Control-r> ReLoadFile
bind $txt <Control-s> SaveAllFile
bind $txt <Control-b> {CodeBrowser; break}
bind $txt <Control-g> Debugger
bind $txt <Control-m> HelpAction
bind $txt <Control-k> HelpAction-tk

bind . <Destroy> {if {"%W" == "."} {ExitProc}}

wm geometry . +$Ide(WinPosX)+$Ide(WinPosY)

focus -force $txt
}


# set up a icon toolbar for console menu choices

proc SetupConsoleToolbar { widget } {

global Ide

frame .bframe

foreach name {openImg saveImg reloadImg editImg debugImg copyImg cutImg pasteImg clearImg
helpImg nltkImg } {
[set $name [image create photo]] read "$Ide(imageDir)/$name.gif"
}

foreach no {1 2 3 4 5} {
label .bframe.vertical$no -text {   } -relief flat
}

# set st groove
set st flat
set st1 raised

button .bframe.open -image $openImg -relief $st -overrelief $st1 -borderwidth 1 -takefocus 0 -command LoadFile
button .bframe.reload -image $reloadImg -relief $st -overrelief $st1 -borderwidth 1 -takefocus 0 -command ReLoadFile
button .bframe.save -image $saveImg -relief $st -overrelief $st1 -borderwidth 1 -takefocus 0 -command SaveAllFile
button .bframe.edit -image $editImg -relief $st -overrelief $st1 -borderwidth 1 -takefocus 0 -command CodeBrowser
button .bframe.debug -image $debugImg -relief $st -overrelief $st1 -borderwidth 1 -takefocus 0 -command Debugger
button .bframe.copy -image $copyImg -relief $st -overrelief $st1 -borderwidth 1 -takefocus 0 -command "event generate $widget <Control-c>"
button .bframe.cut -image $cutImg -relief $st -overrelief $st1 -borderwidth 1 -takefocus 0 -command "event generate $widget <Control-x>"
button .bframe.paste -image $pasteImg -relief $st -overrelief $st1 -borderwidth 1 -takefocus 0 -command "event generate $widget <Control-v>"
button .bframe.clear -image $clearImg -relief $st -overrelief $st1 -borderwidth 1 -takefocus 0 -command "ClearConsoleScreen"
button .bframe.help -image $helpImg -relief $st -overrelief $st1 -borderwidth 1 -takefocus 0 -command HelpAction
button .bframe.nltk -image $nltkImg -relief $st -overrelief $st1 -borderwidth 1 -takefocus 0 -command HelpAction-tk

pack .bframe.open .bframe.reload .bframe.save -side left
set sep [Separator .bframe.sep -orient vertical]
pack $sep -side left -fill y -padx 4 -anchor w

pack .bframe.edit .bframe.debug -side left
set sep1 [Separator .bframe.sep1 -orient vertical]
pack $sep1 -side left -fill y -padx 4 -anchor w

pack .bframe.copy .bframe.cut .bframe.paste -side left
set sep2 [Separator .bframe.sep2 -orient vertical]
pack $sep2 -side left -fill y -padx 4 -anchor w

pack .bframe.clear -side left -padx 1
set sep3 [Separator .bframe.sep3 -orient vertical]
pack $sep3 -side left -fill y -padx 4 -anchor w

pack .bframe.help .bframe.nltk -side left
set sep4 [Separator .bframe.sep4 -orient vertical]
pack $sep4 -side left -fill y -padx 4 -anchor w

balloon_help .bframe.open { Load source   Ctrl-O }
balloon_help .bframe.reload { Reload last source Ctrl-R }
balloon_help .bframe.save { Save workspace   Ctrl-S }
balloon_help .bframe.edit { Browser / Editor   Ctrl-B }
balloon_help .bframe.debug { Debugger   Ctrl-G }
balloon_help .bframe.copy { Copy selection   Ctrl-C }
balloon_help .bframe.cut { Cut selection   Ctrl-X }
balloon_help .bframe.paste { Paste selection   Ctrl-V }
balloon_help .bframe.clear { Clear console   Ctrl-L }
balloon_help .bframe.help { newLISP Reference   Ctrl-M }
balloon_help .bframe.nltk { newLISP-tk Intro   Ctrl-K }

return .bframe
}
Hans-Peter

nigelbrown

#1
No being a tk/tcl-er I ask - Where do you put it?

HPW

#2
Hello Nigel,



It replaces the similar functions in newlisp-tk.tcl from the source distribution.

Of cource then you should be able to wrap a new newLisp-tk.exe with freewrap 5.5.



And it only modified the main console window. The edit window could be done in a similar way.



I ran across this, because I take newLisp-tk.tcl as a template for my own app, and their I want a look closer to common windows software.
Hans-Peter