Added binding mouse button: click on notebook tab highlight opened file name in tree

Change "Paste from Clipboard" function
Change popup editor menu (undo, redo, copy, paste, cut functions)
This commit is contained in:
Sergey Kalinin 2018-02-05 12:08:16 +03:00
parent cc7bbf9a59
commit 8cf4ded785
33 changed files with 69 additions and 9437 deletions

View File

@ -8,6 +8,8 @@
0.4.5
05.02.2018
- Added binding mouse button: click on notebook tab highlight opened file name in tree
- Change "Paste from Clipboard" function
- Change popup editor menu (undo, redo, copy, paste, cut functions)
04.02.2018
- Fixed paste text highlight
@ -376,6 +378,8 @@ Fixed bug with PageRise function

View File

@ -1,87 +0,0 @@
#######################################################################
# Baloon help
# Author: Alexander Dederer
# Usage:
# Set balloon tips to widget:
# balloon $widget set "Hello World"
# balloon [button .exit -text "exit" -command exit] set "Hello world"
#
# Clear ballon tips from widget:
# balloon $widget clear
#
# Show balloon tips on widget:
# balloon $widget show "Hello World"
#######################################################################
proc balloon { widget action args } {
global BALLOON
switch -- $action {
set {
if { $args != {{}} } {
balloon $widget clear
#bind $widget <Any-Enter> "after 1000 [list balloon %W show $args mousepointer %X %Y]"
#bind $widget <Any-Leave> "catch { destroy %W.balloon }"
bind $widget <Enter> " balloon $widget show $args "
bind $widget <Leave> " wm withdraw .bubble "
}
}
show {
if ![winfo exists .bubble] {
toplevel .bubble -relief flat -background black -bd 1
wm withdraw .bubble
update
array set attrFont [font actual fixed]
set attrFont(-size) [expr $attrFont(-size) - 2]
eval pack [message .bubble.txt -aspect 5000 -bg lightyellow \
-font [array get attrFont] -text [lindex $args 0]]
pack .bubble.txt
wm transient .bubble .
wm overrideredirect .bubble 1
bind .bubble <Enter> "wm withdraw .bubble"
} ;# if
if {$args == ""} { wm withdraw .bubble }
set text [lindex $args 0]
set BALLOON $text
switch $text {
"" { wm withdraw .bubble ; update }
"default" {
after 1000 "raise_balloon $widget {$text}"
after 7000 "if { \$BALLOON == {$text} } { wm withdraw .bubble ; update }"
}
} ;# switch
}
clear {
catch { destroy .balloon }
bind $widget <Enter> {}
bind $widget <Leave> {}
}
} ;# switch action
} ;# proc balloon
proc raise_balloon {widget text} {
global BALLOON
if { $BALLOON != $text } { wm withdraw .bubble ; update ; return }
set cur_widget [winfo containing [winfo pointerx .] [winfo pointery .]]
if { $cur_widget != $widget } { return }
raise .bubble
.bubble.txt configure -text $text
set b_x [expr [winfo pointerx .] - [winfo reqwidth .bubble]/2]
set b_y [expr [winfo pointery .] + 15]
wm geometry .bubble +$b_x+$b_y
wm deiconify .bubble
update
} ;# proc raise_balloon

View File

@ -1,175 +0,0 @@
###########################################################
# Tcl/Tk Project Manager #
# Distrubuted under GPL #
# Copyright (c) "Sergey Kalinin", 2002, http://nuk-svk.ru #
# Author: Sergey Kalinin banzaj28@yandex.ru #
###########################################################
# AutoCompletition Procedure #
# Author Alex DEDERER #
###########################################################
proc auto_completition { widget } {
set start_word [$widget get "insert - 1 chars wordstart" insert]
set box [$widget bbox insert]
set box_x [expr [lindex $box 0] + [winfo rootx $widget] ]
set box_y [expr [lindex $box 1] + [winfo rooty $widget] + [lindex $box 3] ]
set cnt 0
set pos "1.0"
set last_pos ""
set pattern "$start_word\\w*"
set list_word($start_word) 1
while { ([set start [$widget search -count cnt -regexp -- $pattern $pos end]] != "") } {
set word [$widget get $start "$start + $cnt chars"]
if { ![string equal $start_word $word] } { set list_word($word) 1 }
set pos [$widget index "$pos + [expr $cnt + 1] chars"]
if { [string equal $last_pos $pos] } { break }
set last_pos $pos
} ;# while
bindtags $widget [list CompletitionBind [winfo toplevel $widget] $widget Text sysAfter all]
bind CompletitionBind <Escape> "bindtags $widget {[list [winfo toplevel $widget] $widget Text sysAfter all]}; catch { destroy .aCompletition }"
bind CompletitionBind <Key> { auto_completition_key %W %K %A ; break}
eval auto_completition_win $box_x $box_y [array names list_word]
} ;# proc auto_completition
## PROCEDURE LIST ##
## by BanZaj ##
proc auto_completition_proc { widget } {
global procList activeProject noteBook varList
set nodeEdit [$noteBook raise]
if {$nodeEdit == "" || $nodeEdit == "newproj" || $nodeEdit == "about" || $nodeEdit == "debug"} {
return
}
set start_word [$widget get "insert - 1 chars wordstart" insert]
set box [$widget bbox insert]
set box_x [expr [lindex $box 0] + [winfo rootx $widget] ]
set box_y [expr [lindex $box 1] + [winfo rooty $widget] + [lindex $box 3] ]
set cnt 0
set pos "1.0"
set last_pos ""
puts "$start_word"
puts [regsub -all -- "\$" $start_word "\\\$" word]
puts $word
#set list_word($start_word) 1
if {[string index $start_word 0] == "\$"} {
set workList $varList($activeProject)
} else {
set workList $procList($activeProject)
}
if [info exists workList] {
set len [llength $workList]
} else {
return
}
set i 0
while {$len >=$i} {
set line [lindex $ $i]
scan $line "%s" word
if {[string match "$start_word*" $word]} {
set list_word($word) $i
}
incr i
}
bindtags $widget [list CompletitionBind [winfo toplevel $widget] $widget Text sysAfter all]
bind CompletitionBind <Escape> "bindtags $widget {[list [winfo toplevel $widget] $widget Text sysAfter all]}; catch { destroy .aCompletition }"
bind CompletitionBind <Key> {auto_completition_key %W %K %A ; break}
eval auto_completition_win $box_x $box_y [array names list_word]
} ;# proc auto_completition_proc
proc auto_completition_win { x y args} {
set win .aCompletition
if { [winfo exists $win] } { destroy $win }
toplevel $win
wm transient $win .
wm overrideredirect $win 1
listbox $win.lBox -width 30 -border 2 -yscrollcommand "$win.yscroll set" -border 1
scrollbar $win.yscroll -orient vertical -command "$win.lBox yview" -width 13 -border 1
pack $win.lBox -expand true -fill y -side left
pack $win.yscroll -side left -expand false -fill y
foreach { word } $args {
$win.lBox insert end $word
} ;# foreach | insert all word
catch { $win.lBox activate 0 ; $win.lBox selection set 0 0 }
if { [set height [llength $args]] > 10 } { set height 10 }
$win.lBox configure -height $height
bind $win <Escape> " destroy $win "
bind $win.lBox <Escape> " destroy $win "
wm geom $win +$x+$y
} ;# auto_completition_win
proc auto_completition_key { widget K A } {
set win .aCompletition
set ind [$win.lBox curselection]
switch -- $K {
Prior {
set up [expr [$win.lBox index active] - [$win.lBox cget -height]]
if { $up < 0 } { set up 0 }
$win.lBox activate $up
$win.lBox selection clear 0 end
$win.lBox selection set $up $up
}
Next {
set down [expr [$win.lBox index active] + [$win.lBox cget -height]]
if { $down >= [$win.lBox index end] } { set down end }
$win.lBox activate $down
$win.lBox selection clear 0 end
$win.lBox selection set $down $down
}
Up {
set up [expr [$win.lBox index active] - 1]
if { $up < 0 } { set up 0 }
$win.lBox activate $up
$win.lBox selection clear 0 end
$win.lBox selection set $up $up
}
Down {
set down [expr [$win.lBox index active] + 1]
if { $down >= [$win.lBox index end] } { set down end }
$win.lBox activate $down
$win.lBox selection clear 0 end
$win.lBox selection set $down $down
}
Return {
$widget delete "insert - 1 chars wordstart" "insert wordend - 1 chars"
$widget insert "insert" [$win.lBox get [$win.lBox curselection]]
eval [bind CompletitionBind <Escape>]
}
default {
$widget insert "insert" $A
eval [bind CompletitionBind <Escape>]
}
}
} ;# proc auto_completition_key

View File

@ -1 +1,2 @@
Sergey Kalinin

1174
editor.tcl

File diff suppressed because it is too large Load Diff

365
help.tcl
View File

@ -1,365 +0,0 @@
##!/usr/bin/wish
###########################################################
# Tcl/Tk Project Manager #
# version 0.0.1 #
# help module #
# Copyright (c) "Sergey Kalinin", 2002, http://nuk-svk.ru #
# Author: Sergey Kalinin banzaj28@yandex.ru #
###########################################################
#package require BWidget
#package require msgcat
## GETTING TABLES OF CONTENT ##
#set homeDir "$env(HOME)/projects/tcl/projman"
#set docDir "$env(HOME)/projects/tcl/projman/hlp"
#set imgDir "$env(HOME)/projects/tcl/projman/img"
#set msgDir "$env(HOME)/projects/tcl/projman/msgs"
#set workDir "$env(HOME)/.projman"
#source $workDir/projman.conf
source [file join $dataDir html_lib.tcl]
#source [file join $dataDir htmllib.tcl]
set sourceEncode "koi8-r"
## LOAD MESSAGES FILE? LANGUAGE AND NEDDED FILES ##
#source $homeDir/html.tcl
#::msgcat::mclocale $locale
#::msgcat::mcload $msgDir
proc HlpTreeOneClick {node} {
global fontNormal hlpTree wordList hlpNoteBook findString imgDir fontBold fontNormal
global lstSearch nodeParent
$hlpTree selection set $node
set nodeParent [$hlpTree parent $node]
set item [$hlpTree itemcget $node -data]
set file [string range $item 4 end]
#puts "$file" ;#debuf info
if {[string range $item 0 2] == "toc"} {
# $hlpTree configure
}
if {[$hlpTree itemcget $node -open] == 1} {
$hlpTree itemconfigure $node -open 0
} elseif {[$hlpTree itemcget $node -open] == 0} {
$hlpTree itemconfigure $node -open 1
}
if {[string range $item 0 2] == "doc"} {
GetContent $file
}
}
## GETTING TABLE OF CONTENT ##
proc GetTOC {} {
global docDir hlpTree imgDir fontNormal lstSearch arr sourceEncode
if {[catch {cd $docDir}] != 0} {
return ""
}
foreach dir [lsort [glob -nocomplain *]] {
if {[file isdirectory $dir] == 1} {
foreach file [lsort [glob -nocomplain [file join $dir *toc.html]]] {
#puts $file
set fileName [file join $file]
set tocFile [open $fileName r]
fconfigure $tocFile -encoding binary
set dot "_"
#set nodeParent [string range $fileName 0 [expr [string first "." $fileName]-1]]
#puts $fileName
set nodeParent [file dirname $fileName]
while {[gets $tocFile line]>=0} {
set a ""
set b ""
set line [encoding convertfrom $sourceEncode $line]
if {[regexp -nocase "<title>.+\</title>" $line a]} {
if {[regexp ">.+\<" $line a]} {
set length [string length $a]
set title [string range $a 1 [expr $length-2]]
#puts $nodeParent ;# debug info
$hlpTree insert end root $nodeParent -text "$title" -font $fontNormal \
-data "toc_$nodeParent" -open 0\
-image [Bitmap::get [file join $imgDir books.gif]]
}
} elseif {[regexp "\".+\"" $line a]} {
set data [string range $a 1 [expr [string last "\"" $a]-1]]
if {[regexp ">.+\<" $line b]} {
set line [string range $b 1 [expr [string first "<" $b]-1]]
regsub -all {[ :]} $line "_" subNode
#regsub -all ":" $ubNode "_" node
set subNode "$nodeParent$dot$subNode"
if {[info exists arr($subNode)] == 0} {
set arr($subNode) [file join $dir $data]
}
set data [file join $dir $data]
#puts "$subNode" ;# debug info
$hlpTree insert end "$nodeParent" $subNode -text "$line"\
-font $fontNormal -data "doc_$data" -open 0\
-image [Bitmap::get [file join $imgDir file.gif]]
$lstSearch insert end $line
}
} else {
break
}
}
} ;# foreach
}
}
$hlpTree configure -redraw 1
}
proc SearchWord {word} {
global arr nBookTree
set word [string tolower [string trim $word]]
puts $word
$nBookTree raise hlpSearch
InsertEnt .help.frmBody.frmCat.nBookTree.fhlpSearch.frmScrhEnt.entSearch $word
foreach wrd [array names arr] {
set name "[file rootname [file tail $arr($wrd)]]"
set file "$arr($wrd)"
if {[string match "$word*" [string tolower $name]] == 1} {
GetContent $file
}
}
}
## GETTING CONTENT FROM FILES ##
proc GetContent {file} {
global docDir hlpNoteBook fontNormal sourceEncode editor
$hlpNoteBook raise [$hlpNoteBook page 0]
set node [$hlpNoteBook raise]
if {$node != ""} {
$hlpNoteBook delete hlpHTML
}
set nbTitle ""
set html ""
set file [open $file r]
fconfigure $file -encoding binary
while {[gets $file line]>=0} {
set line [encoding convertfrom $sourceEncode $line]
if {[regexp -nocase "<title>.+\</title>" $line a]} {
if {[regexp ">.+\<" $a a]} {
set length [string length $a]
set nbTitle [string range $a 1 [expr $length-2]]
#puts $nbTitle
#puts $a
}
}
append html $line\n
}
set frmHTML [$hlpNoteBook insert end hlpHTML -text $nbTitle]
set txt [text $frmHTML.txtHTML -yscrollcommand "$frmHTML.yscroll set" \
-relief sunken -wrap word -highlightthickness 0 -font $fontNormal\
-selectborderwidth 0 -selectbackground #55c4d1 -width 10]
scrollbar $frmHTML.yscroll -relief sunken -borderwidth {1} -width {10} -takefocus 0\
-command "$frmHTML.txtHTML yview"
pack $txt -side left -fill both -expand true
pack $frmHTML.yscroll -side left -fill y
$hlpNoteBook raise hlpHTML
focus -force $txt
# $txt configure -state disabled
HM::init_win $txt
HM::set_link_callback LinkCallback
HM::set_state $txt -size 0
HM::set_indent $txt 1.2
HM::parse_html $html "HM::render $txt"
# HM::tag_title .help "Help - $nbTitle"
$txt configure -state disabled
}
## GOTO URL PROCEDURE ##
proc LinkCallback {w url} {
global docDir nodeParent
set url "[file join $docDir $nodeParent $url]"
if {[catch {open $url r} oHTML]} {
tk_messageBox -title "[::msgcat::mc "Error open URL"]"\
-message "[::msgcat::mc "Can't found file:"] $url"\
-icon error -type ok
} else {
GetContent $url
}
}
## autor DEDERER ##
proc LinkCallback_ {w url} {
global docDir
set url "[file join $docDir $url]"
if {[catch {open $url r} oHTML]} {
tk_messageBox -title "[::msgcat::mc "Error open URL"]"\
-message "[::msgcat::mc "Can't founf file: $url"]"\
-icon error -type ok
} else {
set html [read $oHTML]
$w configure -state normal
HM::reset_win $w
HM::parse_html $html "HM::render $w"
$w configure -state disable
}
# HM::render [winfo toplevel $w] $url
}
## MAIN HELP WINDOW ##
proc TopLevelHelp {} {
global fontNormal fontBold hlpTree hlpNoteBook nBookTree homeDir docDir lstSearch w frmSrchList
global imgDir color editor
set w .help
set w_exist [winfo exists $w]
if !$w_exist {
toplevel $w
# wm resizable .help 0 0
wm geometry $w 900x800+0+0
wm title $w [::msgcat::mc "Help"]
# wm protocol $w WM_DELETE_WINDOW {destroy .msg .help}
#wm geometry . 600x400+0+0
wm title $w [::msgcat::mc "Help"]
frame $w.frmMenu -border 1 -relief raised
frame $w.frmTool -border 1 -relief raised
frame $w.frmBody -border 1 -relief raised
frame $w.frmStatus -border 1 -relief sunken
pack $w.frmMenu -side top -padx 1 -fill x
pack $w.frmTool -side top -padx 1 -fill x
pack $w.frmBody -side top -padx 1 -fill both -expand true
pack $w.frmStatus -side top -padx 1 -fill x
button $w.frmTool.btnBack -relief groove -font $fontBold -command Back -state disable
button $w.frmTool.btnForward -relief groove -font $fontBold -command Forward -state disable
button $w.frmTool.btnRefresh -relief groove -font $fontBold -command Refresh -state disable
button $w.frmTool.btnPrint -relief groove -font $fontBold -command Print -state disable
image create photo imgBack -format gif -file [file join $imgDir back.gif]
image create photo imgForward -format gif -file [file join $imgDir forward.gif]
image create photo imgRefresh -format gif -file [file join $imgDir refresh.gif]
image create photo imgPrint -format png -file [file join $imgDir printer.png]
$w.frmTool.btnBack configure -image imgBack
$w.frmTool.btnForward configure -image imgForward
$w.frmTool.btnRefresh configure -image imgRefresh
$w.frmTool.btnPrint configure -image imgPrint
pack $w.frmTool.btnBack $w.frmTool.btnForward $w.frmTool.btnRefresh $w.frmTool.btnPrint\
-side left -fill x
set frmCat [frame $w.frmBody.frmCat -border 1 -relief sunken]
pack $frmCat -side left -fill y
set frmWork [frame $w.frmBody.frmWork -border 1 -relief sunken]
pack $frmWork -side left -fill both -expand true
set nBookTree [NoteBook $frmCat.nBookTree -font $fontNormal -bg $editor(bg) -fg $editor(fg)]
pack $nBookTree -fill both -expand true -padx 2 -pady 2
set frmTreeNb [$nBookTree insert end hlpTree -text "[::msgcat::mc "Contents"]"]
set frmSearch [$nBookTree insert end hlpSearch -text "[::msgcat::mc "Search"]"]
$nBookTree raise hlpTree
set frmScrlX [frame $frmTreeNb.frmScrlX -border 0 -relief sunken]
set frmTree [frame $frmTreeNb.frmTree -border 1 -relief sunken]
set hlpTree [Tree $frmTree.tree \
-relief sunken -borderwidth 1 -width 20 -highlightthickness 0\
-redraw 0 -dropenabled 1 -dragenabled 1 -dragevent 3 \
-yscrollcommand {.help.frmBody.frmCat.nBookTree.fhlpTree.frmTree.scrlY set} \
-xscrollcommand {.help.frmBody.frmCat.nBookTree.fhlpTree.frmScrlX.scrlX set} \
-selectbackground "#55c4d1" \
-droptypes {
TREE_NODE {copy {} move {} link {}}
LISTBOX_ITEM {copy {} move {} link {}}
} -opencmd "" -closecmd ""]
pack $frmTree -side top -fill y -expand true
pack $frmScrlX -side top -fill x
scrollbar $frmTree.scrlY -command {$hlpTree yview} \
-borderwidth {1} -width {10} -takefocus 0
pack $hlpTree $frmTree.scrlY -side left -fill y
scrollbar $frmScrlX.scrlX -command {$hlpTree xview} \
-orient horizontal -borderwidth {1} -width {10} -takefocus 0
pack $frmScrlX.scrlX -fill x -expand true
set frmSrchList [frame $frmSearch.frmScrhList -border 0 -relief sunken]
set frmSrchEnt [frame $frmSearch.frmScrhEnt -border 0 -relief sunken]
set frmSrchScrollX [frame $frmSearch.frmScrhScrollX -border 0 -relief sunken]
pack $frmSrchEnt -side top -fill x
pack $frmSrchList -side top -fill both -expand true
pack $frmSrchScrollX -side top -fill x
entry $frmSrchEnt.entSearch
set lstSearch [listbox $frmSrchList.lstSearch -font $fontNormal\
-yscrollcommand\
{.help.frmBody.frmCat.nBookTree.fhlpSearch.frmScrhList.scrListY set}\
-xscrollcommand\
{.help.frmBody.frmCat.nBookTree.fhlpSearch.frmScrhScrollX.scrListX set}\
-selectmode single -selectbackground #55c4d1\
-selectborderwidth 0]
scrollbar $frmSrchList.scrListY -command\
{$frmSrchList.lstSearch yview} -borderwidth {1} -width {10} -takefocus 0
pack $frmSrchEnt.entSearch -side top -fill x -expand true
pack $frmSrchList.lstSearch -side left -fill both -expand true
pack $frmSrchList.scrListY -side left -fill y
scrollbar $frmSrchScrollX.scrListX -orient horizontal -command\
{$frmSrchList.lstSearch xview} -borderwidth {1} -width {10} -takefocus 0
pack $frmSrchScrollX.scrListX -fill x
# $hlpTree bindText <ButtonRelease-4> [puts %k]
# $hlpTree bindText <ButtonRelease-3> [puts %k]
# bind $frmTree <ButtonPress-4> {$frmSrchList.lstSearch xview}
# $hlpTree bindText <Double-ButtonPress-1> "HlpTreeDoubleClick [$hlpTree selection get]"
# $hlpTree bindImage <Double-ButtonPress-1> "HlpTreeDoubleClick [$hlpTree selection get]"
$hlpTree bindText <ButtonPress-1> "HlpTreeOneClick [$hlpTree selection get]"
$hlpTree bindImage <ButtonPress-1> "HlpTreeOneClick [$hlpTree selection get]"
bind .help <Escape> "destroy .help"
# bind $frmSrchEnt.entSearch <KeyRelease>\
# {SearchWord [Text .help.frmBody.frmCat.nBookTree.fhlpSearch.frmScrhEnt.entSearch]}
#bind $w <Escape> exit
#bind $frmTree <Down> {TreeClick [$hlpTree selection get]}
#bind $frmTree <Up> {TreeClick [$hlpTree selection get]}
#bind $frmTree <Return> {TreeClick [$hlpTree selection get]}
bind $frmTree.tree.c <Button-4> "$hlpTree yview scroll -3 units"
bind $frmTree.tree.c <Button-5> "$hlpTree yview scroll 3 units"
bind $frmTree.tree.c <Shift-Button-4> "$hlpTree xview scroll -2 units"
bind $frmTree.tree.c <Shift-Button-5> "$hlpTree xview scroll 2 units"
set hlpNoteBook [NoteBook $frmWork.hlpNoteBook -font $fontNormal -bg $editor(bg) -fg $editor(fg)]
pack $hlpNoteBook -fill both -expand true -padx 2 -pady 2
GetTOC
}
}
##################################################
#TopLevelHelp
#GetTOC
#GetContent $docDir/tcl.toc.html

View File

@ -1,219 +0,0 @@
###########################################################
# Tcl/Tk Project Manager #
# version 0.0.1 #
# TCL highlight file #
# Copyright (c) "Sergey Kalinin", 2001, http://nuk-svk.ru #
# Author: Sergey Kalinin banzaj28@yandex.ru #
###########################################################
set beginQuote "0.0"
set endQuote "2.0"
set endQuotePrev "0.0"
proc HighLightML {text line lineNumber node} {
global fontNormal fontBold editorFontBold tree imgDir noteBook
global editor color
global beginQuote endQuote endQuotePrev
set startIndex 0
$text tag configure bold -font $editor(fontBold)
$text tag configure className -font $editor(fontBold) -foreground $color(procName)
$text tag configure keyWord -foreground $color(keyWord)
$text tag configure comments -foreground $color(comments)
$text tag configure variable -foreground $color(var)
$text tag configure string -foreground $color(string)
$text tag configure braceHighLight -font $editor(fontBold)\
-foreground $color(braceBG) -background $color(braceFG)
$text tag configure brace -foreground $color(brace)
$text tag configure percent -foreground $color(percent)
$text tag configure bindKey -foreground $color(bindKey)
$text tag configure sql -font $editor(fontBold) -foreground $color(sql)
set keyWord [info commands]
# for OOP extention
foreach n {let match compile load exception function bol begin end then type done with class method attribute constructor destructor invariant attribute binding new delete extends final finally implements import interface native new private protected public static super this throw synchronized throws transient try volatile void else} {lappend keyWord $n}
set dataType {list abstract boolean byte char double float int long short}
set sqlOperators {select from where and or count sum in order cast as by}
set a ""
set startPos 0
set endPos 0
set length 0
set workLine $line
set className ""
while {$workLine != ""} {
if {[regexp "(^|\t| )\[a-zA-Z\\_:\]+" $workLine word]} {
set length [string length $word]
set startPos [string first [string trim $word] $line]
set endPos [expr $startPos + $length]
set workLine [string range $workLine $length end]
if {[lsearch $keyWord [string trim $word]] != -1} {
$text tag add keyWord $lineNumber.$startPos $lineNumber.$endPos
}
if {[lsearch $dataType [string trim $word]] != -1} {
$text tag add bold $lineNumber.$startPos $lineNumber.$endPos
}
if {[lsearch $sqlOperators [string trim $word]] != -1} {
$text tag add sql $lineNumber.$startPos $lineNumber.$endPos
}
if {[string trim $word]=="let" || [string trim $word]=="extends" || [string trim $word]=="implements"} {
$text tag add className $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]]
}
set startPos [expr $endPos + 1]
} else {
break
}
}
# key binding highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "<.*?>" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add bindKey $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# variable highlight #
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "\\$\[a-zA-Z\\_:\]+" $workLine a]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
if {$a != ""} {
$text tag add variable $lineNumber.$start $lineNumber.$end
}
set startPos $end
} else {
break
}
}
# string " " highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "\".*?\"" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add string $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# persent % highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
# if {[regexp "\%.*? " $workLine a b]}
if {[regexp "\%" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add percent $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
## COMENTS ##
set workLine [$text get $lineNumber.0 $lineNumber.end]
if {[regexp -indices {(^|\t|;| )\(\*} $workLine begin]} {
set p [lindex $begin 0]
$text tag add comments $lineNumber.[expr $p - 0] $lineNumber.end
} elseif {[regexp -indices {(^|\t|;| )\*} $workLine beginIndex]} {
set beginQuote "$lineNumber.[lindex $beginIndex 0]"
set endQuote [$text search -forward -regexp -- {\*\)} $beginQuote end]
if {$endQuote != ""} {
$text tag add comments $beginQuote "$endQuote + 2 chars"
} else {
$text tag add comments $beginQuote end
}
set endQuotePrev [$text search -backward -regexp -- {\*\)} [expr $lineNumber - 1].end 0.0]
if {$endQuotePrev != ""} {
$text tag remove comments "$endQuotePrev + 2 chars" $beginQuote
}
} elseif {[regexp -indices {\*\)} $workLine endIndex]} {
set endQuote "$lineNumber.[lindex $endIndex 1]"
set beginQuote [$text search -backward -regexp -- {\(\*} $endQuote 0.0]
if {$beginQuote != ""} {
$text tag add comments $beginQuote "$endQuote + 1 chars"
} else {
$text tag add comments 0.0 "$endQuote + 1 chars"
}
set beginQuoteNext [$text search -forward -regexp -- {\(\*} $endQuote end]
if {$beginQuoteNext != ""} {
$text tag remove comments "$endQuote + 2 chars" $beginQuoteNext
}
} else {
if {[lindex [split $beginQuote "."] 0] <= $lineNumber && [lindex [split $endQuote "."] 0] >= $lineNumber} {
#$text tag add comments $lineNumber.0 $lineNumber.end
} else {
$text tag remove comments $lineNumber.0 $lineNumber.end
}
}
# DEDERER
# hightlight [, {, }, ], ( , )
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp {\(|\[|{|}|\]|\)} $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add bold $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# parameter for command hightlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp -- {\s-\w+(?=\s)} $workLine a b]} {
set start [expr [string first $a $workLine] + 1]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add bindKey $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
}

View File

@ -1,220 +0,0 @@
###########################################################
# Tcl/Tk Project Manager #
# version 0.0.1 #
# TCL highlight file #
# Copyright (c) "Sergey Kalinin", 2001, http://nuk-svk.ru #
# Author: Sergey Kalinin banzaj28@yandex.ru #
###########################################################
set beginQuote "0.0"
set endQuote "2.0"
set endQuotePrev "0.0"
proc HighLightErl {text line lineNumber node} {
global fontNormal fontBold editorFontBold tree imgDir noteBook
global editor color
global beginQuote endQuote endQuotePrev
set startIndex 0
$text tag configure bold -font $editor(fontBold)
$text tag configure className -font $editor(fontBold) -foreground $color(procName)
$text tag configure keyWord -foreground $color(keyWord)
$text tag configure comments -foreground $color(comments)
$text tag configure variable -foreground $color(var)
$text tag configure string -foreground $color(string)
$text tag configure braceHighLight -font $editor(fontBold)\
-foreground $color(braceBG) -background $color(braceFG)
$text tag configure brace -foreground $color(brace)
$text tag configure percent -foreground $color(percent)
$text tag configure bindKey -foreground $color(bindKey)
$text tag configure sql -font $editor(fontBold) -foreground $color(sql)
set keyWord [info commands]
# for OOP extention
foreach n {let match compile load exception function bol begin end then type done with class method attribute constructor destructor invariant attribute binding new delete extends final finally implements import interface native new private protected public static super this throw synchronized throws transient try volatile void else} {lappend keyWord $n}
set dataType {list abstract boolean byte char double float int long short}
set sqlOperators {select from where and or count sum in order cast as by}
set a ""
set startPos 0
set endPos 0
set length 0
set workLine $line
set className ""
while {$workLine != ""} {
if {[regexp "(^|\t| )\[a-zA-Z\\_:\]+" $workLine word]} {
set length [string length $word]
set startPos [string first [string trim $word] $line]
set endPos [expr $startPos + $length]
set workLine [string range $workLine $length end]
if {[lsearch $keyWord [string trim $word]] != -1} {
$text tag add keyWord $lineNumber.$startPos $lineNumber.$endPos
}
if {[lsearch $dataType [string trim $word]] != -1} {
$text tag add bold $lineNumber.$startPos $lineNumber.$endPos
}
if {[lsearch $sqlOperators [string trim $word]] != -1} {
$text tag add sql $lineNumber.$startPos $lineNumber.$endPos
}
if {[string trim $word]=="let" || [string trim $word]=="extends" || [string trim $word]=="implements"} {
$text tag add className $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]]
}
set startPos [expr $endPos + 1]
} else {
break
}
}
# key binding highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "<.*?>" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add bindKey $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# variable highlight #
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "\\$\[a-zA-Z\\_:\]+" $workLine a]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
if {$a != ""} {
$text tag add variable $lineNumber.$start $lineNumber.$end
}
set startPos $end
} else {
break
}
}
# string " " highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "\".*?\"" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add string $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# persent % highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
# if {[regexp "\%.*? " $workLine a b]}
if {[regexp "\%" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add percent $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
## COMENTS ##
set workLine [$text get $lineNumber.0 $lineNumber.end]
if {[regexp -indices {(^|\t|;| )\(\*} $workLine begin]} {
set p [lindex $begin 0]
$text tag add comments $lineNumber.[expr $p - 0] $lineNumber.end
} elseif {[regexp -indices {(^|\t|;| )\*} $workLine beginIndex]} {
set beginQuote "$lineNumber.[lindex $beginIndex 0]"
set endQuote [$text search -forward -regexp -- {\*\)} $beginQuote end]
if {$endQuote != ""} {
$text tag add comments $beginQuote "$endQuote + 2 chars"
} else {
$text tag add comments $beginQuote end
}
set endQuotePrev [$text search -backward -regexp -- {\*\)} [expr $lineNumber - 1].end 0.0]
if {$endQuotePrev != ""} {
$text tag remove comments "$endQuotePrev + 2 chars" $beginQuote
}
} elseif {[regexp -indices {\*\)} $workLine endIndex]} {
set endQuote "$lineNumber.[lindex $endIndex 1]"
set beginQuote [$text search -backward -regexp -- {\(\*} $endQuote 0.0]
if {$beginQuote != ""} {
$text tag add comments $beginQuote "$endQuote + 1 chars"
} else {
$text tag add comments 0.0 "$endQuote + 1 chars"
}
set beginQuoteNext [$text search -forward -regexp -- {\(\*} $endQuote end]
if {$beginQuoteNext != ""} {
$text tag remove comments "$endQuote + 2 chars" $beginQuoteNext
}
} else {
if {[lindex [split $beginQuote "."] 0] <= $lineNumber && [lindex [split $endQuote "."] 0] >= $lineNumber} {
#$text tag add comments $lineNumber.0 $lineNumber.end
} else {
$text tag remove comments $lineNumber.0 $lineNumber.end
}
}
# DEDERER
# hightlight [, {, }, ], ( , )
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp {\(|\[|{|}|\]|\)} $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add bold $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# parameter for command hightlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp -- {\s-\w+(?=\s)} $workLine a b]} {
set start [expr [string first $a $workLine] + 1]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add bindKey $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
}

View File

@ -1,214 +0,0 @@
###########################################################
# Tcl/Tk Project Manager #
# version 0.0.1 #
# TCL highlight file #
# Copyright (c) "Sergey Kalinin", 2001, http://nuk-svk.ru #
# Author: Sergey Kalinin banzaj28@yandex.ru #
###########################################################
set beginQuote "0.0"
set endQuote "2.0"
set endQuotePrev "0.0"
proc HighLightFORTRAN {text line lineNumber node} {
global fontNormal fontBold editorFontBold tree imgDir noteBook
global editor color
global beginQuote endQuote endQuotePrev
set startIndex 0
$text tag configure bold -font $editor(fontBold)
$text tag configure className -font $editor(fontBold) -foreground $color(procName)
$text tag configure keyWord -foreground $color(keyWord)
$text tag configure comments -foreground $color(comments) ;#-background $editor(bg)
$text tag configure variable -foreground $color(var)
$text tag configure string -foreground $color(string)
$text tag configure braceHighLight -font $editor(fontBold)\
-foreground $color(braceBG) -background $color(braceFG)
$text tag configure brace -foreground $color(brace)
$text tag configure percent -foreground $color(percent)
$text tag configure bindKey -foreground $color(bindKey)
$text tag configure label -background $color(label)
$text tag configure six -foreground $color(sixFG) -background $color(sixBG)
$text tag configure operator -background $editor(bg)
set keyWord [info commands]
# for OOP extention
foreach n {program function subroutine entry block data implicit integer real double precision complex\
logical character dimension common equivalence parameter external intrinsic save data goto assign if then\
else elseif endif end do while enddo continue stop pause end open close read write print\
inquire rewind backspace endfile format call return include} {lappend keyWord $n}
#set dataType {list abstract boolean byte char double float int long short}
set dataType ""
set a ""
set startPos 0
set endPos 0
set length 0
set workLine $line
set className ""
while {$workLine != ""} {
if {[regexp "(^|\t| )\[a-zA-Z\\_:\]+" $workLine word]} {
set length [string length $word]
set startPos [string first [string trim $word] $line]
set endPos [expr $startPos + $length]
set workLine [string range $workLine $length end]
if {[lsearch $keyWord [string trim $word]] != -1} {
$text tag add keyWord $lineNumber.$startPos $lineNumber.$endPos
}
if {[lsearch $dataType [string trim $word]] != -1} {
$text tag add bold $lineNumber.$startPos $lineNumber.$endPos
}
if {[string trim $word]=="class" || [string trim $word]=="extends" || [string trim $word]=="implements"} {
$text tag add className $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]]
}
set startPos [expr $endPos + 1]
} else {
break
}
}
# key binding highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "<.*?>" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add bindKey $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# variable highlight #
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "\\$\[a-zA-Z\\_:\]+" $workLine a]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
if {$a != ""} {
$text tag add variable $lineNumber.$start $lineNumber.$end
}
set startPos $end
} else {
break
}
}
# string " " highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "\".*?\"" $workLine a b] || [regexp "\'.*?\'" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add string $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# persent % highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
# if {[regexp "\%.*? " $workLine a b]}
if {[regexp "\%" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add percent $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
$text tag remove label $lineNumber.0 $lineNumber.end
$text tag add label $lineNumber.0 $lineNumber.5
$text tag remove six $lineNumber.0 $lineNumber.5
$text tag remove six $lineNumber.6 $lineNumber.end
$text tag add six $lineNumber.5 $lineNumber.6
$text tag remove operator $lineNumber.6 $lineNumber.end
$text tag add operator $lineNumber.7 $lineNumber.71
$text tag remove comments $lineNumber.72 $lineNumber.end
$text tag add comments $lineNumber.72 $lineNumber.end
## COMENTS ##
set workLine [$text get $lineNumber.0 $lineNumber.end]
#if {[regexp -indices -nocase {^(c|\*)} $workLine word]}
if {[regexp -indices -nocase {^(c|\*)} $workLine word]} {
set p [lindex $word 1]
#puts "$p $lineNumber -- $workLine"
$text tag remove label $lineNumber.0 $lineNumber.end
$text tag remove operator $lineNumber.0 $lineNumber.end
$text tag add comments $lineNumber.$p $lineNumber.end
$text tag remove six $lineNumber.5 $lineNumber.6
#puts [$text dump -tag $lineNumber.0 $lineNumber.end]
#$text tag raise comments
#puts [$text tag ranges comments]
} else {
$text tag remove comments $lineNumber.0 $lineNumber.end
}
set workLine [$text get $lineNumber.0 $lineNumber.end]
if {[regexp -indices -nocase {\!} $workLine word]} {
set p [lindex $word 1]
if {([string index $workLine [expr $p + 1]] == "\'") || ([string index $workLine [expr $p + 1]] == "\"")} {
} else {
#$text tag add comments $lineNumber.$p $lineNumber.end
}
} else {
#$text tag remove comments $lineNumber.0 $lineNumber.end
}
# DEDERER
# hightlight [, {, }, ], ( , )
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp {\(|\[|{|}|\]|\)} $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add bold $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# parameter for command hightlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp -- {\s-\w+(?=\s)} $workLine a b]} {
set start [expr [string first $a $workLine] + 1]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add bindKey $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
}

View File

@ -1,106 +0,0 @@
###########################################################
# Tcl/Tk Project Manager #
# version 0.0.1 #
# TCL highlight file #
# Copyright (c) "Sergey Kalinin", 2001, http://nuk-svk.ru #
# Author: Sergey Kalinin banzaj28@yandex.ru #
###########################################################
proc HighLightHTML {text line lineNumber node} {
global fontNormal editorFontBold tree imgDir fontBold
global editor color
set startIndex 0
# bind text tags for highlightning #
$text tag configure bold -font $editor(fontBold)
$text tag configure procName -font $editor(fontBold) -foreground $color(procName)
$text tag configure keyWord -foreground $color(keyWord)
$text tag configure comments -foreground $color(comments)
$text tag configure variable -foreground $color(var)
$text tag configure string -foreground $color(string)
$text tag configure braceHighLight -font $editor(fontBold)\
-foreground $color(braceBG) -background $color(braceFG)
$text tag configure brace -foreground $color(brace)
$text tag configure percent -foreground $color(percent)
$text tag configure bindKey -foreground $color(bindKey)
# incr lineNumber
set keyWord [info commands]
# for OOP extention
foreach n {class method attribute constructor destructor invariant attribute binding new delete} {
lappend keyWord $n
}
# add comment #
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "<\!--.+-->" $workLine a]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add coments $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# get keywords
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "(</?\[a-zA-Z0-9\]+\[> \t\])|>" $workLine a]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add keyWord $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# get variables
set workLine $line
set startPos 0
while {$workLine != ""} {
if {[regexp "\[a-zA-Z0-9\]+=" $workLine a]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add variable $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# get strings
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "\".+\"" $workLine a]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add string $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
}

View File

@ -1,215 +0,0 @@
###########################################################
# Tcl/Tk Project Manager #
# version 0.0.1 #
# TCL highlight file #
# Copyright (c) "Sergey Kalinin", 2001, http://nuk-svk.ru #
# Author: Sergey Kalinin banzaj28@yandex.ru #
###########################################################
set beginQuote "0.0"
set endQuote "2.0"
set endQuotePrev "0.0"
proc HighLightJAVA {text line lineNumber node} {
global fontNormal fontBold editorFontBold tree imgDir noteBook
global editor color
global beginQuote endQuote endQuotePrev
set startIndex 0
$text tag configure bold -font $editor(fontBold)
$text tag configure className -font $editor(fontBold) -foreground $color(procName)
$text tag configure keyWord -foreground $color(keyWord)
$text tag configure comments -foreground $color(comments)
$text tag configure variable -foreground $color(var)
$text tag configure string -foreground $color(string)
$text tag configure braceHighLight -font $editor(fontBold)\
-foreground $color(braceBG) -background $color(braceFG)
$text tag configure brace -foreground $color(brace)
$text tag configure percent -foreground $color(percent)
$text tag configure bindKey -foreground $color(bindKey)
$text tag configure sql -font $editor(fontBold) -foreground $color(sql)
set keyWord [info commands]
# for OOP extention
foreach n {class method attribute constructor destructor invariant attribute binding new delete extends final finally implements import interface native new private protected public static super this throw synchronized throws transient try volatile void else} {lappend keyWord $n}
set dataType {list abstract boolean byte char double float int long short}
set sqlOperators {select from where and or count sum in order cast as by}
set a ""
set startPos 0
set endPos 0
set length 0
set workLine $line
set className ""
while {$workLine != ""} {
if {[regexp "(^|\t| )\[a-zA-Z\\_:\]+" $workLine word]} {
set length [string length $word]
set startPos [string first [string trim $word] $line]
set endPos [expr $startPos + $length]
set workLine [string range $workLine $length end]
if {[lsearch $keyWord [string trim $word]] != -1} {
$text tag add keyWord $lineNumber.$startPos $lineNumber.$endPos
}
if {[lsearch $dataType [string trim $word]] != -1} {
$text tag add bold $lineNumber.$startPos $lineNumber.$endPos
}
if {[lsearch $sqlOperators [string trim $word]] != -1} {
$text tag add sql $lineNumber.$startPos $lineNumber.$endPos
}
if {[string trim $word]=="class" || [string trim $word]=="extends" || [string trim $word]=="implements"} {
$text tag add className $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]]
}
set startPos [expr $endPos + 1]
} else {
break
}
}
# key binding highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "<.*?>" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add bindKey $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# variable highlight #
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "\\$\[a-zA-Z\\_:\]+" $workLine a]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
if {$a != ""} {
$text tag add variable $lineNumber.$start $lineNumber.$end
}
set startPos $end
} else {
break
}
}
# string " " highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "\".*?\"" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add string $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# persent % highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
# if {[regexp "\%.*? " $workLine a b]}
if {[regexp "\%" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add percent $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
## COMENTS ##
set workLine [$text get $lineNumber.0 $lineNumber.end]
if {[regexp -indices "(^|\t|;| )//" $workLine begin]} {
set p [lindex $begin 0]
$text tag add comments $lineNumber.[expr $p - 0] $lineNumber.end
} elseif {[regexp -indices {(^|\t|;| )/\*} $workLine beginIndex]} {
set beginQuote "$lineNumber.[lindex $beginIndex 0]"
set endQuote [$text search -forward -regexp -- {\*/} $beginQuote end]
if {$endQuote != ""} {
$text tag add comments $beginQuote "$endQuote + 2 chars"
} else {
$text tag add comments $beginQuote end
}
set endQuotePrev [$text search -backward -regexp -- {\*/} [expr $lineNumber - 1].end 0.0]
if {$endQuotePrev != ""} {
$text tag remove comments "$endQuotePrev + 2 chars" $beginQuote
}
} elseif {[regexp -indices {\*/} $workLine endIndex]} {
set endQuote "$lineNumber.[lindex $endIndex 1]"
set beginQuote [$text search -backward -regexp -- {/\*} $endQuote 0.0]
if {$beginQuote != ""} {
$text tag add comments $beginQuote "$endQuote + 1 chars"
} else {
$text tag add comments 0.0 "$endQuote + 1 chars"
}
set beginQuoteNext [$text search -forward -regexp -- {/\*} $endQuote end]
if {$beginQuoteNext != ""} {
$text tag remove comments "$endQuote + 2 chars" $beginQuoteNext
}
} else {
if {[lindex [split $beginQuote "."] 0] <= $lineNumber && [lindex [split $endQuote "."] 0] >= $lineNumber} {
#$text tag add comments $lineNumber.0 $lineNumber.end
} else {
$text tag remove comments $lineNumber.0 $lineNumber.end
}
}
# DEDERER
# hightlight [, {, }, ], ( , )
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp {\(|\[|{|}|\]|\)} $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add bold $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# parameter for command hightlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp -- {\s-\w+(?=\s)} $workLine a b]} {
set start [expr [string first $a $workLine] + 1]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add bindKey $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
}

View File

@ -1,204 +0,0 @@
###########################################################
# Tcl/Tk Project Manager #
# version 0.0.1 #
# TCL highlight file #
# Copyright (c) "Sergey Kalinin", 2001, http://nuk-svk.ru #
# Author: Sergey Kalinin banzaj28@yandex.ru #
###########################################################
set beginQuote "0.0"
set endQuote "2.0"
set endQuotePrev "0.0"
proc HighLightPERL {text line lineNumber node} {
global fontNormal fontBold editorFontBold tree imgDir noteBook
global editor color
global beginQuote endQuote endQuotePrev
set startIndex 0
$text tag configure bold -font $editor(fontBold)
$text tag configure className -font $editor(fontBold) -foreground $color(procName)
$text tag configure keyWord -foreground $color(keyWord)
$text tag configure comments -foreground $color(comments)
$text tag configure variable -foreground $color(var)
$text tag configure string -foreground $color(string)
$text tag configure braceHighLight -font $editor(fontBold)\
-foreground $color(braceBG) -background $color(braceFG)
$text tag configure brace -foreground $color(brace)
$text tag configure percent -foreground $color(percent)
$text tag configure bindKey -foreground $color(bindKey)
$text tag configure sql -font $editor(fontBold) -foreground $color(sql)
set keyWord [info commands]
# for OOP extention
foreach n {print my use sub printf substr ord class method attribute constructor destructor invariant attribute binding new delete extends final finally implements import interface native new private protected public static super this throw synchronized throws transient try volatile void else } {lappend keyWord $n}
set dataType {list abstract boolean byte char double float int long short}
set sqlOperators {select from where and or count sum in order cast as by}
set a ""
set startPos 0
set endPos 0
set length 0
set workLine $line
set className ""
while {$workLine != ""} {
if {[regexp "(^|\t| )\[a-zA-Z\\_:\]+" $workLine word]} {
set length [string length $word]
set startPos [string first [string trim $word] $line]
set endPos [expr $startPos + $length]
set workLine [string range $workLine $length end]
if {[lsearch $keyWord [string trim $word]] != -1} {
$text tag add keyWord $lineNumber.$startPos $lineNumber.$endPos
}
if {[lsearch $dataType [string trim $word]] != -1} {
$text tag add bold $lineNumber.$startPos $lineNumber.$endPos
}
if {[lsearch $sqlOperators [string trim $word]] != -1} {
$text tag add sql $lineNumber.$startPos $lineNumber.$endPos
}
if {[string trim $word]=="class" || [string trim $word]=="extends" || [string trim $word]=="implements" || [string trim $word]=="use"} {
$text tag add className $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]]
}
set startPos [expr $endPos + 1]
} else {
break
}
}
# key binding highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "<.*?>" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add bindKey $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# variable highlight #
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "\\$\[a-zA-Z\\_:\]+" $workLine a]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
if {$a != ""} {
$text tag add variable $lineNumber.$start $lineNumber.$end
}
set startPos $end
} else {
break
}
}
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "\\@\[a-zA-Z\\_:\]+" $workLine a]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
if {$a != ""} {
$text tag add variable $lineNumber.$start $lineNumber.$end
}
set startPos $end
} else {
break
}
}
# string " " highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "\".*?\"" $workLine a b] || [regexp "\'.*?\'" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add string $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# persent % highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
# if {[regexp "\%.*? " $workLine a b]}
if {[regexp "\%" $workLine a b] || [regexp "(\-\>)" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add percent $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
## COMENTS ##
set workLine [$text get $lineNumber.0 $lineNumber.end]
if {[regexp -indices "(^|\t|;| )#" $workLine word]} {
set p [lindex $word 1]
$text tag add comments $lineNumber.$p $lineNumber.end
} else {
$text tag remove comments $lineNumber.0 $lineNumber.end
}
# DEDERER
# hightlight [, {, }, ], ( , )
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp {\(|\[|{|}|\]|\)} $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add bold $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# parameter for command hightlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp -- {\s-\w+(?=\s)} $workLine a b]} {
set start [expr [string first $a $workLine] + 1]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add bindKey $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
}

View File

@ -1,270 +0,0 @@
###########################################################
# Tcl/Tk Project Manager #
# version 0.0.1 #
# TCL highlight file #
# Copyright (c) "Sergey Kalinin", 2001, http://nuk-svk.ru #
# Author: Sergey Kalinin banzaj28@yandex.ru #
###########################################################
proc HighLightPHP {text line lineNumber node} {
global fontNormal fontBold editorFontBold tree imgDir noteBook
global editor color
global beginQuote endQuote endQuotePrev
# set pos [$text index insert]
# set lineNumber [lindex [split $pos "."] 0]
set startIndex 0
# bind text tags for highlightning #
$text tag configure bold -font $editor(fontBold)
$text tag configure procName -font $editor(fontBold) -foreground $color(procName)
$text tag configure keyWord -foreground $color(keyWord)
$text tag configure comments -foreground $color(comments)
$text tag configure variable -foreground $color(var)
$text tag configure string -foreground $color(string)
$text tag configure braceHighLight -font $editor(fontBold)\
-foreground $color(braceBG) -background $color(braceFG)
$text tag configure brace -foreground $color(brace)
$text tag configure percent -foreground $color(percent)
$text tag configure bindKey -foreground $color(bindKey)
$text tag configure rivet -foreground $color(bindKey) -font $editor(fontBold) -foreground "#ff8800" ;#-background "#c6c6c6"
$text tag configure sql -font $editor(fontBold) -foreground $color(sql)
# incr lineNumber
set keyWord [info commands]
# for OOP extention
foreach n {class method attribute constructor destructor invariant attribute binding new delete \
mcset mc mclocale mcpreferences mcload mcunknown configure match else elseif} {
lappend keyWord $n
}
foreach n {var include_once include function case echo select from where in order by and or} {
lappend keyWord $n
}
set dataType {true false}
set sqlOperators {select from where and or count sum in order cast as by}
set a ""
set startPos 0
set endPos 0
set length 0
set workLine $line
while {$workLine != ""} {
if {[regexp "(^|\t| )\[a-zA-Z\\_:\]+" $workLine word]} {
set length [string length $word]
set startPos [string first [string trim $word] $line]
set endPos [expr $startPos + $length]
set workLine [string range $workLine $length end]
if {[lsearch $keyWord [string trim $word]] != -1} {
$text tag add keyWord $lineNumber.$startPos $lineNumber.$endPos
}
if {[lsearch $dataType [string trim $word]] != -1} {
$text tag add bold $lineNumber.$startPos $lineNumber.$endPos
}
if {[lsearch $sqlOperators [string trim $word]] != -1} {
$text tag add sql $lineNumber.$startPos $lineNumber.$endPos
}
if {[string trim $word]=="proc"} {
$text tag add procName $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]]
}
set startPos [expr $endPos + 1]
} else {
break
}
}
set workLine $line
while {$workLine != ""} {
if {[regexp {(\{|\[)[a-zA-Z\\_:]+} $workLine word v]} {
set word [string trim $word $v]
set length [string length $word]
set startPos [string first [string trim $word] $line]
set endPos [expr $startPos + $length]
set workLine [string range $workLine $length end]
if {[lsearch $keyWord [string trim $word]] != -1} {
$text tag add keyWord $lineNumber.$startPos $lineNumber.$endPos
}
if {[string trim $word]=="proc"} {
$text tag add procName $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]]
}
set startPos [expr $endPos + 1]
} else {
break
}
}
# key binding highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "(</?\[a-zA-Z0-9\]+\[> \t\])|>" $workLine a]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add keyWord $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# variable highlight #
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "\\$\[a-zA-Z\\_:\]+" $workLine a]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
if {$a != ""} {
$text tag add variable $lineNumber.$start $lineNumber.$end
}
set startPos $end
} else {
break
}
}
# persent % highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "\%" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add percent $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# DEDERER
# hightlight [, {, }, ]
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp {\(|\[|{|}|\]|\)} $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add bold $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp {\<\?|\?>} $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add rivet $lineNumber.$start $lineNumber.end
set startPos $end
} else {
break
}
}
# string " " highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "\".*?\"" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add string $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# parameter for command hightlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp -- {\s-\w+(?=\s)} $workLine a b]} {
set start [expr [string first $a $workLine] + 1]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add bindKey $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "<!.+>" $workLine a]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add coments $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# add comment #
set workLine [$text get $lineNumber.0 $lineNumber.end]
if {[regexp -indices "(^|\t|;| )//" $workLine begin]} {
set p [lindex $begin 0]
$text tag add comments $lineNumber.[expr $p - 0] $lineNumber.end
} elseif {[regexp -indices {(^|\t|;| )/\*} $workLine beginIndex]} {
set beginQuote "$lineNumber.[lindex $beginIndex 0]"
set endQuote [$text search -forward -regexp -- {\*/} $beginQuote end]
if {$endQuote != ""} {
$text tag add comments $beginQuote "$endQuote + 2 chars"
} else {
$text tag add comments $beginQuote end
}
set endQuotePrev [$text search -backward -regexp -- {\*/} [expr $lineNumber - 1].end 0.0]
if {$endQuotePrev != ""} {
$text tag remove comments "$endQuotePrev + 2 chars" $beginQuote
}
} elseif {[regexp -indices {\*/} $workLine endIndex]} {
set endQuote "$lineNumber.[lindex $endIndex 1]"
set beginQuote [$text search -backward -regexp -- {/\*} $endQuote 0.0]
if {$beginQuote != ""} {
$text tag add comments $beginQuote "$endQuote + 1 chars"
} else {
$text tag add comments 0.0 "$endQuote + 1 chars"
}
set beginQuoteNext [$text search -forward -regexp -- {/\*} $endQuote end]
if {$beginQuoteNext != ""} {
$text tag remove comments "$endQuote + 2 chars" $beginQuoteNext
}
} else {
if {[lindex [split $beginQuote "."] 0] <= $lineNumber && [lindex [split $endQuote "."] 0] >= $lineNumber} {
#$text tag add comments $lineNumber.0 $lineNumber.end
} else {
$text tag remove comments $lineNumber.0 $lineNumber.end
}
}
}

View File

@ -1,249 +0,0 @@
###########################################################
# Tcl/Tk Project Manager #
# version 0.0.1 #
# TCL highlight file #
# Copyright (c) "Sergey Kalinin", 2001, http://nuk-svk.ru #
# Author: Sergey Kalinin banzaj28@yandex.ru #
###########################################################
proc HighLightRIVET {text line lineNumber node} {
global fontNormal fontBold editorFontBold tree imgDir noteBook
global editor color
# set pos [$text index insert]
# set lineNumber [lindex [split $pos "."] 0]
set startIndex 0
# bind text tags for highlightning #
$text tag configure bold -font $editor(fontBold)
$text tag configure sql -font $editor(fontBold) -foreground $color(sql)
$text tag configure procName -font $editor(fontBold) -foreground $color(procName)
$text tag configure keyWord -foreground $color(keyWord)
$text tag configure comments -foreground $color(comments)
$text tag configure variable -foreground $color(var)
$text tag configure string -foreground $color(string)
$text tag configure braceHighLight -font $editor(fontBold)\
-foreground $color(braceBG) -background $color(braceFG)
$text tag configure brace -foreground $color(brace)
$text tag configure percent -foreground $color(percent)
$text tag configure bindKey -foreground $color(bindKey)
$text tag configure rivet -foreground $color(bindKey) -font $editor(fontBold) -foreground "#ff8800" ;#-background "#c6c6c6"
# incr lineNumber
set keyWord [info commands]
# for OOP extention
foreach n {class method attribute constructor destructor invariant attribute binding new delete \
mcset mc mclocale mcpreferences mcload mcunknown configure match else elseif} {
lappend keyWord $n
}
set dataType {true false}
set sqlOperators {select from where and or count sum in order cast as by}
set a ""
set startPos 0
set endPos 0
set length 0
set workLine $line
while {$workLine != ""} {
if {[regexp "(^|\t| )\[a-zA-Z\\_:\]+" $workLine word]} {
set length [string length $word]
set startPos [string first [string trim $word] $line]
set endPos [expr $startPos + $length]
set workLine [string range $workLine $length end]
if {[lsearch $keyWord [string trim $word]] != -1} {
$text tag add keyWord $lineNumber.$startPos $lineNumber.$endPos
}
if {[lsearch $dataType [string trim $word]] != -1} {
$text tag add bold $lineNumber.$startPos $lineNumber.$endPos
}
if {[lsearch $sqlOperators [string tolower [string trim $word]]] != -1} {
$text tag add sql $lineNumber.$startPos $lineNumber.[expr $endPos - 1]
}
if {[string trim $word]=="proc"} {
$text tag add procName $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]]
}
set startPos [expr $endPos + 1]
} else {
break
}
}
set workLine $line
while {$workLine != ""} {
if {[regexp {(\{|\[)[a-zA-Z\\_:]+} $workLine word v]} {
set word [string trim $word $v]
set length [string length $word]
set startPos [string first [string trim $word] $line]
set endPos [expr $startPos + $length]
set workLine [string range $workLine $length end]
if {[lsearch $keyWord [string trim $word]] != -1} {
$text tag add keyWord $lineNumber.$startPos $lineNumber.$endPos
}
if {[string trim $word]=="proc"} {
$text tag add procName $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]]
}
set startPos [expr $endPos + 1]
} else {
break
}
}
# key binding highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "(</?\[a-zA-Z0-9\]+\[> \t\])|>" $workLine a]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add keyWord $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# variable highlight #
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "\\$\[a-zA-Z\\_:\]+" $workLine a]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
if {$a != ""} {
$text tag add variable $lineNumber.$start $lineNumber.$end
}
set startPos $end
} else {
break
}
}
# string " " highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "\".*?\"" $workLine a b] || [regexp "\'.*?\'" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add string $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# persent % highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "\%" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add percent $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# add comment #
set workLine [$text get $lineNumber.0 $lineNumber.end]
if {[regexp -indices "(^|\t|;| )#" $workLine word]} {
set p [lindex $word 1]
$text tag add comments $lineNumber.$p $lineNumber.end
} else {
$text tag remove comments $lineNumber.0 $lineNumber.end
}
# DEDERER
# hightlight [, {, }, ]
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp {\(|\[|{|}|\]|\)} $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add bold $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp {\<\?|\?>} $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add rivet $lineNumber.$start $lineNumber.end
set startPos $end
} else {
break
}
}
# parameter for command hightlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp -- {\s-\w+(?=\s)} $workLine a b]} {
set start [expr [string first $a $workLine] + 1]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add bindKey $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "<!.+>" $workLine a]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add coments $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
}

View File

@ -1,189 +0,0 @@
###########################################################
# Tcl/Tk Project Manager #
# version 0.0.1 #
# TCL highlight file #
# Copyright (c) "Sergey Kalinin", 2001, http://nuk-svk.ru #
# Author: Sergey Kalinin banzaj28@yandex.ru #
###########################################################
set beginQuote "0.0"
set endQuote "2.0"
set endQuotePrev "0.0"
proc HighLightRUBY {text line lineNumber node} {
global fontNormal fontBold editorFontBold tree imgDir noteBook
global editor color
global beginQuote endQuote endQuotePrev
set startIndex 0
$text tag configure bold -font $editor(fontBold)
$text tag configure procName -font $editor(fontBold) -foreground $color(procName)
$text tag configure keyWord -foreground $color(keyWord)
$text tag configure comments -foreground $color(comments)
$text tag configure variable -foreground $color(var)
$text tag configure string -foreground $color(string)
$text tag configure braceHighLight -font $editor(fontBold)\
-foreground $color(braceBG) -background $color(braceFG)
$text tag configure brace -foreground $color(brace)
$text tag configure percent -foreground $color(percent)
$text tag configure bindKey -foreground $color(bindKey)
$text tag configure sql -font $editor(fontBold) -foreground $color(sql)
set keyWord [info commands]
# for OOP extention
foreach n {class method attribute constructor destructor invariant attribute binding new delete extends final finally implements import interface native new private protected public static super this throw synchronized throws transient try volatile void else def end slots require} {lappend keyWord $n}
set dataType {list abstract boolean byte char double float int long short}
set sqlOperators {select from where and or count sum in order cast as by}
set a ""
set startPos 0
set endPos 0
set length 0
set workLine $line
set className ""
while {$workLine != ""} {
if {[regexp "(^|\t| )\[a-zA-Z\\_:\]+" $workLine word]} {
set length [string length $word]
set startPos [string first [string trim $word] $line]
set endPos [expr $startPos + $length]
set workLine [string range $workLine $length end]
if {[lsearch $keyWord [string trim $word]] != -1} {
$text tag add keyWord $lineNumber.$startPos $lineNumber.$endPos
}
if {[lsearch $dataType [string trim $word]] != -1} {
$text tag add bold $lineNumber.$startPos $lineNumber.$endPos
}
if {[string trim $word]=="class"} {
$text tag add procName $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]]
puts "$text tag add procName $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]]"
}
set startPos [expr $endPos + 1]
} else {
break
}
}
# key binding highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "<.*?>" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add bindKey $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# variable highlight #
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "\\@\[a-zA-Z\\_:\]+" $workLine a]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
if {$a != ""} {
$text tag add variable $lineNumber.$start $lineNumber.$end
}
set startPos $end
} else {
break
}
}
# string " " highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "\".*?\"" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add string $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# persent % highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
# if {[regexp "\%.*? " $workLine a b]}
if {[regexp "\%" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add percent $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
## COMENTS ##
# add comment #
set workLine [$text get $lineNumber.0 $lineNumber.end]
if {[regexp -indices "(^|\t|;| )#" $workLine word]} {
set p [lindex $word 1]
$text tag add comments $lineNumber.$p $lineNumber.end
} else {
$text tag remove comments $lineNumber.0 $lineNumber.end
}
# DEDERER
# hightlight [, {, }, ], ( , )
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp {\(|\[|{|}|\]|\)} $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add bold $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# parameter for command hightlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp -- {\s-\w+(?=\s)} $workLine a b]} {
set start [expr [string first $a $workLine] + 1]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add bindKey $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
}

View File

@ -1,136 +0,0 @@
###########################################################
# Tcl/Tk Project Manager #
# version 0.0.1 #
# SPEC highlight file #
# Copyright (c) "Sergey Kalinin", 2001, http://nuk-svk.ru #
# Author: Sergey Kalinin banzaj28@yandex.ru #
###########################################################
proc HighLightSPEC {text line lineNumber node} {
global fontNormal editorFontBold fontBold tree imgDir noteBook
global editor color
# set pos [$text index insert]
# set lineNumber [lindex [split $pos "."] 0]
set startIndex 0
# bind text tags for highlightning #
# foreach tag {bold procName comments string number variable} {
# $text tag remove $tag $lineNumber.0 $lineNumber.end
# }
$text tag configure bold -font $editor(fontBold)
$text tag configure procName -font $editor(fontBold) -foreground $color(procName)
$text tag configure keyWord -foreground $color(keyWord)
$text tag configure comments -foreground $color(comments)
$text tag configure variable -foreground $color(var)
$text tag configure string -foreground $color(string)
$text tag configure braceHighLight -font $editor(fontBold)\
-foreground $color(braceBG) -background $color(braceFG)
$text tag configure brace -foreground $color(brace)
$text tag configure percent -foreground $color(percent)
$text tag configure bindKey -foreground $color(bindKey)
# $text tag configure bold -font $fontBold
# $text tag configure procName -font $editorFontBold -foreground blue
# $text tag configure keyWord -foreground #0000a8
# $text tag configure comments -foreground #9b9b9b
# $text tag configure variable -foreground #e50000
# $text tag configure string -foreground #168400
# $text tag configure braceHighLight -font $editorFontBold -foreground green -background black
# $text tag configure brace -foreground brown
# $text tag configure percent -foreground #a500c6
foreach n {define name version release description prep setup build install post postun clean files defattr changelog doc} {
lappend keyWord $n
}
# add comment #
if {[string range [string trim $line] 0 0] == "#"} {
$text tag add comments $lineNumber.0 $lineNumber.end
return 0
}
set a ""
regexp "^( |\t|\%)*(\[a-z\]|\[A-Z\]|\[0-9\]|_|:|~|\\.|/)+" $line a
if {$a != ""} {
# gets name
set b ""
regexp "^( |\t|\%)*" $line b
set nameStart [string length $b]
set nameEnd [string length $a]
set name [string range $a [string length $b] end]
# is it keyword?
if {[lsearch $keyWord $name] != -1} {
incr nameStart $startIndex
incr nameEnd $startIndex
$text tag add keyWord $lineNumber.$nameStart $lineNumber.$nameEnd
}
}
# variable highlight #
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "\\$\[a-zA-Z\\_:\]+" $workLine a]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
if {$a != ""} {
$text tag add variable $lineNumber.$start $lineNumber.$end
}
set startPos $end
} else {
break
}
}
# string { } highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "\{.*?\}" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add string $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# persent % highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
# if {[regexp "\%.*? " $workLine a b]}
if {[regexp "\%" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add percent $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
#find [
# set i [string first "\[" $line]
# if {$i != -1} {
# incr i
# set line [string range $line $i end]
# incr i $startIndex
# set l [HighLight $text $line $i $node]
# eval lappend res $l
# }
# return $res
}

View File

@ -1,227 +0,0 @@
###########################################
# Tcl/Tk Project Manager
# version 0.0.1
# TCL highlight file
# Copyright (c) Sergey Kalinin 2001, http://nuk-svk.ru
# Author: Sergey Kalinin (aka BanZaj) banzaj28@gmail.com
###########################################
proc HighLightTCL {text line lineNumber node} {
global fontNormal fontBold editorFontBold tree imgDir noteBook
global editor color
set startIndex 0
# bind text tags for highlightning #
$text tag configure bold -font $editor(fontBold)
$text tag configure procName -font $editor(fontBold) -foreground $color(procName)
$text tag configure keyWord -foreground $color(keyWord)
$text tag configure comments -foreground $color(comments)
$text tag configure variable -foreground $color(var)
$text tag configure string -foreground $color(string)
$text tag configure braceHighLight -font $editor(fontBold)\
-foreground $color(braceBG) -background $color(braceFG)
$text tag configure brace -foreground $color(brace)
$text tag configure bracequad -foreground $color(bracequad)
$text tag configure percent -foreground $color(percent)
$text tag configure bindKey -foreground $color(bindKey)
# incr lineNumber
set keyWord [info commands]
# for OOP extention
foreach n {class method attribute constructor destructor invariant attribute binding new delete \
mcset mc mclocale mcpreferences mcload mcunknown configure match else elseif} {
lappend keyWord $n
}
set dataType {true false}
set a ""
set startPos 0
set endPos 0
set length 0
set workLine $line
while {$workLine != ""} {
if {[regexp "(^|\t| )\[a-zA-Z\\_:\]+" $workLine word]} {
set length [string length $word]
set startPos [string first [string trim $word] $line]
set endPos [expr $startPos + $length]
set workLine [string range $workLine $length end]
if {[lsearch $keyWord [string trim $word]] != -1} {
$text tag add keyWord $lineNumber.$startPos $lineNumber.$endPos
}
if {[lsearch $dataType [string trim $word]] != -1} {
$text tag add bold $lineNumber.$startPos $lineNumber.$endPos
}
if {[string trim $word]=="proc"} {
$text tag add procName $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]]
}
set startPos [expr $endPos + 1]
} else {
break
}
}
set workLine $line
while {$workLine != ""} {
if {[regexp {(\{|\[)[a-zA-Z\\_:]+} $workLine word v]} {
set word [string trim $word $v]
set length [string length $word]
set startPos [string first [string trim $word] $line]
set endPos [expr $startPos + $length]
set workLine [string range $workLine $length end]
if {[lsearch $keyWord [string trim $word]] != -1} {
$text tag add keyWord $lineNumber.$startPos $lineNumber.$endPos
}
if {[string trim $word]=="proc"} {
$text tag add procName $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]]
}
set startPos [expr $endPos + 1]
} else {
break
}
}
# key binding highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "<.*?>" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add bindKey $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# variable highlight #
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "\\$\[a-zA-Z\\_:\]+" $workLine a]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
if {$a != ""} {
$text tag add variable $lineNumber.$start $lineNumber.$end
}
set startPos $end
} else {
break
}
}
# string " " highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "\".*?\"" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add string $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# persent % highlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "\%" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add percent $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp "\{|\}" $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add brace $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# add comment #
set workLine [$text get $lineNumber.0 $lineNumber.end]
if {[regexp -indices "(^|\t|;| )#" $workLine word]} {
set p [lindex $word 1]
$text tag add comments $lineNumber.$p $lineNumber.end
} else {
$text tag remove comments $lineNumber.0 $lineNumber.end
}
# DEDERER
# hightlight [, {, }, ]
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp {\(|\[|\]|\)} $workLine a b]} {
set start [string first $a $workLine]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add bracequad $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
# parameter for command hightlight
set startPos 0
set workLine $line
while {$workLine != ""} {
if {[regexp -- {\s-\w+(?=\s)} $workLine a b]} {
set start [expr [string first $a $workLine] + 1]
set end $start
incr end [string length $a]
set workLine [string range $workLine $end end]
incr start $startPos
incr end $startPos
$text tag add bindKey $lineNumber.$start $lineNumber.$end
set startPos $end
} else {
break
}
}
}

File diff suppressed because it is too large Load Diff

View File

@ -1,60 +0,0 @@
package require Img
proc ImageViewer {f w node} {
global tab_label noteBook factor im1 im2 editor
set factor($node) 1.0
frame $w.f -bg $editor(bg)
pack $w.f -side left -fill both -expand true
canvas $w.f.c -xscrollcommand "$w.f.x set" -yscrollcommand "$w.y set" -bg $editor(bg)
scrollbar $w.f.x -ori hori -command "$w.f.c xview" -bg $editor(bg)
scrollbar $w.y -ori vert -command "$w.f.c yview" -bg $editor(bg)
pack $w.f.c -side top -fill both -expand true
pack $w.f.x -side top -fill x
pack $w.y -side left -fill y
bind $w.f.c <Button-4> "%W yview scroll -3 units"
bind $w.f.c <Button-5> "%W yview scroll 3 units"
bind $w.f.c <Shift-Button-4> "%W xview scroll -2 units"
bind $w.f.c <Shift-Button-5> "%W xview scroll 2 units"
bind $w.f.c <Control-Button-4> "scale $w.f.c 0.5 $node"
bind $w.f.c <Control-Button-5> "scale $w.f.c 2 $node"
#$w.scrwin setwidget $w.scrwin.f
openImg $f $w.f.c $node
set tab_label [$noteBook itemcget $node -text]
balloon $w.f.c set "Mouse wheel up/down - vertiÓal scrolling the image\n\
Shift + mouse wheel up/down - horizontal image scrolling\n\
Control + mouse wheel up/down is a scale image -/+"
}
proc openImg {fn w node} {
global im1
set im1 [image create photo -file $fn]
#scale $w
list [file size $fn] bytes, [image width $im1]x[image height $im1]
$w create image 1 1 -image $im1 -anchor nw -tag img
}
proc scale {w {n 1} node} {
global im1 im2 factor noteBook tab_label
set factor($node) [expr {$factor($node) * $n}]
$w delete img
catch {image delete $im2}
set im2 [image create photo]
if {$factor($node)>=1} {
set f [expr int($factor($node))]
$im2 copy $im1 -zoom $f $f
} else {
set f [expr round(1./$factor($node))]
$im2 copy $im1 -subsample $f $f
}
$w create image 1 1 -image $im2 -anchor nw -tag img
$noteBook itemconfigure $node -text "$tab_label (size x$factor($node))"
$w config -scrollregion [$w bbox all]
}

View File

@ -397,3 +397,4 @@ proc SetVarLang {lang} {

View File

@ -964,31 +964,7 @@ proc EditFile {node fileName} {
bind $text <Control-c> "tk_textCopy $w.text;break"
bind $text <Control-igrave> "tk_textPaste $w.text;break"
#bind $text <Control-v> "tk_textPaste $w.text;break"
bind $text <Control-v> {
set startPos [Position]
set nodeEdit [$noteBook raise]
EditFlag $nodeEdit [lindex $fileList($nodeEdit) 0] 1
set fileList($nodeEdit) [list [lindex $fileList($nodeEdit) 0] 1]
puts "fuck - $fileList($nodeEdit)"
tk_textPaste $w.text
set endPos [Position]
set lineBegin [lindex [split $startPos "."] 0]
set lineEnd [lindex [split $endPos "."] 0]
for {set line $lineBegin} {$line <= $lineEnd} {incr line} {
if {$nodeEdit == "" || $nodeEdit == "newproj" || $nodeEdit == "settings" || $nodeEdit == "about" || $nodeEdit == "debug"} {
} else {
set textEdit "$noteBook.f$nodeEdit.text"
set editLine [$textEdit get $line.0 $line.end]
if {$autoFormat == "Yes"} {
if {$fileExt != "for"} {
TabIns $textEdit
}
}
HighLight $fileExt $textEdit $editLine $line $nodeEdit
}
}
break
}
bind $text <Control-v> {TextOperation paste; break}
bind $text <Control-adiaeresis> "auto_completition $text"
bind $text <Control-l> "auto_completition $text"
@ -1155,14 +1131,45 @@ proc SelectAll {text} {
}
proc TextOperation {oper} {
global noteBook fileList autoFormat
set nb [$noteBook raise]
if {$nb == "" || $nb == "newproj" || $nb == "about" || $nb == "debug"} {
return
}
set nb "$noteBook.f$nb"
switch $oper {
"copy" {tk_textCopy $nb.text}
"paste" {
set startPos [Position]
set nodeEdit [$noteBook raise]
EditFlag $nodeEdit [lindex $fileList($nodeEdit) 0] 1
set fileList($nodeEdit) [list [lindex $fileList($nodeEdit) 0] 1]
set fileExt [string range [file extension [lindex $fileList($nodeEdit) 0]] 1 end]
tk_textPaste $noteBook.f$nodeEdit.text
set endPos [Position]
set lineBegin [lindex [split $startPos "."] 0]
set lineEnd [lindex [split $endPos "."] 0]
for {set line $lineBegin} {$line <= $lineEnd} {incr line} {
if {$nodeEdit == "" || $nodeEdit == "newproj" || $nodeEdit == "settings" || $nodeEdit == "about" || $nodeEdit == "debug"} {
} else {
set textEdit "$noteBook.f$nodeEdit.text"
set editLine [$textEdit get $line.0 $line.end]
if {$autoFormat == "Yes"} {
if {$fileExt != "for"} {
TabIns $textEdit
}
}
HighLight $fileExt $textEdit $editLine $line $nodeEdit
}
}
}
"cut" {tk_textCut $nb.text}
"redo" {$nb.text edit redo}
"undo" {$nb.text edit undo}
}
unset nb
}
####################################
GetOp

View File

@ -92,9 +92,9 @@ menubutton .frmMenu.mnuEdit -text [::msgcat::mc "Edit"] -menu .frmMenu.mnuEdit.m
proc GetMenu {m} {
global fontNormal fontBold imgDir editor
$m add command -label [::msgcat::mc "Undo"] -font $fontNormal -accelerator "Ctrl+Z"\
-state normal -command Undo
$m add command -label [::msgcat::mc "Redo"] -font $fontNormal -accelerator "Ctrl+Z"\
-state normal -command Redo
-state normal -command {TextOperation undo}
$m add command -label [::msgcat::mc "Redo"] -font $fontNormal -accelerator "Ctrl+G"\
-state normal -command {TextOperation redo}
$m add separator
$m add command -label [::msgcat::mc "Procedure name complit"] -font $fontNormal -accelerator "Ctrl+J" -state normal\
-command {
@ -104,23 +104,11 @@ proc GetMenu {m} {
}
$m add separator
$m add command -label [::msgcat::mc "Copy"] -font $fontNormal -accelerator "Ctrl+C"\
-command {
set nb "$noteBook.f[$noteBook raise]"
tk_textCopy $nb.text
unset nb
}
-command {TextOperation copy}
$m add command -label [::msgcat::mc "Paste"] -font $fontNormal -accelerator "Ctrl+V"\
-command {
set nb "$noteBook.f[$noteBook raise]"
tk_textPaste $nb.text
unset nb
}
-command {TextOperation paste}
$m add command -label [::msgcat::mc "Cut"] -font $fontNormal -accelerator "Ctrl+X"\
-command {
set nb "$noteBook.f[$noteBook raise]"
tk_textCut $nb.text
unset nb
}
-command {TextOperation cut}
$m add separator
$m add command -label [::msgcat::mc "Select all"] -font $fontNormal -accelerator "Ctrl+/"\
-command {
@ -382,3 +370,4 @@ set activeProject ""
focus -force $tree

View File

@ -1060,22 +1060,3 @@ proc GetExtention {node} {
return $ext
}
proc TextOperation {oper} {
global noteBook
set nb [$noteBook raise]
if {$nb == "" || $nb == "newproj" || $nb == "about" || $nb == "debug"} {
return
}
set nb "$noteBook.f$nb"
switch $oper {
"copy" {tk_textCopy $nb.text}
"paste" {tk_textPaste $nb.text}
"cut" {tk_textCut $nb.text}
"redo" {$nb.text edit redo}
"undo" {$nb.text edit undo}
}
unset nb
}

View File

@ -1,9 +1,9 @@
#########################################################
# Tcl/Tk project Manager
# Distributed under GNU Public License
# Author: Sergey Kalinin banzaj28@yandex.ru
# Copyright (c) "Sergey Kalinin", 2002, http://nuk-svk.ru
#########################################################
###########################################################
# Tcl/Tk project Manager #
# Distributed under GNU Public License #
# Author: Sergey Kalinin banzaj28@yandex.ru #
# Copyright (c) "Sergey Kalinin", 2002, http://nuk-svk.ru #
###########################################################
proc NewProjDialog {type} {
global fontNormal tree projDir workDir activeProject fileList noteBook imgDir prjDir prjName
@ -906,3 +906,5 @@ proc InsertTitle {newFile type} {

388
main.tcl
View File

@ -1,388 +0,0 @@
###########################################################
# Tcl/Tk Project Manager #
# Distrubuted under GPL #
# Copyright (c) "Sergey Kalinin", 2002, http://nuk-svk.ru #
# Author: Sergey Kalinin banzaj28@yandex.ru #
###########################################################
Modules
## MAIN INTERFACE ##
wm geometry . 1024x768+0+0
wm title . "Tcl/Tk Project Manager $ver"
wm iconname . "Tcl/Tk Project Manager $ver"
wm protocol . WM_DELETE_WINDOW Quit
wm overrideredirect . 0
wm positionfrom . user
#wm resizable . 0 0
frame .frmMenu -border 1 -relief raised -background $editor(bg)
frame .frmTool -border 1 -relief raised -background $editor(bg)
frame .frmBody -border 1 -relief raised -background $editor(bg)
frame .frmStatus -border 1 -relief sunken -bg $editor(bg)
pack .frmMenu -side top -padx 1 -fill x
pack .frmTool -side top -padx 1 -fill x
pack .frmBody -side top -padx 1 -fill both -expand true
pack .frmStatus -side top -padx 1 -fill x
########## CREATE MENU LINE ##########
menubutton .frmMenu.mnuFile -text [::msgcat::mc "File"] -menu .frmMenu.mnuFile.m -font $fontNormal -bg $editor(bg) -fg $editor(fg)
set m [menu .frmMenu.mnuFile.m -bg $editor(bg) -fg $editor(fg)]
$m add cascade -label [::msgcat::mc "New"] -menu $m.new -font $fontNormal
set mn [menu $m.new -bg $editor(bg) -fg $editor(fg)]
$mn add command -label [::msgcat::mc "New file"] -command {AddToProjDialog file}\
-font $fontNormal -accelerator "Ctrl+N"
$mn add command -label [::msgcat::mc "New directory"] -command {AddToProjDialog directory}\
-font $fontNormal -accelerator "Ctrl+N"
$mn add command -label [::msgcat::mc "New project"] -command {NewProjDialog "new"}\
-font $fontNormal
$m add command -label [::msgcat::mc "Open"] -command {FileDialog open}\
-font $fontNormal -accelerator "Ctrl+O" -state disable
$m add command -label [::msgcat::mc "Save"] -command {FileDialog save}\
-font $fontNormal -accelerator "Ctrl+S"
$m add command -label [::msgcat::mc "Save as"] -command {FileDialog save_as}\
-font $fontNormal -accelerator "Ctrl+A"
$m add command -label [::msgcat::mc "Save all"] -command {FileDialog save_all}\
-font $fontNormal
$m add command -label [::msgcat::mc "Close"] -command {FileDialog close}\
-font $fontNormal -accelerator "Ctrl+W"
$m add command -label [::msgcat::mc "Close all"] -command {FileDialog close_all}\
-font $fontNormal
$m add command -label [::msgcat::mc "Delete"] -command {FileDialog delete}\
-font $fontNormal -accelerator "Ctrl+D"
$m add separator
$m add command -label [::msgcat::mc "Compile file"] -command {MakeProj compile file} -font $fontNormal -accelerator "Ctrl+F8"
$m add command -label [::msgcat::mc "Run file"] -command {MakeProj run file} -font $fontNormal -accelerator "Ctrl+F9"
$m add separator
$m add command -label [::msgcat::mc "Print"] -command PrintDialog\
-font $fontNormal -accelerator "Ctrl+P"
$m add separator
$m add command -label [::msgcat::mc "Settings"] -command Settings -font $fontNormal
$m add separator
$m add command -label [::msgcat::mc "Exit"] -command Quit -font $fontNormal -accelerator "Ctrl+Q"
##.frmMenu 'Project' ##
proc GetProjMenu {m} {
global fontNormal
$m add command -label [::msgcat::mc "Project settings"] -command {NewProj edit $activeProject ""}\
-font $fontNormal
$m add separator
$m add command -label [::msgcat::mc "Open project"] -command {OpenProj} -font $fontNormal
$m add command -label [::msgcat::mc "New project"] -command {NewProjDialog new} -font $fontNormal
$m add command -label [::msgcat::mc "Delete project"] -command DelProj -font $fontNormal
$m add separator
$m add command -label [::msgcat::mc "Add to project"] -command AddToProjDialog -font $fontNormal
$m add command -label [::msgcat::mc "Delete from project"]\
-command {FileDialog delete} -font $fontNormal
$m add separator
$m add command -label [::msgcat::mc "Make archive"] -command MakeTGZ -font $fontNormal -accelerator "F7"
$m add command -label [::msgcat::mc "Make RPM"] -command MakeRPM -font $fontNormal -accelerator "F6"
$m add separator
$m add command -label [::msgcat::mc "Compile"] -command {MakeProj compile proj} -font $fontNormal -accelerator "F8"
$m add command -label [::msgcat::mc "Run"] -command {MakeProj run proj} -font $fontNormal -accelerator "F9"
}
menubutton .frmMenu.mnuProj -text [::msgcat::mc "Project"] -menu .frmMenu.mnuProj.m -font $fontNormal -bg $editor(bg) -fg $editor(fg)
set m [menu .frmMenu.mnuProj.m -bg $editor(bg) -fg $editor(fg)]
GetProjMenu $m
##.frmMenu 'Edit' ##
menubutton .frmMenu.mnuEdit -text [::msgcat::mc "Edit"] -menu .frmMenu.mnuEdit.m -font $fontNormal -bg $editor(bg) -fg $editor(fg)
## BUILDING EDIT-MENU FOR MAIN AND POP-UP MENU ##
proc GetMenu {m} {
global fontNormal fontBold imgDir editor
$m add command -label [::msgcat::mc "Undo"] -font $fontNormal -accelerator "Ctrl+Z"\
-state normal -command Undo
$m add command -label [::msgcat::mc "Redo"] -font $fontNormal -accelerator "Ctrl+Z"\
-state normal -command Redo
$m add separator
$m add command -label [::msgcat::mc "Procedure name complit"] -font $fontNormal -accelerator "Ctrl+J" -state normal\
-command {
set nb "$noteBook.f[$noteBook raise]"
auto_completition_proc $nb.text
unset nb
}
$m add separator
$m add command -label [::msgcat::mc "Copy"] -font $fontNormal -accelerator "Ctrl+C"\
-command {
set nb "$noteBook.f[$noteBook raise]"
tk_textCopy $nb.text
unset nb
}
$m add command -label [::msgcat::mc "Paste"] -font $fontNormal -accelerator "Ctrl+V"\
-command {
set nb "$noteBook.f[$noteBook raise]"
tk_textPaste $nb.text
unset nb
}
$m add command -label [::msgcat::mc "Cut"] -font $fontNormal -accelerator "Ctrl+X"\
-command {
set nb "$noteBook.f[$noteBook raise]"
tk_textCut $nb.text
unset nb
}
$m add separator
$m add command -label [::msgcat::mc "Select all"] -font $fontNormal -accelerator "Ctrl+/"\
-command {
set nb [$noteBook raise]
if {$nb == "" || $nb == "newproj" || $nb == "about" || $nb == "debug"} {
return
}
set nb "$noteBook.f$nb"
SelectAll $nb.text
unset nb
}
$m add separator
$m add command -label [::msgcat::mc "Goto line"] -command GoToLine -font $fontNormal\
-accelerator "Ctrl+G"
$m add command -label [::msgcat::mc "Find"] -command Find -font $fontNormal -accelerator "Ctrl+F"
$m add command -label [::msgcat::mc "Replace"] -command ReplaceDialog -font $fontNormal\
-accelerator "Ctrl+R"
$m add cascade -label [::msgcat::mc "Encode"] -menu $m.encode -font $fontNormal
set me [menu $m.encode -bg $editor(bg) -fg $editor(fg)]
$me add command -label [::msgcat::mc "KOI8-R"] -command {TextEncode koi8-r} -font $fontNormal
$me add command -label [::msgcat::mc "CP1251"] -command {TextEncode cp1251} -font $fontNormal
$me add command -label [::msgcat::mc "CP866"] -command {TextEncode cp866} -font $fontNormal
}
GetMenu [menu .frmMenu.mnuEdit.m -bg $editor(bg) -fg $editor(fg)];# main edit menu
GetMenu [menu .popMnuEdit -bg $editor(bg) -fg $editor(fg)] ;# pop-up edit menu
## VIEW MENU ##
menubutton .frmMenu.mnuView -text [::msgcat::mc "View"] -menu .frmMenu.mnuView.m -font $fontNormal -bg $editor(bg) -fg $editor(fg)
set m [menu .frmMenu.mnuView.m -bg $editor(bg) -fg $editor(fg)]
$m add checkbutton -label [::msgcat::mc "Toolbar"] -font $fontNormal -state normal\
-offvalue "No" -onvalue "Yes" -variable toolBar -command {ToolBar}
$m add command -label [::msgcat::mc "Split edit window"] -font $fontNormal -accelerator "F4" -state disable\
-command SplitWindow
$m add separator
$m add command -label [::msgcat::mc "Refresh"] -font $fontNormal -accelerator "F5" -state normal\
-command UpdateTree
##.frmMenu Settings ##
menubutton .frmMenu.mnuCVS -text [::msgcat::mc "Modules"] -menu .frmMenu.mnuCVS.m \
-font $fontNormal -state normal -bg $editor(bg) -fg $editor(fg)
set m [menu .frmMenu.mnuCVS.m -bg $editor(bg) -fg $editor(fg)]
if {$module(tkcvs) != ""} {
$m add command -label "TkCVS" -command {DoModule tkcvs} -font $fontNormal
}
if {$module(tkdiff) != ""} {
$m add command -label "TkDIFF+" -command {DoModule tkdiff} -font $fontNormal
}
if {$module(tkregexp) != ""} {
$m add command -label "TkREGEXP" -command {DoModule tkregexp} -font $fontNormal
}
if {$module(gitk) != ""} {
$m add command -label "Gitk" -font $fontNormal -command {
DoModule gitk
GetTagList [file join $workDir $activeProject.tags] ;# geting tag list
}
}
menubutton .frmMenu.mnuHelp -text [::msgcat::mc "Help"] -menu .frmMenu.mnuHelp.m \
-underline 0 -font $fontNormal -bg $editor(bg) -fg $editor(fg)
set m [menu .frmMenu.mnuHelp.m -bg $editor(bg) -fg $editor(fg)]
$m add command -label [::msgcat::mc "Help"] -command ShowHelp \
-accelerator F1 -font $fontNormal
$m add command -label [::msgcat::mc "About ..."] -command AboutDialog \
-font $fontNormal
pack .frmMenu.mnuFile .frmMenu.mnuProj .frmMenu.mnuEdit .frmMenu.mnuView .frmMenu.mnuCVS -side left
pack .frmMenu.mnuHelp -side right
## Bind command ##
bind . <F1> ShowHelp
bind . <F5> UpdateTree
bind . <F6> MakeRPM
bind . <F7> MakeTGZ
bind . <F8> {MakeProj compile proj}
bind . <Control-F8> {MakeProj compile file}
bind . <F9> {MakeProj run proj}
bind . <Control-F9> {MakeProj run file}
bind . <Control-ograve> AddToProjDialog
bind . <Control-n> AddToProjDialog
bind . <Control-ocircumflex> AddToProjDialog
bind . <Control-a> AddToProjDialog
bind . <Control-eacute> Quit
bind . <Control-q> Quit
bind . <Control-ccedilla> PrintDialog
bind . <Control-p> PrintDialog
## TOOLBAR ##
proc add_toolbar_button {path icon command helptext} {
global editor imgDir
image create photo $icon -format png -file [file join $imgDir $icon]
$path add -image $icon \
-highlightthickness 0 -takefocus 0 -relief link -bd 1 -activebackground $editor(bg)\
-padx 1 -pady 1 -command $command -helptext $helptext
}
# Separator for toolbar
set sepIndex 0
proc Separator {} {
global sepIndex editor
set f [frame .frmTool.separator$sepIndex -width 10 -border 1 -background $editor(bg) -relief raised]
incr sepIndex 1
return $f
}
proc CreateToolBar {} {
global toolBar fontBold noteBook tree imgDir editor
if {$toolBar == "Yes"} {
set bboxFile [ButtonBox .frmTool.bboxFile -spacing 0 -padx 1 -pady 1 -bg $editor(bg)]
add_toolbar_button $bboxFile new.png {AddToProjDialog file} [::msgcat::mc "Create new file"]
add_toolbar_button $bboxFile save.png {FileDialog save} [::msgcat::mc "Save file"]
add_toolbar_button $bboxFile save_as.png {FileDialog save_as} [::msgcat::mc "Save file as"]
add_toolbar_button $bboxFile save_all.png {FileDialog save_all} [::msgcat::mc "Save all"]
add_toolbar_button $bboxFile printer.png {PrintDialog} [::msgcat::mc "Print ..."]
add_toolbar_button $bboxFile close.png {FileDialog close} [::msgcat::mc "Close"]
set bboxEdit [ButtonBox .frmTool.bboxEdit -spacing 0 -padx 1 -pady 1 -bg $editor(bg)]
add_toolbar_button $bboxEdit copy.png {TextOperation copy} [::msgcat::mc "Copy into clipboard"]
add_toolbar_button $bboxEdit cut.png {TextOperation cut} [::msgcat::mc "Cut into clipboard"]
add_toolbar_button $bboxEdit paste.png {TextOperation paste} [::msgcat::mc "Paste from clipboard"]
add_toolbar_button $bboxEdit undo.png {TextOperation undo} [::msgcat::mc "Undo"]
add_toolbar_button $bboxEdit redo.png {TextOperation redo} [::msgcat::mc "Redo"]
set bboxProj [ButtonBox .frmTool.bboxProj -spacing 0 -padx 1 -pady 1 -bg $editor(bg)]
add_toolbar_button $bboxProj doit.png {MakeProj run proj} [::msgcat::mc "Running project"]
add_toolbar_button $bboxProj doit_file.png {MakeProj run file} [::msgcat::mc "Running file"]
add_toolbar_button $bboxProj archive.png {MakeTGZ} [::msgcat::mc "Make TGZ"]
set bboxHelp [ButtonBox .frmTool.bboxHelp -spacing 0 -padx 1 -pady 1 -bg $editor(bg)]
add_toolbar_button $bboxHelp help.png {ShowHelp} [::msgcat::mc "Help"]
pack $bboxFile [Separator] $bboxEdit [Separator] $bboxProj [Separator] $bboxHelp -side left -anchor w
}
}
########## STATUS BAR ##########
set frm1 [frame .frmStatus.frmHelp -bg $editor(bg)]
set frm2 [frame .frmStatus.frmActive -bg $editor(bg)]
set frm3 [frame .frmStatus.frmProgress -relief sunken -bg $editor(bg)]
set frm4 [frame .frmStatus.frmLine -bg $editor(bg)]
set frm5 [frame .frmStatus.frmFile -bg $editor(bg)]
set frm6 [frame .frmStatus.frmOvwrt -bg $editor(bg)]
pack $frm1 $frm4 $frm6 $frm2 $frm5 -side left -fill x
pack $frm3 -side left -fill x -expand true
label $frm1.lblHelp -width 25 -relief sunken -font $fontNormal -anchor w -bg $editor(bg) -fg $editor(fg)
pack $frm1.lblHelp -fill x
label $frm4.lblLine -width 10 -relief sunken -font $fontNormal -anchor w -bg $editor(bg) -fg $editor(fg)
pack $frm4.lblLine -fill x
label $frm2.lblActive -width 25 -relief sunken -font $fontNormal -anchor center -bg $editor(bg) -fg $editor(fg)
pack $frm2.lblActive -fill x
label $frm3.lblProgress -relief sunken -font $fontNormal -anchor w -bg $editor(bg) -fg $editor(fg)
pack $frm3.lblProgress -fill x
label $frm5.lblFile -width 10 -relief sunken -font $fontNormal -anchor w -bg $editor(bg) -fg $editor(fg)
pack $frm5.lblFile -fill x
label $frm6.lblOvwrt -width 10 -relief sunken -font $fontNormal -anchor center -bg $editor(bg) -fg $editor(fg)
pack $frm6.lblOvwrt -fill x
########## PROJECT-FILE-FUNCTION TREE ##################
set frmCat [frame .frmBody.frmCat -border 1 -relief sunken -bg $editor(bg)]
pack $frmCat -side left -fill y -fill both
set frmWork [frame .frmBody.frmWork -border 1 -relief sunken -bg $editor(bg)]
pack $frmWork -side left -fill both -expand true
## CREATE PANE ##
pane::create .frmBody.frmCat .frmBody.frmWork
set frmTree [ScrolledWindow $frmCat.frmTree -bg $editor(bg)]
global tree noteBook
set tree [Tree $frmTree.tree \
-relief sunken -borderwidth 1 -width 5 -height 5 -highlightthickness 1\
-redraw 0 -dropenabled 1 -dragenabled 1 -dragevent 3 \
-background $editor(bg) -selectbackground $editor(selectbg) -selectforeground white\
-droptypes {
TREE_NODE {copy {} move {} link {}}
LISTBOX_ITEM {copy {} move {} link {}}
} -opencmd {TreeOpen} -closecmd {TreeClose}]
$frmTree setwidget $tree
pack $frmTree -side top -fill both -expand true
$tree bindText <Double-ButtonPress-1> "TreeDoubleClick [$tree selection get]"
$tree bindText <ButtonPress-1> "TreeOneClick [$tree selection get]"
$tree bindImage <Double-ButtonPress-1> "TreeDoubleClick [$tree selection get]"
$tree bindImage <ButtonPress-1> "TreeOneClick [$tree selection get]"
$tree bindText <Shift-Button-1> {$tree selection add [$tree selection get]}
bind $frmTree.tree.c <Control-acircumflex> {FileDialog delete}
bind $frmTree.tree.c <Control-d> {FileDialog delete}
bind $frmTree.tree.c <Return> {
set node [$tree selection get]
TreeOneClick $node
TreeDoubleClick $node
}
## POPUP FILE-MENU ##
set m .popupFile
menu $m -font $fontNormal -bg $editor(bg) -fg $editor(fg)
$m add command -label [::msgcat::mc "New file"] -command {AddToProjDialog file}\
-font $fontNormal -accelerator "Ctrl+N"
$m add command -label [::msgcat::mc "New directory"] -command {AddToProjDialog directory}\
-font $fontNormal -accelerator "Alt + Ctrl+N"
$m add command -label [::msgcat::mc "Open"] -command {FileDialog open}\
-font $fontNormal -accelerator "Ctrl+O" -state disable
$m add command -label [::msgcat::mc "Save"] -command {FileDialog save}\
-font $fontNormal -accelerator "Ctrl+S"
$m add command -label [::msgcat::mc "Save as"] -command {FileDialog save_as}\
-font $fontNormal -accelerator "Ctrl+A"
$m add command -label [::msgcat::mc "Save all"] -command {FileDialog save_all}\
-font $fontNormal
$m add command -label [::msgcat::mc "Close"] -command {FileDialog close}\
-font $fontNormal -accelerator "Ctrl+W"
$m add command -label [::msgcat::mc "Close all"] -command {FileDialog close_all}\
-font $fontNormal
$m add command -label [::msgcat::mc "Delete"] -command {FileDialog delete}\
-font $fontNormal -accelerator "Ctrl+D"
$m add separator
$m add command -label [::msgcat::mc "Compile file"] -command {MakeProj compile file} -font $fontNormal -accelerator "Ctrl+F8"
$m add command -label [::msgcat::mc "Run file"] -command {MakeProj run file} -font $fontNormal -accelerator "Ctrl+F9"
## POPUP PROJECT-MENU ##
set m [menu .popupProj -font $fontNormal -bg $editor(bg) -fg $editor(fg)]
GetProjMenu $m
## TABS popups ##
set m .popupTabs
menu $m -font $fontNormal -bg $editor(bg) -fg $editor(fg)
$m add command -label [::msgcat::mc "Close"] -command {FileDialog close}\
-font $fontNormal -accelerator "Ctrl+W"
$m add command -label [::msgcat::mc "Close all"] -command {FileDialog close_all}\
-font $fontNormal
proc PopupMenuTab {menu x y} {
tk_popup $menu $x $y
}
bind $frmTree.tree.c <Button-3> {catch [PopupMenuTree %X %Y]}
######### DEDERER: bind Wheel Scroll ##################
#$tree bindText <Button-4> "$tree yview scroll -3 units ; break ;# "
#$tree bindText <Button-5> "$tree yview scroll 3 units ; break ;# "
bind $frmTree.tree.c <Button-4> "$tree yview scroll -3 units"
bind $frmTree.tree.c <Button-5> "$tree yview scroll 3 units"
bind $frmTree.tree.c <Shift-Button-4> "$tree xview scroll -2 units"
bind $frmTree.tree.c <Shift-Button-5> "$tree xview scroll 2 units"
#################### WORKING AREA ####################
set noteBook [NoteBook $frmWork.noteBook -font $fontNormal -side top -bg $editor(bg) -fg $editor(fg)]
pack $noteBook -fill both -expand true -padx 2 -pady 2
#$noteBook bindtabs <ButtonRelease-1> "PageRaise [$tree selection get]"
$noteBook bindtabs <Button-3> {catch [PopupMenuTab .popupTabs %X %Y]}
#bind . <Control-udiaeresis> PageTab
#bind . <Control-M> PageTab
bind . <Control-Next> {PageTab 1}
bind . <Control-Prior> {PageTab -1}
##################################################
CreateToolBar
GetProj $tree
$tree configure -redraw 1
set activeProject ""
focus -force $tree

100
pane.tcl
View File

@ -1,100 +0,0 @@
package provide pane 1.0
namespace eval pane {
namespace export create
proc create { f1 f2 args } {
global editor
set t(-orient) vertical
set t(-percent) 0.25
set t(-gripcolor) $editor(bg)
set t(-gripposition) 0.95
set t(-gripcursor) crosshair
set t(-in) [winfo parent $f1]
array set t $args
set master $t(-in)
upvar #0 [namespace current]::Pane$master pane
array set pane [array get t]
if {! [string match v* $pane(-orient)] } {
set pane(-gripcursor) sb_v_double_arrow
set height 5 ; set width 3000
} else {
set pane(-gripcursor) sb_h_double_arrow
set height 3000 ; set width 5
}
set pane(1) $f1
set pane(2) $f2
set pane(grip) [frame $master.grip -background $pane(-gripcolor) \
-width $width -height $height \
-bd 1 -relief raised -cursor $pane(-gripcursor)]
if {! [string match v* $pane(-orient)] } {
set pane(D) Y
place $pane(1) -in $master -x 0 -rely 0.0 -anchor nw -relwidth 1.0 -height -1
place $pane(2) -in $master -x 0 -rely 1.0 -anchor sw -relwidth 1.0 -height -1
place $pane(grip) -in $master -anchor c -relx $pane(-gripposition)
} else {
set pane(D) X
place $pane(1) -in $master -relx 0.0 -y 0 -anchor nw -relheight 1.0 -width -1
place $pane(2) -in $master -relx 1.0 -y 0 -anchor ne -relheight 1.0 -width -1
place $pane(grip) -in $master -anchor c -rely 0 ;#$pane(-gripposition)
}
$master configure -background gray50
bind $master <Configure> [list [namespace current]::PaneGeometry $master]
bind $pane(grip) <ButtonPress-1> \
[list [namespace current]::PaneDrag $master %$pane(D)]
bind $pane(grip) <B1-Motion> \
[list [namespace current]::PaneDrag $master %$pane(D)]
bind $pane(grip) <ButtonRelease-1> \
[list [namespace current]::PaneStop $master]
[namespace current]::PaneGeometry $master
}
proc PaneDrag { master D } {
upvar #0 [namespace current]::Pane$master pane
if {[info exists pane(lastD)]} {
set delta [expr double($pane(lastD) - $D) \
/ $pane(size)]
set pane(-percent) [expr $pane(-percent) - $delta]
if {$pane(-percent) < 0.0} {
set pane(-percent) 0.0
} elseif {$pane(-percent) > 1.0} {
set pane(-percent) 1.0
}
[namespace current]::PaneGeometry $master
}
set pane(lastD) $D
}
proc PaneStop { master } {
upvar #0 [namespace current]::Pane$master pane
catch {unset pane(lastD)}
}
proc PaneGeometry { master } {
upvar #0 [namespace current]::Pane$master pane
if {$pane(D) == "X"} {
place $pane(1) -relwidth $pane(-percent)
place $pane(2) -relwidth [expr 1.0 - $pane(-percent)]
place $pane(grip) -relx $pane(-percent)
set pane(size) [winfo width $master]
} else {
place $pane(1) -relheight $pane(-percent)
place $pane(2) -relheight [expr 1.0 - $pane(-percent)]
place $pane(grip) -rely $pane(-percent)
set pane(size) [winfo height $master]
}
}
}

File diff suppressed because it is too large Load Diff

View File

@ -1,908 +0,0 @@
#########################################################
# Tcl/Tk project Manager
# Distributed under GNU Public License
# Author: Sergey Kalinin banzaj28@yandex.ru
# Copyright (c) "Sergey Kalinin", 2002, http://nuk-svk.ru
#########################################################
proc NewProjDialog {type} {
global fontNormal tree projDir workDir activeProject fileList noteBook imgDir prjDir prjName
global openProjDir tclDir
set w .newProj
# destroy the find window if it already exists
if {[winfo exists $w]} {
destroy $w
}
set typeProjects "Tcl Java Perl Fortran O'Caml PHP Ruby Erlang"
toplevel $w
wm title $w [::msgcat::mc "New project"]
wm resizable $w 0 0
wm transient $w .
frame $w.frmCombo -borderwidth 1
frame $w.frmBtn -borderwidth 1
pack $w.frmCombo $w.frmBtn -side top -fill x
# set combo [entry $w.frmCombo.entFind]
set combo [ComboBox $w.frmCombo.txtLocale\
-textvariable lang -editable false\
-selectbackground "#55c4d1" -selectborderwidth 0\
-values $typeProjects]
pack $combo -fill x -padx 2 -pady 2
if {$type=="new"} {
button $w.frmBtn.btnFind -text "[::msgcat::mc "Create"]"\
-font $fontNormal -width 12 -relief groove\
-command {
NewProj add "" $lang
destroy .newProj
}
} elseif {$type=="open"} {
button $w.frmBtn.btnFind -text "[::msgcat::mc "Open"]"\
-font $fontNormal -width 12 -relief groove\
-command {
NewProj open "$prjName" $lang
destroy .newProj
}
}
button $w.frmBtn.btnCancel -text "[::msgcat::mc "Close"] - Esc"\
-relief groove -width 12 -font $fontNormal\
-command "destroy $w"
pack $w.frmBtn.btnFind $w.frmBtn.btnCancel -fill x -padx 2 -pady 2 -side left
if {$type=="open"} {
bind $w <Return> {NewProj open $prjName $lang; destroy .newProj}
} elseif {$type=="new"} {
bind $w <Return> {NewProj add "" $lang; destroy .newProj}
}
bind $w <Escape> "destroy $w"
focus -force $combo
# set findIndex [lsearch -exact $findHistory "$findString"]
$combo setvalue @0
}
proc NewProj {type proj l} {
global fontNormal tree projDir workDir activeProject fileList noteBook imgDir prjDir
global openProjDir tclDir frm lang operType
set operType $type
if {$operType == "edit" && $proj == ""} {
set answer [tk_messageBox\
-message "[::msgcat::mc "Not found active project"]"\
-type ok -icon warning -title [::msgcat::mc "Warning"]]
case $answer {
ok {return 0}
}
}
set lang $l
set node [$noteBook page [$noteBook index newproj]]
if {$node != ""} {
$noteBook raise newproj
return 0
} else {
set w [$noteBook insert end newproj -text [::msgcat::mc "New project"]]
}
set frm [frame $w.frmProjSettings]
pack $frm -fill both -expand true
image create photo imgFold -format gif -file [file join $imgDir folder.gif]
set frm_1 [frame $frm.frmProjName]
label $frm_1.lblProjName -text [::msgcat::mc "Project name"] -width 20 -anchor w
entry $frm_1.txtProjName -textvariable txtProjName
pack $frm_1.lblProjName -side left
pack $frm_1.txtProjName -side left -fill x -expand true
set frm_2 [frame $frm.frmFileName]
label $frm_2.lblFileName -text [::msgcat::mc "Project file"] -width 20 -anchor w
entry $frm_2.txtFileName -textvariable txtFileName
pack $frm_2.lblFileName -side left
pack $frm_2.txtFileName -side left -fill x -expand true
set frm_8 [frame $frm.frmDirName]
label $frm_8.lblDirName -text [::msgcat::mc "Project dir"] -width 20 -anchor w
entry $frm_8.txtDirName -textvariable txtDirName -state disable
button $frm_8.btnDirName -borderwidth {1} -image imgFold\
-command {
$frm.frmDirName.txtDirName configure -state normal
InsertEnt $frm.frmDirName.txtDirName [tk_chooseDirectory -initialdir $projDir -title "[::msgcat::mc "Select directory"]" -parent .]
$frm.frmDirName.txtDirName configure -state disable
}
pack $frm_8.lblDirName -side left
pack $frm_8.txtDirName -side left -fill x -expand true
pack $frm_8.btnDirName -side left
set frm_13 [frame $frm.frmCompiler]
label $frm_13.lblCompiler -text [::msgcat::mc "Compiler"]\
-width 20 -anchor w
entry $frm_13.txtCompiler -textvariable txtCompiler
button $frm_13.btnCompiler -borderwidth {1} -image imgFold\
-command {
InsertEnt $frm.frmCompiler.txtCompiler [tk_getOpenFile -initialdir $tclDir -parent .]
}
pack $frm_13.lblCompiler -side left
pack $frm_13.txtCompiler -side left -fill x -expand true
pack $frm_13.btnCompiler -side left
set frm_12 [frame $frm.frmProjInterp]
label $frm_12.lblProjInterp -text [::msgcat::mc "Interpetator"]\
-width 20 -anchor w
entry $frm_12.txtProjInterp -textvariable txtProjInterp
button $frm_12.btnInterp -borderwidth {1} -image imgFold\
-command {
InsertEnt $frm.frmProjInterp.txtProjInterp [tk_getOpenFile -initialdir $tclDir -parent .]
}
pack $frm_12.lblProjInterp -side left
pack $frm_12.txtProjInterp -side left -fill x -expand true
pack $frm_12.btnInterp -side left
set frm_4 [frame $frm.frmVersion]
label $frm_4.lblProjVersion -text [::msgcat::mc "Version"] -width 20 -anchor w
entry $frm_4.txtProjVersion -textvariable txtProjVersion
pack $frm_4.lblProjVersion -side left
pack $frm_4.txtProjVersion -side left -fill x -expand true
InsertEnt $frm_4.txtProjVersion "0.0.1"
set frm_11 [frame $frm.frmRelease]
label $frm_11.lblProjRelease -text [::msgcat::mc "Release"] -width 20 -anchor w
entry $frm_11.txtProjRelease -textvariable txtProjRelease
pack $frm_11.lblProjRelease -side left
pack $frm_11.txtProjRelease -side left -fill x -expand true
InsertEnt $frm_11.txtProjRelease "1"
set frm_3 [frame $frm.frmProjAuthor]
label $frm_3.lblProjAuthor -text [::msgcat::mc "Author"] -width 20 -anchor w
entry $frm_3.txtProjAuthor -textvariable txtProjAuthor
pack $frm_3.lblProjAuthor -side left
pack $frm_3.txtProjAuthor -side left -fill x -expand true
set frm_9 [frame $frm.frmProjEmail]
label $frm_9.lblProjEmail -text [::msgcat::mc "E-mail"] -width 20 -anchor w
entry $frm_9.txtProjEmail -textvariable txtProjEmail
pack $frm_9.lblProjEmail -side left
pack $frm_9.txtProjEmail -side left -fill x -expand true
set frm_5 [frame $frm.frmProjCompany]
label $frm_5.lblProjCompany -text [::msgcat::mc "Company"] -width 20 -anchor w
entry $frm_5.txtProjCompany -textvariable txtProjCompany
pack $frm_5.lblProjCompany -side left
pack $frm_5.txtProjCompany -side left -fill x -expand true
set frm_10 [frame $frm.frmProjHome]
label $frm_10.lblProjHome -text [::msgcat::mc "Home page"] -width 20 -anchor w
entry $frm_10.txtProjHome -textvariable txtProjHome
pack $frm_10.lblProjHome -side left
pack $frm_10.txtProjHome -side left -fill x -expand true
set frm_7 [frame $frm.frmWinTitle -border 2 -relief ridge -background grey]
label $frm_7.lblWinTitle -text "[::msgcat::mc "Create new project"] $lang" -foreground yellow \
-background black
pack $frm_7.lblWinTitle -fill x -expand true
set frm_6 [frame $frm.frmBtn -border 2 -relief ridge]
if {$operType == "edit" && $proj != ""} {
$noteBook itemconfigure newproj -text [::msgcat::mc "Project settings"]
button $frm_6.btnProjCreate -text [::msgcat::mc "Save"] -relief groove\
-font $fontNormal -command {
regsub -all {\\} $txtProjInterp {\\\\} $txtProjInterp
SaveProj "$txtFileName" "$txtProjName" "$txtFileName" "$txtDirName"\
"$txtCompiler" "$txtProjInterp" "$txtProjVersion" "$txtProjRelease"\
"$txtProjAuthor" "$txtProjEmail" "$txtProjCompany" "$txtProjHome"
$noteBook delete newproj
$noteBook raise [$noteBook page end]
}
} else {
button $frm_6.btnProjCreate -text [::msgcat::mc "Create"] -relief groove\
-font $fontNormal -command {
CreateProj $operType $lang "$txtFileName" "$txtProjName" "$txtFileName" "$txtDirName"\
"$txtCompiler" "$txtProjInterp" "$txtProjVersion" "$txtProjRelease"\
"$txtProjAuthor" "$txtProjEmail" "$txtProjCompany" "$txtProjHome"
$noteBook delete newproj
$noteBook raise [$noteBook page end]
}
}
button $frm_6.btnClose -text [::msgcat::mc "Cancel"] -relief groove -font $fontNormal -command {
$noteBook delete newproj
$noteBook raise [$noteBook page end]
}
pack $frm_6.btnProjCreate $frm_6.btnClose -padx 10 -pady 2 -side left -fill x -expand true
pack $frm_7 $frm_1 $frm_2 $frm_8 $frm_13 $frm_12 $frm_4 $frm_11 $frm_3 $frm_9 $frm_5 $frm_10 $frm_6\
-side top -fill x
pack $frm_6 -side top -fill x -expand true -anchor s
bind $w <Escape> "$noteBook delete newproj"
$noteBook raise newproj
## EDIT PROJECT SETTINGS ##
if {$operType == "edit" && $proj != ""} {
$frm.frmDirName.txtDirName configure -state normal
$frm_7.lblWinTitle configure -text [::msgcat::mc "Project settings"]
$frm_6.btnProjCreate configure -text "[::msgcat::mc "Save"]"
set file [open [file join $workDir $proj.proj] r]
while {[gets $file line]>=0} {
scan $line "%s" keyWord
set string [string range $line [string first "\"" $line] [string last "\"" $line]]
set string [string trim $string "\""]
# regsub -all " " $string "_" project
puts $string
switch $keyWord {
ProjectName {InsertEnt $frm_1.txtProjName "$string"}
ProjectFileName {InsertEnt $frm_2.txtFileName "$string"}
ProjectDirName {InsertEnt $frm_8.txtDirName "$string"}
ProjectCompiler {InsertEnt $frm_13.txtCompiler "$string"}
ProjectInterp {InsertEnt $frm_12.txtProjInterp "$string"}
ProjectVersion {InsertEnt $frm_4.txtProjVersion "$string"}
ProjectRelease {InsertEnt $frm_11.txtProjRelease "$string"}
ProjectAuthor {InsertEnt $frm_3.txtProjAuthor "$string"}
ProjectEmail {InsertEnt $frm_9.txtProjEmail "$string"}
ProjectCompany {InsertEnt $frm_5.txtProjCompany "$string"}
ProjectHome {InsertEnt $frm_10.txtProjHome "$string"}
}
}
close $file
} elseif {$operType == "open"} {
$frm_7.lblWinTitle configure -text "[::msgcat::mc "Open project"] $lang"
InsertEnt $frm_1.txtProjName "$proj"
InsertEnt $frm_2.txtFileName "$proj"
InsertEnt $frm_8.txtDirName "$proj"
$frm_8.txtDirName configure -state normal
puts $prjDir
InsertEnt $frm_8.txtDirName "$prjDir"
InsertEnt $frm_13.txtCompiler ""
InsertEnt $frm_12.txtProjInterp ""
InsertEnt $frm_4.txtProjVersion "0.0.1"
InsertEnt $frm_11.txtProjRelease "1"
InsertEnt $frm_3.txtProjAuthor ""
InsertEnt $frm_9.txtProjEmail ""
InsertEnt $frm_5.txtProjCompany ""
InsertEnt $frm_10.txtProjHome ""
} else {
InsertEnt $frm_1.txtProjName ""
InsertEnt $frm_2.txtFileName ""
InsertEnt $frm_8.txtDirName ""
InsertEnt $frm_13.txtCompiler ""
InsertEnt $frm_12.txtProjInterp ""
InsertEnt $frm_4.txtProjVersion "0.0.1"
InsertEnt $frm_11.txtProjRelease "1"
InsertEnt $frm_3.txtProjAuthor ""
InsertEnt $frm_9.txtProjEmail ""
InsertEnt $frm_5.txtProjCompany ""
InsertEnt $frm_10.txtProjHome ""
}
}
## CREATING PROJECT PROCEDURE ##
proc CreateProj {type lang txtFileName txtProjName txtFileName txtDirName txtCompiler txtProjInterp txtProjVersion txtProjRelease txtProjAuthor txtProjEmail txtProjCompany txtProjHome} {
global projDir workDir tree fontNormal dataDir tcl_platform
set projShortName [file tail $txtDirName]
set projFile [open [file join $workDir $projShortName.proj] w]
puts $projFile "ProjectName \"$txtProjName\""
puts $projFile "ProjectFileName \"$txtFileName\""
puts $projFile "ProjectDirName \"$txtDirName\""
puts $projFile "ProjectCompiler \"$txtCompiler\""
puts $projFile "ProjectInterp \"$txtProjInterp\""
puts $projFile "ProjectVersion \"$txtProjVersion\""
puts $projFile "ProjectRelease \"$txtProjRelease\""
puts $projFile "ProjectAuthor \"$txtProjAuthor\""
puts $projFile "ProjectEmail \"$txtProjEmail\""
puts $projFile "ProjectCompany \"$txtProjCompany\""
puts $projFile "ProjectHome \"$txtProjHome\""
close $projFile
if {$type != "open"} {
set dir [file join $projDir $txtDirName]
if {[file exists "$dir"] != 1} {
file mkdir "$dir"
}
# file header
if {$lang=="Tcl" || $lang == "Perl"} {
set text "######################################################\n#\t$txtProjName\n#\tDistributed under GNU Public License\n# Author: $txtProjAuthor $txtProjEmail\n# Home page: $txtProjHome\n######################################################\n"
} elseif {$lang == "Perl"} {
set lang pl
set text "######################################################\n#\t$txtProjName\n#\tDistributed under GNU Public License\n# Author: $txtProjAuthor $txtProjEmail\n# Home page: $txtProjHome\n######################################################\n"
} elseif {$lang=="Java"} {
set text "/*\n*****************************************************\n*\t$txtProjName\n*\tDistributed under GNU Public License\n* Author: $txtProjAuthor $txtProjEmail\n* Home page: $txtProjHome\n*****************************************************\n*/\n"
} elseif {$lang=="Fortran"} {
set text "\nc*****************************************************\nc*\t$txtProjName\n*c\tDistributed under GNU Public License\nc* Author: $txtProjAuthor $txtProjEmail\nc* Home page: $txtProjHome\nc*****************************************************\n*/\n"
} elseif {$lang=="O'Caml"} {
set text "\(*****************************************************\n*\t$txtProjName\n*\tDistributed under GNU Public License\n* Author: $txtProjAuthor $txtProjEmail\n* Home page: $txtProjHome\n******************************************************\)\n"
set lang ml
} elseif {$lang=="Ruby"} {
set lang rb
set text "######################################################\n#\t$txtProjName\n#\tDistributed under GNU Public License\n# Author: $txtProjAuthor $txtProjEmail\n# Home page: $txtProjHome\n######################################################\n"
} elseif {$lang=="PHP"} {
set text "<?\n/////////////////////////////////////////////////////\n//\t$txtProjName\n//\tDistributed under GNU Public License\n// Author: $txtProjAuthor $txtProjEmail\n// Home page: $txtProjHome\n/////////////////////////////////////////////////////\n?>"
set lang php
} elseif {$lang=="Erlang"} {
set text "\%**************************************************\n%\t$txtProjName\n%\tDistributed under GNU Public License\n% Author: $txtProjAuthor $txtProjEmail\n* Home page: $txtProjHome\n%*****************************************************\)\n"
set lang erl
}
if {[file exists [file join $dir $txtFileName.[string tolower $lang]]] == 0} {
set file [open [file join $dir $txtFileName.[string tolower $lang]] w]
puts $file $text
close $file
}
# spec file generating
if {[file exists [file join $dir $txtFileName.spec]] == 0} {
set file [open [file join $dir $txtFileName.spec] w]
puts $file "%define name $txtFileName"
puts $file "%define version $txtProjVersion"
puts $file "%define release $txtProjRelease"
puts $file "%define instdir $dataDir"
puts $file "Summary:\t$txtProjName"
puts $file "Name:\t\t%\{name\}"
puts $file "Version:\t%\{version\}"
puts $file "Release:\t%\{release\}"
puts $file "Source:\t%\{name\}-%\{version\}.tar.gz"
puts $file "Copyright:\tGPL"
puts $file "Group:\t\tDevelopment"
puts $file "Vendor:\t\t$txtProjAuthor <$txtProjEmail>"
puts $file "BuildRoot:\t%{_tmppath}/%{name}-buildroot"
puts $file "BuildArch:\tnoarch"
puts $file "Requires:\ttcl >= 8.3\n"
puts $file "%description"
puts $file "This project made by Tcl/Tk Project Manager"
puts $file "%prep\n%setup -n%\{name\}\n%build\n"
puts $file "%install"
puts $file "rm -rf \$RPM_BUILD_ROOT"
puts $file "mkdir -p \$RPM_BUILD_ROOT%\{_datadir\}/%\{name\}"
puts $file "cp -f \* \$RPM_BUILD_ROOT%\{_datadir\}/%\{name\}\n"
puts $file "%post\nmkdir \$HOME/.$txtDirName"
puts $file "%clean\nrm -rf \$RPM_BUILD_ROOT"
puts $file "%files"
puts $file "%defattr\(-,root,root\)"
puts $file "%doc README TODO CHANGELOG COPYING INSTALL"
puts $file "%\{_datadir\}/%\{name\}"
puts $file "%define date\t%\(echo \`LC_ALL=\"C\" date +\"%a %b %d %Y\"\`\)"
puts $file "%changelog"
puts $file "\* %\{date\}\n\n# end of file"
close $file
}
# file attributes "$dir/$txtFileName.tcl" -permissions "777"
# catch {chmod 744 "$dir/$txtFileName.tcl"} mes
foreach f {README TODO CHANGELOG COPYING INSTALL} {
if {[file exists [file join $dir $f]] != 1} {
set file [open [file join $dir $f] w]
puts $file "$text"
if {$f == "CHANGELOG"} {
if {$tcl_platform(platform) == "windows"} {
set d [clock format [clock scan "now" -base [clock seconds]] -format %d/%m/%Y]
} elseif {$tcl_platform(platform) == "mac"} {
set d "Needed date command for this platform"
} elseif {$tcl_platform(platform) == "unix"} {
set d [clock format [clock scan "now" -base [clock seconds]] -format %d/%m/%Y]
}
puts $file "$d\n\t- Beginning the project"
}
close $file
}
}
} else {
## Insert new project into tree ##
$tree insert end root $projShortName -text "$txtProjName" -font $fontNormal \
-data "prj_$projShortName" -open 0 -image [Bitmap::get folder]
GetFiles $txtDirName $projShortName $tree
}
}
## SAVING PROJECT SETTINGS ##
proc SaveProj {txtFileName txtProjName txtFileName txtDirName txtCompiler txtProjInterp txtProjVersion txtProjRelease txtProjAuthor txtProjEmail txtProjCompany txtProjHome} {
global projDir workDir tree fontNormal dataDir
set file [file tail $txtDirName]
set projFile [open [file join $workDir $file.proj] w]
puts $projFile "ProjectName \"$txtProjName\""
puts $projFile "ProjectFileName \"$txtFileName\""
puts $projFile "ProjectDirName \"$txtDirName\""
puts $projFile "ProjectCompiler \"$txtCompiler\""
puts $projFile "ProjectInterp \"$txtProjInterp\""
puts $projFile "ProjectVersion \"$txtProjVersion\""
puts $projFile "ProjectRelease \"$txtProjRelease\""
puts $projFile "ProjectAuthor \"$txtProjAuthor\""
puts $projFile "ProjectEmail \"$txtProjEmail\""
puts $projFile "ProjectCompany \"$txtProjCompany\""
puts $projFile "ProjectHome \"$txtProjHome\""
close $projFile
}
## OPEN EXISTING PROJECT AND ADDED INYO PROJMAN TREE ##
proc OpenProj {} {
global projDir workDir openProjDir prjDir prjName
set prjDir [SelectDir $projDir]
if {$prjDir != ""} {
set prjName "[file tail $prjDir]"
NewProjDialog open
#file copy $prjDir $projDir
}
return
}
## ADD FILE INTO PROJECTS ##
proc AddToProj {fileName mode} {
global projDir workDir activeProject tree noteBook fontNormal imgDir tree
set type [string trim [file extension $fileName] {.}]
destroy .addtoproj
set node [$tree selection get]
set fullPath [$tree itemcget $node -data]
if {[file isdirectory $fullPath] == 1} {
set dir $fullPath
set parentNode $node
} else {
set dir [file dirname $fullPath]
set parentNode [$tree parent $node]
}
if {$type == "tcl"} {
set img "tcl"
} elseif {$type == "tk"} {
set img "tk"
} elseif {$type == "txt"} {
set img "file"
} elseif {$type == "html"} {
set img "html"
} elseif {$type == "java"} {
set img "java"
} elseif {$type == "pl" || $type == "perl"} {
set img "perl"
} elseif {$type == "for"} {
set img "fortran"
} elseif {$type == "ml" || $type == "mli"} {
set img "caml"
} elseif {$type == "php" || $type == "phtml"} {
set img "php"
} elseif {$type == "rb"} {
set img "ruby"
} elseif {$type == "rb"} {
set img "erl"
} else {
set img "file"
}
if {$mode == "directory"} {
set img "folder"
}
#set dir [file join $projDir $activeProject]
set dot "_"
set name [file rootname $fileName]
set ext [string range [file extension $fileName] 1 end]
set subNode "$name$dot$ext"
$tree insert end $parentNode $subNode -text $fileName \
-data [file join $dir $fileName] -open 1\
-image [Bitmap::get [file join $imgDir $img.gif]]\
-font $fontNormal
if {[$tree itemcget $activeProject -open] == 0} {
$tree itemconfigure $activeProject -open 1
}
set file [file join $dir $fileName]
#set f [open $file w]
#close $f
puts $file
if {$mode == "directory"} {
file mkdir $file
return
}
InsertTitle $file $type
EditFile $subNode [file join $dir $fileName]
}
## ADD FILE INTO PROJECT DIALOG##
proc AddToProjDialog {mode} {
global projDir workDir activeProject imgDir tree mod
set mod $mode
if {$activeProject == ""} {
set answer [tk_messageBox\
-message "[::msgcat::mc "Not found active project"]"\
-type ok -icon warning]
case $answer {
ok {return 0}
}
}
set w .addtoproj
if {[winfo exists $w]} {
destroy $w
}
# create the new "goto" window
toplevel $w
wm title $w [::msgcat::mc "Create new $mod"]
wm resizable $w 0 0
wm transient $w .
frame $w.frmCanv -border 1 -relief sunken
frame $w.frmBtn -border 1 -relief sunken
pack $w.frmCanv -side top -fill both -padx 1 -pady 1
pack $w.frmBtn -side top -fill x
label $w.frmCanv.lblImgTcl -text [::msgcat::mc "Input $mod name"]
entry $w.frmCanv.entImgTcl
pack $w.frmCanv.lblImgTcl $w.frmCanv.entImgTcl -expand true -padx 5 -pady 5 -side top
button $w.frmBtn.btnOk -text [::msgcat::mc "Create"] -relief groove -command {
AddToProj [.addtoproj.frmCanv.entImgTcl get] $mod
}
button $w.frmBtn.btnCancel -text [::msgcat::mc "Close"] -command "destroy $w" -relief groove
pack $w.frmBtn.btnOk $w.frmBtn.btnCancel -padx 2 -pady 2 -fill x -side left
bind $w <Escape> "destroy .addtoproj"
bind $w.frmCanv.entImgTcl <Return> {
AddToProj [.addtoproj.frmCanv.entImgTcl get] $mod
}
focus -force $w.frmCanv.entImgTcl
#unset type
}
proc AddToProjDialog_ {} {
global projDir workDir activeProject imgDir tree
if {$activeProject == ""} {
set answer [tk_messageBox\
-message "[::msgcat::mc "Not found active project"]"\
-type ok -icon warning]
case $answer {
ok {return 0}
}
}
set w .addtoproj
if {[winfo exists $w]} {
destroy $w
}
# create the new "goto" window
toplevel $w
wm title $w [::msgcat::mc "Create new file"]
wm resizable $w 0 0
wm transient $w .
frame $w.frmCanv -border 1 -relief sunken
frame $w.frmBtn -border 1 -relief sunken
pack $w.frmCanv -side top -fill both -padx 1 -pady 1
pack $w.frmBtn -side top -fill x
label $w.frmCanv.lblImgTcl -text [::msgcat::mc "Input file name"]
entry $w.frmCanv.entImgTcl
pack $w.frmCanv.lblImgTcl $w.frmCanv.entImgTcl -expand true -padx 5 -pady 5 -side top
button $w.frmBtn.btnOk -text [::msgcat::mc "Create"] -relief groove -command {
AddToProj [.addtoproj.frmCanv.entImgTcl get]
}
button $w.frmBtn.btnCancel -text [::msgcat::mc "Close"] -command "destroy $w" -relief groove
pack $w.frmBtn.btnOk $w.frmBtn.btnCancel -padx 2 -pady 2 -fill x -side left
bind $w <Escape> "destroy .addtoproj"
bind $w.frmCanv.entImgTcl <Return> {
AddToProj [.addtoproj.frmCanv.entImgTcl get]
}
focus -force $w.frmCanv.entImgTcl
}
## DELETE FILE FROM PROJECT ##
proc DelFromProj {project} {
global projDir workDir
}
## DELETEING PROJECT PROCEDURE ##
proc DelProj {} {
global workDir activeProject tree
if {$activeProject == ""} {
set answer [tk_messageBox\
-message "[::msgcat::mc "Not found active project"]"\
-type ok -icon warning]
case $answer {
ok {return 0}
}
}
set file [open [file join $workDir $activeProject.proj] r]
while {[gets $file line]>=0} {
scan $line "%s" keyWord
set string [string range $line [string first "\"" $line] [string last "\"" $line]]
set string [string trim $string "\""]
if {$keyWord == "ProjectDirName"} {
set projDir "$string"
puts $projDir
}
}
close $file
set answer [tk_messageBox -message "[::msgcat::mc "Delete project"] \"$activeProject\" ?"\
-type yesno -icon question -default yes]
case $answer {
yes {
FileDialog close_all
file delete -force $projDir
file delete -force [file join $workDir $activeProject.proj]
file delete -force [file join $workDir $activeProject.tags]
$tree delete [$tree selection get]
$tree configure -redraw 1
set activeProject ""
LabelUpdate .frmStatus.frmActive.lblActive ""
}
}
}
proc CompileOption {string} {
global fontNormal cmdCompile editor
set w .cmd
# destroy the find window if it already exists
if {[winfo exists $w]} {
destroy $w
}
toplevel $w
wm title $w [::msgcat::mc "Command options"]
wm resizable $w 0 0
wm transient $w .
frame $w.frmCombo -borderwidth 1 -bg $editor(bg)
frame $w.frmBtn -borderwidth 1 -bg $editor(bg)
pack $w.frmCombo $w.frmBtn -side top -fill x
# set combo [entry $w.frmCombo.entFind]
label $w.frmCombo.lblModule -text "[::msgcat::mc "Convert to"]" -bg $editor(bg) -fg $editor(fg)
label $w.frmCombo.lblFile -text "[::msgcat::mc "File"]" -bg $editor(bg) -fg $editor(fg)
set combo [entry $w.frmCombo.txtString -text "$string"]
pack $w.frmCombo.lblModule $w.frmCombo.lblFile $combo -fill x -padx 2 -pady 2 -side top
button $w.frmBtn.btnFind -text [::msgcat::mc "Run"]\
-font $fontNormal -width 12 -relief groove -bg $editor(bg) -fg $editor(fg)\
-command {
return [.cmd.frmCombo.txtString get]
destroy .cmd
}
button $w.frmBtn.btnCancel -text [::msgcat::mc "Close"] -bg $editor(bg) -fg $editor(fg)\
-relief groove -width 12 -font $fontNormal\
-command "destroy $w"
pack $w.frmBtn.btnFind $w.frmBtn.btnCancel -fill x -padx 2 -pady 2 -side left
bind $w <Return> {
set cmdCompile [.cmd.frmCombo.txtString get]
destroy .cmd
}
bind $w <Escape> "destroy $w"
$combo insert end "$string"
focus -force $combo
}
## MAKE PROJ PROCEDURE (RUNNING PROJECT) ##
proc MakeProj {action t} {
global activeProject projDir noteBook fontNormal fontBold workDir tree cmdCompile editor
if {$activeProject == ""} {
set answer [tk_messageBox\
-message "[::msgcat::mc "Not found active project"]"\
-type ok -icon warning\
-title [::msgcat::mc "Warning"]]
case $answer {
ok {return 0}
}
}
FileDialog save_all
set file [open [file join $workDir $activeProject.proj] r]
while {[gets $file line]>=0} {
scan $line "%s" keyWord
set string [string range $line [string first "\"" $line] [string last "\"" $line]]
set string [string trim $string "\""]
if {$keyWord == "ProjectName"} {
set projName "$string"
}
if {$keyWord == "ProjectFileName"} {
set projFileName "$string"
}
if {$keyWord == "ProjectDirName"} {
set projDirName "$string"
}
if {$keyWord == "ProjectCompiler"} {
set projCompiler "$string"
}
if {$keyWord == "ProjectInterp"} {
set projInterp "$string"
}
}
close $file
if {$action == "compile"} {
if {$t == "proj"} {
set prog [file join $projDirName $projFileName.java]
} elseif {$t == "file"} {
set node [$tree selection get]
set fullPath [$tree itemcget $node -data]
set dir [file dirname $fullPath]
set file [file tail $fullPath]
set prog $fullPath
}
} elseif {$action == "run"} {
if {$t == "proj"} {
set prog [file join $projDirName $projFileName.tcl]
} elseif {$t == "file"} {
set node [$tree selection get]
set fullPath [$tree itemcget $node -data]
set dir [file dirname $fullPath]
set file [file tail $fullPath]
set prog $fullPath
}
}
set node "debug"
if {[$noteBook index $node] != -1} {
$noteBook delete debug
}
set w [$noteBook insert end $node -text [::msgcat::mc "Running project"]]
# create array with file names #
frame $w.frame -borderwidth 2 -relief ridge -background $editor(bg)
pack $w.frame -side top -fill both -expand true
text $w.frame.text -yscrollcommand "$w.frame.yscroll set" \
-bg $editor(bg) -fg $editor(fg) \
-relief sunken -wrap word -highlightthickness 0 -font $fontNormal\
-selectborderwidth 0 -selectbackground #55c4d1 -width 10 -height 10
scrollbar $w.frame.yscroll -relief sunken -borderwidth {1} -width {10} -takefocus 0 \
-command "$w.frame.text yview" -background $editor(bg)
pack $w.frame.text -side left -fill both -expand true
pack $w.frame.yscroll -side left -fill y
frame $w.frmBtn -borderwidth 2 -relief ridge -bg $editor(bg)
pack $w.frmBtn -side top -fill x
button $w.frmBtn.btnOk -text [::msgcat::mc "Close"] -borderwidth {1} \
-bg $editor(bg) -fg $editor(fg) -command {
$noteBook delete debug
$noteBook raise [$noteBook page end]
return 0
}
pack $w.frmBtn.btnOk -pady 2
# key bindings #
bind $w.frmBtn.btnOk <Escape> {
$noteBook delete debug
$noteBook raise [$noteBook page end]
# return 0
}
bind $w.frmBtn.btnOk <Return> {
$noteBook delete debug
$noteBook raise [$noteBook page end]
# return 0
}
focus -force $w.frmBtn.btnOk
$noteBook raise $node
# insert debug data into text widget #
$w.frame.text tag configure bold -font $fontBold
$w.frame.text tag configure error -font $fontNormal -foreground red
$w.frame.text tag add bold 0.0 0.end
if {$action == "compile"} {
$w.frame.text insert end "[::msgcat::mc "Compile project"] - $activeProject\n"
$w.frame.text insert end "[::msgcat::mc "Compile"] - $prog\n\n"
} elseif {$action == "run"} {
$w.frame.text insert end "[::msgcat::mc "Running project"] - $activeProject\n"
$w.frame.text insert end "[::msgcat::mc "Run"] - $prog\n\n"
}
set pos [$w.frame.text index insert]
set lineNum [lindex [split $pos "."] 0]
$w.frame.text insert end "----------------- [::msgcat::mc "Programm output"] -----------------\n"
$w.frame.text tag add bold $lineNum.0 $lineNum.end
# open and manipulate executed program chanel #
if {$action == "compile"} {
set cmdCompile ""
CompileOption "$projCompiler $prog"
vwait cmdCompile
puts "string - $projCompiler $prog" ;# debug info
set pipe [open "|$cmdCompile 2> [file join $projDirName errors]" "r"]
set f [open [file join $projDirName errors] "r"]
} elseif {$action == "run"} {
set pipe [open "|$projInterp $prog 2> [file join $projDirName errors]" "r"]
set f [open [file join $projDirName errors] "r"]
}
fileevent $pipe readable [list DebugInfo $w.frame.text $pipe $f]
fconfigure $pipe -buffering none -blocking no
#fileevent $f readable [list DebugInfo $w.frame.text $f]
#fconfigure $f -buffering none -blocking no
}
## INSERT DEBUG INFORMATION INTO TEXT WIDGET ##
proc DebugInfo {widget file f} {
$widget configure -state normal
if {[eof $file]} {
catch [close $file] msg
if {$msg != ""} {
puts $msg
$widget insert end "[::msgcat::mc "Program failed"]: $msg\n";
} else {
puts $msg
$widget insert end "\n-------------------------------------------------\n"
$widget insert end "[::msgcat::mc "Program finished successfully"]\n"
}
} else {
$widget insert end [read $file]
}
while {[gets $f line]>=0} {
$widget insert end "$line\n"
puts $line
}
$widget see end
$widget tag add error 0.0 0.end
$widget configure -state disabled
}
## INSERT TITLE INTO NEW FILE ##
proc InsertTitle {newFile type} {
global activeProject projDir workDir ver
puts "$newFile $type"
set year [clock format [clock scan "now" -base [clock seconds]] -format %Y]
if {$activeProject == ""} {
set answer [tk_messageBox\
-message "[::msgcat::mc "Not found active project"]"\
-type ok -icon warning\
-title [::msgcat::mc "Warning"]]
case $answer {
ok {return 0}
}
}
set file [open [file join $workDir $activeProject.proj] r]
while {[gets $file line]>=0} {
scan $line "%s" keyWord
set string [string range $line [string first "\"" $line] [string last "\"" $line]]
set string [string trim $string "\""]
if {$keyWord == "ProjectName"} {
set txtProjName "$string"
}
if {$keyWord == "ProjectFileName"} {
set txtProjFileName "$string"
}
if {$keyWord == "ProjectDirName"} {
set txtProjDirName "$string"
}
if {$keyWord == "ProjectInterp"} {
set txtProjInterp "$string"
}
if {$keyWord == "ProjectVersion"} {
set txtProjVersion "$string"
}
if {$keyWord == "ProjectRelease"} {
set txtProjRelease "$string"
}
if {$keyWord == "ProjectAuthor"} {
set txtProjAuthor "$string"
}
if {$keyWord == "ProjectEmail"} {
set txtProjEmail "$string"
}
if {$keyWord == "ProjectCompany"} {
set txtProjCompany "$string"
}
if {$keyWord == "ProjectHome"} {
set txtProjHome "$string"
}
}
if {$type == "html"} {
set fileTitle "<HTML>\n<HEAD>\n<META http-equiv=Content-Type content=\"text/html; charset=koi8-r\">\n<META NAME=\"Author\" CONTENT=\"$txtProjAuthor\">\n<META NAME=\"GENERATOR\" CONTENT=\"Created by Tcl/Tk Project Manager - $ver\">\n<TITLE></TITLE>\n</HEAD>\n<BODY>\n\n</BODY>\n</HTML>"
} elseif {$type == "tcl"} {
set fileTitle "#!$txtProjInterp\n######################################################\n#\t\t$txtProjName\n#\tDistributed under GNU Public License\n# Author: $txtProjAuthor $txtProjEmail\n# Copyright (c) \"$txtProjCompany\", $year, $txtProjHome\n######################################################\n"
} elseif {$type == "perl" || $type == "pl"} {
set fileTitle "######################################################\n#\t\t$txtProjName\n#\tDistributed under GNU Public License\n# Author: $txtProjAuthor $txtProjEmail\n# Copyright (c) \"$txtProjCompany\", $year, $txtProjHome\n######################################################\n"
} elseif {$type == "txt"} {
set fileTitle "#######################################################\n#\t\t$txtProjName\n#\tDistributed under GNU Public License\n# Author: $txtProjAuthor $txtProjEmail\n# Copyright (c) \"$txtProjCompany\", $year, $txtProjHome\n######################################################\n"
} elseif {$type == "rb"} {
set fileTitle "#!$txtProjInterp\n######################################################\n#\t\t$txtProjName\n#\tDistributed under GNU Public License\n# Author: $txtProjAuthor $txtProjEmail\n# Copyright (c) \"$txtProjCompany\", $year, $txtProjHome\n######################################################\n"
} elseif {$type == "java"} {
set fileTitle "/*\n*****************************************************\n*\t$txtProjName\n*\tDistributed under GNU Public License\n* Author: $txtProjAuthor $txtProjEmail\n* Home page: $txtProjHome\n*****************************************************\n*/\n"
} elseif {$type == "for"} {
set fileTitle "*****************************************************\n*\t$txtProjName\n*\tDistributed under GNU Public License\n* Author: $txtProjAuthor $txtProjEmail\n* Home page: $txtProjHome\n*****************************************************\n"
} elseif {$type == "ml" || $type == "mli"} {
set fileTitle "\(*****************************************************\n*\t$txtProjName\n*\tDistributed under GNU Public License\n* Author: $txtProjAuthor $txtProjEmail\n* Home page: $txtProjHome\n*****************************************************\)\n"
} elseif {$type == "php" || $type == "phtml"} {
set fileTitle "<?\n////////////////////////////////////////////////////////////\n//\t$txtProjName\n//\tDistributed under GNU Public License\n// Author: $txtProjAuthor $txtProjEmail\n// Home page: $txtProjHome\n////////////////////////////////////////////////////////////\n\n\n\n\n?>"
} elseif {$type == "tml"} {
set fileTitle "<!--\n######################################################\n#\t\t$txtProjName\n#\tDistributed under GNU Public License\n# Author: $txtProjAuthor $txtProjEmail\n# Copyright (c) \"$txtProjCompany\", $year, $txtProjHome\n######################################################\n-->\n"
} elseif {$type == "erl"} {
set fileTitle "%*****************************************************\n%\t$txtProjName\n%\tDistributed under GNU Public License\n% Author: $txtProjAuthor $txtProjEmail\n% Home page: $txtProjHome\n%****************************************************\n"
} else {
set fileTitle "######################################################\n#\t\t$txtProjName\n#\tDistributed under GNU Public License\n# Author: $txtProjAuthor $txtProjEmail\n# Copyright (c) \"$txtProjCompany\", $year, $txtProjHome\n######################################################\n"
}
set pipe [open $newFile w]
# puts "$newFile\n $fileTitle" ;# debuf info
puts $pipe $fileTitle
close $pipe
}

View File

@ -1,6 +1,6 @@
###########################################################
# TCL/Tk Project Manager #
# version 0.3.8 #
# version 0.4.5 #
# #
# Copyright (c) "Sergey Kalinin", 2001, http://nuk-svk.ru #
# Authors: Sergey Kalinin banzaj28@yandex.ru #
@ -69,3 +69,5 @@ set color(label) "#c9c9c9"
set color(sixFG) "#ff0000"
set color(sixBG) "#ffdbdb"
set color(sql) "#ffff828f0000"

View File

@ -1,9 +1,8 @@
#!/usr/bin/wish
###########################################################
# Tcl/Tk Project Manager #
# Distrubuted under GPL #
# Copyright (c) "Sergey Kalinin", 2002, http://nuk-svk.ru #
# Copyright (c) "Sergey Kalinin", 2001, http://nuk-svk.ru #
# Author: Sergey Kalinin banzaj28@yandex.ru #
###########################################################
@ -17,7 +16,6 @@ package require msgcat
set rootDir "/usr"
set tclDir "/usr/bin"
##
if {[file exists $env(HOME)/projects/tcl/projman]==1} {
set dataDir "[file join $env(HOME) projects tcl projman lib]"
set docDir "[file join $env(HOME) projects tcl projman hlp ru]"
@ -88,9 +86,6 @@ foreach modFile [lsort [glob -nocomplain [file join $hlDir *.tcl]]] {
source [file join $dataDir main.tcl]
#set editor(selectBorder) "0"
#option add *tree.foreground red widgetDefault
# Set colors for widgets
option add *Frame.background $editor(bg) startupFile
@ -122,3 +117,4 @@ option add *Listbox.foreground $editor(fg) startupFile
option add *Listbox.background $editor(bg) startupFile
option add *Scrollbar.background $editor(bg) startupFile

View File

@ -1,867 +0,0 @@
######################################################
# Tcl/Tk project Manager
# Distributed under GNU Public License
# Author: Sergey Kalinin banzaj28@yandex.ru
# Home page: http://nuk-svk.ru
######################################################
## SETTING DIALOG ##
proc Settings {} {
global fontNormal fontBold imgDir workDir
global editor color nb
global main editFrm network
global toolBar autoFormat backUpDel backUpCreate backUpShow localeSet localeList wrapSet wrapList
set w .pref
# destroy the find window if it already exists
if {[winfo exists $w]} {
destroy $w
}
toplevel $w
wm title $w [::msgcat::mc "Settings"]
# wm resizable $w 0 0
wm geometry $w 464x450+0+0
wm transient $w .
frame $w.frmMain -borderwidth 1 -bg $editor(bg)
pack $w.frmMain -side top -fill both -expand 1
frame $w.frmBtn -borderwidth 1 -bg $editor(bg)
pack $w.frmBtn -side top -fill x
set nb [NoteBook $w.frmMain.noteBook -font $fontBold -side top -bg $editor(bg) -fg $editor(fg)]
pack $nb -fill both -expand true -padx 2 -pady 2
button $w.frmBtn.btnFind -text [::msgcat::mc "Save"] -font $fontNormal -width 12 -relief groove \
-bg $editor(bg) -fg $editor(fg) \
-command {
file copy -force [file join $workDir projman.conf] [file join $workDir projman.conf.old]
set file [open [file join $workDir projman.conf] w]
puts $file "###########################################################"
puts $file "# TCL/Tk Project Manager #"
puts $file "# version $ver #"
puts $file "# #"
puts $file "# Copyright \(c\) \"Sergey Kalinin\", 2001, http://nuk-svk.ru #"
puts $file "# Authors: Sergey Kalinin \(aka BanZaj\) banzaj28@yandex.ru #"
puts $file "###########################################################"
puts $file "# Modification date: [exec date]"
puts $file "###########################################################\n"
puts $file "# Normal Font"
puts $file "set fontNormal \"[$main.frmFontNormal.txtFontNormal get]\""
puts $file "# Bold Font #"
puts $file "set fontBold \"[$main.frmFontBold.txtFontBold get]\""
puts $file "# ToolBar on/off \(Yes/No\)"
if {$toolBar == "false"} {
puts $file "set toolBar \"No\"\n"
} else {
puts $file "set toolBar \"Yes\"\n"
}
if {$backUpShow == "false"} {
puts $file "set backUpFileShow \"No\""
} else {
puts $file "set backUpFileShow \"Yes\""
}
if {$backUpCreate == "false"} {
puts $file "set backUpFileCreate \"No\""
} else {
puts $file "set backUpFileCreate \"Yes\""
}
if {$backUpDel == "false"} {
puts $file "set backUpFileDelete \"No\""
} else {
puts $file "set backUpFileDelete \"Yes\""
}
puts $file "\n# Don't edit this line"
puts $file "# Directorys Settings #"
puts $file "set projDir \"[$main.frmProjDir.txtProjDir get]\""
puts $file "set rpmDir \"[$main.frmRpmDir.txtRpmDir get]\""
puts $file "set tgzDir \"[$main.frmTgzDir.txtTgzDir get]\""
puts $file "# File mask #"
puts $file "set rpmNamed \"[$main.frmRpmNamed.txtRpmNamed get]\""
puts $file "set tgzNamed \"[$main.frmTgzNamed.txtTgzNamed get]\""
puts $file "\n# Locale setting\nset locale \"$localeSet\""
if {$autoFormat == "false"} {
puts $file "set autoFormat \"No\"\n"
} else {
puts $file "set autoFormat \"Yes\"\n"
}
puts $file "# Editor Font #"
puts $file "set editor(font) \"[$editFrm.frmEditorFont.txtEditorFont get]\""
puts $file "# Editor Bold Font #"
puts $file "set editor(fontBold) \"[$editFrm.frmEditorFontBold.txtEditorFontBold get]\""
puts $file "# background color #"
puts $file "set editor(bg) \"[$editFrm.frmColorEditBG.txtColorEditBG get]\""
puts $file "# foreground color #"
puts $file "set editor(fg) \"[$editFrm.frmColorEditFG.txtColorEditFG get]\""
puts $file "# selection background color #"
puts $file "set editor(selectbg) \"[$editFrm.frmColorSelectBG.txtColorSelectBG get]\""
puts $file "# NoteBook title normal font color #"
puts $file "set editor(nbNormal) \"[$editFrm.frmColorNbNormal.txtColorNbNormal get]\""
puts $file "# NoteBook title modify font color #"
puts $file "set editor(nbModify) \"[$editFrm.frmColorNbModify.txtColorNbModify get]\""
puts $file "# selection border width #"
puts $file "set editor(selectBorder) \"0\""
puts $file "# Editor wraping #"
puts $file "# must be: none, word or char"
puts $file "set editor(wrap) \"$wrapSet\""
puts $file "## SOURCE CODE HIGHLIGTNING ##"
puts $file "set color(procName) \"[$editFrm.frmColorProc.txtColorProc get]\""
puts $file "set color(keyWord) \"[$editFrm.frmColorKeyWord.txtColorKeyWord get]\""
puts $file "set color(param) \"[$editFrm.frmColorParam.txtColorParam get]\""
puts $file "set color(subParam) \"[$editFrm.frmColorSubParam.txtColorSubParam get]\""
puts $file "set color(comments) \"[$editFrm.frmColorComments.txtColorComments get]\""
puts $file "set color(var) \"[$editFrm.frmColorVar.txtColorVar get]\""
puts $file "set color(string) \"[$editFrm.frmColorString.txtColorString get]\""
puts $file "set color(brace) \"[$editFrm.frmColorBrace.txtColorBrace get]\""
puts $file "set color(bracequad) \"[$editFrm.frmColorBraceQuad.txtColorBraceQuad get]\""
puts $file "set color(braceBG) \"[$editFrm.frmColorBraceBG.txtColorBraceBG get]\""
puts $file "set color(braceFG) \"[$editFrm.frmColorBraceFG.txtColorBraceFG get]\""
puts $file "set color(percent) \"[$editFrm.frmColorPercent.txtColorPercent get]\""
puts $file "set color(bindKey) \"[$editFrm.frmColorBindKey.txtColorBindKey get]\""
puts $file "set color(label) \"[$editFrm.frmColorLabel.txtColorLabel get]\""
puts $file "set color(sixFG) \"[$editFrm.frmColorSixFG.txtColorSixFG get]\""
puts $file "set color(sixBG) \"[$editFrm.frmColorSixBG.txtColorSixBG get]\""
puts $file "set color(sql) \"[$editFrm.frmColorSQL.txtColorSQL get]\""
close $file
destroy .pref
}
button $w.frmBtn.btnCancel -text [::msgcat::mc "Close"] -relief groove -width 12\
-font $fontNormal -command "destroy $w" -bg $editor(bg) -fg $editor(fg)
pack $w.frmBtn.btnFind $w.frmBtn.btnCancel -fill x -padx 2 -pady 2 -side left
################## MAIN PREF ##########################
set main [$nb insert end main -text "[::msgcat::mc "Main"]"]
set scrwin [ScrolledWindow $main.scrwin -relief groove -bd 2 -bg $editor(bg)]
#pack $scrwin -fill both -expand true
set scrfrm [ScrollableFrame $main.frm -bg $editor(bg)]
pack $scrwin -fill both -expand true
pack $scrfrm -fill both -expand true
$scrwin setwidget $scrfrm
set main [$scrfrm getframe]
set frm_1 [frame $main.frmFontNormal -bg $editor(bg)]
label $frm_1.lblFontNormal -text [::msgcat::mc "Font normal"] -width 30\
-anchor w -font $fontNormal -fg $editor(fg) -bg $editor(bg)
entry $frm_1.txtFontNormal
button $frm_1.btnFontNormal -borderwidth {1} -font $fontNormal \
-command {SelectFontDlg $fontNormal $main.frmFontNormal.txtFontNormal} \
-image [Bitmap::get [file join $imgDir font_selector.gif]]
pack $frm_1.lblFontNormal -side left
pack $frm_1.txtFontNormal -side left -fill x -expand true
pack $frm_1.btnFontNormal -side left
set frm_2 [frame $main.frmFontBold -bg $editor(bg)]
label $frm_2.lblFontBold -text [::msgcat::mc "Font bold"] -width 30 -anchor w \
-font $fontNormal -fg $editor(fg) -bg $editor(bg)
entry $frm_2.txtFontBold
button $frm_2.btnFontBold -borderwidth {1} -font $fontNormal \
-command {SelectFontDlg $fontBold $main.frmFontBold.txtFontBold} \
-image [Bitmap::get [file join $imgDir font_selector.gif]]
pack $frm_2.lblFontBold -side left
pack $frm_2.txtFontBold -side left -fill x -expand true
pack $frm_2.btnFontBold -side left
set frm_3 [frame $main.frmToolBar -bg $editor(bg)]
label $frm_3.lblToolBar -text [::msgcat::mc "Toolbar"] -width 30 -anchor w \
-font $fontNormal -fg $editor(fg) -bg $editor(bg)
checkbutton $frm_3.chkToolBar -text "" -variable toolBar \
-font $fontNormal -onvalue true -offvalue false -bg $editor(bg)
pack $frm_3.lblToolBar -side left
pack $frm_3.chkToolBar -side left
set frm_4 [frame $main.frmProjDir -bg $editor(bg)]
label $frm_4.lblProjDir -text [::msgcat::mc "Projects"] -width 30 -anchor w \
-font $fontNormal -fg $editor(fg) -bg $editor(bg)
entry $frm_4.txtProjDir -bg $editor(bg)
button $frm_4.btnProjDir -borderwidth {1} -font $fontNormal -bg $editor(bg)\
-image [Bitmap::get [file join $imgDir folder.gif]]\
-command {
InsertEnt $main.frmProjDir.txtProjDir [SelectDir $projDir]
}
pack $frm_4.lblProjDir -side left
pack $frm_4.txtProjDir -side left -fill x -expand true
pack $frm_4.btnProjDir -side left
set frm_5 [frame $main.frmLocale -bg $editor(bg)]
label $frm_5.lblLocale -text [::msgcat::mc "Interface language"]\
-width 30 -anchor w -font $fontNormal -fg $editor(fg) -bg $editor(bg)
set combo [ComboBox $frm_5.txtLocale \
-textvariable localeSet -command "puts 123"\
-selectbackground "#55c4d1" -selectborderwidth 0\
-values [GetLocale]]
pack $frm_5.lblLocale -side left
pack $frm_5.txtLocale -side left -fill x -expand true
set frm_6 [frame $main.frmRpmDir -bg $editor(bg)]
label $frm_6.lblRpmDir -text [::msgcat::mc "RPM dir"] -width 30 -anchor w \
-font $fontNormal -fg $editor(fg) -bg $editor(bg)
entry $frm_6.txtRpmDir -fg $editor(fg) -bg $editor(bg)
button $frm_6.btnRpmDir -borderwidth {1} -font $fontNormal -bg $editor(bg) \
-image [Bitmap::get [file join $imgDir folder.gif]]\
-command {
InsertEnt $main.frmRpmDir.txtRpmDir [SelectDir $workDir]
}
pack $frm_6.lblRpmDir -side left
pack $frm_6.txtRpmDir -side left -fill x -expand true
pack $frm_6.btnRpmDir -side left
set frm_7 [frame $main.frmTgzDir -bg $editor(bg)]
label $frm_7.lblTgzDir -text [::msgcat::mc "TGZ dir"] -width 30 -anchor w -font $fontNormal -fg $editor(fg)
entry $frm_7.txtTgzDir
button $frm_7.btnTgzDir -borderwidth {1} -font $fontNormal \
-image [Bitmap::get [file join $imgDir folder.gif]]\
-command {
InsertEnt $main.frmTgzDir.txtTgzDir [SelectDir $workDir]
}
pack $frm_7.lblTgzDir -side left
pack $frm_7.txtTgzDir -side left -fill x -expand true
pack $frm_7.btnTgzDir -side left
set frm_8 [frame $main.frmRpmNamed -bg $editor(bg)]
label $frm_8.lblRpmNamed -text [::msgcat::mc "RPM file mask"] -width 30 -anchor w\
-font $fontNormal -fg $editor(fg)
entry $frm_8.txtRpmNamed
pack $frm_8.lblRpmNamed -side left
pack $frm_8.txtRpmNamed -side left -fill x -expand true
set frm_9 [frame $main.frmTgzNamed -bg $editor(bg)]
label $frm_9.lblTgzNamed -text [::msgcat::mc "TGZ file mask"] -width 30 -anchor w\
-font $fontNormal -fg $editor(fg)
entry $frm_9.txtTgzNamed
pack $frm_9.lblTgzNamed -side left
pack $frm_9.txtTgzNamed -side left -fill x -expand true
set frm_10 [frame $main.frmBackUpCreate -bg $editor(bg)]
label $frm_10.lblBackUpCreate -text [::msgcat::mc "Create backup files"]\
-width 30 -anchor w -font $fontNormal -fg $editor(fg)
checkbutton $frm_10.chkBackUpCreate -text "" -variable backUpCreate \
-font $fontNormal -onvalue true -offvalue false
pack $frm_10.lblBackUpCreate -side left
pack $frm_10.chkBackUpCreate -side left
set frm_11 [frame $main.frmBackUpShow -bg $editor(bg)]
label $frm_11.lblBackUpShow -text [::msgcat::mc "Show backup files"]\
-width 30 -anchor w -font $fontNormal -fg $editor(fg)
checkbutton $frm_11.chkBackUpShow -text "" -variable backUpShow \
-font $fontNormal -onvalue true -offvalue false
pack $frm_11.lblBackUpShow -side left
pack $frm_11.chkBackUpShow -side left
set frm_12 [frame $main.frmBackUpDel -bg $editor(bg)]
label $frm_12.lblBackUpDel -text [::msgcat::mc "Delete backup files"]\
-width 30 -anchor w -font $fontNormal -fg $editor(fg)
checkbutton $frm_12.chkBackUpDel -text "" -variable backUpDel \
-font $fontNormal -onvalue true -offvalue false
pack $frm_12.lblBackUpDel -side left
pack $frm_12.chkBackUpDel -side left
pack $frm_1 $frm_2 $frm_5 $frm_3 $frm_4 $frm_6 $frm_7 \
$frm_8 $frm_9 $frm_10 $frm_11 $frm_12 -side top -fill both -expand true
#################### EDITOR PREF #########################
set editFrm [$nb insert end editor -text "[::msgcat::mc "Editor"]"]
set scrwin [ScrolledWindow $editFrm.scrwin -relief groove -bd 2 -bg $editor(bg)]
set scrfrm [ScrollableFrame $editFrm.frm -bg $editor(bg)]
pack $scrwin -fill both -expand true
pack $scrfrm -fill both -expand true
$scrwin setwidget $scrfrm
set editFrm [$scrfrm getframe]
set frm_13 [frame $editFrm.frmEditorFont -bg $editor(bg)]
label $frm_13.lblEditorFont -text [::msgcat::mc "Editor font"] -width 30\
-anchor w -font $fontNormal
entry $frm_13.txtEditorFont
button $frm_13.btnEditorFont -borderwidth {1} -font $fontNormal \
-command {SelectFontDlg $editor(font) $editFrm.frmEditorFont.txtEditorFont} \
-image [Bitmap::get [file join $imgDir font_selector.gif]]
pack $frm_13.lblEditorFont -side left
pack $frm_13.txtEditorFont -side left -fill x -expand true
pack $frm_13.btnEditorFont -side left
set frm_14 [frame $editFrm.frmEditorFontBold -bg $editor(bg)]
label $frm_14.lblEditorFontBold -text [::msgcat::mc "Editor font bold"]\ -width 30 -anchor w -font $fontNormal
entry $frm_14.txtEditorFontBold
button $frm_14.btnEditorFontBold -borderwidth {1} -font $fontNormal \
-command {SelectFontDlg $editor(fontBold) $editFrm.frmEditorFontBold.txtEditorFontBold} \
-image [Bitmap::get [file join $imgDir font_selector.gif]]
pack $frm_14.lblEditorFontBold -side left
pack $frm_14.txtEditorFontBold -side left -fill x -expand true
pack $frm_14.btnEditorFontBold -side left
set frm_21 [frame $editFrm.frmColorEditBG -bg $editor(bg)]
label $frm_21.lblColorEditBG -text [::msgcat::mc "Editor background"]\
-width 30 -anchor w -font $fontNormal
entry $frm_21.txtColorEditBG
button $frm_21.btnColorEditBG -borderwidth {1} -font $fontNormal \
-text "Select color" -image [Bitmap::get [file join $imgDir color_selector.gif]]\
-command {
ColorSelect $editFrm.frmColorEditBG.txtColorEditBG $editFrm.frmColorEditBG.btnColorEditBG
ConfigureEnt [Text $editFrm.frmColorEditBG.txtColorEditBG]
}
pack $frm_21.lblColorEditBG -side left
pack $frm_21.txtColorEditBG -side left -fill x -expand true
pack $frm_21.btnColorEditBG -side left
set frm_22 [frame $editFrm.frmColorEditFG -bg $editor(bg)]
label $frm_22.lblColorEditFG -text [::msgcat::mc "Editor foreground"]\
-width 30 -anchor w -font $fontNormal
entry $frm_22.txtColorEditFG
button $frm_22.btnColorEditFG -borderwidth {1} -font $fontNormal \
-command {
ColorSelect $editFrm.frmColorEditFG.txtColorEditFG $editFrm.frmColorEditFG.btnColorEditFG
} \
-text "Select color"\
-image [Bitmap::get [file join $imgDir color_selector.gif]]
pack $frm_22.lblColorEditFG -side left
pack $frm_22.txtColorEditFG -side left -fill x -expand true
pack $frm_22.btnColorEditFG -side left
set frm_15 [frame $editFrm.frmAutoFormat -bg $editor(bg)]
label $frm_15.lblAutoFormat -text [::msgcat::mc "Text autoformat"]\
-width 30 -anchor w -font $fontNormal
checkbutton $frm_15.chkAutoFormat -text "" -variable autoFormat \
-font $fontNormal -onvalue true -offvalue false
pack $frm_15.lblAutoFormat -side left
pack $frm_15.chkAutoFormat -side left
set wrapList [list none word char]
set frm_28 [frame $editFrm.frmWrap -bg $editor(bg)]
label $frm_28.lblWrap -text [::msgcat::mc "Word wrapping"]\
-width 30 -anchor w -font $fontNormal
set combo2 [ComboBox $frm_28.txtWrap\
-textvariable wrapSet -command "puts 123"\
-selectbackground "#55c4d1" -selectborderwidth 0\
-values "$wrapList"]
pack $frm_28.lblWrap -side left
pack $combo2 -side left
set frm_16 [frame $editFrm.frmColorProc -bg $editor(bg)]
label $frm_16.lblColorProc -text [::msgcat::mc "Procedure name"]\
-width 30 -anchor w -font $fontNormal
entry $frm_16.txtColorProc -background $editor(bg)
button $frm_16.btnColorProc -borderwidth {1} -font $fontNormal \
-command {ColorSelect $editFrm.frmColorProc.txtColorProc $editFrm.frmColorProc.btnColorProc} \
-text "Select color"\
-image [Bitmap::get [file join $imgDir color_selector.gif]]
pack $frm_16.lblColorProc -side left
pack $frm_16.txtColorProc -side left -fill x -expand true
pack $frm_16.btnColorProc -side left
set frm_17 [frame $editFrm.frmColorKeyWord -bg $editor(bg)]
label $frm_17.lblColorKeyWord -text [::msgcat::mc "Operators"]\
-width 30 -anchor w -font $fontNormal
entry $frm_17.txtColorKeyWord -background $editor(bg)
button $frm_17.btnColorKeyWord -borderwidth {1} -font $fontNormal \
-command {ColorSelect $editFrm.frmColorKeyWord.txtColorKeyWord $editFrm.frmColorKeyWord.btnColorKeyWord} \
-text "Select color"\
-image [Bitmap::get [file join $imgDir color_selector.gif]]
pack $frm_17.lblColorKeyWord -side left
pack $frm_17.txtColorKeyWord -side left -fill x -expand true
pack $frm_17.btnColorKeyWord -side left
set frm_35 [frame $editFrm.frmColorParam -bg $editor(bg)]
label $frm_35.lblColorParam -text [::msgcat::mc "Parameters"]\
-width 30 -anchor w -font $fontNormal
entry $frm_35.txtColorParam -background $editor(bg)
button $frm_35.btnColorParam -borderwidth {1} -font $fontNormal \
-command {ColorSelect $editFrm.frmColorParam.txtColorParam $editFrm.frmColorParam.btnColorParam} \
-text "Select color"\
-image [Bitmap::get [file join $imgDir color_selector.gif]]
pack $frm_35.lblColorParam -side left
pack $frm_35.txtColorParam -side left -fill x -expand true
pack $frm_35.btnColorParam -side left
set frm_36 [frame $editFrm.frmColorSubParam -bg $editor(bg)]
label $frm_36.lblColorSubParam -text [::msgcat::mc "Subparameters"]\
-width 30 -anchor w -font $fontNormal
entry $frm_36.txtColorSubParam -background $editor(bg)
button $frm_36.btnColorSubParam -borderwidth {1} -font $fontNormal \
-command {ColorSelect $editFrm.frmColorSubParam.txtColorSubParam $editFrm.frmColorSubParam.btnColorSubParam} \
-text "Select color"\
-image [Bitmap::get [file join $imgDir color_selector.gif]]
pack $frm_36.lblColorSubParam -side left
pack $frm_36.txtColorSubParam -side left -fill x -expand true
pack $frm_36.btnColorSubParam -side left
set frm_18 [frame $editFrm.frmColorComments -bg $editor(bg)]
label $frm_18.lblColorComments -text [::msgcat::mc "Comments"]\
-width 30 -anchor w -font $fontNormal
entry $frm_18.txtColorComments -background $editor(bg)
button $frm_18.btnColorComments -borderwidth {1} -font $fontNormal \
-command {ColorSelect $editFrm.frmColorComments.txtColorComments $editFrm.frmColorComments.btnColorComments} \
-text "Select color"\
-image [Bitmap::get [file join $imgDir color_selector.gif]]
pack $frm_18.lblColorComments -side left
pack $frm_18.txtColorComments -side left -fill x -expand true
pack $frm_18.btnColorComments -side left
set frm_19 [frame $editFrm.frmColorVar -bg $editor(bg)]
label $frm_19.lblColorVar -text [::msgcat::mc "Variables"]\
-width 30 -anchor w -font $fontNormal
entry $frm_19.txtColorVar -background $editor(bg)
button $frm_19.btnColorVar -borderwidth {1} -font $fontNormal \
-command {ColorSelect $editFrm.frmColorVar.txtColorVar $editFrm.frmColorVar.btnColorVar} \
-text "Select color"\
-image [Bitmap::get [file join $imgDir color_selector.gif]]
pack $frm_19.lblColorVar -side left
pack $frm_19.txtColorVar -side left -fill x -expand true
pack $frm_19.btnColorVar -side left
set frm_20 [frame $editFrm.frmColorString -bg $editor(bg)]
label $frm_20.lblColorString -text [::msgcat::mc "Quote string"]\
-width 30 -anchor w -font $fontNormal
entry $frm_20.txtColorString -background $editor(bg)
button $frm_20.btnColorString -borderwidth {1} -font $fontNormal \
-command {ColorSelect $editFrm.frmColorString.txtColorString $editFrm.frmColorString.btnColorString} \
-text "Select color"\
-image [Bitmap::get [file join $imgDir color_selector.gif]]
pack $frm_20.lblColorString -side left
pack $frm_20.txtColorString -side left -fill x -expand true
pack $frm_20.btnColorString -side left
set frm_23 [frame $editFrm.frmColorBrace -bg $editor(bg)]
label $frm_23.lblColorBrace -text [::msgcat::mc "Braces"]\
-width 30 -anchor w -font $fontNormal
entry $frm_23.txtColorBrace -background $editor(bg)
button $frm_23.btnColorBrace -borderwidth {1} -font $fontNormal \
-command {ColorSelect $editFrm.frmColorBrace.txtColorBrace $editFrm.frmColorBrace.btnColorBrace} \
-text "Select color"\
-image [Bitmap::get [file join $imgDir color_selector.gif]]
pack $frm_23.lblColorBrace -side left
pack $frm_23.txtColorBrace -side left -fill x -expand true
pack $frm_23.btnColorBrace -side left
set frm_24 [frame $editFrm.frmColorBraceBG -bg $editor(bg)]
label $frm_24.lblColorBraceBG -text [::msgcat::mc "Braces background"]\
-width 30 -anchor w -font $fontNormal
entry $frm_24.txtColorBraceBG -background $editor(bg)
button $frm_24.btnColorBraceBG -borderwidth {1} -font $fontNormal \
-command {
ColorSelect $editFrm.frmColorBraceBG.txtColorBraceBG $editFrm.frmColorBraceBG.btnColorBraceBG
$editFrm.frmColorBraceFG.txtColorBraceFG configure -background [Text $editFrm.frmColorBraceBG.txtColorBraceBG]
} \
-text "Select color"\
-image [Bitmap::get [file join $imgDir color_selector.gif]]
pack $frm_24.lblColorBraceBG -side left
pack $frm_24.txtColorBraceBG -side left -fill x -expand true
pack $frm_24.btnColorBraceBG -side left
set frm_25 [frame $editFrm.frmColorBraceFG -bg $editor(bg)]
label $frm_25.lblColorBraceFG -text [::msgcat::mc "Braces foreground"]\
-width 30 -anchor w -font $fontNormal
entry $frm_25.txtColorBraceFG -background $color(braceBG)
button $frm_25.btnColorBraceFG -borderwidth {1} -font $fontNormal \
-command {ColorSelect $editFrm.frmColorBraceFG.txtColorBraceFG $editFrm.frmColorBraceFG.btnColorBraceFG} \
-text "Select color"\
-image [Bitmap::get [file join $imgDir color_selector.gif]]
pack $frm_25.lblColorBraceFG -side left
pack $frm_25.txtColorBraceFG -side left -fill x -expand true
pack $frm_25.btnColorBraceFG -side left
set frm_26 [frame $editFrm.frmColorPercent -bg $editor(bg)]
label $frm_26.lblColorPercent -text [::msgcat::mc "Percent \%"]\
-width 30 -anchor w -font $fontNormal
entry $frm_26.txtColorPercent -background $editor(bg)
button $frm_26.btnColorPercent -borderwidth {1} -font $fontNormal \
-command {ColorSelect $editFrm.frmColorPercent.txtColorPercent $editFrm.frmColorPercent.btnColorPercent} \
-text "Select color"\
-image [Bitmap::get [file join $imgDir color_selector.gif]]
pack $frm_26.lblColorPercent -side left
pack $frm_26.txtColorPercent -side left -fill x -expand true
pack $frm_26.btnColorPercent -side left
set frm_27 [frame $editFrm.frmColorBindKey -bg $editor(bg)]
label $frm_27.lblColorBindKey -text [::msgcat::mc "Key bindings <Key>"]\
-width 30 -anchor w -font $fontNormal
entry $frm_27.txtColorBindKey -background $editor(bg)
button $frm_27.btnColorBindKey -borderwidth {1} -font $fontNormal \
-command {ColorSelect $editFrm.frmColorBindKey.txtColorBindKey $editFrm.frmColorBindKey.btnColorBindKey} \
-text "Select color"\
-image [Bitmap::get [file join $imgDir color_selector.gif]]
pack $frm_27.lblColorBindKey -side left
pack $frm_27.txtColorBindKey -side left -fill x -expand true
pack $frm_27.btnColorBindKey -side left
set frm_32 [frame $editFrm.frmColorSelectBG -bg $editor(bg)]
label $frm_32.lblColorSelectBG -text [::msgcat::mc "Selection color"]\
-width 30 -anchor w -font $fontNormal
entry $frm_32.txtColorSelectBG -background $editor(bg)
button $frm_32.btnColorSelectBG -borderwidth {1} -font $fontNormal \
-command {ColorSelect $editFrm.frmColorSelectBG.txtColorSelectBG $editFrm.frmColorSelectBG.btnColorSelectBG} \
-text "Select color"\
-image [Bitmap::get [file join $imgDir color_selector.gif]]
pack $frm_32.lblColorSelectBG -side left
pack $frm_32.txtColorSelectBG -side left -fill x -expand true
pack $frm_32.btnColorSelectBG -side left
set frm_33 [frame $editFrm.frmColorNbNormal -bg $editor(bg)]
label $frm_33.lblColorNbNormal -text [::msgcat::mc "Title normal"]\
-width 30 -anchor w -font $fontNormal
entry $frm_33.txtColorNbNormal -background $editor(bg)
button $frm_33.btnColorNbNormal -borderwidth {1} -font $fontNormal \
-command {ColorSelect $editFrm.frmColorNbNormal.txtColorNbNormal $editFrm.frmColorNbNormal.btnColorNbNormal} \
-text "Select color"\
-image [Bitmap::get [file join $imgDir color_selector.gif]]
pack $frm_33.lblColorNbNormal -side left
pack $frm_33.txtColorNbNormal -side left -fill x -expand true
pack $frm_33.btnColorNbNormal -side left
set frm_34 [frame $editFrm.frmColorNbModify -bg $editor(bg)]
label $frm_34.lblColorNbModify -text [::msgcat::mc "Title modify"]\
-width 30 -anchor w -font $fontNormal
entry $frm_34.txtColorNbModify -background $editor(bg)
button $frm_34.btnColorNbModify -borderwidth {1} -font $fontNormal \
-command {ColorSelect $editFrm.frmColorNbModify.txtColorNbModify $editFrm.frmColorNbModify.btnColorNbModify} \
-text "Select color"\
-image [Bitmap::get [file join $imgDir color_selector.gif]]
pack $frm_34.lblColorNbModify -side left
pack $frm_34.txtColorNbModify -side left -fill x -expand true
pack $frm_34.btnColorNbModify -side left
set frm_37 [frame $editFrm.frmColorLabel -bg $editor(bg)]
label $frm_37.lblColorLabel -text [::msgcat::mc "Label"]\
-width 30 -anchor w -font $fontNormal
entry $frm_37.txtColorLabel -background $editor(bg)
button $frm_37.btnColorLabel -borderwidth {1} -font $fontNormal \
-command {ColorSelect $editFrm.frmColorLabel.txtColorLabel $editFrm.frmColorLabel.btnColorLabel} \
-text "Select color"\
-image [Bitmap::get [file join $imgDir color_selector.gif]]
pack $frm_37.lblColorLabel -side left
pack $frm_37.txtColorLabel -side left -fill x -expand true
pack $frm_37.btnColorLabel -side left
set frm_38 [frame $editFrm.frmColorSixFG -bg $editor(bg)]
label $frm_38.lblColorSixFG -text [::msgcat::mc "Six pos. foreground"]\
-width 30 -anchor w -font $fontNormal
entry $frm_38.txtColorSixFG -background $editor(bg)
button $frm_38.btnColorSixFG -borderwidth {1} -font $fontNormal \
-command {ColorSelect $editFrm.frmColorSixFG.txtColorSixFG $editFrm.frmColorSixFG.btnColorSixFG} \
-text "Select color"\
-image [Bitmap::get [file join $imgDir color_selector.gif]]
pack $frm_38.lblColorSixFG -side left
pack $frm_38.txtColorSixFG -side left -fill x -expand true
pack $frm_38.btnColorSixFG -side left
set frm_39 [frame $editFrm.frmColorSixBG -bg $editor(bg)]
label $frm_39.lblColorSixBG -text [::msgcat::mc "Six pos. background"]\
-width 30 -anchor w -font $fontNormal
entry $frm_39.txtColorSixBG -background $editor(bg)
button $frm_39.btnColorSixBG -borderwidth {1} -font $fontNormal \
-command {ColorSelect $editFrm.frmColorSixBG.txtColorSixBG $editFrm.frmColorSixBG.btnColorSixBG} \
-text "Select color"\
-image [Bitmap::get [file join $imgDir color_selector.gif]]
pack $frm_39.lblColorSixBG -side left
pack $frm_39.txtColorSixBG -side left -fill x -expand true
pack $frm_39.btnColorSixBG -side left
set frm_40 [frame $editFrm.frmColorSQL -bg $editor(bg)]
label $frm_40.lblColorSQL -text [::msgcat::mc "SQL commands"]\
-width 30 -anchor w -font $fontNormal
entry $frm_40.txtColorSQL -background $editor(bg)
button $frm_40.btnColorSQL -borderwidth {1} -font $fontNormal \
-command {ColorSelect $editFrm.frmColorSQL.txtColorSQL $editFrm.frmColorSQL.btnColorSQL} \
-text "Select color"\
-image [Bitmap::get [file join $imgDir color_selector.gif]]
pack $frm_40.lblColorSQL -side left
pack $frm_40.txtColorSQL -side left -fill x -expand true
pack $frm_40.btnColorSQL -side left
set frm_41 [frame $editFrm.frmColorBraceQuad -bg $editor(bg)]
label $frm_41.lblColorBraceQuad -text [::msgcat::mc "Quad braces"]\
-width 30 -anchor w -font $fontNormal
entry $frm_41.txtColorBraceQuad -background $editor(bg)
button $frm_41.btnColorBraceQuad -borderwidth {1} -font $fontNormal \
-command {ColorSelect $editFrm.frmColorBraceQuad.txtColorBraceQuad $editFrm.frmColorBraceQuad.txtColorBraceQuad} \
-text "Select color"\
-image [Bitmap::get [file join $imgDir color_selector.gif]]
pack $frm_41.lblColorBraceQuad -side left
pack $frm_41.txtColorBraceQuad -side left -fill x -expand true
pack $frm_41.btnColorBraceQuad -side left
pack $frm_13 $frm_14 $frm_15 $frm_28 $frm_21 $frm_22 $frm_32 $frm_33 $frm_34 $frm_16 $frm_17 $frm_35 $frm_36 $frm_18 $frm_19 $frm_20\
$frm_23 $frm_41 $frm_24 $frm_25 $frm_26 $frm_27 $frm_37 $frm_38 $frm_39 $frm_40 -side top -fill x -expand true
################### NETWORK PREF #########################
set network [$nb insert end network -text "[::msgcat::mc "Network"]" -state disabled]
set scrwin [ScrolledWindow $network.scrwin -relief groove -bd 2]
set scrfrm [ScrollableFrame $network.frm]
pack $scrwin -fill both -expand true
pack $scrfrm -fill both -expand true
$scrwin setwidget $scrfrm
set network [$scrfrm getframe]
set frm_29 [frame $network.frmFtpServer]
label $frm_29.lblFtpServer -text [::msgcat::mc "FTP server"] -width 30\
-anchor w -font $fontNormal
entry $frm_29.txtFtpServer
pack $frm_29.lblFtpServer -side left
pack $frm_29.txtFtpServer -side left -fill x -expand true
set frm_30 [frame $network.frmFtpUser]
label $frm_30.lblFtpUser -text [::msgcat::mc "FTP user"] -width 30\
-anchor w -font $fontNormal
entry $frm_30.txtFtpUser
pack $frm_30.lblFtpUser -side left
pack $frm_30.txtFtpUser -side left -fill x -expand true
set frm_31 [frame $network.frmFtpUserPass]
label $frm_31.lblFtpUserPass -text [::msgcat::mc "FTP password"] -width 30\
-anchor w -font $fontNormal
entry $frm_31.txtFtpUserPass
pack $frm_31.lblFtpUserPass -side left
pack $frm_31.txtFtpUserPass -side left -fill x -expand true
pack $frm_29 $frm_30 $frm_31 -side top -fill x
$nb raise main
# Read a config file #
LoadSettings
}
proc ColorSelect {ent w} {
set color [SelectColor::menu $w.color [list below $w] -color [$w cget -background]]
if {[string length $color]} {
$ent configure -foreground $color
InsertEnt $ent $color
}
}
## SHOW SELECTED COLOR IN DIALOG ##
proc ConfigureEnt {col} {
global editor color
global main editFrm network
$editFrm.frmColorEditFG.txtColorEditFG configure -background $col
$editFrm.frmColorProc.txtColorProc configure -background $col -fg $color(procName)
$editFrm.frmColorKeyWord.txtColorKeyWord configure -background $col -fg $color(keyWord)
$editFrm.frmColorParam.txtColorParam configure -background $col -fg $color(param)
$editFrm.frmColorSubParam.txtColorSubParam configure -background $col -fg $color(subParam)
$editFrm.frmColorComments.txtColorComments configure -background $col -fg $color(comments)
$editFrm.frmColorVar.txtColorVar configure -background $col -fg $color(var)
$editFrm.frmColorString.txtColorString configure -background $col -fg $color(string)
$editFrm.frmColorBrace.txtColorBrace configure -background $col -fg $color(brace)
$editFrm.frmColorBraceQuad.txtColorBraceQuad configure -background $col -fg $color(bracequad)
$editFrm.frmColorBraceBG.txtColorBraceBG configure -background $col -fg $color(braceBG)
$editFrm.frmColorBraceFG.txtColorBraceFG configure -background $col -fg $color(braceFG)
$editFrm.frmColorPercent.txtColorPercent configure -background $col -fg $color(percent)
$editFrm.frmColorBindKey.txtColorBindKey configure -background $col -fg $color(bindKey)
$editFrm.frmColorLabel.txtColorLabel configure -background $col -fg $color(label)
$editFrm.frmColorSixFG.txtColorSixFG configure -background $col -fg $color(sixFG)
$editFrm.frmColorSixBG.txtColorSixBG configure -background $col -fg $color(sixBG)
$editFrm.frmColorSQL.txtColorSQL configure -background $col -fg $color(sql)
}
## READ CONFIG FILE ##
proc LoadSettings {} {
global fontNormal imgDir workDir msgDir
global editor color nb
global main editFrm network
global toolBar autoFormat backUpDel backUpCreate backUpShow localeSet localeList wrapSet wrapList
## load .conf file ##
set file [open [file join $workDir projman.conf] r]
while {[gets $file line]>=0} {
scan $line "%s%s%s" trash keyWord var
if {$trash == "set"} {
set var [string trim $var "\""]
switch $keyWord {
fontNormal {
set v [string trim [string range $line [string first $var $line] end] "\""]
InsertEnt $main.frmFontNormal.txtFontNormal "$v"
}
fontBold {
set v [string trim [string range $line [string first $var $line] end] "\""]
InsertEnt $main.frmFontBold.txtFontBold "$v"
}
locale {
set localeIndex [lsearch -exact $localeList "$var"]
if {$localeIndex != -1} {
$main.frmLocale.txtLocale setvalue @$localeIndex
} else {
puts "$var.msg file not found into $msgDir"
}
}
toolBar {if {$var == "Yes"} {set toolBar "true" } else {set toolBar "false"} }
backUpFileShow {
if {$var == "Yes"} {
set backUpShow "true"
} else {
set backUpShow "false"
}
}
backUpFileCreate {
if {$var == "Yes"} {
set backUpCreate "true"
} else {
set backUpCreate "false"
}
}
backUpFileDel {
if {$var == "Yes"} {
set backUpDel "true"
} else {
set backUpDel "false"
}
}
projDir {InsertEnt $main.frmProjDir.txtProjDir "$var"}
rpmDir {InsertEnt $main.frmRpmDir.txtRpmDir "$var"}
tgzDir {InsertEnt $main.frmTgzDir.txtTgzDir "$var"}
rpmNamed {InsertEnt $main.frmRpmNamed.txtRpmNamed "$var"}
tgzNamed {InsertEnt $main.frmTgzNamed.txtTgzNamed "$var"}
autoFormat {if {$var == "Yes"} {set autoFormat "true"} else {set autoFormat "false"}}
"editor(wrap)" {
set wrapIndex [lsearch -exact $wrapList "$var"]
if {$wrapIndex != -1} {
$editFrm.frmWrap.txtWrap setvalue @$wrapIndex
}
unset wrapIndex
}
"editor(bg)" {
InsertEnt $editFrm.frmColorEditBG.txtColorEditBG "$var"
ConfigureEnt $var
}
"editor(fg)" {InsertEnt $editFrm.frmColorEditFG.txtColorEditFG "$var"}
"editor(selectbg)" {InsertEnt $editFrm.frmColorSelectBG.txtColorSelectBG "$var"}
"editor(nbNormal)" {InsertEnt $editFrm.frmColorNbNormal.txtColorNbNormal "$var"}
"editor(nbModify)" {InsertEnt $editFrm.frmColorNbModify.txtColorNbModify "$var"}
"color(procName)" {InsertEnt $editFrm.frmColorProc.txtColorProc "$var"}
"color(keyWord)" {InsertEnt $editFrm.frmColorKeyWord.txtColorKeyWord "$var"}
"color(param)" {InsertEnt $editFrm.frmColorParam.txtColorParam "$var"}
"color(subParam)" {InsertEnt $editFrm.frmColorSubParam.txtColorSubParam "$var"}
"color(comments)" {InsertEnt $editFrm.frmColorComments.txtColorComments "$var"}
"color(var)" {InsertEnt $editFrm.frmColorVar.txtColorVar "$var"}
"color(string)" {InsertEnt $editFrm.frmColorString.txtColorString "$var"}
"color(brace)" {InsertEnt $editFrm.frmColorBrace.txtColorBrace "$var"}
"color(bracequad)" {InsertEnt $editFrm.frmColorBraceQuad.txtColorBraceQuad "$var"}
"color(braceBG)" {InsertEnt $editFrm.frmColorBraceBG.txtColorBraceBG "$var"}
"color(braceFG)" {InsertEnt $editFrm.frmColorBraceFG.txtColorBraceFG "$var"}
"color(percent)" {InsertEnt $editFrm.frmColorPercent.txtColorPercent "$var"}
"color(bindKey)" {InsertEnt $editFrm.frmColorBindKey.txtColorBindKey "$var"}
"color(label)" {InsertEnt $editFrm.frmColorLabel.txtColorLabel "$var"}
"color(sixFG)" {InsertEnt $editFrm.frmColorSixFG.txtColorSixFG "$var"}
"color(sixBG)" {InsertEnt $editFrm.frmColorSixBG.txtColorSixBG "$var"}
"color(sql)" {InsertEnt $editFrm.frmColorSQL.txtColorSQL "$var"}
}
if {$keyWord == "editor(fontBold)"} {
set v [string trim [string range $line [string first $var $line] end] "\""]
InsertEnt $editFrm.frmEditorFontBold.txtEditorFontBold "$v"
}
if {$keyWord == "editor(font)"} {
set v [string trim [string range $line [string first $var $line] end] "\""]
InsertEnt $editFrm.frmEditorFont.txtEditorFont "$v"
}
}
}
close $file
}
## SAVE SETTINGS PROCEDURE ##
proc SaveSettings {} {
global editor color workDir
global main editFrm network wrapSet
file copy -force [file join $workDir projman.conf] [file join $workDir projman.conf.old]
set file [open [file join $workDir projman.conf] w]
puts $file "###########################################################"
puts $file "# TCL/Tk Project Manager #"
puts $file "# version $ver #"
puts $file "# #"
puts $file "# Copyright \(c\) \"Sergey Kalinin\", 2001, http://nuk-svk.ru #"
puts $file "# Authors: Sergey Kalinin \(aka BanZaj\) banzaj28@yandex.ru #"
puts $file "###########################################################\n"
puts $file "# Modification date: [exec date]"
puts $file "###########################################################\n"
puts $file "# Normal Font"
puts $file "set fontNormal \"[$main.frmFontNormal.txtFontNormal get]\""
puts $file "# Bold Font #"
puts $file "set fontBold \"[$main.frmFontBold.txtFontBold get]\""
puts $file "# ToolBar on/off \(Yes/No\)"
if {$toolBar == "false"} {
puts $file "set toolBar \"No\"\n"
} else {
puts $file "set toolBar \"Yes\"\n"
}
if {$backUpShow == "false"} {
puts $file "set backUpFileShow \"No\""
} else {
puts $file "set backUpFileShow \"Yes\""
}
if {$backUpCreate == "false"} {
puts $file "set backUpFileCreate \"No\""
} else {
puts $file "set backUpFileCreate \"Yes\""
}
if {$backUpDel == "false"} {
puts $file "set backUpFileDelete \"No\""
} else {
puts $file "set backUpFileDelete \"Yes\""
}
puts $file "\n# Don't edit this line"
puts $file "# Directorys Settings #"
puts $file "set projDir \"[$main.frmProjDir.txtProjDir get]\""
puts $file "set rpmDir \"[$main.frmRpmDir.txtRpmDir get]\""
puts $file "set tgzDir \"[$main.frmTgzDir.txtTgzDir get]\""
puts $file "# File mask #"
puts $file "set rpmNamed \"[$main.frmRpmNamed.txtRpmNamed get]\""
puts $file "set tgzNamed \"[$main.frmTgzNamed.txtTgzNamed get]\""
puts $file "\n# Locale setting\nset locale \"$localeSet\""
if {$autoFormat == "false"} {
puts $file "set autoFormat \"No\"\n"
} else {
puts $file "set autoFormat \"Yes\"\n"
}
puts $file "# Editor Font #"
puts $file "set editor(font) \"[$frm_17.txtEditorFont get]\""
puts $file "# Editor Bold Font #"
puts $file "set editor(fontBold) \"[$frm_18.txtEditorFontBold get]\""
puts $file "# background color #"
puts $file "set editor(bg) \"[$editFrm.frmColorEditBG.txtColorEditBG get]\""
puts $file "# foreground color #"
puts $file "set editor(fg) \"[$editFrm.frmColorEditFG.txtColorEditFG get]\""
puts $file "# selection background color #"
puts $file "set editor(selectbg) \"[$editFrm.frmColorSelectBG.txtColorSelectBG get]\""
puts $file "# NoteBook title normal font color #"
puts $file "set editor(nbNormal) \"[$editFrm.frmColorNbNormal.txtColorNbNormal get]\""
puts $file "# NoteBook title modify font color #"
puts $file "set editor(nbModify) \"[$editFrm.frmColorNbModify.txtColorNbModify get]\""
puts $file "# selection border width #"
puts $file "set editor(selectBorder) \"0\""
puts $file "# Editor wraping #"
puts $file "# must be: none, word or char"
puts $file "set editor(wrap) \"$wrapSet\""
puts $file "## SOURCE CODE HIGHLIGTNING ##"
puts $file "set color(procName) \"[$editFrm.frmColorProc.txtColorProc get]\""
puts $file "set color(keyWord) \"[$editFrm.frmColorKeyWord.txtColorKeyWord get]\""
puts $file "set color(param) \"[$editFrm.frmColorComments.txtColorComments get]\""
puts $file "set color(subParam) \"[ get]\""
puts $file "set color(comments) \"[ get]\""
puts $file "set color(var) \"[$editFrm.frmColorVar.txtColorVar get]\""
puts $file "set color(string) \"[$editFrm.frmColorString.txtColorString get]\""
puts $file "set color(brace) \"[$editFrm.frmColorBrace.txtColorBrace get]\""
puts $file "set color(bracequad) \"[$editFrm.frmColorBraceQuad.txtColorBraceQuad get]\""
puts $file "set color(braceBG) \"[$editFrm.frmColorBraceBG.txtColorBraceBG get]\""
puts $file "set color(braceFG) \"[$editFrm.frmColorBraceFG.txtColorBraceFG get]\""
puts $file "set color(percent) \"[$editFrm.frmColorPercent.txtColorPercent get]\""
puts $file "set color(bindKey) \"[$editFrm.frmColorBindKey.txtColorBindKey get]\""
puts $file "set color(label) \"[$editFrm.frmColorLabel.txtColorLabel get]\""
puts $file "set color(sixFG) \"[$editFrm.frmColorSixFG.txtColorSixFG get]\""
puts $file "set color(sixBG) \"[$editFrm.frmColorSixBG.txtColorSixBG get]\""
puts $file "set color(sql) \"[$editFrm.frmColorSQL.txtColorSQL get]\""
close $file
$noteBook delete settings
$noteBook raise [$noteBook page end]
}

View File

@ -1,387 +0,0 @@
# supertext.tcl v1.01
#
# Copyright (c) 1998 Bryan Oakley
# All Rights Reserved
#
# this code is freely distributable, but is provided as-is with
# no waranty expressed or implied.
# send comments to oakley@channelpoint.com
# What is this?
#
# This is a replacement for (or superset of , or subclass of, ...)
# the tk text widget. Its big feature is that it supports unlimited
# undo. It also has two poorly documented options: -preproc and
# -postproc.
# The entry point to this widget is supertext::text; it takes all of
# the same arguments as the standard text widget and exhibits all of
# the same behaviors. The proc supertext::overrideTextCommand may be
# called to have the supertext widget be used whenever the command
# "text" is used (ie: it imports supertext::text as the command "text").
# Use at your own risk...
# To access the undo feature, use ".widget undo". It will undo the
# most recent insertion or deletion. On windows and the mac
# this command is bound to <Control-z>; on unix it is bound to
# <Control-_>
# if you are lucky, you might find documentation here:
# http://www1.clearlight.com/~oakley/tcl/supertext.html
package provide supertext 1.01
namespace eval supertext {
variable undo
variable undoIndex
variable text "::text"
variable preProc
variable postProc
namespace export text
}
# this proc is probably attempting to be more clever than it should...
# When called, it will (*gasp*) rename the tk command "text" to "_text_",
# then import our text command into the global scope.
#
# Use at your own risk!
proc supertext::overrideTextCommand {} {
variable text
set text "::_text_"
rename ::text $text
uplevel #0 namespace import supertext::text
}
proc supertext::text {w args} {
variable text
variable undo
variable undoIndex
variable preProc
variable postProc
# this is what we will rename our widget proc to...
set original __$w
# do we have any of our custom options? If so, process them and
# strip them out before sending them to the real text command
if {[set i [lsearch -exact $args "-preproc"]] >= 0} {
set j [expr $i + 1]
set preProc($original) [lindex $args $j]
set args [lreplace $args $i $j]
} else {
set preProc($original) {}
}
if {[set i [lsearch -exact $args "-postproc"]] >= 0} {
set j [expr $i + 1]
set postProc($original) [lindex $args $j]
set args [lreplace $args $i $j]
} else {
set postProc($original) {}
}
# let the text command create the widget...
eval $text $w $args
# now, rename the resultant widget proc so we can create our own
rename ::$w $original
# here's where we create our own widget proc.
proc ::$w {command args} \
"namespace eval supertext widgetproc $w $original \$command \$args"
# set up platform-specific binding for undo; the only one I'm
# really sure about is winders; the rest will stay the same for
# now until someone has a better suggestion...
switch $::tcl_platform(platform) {
unix {
event add <<Undo>> <Control-z>
event add <<Undo>> <Control-Z>
}
windows {
event add <<Undo>> <Control-z>
event add <<Undo>> <Control-Z>
}
macintosh {
event add <<Undo>> <Control-z>
event add <<Undo>> <Control-Z>
}
}
bind $w <<Undo>> "$w undo"
set undo($original) {}
set undoIndex($original) -1
set clones($original) {}
return $w
}
# this is the command that we associate with a supertext widget.
proc supertext::widgetproc {this w command args} {
variable undo
variable undoIndex
variable preProc
variable postProc
# these will be the arguments to the pre and post procs
set originalCommand $command
set originalArgs $args
# is there a pre-proc? If so, run it. If there is a problem,
# die. This is potentially bad, because once there is a problem
# in a preproc the user must fix the preproc -- there is no
# way to unconfigure the preproc. Oh well. The other choice
# is to ignore errors, but then how will the caller know if
# the proc fails?
if {[info exists preProc($w)] && $preProc($w) != ""} {
if {[catch "$preProc($w) command args" error]} {
return -code error "error during processing of -preproc: $error"
}
}
# if the command is "undo", we need to morph it into the appropriate
# command for undoing the last item on the stack
if {$command == "undo"} {
if {$undoIndex($w) == ""} {
# ie: last command was anything _but_ an undo...
set undoIndex($w) [expr [llength $undo($w)] -1]
}
# if the index is pointing to a valid list element,
# lets undo it...
if {$undoIndex($w) < 0} {
# nothing to undo...
bell
} else {
# data is a list comprised of a command token
# (i=insert, d=delete) and parameters related
# to that token
set data [lindex $undo($w) $undoIndex($w)]
if {[lindex $data 0] == "d"} {
set command "delete"
} else {
set command "insert"
}
set args [lrange $data 1 end]
# adjust the index
incr undoIndex($w) -1
}
}
# now, process the command (either the original one, or the morphed
# undo command
switch $command {
reset_undo {
set undo($w) ""
set undoIndex($w) ""
set result {}
}
configure {
# we have to deal with configure specially, since the
# user could try to configure the -preproc or -postproc
# options...
if {[llength $args] == 0} {
# first, the case where they just type "configure"; lets
# get it out of the way
set list [$w configure]
lappend list [list -preproc preproc Preproc {} $preProc($w)]
lappend list [list -postproc postproc Postproc {} $postProc($w)]
set result $list
} elseif {[llength $args] == 1} {
# this means they are wanting specific configuration
# information
set option [lindex $args 0]
if {$option == "-preproc"} {
set result [list -preproc preproc Preproc {} $preProc($w)]
} elseif {$option == "-postproc"} {
set result [list -postproc postproc Postproc {} $postProc($w)]
} else {
if {[catch "$w $command $args" result]} {
regsub $w $result $this result
return -code error $result
}
}
} else {
# ok, the user is actually configuring something...
# we'll deal with our special options first
if {[set i [lsearch -exact $args "-preproc"]] >= 0} {
set j [expr $i + 1]
set preProc($w) [lindex $args $j]
set args [lreplace $args $i $j]
set result {}
}
if {[set i [lsearch -exact $args "-postproc"]] >= 0} {
set j [expr $i + 1]
set postProc($w) [lindex $args $j]
set args [lreplace $args $i $j]
set result {}
}
# now, process any remaining args
if {[llength $args] > 0} {
if {[catch "$w $command $args" result]} {
regsub $w $result $this result
return -code error $result
}
}
}
}
undo {
# if an undo command makes it to here, that means there
# wasn't anything to undo; this effectively becomes a
# no-op
set result {}
}
insert {
if {[catch {set index [text_index $w [lindex $args 0]]}]} {
set index [lindex $args 0]
}
# since the insert command can have an arbitrary number
# of strings and possibly tags, we need to ferret that out
# now... what a pain!
set myargs [lrange $args 1 end]
set length 0
while {[llength $myargs] > 0} {
incr length [string length [lindex $myargs 0]]
if {[llength $myargs] > 1} {
# we have a tag...
set myargs [lrange $myargs 2 end]
} else {
set myargs [lrange $myargs 1 end]
}
}
# now, let the real widget command do the dirty work
# of inserting the text. If we fail, do some munging
# of the error message so the right widget name appears...
if {[catch "$w $command $args" result]} {
regsub $w $result $this result
return -code error $result
}
# we need this for the undo stack; index2 couldn't be
# computed until after we inserted the data...
set index2 [text_index $w "$index + $length chars"]
if {$originalCommand == "undo"} {
# let's do a "see" so what we just did is visible;
# also, we'll move the insertion cursor to the end
# of what we just did...
$w see $index2
$w mark set insert $index2
} else {
# since the original command wasn't undo, we need
# to reset the undoIndex. This means that the next
# time an undo is called for we'll start at the
# end of the stack
set undoIndex($w) ""
}
# add a delete command on the undo stack.
lappend undo($w) "d $index $index2"
}
delete {
# this converts the insertion index into an absolute address
set index [text_index $w [lindex $args 0]]
# lets get the data we are about to delete; we'll need
# it to be able to undo it (obviously. Duh.)
set data [eval $w get $args]
# add an insert on the undo stack
lappend undo($w) [list "i" $index $data]
if {$originalCommand == "undo"} {
# let's do a "see" so what we just did is visible;
# also, we'll move the insertion cursor to a suitable
# spot
$w see $index
$w mark set insert $index
} else {
# since the original command wasn't undo, we need
# to reset the undoIndex. This means that the next
# time an undo is called for we'll start at the
# end of the stack
set undoIndex($w) ""
}
# let the real widget command do the actual deletion. If
# we fail, do some munging of the error message so the right
# widget name appears...
if {[catch "$w $command $args" result]} {
regsub $w $result $this result
return -code error $result
}
}
default {
# if the command wasn't one of the special commands above,
# just pass it on to the real widget command as-is. If
# we fail, do some munging of the error message so the right
# widget name appears...
if {[catch "$w $command $args" result]} {
regsub $w $result $this result
return -code error $result
}
}
}
# is there a post-proc? If so, run it.
if {[info exists postProc($w)] && $postProc($w) != ""} {
if {[catch "$postProc($w) originalCommand originalArgs" error]} {
return -code error "error during processing of -postproc: $error"
}
}
# we're outta here! (I think this is faster than a
# return, though I'm not 100% sure on this...)
set result $result
}
# this returns a normalized index (ie: line.column), with special
# handling for the index "end"; to undo something we pretty much
# _have_ to have a precise row and column number.
proc supertext::text_index {w i} {
if {$i == "end"} {
set index [$w index "end-1c"]
} else {
set index [$w index $i]
}
return $index
}

View File

@ -1,56 +0,0 @@
#########################################################
# Tcl/Tk project Manager
# Distributed under GNU Public License
# Author: Sergey Kalinin banzaj28@yandex.ru
# Copyright (c) "Sergey Kalinin", 2002, http://nuk-svk.ru
#########################################################
proc GetTagList {tagFile} {
global tmpDir projDir workDir procList activeProject
if {[file exists $tagFile] == 0} {
return
}
set file [open $tagFile r]
set procList($activeProject) ""
while {[gets $file line]>=0} {
scan $line "%s%s" proc procFile
if {[regexp -nocase -all -- {\s\{.*?\}+\s} $line par]} {
if [info exists procList($activeProject)] {
lappend procList($activeProject) [list $proc $par $procFile]
} else {
set procList($activeProject) [list [list $proc $par $procFile]]
}
}
}
}
proc GetTagList_ {tagFile} {
global tmpDir projDir workDir procList activeProject
if {[file exists $tagFile] == 0} {
return
}
set projName [file rootname $tagFile]
set file [open $tagFile r]
set procList($projName) ""
while {[gets $file line]>=0} {
scan $line "%s%s" proc procFile
if {[regexp -nocase -all -- {\s\{.*?\}+\s} $line par]} {
if [info exists procList($projName)] {
lappend procList($projName) [list $proc $par $procFile]
} else {
set procList($projName) [list [list $proc $par $procFile]]
}
}
}
}