Modules load procedure changes
This commit is contained in:
Sergey Kalinin
parent
2206b153f3
commit
cc7bbf9a59
5
BUGS
5
BUGS
|
|
@ -15,10 +15,6 @@
|
|||
элемента в TreeView. Сделай это по умолчанию автоматом, плиз. И чтобы
|
||||
это также работало при команде refresh.
|
||||
|
||||
* Есть refresh для TreeView хорошо бы тогда чтобы он или другая
|
||||
функция обновляла syntax hightlight, а то когда большие куски
|
||||
ставляешь кода и он их не рассчвечивает неудобно.
|
||||
|
||||
* При вводе текста если ввести proc, то твой редактор подставит
|
||||
автоматом скобки. Вообще-то это не очень правильно, к примеру я
|
||||
ставлю после функции комментарий вида } ;# proc testFunct
|
||||
|
|
@ -35,3 +31,4 @@ balloon окне показать формат этой команды (такж
|
|||
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -6,6 +6,9 @@
|
|||
#########################################################
|
||||
|
||||
0.4.5
|
||||
05.02.2018
|
||||
- Added binding mouse button: click on notebook tab highlight opened file name in tree
|
||||
|
||||
04.02.2018
|
||||
- Fixed paste text highlight
|
||||
- Fixed setting edited flag when paste the text from buffer
|
||||
|
|
@ -373,5 +376,6 @@ Fixed bug with PageRise function
|
|||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -17,6 +17,8 @@ set fontNormal "helvetica 12 normal roman"
|
|||
package require msgcat
|
||||
package require BWidget
|
||||
|
||||
|
||||
|
||||
::msgcat::mclocale en
|
||||
::msgcat::mcload msgs
|
||||
|
||||
|
|
@ -394,3 +396,4 @@ proc SetVarLang {lang} {
|
|||
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
87
lib/baloon.tcl
Normal file
87
lib/baloon.tcl
Normal file
|
|
@ -0,0 +1,87 @@
|
|||
#######################################################################
|
||||
# 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
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
175
lib/completition.tcl
Normal file
175
lib/completition.tcl
Normal file
|
|
@ -0,0 +1,175 @@
|
|||
###########################################################
|
||||
# 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
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
1168
lib/editor.tcl
Normal file
1168
lib/editor.tcl
Normal file
File diff suppressed because it is too large
Load Diff
365
lib/help.tcl
Normal file
365
lib/help.tcl
Normal file
|
|
@ -0,0 +1,365 @@
|
|||
##!/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
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
219
lib/highlight/caml.tcl
Normal file
219
lib/highlight/caml.tcl
Normal file
|
|
@ -0,0 +1,219 @@
|
|||
###########################################################
|
||||
# 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
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
220
lib/highlight/erlang.tcl
Normal file
220
lib/highlight/erlang.tcl
Normal file
|
|
@ -0,0 +1,220 @@
|
|||
###########################################################
|
||||
# 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
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
214
lib/highlight/fortran.tcl
Normal file
214
lib/highlight/fortran.tcl
Normal file
|
|
@ -0,0 +1,214 @@
|
|||
###########################################################
|
||||
# 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
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
106
lib/highlight/html.tcl
Normal file
106
lib/highlight/html.tcl
Normal file
|
|
@ -0,0 +1,106 @@
|
|||
###########################################################
|
||||
# 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
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
215
lib/highlight/java.tcl
Normal file
215
lib/highlight/java.tcl
Normal file
|
|
@ -0,0 +1,215 @@
|
|||
###########################################################
|
||||
# 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
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
204
lib/highlight/perl.tcl
Normal file
204
lib/highlight/perl.tcl
Normal file
|
|
@ -0,0 +1,204 @@
|
|||
###########################################################
|
||||
# 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
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
270
lib/highlight/php.tcl
Normal file
270
lib/highlight/php.tcl
Normal file
|
|
@ -0,0 +1,270 @@
|
|||
###########################################################
|
||||
# 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
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
249
lib/highlight/rivet.tcl
Normal file
249
lib/highlight/rivet.tcl
Normal file
|
|
@ -0,0 +1,249 @@
|
|||
###########################################################
|
||||
# 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
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
189
lib/highlight/ruby.tcl
Normal file
189
lib/highlight/ruby.tcl
Normal file
|
|
@ -0,0 +1,189 @@
|
|||
###########################################################
|
||||
# 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
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
136
lib/highlight/spec.tcl
Normal file
136
lib/highlight/spec.tcl
Normal file
|
|
@ -0,0 +1,136 @@
|
|||
###########################################################
|
||||
# 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
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
227
lib/highlight/tcl.tcl
Normal file
227
lib/highlight/tcl.tcl
Normal file
|
|
@ -0,0 +1,227 @@
|
|||
###########################################
|
||||
# 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
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
1437
lib/html_lib.tcl
Normal file
1437
lib/html_lib.tcl
Normal file
File diff suppressed because it is too large
Load Diff
60
lib/imgviewer.tcl
Normal file
60
lib/imgviewer.tcl
Normal file
|
|
@ -0,0 +1,60 @@
|
|||
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]
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
384
lib/main.tcl
Normal file
384
lib/main.tcl
Normal file
|
|
@ -0,0 +1,384 @@
|
|||
###########################################################
|
||||
# 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 [$noteBook raise]"
|
||||
$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
lib/pane.tcl
Normal file
100
lib/pane.tcl
Normal file
|
|
@ -0,0 +1,100 @@
|
|||
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]
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
1081
lib/procedure.tcl
Normal file
1081
lib/procedure.tcl
Normal file
File diff suppressed because it is too large
Load Diff
908
lib/projects.tcl
Normal file
908
lib/projects.tcl
Normal file
|
|
@ -0,0 +1,908 @@
|
|||
#########################################################
|
||||
# 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
|
||||
}
|
||||
|
||||
|
||||
|
||||
867
lib/settings.tcl
Normal file
867
lib/settings.tcl
Normal file
|
|
@ -0,0 +1,867 @@
|
|||
######################################################
|
||||
# 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]
|
||||
}
|
||||
|
||||
|
||||
|
||||
387
lib/supertext.tcl
Normal file
387
lib/supertext.tcl
Normal file
|
|
@ -0,0 +1,387 @@
|
|||
# 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
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
56
lib/taglist.tcl
Normal file
56
lib/taglist.tcl
Normal file
|
|
@ -0,0 +1,56 @@
|
|||
#########################################################
|
||||
# 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]]
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
41
projman.tcl
41
projman.tcl
|
|
@ -19,11 +19,10 @@ set tclDir "/usr/bin"
|
|||
|
||||
##
|
||||
if {[file exists $env(HOME)/projects/tcl/projman]==1} {
|
||||
set dataDir "[file join $env(HOME) projects tcl projman]"
|
||||
set dataDir "[file join $env(HOME) projects tcl projman lib]"
|
||||
set docDir "[file join $env(HOME) projects tcl projman hlp ru]"
|
||||
set imgDir "[file join $env(HOME) projects tcl projman img]"
|
||||
set msgDir "[file join $env(HOME) projects tcl projman msgs]"
|
||||
set hlDir "[file join $env(HOME) projects tcl projman highlight]"
|
||||
set binDir "[file join $env(HOME) projects tcl projman]"
|
||||
} else {
|
||||
set binDir [file join $rootDir bin]
|
||||
|
|
@ -31,8 +30,9 @@ if {[file exists $env(HOME)/projects/tcl/projman]==1} {
|
|||
set docDir [file join $rootDir share doc projman-$ver]
|
||||
set imgDir [file join $dataDir img]
|
||||
set msgDir [file join $dataDir msgs]
|
||||
set hlDir [file join $dataDir highlight]
|
||||
}
|
||||
set hlDir [file join $dataDir highlight]
|
||||
|
||||
if {$tcl_platform(platform) == "unix"} {
|
||||
set tmpDir "$env(HOME)/tmp"
|
||||
set workDir "[file join $env(HOME) .projman]"
|
||||
|
|
@ -71,32 +71,24 @@ if [info exists env(LANG)] {
|
|||
|
||||
::msgcat::mclocale $locale
|
||||
::msgcat::mcload $msgDir
|
||||
#set mc_source [open [file join $msgDir $locale.msg] "r"]
|
||||
#set mc_source [encoding convertto koi8-r $mc_source]
|
||||
#set mc_source [encoding convertfrom [encoding system] $mc_source]
|
||||
|
||||
## LOAD FILE ##
|
||||
# Load modules but maain.tcl must last loaded
|
||||
foreach modFile [lsort [glob -nocomplain [file join $dataDir *.tcl]]] {
|
||||
if {[file tail $modFile] ne "main.tcl"} {
|
||||
source $modFile
|
||||
puts "Loaded module $modFile"
|
||||
}
|
||||
}
|
||||
# load code highlight modules
|
||||
foreach modFile [lsort [glob -nocomplain [file join $hlDir *.tcl]]] {
|
||||
source $modFile
|
||||
puts "Loaded highlight module $modFile"
|
||||
}
|
||||
|
||||
|
||||
source [file join $dataDir procedure.tcl]
|
||||
source [file join $dataDir supertext.tcl]
|
||||
source [file join $dataDir editor.tcl]
|
||||
source [file join $dataDir help.tcl]
|
||||
source [file join $dataDir settings.tcl]
|
||||
source [file join $dataDir baloon.tcl]
|
||||
source [file join $dataDir completition.tcl]
|
||||
source [file join $dataDir pane.tcl]
|
||||
source [file join $dataDir taglist.tcl]
|
||||
source [file join $dataDir projects.tcl]
|
||||
source [file join $dataDir imgviewer.tcl]
|
||||
source [file join $dataDir main.tcl]
|
||||
|
||||
|
||||
foreach file [lsort [glob -nocomplain [file join $hlDir *.tcl]]] {
|
||||
source $file
|
||||
puts "Loaded highlight module $file"
|
||||
}
|
||||
|
||||
#set editor(selectBorder) "0"
|
||||
|
||||
#option add *tree.foreground red widgetDefault
|
||||
|
|
@ -130,6 +122,3 @@ option add *Listbox.foreground $editor(fg) startupFile
|
|||
option add *Listbox.background $editor(bg) startupFile
|
||||
option add *Scrollbar.background $editor(bg) startupFile
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user