From 8cf4ded7858bb3d15870dbf5216686dc71173ca8 Mon Sep 17 00:00:00 2001 From: Sergey Kalinin Date: Mon, 5 Feb 2018 12:08:16 +0300 Subject: [PATCH] Added binding mouse button: click on notebook tab highlight opened file name in tree Change "Paste from Clipboard" function Change popup editor menu (undo, redo, copy, paste, cut functions) --- CHANGELOG | 4 + baloon.tcl | 87 --- completition.tcl | 175 ----- contributors.txt | 1 + editor.tcl | 1174 --------------------------------- help.tcl | 365 ----------- highlight/caml.tcl | 219 ------- highlight/erlang.tcl | 220 ------- highlight/fortran.tcl | 214 ------ highlight/html.tcl | 106 --- highlight/java.tcl | 215 ------ highlight/perl.tcl | 204 ------ highlight/php.tcl | 270 -------- highlight/rivet.tcl | 249 ------- highlight/ruby.tcl | 189 ------ highlight/spec.tcl | 136 ---- highlight/tcl.tcl | 227 ------- html_lib.tcl | 1437 ----------------------------------------- imgviewer.tcl | 60 -- install.tcl | 1 + lib/editor.tcl | 73 ++- lib/main.tcl | 25 +- lib/procedure.tcl | 19 - lib/projects.tcl | 14 +- main.tcl | 388 ----------- pane.tcl | 100 --- procedure.tcl | 1098 ------------------------------- projects.tcl | 908 -------------------------- projman.conf | 8 +- projman.tcl | 10 +- settings.tcl | 867 ------------------------- supertext.tcl | 387 ----------- taglist.tcl | 56 -- 33 files changed, 69 insertions(+), 9437 deletions(-) delete mode 100644 baloon.tcl delete mode 100644 completition.tcl delete mode 100644 editor.tcl delete mode 100644 help.tcl delete mode 100644 highlight/caml.tcl delete mode 100644 highlight/erlang.tcl delete mode 100644 highlight/fortran.tcl delete mode 100644 highlight/html.tcl delete mode 100644 highlight/java.tcl delete mode 100644 highlight/perl.tcl delete mode 100644 highlight/php.tcl delete mode 100644 highlight/rivet.tcl delete mode 100644 highlight/ruby.tcl delete mode 100644 highlight/spec.tcl delete mode 100644 highlight/tcl.tcl delete mode 100644 html_lib.tcl delete mode 100644 imgviewer.tcl delete mode 100644 main.tcl delete mode 100644 pane.tcl delete mode 100644 procedure.tcl delete mode 100644 projects.tcl delete mode 100644 settings.tcl delete mode 100644 supertext.tcl delete mode 100644 taglist.tcl diff --git a/CHANGELOG b/CHANGELOG index f660060..2554c75 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -8,6 +8,8 @@ 0.4.5 05.02.2018 - Added binding mouse button: click on notebook tab highlight opened file name in tree +- Change "Paste from Clipboard" function +- Change popup editor menu (undo, redo, copy, paste, cut functions) 04.02.2018 - Fixed paste text highlight @@ -376,6 +378,8 @@ Fixed bug with PageRise function + + diff --git a/baloon.tcl b/baloon.tcl deleted file mode 100644 index d56bef9..0000000 --- a/baloon.tcl +++ /dev/null @@ -1,87 +0,0 @@ -####################################################################### -# Baloon help -# Author: Alexander Dederer -# Usage: -# Set balloon tips to widget: -# balloon $widget set "Hello World" -# balloon [button .exit -text "exit" -command exit] set "Hello world" -# -# Clear ballon tips from widget: -# balloon $widget clear -# -# Show balloon tips on widget: -# balloon $widget show "Hello World" -####################################################################### - -proc balloon { widget action args } { - global BALLOON - - switch -- $action { - set { - if { $args != {{}} } { - balloon $widget clear - #bind $widget "after 1000 [list balloon %W show $args mousepointer %X %Y]" - #bind $widget "catch { destroy %W.balloon }" - bind $widget " balloon $widget show $args " - bind $widget " 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 "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 {} - bind $widget {} - } - } ;# 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 - - - - - - - - diff --git a/completition.tcl b/completition.tcl deleted file mode 100644 index d784ec2..0000000 --- a/completition.tcl +++ /dev/null @@ -1,175 +0,0 @@ -########################################################### -# Tcl/Tk Project Manager # -# Distrubuted under GPL # -# Copyright (c) "Sergey Kalinin", 2002, http://nuk-svk.ru # -# Author: Sergey Kalinin banzaj28@yandex.ru # -########################################################### -# AutoCompletition Procedure # -# Author Alex DEDERER # -########################################################### - -proc auto_completition { widget } { - set start_word [$widget get "insert - 1 chars wordstart" insert] - set box [$widget bbox insert] - set box_x [expr [lindex $box 0] + [winfo rootx $widget] ] - set box_y [expr [lindex $box 1] + [winfo rooty $widget] + [lindex $box 3] ] - set cnt 0 - set pos "1.0" - set last_pos "" - set pattern "$start_word\\w*" - set list_word($start_word) 1 - while { ([set start [$widget search -count cnt -regexp -- $pattern $pos end]] != "") } { - set word [$widget get $start "$start + $cnt chars"] - if { ![string equal $start_word $word] } { set list_word($word) 1 } - set pos [$widget index "$pos + [expr $cnt + 1] chars"] - if { [string equal $last_pos $pos] } { break } - set last_pos $pos - } ;# while - - bindtags $widget [list CompletitionBind [winfo toplevel $widget] $widget Text sysAfter all] - bind CompletitionBind "bindtags $widget {[list [winfo toplevel $widget] $widget Text sysAfter all]}; catch { destroy .aCompletition }" - bind CompletitionBind { 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 "bindtags $widget {[list [winfo toplevel $widget] $widget Text sysAfter all]}; catch { destroy .aCompletition }" - bind CompletitionBind {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 " destroy $win " - bind $win.lBox " 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 ] - } - default { - $widget insert "insert" $A - eval [bind CompletitionBind ] - } - } -} ;# proc auto_completition_key - - - - - - - - - - - - - - - - - - - - - diff --git a/contributors.txt b/contributors.txt index 406563b..0b688f0 100644 --- a/contributors.txt +++ b/contributors.txt @@ -1 +1,2 @@ Sergey Kalinin + diff --git a/editor.tcl b/editor.tcl deleted file mode 100644 index 36ad39a..0000000 --- a/editor.tcl +++ /dev/null @@ -1,1174 +0,0 @@ -########################################################### -# Tcl/Tk Project Manager # -# all procedure file # -# Copyright (c) "Sergey Kalinin", 2002, http://nuk-svk.ru # -# Author: Sergey Kalinin banzaj28@yandex.ru # -########################################################### - -## GETTING OPERATORS FOR COMPLITE PROCEDURE # -proc GetOp {} { - global opList - set opList(if) "\{\} \{\n\n\}" - set opList(else) "\{\n\n\}" - set opList(elseif) "\{\} \{\n\n\}" - set opList(for) "\{\} \{\} \{\} \{\n\n\}" - set opList(foreach) "\{\n\n\}" - set opList(while) "\{\} \{\n\n\}" - set opList(switch) "\{\n\n\}" - set opList(proc) "\{\} \{\n\n\}" - # for Object extention - set opList(method) "\{\} \{\n\n\}" - set opList(class) "\{\n\n\}" -} -## Alexander Dederer (aka Korwin) dederer-a@mail.ru ## -## SETTING DEFAULT STYLE FOR TEXT WIDGET ## -proc SetDefStyle { text args } { - global editor(font) editor(fontBold) - set a_args(-wrap) none - set a_args(-background) white - set a_args(-font) {$editor(font)} - array set a_args $args - - foreach { key value } [ array get a_args ] { - catch { $text configure $key $value } - } ;# foreach -} - -## CURSOR POSITION COUNTERED ## -proc Position {} { - global tree noteBook fontNormal fontBold replace - set nodeEdit [$noteBook raise] - if {$nodeEdit == "" || $nodeEdit == "newproj" || $nodeEdit == "debug" || $nodeEdit == "about"} { - return - } - set text "$noteBook.f$nodeEdit.text" - set pos [$text index insert] - set posY [lindex [split $pos "."] 0] - set posX [lindex [split $pos "."] 1] - set lbl .frmStatus.frmLine.lblLine - $lbl configure -text $pos -font $fontBold - return $pos -} -proc ReplaceChar {text} { - global replace - set pos [$text index insert] - set posY [lindex [split $pos "."] 0] - set posX [lindex [split $pos "."] 1] - if {$replace == 1} { - $text delete $posY.$posX $posY.[expr $posX + 1] - } -} -## OVERWRITE SYMBOL PROCEDURE ## -proc OverWrite {} { - global replace fontNormal - if {$replace == 1} { - set replace 0 - .frmStatus.frmOvwrt.lblOvwrt configure -text [::msgcat::mc "Insert"] -font $fontNormal\ - -foreground black - } else { - set replace 1 - .frmStatus.frmOvwrt.lblOvwrt configure -text [::msgcat::mc "Overwrite"] -font $fontNormal\ - -foreground red - } -} -## GOTO LINE DIALOG FORM ## -proc GoToLine {} { - global noteBook fileList fontNormal - set node [$noteBook raise] - if {$node == "newproj" || $node == "settings" || $node == "about" || $node == ""} { - return - } - set file $fileList($node) - set w $noteBook.f$node.goto - set text "$noteBook.f$node.text" - # destroy the find window if it already exists - if {[winfo exists $w]} { - destroy $w - } - # create the new "goto" window - toplevel $w - wm title $w [::msgcat::mc "Goto line"] - wm resizable $w 0 0 - wm transient $w $noteBook.f$node - - label $w.text -text [::msgcat::mc "Line number"] -font $fontNormal - entry $w.entGoTo -width 6 -validate key -validatecommand "ValidNumber %W %P" - pack $w.text $w.entGoTo -side left -anchor nw -padx 2 -pady 2 - - bind $w.entGoTo "+GoToLineNumber $text $noteBook.f$node" - bind $w.entGoTo "destroy $w" - focus -force $w.entGoTo -} -## Check input number ## -proc ValidNumber {w value} { - if [string is integer $value] { - return 1 - } else { - bell - return 0 - } -} -## GOTO LINE ## -proc GoToLineNumber {text w} { - set lineNumber [$w.goto.entGoTo get] - destroy $w.goto - catch { - $text mark set insert $lineNumber.0 - $text see insert - Position $text .frmStatus.frmLine.lblLine - } -} -## SEARCH DIALOG FORM ## -set findHistory "" -set findString "" -set replaceString "" -proc Find {} { - global noteBook fileList findHistory findString fontNormal - - set node [$noteBook raise] - if {$node == "newproj" || $node == "settings" || $node == "about" || $node == ""} { - return - } - set file $fileList($node) - set w $noteBook.f$node.find - set text "$noteBook.f$node.text" - set findString "" - # destroy the find window if it already exists - if {[winfo exists $w]} { - destroy $w - } - - toplevel $w - wm title $w [::msgcat::mc "Find"] - wm resizable $w 0 0 - wm transient $w $noteBook.f$node - 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 findString \ - -selectbackground "#55c4d1" -selectborderwidth 0\ - -values $findHistory] - - pack $combo -fill x -padx 2 -pady 2 - - button $w.frmBtn.btnFind -text "[::msgcat::mc "Find"] - F3"\ - -font $fontNormal -width 12 -relief groove\ - -command "FindCommand $text $w" - 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 - - bind $w "FindCommand $text $w" - bind $w "FindCommand $text $w" - bind $w "destroy $w" - focus -force $combo - - # set findIndex [lsearch -exact $findHistory "$findString"] - $combo setvalue @0 -} - -proc FindCommand {text w} { - global findString findHistory - # set findString [$entry get] - destroy $w - # if null string? do nothing - if {$findString == ""} { - return - } - # search "again" (starting from current position) - FindNext $text 0 -} - -proc FindNext {text {incr 1}} { - global findString findHistory - set t $text - puts $t - # append find string into find history list # - if {[lsearch -exact $findHistory $findString] == -1} { - set findHistory [linsert $findHistory 0 $findString] - } - - set pos [$t index insert] - set line [lindex [split $pos "."] 0] - set x [lindex [split $pos "."] 1] - incr x $incr - - set pos [$t search -nocase $findString $line.$x end] - - # if found then move the insert cursor to that position, otherwise beep - if {$pos != ""} { - $t mark set insert $pos - $t see $pos - - # highlight the found word - set line [lindex [split $pos "."] 0] - set x [lindex [split $pos "."] 1] - set x [expr {$x + [string length $findString]}] - $t tag remove sel 1.0 end - $t tag add sel $pos $line.$x - focus -force $t - return 1 - } else { - bell - return 0 - } - Position -} -## FIND FUNCTION PROCEDURE ## -proc FindProc {text findString node} { - global noteBook - - set pos "0.0" - $text see $pos - set line [lindex [split $pos "."] 0] - set x [lindex [split $pos "."] 1] - - set pos [$text search -nocase $findString $line.$x end] - $text mark set insert $pos - $text see $pos - - # highlight the found word - set line [lindex [split $pos "."] 0] - set x [lindex [split $pos "."] 1] - set x [expr {$x + [string length $findString]}] - $text tag remove sel 1.0 end - $text tag add sel $pos $line.$x - focus -force $text - Position - return 1 -} - -#3 REPLACE DIALOG FORM ## -proc ReplaceDialog {} { - global noteBook fontNormal fontBold fileList findString replaceString text - set node [$noteBook raise] - if {$node == "newproj" || $node == "settings" || $node == "about" || $node == ""} { - return - } - #set file $fileList($node) - set w .replace - set text "$noteBook.f$node.text" - # set findString "" - # destroy the find window if it already exists - if {[winfo exists $w]} { - destroy $w - } - - # create the new "find" window - toplevel $w - wm transient $w $noteBook.f$node - wm title $w [::msgcat::mc "Replace"] - wm resizable $w 0 0 - - set f1 [frame $w.frmFind] - set f2 [frame $w.frmReplace] - set f3 [frame $w.frmBtn -borderwidth 1] - pack $f1 $f2 $f3 -side top -fill x -expand true - - label $f1.lblFind -text [::msgcat::mc "Find"] -font $fontNormal -width 15 -anchor w - entry $f1.entFind -width 30 - pack $f1.lblFind $f1.entFind -side left -padx 2 -pady 2 - pack $f1.entFind -side left -fill x -expand true -padx 2 -pady 2 - - label $f2.lblReplace -text [::msgcat::mc "Replace with"] -font $fontNormal -width 15 -anchor w - entry $f2.entReplace -width 30 - pack $f2.lblReplace $f2.entReplace -side left -padx 2 -pady 2 - pack $f2.entReplace -side left -fill x -expand true -padx 2 -pady 2 - - button $f3.btnFind -text "[::msgcat::mc "Find"] - Enter" -width 12 -pady 0 -font $fontNormal -relief groove\ - -command "ReplaceCommand $text $w $f1.entFind $f2.entReplace find" - button $f3.btnReplace -text "[::msgcat::mc "Replace"] - F4" -width 12 -pady 0\ - -font $fontNormal -relief groove\ - -command { - ReplaceCommand $text $w .replace.frmFind.entFind .replace.frmReplace.entReplace replace - focus -force .replace - } - button $f3.btnReplaceAll -text [::msgcat::mc "Replace all"] -width 12 -pady 0\ - -font $fontNormal -relief groove\ - -command "ReplaceCommand $text $w $f1.entFind $f2.entReplace replace_all" - button $f3.btnCancel -text "[::msgcat::mc "Cancel"] - Esc" -command "destroy $w"\ - -width 12 -pady 0 -font $fontNormal -relief groove - pack $f3.btnFind $f3.btnReplace $f3.btnReplaceAll $f3.btnCancel\ - -side left -padx 2 -pady 2 -fill x - - bind $w "ReplaceCommand $text $w $f1.entFind $f2.entReplace find" - bind $w "ReplaceCommand $text $w $f1.entFind $f2.entReplace replace" - bind $w "destroy $w" - focus -force $f1.entFind - - if {$findString != ""} { - InsertEnt $f1.entFind $findString - } - if {$replaceString != ""} { - InsertEnt $f2.entReplace $replaceString - } -} -## REPLACE COMMAND ## -proc ReplaceCommand {text w entFind entReplace command} { - global noteBook fontNormal fontBold fileList findString replaceString - set node [$noteBook raise] - - set findString [$entFind get] - set replaceString [$entReplace get] - - switch -- $command { - "find" { - FindNext $text 1 - focus -force .replace - } - "replace" { - if {[Replace $text 0]} { - FindNext $text 1 - if {[lindex $fileList($node) 1] == 0} { - set fileList($node) [list [lindex $fileList($node) 0] 1] - LabelUpdate .frmStatus.frmProgress.lblProgress [::msgcat::mc "File modify"] - } - focus -force .replace - } - } - "replace_all" { - set stringsReplace 0 - if {[Replace $text 0]} { - if {[lindex $fileList($node) 1] == 0} { - set fileList($node) [list [lindex $fileList($node) 0] 1] - LabelUpdate .frmStatus.frmProgress.lblProgress [::msgcat::mc "File modify"] - } - incr stringsReplace - while {[Replace $text 1]} { - incr stringsReplace - } - } - tk_messageBox -icon info -title [::msgcat::mc "Replace"]\ - -parent $text -message\ - "[::msgcat::mc "Was replacement"] $stringsReplace." - destroy $w - } - } -} -## REPLACE ONE WORD PROCEDURE ## -proc Replace {text incr} { - global noteBook fontNormal fontBold fileList findString replaceString - - if {[FindNext $text $incr]} { - set selected [$text tag ranges sel] - set start [lindex $selected 0] - set end [lindex $selected 1] - $text delete $start $end - $text insert [$text index insert] $replaceString - return 1 - } else { - return 0 - } - # focus -force .replace -} -## FILE OPERATION ## -proc FileDialog {operation} { - global noteBook fontNormal fontBold fileList tree noteBook projDir activeProject imgDir editor - set dot "_" - set types { - {"Tcl files" {.tcl}} - {"Tk files" {.tk}} - {"Rivet files" {.rvt}} - {"TclHttpd Template" {.tml}} - {"Sql files" {.sql}} - {"Html files" {.html}} - {"Text files" {.txt}} - {"JAVA files" {.java}} - {"PERL files" {.pl}} - {"PHP files" {.php}} - {"FORTRAN files" {.for}} - {"CAML or ML files" {.ml}} - {"CAML or ML interface files" {.mli}} - {"Ruby files" {.rb}} - {"Text files" {} TEXT} - {"All files" *} - } - - - if {$operation == "open"} { - set dir $projDir - set fullPath [tk_getOpenFile -initialdir $dir -filetypes \ - $types -parent $noteBook] - regsub -all "." $file "_" node - set dir [file dirname $fullPath] - set file [file tail $fullPath] - set name [file rootname $file] - set ext [string range [file extension $file] 1 end] - set node "$name$dot$ext" - EditFile $node $fullPath - return 1 - } elseif {$operation == "delete"} { - set node [$tree selection get] - set fullPath [$tree itemcget $node -data] - set dir [file dirname $fullPath] - set file [file tail $fullPath] - set answer [tk_messageBox -message "[::msgcat::mc "Delete file"] \"$file\"?"\ - -type yesno -icon question -default yes] - case $answer { - yes { - FileDialog close - file delete -force "$fullPath" - $tree delete $node - $tree configure -redraw 1 - return 0 - } - } - } elseif {$operation == "close"} { - set node [$noteBook raise] - if {$node == "newproj" || $node == "settings" || $node == "about" || $node == "debug"} { - $noteBook delete $node - set node [$noteBook raise] - return - } else { - if {$node == ""} {return} - if {[info exists fileList($node)] == 0} {return} - set fullPath [lindex $fileList($node) 0] - set dir [file dirname $fullPath] - set file [file tail $fullPath] - set text "$noteBook.f$node.text" - } - } elseif {$operation == "close" && [info exists files] == 0} { - return - } else { - set node [$noteBook raise] - puts $node - if {$node == ""} {return} - if {[info exists fileList($node)] == 0} {return} - set fullPath [lindex $fileList($node) 0] - set dir [file dirname $fullPath] - set file [file tail $fullPath] - set text "$noteBook.f$node.text" - } - set name [file rootname $file] - set ext [string range [file extension $file] 1 end] - set treeSubNode "$name$dot$ext" - - set img [GetImage $file] - - if {$operation == "open"} { - set fullPath [tk_getOpenFile -initialdir $dir -filetypes \ - $types -parent $noteBook] - set file [string range $fullPath [expr [string last "/" $fullPath]+1] end] - regsub -all "." $file "_" node - $noteBook insert end $node -text "$file" - EditFile $node $fullPath - } elseif {$operation == "save"} { - if {$name == "untitled"} { - set file [tk_getSaveFile -initialdir $dir -filetypes \ - $types -parent $text -initialfile $file \ - -defaultextension .$ext] - set contents [$text get 0.0 end] - set fhandle [open "$file" "w"] - puts $fhandle $contents nonewline - close $fhandle - file delete [file join $dir $name.$ext] - #$tree delete $treeSubNode - unset fileList($node) - # change data into tree and notebook - set dir [file dirname $file] - set file [file tail $file] - set name [file rootname $file] - set ext [string range [file extension $file] 1 end] - $tree itemconfigure $treeSubNode -text $name - set treeSubNode "$activeProject$dot$name$dot$ext" - - #$tree insert end $activeProject $treeSubNode -text "$file" \ - #-data "[file join $dir $file]" -open 1\ - #-image [Bitmap::get [file join $imgDir $img.gif]]\ - #-font $fontNormal - set nbNode [$noteBook raise] - $noteBook itemconfigure $nbNode -text $file - set fileList($nbNode) [list $file 0] - } else { - set contents [$text get 0.0 end] - set fhandle [open [file join $dir $file] "w"] - puts $fhandle $contents nonewline - close $fhandle - EditFlag $node [file join $dir $file] 0 - } - } elseif {$operation == "save_all"} { - set i 0 - set nodeList [$noteBook pages 0 end] - set length [llength $nodeList] - while {$i < $length} { - set nbNode [lindex $nodeList $i] - if {[info exists fileList($nbNode)] == 1} { - set text "$noteBook.f$nbNode.text" - set savedFile [lindex $fileList($nbNode) 0] - set contents [$text get 0.0 end] - set fhandle [open [file join $dir $savedFile] "w"] - puts $fhandle $contents nonewline - close $fhandle - EditFlag $nbNode [file join $dir $savedFile] 0 - } - incr i - } - } elseif {$operation == "close"} { - # delete file name from fileList array # - if {$node == "newproj" || $node == "settings" || $node == "about" || $node == "debug"} { - $noteBook delete $node - set node [$noteBook raise] - return - } - set editFlag [lindex $fileList($node) 1] - set closedFile [file tail [lindex $fileList($node) 0]] - if {$editFlag == 1} { - set answer [tk_messageBox\ - -message "$closedFile [::msgcat::mc "File was modifyed. Save?"]"\ - -type yesnocancel -icon warning\ - -title [::msgcat::mc "Warning"]] - case $answer { - yes { - FileDialog save - # FileDialog close - } - no { - set index 0 - set nl [$tree nodes $node 0 end] - if {$nl != ""} { - foreach n $nl { - $tree delete $n - } - } - $noteBook delete $node - unset fileList($node) - $noteBook raise [$noteBook page $index] - set node [$noteBook raise] - } - cancel { - return 0 - } - } - } else { - set index 0 - set nl [$tree nodes $node 0 end] - if {$nl != ""} { - foreach n $nl { - $tree delete $n - } - } - #puts $node - $noteBook delete $node - unset fileList($node) - $noteBook raise [$noteBook page $index] - set node [$noteBook raise] - } - if {$node != ""} { - if {$node == "newproj" || $node == "settings" || $node == "about" || $node == "debug"} { - $noteBook delete $node - } else { - focus -force $noteBook.f$node - } - $tree selection set $node - } else { - LabelUpdate .frmStatus.frmLine.lblLine "" - LabelUpdate .frmStatus.frmFile.lblFile "" - LabelUpdate .frmStatus.frmOvwrt.lblOvwrt "" - LabelUpdate .frmStatus.frmProgress.lblProgress "" - } - } elseif {$operation == "close_all"} { - set nodeList [$noteBook pages 0 end] - $noteBook raise [$noteBook page 0] - set nbNode [$noteBook raise] - while {$nbNode != ""} { - if {$nbNode == "newproj" || $nbNode == "settings" || $nbNode == "about" || $nbNode == "debug"} { - $noteBook delete $nbNode - $noteBook raise [$noteBook page 0] - set nbNode [$noteBook raise] - } - if {[info exists fileList($nbNode)] == 1} { - set editFlag [lindex $fileList($nbNode) 1] - if {$editFlag == 1} { - set f [lindex $fileList($nbNode) 0] - set f [file tail $f] - set answer [tk_messageBox\ - -message "$f [::msgcat::mc "File was modifyed. Save?"]"\ - -type yesnocancel -icon warning\ - -title [::msgcat::mc "Warning"]] - case $answer { - yes { - FileDialog save - } - no {} - cancel {return cancel} - } - } - set nl [$tree nodes $nbNode 0 end] - if {$nl != ""} { - foreach n $nl { - $tree delete $n - } - } - $noteBook delete $nbNode - $noteBook raise [$noteBook page 0] - unset fileList($nbNode) - set nbNode [$noteBook raise] - } - } - LabelUpdate .frmStatus.frmLine.lblLine "" - LabelUpdate .frmStatus.frmFile.lblFile "" - LabelUpdate .frmStatus.frmOvwrt.lblOvwrt "" - - } elseif {$operation == "save_as"} { - set file [tk_getSaveFile -initialdir $dir -filetypes \ - $types -parent $text -initialfile $file] - if {$file != ""} { - set contents [$text get 0.0 end] - set fhandle [open $file "w"] - puts $fhandle $contents nonewline - close $fhandle - set dir [file dirname $file] - set file [file tail $file] - set name [string range $file 0 [expr [string last "." $file]-1]] - if {[string last "." $file] == -1} { - set ext [string range [file extension $file] 1 end] - } else { - set ext "" - } - set treeSubNode "$activeProject$dot$name$dot$ext" - $tree insert end $activeProject $treeSubNode -text "$file" \ - -data "[file join $dir $file]" -open 1\ - -image [Bitmap::get [file join $imgDir $img.gif]]\ - -font $fontNormal - set nbNode [$noteBook raise] - $noteBook itemconfigure $nbNode -text $file - set fileList($nbNode) [list $file 0] - } - return 0 - } -} -## COMPLITE PRODEDURE AND OPERATOR ## -proc OpComplite {text fileExt node} { - global opList autoFormat fileList - if {$node == "newproj" || $node == "settings" || $node == "about"} {return} - - set pos [$text index insert] - set line [lindex [split $pos "."] 0] - set posNum [lindex [split $pos "."] 1] - set string [$text get $line.0 $pos] - set first [string wordstart $string [expr $posNum-1]] - set op [string range $string $first $posNum] - if {[info exists opList($op)] == 1} { - if {[string match "*\{" [$text get $pos $line.end]] != 1} { - $text insert $pos $opList($op) - set x [expr $posNum + 2] - $text mark set insert $line.$posNum - $text see $line.$posNum - } else { - return - } - } -} -## OPEN AND CLOSE BRACE HIGHLIGHT ## -proc BraceHighLight {text} { - set pos [$text index insert] - set lineNum [lindex [split $pos "."] 0] - set posNum [lindex [split $pos "."] 1] - set curChar [$text get $lineNum.$posNum $lineNum.[expr $posNum+1]] - # _searchCloseBracket $text \{ \} insert end] - -} - - -## NOTEBOOK PAGE SWITCHER ## -## NOTEBOOK PAGE SWITCHER ## -proc PageTab {key} { - global noteBook tree fileList editor - set nb $noteBook - set len [llength [$nb pages]] - if {$len > 0} { - set newIndex [expr [$nb index [$nb raise]] + $key] - if {$newIndex < 0} { - set newIndex [expr $len - 1] - } elseif {$newIndex >= $len} { - set newIndex 0 - } - $nb see [lindex [$nb pages] $newIndex] - $nb raise [lindex [$nb pages] $newIndex] - PageRaise [lindex [$nb pages] $newIndex] - } -} - -proc _PageTab {} { - global noteBook tree fileList editor - set nodeList [$noteBook pages 0 end] - set length [llength $nodeList] - set node [$noteBook raise] - set nodeIndex [$noteBook index $node] - if {$nodeIndex == [expr $length-1]} { - set nextNode [$noteBook page 0] - } else { - set nextNode [$noteBook page [expr $nodeIndex + 1]] - } - $noteBook raise $nextNode - - if {$nextNode == "newproj" || $nextNode == "settings" || $nextNode == "about" || $nextNode == "debug"} { - return - } else { - $tree selection set $nextNode - $tree see $nextNode - set item [$tree itemcget $nextNode -data] - focus -force $noteBook.f$nextNode.text - LabelUpdate .frmStatus.frmHelp.lblHelp "[FileAttr $item]" - LabelUpdate .frmStatus.frmFile.lblFile "[file size $item] b." - if {[lindex $fileList($nextNode) 1] == 0} { - LabelUpdate .frmStatus.frmProgress.lblProgress "" - $noteBook itemconfigure $node -foreground $editor(nbNormal) - } else { - LabelUpdate .frmStatus.frmProgress.lblProgress [::msgcat::mc "File modify"] - $noteBook itemconfigure $node -foreground $editor(nbModify) - } - } -} -## RAISED NOTEBOOK TAB IF CLICK MPOUSE BUTTON ## -proc PageRaise {node} { - global noteBook tree fileList editor nodeEdit - #puts $node - $noteBook raise $node - set nodeEdit [$noteBook raise] - #set nodeEdit $node - puts $node - puts $nodeEdit - if {$node == "newproj" || $node == "settings" || $node == "about" || $node == "debug"} { - return - } else { - $tree selection set $node - $tree see $node - set item [$tree itemcget $node -data] - puts $item ;# debug - set ext [GetExtention $node] - if {$ext == "gif" || $ext == "jpg" || $ext == "png" || $ext == "xpm" || $ext == "xbm"} { - focus -force $noteBook.f$node.f.c - } else { - focus -force $noteBook.f$node.text - Position - } - - LabelUpdate .frmStatus.frmHelp.lblHelp "[FileAttr $item]" - LabelUpdate .frmStatus.frmFile.lblFile "[file size $item] b." - if {[lindex $fileList($node) 1] == 0} { - LabelUpdate .frmStatus.frmProgress.lblProgress "" - $noteBook itemconfigure $node -foreground $editor(nbNormal) - } else { - LabelUpdate .frmStatus.frmProgress.lblProgress [::msgcat::mc "File modify"] - $noteBook itemconfigure $node -foreground $editor(nbModify) - } - } -} - -## TABULAR INSERT (auto indent)## -proc TabIns {text} { - set tabSize 4 - set indentSize 4 - set pos [$text index insert] - set lineNum [lindex [split $pos "."] 0] - set posNum [lindex [split $pos "."] 1] - if {$lineNum > 1} { - # get current text - set curText [$text get $lineNum.0 "$lineNum.0 lineend"] - #get text of prev line - set prevLineNum [expr {$lineNum - 1}] - set prevText [$text get $prevLineNum.0 "$prevLineNum.0 lineend"] - #count first spaces in current line - set spaces "" - regexp "^| *" $curText spaces - #count first spaces in prev line - set prevSpaces "" - regexp "^( |\t)*" $prevText prevSpaces - set len [string length $prevSpaces] - set shouldBeSpaces 0 - for {set i 0} {$i < $len} {incr i} { - if {[string index $prevSpaces $i] == "\t"} { - incr shouldBeSpaces $tabSize - } else { - incr shouldBeSpaces - } - } - #see last symbol in the prev String. - set lastSymbol [string index $prevText [expr {[string length $prevText] - 1}]] - # is it open brace? - if {$lastSymbol == "\{"} { - incr shouldBeSpaces $indentSize - } - set a "" - regexp "^| *\}" $curText a - if {$a != ""} { - # make unindent - if {$shouldBeSpaces >= $indentSize} { - set shouldBeSpaces [expr {$shouldBeSpaces - $indentSize}] - } - } - set spaceNum [string length $spaces] - if {$shouldBeSpaces > $spaceNum} { - #insert spaces - set deltaSpace [expr {$shouldBeSpaces - $spaceNum}] - set incSpaces "" - for {set i 0} {$i < $deltaSpace} {incr i} { - append incSpaces " " - } - $text insert $lineNum.0 $incSpaces - } elseif {$shouldBeSpaces < $spaceNum} { - #delete spaces - set deltaSpace [expr {$spaceNum - $shouldBeSpaces}] - $text delete $lineNum.0 $lineNum.$deltaSpace - } - } -} - -proc EditFlag {node file flag} { - global fileList editor noteBook - if {$flag == 0} { - set fileList($node) [list $file 0] - LabelUpdate .frmStatus.frmProgress.lblProgress [::msgcat::mc "File saved"] - $noteBook itemconfigure $node -foreground $editor(nbNormal) - } else { - set fileList($node) [list $file end 1] - LabelUpdate .frmStatus.frmProgress.lblProgress [::msgcat::mc "File modify"] - $noteBook itemconfigure $node -foreground $editor(nbModify) - } -} -proc TextEncode {encode} { - global fileList editor noteBook - set node [$noteBook raise] - if {$node == "newproj" || $node == "settings" || $node == "about" || $node == ""} { - return - } - #set file $fileList($node) - set w .replace - set text "$noteBook.f$node.text" - set contents [$text get 0.0 end] - #puts "[lindex $files($activeFile) 2] $encode" - set contents [encoding convertfrom $encode $contents] - #set contents [encoding convertfrom $encode $contents] - $text delete 0.0 end - $text insert end $contents - unset text - #SetEncode $encode -} - -## EDITING FILE ## -proc EditFile {node fileName} { - global projDir workDir imgDir tree noteBook fontNormal fontBold w fileList replace nodeEdit procList - global backUpFileCreate fileExt progress editor braceHighLightBG braceHighLightFG activeProject - set nodeEdit $node - set replace 0 - set file [file tail $fileName] - set name [file rootname $file] - set fileExt [string range [file extension $fileName] 1 end] - set parentNode [$tree parent $node] - set project [$tree itemcget $parentNode -data] - set w [$noteBook insert end $node -text "$file" -image [Bitmap::get [file join $imgDir [GetImage $fileName].gif]]] - # create array with file names # - if {[info exists fileList($node)] != 1} { - set fileList($node) [list $fileName 0] - LabelUpdate .frmStatus.frmProgress.lblProgress "" - } - - - if {$fileExt == "gif" || $fileExt == "jpg" || $fileExt == "png" || $fileExt == "xpm" || $fileExt == "xbm"} { - ImageViewer $fileName $w $node - #$scrwin setwidget $w.Ó - $noteBook raise $node - return - } - set scrwin [ScrolledWindow $w.scrwin -bg $editor(bg)] - pack $scrwin -fill both -expand true - - - text $w.text\ - -relief sunken -wrap $editor(wrap) -highlightthickness 0 -undo 1 -font $editor(font)\ - -selectborderwidth 0 -selectbackground $editor(selectbg) -width 10 -background $editor(bg) -foreground $editor(fg) - - pack $w.text -side left -fill both -expand true - $scrwin setwidget $w.text - - if {$backUpFileCreate == "Yes"} {file copy -force $fileName "$fileName~"} - - $noteBook raise $node - set procName "" - set file [open "$fileName" r] - set lineNumber 1 - # Progress start - # LabelUpdate .frmStatus.frmProgress.lblProgress "[::msgcat::mc "Opened file in progress"]" - - while {[gets $file line]>=0} { - # Insert procedure names into tree # - regsub -all {\t} $line " " line - $w.text insert end "$line\n" - # set progress $lineNumber - set keyWord "" - set procName "" - - if {$fileExt == "php" || $fileExt == "phtml"} { - regexp -nocase -all -- {(function) (.*?)\(} $line match keyWord procName - #puts "$keyWord --- $procName" - - } else { - scan $line "%s%s" keyWord procName - } - # && $procName != "" - if {$keyWord == "proc" || $keyWord == "let" || $keyWord == "class" || $keyWord == "sub" || $keyWord == "function" || $keyWord == "fun" } { - set dot "_" - set openBrace [string first "\{" $line] - set closeBrace [expr [string first "\}" $line]-1] - set var [string range $line $openBrace end] - regsub -all ":" $procName "_" prcNode - if {$keyWord == "proc" || $keyWord == "sub" || $keyWord == "function" || $keyWord == "let"} { - set img "proc.gif" - } elseif {$keyWord == "class"} { - set img "class.gif" - } - if {$keyWord =="proc"} { - lappend procList($activeProject) [list $procName "param"] - #$w.text tag add procName $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]] - } - if {[$tree exists $prcNode$dot$lineNumber] !=1} { - $tree insert end $node $prcNode$dot$lineNumber -text $procName \ - -data "prc_$procName"\ - -image [Bitmap::get [file join $imgDir $img]] -font $fontNormal - } - } - if {$keyWord =="set"} { - lappend varList($activeProject) [list $procName "param"]] - } - incr lineNumber - } - #puts $procList - close $file - $w.text mark set insert 0.0 - $w.text see insert - $w.text tag configure lightBracket -background #000000 -foreground #00ffff - - # key bindings # - set text $w.text - bind $text { - regexp {^(\s*)} [%W get "insert linestart" end] -> spaceStart - %W insert insert "\n$spaceStart" - break - } - - - bind $text GoToLine - bind $text GoToLine - bind $text Find - bind $text Find - bind $text {FindNext $w.text 1} - bind $text ReplaceDialog - bind $text ReplaceDialog - bind $text {ReplaceCommand $w.text 1} - bind $text {FileDialog save} - bind $text {FileDialog save} - bind $text {FileDialog save_as} - bind $text {FileDialog save_as} - bind $text {FileDialog close} - bind $text {FileDialog close} - bind $text "tk_textCut $w.text;break" - bind $text "tk_textCut $w.text;break" - bind $text "tk_textCopy $w.text;break" - bind $text "tk_textCopy $w.text;break" - bind $text "tk_textPaste $w.text;break" - #bind $text "tk_textPaste $w.text;break" - bind $text { - set startPos [Position] - set nodeEdit [$noteBook raise] - EditFlag $nodeEdit $file 1 - set fileList($nodeEdit) [list [lindex $fileList($nodeEdit) 0] 1] - tk_textPaste $w.text - set endPos [Position] - set lineBegin [lindex [split $startPos "."] 0] - set lineEnd [lindex [split $endPos "."] 0] - for {set line $lineBegin} {$line <= $lineEnd} {incr line} { - if {$nodeEdit == "" || $nodeEdit == "newproj" || $nodeEdit == "settings" || $nodeEdit == "about" || $nodeEdit == "debug"} { - } else { - set textEdit "$noteBook.f$nodeEdit.text" - set editLine [$textEdit get $line.0 $line.end] - if {$autoFormat == "Yes"} { - if {$fileExt != "for"} { - TabIns $textEdit - } - } - HighLight $fileExt $textEdit $editLine $line $nodeEdit - } - } - break - } - - bind $text "auto_completition $text" - bind $text "auto_completition $text" - bind $text "auto_completition_proc $text" - bind $text "auto_completition_proc $text" - bind $text Find - bind $text Find - #bind . PageTab - #bind . PageTab - bind $text {OverWrite} - bind $text {Position} - bind $text {catch [PopupMenuEditor %X %Y]} - bind $text "%W yview scroll -3 units" - bind $text "%W yview scroll 3 units" - #bind $text "%W xview scroll -2 units" - #bind $text "%W xview scroll 2 units" - - bind $text { - Position - set nodeEdit [$noteBook raise] - if {$nodeEdit == "" || $nodeEdit == "newproj" || $nodeEdit == "settings" || $nodeEdit == "about" || $nodeEdit == "debug"} { - } else { - set textEdit "$noteBook.f$nodeEdit.text" - set pos [$textEdit index insert] - set line [lindex [split $pos "."] 0] - set editLine [$textEdit get $line.0 $pos] - if {$autoFormat == "Yes"} { - if {$fileExt != "for"} { - TabIns $textEdit - } - } - HighLight $fileExt $textEdit $editLine $line $nodeEdit - } - } - bind $text { - if {$nodeEdit == "" || $nodeEdit == "newproj" || $nodeEdit == "settings" || $nodeEdit == "about" || $nodeEdit == "debug"} { - } else { - set nodeEdit [$noteBook raise] - if {[Key %k] == "true"} { - if {[lindex $fileList($nodeEdit) 1] == 0} { - set fileList($nodeEdit) [list [lindex $fileList($nodeEdit) 0] 1] - LabelUpdate .frmStatus.frmProgress.lblProgress [::msgcat::mc "File modify"] - $noteBook itemconfigure $nodeEdit -foreground $editor(nbModify) - } - ReplaceChar %W - };# if - };# if - };# bind - bind $text { - if {$nodeEdit == ""} {return} - set textEdit "$noteBook.f$nodeEdit.text" - OpComplite $textEdit $fileExt $nodeEdit - if {[lindex $fileList($nodeEdit) 1] == 0} { - set fileList($nodeEdit) [list [lindex $fileList($nodeEdit) 0] 1] - LabelUpdate .frmStatus.frmProgress.lblProgress [::msgcat::mc "File modify"] - $noteBook itemconfigure $nodeEdit -foreground $editor(nbModify) - } - } - # Alexander Dederer (aka Korwin) - # bind like VI editor - bind $text { - set i -1 - switch -- [%W get "insert - 1 chars"] { - \{ {set i [_searchCloseBracket %W \{ \} insert end]} - \[ {set i [_searchCloseBracket %W \[ \] insert end]} - ( {set i [_searchCloseBracket %W ( ) insert end]} - \} {set i [_searchOpenBracket %W \{ \} insert 1.0]} - \] {set i [_searchOpenBracket %W \[ \] insert 1.0]} - ) {set i [_searchOpenBracket %W ( ) insert 1.0]} - } ;# switch - if { $i != -1 } { - %W mark set insert $i - %W see insert - } - } ;# bind - bindtags $text [list [winfo toplevel $text] $text Text sysAfter all] - bind sysAfter {+ set i -1 - catch { - switch -- [%W get "insert - 1 chars"] { - \{ {set i [_searchCloseBracket %W \{ \} insert end]} - \[ {set i [_searchCloseBracket %W \[ \] insert end]} - ( {set i [_searchCloseBracket %W ( ) insert end]} - \} {set i [_searchOpenBracket %W \{ \} insert 1.0]} - \] {set i [_searchOpenBracket %W \[ \] insert 1.0]} - ) {set i [_searchOpenBracket %W ( ) insert 1.0]} - } ;# switch - catch { %W tag remove lightBracket 1.0 end } - if { $i != -1 } { - %W tag add lightBracket "$i - 1 chars" $i - };#if - };#catch - } ;# bind sysAfter - - bind sysAfter [bind sysAfter ] - focus -force $w.text - Position - .frmStatus.frmOvwrt.lblOvwrt configure -text [::msgcat::mc "Insert"] -font $fontNormal - bind $text {OverWrite; break} - ## READ TEXT FOR HIGHLIGHTNING ## - set lineNum 1 - while {$lineNum <=[expr $lineNumber + 1]} { - set line [$w.text get $lineNum.0 $lineNum.end] - HighLight $fileExt $w.text $line $lineNum $nodeEdit - incr lineNum - } -} - -## GET KEYS CODE ## -proc Key {key} { - if {$key >= 10 && $key <= 22} {return "true"} - if {$key >= 24 && $key <= 36} {return "true"} - if {$key >= 38 && $key <= 50} {return "true"} - if {$key >= 51 && $key <= 61 && $key != 58} {return "true"} - if {$key >= 79 && $key <= 91} {return "true"} - if {$key == 63 || $key == 107 || $key == 108 || $key == 112} {return "true"} -} - - -# "Alexander Dederer (aka Korwin) -## Search close bracket in editor widget -proc _searchCloseBracket { widget o_bracket c_bracket start_pos end_pos } { - set o_count 1 - set c_count 0 - set found 0 - set pattern "\[\\$o_bracket\\$c_bracket\]" - set pos [$widget search -regexp -- $pattern $start_pos $end_pos] - while { ! [string equal $pos {}] } { - set char [$widget get $pos] - #tk_messageBox -title $pattern -message "char: $char; $pos; o_count=$o_count; c_count=$c_count" - if {[string equal $char $o_bracket]} {incr o_count ; set found 1} - if {[string equal $char $c_bracket]} {incr c_count ; set found 1} - if {($found == 1) && ($o_count == $c_count) } { return [$widget index "$pos + 1 chars"] } - set found 0 - set start_pos "$pos + 1 chars" - set pos [$widget search -regexp -- $pattern $start_pos $end_pos] - } ;# while search - - return -1 -} ;# proc _searchCloseBracket - -# "Alexander Dederer (aka Korwin) -## Search open bracket in editor widget -proc _searchOpenBracket { widget o_bracket c_bracket start_pos end_pos } { - set o_count 0 - set c_count 1 - set found 0 - set pattern "\[\\$o_bracket\\$c_bracket\]" - set pos [$widget search -backward -regexp -- $pattern "$start_pos - 1 chars" $end_pos] - while { ! [string equal $pos {}] } { - set char [$widget get $pos] - #tk_messageBox -title $pattern -message "char: $char; $pos; o_count=$o_count; c_count=$c_count" - if {[string equal $char $o_bracket]} {incr o_count ; set found 1} - if {[string equal $char $c_bracket]} {incr c_count ; set found 1} - if {($found == 1) && ($o_count == $c_count) } { return [$widget index "$pos + 1 chars"] } - set found 0 - set start_pos "$pos - 0 chars" - set pos [$widget search -backward -regexp -- $pattern $start_pos $end_pos] - } ;# while search - return -1 -} ;# proc _searchOpenBracket - -proc SelectAll {text} { - global noteBook - - $text tag remove sel 1.0 end - $text tag add sel 1.0 end - -} - -#################################### -GetOp - - - - - diff --git a/help.tcl b/help.tcl deleted file mode 100644 index 7624db6..0000000 --- a/help.tcl +++ /dev/null @@ -1,365 +0,0 @@ -##!/usr/bin/wish - -########################################################### -# Tcl/Tk Project Manager # -# version 0.0.1 # -# help module # -# Copyright (c) "Sergey Kalinin", 2002, http://nuk-svk.ru # -# Author: Sergey Kalinin banzaj28@yandex.ru # -########################################################### - -#package require BWidget -#package require msgcat - -## GETTING TABLES OF CONTENT ## -#set homeDir "$env(HOME)/projects/tcl/projman" -#set docDir "$env(HOME)/projects/tcl/projman/hlp" -#set imgDir "$env(HOME)/projects/tcl/projman/img" -#set msgDir "$env(HOME)/projects/tcl/projman/msgs" - -#set workDir "$env(HOME)/.projman" - -#source $workDir/projman.conf -source [file join $dataDir html_lib.tcl] -#source [file join $dataDir htmllib.tcl] - -set sourceEncode "koi8-r" - -## LOAD MESSAGES FILE? LANGUAGE AND NEDDED FILES ## -#source $homeDir/html.tcl - -#::msgcat::mclocale $locale -#::msgcat::mcload $msgDir -proc HlpTreeOneClick {node} { - global fontNormal hlpTree wordList hlpNoteBook findString imgDir fontBold fontNormal - global lstSearch nodeParent - $hlpTree selection set $node - set nodeParent [$hlpTree parent $node] - set item [$hlpTree itemcget $node -data] - set file [string range $item 4 end] - #puts "$file" ;#debuf info - if {[string range $item 0 2] == "toc"} { - # $hlpTree configure - } - if {[$hlpTree itemcget $node -open] == 1} { - $hlpTree itemconfigure $node -open 0 - } elseif {[$hlpTree itemcget $node -open] == 0} { - $hlpTree itemconfigure $node -open 1 - } - if {[string range $item 0 2] == "doc"} { - GetContent $file - } -} -## GETTING TABLE OF CONTENT ## -proc GetTOC {} { - global docDir hlpTree imgDir fontNormal lstSearch arr sourceEncode - if {[catch {cd $docDir}] != 0} { - return "" - } - foreach dir [lsort [glob -nocomplain *]] { - if {[file isdirectory $dir] == 1} { - foreach file [lsort [glob -nocomplain [file join $dir *toc.html]]] { - #puts $file - set fileName [file join $file] - set tocFile [open $fileName r] - fconfigure $tocFile -encoding binary - set dot "_" - #set nodeParent [string range $fileName 0 [expr [string first "." $fileName]-1]] - #puts $fileName - set nodeParent [file dirname $fileName] - while {[gets $tocFile line]>=0} { - set a "" - set b "" - set line [encoding convertfrom $sourceEncode $line] - if {[regexp -nocase ".+\" $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 ".+\" $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 [puts %k] - # $hlpTree bindText [puts %k] - # bind $frmTree {$frmSrchList.lstSearch xview} - # $hlpTree bindText "HlpTreeDoubleClick [$hlpTree selection get]" - # $hlpTree bindImage "HlpTreeDoubleClick [$hlpTree selection get]" - $hlpTree bindText "HlpTreeOneClick [$hlpTree selection get]" - $hlpTree bindImage "HlpTreeOneClick [$hlpTree selection get]" - bind .help "destroy .help" - - # bind $frmSrchEnt.entSearch \ - # {SearchWord [Text .help.frmBody.frmCat.nBookTree.fhlpSearch.frmScrhEnt.entSearch]} - - #bind $w exit - #bind $frmTree {TreeClick [$hlpTree selection get]} - #bind $frmTree {TreeClick [$hlpTree selection get]} - #bind $frmTree {TreeClick [$hlpTree selection get]} - bind $frmTree.tree.c "$hlpTree yview scroll -3 units" - bind $frmTree.tree.c "$hlpTree yview scroll 3 units" - bind $frmTree.tree.c "$hlpTree xview scroll -2 units" - bind $frmTree.tree.c "$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 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/highlight/caml.tcl b/highlight/caml.tcl deleted file mode 100644 index f4d6747..0000000 --- a/highlight/caml.tcl +++ /dev/null @@ -1,219 +0,0 @@ -########################################################### -# Tcl/Tk Project Manager # -# version 0.0.1 # -# TCL highlight file # -# Copyright (c) "Sergey Kalinin", 2001, http://nuk-svk.ru # -# Author: Sergey Kalinin banzaj28@yandex.ru # -########################################################### -set beginQuote "0.0" -set endQuote "2.0" -set endQuotePrev "0.0" - -proc HighLightML {text line lineNumber node} { - global fontNormal fontBold editorFontBold tree imgDir noteBook - global editor color - global beginQuote endQuote endQuotePrev - set startIndex 0 - - $text tag configure bold -font $editor(fontBold) - $text tag configure className -font $editor(fontBold) -foreground $color(procName) - $text tag configure keyWord -foreground $color(keyWord) - $text tag configure comments -foreground $color(comments) - $text tag configure variable -foreground $color(var) - $text tag configure string -foreground $color(string) - $text tag configure braceHighLight -font $editor(fontBold)\ - -foreground $color(braceBG) -background $color(braceFG) - $text tag configure brace -foreground $color(brace) - $text tag configure percent -foreground $color(percent) - $text tag configure bindKey -foreground $color(bindKey) - $text tag configure sql -font $editor(fontBold) -foreground $color(sql) - - set keyWord [info commands] - # for OOP extention - foreach n {let match compile load exception function bol begin end then type done with class method attribute constructor destructor invariant attribute binding new delete extends final finally implements import interface native new private protected public static super this throw synchronized throws transient try volatile void else} {lappend keyWord $n} - set dataType {list abstract boolean byte char double float int long short} - set sqlOperators {select from where and or count sum in order cast as by} - set a "" - set startPos 0 - set endPos 0 - set length 0 - set workLine $line - set className "" - while {$workLine != ""} { - if {[regexp "(^|\t| )\[a-zA-Z\\_:\]+" $workLine word]} { - set length [string length $word] - set startPos [string first [string trim $word] $line] - set endPos [expr $startPos + $length] - set workLine [string range $workLine $length end] - if {[lsearch $keyWord [string trim $word]] != -1} { - $text tag add keyWord $lineNumber.$startPos $lineNumber.$endPos - } - if {[lsearch $dataType [string trim $word]] != -1} { - $text tag add bold $lineNumber.$startPos $lineNumber.$endPos - } - if {[lsearch $sqlOperators [string trim $word]] != -1} { - $text tag add sql $lineNumber.$startPos $lineNumber.$endPos - } - if {[string trim $word]=="let" || [string trim $word]=="extends" || [string trim $word]=="implements"} { - $text tag add className $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]] - } - set startPos [expr $endPos + 1] - } else { - break - } - } - - # key binding highlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "<.*?>" $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add bindKey $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - # variable highlight # - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "\\$\[a-zA-Z\\_:\]+" $workLine a]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - if {$a != ""} { - $text tag add variable $lineNumber.$start $lineNumber.$end - } - set startPos $end - } else { - break - } - } - # string " " highlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "\".*?\"" $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add string $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - # persent % highlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - # if {[regexp "\%.*? " $workLine a b]} - if {[regexp "\%" $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add percent $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - ## COMENTS ## - set workLine [$text get $lineNumber.0 $lineNumber.end] - if {[regexp -indices {(^|\t|;| )\(\*} $workLine begin]} { - set p [lindex $begin 0] - $text tag add comments $lineNumber.[expr $p - 0] $lineNumber.end - } elseif {[regexp -indices {(^|\t|;| )\*} $workLine beginIndex]} { - set beginQuote "$lineNumber.[lindex $beginIndex 0]" - set endQuote [$text search -forward -regexp -- {\*\)} $beginQuote end] - if {$endQuote != ""} { - $text tag add comments $beginQuote "$endQuote + 2 chars" - } else { - $text tag add comments $beginQuote end - } - set endQuotePrev [$text search -backward -regexp -- {\*\)} [expr $lineNumber - 1].end 0.0] - if {$endQuotePrev != ""} { - $text tag remove comments "$endQuotePrev + 2 chars" $beginQuote - } - } elseif {[regexp -indices {\*\)} $workLine endIndex]} { - set endQuote "$lineNumber.[lindex $endIndex 1]" - set beginQuote [$text search -backward -regexp -- {\(\*} $endQuote 0.0] - if {$beginQuote != ""} { - $text tag add comments $beginQuote "$endQuote + 1 chars" - } else { - $text tag add comments 0.0 "$endQuote + 1 chars" - } - set beginQuoteNext [$text search -forward -regexp -- {\(\*} $endQuote end] - if {$beginQuoteNext != ""} { - $text tag remove comments "$endQuote + 2 chars" $beginQuoteNext - } - } else { - if {[lindex [split $beginQuote "."] 0] <= $lineNumber && [lindex [split $endQuote "."] 0] >= $lineNumber} { - #$text tag add comments $lineNumber.0 $lineNumber.end - } else { - $text tag remove comments $lineNumber.0 $lineNumber.end - } - } - - # DEDERER - # hightlight [, {, }, ], ( , ) - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp {\(|\[|{|}|\]|\)} $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add bold $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - - # parameter for command hightlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp -- {\s-\w+(?=\s)} $workLine a b]} { - set start [expr [string first $a $workLine] + 1] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add bindKey $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } -} - - - - - - - - - diff --git a/highlight/erlang.tcl b/highlight/erlang.tcl deleted file mode 100644 index e74fcd3..0000000 --- a/highlight/erlang.tcl +++ /dev/null @@ -1,220 +0,0 @@ -########################################################### -# Tcl/Tk Project Manager # -# version 0.0.1 # -# TCL highlight file # -# Copyright (c) "Sergey Kalinin", 2001, http://nuk-svk.ru # -# Author: Sergey Kalinin banzaj28@yandex.ru # -########################################################### -set beginQuote "0.0" -set endQuote "2.0" -set endQuotePrev "0.0" - -proc HighLightErl {text line lineNumber node} { - global fontNormal fontBold editorFontBold tree imgDir noteBook - global editor color - global beginQuote endQuote endQuotePrev - set startIndex 0 - - $text tag configure bold -font $editor(fontBold) - $text tag configure className -font $editor(fontBold) -foreground $color(procName) - $text tag configure keyWord -foreground $color(keyWord) - $text tag configure comments -foreground $color(comments) - $text tag configure variable -foreground $color(var) - $text tag configure string -foreground $color(string) - $text tag configure braceHighLight -font $editor(fontBold)\ - -foreground $color(braceBG) -background $color(braceFG) - $text tag configure brace -foreground $color(brace) - $text tag configure percent -foreground $color(percent) - $text tag configure bindKey -foreground $color(bindKey) - $text tag configure sql -font $editor(fontBold) -foreground $color(sql) - - set keyWord [info commands] - # for OOP extention - foreach n {let match compile load exception function bol begin end then type done with class method attribute constructor destructor invariant attribute binding new delete extends final finally implements import interface native new private protected public static super this throw synchronized throws transient try volatile void else} {lappend keyWord $n} - set dataType {list abstract boolean byte char double float int long short} - set sqlOperators {select from where and or count sum in order cast as by} - set a "" - set startPos 0 - set endPos 0 - set length 0 - set workLine $line - set className "" - while {$workLine != ""} { - if {[regexp "(^|\t| )\[a-zA-Z\\_:\]+" $workLine word]} { - set length [string length $word] - set startPos [string first [string trim $word] $line] - set endPos [expr $startPos + $length] - set workLine [string range $workLine $length end] - if {[lsearch $keyWord [string trim $word]] != -1} { - $text tag add keyWord $lineNumber.$startPos $lineNumber.$endPos - } - if {[lsearch $dataType [string trim $word]] != -1} { - $text tag add bold $lineNumber.$startPos $lineNumber.$endPos - } - if {[lsearch $sqlOperators [string trim $word]] != -1} { - $text tag add sql $lineNumber.$startPos $lineNumber.$endPos - } - if {[string trim $word]=="let" || [string trim $word]=="extends" || [string trim $word]=="implements"} { - $text tag add className $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]] - } - set startPos [expr $endPos + 1] - } else { - break - } - } - - # key binding highlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "<.*?>" $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add bindKey $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - # variable highlight # - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "\\$\[a-zA-Z\\_:\]+" $workLine a]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - if {$a != ""} { - $text tag add variable $lineNumber.$start $lineNumber.$end - } - set startPos $end - } else { - break - } - } - # string " " highlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "\".*?\"" $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add string $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - # persent % highlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - # if {[regexp "\%.*? " $workLine a b]} - if {[regexp "\%" $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add percent $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - ## COMENTS ## - set workLine [$text get $lineNumber.0 $lineNumber.end] - if {[regexp -indices {(^|\t|;| )\(\*} $workLine begin]} { - set p [lindex $begin 0] - $text tag add comments $lineNumber.[expr $p - 0] $lineNumber.end - } elseif {[regexp -indices {(^|\t|;| )\*} $workLine beginIndex]} { - set beginQuote "$lineNumber.[lindex $beginIndex 0]" - set endQuote [$text search -forward -regexp -- {\*\)} $beginQuote end] - if {$endQuote != ""} { - $text tag add comments $beginQuote "$endQuote + 2 chars" - } else { - $text tag add comments $beginQuote end - } - set endQuotePrev [$text search -backward -regexp -- {\*\)} [expr $lineNumber - 1].end 0.0] - if {$endQuotePrev != ""} { - $text tag remove comments "$endQuotePrev + 2 chars" $beginQuote - } - } elseif {[regexp -indices {\*\)} $workLine endIndex]} { - set endQuote "$lineNumber.[lindex $endIndex 1]" - set beginQuote [$text search -backward -regexp -- {\(\*} $endQuote 0.0] - if {$beginQuote != ""} { - $text tag add comments $beginQuote "$endQuote + 1 chars" - } else { - $text tag add comments 0.0 "$endQuote + 1 chars" - } - set beginQuoteNext [$text search -forward -regexp -- {\(\*} $endQuote end] - if {$beginQuoteNext != ""} { - $text tag remove comments "$endQuote + 2 chars" $beginQuoteNext - } - } else { - if {[lindex [split $beginQuote "."] 0] <= $lineNumber && [lindex [split $endQuote "."] 0] >= $lineNumber} { - #$text tag add comments $lineNumber.0 $lineNumber.end - } else { - $text tag remove comments $lineNumber.0 $lineNumber.end - } - } - - # DEDERER - # hightlight [, {, }, ], ( , ) - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp {\(|\[|{|}|\]|\)} $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add bold $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - - # parameter for command hightlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp -- {\s-\w+(?=\s)} $workLine a b]} { - set start [expr [string first $a $workLine] + 1] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add bindKey $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } -} - - - - - - - - - - diff --git a/highlight/fortran.tcl b/highlight/fortran.tcl deleted file mode 100644 index 2b3658f..0000000 --- a/highlight/fortran.tcl +++ /dev/null @@ -1,214 +0,0 @@ -########################################################### -# Tcl/Tk Project Manager # -# version 0.0.1 # -# TCL highlight file # -# Copyright (c) "Sergey Kalinin", 2001, http://nuk-svk.ru # -# Author: Sergey Kalinin banzaj28@yandex.ru # -########################################################### -set beginQuote "0.0" -set endQuote "2.0" -set endQuotePrev "0.0" - -proc HighLightFORTRAN {text line lineNumber node} { - global fontNormal fontBold editorFontBold tree imgDir noteBook - global editor color - global beginQuote endQuote endQuotePrev - set startIndex 0 - - $text tag configure bold -font $editor(fontBold) - $text tag configure className -font $editor(fontBold) -foreground $color(procName) - $text tag configure keyWord -foreground $color(keyWord) - $text tag configure comments -foreground $color(comments) ;#-background $editor(bg) - $text tag configure variable -foreground $color(var) - $text tag configure string -foreground $color(string) - $text tag configure braceHighLight -font $editor(fontBold)\ - -foreground $color(braceBG) -background $color(braceFG) - $text tag configure brace -foreground $color(brace) - $text tag configure percent -foreground $color(percent) - $text tag configure bindKey -foreground $color(bindKey) - - $text tag configure label -background $color(label) - $text tag configure six -foreground $color(sixFG) -background $color(sixBG) - $text tag configure operator -background $editor(bg) - - set keyWord [info commands] - # for OOP extention - foreach n {program function subroutine entry block data implicit integer real double precision complex\ - logical character dimension common equivalence parameter external intrinsic save data goto assign if then\ - else elseif endif end do while enddo continue stop pause end open close read write print\ - inquire rewind backspace endfile format call return include} {lappend keyWord $n} - #set dataType {list abstract boolean byte char double float int long short} - set dataType "" - set a "" - set startPos 0 - set endPos 0 - set length 0 - set workLine $line - set className "" - while {$workLine != ""} { - if {[regexp "(^|\t| )\[a-zA-Z\\_:\]+" $workLine word]} { - set length [string length $word] - set startPos [string first [string trim $word] $line] - set endPos [expr $startPos + $length] - set workLine [string range $workLine $length end] - if {[lsearch $keyWord [string trim $word]] != -1} { - $text tag add keyWord $lineNumber.$startPos $lineNumber.$endPos - } - if {[lsearch $dataType [string trim $word]] != -1} { - $text tag add bold $lineNumber.$startPos $lineNumber.$endPos - } - if {[string trim $word]=="class" || [string trim $word]=="extends" || [string trim $word]=="implements"} { - $text tag add className $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]] - } - set startPos [expr $endPos + 1] - } else { - break - } - } - - # key binding highlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "<.*?>" $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add bindKey $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - # variable highlight # - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "\\$\[a-zA-Z\\_:\]+" $workLine a]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - if {$a != ""} { - $text tag add variable $lineNumber.$start $lineNumber.$end - } - set startPos $end - } else { - break - } - } - # string " " highlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "\".*?\"" $workLine a b] || [regexp "\'.*?\'" $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add string $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - # persent % highlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - # if {[regexp "\%.*? " $workLine a b]} - if {[regexp "\%" $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add percent $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - $text tag remove label $lineNumber.0 $lineNumber.end - $text tag add label $lineNumber.0 $lineNumber.5 - $text tag remove six $lineNumber.0 $lineNumber.5 - $text tag remove six $lineNumber.6 $lineNumber.end - $text tag add six $lineNumber.5 $lineNumber.6 - $text tag remove operator $lineNumber.6 $lineNumber.end - $text tag add operator $lineNumber.7 $lineNumber.71 - $text tag remove comments $lineNumber.72 $lineNumber.end - $text tag add comments $lineNumber.72 $lineNumber.end - ## COMENTS ## - set workLine [$text get $lineNumber.0 $lineNumber.end] - #if {[regexp -indices -nocase {^(c|\*)} $workLine word]} - if {[regexp -indices -nocase {^(c|\*)} $workLine word]} { - set p [lindex $word 1] - #puts "$p $lineNumber -- $workLine" - $text tag remove label $lineNumber.0 $lineNumber.end - $text tag remove operator $lineNumber.0 $lineNumber.end - $text tag add comments $lineNumber.$p $lineNumber.end - $text tag remove six $lineNumber.5 $lineNumber.6 - #puts [$text dump -tag $lineNumber.0 $lineNumber.end] - #$text tag raise comments - #puts [$text tag ranges comments] - } else { - $text tag remove comments $lineNumber.0 $lineNumber.end - } - set workLine [$text get $lineNumber.0 $lineNumber.end] - if {[regexp -indices -nocase {\!} $workLine word]} { - set p [lindex $word 1] - if {([string index $workLine [expr $p + 1]] == "\'") || ([string index $workLine [expr $p + 1]] == "\"")} { - } else { - #$text tag add comments $lineNumber.$p $lineNumber.end - } - } else { - #$text tag remove comments $lineNumber.0 $lineNumber.end - } - - - # DEDERER - # hightlight [, {, }, ], ( , ) - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp {\(|\[|{|}|\]|\)} $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add bold $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - - # parameter for command hightlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp -- {\s-\w+(?=\s)} $workLine a b]} { - set start [expr [string first $a $workLine] + 1] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add bindKey $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } -} - diff --git a/highlight/html.tcl b/highlight/html.tcl deleted file mode 100644 index 00afa99..0000000 --- a/highlight/html.tcl +++ /dev/null @@ -1,106 +0,0 @@ -########################################################### -# Tcl/Tk Project Manager # -# version 0.0.1 # -# TCL highlight file # -# Copyright (c) "Sergey Kalinin", 2001, http://nuk-svk.ru # -# Author: Sergey Kalinin banzaj28@yandex.ru # -########################################################### - -proc HighLightHTML {text line lineNumber node} { - global fontNormal editorFontBold tree imgDir fontBold - global editor color - set startIndex 0 - # bind text tags for highlightning # - $text tag configure bold -font $editor(fontBold) - $text tag configure procName -font $editor(fontBold) -foreground $color(procName) - $text tag configure keyWord -foreground $color(keyWord) - $text tag configure comments -foreground $color(comments) - $text tag configure variable -foreground $color(var) - $text tag configure string -foreground $color(string) - $text tag configure braceHighLight -font $editor(fontBold)\ - -foreground $color(braceBG) -background $color(braceFG) - $text tag configure brace -foreground $color(brace) - $text tag configure percent -foreground $color(percent) - $text tag configure bindKey -foreground $color(bindKey) -# incr lineNumber - set keyWord [info commands] - # for OOP extention - foreach n {class method attribute constructor destructor invariant attribute binding new delete} { - lappend keyWord $n - } - # add comment # - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "<\!--.+-->" $workLine a]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add coments $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - # get keywords - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "( \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 - } - } - -} - - - - - - diff --git a/highlight/java.tcl b/highlight/java.tcl deleted file mode 100644 index b2669e8..0000000 --- a/highlight/java.tcl +++ /dev/null @@ -1,215 +0,0 @@ -########################################################### -# Tcl/Tk Project Manager # -# version 0.0.1 # -# TCL highlight file # -# Copyright (c) "Sergey Kalinin", 2001, http://nuk-svk.ru # -# Author: Sergey Kalinin banzaj28@yandex.ru # -########################################################### -set beginQuote "0.0" -set endQuote "2.0" -set endQuotePrev "0.0" -proc HighLightJAVA {text line lineNumber node} { - global fontNormal fontBold editorFontBold tree imgDir noteBook - global editor color - global beginQuote endQuote endQuotePrev - set startIndex 0 - - $text tag configure bold -font $editor(fontBold) - $text tag configure className -font $editor(fontBold) -foreground $color(procName) - $text tag configure keyWord -foreground $color(keyWord) - $text tag configure comments -foreground $color(comments) - $text tag configure variable -foreground $color(var) - $text tag configure string -foreground $color(string) - $text tag configure braceHighLight -font $editor(fontBold)\ - -foreground $color(braceBG) -background $color(braceFG) - $text tag configure brace -foreground $color(brace) - $text tag configure percent -foreground $color(percent) - $text tag configure bindKey -foreground $color(bindKey) - $text tag configure sql -font $editor(fontBold) -foreground $color(sql) - - set keyWord [info commands] - # for OOP extention - foreach n {class method attribute constructor destructor invariant attribute binding new delete extends final finally implements import interface native new private protected public static super this throw synchronized throws transient try volatile void else} {lappend keyWord $n} - set dataType {list abstract boolean byte char double float int long short} - set sqlOperators {select from where and or count sum in order cast as by} - set a "" - set startPos 0 - set endPos 0 - set length 0 - set workLine $line - set className "" - while {$workLine != ""} { - if {[regexp "(^|\t| )\[a-zA-Z\\_:\]+" $workLine word]} { - set length [string length $word] - set startPos [string first [string trim $word] $line] - set endPos [expr $startPos + $length] - set workLine [string range $workLine $length end] - if {[lsearch $keyWord [string trim $word]] != -1} { - $text tag add keyWord $lineNumber.$startPos $lineNumber.$endPos - } - if {[lsearch $dataType [string trim $word]] != -1} { - $text tag add bold $lineNumber.$startPos $lineNumber.$endPos - } - if {[lsearch $sqlOperators [string trim $word]] != -1} { - $text tag add sql $lineNumber.$startPos $lineNumber.$endPos - } - - if {[string trim $word]=="class" || [string trim $word]=="extends" || [string trim $word]=="implements"} { - $text tag add className $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]] - } - set startPos [expr $endPos + 1] - } else { - break - } - } - - # key binding highlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "<.*?>" $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add bindKey $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - # variable highlight # - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "\\$\[a-zA-Z\\_:\]+" $workLine a]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - if {$a != ""} { - $text tag add variable $lineNumber.$start $lineNumber.$end - } - set startPos $end - } else { - break - } - } - # string " " highlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "\".*?\"" $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add string $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - # persent % highlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - # if {[regexp "\%.*? " $workLine a b]} - if {[regexp "\%" $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add percent $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - ## COMENTS ## - set workLine [$text get $lineNumber.0 $lineNumber.end] - if {[regexp -indices "(^|\t|;| )//" $workLine begin]} { - set p [lindex $begin 0] - $text tag add comments $lineNumber.[expr $p - 0] $lineNumber.end - } elseif {[regexp -indices {(^|\t|;| )/\*} $workLine beginIndex]} { - set beginQuote "$lineNumber.[lindex $beginIndex 0]" - set endQuote [$text search -forward -regexp -- {\*/} $beginQuote end] - if {$endQuote != ""} { - $text tag add comments $beginQuote "$endQuote + 2 chars" - } else { - $text tag add comments $beginQuote end - } - set endQuotePrev [$text search -backward -regexp -- {\*/} [expr $lineNumber - 1].end 0.0] - if {$endQuotePrev != ""} { - $text tag remove comments "$endQuotePrev + 2 chars" $beginQuote - } - } elseif {[regexp -indices {\*/} $workLine endIndex]} { - set endQuote "$lineNumber.[lindex $endIndex 1]" - set beginQuote [$text search -backward -regexp -- {/\*} $endQuote 0.0] - if {$beginQuote != ""} { - $text tag add comments $beginQuote "$endQuote + 1 chars" - } else { - $text tag add comments 0.0 "$endQuote + 1 chars" - } - set beginQuoteNext [$text search -forward -regexp -- {/\*} $endQuote end] - if {$beginQuoteNext != ""} { - $text tag remove comments "$endQuote + 2 chars" $beginQuoteNext - } - } else { - if {[lindex [split $beginQuote "."] 0] <= $lineNumber && [lindex [split $endQuote "."] 0] >= $lineNumber} { - #$text tag add comments $lineNumber.0 $lineNumber.end - } else { - $text tag remove comments $lineNumber.0 $lineNumber.end - } - } - - # DEDERER - # hightlight [, {, }, ], ( , ) - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp {\(|\[|{|}|\]|\)} $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add bold $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - - # parameter for command hightlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp -- {\s-\w+(?=\s)} $workLine a b]} { - set start [expr [string first $a $workLine] + 1] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add bindKey $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } -} - - - - - diff --git a/highlight/perl.tcl b/highlight/perl.tcl deleted file mode 100644 index 62f6083..0000000 --- a/highlight/perl.tcl +++ /dev/null @@ -1,204 +0,0 @@ -########################################################### -# Tcl/Tk Project Manager # -# version 0.0.1 # -# TCL highlight file # -# Copyright (c) "Sergey Kalinin", 2001, http://nuk-svk.ru # -# Author: Sergey Kalinin banzaj28@yandex.ru # -########################################################### -set beginQuote "0.0" -set endQuote "2.0" -set endQuotePrev "0.0" -proc HighLightPERL {text line lineNumber node} { - global fontNormal fontBold editorFontBold tree imgDir noteBook - global editor color - global beginQuote endQuote endQuotePrev - set startIndex 0 - - $text tag configure bold -font $editor(fontBold) - $text tag configure className -font $editor(fontBold) -foreground $color(procName) - $text tag configure keyWord -foreground $color(keyWord) - $text tag configure comments -foreground $color(comments) - $text tag configure variable -foreground $color(var) - $text tag configure string -foreground $color(string) - $text tag configure braceHighLight -font $editor(fontBold)\ - -foreground $color(braceBG) -background $color(braceFG) - $text tag configure brace -foreground $color(brace) - $text tag configure percent -foreground $color(percent) - $text tag configure bindKey -foreground $color(bindKey) - $text tag configure sql -font $editor(fontBold) -foreground $color(sql) - - set keyWord [info commands] - # for OOP extention - foreach n {print my use sub printf substr ord class method attribute constructor destructor invariant attribute binding new delete extends final finally implements import interface native new private protected public static super this throw synchronized throws transient try volatile void else } {lappend keyWord $n} - set dataType {list abstract boolean byte char double float int long short} - set sqlOperators {select from where and or count sum in order cast as by} - set a "" - set startPos 0 - set endPos 0 - set length 0 - set workLine $line - set className "" - while {$workLine != ""} { - if {[regexp "(^|\t| )\[a-zA-Z\\_:\]+" $workLine word]} { - set length [string length $word] - set startPos [string first [string trim $word] $line] - set endPos [expr $startPos + $length] - set workLine [string range $workLine $length end] - if {[lsearch $keyWord [string trim $word]] != -1} { - $text tag add keyWord $lineNumber.$startPos $lineNumber.$endPos - } - if {[lsearch $dataType [string trim $word]] != -1} { - $text tag add bold $lineNumber.$startPos $lineNumber.$endPos - } - if {[lsearch $sqlOperators [string trim $word]] != -1} { - $text tag add sql $lineNumber.$startPos $lineNumber.$endPos - } - if {[string trim $word]=="class" || [string trim $word]=="extends" || [string trim $word]=="implements" || [string trim $word]=="use"} { - $text tag add className $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]] - } - set startPos [expr $endPos + 1] - } else { - break - } - } - - # key binding highlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "<.*?>" $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add bindKey $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - # variable highlight # - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "\\$\[a-zA-Z\\_:\]+" $workLine a]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - if {$a != ""} { - $text tag add variable $lineNumber.$start $lineNumber.$end - } - set startPos $end - } else { - break - } - } - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "\\@\[a-zA-Z\\_:\]+" $workLine a]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - if {$a != ""} { - $text tag add variable $lineNumber.$start $lineNumber.$end - } - set startPos $end - } else { - break - } - } - # string " " highlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "\".*?\"" $workLine a b] || [regexp "\'.*?\'" $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add string $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - # persent % highlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - # if {[regexp "\%.*? " $workLine a b]} - if {[regexp "\%" $workLine a b] || [regexp "(\-\>)" $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add percent $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - ## COMENTS ## - set workLine [$text get $lineNumber.0 $lineNumber.end] - if {[regexp -indices "(^|\t|;| )#" $workLine word]} { - set p [lindex $word 1] - $text tag add comments $lineNumber.$p $lineNumber.end - } else { - $text tag remove comments $lineNumber.0 $lineNumber.end - } - - # DEDERER - # hightlight [, {, }, ], ( , ) - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp {\(|\[|{|}|\]|\)} $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add bold $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - - # parameter for command hightlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp -- {\s-\w+(?=\s)} $workLine a b]} { - set start [expr [string first $a $workLine] + 1] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add bindKey $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } -} - - - - - diff --git a/highlight/php.tcl b/highlight/php.tcl deleted file mode 100644 index 7158e76..0000000 --- a/highlight/php.tcl +++ /dev/null @@ -1,270 +0,0 @@ -########################################################### -# Tcl/Tk Project Manager # -# version 0.0.1 # -# TCL highlight file # -# Copyright (c) "Sergey Kalinin", 2001, http://nuk-svk.ru # -# Author: Sergey Kalinin banzaj28@yandex.ru # -########################################################### - -proc HighLightPHP {text line lineNumber node} { - global fontNormal fontBold editorFontBold tree imgDir noteBook - global editor color - global beginQuote endQuote endQuotePrev - # set pos [$text index insert] - # set lineNumber [lindex [split $pos "."] 0] - - set startIndex 0 - # bind text tags for highlightning # - $text tag configure bold -font $editor(fontBold) - $text tag configure procName -font $editor(fontBold) -foreground $color(procName) - $text tag configure keyWord -foreground $color(keyWord) - $text tag configure comments -foreground $color(comments) - $text tag configure variable -foreground $color(var) - $text tag configure string -foreground $color(string) - $text tag configure braceHighLight -font $editor(fontBold)\ - -foreground $color(braceBG) -background $color(braceFG) - $text tag configure brace -foreground $color(brace) - $text tag configure percent -foreground $color(percent) - $text tag configure bindKey -foreground $color(bindKey) - $text tag configure rivet -foreground $color(bindKey) -font $editor(fontBold) -foreground "#ff8800" ;#-background "#c6c6c6" - $text tag configure sql -font $editor(fontBold) -foreground $color(sql) - # incr lineNumber - set keyWord [info commands] - # for OOP extention - foreach n {class method attribute constructor destructor invariant attribute binding new delete \ - mcset mc mclocale mcpreferences mcload mcunknown configure match else elseif} { - lappend keyWord $n - } - foreach n {var include_once include function case echo select from where in order by and or} { - lappend keyWord $n - } - set dataType {true false} - set sqlOperators {select from where and or count sum in order cast as by} - set a "" - set startPos 0 - set endPos 0 - set length 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "(^|\t| )\[a-zA-Z\\_:\]+" $workLine word]} { - set length [string length $word] - set startPos [string first [string trim $word] $line] - set endPos [expr $startPos + $length] - set workLine [string range $workLine $length end] - if {[lsearch $keyWord [string trim $word]] != -1} { - $text tag add keyWord $lineNumber.$startPos $lineNumber.$endPos - } - if {[lsearch $dataType [string trim $word]] != -1} { - $text tag add bold $lineNumber.$startPos $lineNumber.$endPos - } - if {[lsearch $sqlOperators [string trim $word]] != -1} { - $text tag add sql $lineNumber.$startPos $lineNumber.$endPos - } - if {[string trim $word]=="proc"} { - $text tag add procName $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]] - } - set startPos [expr $endPos + 1] - } else { - break - } - } - set workLine $line - while {$workLine != ""} { - if {[regexp {(\{|\[)[a-zA-Z\\_:]+} $workLine word v]} { - set word [string trim $word $v] - set length [string length $word] - set startPos [string first [string trim $word] $line] - set endPos [expr $startPos + $length] - set workLine [string range $workLine $length end] - if {[lsearch $keyWord [string trim $word]] != -1} { - $text tag add keyWord $lineNumber.$startPos $lineNumber.$endPos - } - if {[string trim $word]=="proc"} { - $text tag add procName $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]] - } - set startPos [expr $endPos + 1] - } else { - break - } - } - - # key binding highlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "( \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 - } - } -} - - - - - diff --git a/highlight/rivet.tcl b/highlight/rivet.tcl deleted file mode 100644 index 7032dbe..0000000 --- a/highlight/rivet.tcl +++ /dev/null @@ -1,249 +0,0 @@ -########################################################### -# Tcl/Tk Project Manager # -# version 0.0.1 # -# TCL highlight file # -# Copyright (c) "Sergey Kalinin", 2001, http://nuk-svk.ru # -# Author: Sergey Kalinin banzaj28@yandex.ru # -########################################################### - -proc HighLightRIVET {text line lineNumber node} { - global fontNormal fontBold editorFontBold tree imgDir noteBook - global editor color - # set pos [$text index insert] - # set lineNumber [lindex [split $pos "."] 0] - - set startIndex 0 - # bind text tags for highlightning # - $text tag configure bold -font $editor(fontBold) - $text tag configure sql -font $editor(fontBold) -foreground $color(sql) - $text tag configure procName -font $editor(fontBold) -foreground $color(procName) - $text tag configure keyWord -foreground $color(keyWord) - $text tag configure comments -foreground $color(comments) - $text tag configure variable -foreground $color(var) - $text tag configure string -foreground $color(string) - $text tag configure braceHighLight -font $editor(fontBold)\ - -foreground $color(braceBG) -background $color(braceFG) - $text tag configure brace -foreground $color(brace) - $text tag configure percent -foreground $color(percent) - $text tag configure bindKey -foreground $color(bindKey) - $text tag configure rivet -foreground $color(bindKey) -font $editor(fontBold) -foreground "#ff8800" ;#-background "#c6c6c6" - # incr lineNumber - set keyWord [info commands] - # for OOP extention - foreach n {class method attribute constructor destructor invariant attribute binding new delete \ - mcset mc mclocale mcpreferences mcload mcunknown configure match else elseif} { - lappend keyWord $n - } - set dataType {true false} - set sqlOperators {select from where and or count sum in order cast as by} - set a "" - set startPos 0 - set endPos 0 - set length 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "(^|\t| )\[a-zA-Z\\_:\]+" $workLine word]} { - set length [string length $word] - set startPos [string first [string trim $word] $line] - set endPos [expr $startPos + $length] - set workLine [string range $workLine $length end] - if {[lsearch $keyWord [string trim $word]] != -1} { - $text tag add keyWord $lineNumber.$startPos $lineNumber.$endPos - } - if {[lsearch $dataType [string trim $word]] != -1} { - $text tag add bold $lineNumber.$startPos $lineNumber.$endPos - } - if {[lsearch $sqlOperators [string tolower [string trim $word]]] != -1} { - $text tag add sql $lineNumber.$startPos $lineNumber.[expr $endPos - 1] - } - if {[string trim $word]=="proc"} { - $text tag add procName $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]] - } - set startPos [expr $endPos + 1] - } else { - break - } - } - set workLine $line - while {$workLine != ""} { - if {[regexp {(\{|\[)[a-zA-Z\\_:]+} $workLine word v]} { - set word [string trim $word $v] - set length [string length $word] - set startPos [string first [string trim $word] $line] - set endPos [expr $startPos + $length] - set workLine [string range $workLine $length end] - if {[lsearch $keyWord [string trim $word]] != -1} { - $text tag add keyWord $lineNumber.$startPos $lineNumber.$endPos - } - if {[string trim $word]=="proc"} { - $text tag add procName $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]] - } - set startPos [expr $endPos + 1] - } else { - break - } - } - - # key binding highlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "( \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 - } - } - -} - - - - - - - - - - - - - - - - diff --git a/highlight/ruby.tcl b/highlight/ruby.tcl deleted file mode 100644 index 2626d52..0000000 --- a/highlight/ruby.tcl +++ /dev/null @@ -1,189 +0,0 @@ -########################################################### -# Tcl/Tk Project Manager # -# version 0.0.1 # -# TCL highlight file # -# Copyright (c) "Sergey Kalinin", 2001, http://nuk-svk.ru # -# Author: Sergey Kalinin banzaj28@yandex.ru # -########################################################### -set beginQuote "0.0" -set endQuote "2.0" -set endQuotePrev "0.0" -proc HighLightRUBY {text line lineNumber node} { - global fontNormal fontBold editorFontBold tree imgDir noteBook - global editor color - global beginQuote endQuote endQuotePrev - set startIndex 0 - - $text tag configure bold -font $editor(fontBold) - $text tag configure procName -font $editor(fontBold) -foreground $color(procName) - $text tag configure keyWord -foreground $color(keyWord) - $text tag configure comments -foreground $color(comments) - $text tag configure variable -foreground $color(var) - $text tag configure string -foreground $color(string) - $text tag configure braceHighLight -font $editor(fontBold)\ - -foreground $color(braceBG) -background $color(braceFG) - $text tag configure brace -foreground $color(brace) - $text tag configure percent -foreground $color(percent) - $text tag configure bindKey -foreground $color(bindKey) - $text tag configure sql -font $editor(fontBold) -foreground $color(sql) - - set keyWord [info commands] - # for OOP extention - foreach n {class method attribute constructor destructor invariant attribute binding new delete extends final finally implements import interface native new private protected public static super this throw synchronized throws transient try volatile void else def end slots require} {lappend keyWord $n} - set dataType {list abstract boolean byte char double float int long short} - set sqlOperators {select from where and or count sum in order cast as by} - set a "" - set startPos 0 - set endPos 0 - set length 0 - set workLine $line - set className "" - while {$workLine != ""} { - if {[regexp "(^|\t| )\[a-zA-Z\\_:\]+" $workLine word]} { - set length [string length $word] - set startPos [string first [string trim $word] $line] - set endPos [expr $startPos + $length] - set workLine [string range $workLine $length end] - if {[lsearch $keyWord [string trim $word]] != -1} { - $text tag add keyWord $lineNumber.$startPos $lineNumber.$endPos - } - if {[lsearch $dataType [string trim $word]] != -1} { - $text tag add bold $lineNumber.$startPos $lineNumber.$endPos - } - if {[string trim $word]=="class"} { - $text tag add procName $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]] - puts "$text tag add procName $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]]" - } - set startPos [expr $endPos + 1] - } else { - break - } - } - - # key binding highlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "<.*?>" $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add bindKey $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - # variable highlight # - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "\\@\[a-zA-Z\\_:\]+" $workLine a]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - if {$a != ""} { - $text tag add variable $lineNumber.$start $lineNumber.$end - } - set startPos $end - } else { - break - } - } - # string " " highlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "\".*?\"" $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add string $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - # persent % highlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - # if {[regexp "\%.*? " $workLine a b]} - if {[regexp "\%" $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add percent $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - ## COMENTS ## - # add comment # - set workLine [$text get $lineNumber.0 $lineNumber.end] - if {[regexp -indices "(^|\t|;| )#" $workLine word]} { - set p [lindex $word 1] - $text tag add comments $lineNumber.$p $lineNumber.end - } else { - $text tag remove comments $lineNumber.0 $lineNumber.end - } - - # DEDERER - # hightlight [, {, }, ], ( , ) - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp {\(|\[|{|}|\]|\)} $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add bold $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - - # parameter for command hightlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp -- {\s-\w+(?=\s)} $workLine a b]} { - set start [expr [string first $a $workLine] + 1] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add bindKey $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } -} - - - - - - - - - diff --git a/highlight/spec.tcl b/highlight/spec.tcl deleted file mode 100644 index db4a5d6..0000000 --- a/highlight/spec.tcl +++ /dev/null @@ -1,136 +0,0 @@ -########################################################### -# Tcl/Tk Project Manager # -# version 0.0.1 # -# SPEC highlight file # -# Copyright (c) "Sergey Kalinin", 2001, http://nuk-svk.ru # -# Author: Sergey Kalinin banzaj28@yandex.ru # -########################################################### - -proc HighLightSPEC {text line lineNumber node} { - global fontNormal editorFontBold fontBold tree imgDir noteBook - global editor color -# set pos [$text index insert] -# set lineNumber [lindex [split $pos "."] 0] - - set startIndex 0 - # bind text tags for highlightning # -# foreach tag {bold procName comments string number variable} { -# $text tag remove $tag $lineNumber.0 $lineNumber.end -# } - - $text tag configure bold -font $editor(fontBold) - $text tag configure procName -font $editor(fontBold) -foreground $color(procName) - $text tag configure keyWord -foreground $color(keyWord) - $text tag configure comments -foreground $color(comments) - $text tag configure variable -foreground $color(var) - $text tag configure string -foreground $color(string) - $text tag configure braceHighLight -font $editor(fontBold)\ - -foreground $color(braceBG) -background $color(braceFG) - $text tag configure brace -foreground $color(brace) - $text tag configure percent -foreground $color(percent) - $text tag configure bindKey -foreground $color(bindKey) -# $text tag configure bold -font $fontBold -# $text tag configure procName -font $editorFontBold -foreground blue -# $text tag configure keyWord -foreground #0000a8 -# $text tag configure comments -foreground #9b9b9b -# $text tag configure variable -foreground #e50000 -# $text tag configure string -foreground #168400 -# $text tag configure braceHighLight -font $editorFontBold -foreground green -background black -# $text tag configure brace -foreground brown -# $text tag configure percent -foreground #a500c6 - - foreach n {define name version release description prep setup build install post postun clean files defattr changelog doc} { - lappend keyWord $n - } - # add comment # - if {[string range [string trim $line] 0 0] == "#"} { - $text tag add comments $lineNumber.0 $lineNumber.end - return 0 - } - - set a "" - regexp "^( |\t|\%)*(\[a-z\]|\[A-Z\]|\[0-9\]|_|:|~|\\.|/)+" $line a - if {$a != ""} { - # gets name - set b "" - regexp "^( |\t|\%)*" $line b - set nameStart [string length $b] - set nameEnd [string length $a] - set name [string range $a [string length $b] end] - # is it keyword? - if {[lsearch $keyWord $name] != -1} { - incr nameStart $startIndex - incr nameEnd $startIndex - $text tag add keyWord $lineNumber.$nameStart $lineNumber.$nameEnd - } - } - # variable highlight # - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "\\$\[a-zA-Z\\_:\]+" $workLine a]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - if {$a != ""} { - $text tag add variable $lineNumber.$start $lineNumber.$end - } - set startPos $end - } else { - break - } - } - # string { } highlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "\{.*?\}" $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add string $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - # persent % highlight - set startPos 0 - set workLine $line - while {$workLine != ""} { -# if {[regexp "\%.*? " $workLine a b]} - if {[regexp "\%" $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add percent $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - #find [ -# set i [string first "\[" $line] -# if {$i != -1} { -# incr i -# set line [string range $line $i end] -# incr i $startIndex -# set l [HighLight $text $line $i $node] -# eval lappend res $l -# } - -# return $res - -} - - - diff --git a/highlight/tcl.tcl b/highlight/tcl.tcl deleted file mode 100644 index 91548fc..0000000 --- a/highlight/tcl.tcl +++ /dev/null @@ -1,227 +0,0 @@ -########################################### -# Tcl/Tk Project Manager -# version 0.0.1 -# TCL highlight file -# Copyright (c) Sergey Kalinin 2001, http://nuk-svk.ru -# Author: Sergey Kalinin (aka BanZaj) banzaj28@gmail.com -########################################### - -proc HighLightTCL {text line lineNumber node} { - global fontNormal fontBold editorFontBold tree imgDir noteBook - global editor color - - set startIndex 0 - # bind text tags for highlightning # - $text tag configure bold -font $editor(fontBold) - $text tag configure procName -font $editor(fontBold) -foreground $color(procName) - $text tag configure keyWord -foreground $color(keyWord) - $text tag configure comments -foreground $color(comments) - $text tag configure variable -foreground $color(var) - $text tag configure string -foreground $color(string) - $text tag configure braceHighLight -font $editor(fontBold)\ - -foreground $color(braceBG) -background $color(braceFG) - $text tag configure brace -foreground $color(brace) - $text tag configure bracequad -foreground $color(bracequad) - $text tag configure percent -foreground $color(percent) - $text tag configure bindKey -foreground $color(bindKey) - - # incr lineNumber - set keyWord [info commands] - # for OOP extention - foreach n {class method attribute constructor destructor invariant attribute binding new delete \ - mcset mc mclocale mcpreferences mcload mcunknown configure match else elseif} { - lappend keyWord $n - } - set dataType {true false} - set a "" - set startPos 0 - set endPos 0 - set length 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "(^|\t| )\[a-zA-Z\\_:\]+" $workLine word]} { - set length [string length $word] - set startPos [string first [string trim $word] $line] - set endPos [expr $startPos + $length] - set workLine [string range $workLine $length end] - if {[lsearch $keyWord [string trim $word]] != -1} { - $text tag add keyWord $lineNumber.$startPos $lineNumber.$endPos - } - if {[lsearch $dataType [string trim $word]] != -1} { - $text tag add bold $lineNumber.$startPos $lineNumber.$endPos - } - if {[string trim $word]=="proc"} { - $text tag add procName $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]] - } - set startPos [expr $endPos + 1] - } else { - break - } - } - set workLine $line - while {$workLine != ""} { - if {[regexp {(\{|\[)[a-zA-Z\\_:]+} $workLine word v]} { - set word [string trim $word $v] - set length [string length $word] - set startPos [string first [string trim $word] $line] - set endPos [expr $startPos + $length] - set workLine [string range $workLine $length end] - if {[lsearch $keyWord [string trim $word]] != -1} { - $text tag add keyWord $lineNumber.$startPos $lineNumber.$endPos - } - if {[string trim $word]=="proc"} { - $text tag add procName $lineNumber.[expr $startPos + $length] $lineNumber.[string wordend $line [expr $startPos + $length +2]] - } - set startPos [expr $endPos + 1] - } else { - break - } - } - - # key binding highlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "<.*?>" $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add bindKey $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - # variable highlight # - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "\\$\[a-zA-Z\\_:\]+" $workLine a]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - if {$a != ""} { - $text tag add variable $lineNumber.$start $lineNumber.$end - } - set startPos $end - } else { - break - } - } - # string " " highlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "\".*?\"" $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add string $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - # persent % highlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "\%" $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add percent $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp "\{|\}" $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add brace $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - - # add comment # - set workLine [$text get $lineNumber.0 $lineNumber.end] - if {[regexp -indices "(^|\t|;| )#" $workLine word]} { - set p [lindex $word 1] - $text tag add comments $lineNumber.$p $lineNumber.end - } else { - $text tag remove comments $lineNumber.0 $lineNumber.end - } - # DEDERER - # hightlight [, {, }, ] - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp {\(|\[|\]|\)} $workLine a b]} { - set start [string first $a $workLine] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add bracequad $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } - # parameter for command hightlight - set startPos 0 - set workLine $line - while {$workLine != ""} { - if {[regexp -- {\s-\w+(?=\s)} $workLine a b]} { - set start [expr [string first $a $workLine] + 1] - set end $start - incr end [string length $a] - set workLine [string range $workLine $end end] - incr start $startPos - incr end $startPos - $text tag add bindKey $lineNumber.$start $lineNumber.$end - set startPos $end - } else { - break - } - } -} - - - - - - - - - - - - - - - - diff --git a/html_lib.tcl b/html_lib.tcl deleted file mode 100644 index d9a6f44..0000000 --- a/html_lib.tcl +++ /dev/null @@ -1,1437 +0,0 @@ -# Simple HTML display library by Stephen Uhler (stephen.uhler@sun.com) -# Copyright (c) 1995 by Sun Microsystems -# Version 0.3 Fri Sep 1 10:47:17 PDT 1995 -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# To use this package, create a text widget (say, .text) -# and set a variable full of html, (say $html), and issue: -# HM::init_win .text -# HM::parse_html $html "HM::render .text" -# You also need to supply the routine: -# proc HM::link_callback {win href} { ...} -# win: The name of the text widget -# href The name of the link -# which will be called anytime the user "clicks" on a link. -# !!! Use HM::set_link_callback !!! -# The supplied version just prints the link to stdout. -# In addition, if you wish to use embedded images, you will need to write -# proc HM::set_image {handle src} -# handle an arbitrary handle (not really) -# src The name of the image -# Which calls -# HM::got_image $handle $image -# with the TK image. -# -# To return a "used" text widget to its initialized state, call: -# HM::reset_win .text -# See "sample.tcl" for sample usage -################################################################## -############################################ -# mapping of html tags to text tag properties -# properties beginning with "T" map directly to text tags - -namespace eval HM { -} - -# These are Defined in HTML 2.0 - -proc HM::init_array {} { - global HM::tag_map HM::insert_map HM::list_elements HM::param_map - global HM::events HM::esc_map HM::form_map HM::proc_link_callback - -array set HM::tag_map { - b {weight bold} - blockquote {style i indent 1 Trindent rindent} - bq {style i indent 1 Trindent rindent} - cite {style i} - code {family courier} - dfn {style i} - dir {indent 1} - dl {indent 1} - em {style i} - h1 {size 24 weight bold} - h2 {size 22} - h3 {size 20} - h4 {size 18} - h5 {size 16} - h6 {style i} - i {style i} - kbd {family courier weight bold} - menu {indent 1} - ol {indent 1} - pre {fill 0 family courier Tnowrap nowrap} - samp {family courier} - strong {weight bold} - tt {family courier} - u {Tunderline underline} - ul {indent 1} - var {style i} -} - -# These are in common(?) use, but not defined in html2.0 - -array set HM::tag_map { - center {Tcenter center} - strike {Tstrike strike} - u {Tunderline underline} -} - -# initial values - -set HM::tag_map(hmstart) { - family times weight medium style r size 14 - Tcenter "" Tlink "" Tnowrap "" Tunderline "" list list - fill 1 indent "" counter 0 adjust 0 -} - -# html tags that insert white space - -array set HM::insert_map { - blockquote "\n\n" /blockquote "\n" - br "\n" - dd "\n" /dd "\n" - dl "\n" /dl "\n" - dt "\n" - form "\n" /form "\n" - h1 "\n\n" /h1 "\n" - h2 "\n\n" /h2 "\n" - h3 "\n\n" /h3 "\n" - h4 "\n" /h4 "\n" - h5 "\n" /h5 "\n" - h6 "\n" /h6 "\n" - li "\n" - /dir "\n" - /ul "\n" - /ol "\n" - /menu "\n" - p "\n\n" - pre "\n" /pre "\n" -} - -# tags that are list elements, that support "compact" rendering - -array set HM::list_elements { - ol 1 ul 1 menu 1 dl 1 dir 1 -} - -# alter the parameters of the text state -# this allows an application to over-ride the default settings -# it is called as: HM::set_state -param value -param value ... - -array set HM::param_map { - -update S_update - -tab S_tab - -unknown S_unknown - -stop S_stop - -size S_adjust_size - -symbols S_symbols - -insert S_insert -} - -array set HM::events { - Enter {-borderwidth 2 -relief flat -underline 1} - Leave {-borderwidth 2 -relief flat -underline 0} - 1 {-borderwidth 2 -relief sunken} - ButtonRelease-1 {-borderwidth 2 -relief flat} -} - -# table of escape characters (ISO latin-1 esc's are in a different table) - -array set HM::esc_map { - lt < gt > amp & quot \" copy \xa9 - reg \xae ob \x7b cb \x7d nbsp \xa0 -} -############################################################# -# ISO Latin-1 escape codes - -array set HM::esc_map { - nbsp \xa0 iexcl \xa1 cent \xa2 pound \xa3 curren \xa4 - yen \xa5 brvbar \xa6 sect \xa7 uml \xa8 copy \xa9 - ordf \xaa laquo \xab not \xac shy \xad reg \xae - hibar \xaf deg \xb0 plusmn \xb1 sup2 \xb2 sup3 \xb3 - acute \xb4 micro \xb5 para \xb6 middot \xb7 cedil \xb8 - sup1 \xb9 ordm \xba raquo \xbb frac14 \xbc frac12 \xbd - frac34 \xbe iquest \xbf Agrave \xc0 Aacute \xc1 Acirc \xc2 - Atilde \xc3 Auml \xc4 Aring \xc5 AElig \xc6 Ccedil \xc7 - Egrave \xc8 Eacute \xc9 Ecirc \xca Euml \xcb Igrave \xcc - Iacute \xcd Icirc \xce Iuml \xcf ETH \xd0 Ntilde \xd1 - Ograve \xd2 Oacute \xd3 Ocirc \xd4 Otilde \xd5 Ouml \xd6 - times \xd7 Oslash \xd8 Ugrave \xd9 Uacute \xda Ucirc \xdb - Uuml \xdc Yacute \xdd THORN \xde szlig \xdf agrave \xe0 - aacute \xe1 acirc \xe2 atilde \xe3 auml \xe4 aring \xe5 - aelig \xe6 ccedil \xe7 egrave \xe8 eacute \xe9 ecirc \xea - euml \xeb igrave \xec iacute \xed icirc \xee iuml \xef - eth \xf0 ntilde \xf1 ograve \xf2 oacute \xf3 ocirc \xf4 - otilde \xf5 ouml \xf6 divide \xf7 oslash \xf8 ugrave \xf9 - uacute \xfa ucirc \xfb uuml \xfc yacute \xfd thorn \xfe - yuml \xff -} - -########################################################## -# html forms management commands - -# As each form element is located, it is created and rendered. Additional -# state is stored in a form specific global variable to be processed at -# the end of the form, including the "reset" and "submit" options. -# Remember, there can be multiple forms existing on multiple pages. When -# HTML tables are added, a single form could be spread out over multiple -# text widgets, which makes it impractical to hang the form state off the -# HM::$win structure. We don't need to check for the existance of required -# parameters, we just "fail" and get caught in HM::render - -# This causes line breaks to be preserved in the inital values -# of text areas -array set HM::tag_map { - textarea {fill 0} -} - -# These are handled specially -array set HM::form_map { - " " + \n %0d%0a -} - -} -############################################ -# initialize the window and stack state - -proc HM::init_win {win} { - HM::init_array - upvar #0 HM::$win var - - HM::init_state $win - $win tag configure underline -underline 1 - $win tag configure center -justify center - $win tag configure nowrap -wrap none - $win tag configure rindent -rmargin $var(S_tab)c - $win tag configure strike -overstrike 1 - $win tag configure mark -foreground red ;# list markers - $win tag configure list -spacing1 3p -spacing3 3p ;# regular lists - $win tag configure compact -spacing1 0p ;# compact lists - $win tag configure link -borderwidth 0 -foreground blue;# hypertext links - HM::set_indent $win $var(S_tab) - $win configure -wrap word - - # configure the text insertion point - $win mark set $var(S_insert) 1.0 - - # for horizontal rules - $win tag configure thin -font [HM::x_font times 2 medium r] - $win tag configure hr -relief sunken -borderwidth 2 -wrap none \ - -tabs [winfo width $win] - bind $win { - %W tag configure hr -tabs %w - %W tag configure last -spacing3 %h - } - - # generic link enter callback - - $win tag bind link <1> "HM::link_hit $win %x %y" -} - -proc HM::set_link_callback {name} { - global HM::proc_link_callback - set HM::proc_link_callback $name -} - -# set the indent spacing (in cm) for lists -# TK uses a "weird" tabbing model that causes \t to insert a single -# space if the current line position is past the tab setting - -proc HM::set_indent {win cm} { - set tabs [expr $cm / 2.0] - $win configure -tabs ${tabs}c - foreach i {1 2 3 4 5 6 7 8 9} { - set tab [expr $i * $cm] - $win tag configure indent$i -lmargin1 ${tab}c -lmargin2 ${tab}c \ - -tabs "[expr $tab + $tabs]c [expr $tab + 2*$tabs]c" - } -} - -# reset the state of window - get ready for the next page -# remove all but the font tags, and remove all form state - -proc HM::reset_win {win} { - upvar #0 HM::$win var - regsub -all { +[^L ][^ ]*} " [$win tag names] " {} tags - catch "$win tag delete $tags" - eval $win mark unset [$win mark names] - $win delete 0.0 end - $win tag configure hr -tabs [winfo width $win] - - # configure the text insertion point - $win mark set $var(S_insert) 1.0 - - # remove form state. If any check/radio buttons still exists, - # their variables will be magically re-created, and never get - # cleaned up. - catch unset [info globals HM::$win.form*] - - HM::init_state $win - return HM::$win -} - -# initialize the window's state array -# Parameters beginning with S_ are NOT reset -# adjust_size: global font size adjuster -# unknown: character to use for unknown entities -# tab: tab stop (in cm) -# stop: enabled to stop processing -# update: how many tags between update calls -# tags: number of tags processed so far -# symbols: Symbols to use on un-ordered lists - -proc HM::init_state {win} { - upvar #0 HM::$win var - array set tmp [array get var S_*] - catch {unset var} - array set var { - stop 0 - tags 0 - fill 0 - list list - S_adjust_size 0 - S_tab 1.0 - S_unknown \xb7 - S_update 10 - S_symbols O*=+-o\xd7\xb0>:\xb7 - S_insert Insert - } - array set var [array get tmp] -} - -proc HM::set_state {win args} { - upvar #0 HM::$win var - global HM::param_map - set bad 0 - if {[catch {array set params $args}]} {return 0} - foreach i [array names params] { - incr bad [catch {set var($HM::param_map($i)) $params($i)}] - } - return [expr $bad == 0] -} - -############################################ -# manage the display of html - -# HM::render gets called for every html tag -# win: The name of the text widget to render into -# tag: The html tag (in arbitrary case) -# not: a "/" or the empty string -# param: The un-interpreted parameter list -# text: The plain text until the next html tag - -proc HM::render {win tag not param text} { - upvar #0 HM::$win var - if {$var(stop)} return - global HM::tag_map HM::insert_map HM::list_elements - set tag [string tolower $tag] - set text [HM::map_esc $text] - - # manage compact rendering of lists - if {[info exists HM::list_elements($tag)]} { - set list "list [expr {[HM::extract_param $param compact] ? "compact" : "list"}]" - } else { - set list "" - } - - # Allow text to be diverted to a different window (for tables) - # this is not currently used - if {[info exists var(divert)]} { - set win $var(divert) - upvar #0 HM::$win var - } - - # adjust (push or pop) tag state - catch {HM::stack $win $not "$HM::tag_map($tag) $list"} - - # insert white space (with current font) - # adding white space can get a bit tricky. This isn't quite right - set bad [catch {$win insert $var(S_insert) $HM::insert_map($not$tag) "space $var(font)"}] - if {!$bad && [lindex $var(fill) end]} { - set text [string trimleft $text] - } - - # to fill or not to fill - if {[lindex $var(fill) end]} { - set text [HM::zap_white $text] - } - - # generic mark hook - catch {HM::mark $not$tag $win $param text} err - - # do any special tag processing - catch {HM::tag_$not$tag $win $param text} msg - - - # add the text with proper tags - - set tags [HM::current_tags $win] - $win insert $var(S_insert) $text $tags - - # We need to do an update every so often to insure interactive response. - # This can cause us to re-enter the event loop, and cause recursive - # invocations of HM::render, so we need to be careful. - if {!([incr var(tags)] % $var(S_update))} { - update - } -} - -# html tags requiring special processing -# Procs of the form HM::tag_ or HM::tag_ get called just before -# the text for this tag is displayed. These procs are called inside a -# "catch" so it is OK to fail. -# win: The name of the text widget to render into -# param: The un-interpreted parameter list -# text: A pass-by-reference name of the plain text until the next html tag -# Tag commands may change this to affect what text will be inserted -# next. - -# A pair of pseudo tags are added automatically as the 1st and last html -# tags in the document. The default is and . -# Append enough blank space at the end of the text widget while -# rendering so HM::goto can place the target near the top of the page, -# then remove the extra space when done rendering. - -proc HM::tag_hmstart {win param text} { - upvar #0 HM::$win var - $win mark gravity $var(S_insert) left - $win insert end "\n " last - $win mark gravity $var(S_insert) right -} - -proc HM::tag_/hmstart {win param text} { - $win delete last.first end -} - -# put the document title in the window banner, and remove the title text -# from the document - -proc HM::tag_title {win param text} { - upvar $text data - wm title [winfo toplevel $win] $data - set data "" -} - -proc HM::tag_hr {win param text} { - upvar #0 HM::$win var - $win insert $var(S_insert) "\n" space "\n" thin "\t" "thin hr" "\n" thin -} - -# list element tags - -proc HM::tag_ol {win param text} { - upvar #0 HM::$win var - set var(count$var(level)) 0 -} - -proc HM::tag_ul {win param text} { - upvar #0 HM::$win var - catch {unset var(count$var(level))} -} - -proc HM::tag_menu {win param text} { - upvar #0 HM::$win var - set var(menu) -> - set var(compact) 1 -} - -proc HM::tag_/menu {win param text} { - upvar #0 HM::$win var - catch {unset var(menu)} - catch {unset var(compact)} -} - -proc HM::tag_dt {win param text} { - upvar #0 HM::$win var - upvar $text data - set level $var(level) - incr level -1 - $win insert $var(S_insert) "$data" \ - "hi [lindex $var(list) end] indent$level $var(font)" - set data {} -} - -proc HM::tag_li {win param text} { - upvar #0 HM::$win var - set level $var(level) - incr level -1 - set x [string index $var(S_symbols)+-+-+-+-" $level] - catch {set x [incr var(count$level)]} - catch {set x $var(menu)} - $win insert $var(S_insert) \t$x\t "mark [lindex $var(list) end] indent$level $var(font)" -} - -# Manage hypertext "anchor" links. A link can be either a source (href) -# a destination (name) or both. If its a source, register it via a callback, -# and set its default behavior. If its a destination, check to see if we need -# to go there now, as a result of a previous HM::goto request. If so, schedule -# it to happen with the closing tag, so we can highlight the text up to -# the . - -proc HM::tag_a {win param text} { - upvar #0 HM::$win var - - # a source - - if {[HM::extract_param $param href]} { - set var(Tref) [list L:$href] - HM::stack $win "" "Tlink link" - HM::link_setup $win $href - } - - # a destination - - if {[HM::extract_param $param name]} { - set var(Tname) [list N:$name] - HM::stack $win "" "Tanchor anchor" - $win mark set N:$name "$var(S_insert) - 1 chars" - $win mark gravity N:$name left - if {[info exists var(goto)] && $var(goto) == $name} { - unset var(goto) - set var(going) $name - } - } -} - -# The application should call here with the fragment name -# to cause the display to go to this spot. -# If the target exists, go there (and do the callback), -# otherwise schedule the goto to happen when we see the reference. - -proc HM::goto {win where {callback HM::went_to}} { - upvar #0 HM::$win var - if {[regexp N:$where [$win mark names]]} { - $win see N:$where - update - eval $callback $win [list $where] - return 1 - } else { - set var(goto) $where - return 0 - } -} - -# We actually got to the spot, so highlight it! -# This should/could be replaced by the application -# We'll flash it orange a couple of times. - -proc HM::went_to {win where {count 0} {color orange}} { - upvar #0 HM::$win var - if {$count > 5} return - catch {$win tag configure N:$where -foreground $color} - update - after 200 [list HM::went_to $win $where [incr count] \ - [expr {$color=="orange" ? "" : "orange"}]] -} - -proc HM::tag_/a {win param text} { - upvar #0 HM::$win var - if {[info exists var(Tref)]} { - unset var(Tref) - HM::stack $win / "Tlink link" - } - - # goto this link, then invoke the call-back. - - if {[info exists var(going)]} { - $win yview N:$var(going) - update - HM::went_to $win $var(going) - unset var(going) - } - - if {[info exists var(Tname)]} { - unset var(Tname) - HM::stack $win / "Tanchor anchor" - } -} - -# Inline Images -# This interface is subject to change -# Most of the work is getting around a limitation of TK that prevents -# setting the size of a label to a widthxheight in pixels -# -# Images have the following parameters: -# align: top,middle,bottom -# alt: alternate text -# ismap: A clickable image map -# src: The URL link -# Netscape supports (and so do we) -# width: A width hint (in pixels) -# height: A height hint (in pixels) -# border: The size of the window border - -proc HM::tag_img {win param text} { - upvar #0 HM::$win var - - # get alignment - array set align_map {top top middle center bottom bottom} - set align bottom ;# The spec isn't clear what the default should be - HM::extract_param $param align - catch {set align $align_map([string tolower $align])} - - # get alternate text - set alt "" - HM::extract_param $param alt - set alt [HM::map_esc $alt] - - # get the border width - set border 1 - HM::extract_param $param border - - # see if we have an image size hint - # If so, make a frame the "hint" size to put the label in - # otherwise just make the label - set item $win.$var(tags) - # catch {destroy $item} - if {[HM::extract_param $param width] && [HM::extract_param $param height]} { - frame $item -width $width -height $height - pack propagate $item 0 - set label $item.label - label $label - pack $label -expand 1 -fill both - } else { - set label $item - label $label - } - - $label configure -relief ridge -fg orange -text $alt - catch {$label configure -bd $border} - $win window create $var(S_insert) -align $align -window $item -pady 2 -padx 2 - - # add in all the current tags (this is overkill) - set tags [HM::current_tags $win] - foreach tag $tags { - $win tag add $tag $item - } - - # set imagemap callbacks - if {[HM::extract_param $param ismap]} { - # regsub -all {[^L]*L:([^ ]*).*} $tags {\1} link - set link [lindex $tags [lsearch -glob $tags L:*]] - regsub L: $link {} link - global HM::events - regsub -all {%} $link {%%} link2 - foreach i [array names HM::events] { - bind $label <$i> "catch \{%W configure $HM::events($i)\}" - } - bind $label <1> "+HM::link_callback $win $link2?%x,%y" - } - - # now callback to the application - set src "" - HM::extract_param $param src - HM::set_image $win $label $src - return $label ;# used by the forms package for input_image types -} - -# The app needs to supply one of these -proc HM::set_image {win handle src} { - HM::got_image $handle "can't get\n$src" -} - -# When the image is available, the application should call back here. -# If we have the image, put it in the label, otherwise display the error -# message. If we don't get a callback, the "alt" text remains. -# if we have a clickable image, arrange for a callback - -proc HM::got_image {win image_error} { - # if we're in a frame turn on geometry propogation - if {[winfo name $win] == "label"} { - pack propagate [winfo parent $win] 1 - } - if {[catch {$win configure -image $image_error}]} { - $win configure -image {} - $win configure -text $image_error - } -} - -# Sample hypertext link callback routine - should be replaced by app -# This proc is called once for each tag. -# Applications can overwrite this procedure, as required, or -# replace the HM::events array -# win: The name of the text widget to render into -# href: The HREF link for this tag. - -# We need to escape any %'s in the href tag name so the bind command -# doesn't try to substitute them. - -proc HM::link_setup {win href} { - global HM::events - regsub -all {%} $href {%%} href2 - foreach i [array names HM::events] { - eval {$win tag bind L:$href <$i>} \ - \{$win tag configure \{L:$href2\} $HM::events($i)\} - } -} - -# generic link-hit callback -# This gets called upon button hits on hypertext links -# Applications are expected to supply ther own HM::link_callback routine -# win: The name of the text widget to render into -# x,y: The cursor position at the "click" - -proc HM::link_hit {win x y} { - set tags [$win tag names @$x,$y] - set link [lindex $tags [lsearch -glob $tags L:*]] - # regsub -all {[^L]*L:([^ ]*).*} $tags {\1} link - regsub L: $link {} link - HM::link_callback $win $link -} - -# replace this! -# win: The name of the text widget to render into -# href: The HREF link for this tag. - -proc HM::link_callback {win href} { - if {$HM::proc_link_callback != ""} { - $HM::proc_link_callback $win $href - } -} - -# extract a value from parameter list (this needs a re-do) -# returns "1" if the keyword is found, "0" otherwise -# param: A parameter list. It should alredy have been processed to -# remove any entity references -# key: The parameter name -# val: The variable to put the value into (use key as default) - -proc HM::extract_param {param key {val ""}} { - - if {$val == ""} { - upvar $key result - } else { - upvar $val result - } - set ws " \n\r" - - # look for name=value combinations. Either (') or (") are valid delimeters - if { - [regsub -nocase [format {.*%s[%s]*=[%s]*"([^"]*).*} $key $ws $ws] $param {\1} value] || - [regsub -nocase [format {.*%s[%s]*=[%s]*'([^']*).*} $key $ws $ws] $param {\1} value] || - [regsub -nocase [format {.*%s[%s]*=[%s]*([^%s]+).*} $key $ws $ws $ws] $param {\1} value] } { - set result $value - return 1 - } - - # now look for valueless names - # I should strip out name=value pairs, so we don't end up with "name" - # inside the "value" part of some other key word - some day - - set bad \[^a-zA-Z\]+ - if {[regexp -nocase "$bad$key$bad" -$param-]} { - return 1 - } else { - return 0 - } -} - -# These next two routines manage the display state of the page. - -# Push or pop tags to/from stack. -# Each orthogonal text property has its own stack, stored as a list. -# The current (most recent) tag is the last item on the list. -# Push is {} for pushing and {/} for popping - -proc HM::stack {win push list} { - upvar #0 HM::$win var - array set tags $list - if {$push == ""} { - foreach tag [array names tags] { - lappend var($tag) $tags($tag) - } - } else { - foreach tag [array names tags] { - # set cnt [regsub { *[^ ]+$} $var($tag) {} var($tag)] - set var($tag) [lreplace $var($tag) end end] - } - } -} - -# extract set of current text tags -# tags starting with T map directly to text tags, all others are -# handled specially. There is an application callback, HM::set_font -# to allow the application to do font error handling - -proc HM::current_tags {win} { - upvar #0 HM::$win var - set font font - foreach i {family size weight style} { - set $i [lindex $var($i) end] - append font :[set $i] - } - set xfont [HM::x_font $family $size $weight $style $var(S_adjust_size)] - HM::set_font $win $font $xfont - set indent [llength $var(indent)] - incr indent -1 - lappend tags $font indent$indent - foreach tag [array names var T*] { - lappend tags [lindex $var($tag) end] ;# test - } - set var(font) $font - set var(xfont) [$win tag cget $font -font] - set var(level) $indent - return $tags -} - -# allow the application to do do better font management -# by overriding this procedure - -proc HM::set_font {win tag font} { - catch {$win tag configure $tag -font $font} msg -} - -# generate an X font name -proc HM::x_font {family size weight style {adjust_size 0}} { - catch {incr size $adjust_size} - return "-*-$family-$weight-$style-normal-*-*-${size}0-*-*-*-*-*-*" -} - -# Optimize HM::render (hee hee) -# This is experimental - -proc HM::optimize {} { - regsub -all "\n\[ \]*#\[^\n\]*" [info body HM::render] {} body - regsub -all ";\[ \]*#\[^\n]*" $body {} body - regsub -all "\n\n+" $body \n body - proc HM::render {win tag not param text} $body -} -############################################ -# Turn HTML into TCL commands -# html A string containing an html document -# cmd A command to run for each html tag found -# start The name of the dummy html start/stop tags - -proc HM::parse_html {html {cmd HM::test_parse} {start hmstart}} { - regsub -all \{ $html {\&ob;} html - regsub -all \} $html {\&cb;} html - set w " \t\r\n" ;# white space - proc cl x {return "\[$x\]"} - set exp <(/?)([HM::cl ^$w>]+)[HM::cl $w]*([HM::cl ^>]*)> - set sub "\}\n$cmd {\\2} {\\1} {\\3} \{" - regsub -all $exp $html $sub html - eval "$cmd {$start} {} {} \{ $html \}" - eval "$cmd {$start} / {} {}" -} - -proc HM::test_parse {command tag slash text_after_tag} { - puts "==> $command $tag $slash $text_after_tag" -} - -# Convert multiple white space into a single space - -proc HM::zap_white {data} { - regsub -all "\[ \t\r\n\]+" $data " " data - return $data -} - -# find HTML escape characters of the form &xxx; - -proc HM::map_esc {text} { - if {![regexp & $text]} {return $text} - regsub -all {([][$\\])} $text {\\\1} new - regsub -all {&#([0-9][0-9]?[0-9]?);?} \ - $new {[format %c [scan \1 %d tmp;set tmp]]} new - regsub -all {&([a-zA-Z]+);?} $new {[HM::do_map \1]} new - return [subst $new] -} - -# convert an HTML escape sequence into character - -proc HM::do_map {text {unknown ?}} { - global HM::esc_map - set result $unknown - catch {set result $HM::esc_map($text)} - return $result -} - -########################################################## -# html isindex tag. Although not strictly forms, they're close enough -# to be in this file - -# is-index forms -# make a frame with a label, entry, and submit button - -proc HM::tag_isindex {win param text} { - upvar #0 HM::$win var - - set item $win.$var(tags) - if {[winfo exists $item]} { - destroy $item - } - frame $item -relief ridge -bd 3 - set prompt "Enter search keywords here" - HM::extract_param $param prompt - label $item.label -text [HM::map_esc $prompt] -font $var(xfont) - entry $item.entry - bind $item.entry "$item.submit invoke" - button $item.submit -text search -font $var(xfont) -command \ - [format {HM::submit_index %s {%s} [HM::map_reply [%s get]]} \ - $win $param $item.entry] - pack $item.label -side top - pack $item.entry $item.submit -side left - - # insert window into text widget - - $win insert $var(S_insert) \n isindex - HM::win_install $win $item - $win insert $var(S_insert) \n isindex - bind $item {focus %W.entry} -} - -# This is called when the isindex form is submitted. -# The default version calls HM::link_callback. Isindex tags should either -# be deprecated, or fully supported (e.g. they need an href parameter) - -proc HM::submit_index {win param text} { - HM::link_callback $win ?$text -} - -# initialize form state. All of the state for this form is kept -# in a global array whose name is stored in the form_id field of -# the main window array. -# Parameters: ACTION, METHOD, ENCTYPE - -proc HM::tag_form {win param text} { - upvar #0 HM::$win var - - # create a global array for the form - set id HM::$win.form$var(tags) - upvar #0 $id form - - # missing /form tag, simulate it - if {[info exists var(form_id)]} { - puts "Missing end-form tag !!!! $var(form_id)" - HM::tag_/form $win {} {} - } - catch {unset form} - set var(form_id) $id - - set form(param) $param ;# form initial parameter list - set form(reset) "" ;# command to reset the form - set form(reset_button) "" ;# list of all reset buttons - set form(submit) "" ;# command to submit the form - set form(submit_button) "" ;# list of all submit buttons -} - -# Where we're done try to get all of the state into the widgets so -# we can free up the form structure here. Unfortunately, we can't! - -proc HM::tag_/form {win param text} { - upvar #0 HM::$win var - upvar #0 $var(form_id) form - - # make submit button entries for all radio buttons - foreach name [array names form radio_*] { - regsub radio_ $name {} name - lappend form(submit) [list $name \$form(radio_$name)] - } - - # process the reset button(s) - - foreach item $form(reset_button) { - $item configure -command $form(reset) - } - - # no submit button - add one - if {$form(submit_button) == ""} { - HM::input_submit $win {} - } - - # process the "submit" command(s) - # each submit button could have its own name,value pair - - foreach item $form(submit_button) { - set submit $form(submit) - catch {lappend submit $form(submit_$item)} - $item configure -command \ - [list HM::submit_button $win $var(form_id) $form(param) \ - $submit] - } - - # unset all unused fields here - unset form(reset) form(submit) form(reset_button) form(submit_button) - unset var(form_id) -} - -################################################################### -# handle form input items -# each item type is handled in a separate procedure -# Each "type" procedure needs to: -# - create the window -# - initialize it -# - add the "submit" and "reset" commands onto the proper Q's -# "submit" is subst'd -# "reset" is eval'd - -proc HM::tag_input {win param text} { - upvar #0 HM::$win var - - set type text ;# the default - HM::extract_param $param type - set type [string tolower $type] - if {[catch {HM::input_$type $win $param} err]} { - puts stderr $err - } -} - -# input type=text -# parameters NAME (reqd), MAXLENGTH, SIZE, VALUE - -proc HM::input_text {win param {show {}}} { - upvar #0 HM::$win var - upvar #0 $var(form_id) form - - # make the entry - HM::extract_param $param name ;# required - set item $win.input_text,$var(tags) - set size 20; HM::extract_param $param size - set maxlength 0; HM::extract_param $param maxlength - entry $item -width $size -show $show - - # set the initial value - set value ""; HM::extract_param $param value - $item insert 0 $value - - # insert the entry - HM::win_install $win $item - - # set the "reset" and "submit" commands - append form(reset) ";$item delete 0 end;$item insert 0 [list $value]" - lappend form(submit) [list $name "\[$item get]"] - - # handle the maximum length (broken - no way to cleanup bindtags state) - if {$maxlength} { - bindtags $item "[bindtags $item] max$maxlength" - bind max$maxlength "%W delete $maxlength end" - } -} - -# password fields - same as text, only don't show data -# parameters NAME (reqd), MAXLENGTH, SIZE, VALUE - -proc HM::input_password {win param} { - HM::input_text $win $param * -} - -# checkbuttons are missing a "get" option, so we must use a global -# variable to store the value. -# Parameters NAME, VALUE, (reqd), CHECKED - -proc HM::input_checkbox {win param} { - upvar #0 HM::$win var - upvar #0 $var(form_id) form - - HM::extract_param $param name - HM::extract_param $param value - - # Set the global variable, don't use the "form" alias as it is not - # defined in the global scope of the button - set variable $var(form_id)(check_$var(tags)) - set item $win.input_checkbutton,$var(tags) - checkbutton $item -variable $variable -off {} -on $value -text " " - if {[HM::extract_param $param checked]} { - $item select - append form(reset) ";$item select" - } else { - append form(reset) ";$item deselect" - } - - HM::win_install $win $item - lappend form(submit) [list $name \$form(check_$var(tags))] -} - -# radio buttons. These are like check buttons, but only one can be selected - -proc HM::input_radio {win param} { - upvar #0 HM::$win var - upvar #0 $var(form_id) form - - HM::extract_param $param name - HM::extract_param $param value - - set first [expr ![info exists form(radio_$name)]] - set variable $var(form_id)(radio_$name) - set variable $var(form_id)(radio_$name) - set item $win.input_radiobutton,$var(tags) - radiobutton $item -variable $variable -value $value -text " " - - HM::win_install $win $item - - if {$first || [HM::extract_param $param checked]} { - $item select - append form(reset) ";$item select" - } else { - append form(reset) ";$item deselect" - } - - # do the "submit" actions in /form so we only end up with 1 per button grouping - # contributing to the submission -} - -# hidden fields, just append to the "submit" data -# params: NAME, VALUE (reqd) - -proc HM::input_hidden {win param} { - upvar #0 HM::$win var - upvar #0 $var(form_id) form - HM::extract_param $param name - HM::extract_param $param value - lappend form(submit) [list $name $value] -} - -# handle input images. The spec isn't very clear on these, so I'm not -# sure its quite right -# Use std image tag, only set up our own callbacks -# (e.g. make sure ismap isn't set) -# params: NAME, SRC (reqd) ALIGN - -proc HM::input_image {win param} { - upvar #0 HM::$win var - upvar #0 $var(form_id) form - HM::extract_param $param name - set name ;# barf if no name is specified - set item [HM::tag_img $win $param {}] - $item configure -relief raised -bd 2 -bg blue - - # make a dummy "submit" button, and invoke it to send the form. - # We have to get the %x,%y in the value somehow, so calculate it during - # binding, and save it in the form array for later processing - - set submit $win.dummy_submit,$var(tags) - if {[winfo exists $submit]} { - destroy $submit - } - button $submit -takefocus 0;# this never gets mapped! - lappend form(submit_button) $submit - set form(submit_$submit) [list $name $name.\$form(X).\$form(Y)] - - $item configure -takefocus 1 - bind $item "catch \{$win see $item\}" - bind $item <1> "$item configure -relief sunken" - bind $item " - set $var(form_id)(X) 0 - set $var(form_id)(Y) 0 - $submit invoke - " - bind $item " - set $var(form_id)(X) %x - set $var(form_id)(Y) %y - $item configure -relief raised - $submit invoke - " -} - -# Set up the reset button. Wait for the /form to attach -# the -command option. There could be more that 1 reset button -# params VALUE - -proc HM::input_reset {win param} { - upvar #0 HM::$win var - upvar #0 $var(form_id) form - - set value reset - HM::extract_param $param value - - set item $win.input_reset,$var(tags) - button $item -text [HM::map_esc $value] - HM::win_install $win $item - lappend form(reset_button) $item -} - -# Set up the submit button. Wait for the /form to attach -# the -command option. There could be more that 1 submit button -# params: NAME, VALUE - -proc HM::input_submit {win param} { - upvar #0 HM::$win var - upvar #0 $var(form_id) form - - HM::extract_param $param name - set value submit - HM::extract_param $param value - set item $win.input_submit,$var(tags) - button $item -text [HM::map_esc $value] -fg blue - HM::win_install $win $item - lappend form(submit_button) $item - # need to tie the "name=value" to this button - # save the pair and do it when we finish the submit button - catch {set form(submit_$item) [list $name $value]} -} - -######################################################################### -# selection items -# They all go into a list box. We don't what to do with the listbox until -# we know how many items end up in it. Gather up the data for the "options" -# and finish up in the /select tag -# params: NAME (reqd), MULTIPLE, SIZE - -proc HM::tag_select {win param text} { - upvar #0 HM::$win var - upvar #0 $var(form_id) form - - HM::extract_param $param name - set size 5; HM::extract_param $param size - set form(select_size) $size - set form(select_name) $name - set form(select_values) "" ;# list of values to submit - if {[HM::extract_param $param multiple]} { - set mode multiple - } else { - set mode single - } - set item $win.select,$var(tags) - frame $item - set form(select_frame) $item - listbox $item.list -selectmode $mode -width 0 -exportselection 0 - HM::win_install $win $item -} - -# select options -# The values returned in the query may be different from those -# displayed in the listbox, so we need to keep a separate list of -# query values. -# form(select_default) - contains the default query value -# form(select_frame) - name of the listbox's containing frame -# form(select_values) - list of query values -# params: VALUE, SELECTED - -proc HM::tag_option {win param text} { - upvar #0 HM::$win var - upvar #0 $var(form_id) form - upvar $text data - set frame $form(select_frame) - - # set default option (or options) - if {[HM::extract_param $param selected]} { - lappend form(select_default) [$form(select_frame).list size] - } - set value [string trimright $data " \n"] - $frame.list insert end $value - HM::extract_param $param value - lappend form(select_values) $value - set data "" -} - -# do most of the work here! -# if SIZE>1, make the listbox. Otherwise make a "drop-down" -# listbox with a label in it -# If the # of items > size, add a scroll bar -# This should probably be broken up into callbacks to make it -# easier to override the "look". - -proc HM::tag_/select {win param text} { - upvar #0 HM::$win var - upvar #0 $var(form_id) form - set frame $form(select_frame) - set size $form(select_size) - set items [$frame.list size] - - # set the defaults and reset button - append form(reset) ";$frame.list selection clear 0 $items" - if {[info exists form(select_default)]} { - foreach i $form(select_default) { - $frame.list selection set $i - append form(reset) ";$frame.list selection set $i" - } - } else { - $frame.list selection set 0 - append form(reset) ";$frame.list selection set 0" - } - - # set up the submit button. This is the general case. For single - # selections we could be smarter - - for {set i 0} {$i < $size} {incr i} { - set value [format {[expr {[%s selection includes %s] ? {%s} : {}}]} \ - $frame.list $i [lindex $form(select_values) $i]] - lappend form(submit) [list $form(select_name) $value] - } - - # show the listbox - no scroll bar - - if {$size > 1 && $items <= $size} { - $frame.list configure -height $items - pack $frame.list - - # Listbox with scrollbar - - } elseif {$size > 1} { - scrollbar $frame.scroll -command "$frame.list yview" \ - -orient v -takefocus 0 - $frame.list configure -height $size \ - -yscrollcommand "$frame.scroll set" - pack $frame.list $frame.scroll -side right -fill y - - # This is a joke! - - } else { - scrollbar $frame.scroll -command "$frame.list yview" \ - -orient h -takefocus 0 - $frame.list configure -height 1 \ - -yscrollcommand "$frame.scroll set" - pack $frame.list $frame.scroll -side top -fill x - } - - # cleanup - - foreach i [array names form select_*] { - unset form($i) - } -} - -# do a text area (multi-line text) -# params: COLS, NAME, ROWS (all reqd, but default rows and cols anyway) - -proc HM::tag_textarea {win param text} { - upvar #0 HM::$win var - upvar #0 $var(form_id) form - upvar $text data - - set rows 5; HM::extract_param $param rows - set cols 30; HM::extract_param $param cols - HM::extract_param $param name - set item $win.textarea,$var(tags) - frame $item - text $item.text -width $cols -height $rows -wrap none \ - -yscrollcommand "$item.scroll set" -padx 3 -pady 3 - scrollbar $item.scroll -command "$item.text yview" -orient v - $item.text insert 1.0 $data - HM::win_install $win $item - pack $item.text $item.scroll -side right -fill y - lappend form(submit) [list $name "\[$item.text get 0.0 end]"] - append form(reset) ";$item.text delete 1.0 end; \ - $item.text insert 1.0 [list $data]" - set data "" -} - -# procedure to install windows into the text widget -# - win: name of the text widget -# - item: name of widget to install - -proc HM::win_install {win item} { - upvar #0 HM::$win var - $win window create $var(S_insert) -window $item -align bottom - $win tag add indent$var(level) $item - set focus [expr {[winfo class $item] != "Frame"}] - $item configure -takefocus $focus - bind $item "$win see $item" -} - -##################################################################### -# Assemble and submit the query -# each list element in "stuff" is a name/value pair -# - The names are the NAME parameters of the various fields -# - The values get run through "subst" to extract the values -# - We do the user callback with the list of name value pairs - -proc HM::submit_button {win form_id param stuff} { - upvar #0 HM::$win var - upvar #0 $form_id form - set query "" - foreach pair $stuff { - set value [subst [lindex $pair 1]] - if {$value != ""} { - set item [lindex $pair 0] - lappend query $item $value - } - } - # this is the user callback. - HM::submit_form $win $param $query -} - -# sample user callback for form submission -# should be replaced by the application -# Sample version generates a string suitable for http - -proc HM::submit_form {win param query} { - set result "" - set sep "" - foreach i $query { - append result $sep [HM::map_reply $i] - if {$sep != "="} {set sep =} {set sep &} - } - puts $result -} - -# do x-www-urlencoded character mapping -# The spec says: "non-alphanumeric characters are replaced by '%HH'" - -set HM::alphanumeric a-zA-Z0-9 ;# definition of alphanumeric character class -for {set i 1} {$i <= 256} {incr i} { - set c [format %c $i] - if {![string match \[$HM::alphanumeric\] $c]} { - set HM::form_map($c) %[format %.2x $i] - } -} - -# 1 leave alphanumerics characters alone -# 2 Convert every other character to an array lookup -# 3 Escape constructs that are "special" to the tcl parser -# 4 "subst" the result, doing all the array substitutions - -proc HM::map_reply {string} { - global HM::form_map HM::alphanumeric - regsub -all \[^$HM::alphanumeric\] $string {$HM::form_map(&)} string - regsub -all \n $string {\\n} string - regsub -all \t $string {\\t} string - regsub -all {[][{})\\]\)} $string {\\&} string - return [subst $string] -} - -# convert a x-www-urlencoded string int a a list of name/value pairs - -# 1 convert a=b&c=d... to {a} {b} {c} {d}... -# 2, convert + to " " -# 3, convert %xx to char equiv - -proc HM::cgiDecode {data} { - set data [split $data "&="] - foreach i $data { - lappend result [cgiMap $i] - } - return $result -} - -proc HM::cgiMap {data} { - regsub -all {\+} $data " " data - - if {[regexp % $data]} { - regsub -all {([][$\\])} $data {\\\1} data - regsub -all {%([0-9a-fA-F][0-9a-fA-F])} $data {[format %c 0x\1]} data - return [subst $data] - } else { - return $data - } -} - -# There is a bug in the tcl library focus routines that prevents focus -# from every reaching an un-viewable window. Use our *own* -# version of the library routine, until the bug is fixed, make sure we -# over-ride the library version, and not the otherway around - -#auto_load tkFocusOK -#proc tkFocusOK w { -# set code [catch {$w cget -takefocus} value] -# if {($code == 0) && ($value != "")} { -# if {$value == 0} { -# return 0 -# } elseif {$value == 1} { -# return 1 -# } else { -# set value [uplevel #0 $value $w] -# if {$value != ""} { -# return $value -# } -# } -# } -# set code [catch {$w cget -state} value] -# if {($code == 0) && ($value == "disabled")} { -# return 0 -# } -# regexp Key|Focus "[bind $w] [bind [winfo class $w]]" -#} - - diff --git a/imgviewer.tcl b/imgviewer.tcl deleted file mode 100644 index 8940b61..0000000 --- a/imgviewer.tcl +++ /dev/null @@ -1,60 +0,0 @@ -package require Img - - -proc ImageViewer {f w node} { - global tab_label noteBook factor im1 im2 editor - set factor($node) 1.0 - frame $w.f -bg $editor(bg) - pack $w.f -side left -fill both -expand true - canvas $w.f.c -xscrollcommand "$w.f.x set" -yscrollcommand "$w.y set" -bg $editor(bg) - scrollbar $w.f.x -ori hori -command "$w.f.c xview" -bg $editor(bg) - scrollbar $w.y -ori vert -command "$w.f.c yview" -bg $editor(bg) - - pack $w.f.c -side top -fill both -expand true - pack $w.f.x -side top -fill x - pack $w.y -side left -fill y - bind $w.f.c "%W yview scroll -3 units" - bind $w.f.c "%W yview scroll 3 units" - bind $w.f.c "%W xview scroll -2 units" - bind $w.f.c "%W xview scroll 2 units" - bind $w.f.c "scale $w.f.c 0.5 $node" - bind $w.f.c "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 - vertial 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] -} - - - - - - diff --git a/install.tcl b/install.tcl index 21b66b3..5859336 100644 --- a/install.tcl +++ b/install.tcl @@ -397,3 +397,4 @@ proc SetVarLang {lang} { + diff --git a/lib/editor.tcl b/lib/editor.tcl index 5af09e8..5f95544 100644 --- a/lib/editor.tcl +++ b/lib/editor.tcl @@ -964,31 +964,7 @@ proc EditFile {node fileName} { bind $text "tk_textCopy $w.text;break" bind $text "tk_textPaste $w.text;break" #bind $text "tk_textPaste $w.text;break" - bind $text { - set startPos [Position] - set nodeEdit [$noteBook raise] - EditFlag $nodeEdit [lindex $fileList($nodeEdit) 0] 1 - set fileList($nodeEdit) [list [lindex $fileList($nodeEdit) 0] 1] - puts "fuck - $fileList($nodeEdit)" - tk_textPaste $w.text - set endPos [Position] - set lineBegin [lindex [split $startPos "."] 0] - set lineEnd [lindex [split $endPos "."] 0] - for {set line $lineBegin} {$line <= $lineEnd} {incr line} { - if {$nodeEdit == "" || $nodeEdit == "newproj" || $nodeEdit == "settings" || $nodeEdit == "about" || $nodeEdit == "debug"} { - } else { - set textEdit "$noteBook.f$nodeEdit.text" - set editLine [$textEdit get $line.0 $line.end] - if {$autoFormat == "Yes"} { - if {$fileExt != "for"} { - TabIns $textEdit - } - } - HighLight $fileExt $textEdit $editLine $line $nodeEdit - } - } - break - } + bind $text {TextOperation paste; break} bind $text "auto_completition $text" bind $text "auto_completition $text" @@ -1155,14 +1131,45 @@ proc SelectAll {text} { } +proc TextOperation {oper} { + global noteBook fileList autoFormat + set nb [$noteBook raise] + if {$nb == "" || $nb == "newproj" || $nb == "about" || $nb == "debug"} { + return + } + set nb "$noteBook.f$nb" + switch $oper { + "copy" {tk_textCopy $nb.text} + "paste" { + set startPos [Position] + set nodeEdit [$noteBook raise] + EditFlag $nodeEdit [lindex $fileList($nodeEdit) 0] 1 + set fileList($nodeEdit) [list [lindex $fileList($nodeEdit) 0] 1] + set fileExt [string range [file extension [lindex $fileList($nodeEdit) 0]] 1 end] + tk_textPaste $noteBook.f$nodeEdit.text + set endPos [Position] + set lineBegin [lindex [split $startPos "."] 0] + set lineEnd [lindex [split $endPos "."] 0] + for {set line $lineBegin} {$line <= $lineEnd} {incr line} { + if {$nodeEdit == "" || $nodeEdit == "newproj" || $nodeEdit == "settings" || $nodeEdit == "about" || $nodeEdit == "debug"} { + } else { + set textEdit "$noteBook.f$nodeEdit.text" + set editLine [$textEdit get $line.0 $line.end] + if {$autoFormat == "Yes"} { + if {$fileExt != "for"} { + TabIns $textEdit + } + } + HighLight $fileExt $textEdit $editLine $line $nodeEdit + } + } + } + "cut" {tk_textCut $nb.text} + "redo" {$nb.text edit redo} + "undo" {$nb.text edit undo} + } + unset nb +} #################################### GetOp - - - - - - - - diff --git a/lib/main.tcl b/lib/main.tcl index 47240ee..769fb77 100644 --- a/lib/main.tcl +++ b/lib/main.tcl @@ -92,9 +92,9 @@ menubutton .frmMenu.mnuEdit -text [::msgcat::mc "Edit"] -menu .frmMenu.mnuEdit.m proc GetMenu {m} { global fontNormal fontBold imgDir editor $m add command -label [::msgcat::mc "Undo"] -font $fontNormal -accelerator "Ctrl+Z"\ - -state normal -command Undo - $m add command -label [::msgcat::mc "Redo"] -font $fontNormal -accelerator "Ctrl+Z"\ - -state normal -command Redo + -state normal -command {TextOperation undo} + $m add command -label [::msgcat::mc "Redo"] -font $fontNormal -accelerator "Ctrl+G"\ + -state normal -command {TextOperation redo} $m add separator $m add command -label [::msgcat::mc "Procedure name complit"] -font $fontNormal -accelerator "Ctrl+J" -state normal\ -command { @@ -104,23 +104,11 @@ proc GetMenu {m} { } $m add separator $m add command -label [::msgcat::mc "Copy"] -font $fontNormal -accelerator "Ctrl+C"\ - -command { - set nb "$noteBook.f[$noteBook raise]" - tk_textCopy $nb.text - unset nb - } + -command {TextOperation copy} $m add command -label [::msgcat::mc "Paste"] -font $fontNormal -accelerator "Ctrl+V"\ - -command { - set nb "$noteBook.f[$noteBook raise]" - tk_textPaste $nb.text - unset nb - } + -command {TextOperation paste} $m add command -label [::msgcat::mc "Cut"] -font $fontNormal -accelerator "Ctrl+X"\ - -command { - set nb "$noteBook.f[$noteBook raise]" - tk_textCut $nb.text - unset nb - } + -command {TextOperation cut} $m add separator $m add command -label [::msgcat::mc "Select all"] -font $fontNormal -accelerator "Ctrl+/"\ -command { @@ -382,3 +370,4 @@ set activeProject "" focus -force $tree + diff --git a/lib/procedure.tcl b/lib/procedure.tcl index a12222e..e0609b5 100644 --- a/lib/procedure.tcl +++ b/lib/procedure.tcl @@ -1060,22 +1060,3 @@ proc GetExtention {node} { return $ext } -proc TextOperation {oper} { - global noteBook - set nb [$noteBook raise] - if {$nb == "" || $nb == "newproj" || $nb == "about" || $nb == "debug"} { - return - } - set nb "$noteBook.f$nb" - switch $oper { - "copy" {tk_textCopy $nb.text} - "paste" {tk_textPaste $nb.text} - "cut" {tk_textCut $nb.text} - "redo" {$nb.text edit redo} - "undo" {$nb.text edit undo} - } - unset nb -} - - - diff --git a/lib/projects.tcl b/lib/projects.tcl index 4e771ae..a6d3f5f 100644 --- a/lib/projects.tcl +++ b/lib/projects.tcl @@ -1,9 +1,9 @@ -######################################################### -# Tcl/Tk project Manager -# Distributed under GNU Public License -# Author: Sergey Kalinin banzaj28@yandex.ru -# Copyright (c) "Sergey Kalinin", 2002, http://nuk-svk.ru -######################################################### +########################################################### +# Tcl/Tk project Manager # +# Distributed under GNU Public License # +# Author: Sergey Kalinin banzaj28@yandex.ru # +# Copyright (c) "Sergey Kalinin", 2002, http://nuk-svk.ru # +########################################################### proc NewProjDialog {type} { global fontNormal tree projDir workDir activeProject fileList noteBook imgDir prjDir prjName @@ -906,3 +906,5 @@ proc InsertTitle {newFile type} { + + diff --git a/main.tcl b/main.tcl deleted file mode 100644 index 6ca26ab..0000000 --- a/main.tcl +++ /dev/null @@ -1,388 +0,0 @@ -########################################################### -# Tcl/Tk Project Manager # -# Distrubuted under GPL # -# Copyright (c) "Sergey Kalinin", 2002, http://nuk-svk.ru # -# Author: Sergey Kalinin banzaj28@yandex.ru # -########################################################### - -Modules -## MAIN INTERFACE ## -wm geometry . 1024x768+0+0 -wm title . "Tcl/Tk Project Manager $ver" -wm iconname . "Tcl/Tk Project Manager $ver" -wm protocol . WM_DELETE_WINDOW Quit -wm overrideredirect . 0 -wm positionfrom . user -#wm resizable . 0 0 - -frame .frmMenu -border 1 -relief raised -background $editor(bg) -frame .frmTool -border 1 -relief raised -background $editor(bg) -frame .frmBody -border 1 -relief raised -background $editor(bg) -frame .frmStatus -border 1 -relief sunken -bg $editor(bg) -pack .frmMenu -side top -padx 1 -fill x -pack .frmTool -side top -padx 1 -fill x -pack .frmBody -side top -padx 1 -fill both -expand true -pack .frmStatus -side top -padx 1 -fill x - -########## CREATE MENU LINE ########## -menubutton .frmMenu.mnuFile -text [::msgcat::mc "File"] -menu .frmMenu.mnuFile.m -font $fontNormal -bg $editor(bg) -fg $editor(fg) -set m [menu .frmMenu.mnuFile.m -bg $editor(bg) -fg $editor(fg)] -$m add cascade -label [::msgcat::mc "New"] -menu $m.new -font $fontNormal -set mn [menu $m.new -bg $editor(bg) -fg $editor(fg)] -$mn add command -label [::msgcat::mc "New file"] -command {AddToProjDialog file}\ --font $fontNormal -accelerator "Ctrl+N" -$mn add command -label [::msgcat::mc "New directory"] -command {AddToProjDialog directory}\ --font $fontNormal -accelerator "Ctrl+N" -$mn add command -label [::msgcat::mc "New project"] -command {NewProjDialog "new"}\ --font $fontNormal -$m add command -label [::msgcat::mc "Open"] -command {FileDialog open}\ --font $fontNormal -accelerator "Ctrl+O" -state disable -$m add command -label [::msgcat::mc "Save"] -command {FileDialog save}\ --font $fontNormal -accelerator "Ctrl+S" -$m add command -label [::msgcat::mc "Save as"] -command {FileDialog save_as}\ --font $fontNormal -accelerator "Ctrl+A" -$m add command -label [::msgcat::mc "Save all"] -command {FileDialog save_all}\ --font $fontNormal -$m add command -label [::msgcat::mc "Close"] -command {FileDialog close}\ --font $fontNormal -accelerator "Ctrl+W" -$m add command -label [::msgcat::mc "Close all"] -command {FileDialog close_all}\ --font $fontNormal -$m add command -label [::msgcat::mc "Delete"] -command {FileDialog delete}\ --font $fontNormal -accelerator "Ctrl+D" -$m add separator -$m add command -label [::msgcat::mc "Compile file"] -command {MakeProj compile file} -font $fontNormal -accelerator "Ctrl+F8" -$m add command -label [::msgcat::mc "Run file"] -command {MakeProj run file} -font $fontNormal -accelerator "Ctrl+F9" -$m add separator -$m add command -label [::msgcat::mc "Print"] -command PrintDialog\ --font $fontNormal -accelerator "Ctrl+P" -$m add separator -$m add command -label [::msgcat::mc "Settings"] -command Settings -font $fontNormal -$m add separator -$m add command -label [::msgcat::mc "Exit"] -command Quit -font $fontNormal -accelerator "Ctrl+Q" - -##.frmMenu 'Project' ## - -proc GetProjMenu {m} { - global fontNormal - $m add command -label [::msgcat::mc "Project settings"] -command {NewProj edit $activeProject ""}\ - -font $fontNormal - $m add separator - $m add command -label [::msgcat::mc "Open project"] -command {OpenProj} -font $fontNormal - $m add command -label [::msgcat::mc "New project"] -command {NewProjDialog new} -font $fontNormal - $m add command -label [::msgcat::mc "Delete project"] -command DelProj -font $fontNormal - $m add separator - $m add command -label [::msgcat::mc "Add to project"] -command AddToProjDialog -font $fontNormal - $m add command -label [::msgcat::mc "Delete from project"]\ - -command {FileDialog delete} -font $fontNormal - $m add separator - $m add command -label [::msgcat::mc "Make archive"] -command MakeTGZ -font $fontNormal -accelerator "F7" - $m add command -label [::msgcat::mc "Make RPM"] -command MakeRPM -font $fontNormal -accelerator "F6" - $m add separator - $m add command -label [::msgcat::mc "Compile"] -command {MakeProj compile proj} -font $fontNormal -accelerator "F8" - $m add command -label [::msgcat::mc "Run"] -command {MakeProj run proj} -font $fontNormal -accelerator "F9" -} - -menubutton .frmMenu.mnuProj -text [::msgcat::mc "Project"] -menu .frmMenu.mnuProj.m -font $fontNormal -bg $editor(bg) -fg $editor(fg) -set m [menu .frmMenu.mnuProj.m -bg $editor(bg) -fg $editor(fg)] -GetProjMenu $m - -##.frmMenu 'Edit' ## -menubutton .frmMenu.mnuEdit -text [::msgcat::mc "Edit"] -menu .frmMenu.mnuEdit.m -font $fontNormal -bg $editor(bg) -fg $editor(fg) -## BUILDING EDIT-MENU FOR MAIN AND POP-UP MENU ## -proc GetMenu {m} { - global fontNormal fontBold imgDir editor - $m add command -label [::msgcat::mc "Undo"] -font $fontNormal -accelerator "Ctrl+Z"\ - -state normal -command Undo - $m add command -label [::msgcat::mc "Redo"] -font $fontNormal -accelerator "Ctrl+Z"\ - -state normal -command Redo - $m add separator - $m add command -label [::msgcat::mc "Procedure name complit"] -font $fontNormal -accelerator "Ctrl+J" -state normal\ - -command { - set nb "$noteBook.f[$noteBook raise]" - auto_completition_proc $nb.text - unset nb - } - $m add separator - $m add command -label [::msgcat::mc "Copy"] -font $fontNormal -accelerator "Ctrl+C"\ - -command { - set nb "$noteBook.f[$noteBook raise]" - tk_textCopy $nb.text - unset nb - } - $m add command -label [::msgcat::mc "Paste"] -font $fontNormal -accelerator "Ctrl+V"\ - -command { - set nb "$noteBook.f[$noteBook raise]" - tk_textPaste $nb.text - unset nb - } - $m add command -label [::msgcat::mc "Cut"] -font $fontNormal -accelerator "Ctrl+X"\ - -command { - set nb "$noteBook.f[$noteBook raise]" - tk_textCut $nb.text - unset nb - } - $m add separator - $m add command -label [::msgcat::mc "Select all"] -font $fontNormal -accelerator "Ctrl+/"\ - -command { - set nb [$noteBook raise] - if {$nb == "" || $nb == "newproj" || $nb == "about" || $nb == "debug"} { - return - } - set nb "$noteBook.f$nb" - SelectAll $nb.text - unset nb - } - $m add separator - $m add command -label [::msgcat::mc "Goto line"] -command GoToLine -font $fontNormal\ - -accelerator "Ctrl+G" - $m add command -label [::msgcat::mc "Find"] -command Find -font $fontNormal -accelerator "Ctrl+F" - $m add command -label [::msgcat::mc "Replace"] -command ReplaceDialog -font $fontNormal\ - -accelerator "Ctrl+R" - $m add cascade -label [::msgcat::mc "Encode"] -menu $m.encode -font $fontNormal - set me [menu $m.encode -bg $editor(bg) -fg $editor(fg)] - $me add command -label [::msgcat::mc "KOI8-R"] -command {TextEncode koi8-r} -font $fontNormal - $me add command -label [::msgcat::mc "CP1251"] -command {TextEncode cp1251} -font $fontNormal - $me add command -label [::msgcat::mc "CP866"] -command {TextEncode cp866} -font $fontNormal -} -GetMenu [menu .frmMenu.mnuEdit.m -bg $editor(bg) -fg $editor(fg)];# main edit menu -GetMenu [menu .popMnuEdit -bg $editor(bg) -fg $editor(fg)] ;# pop-up edit menu - -## VIEW MENU ## -menubutton .frmMenu.mnuView -text [::msgcat::mc "View"] -menu .frmMenu.mnuView.m -font $fontNormal -bg $editor(bg) -fg $editor(fg) -set m [menu .frmMenu.mnuView.m -bg $editor(bg) -fg $editor(fg)] -$m add checkbutton -label [::msgcat::mc "Toolbar"] -font $fontNormal -state normal\ --offvalue "No" -onvalue "Yes" -variable toolBar -command {ToolBar} -$m add command -label [::msgcat::mc "Split edit window"] -font $fontNormal -accelerator "F4" -state disable\ --command SplitWindow -$m add separator -$m add command -label [::msgcat::mc "Refresh"] -font $fontNormal -accelerator "F5" -state normal\ --command UpdateTree - -##.frmMenu Settings ## -menubutton .frmMenu.mnuCVS -text [::msgcat::mc "Modules"] -menu .frmMenu.mnuCVS.m \ --font $fontNormal -state normal -bg $editor(bg) -fg $editor(fg) -set m [menu .frmMenu.mnuCVS.m -bg $editor(bg) -fg $editor(fg)] -if {$module(tkcvs) != ""} { - $m add command -label "TkCVS" -command {DoModule tkcvs} -font $fontNormal -} -if {$module(tkdiff) != ""} { - $m add command -label "TkDIFF+" -command {DoModule tkdiff} -font $fontNormal -} -if {$module(tkregexp) != ""} { - $m add command -label "TkREGEXP" -command {DoModule tkregexp} -font $fontNormal -} -if {$module(gitk) != ""} { - $m add command -label "Gitk" -font $fontNormal -command { - DoModule gitk - GetTagList [file join $workDir $activeProject.tags] ;# geting tag list - } -} - -menubutton .frmMenu.mnuHelp -text [::msgcat::mc "Help"] -menu .frmMenu.mnuHelp.m \ --underline 0 -font $fontNormal -bg $editor(bg) -fg $editor(fg) -set m [menu .frmMenu.mnuHelp.m -bg $editor(bg) -fg $editor(fg)] -$m add command -label [::msgcat::mc "Help"] -command ShowHelp \ --accelerator F1 -font $fontNormal -$m add command -label [::msgcat::mc "About ..."] -command AboutDialog \ --font $fontNormal - -pack .frmMenu.mnuFile .frmMenu.mnuProj .frmMenu.mnuEdit .frmMenu.mnuView .frmMenu.mnuCVS -side left -pack .frmMenu.mnuHelp -side right -## Bind command ## -bind . ShowHelp -bind . UpdateTree -bind . MakeRPM -bind . MakeTGZ -bind . {MakeProj compile proj} -bind . {MakeProj compile file} -bind . {MakeProj run proj} -bind . {MakeProj run file} -bind . AddToProjDialog -bind . AddToProjDialog -bind . AddToProjDialog -bind . AddToProjDialog -bind . Quit -bind . Quit -bind . PrintDialog -bind . 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 "TreeDoubleClick [$tree selection get]" -$tree bindText "TreeOneClick [$tree selection get]" -$tree bindImage "TreeDoubleClick [$tree selection get]" -$tree bindImage "TreeOneClick [$tree selection get]" -$tree bindText {$tree selection add [$tree selection get]} -bind $frmTree.tree.c {FileDialog delete} -bind $frmTree.tree.c {FileDialog delete} -bind $frmTree.tree.c { - 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 {catch [PopupMenuTree %X %Y]} - -######### DEDERER: bind Wheel Scroll ################## -#$tree bindText "$tree yview scroll -3 units ; break ;# " -#$tree bindText "$tree yview scroll 3 units ; break ;# " -bind $frmTree.tree.c "$tree yview scroll -3 units" -bind $frmTree.tree.c "$tree yview scroll 3 units" -bind $frmTree.tree.c "$tree xview scroll -2 units" -bind $frmTree.tree.c "$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 "PageRaise [$tree selection get]" -$noteBook bindtabs {catch [PopupMenuTab .popupTabs %X %Y]} - - -#bind . PageTab -#bind . PageTab - -bind . {PageTab 1} -bind . {PageTab -1} - -################################################## -CreateToolBar -GetProj $tree -$tree configure -redraw 1 -set activeProject "" -focus -force $tree - - diff --git a/pane.tcl b/pane.tcl deleted file mode 100644 index 98a9c26..0000000 --- a/pane.tcl +++ /dev/null @@ -1,100 +0,0 @@ -package provide pane 1.0 - -namespace eval pane { - - namespace export create - - proc create { f1 f2 args } { - global editor - set t(-orient) vertical - set t(-percent) 0.25 - set t(-gripcolor) $editor(bg) - set t(-gripposition) 0.95 - set t(-gripcursor) crosshair - set t(-in) [winfo parent $f1] - array set t $args - - set master $t(-in) - upvar #0 [namespace current]::Pane$master pane - array set pane [array get t] - - if {! [string match v* $pane(-orient)] } { - set pane(-gripcursor) sb_v_double_arrow - set height 5 ; set width 3000 - } else { - set pane(-gripcursor) sb_h_double_arrow - set height 3000 ; set width 5 - } - - set pane(1) $f1 - set pane(2) $f2 - set pane(grip) [frame $master.grip -background $pane(-gripcolor) \ - -width $width -height $height \ - -bd 1 -relief raised -cursor $pane(-gripcursor)] - - if {! [string match v* $pane(-orient)] } { - set pane(D) Y - place $pane(1) -in $master -x 0 -rely 0.0 -anchor nw -relwidth 1.0 -height -1 - place $pane(2) -in $master -x 0 -rely 1.0 -anchor sw -relwidth 1.0 -height -1 - place $pane(grip) -in $master -anchor c -relx $pane(-gripposition) - } else { - set pane(D) X - place $pane(1) -in $master -relx 0.0 -y 0 -anchor nw -relheight 1.0 -width -1 - place $pane(2) -in $master -relx 1.0 -y 0 -anchor ne -relheight 1.0 -width -1 - place $pane(grip) -in $master -anchor c -rely 0 ;#$pane(-gripposition) - } - $master configure -background gray50 - - bind $master [list [namespace current]::PaneGeometry $master] - bind $pane(grip) \ - [list [namespace current]::PaneDrag $master %$pane(D)] - bind $pane(grip) \ - [list [namespace current]::PaneDrag $master %$pane(D)] - bind $pane(grip) \ - [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] - } - } - -} - - - - - diff --git a/procedure.tcl b/procedure.tcl deleted file mode 100644 index a5d19e8..0000000 --- a/procedure.tcl +++ /dev/null @@ -1,1098 +0,0 @@ -########################################################### -# Tcl/Tk Project Manager # -# Distributed under GPL # -# all procedure file # -# Copyright (c) "Sergey Kalinin", 2001, http://nuk-svk.ru # -# Author: Sergey Kalinin banzaj28@yandex.ru # -########################################################### - -## INSERT TEXT INTO ENTRY BOmX ## -proc InsertEnt {entry text} { - $entry delete 0 end - $entry insert end $text -} - -## GET TEXT FROM ENTRY WIDGET ## -proc Text {entry} { - set text [$entry get] -} -## FONT SELECTOR DIALOG ## -proc SelectFontDlg {font text} { - set font [SelectFont .fontdlg -parent . -font $font] - if { $font != "" } { - InsertEnt $text $font - } -} -## STATUS BAR OR ANYTHING LABEL TEXT UPDATE ## -proc LabelUpdate {widget value} { - global fontNormal - $widget configure -text $value -font $fontNormal -} -## SHOW PUP-UP MENUS ## -proc PopupMenuTree {x y} { - global tree fontNormal fontBold imgDir activeProject - set node [$tree selection get] - if {$node ==""} { - set answer [tk_messageBox\ - -message "[::msgcat::mc "Not found active project"]"\ - -type ok -icon warning] - case $answer { - ok {return 0} - } - } - $tree selection set $node - set item [$tree itemcget $node -data] - if {[string range $item 0 2] == "prj"} { - set activeProject [string range $item 4 end] - .frmStatus.frmActive.lblActive configure -text [$tree itemcget $node -text] -font $fontBold - tk_popup .popupProj $x $y - return - } - if {[info exists fileList($node)] != 1} { - # set fileList($node) $item - tk_popup .popupFile $x $y - } -} -proc PopupMenuEditor {x y} { - tk_popup .popMnuEdit $x $y -} -## GETTING FILE ATTRIBUTES ## -proc FileAttr {file} { - global tcl_platform - set fileAttribute "" - # get file modify time - if {$tcl_platform(platform) == "windows"} { - set unixTime [file mtime $file] - set modifyTime [clock format $unixTime -format "%d/%m/%Y, %H:%M"] - append fileAttribute $modifyTime - } elseif {$tcl_platform(platform) == "mac"} { - -} elseif {$tcl_platform(platform) == "unix"} { - set unixTime [file mtime $file] - set modifyTime [clock format $unixTime -format "%d/%m/%Y, %H:%M"] - append fileAttribute $modifyTime -} -# get file size -set size [file size $file] -if {$size < 1024} { - set fileSize "$size b" - } - if {$size >= 1024} { - set s [expr ($size.0) / 1024] - set dot [string first "\." $s] - set int [string range $s 0 [expr $dot - 1]] - set dec [string range $s [expr $dot + 1] [expr $dot + 2]] - set fileSize "$int.$dec Kb" - } - if {$size >= 1048576} { - set s [expr ($size.0) / 1048576] - set dot [string first "\." $s] - set int [string range $s 0 [expr $dot - 1]] - set dec [string range $s [expr $dot + 1] [expr $dot + 2]] - set fileSize "$int.$dec Mb" - } - append fileAttribute ", $fileSize" -} -## OPEN TREE PROCEDURE -proc TreeOpen {node} { - global fontNormal tree projDir workDir activeProject fileList noteBook findString imgDir fontBold - - $tree selection set $node - set item [$tree itemcget $node -data] - if {[string range $item 0 2] == "prj"} { - set activeProject [string range $item 4 end] - puts $activeProject - .frmStatus.frmActive.lblActive configure -text [$tree itemcget $node -text] -font $fontBold - $tree itemconfigure $node -image [Bitmap::get [file join $imgDir openfold.gif]] - if {[file exists [file join $workDir $activeProject.tags]] == 1} { - GetTagList [file join $workDir $activeProject.tags] ;# geting tag list - } else { - DoModule ctags - } - } - if {[info exists fileList($node)] != 1} { - set fileList($node) $item - if {[file isdirectory $item] == 1} { - $tree itemconfigure $node -image [Bitmap::get [file join $imgDir openfold.gif]] - } - } -} -## CLOSE TREE PROCEDURE ## -proc TreeClose {node} { - global fontNormal tree projDir workDir activeProject fileList noteBook findString imgDir fontBold - - $tree selection set $node - set item [$tree itemcget $node -data] - if {[string range $item 0 2] == "prj"} { - $tree itemconfigure $node -image [Bitmap::get [file join $imgDir folder.gif]] - } - if {[info exists fileList($node)] != 1} { - if {[file isdirectory $item] == 1} { - $tree itemconfigure $node -image [Bitmap::get [file join $imgDir folder.gif]] - } - } -} -## TREE ONE CLICK PROCEDURE ## -proc TreeOneClick {node} { - global fontNormal tree projDir workDir activeProject fileList noteBook findString imgDir fontBold - $tree selection set $node - set item [$tree itemcget $node -data] - if {[string range $item 0 2] == "prj"} { - set activeProject [string range $item 4 end] - puts $activeProject - .frmStatus.frmActive.lblActive configure -text [$tree itemcget $node -text] -font $fontBold - if {[file exists [file join $workDir $activeProject.tags]] == 1} { - GetTagList [file join $workDir $activeProject.tags] ;# geting tag list - } else { - DoModule ctags - } - return - } - if {[info exists fileList($node)] != 1} { - if {[file isdirectory $item] == 1} { - return - } else { - if {[file exists $item] == 1} { - LabelUpdate .frmStatus.frmHelp.lblHelp [FileAttr $item] - } - } - } else { - PageRaise $node - } - if {[string range $item 0 2] == "prc"} { - set parent [$tree parent $node] - set file [$tree itemcget $parent -data] - set fileExt [string range [file extension $file] 1 end] - if {[info exists fileList($parent)] == 0} { - EditFile $parent $file - } - PageRaise $parent - $tree selection set $node - set text "$noteBook.f$parent.text" - set index1 [expr [string first "_" $item]+1] - set index2 [expr [string last "_" $item]11] - if {$fileExt == "java" || $fileExt == "ja"} { - set findString "class [string range $item $index1 $index2] " - } elseif {$fileExt == "perl" || $fileExt == "pl"} { - set findString "sub [string range $item $index1 $index2]" - } elseif {$fileExt == "ml" || $fileExt == "mli"} { - set findString "let [string range $item $index1 $index2]" - } elseif {$fileExt == "php" || $fileExt == "phtml"} { - set findString "function [string range $item $index1 $index2]" - puts $findString - #return - } elseif {$fileExt == "rb"} { - set findString "class [string range $item $index1 $index2]" - } else { - set findString "proc [string range $item $index1 $index2] " - } - FindProc $text $findString $node - focus -force $text - } -} -## TREE DOUBLE CLICK PROCEDURE ## -proc TreeDoubleClick {node} { - global fontNormal tree projDir workDir activeProject fileList noteBook findString imgDir fontBold - - $tree selection set $node - set item [$tree itemcget $node -data] - if {[$tree itemcget $node -open] == 1} { - $tree itemconfigure $node -open 0 - } elseif {[$tree itemcget $node -open] == 0} { - $tree itemconfigure $node -open 1 - } - if {[string range $item 0 2] == "prj"} { - set activeProject [string range $item 4 end] - .frmStatus.frmActive.lblActive configure -text [$tree itemcget $node -text] -font $fontBold - GetTagList [file join $workDir $activeProject.tags] ;# geting tag list - } - - if {[info exists fileList($node)] != 1} { - if {[file isdirectory $item] == 1} { - GetFilesSubdir $node $item - } else { - if {[file exists $item] == 1} { - EditFile $node $item - LabelUpdate .frmStatus.frmFile.lblFile "[file size $item] b." - } - } - } - if {[string range $item 0 2] == "prc"} { - $tree selection set $node - set parent [$tree parent $node] - if {[info exists fileList($parent)] != 1} { - set file [$tree itemcget $parent -data] - EditFile $parent $file - $noteBook raise $parent - } else { - $noteBook raise $parent - } - set text "$noteBook.f$parent.text" - set index1 [expr [string first "_" $item]+1] - set index2 [expr [string last "_" $item]11] - set findString "proc [string range $item $index1 $index2] " - FindProc $text $findString $node - focus -force $text - } - -} -## GETTING FILES FROM SUBCIR ## -proc GetFilesSubdir {node dir} { - global fontNormal tree projDir workDir activeProject imgDir count - global backUpFileShow - set count 1 - set rList "" - if {[catch {cd $dir}] != 0} { - return "" - } - foreach file [lsort [glob -nocomplain .*]] { - if {$file == "." || $file == ".."} { - puts $file - } else { - lappend rList [list [file join $dir $file]] - set fileName [file join $file] - set img [GetImage $fileName] - set dot "_" - regsub -all {\.} $fileName "_" subNode - set subNode "$activeProject$dot$node$dot$subNode$dot$count" - if {[$tree exists $subNode] == 1} {return} - if {$backUpFileShow == "Yes"} { - $tree insert end $node $subNode -text $fileName \ - -data [file join $dir $fileName] -open 1\ - -image [Bitmap::get [file join $imgDir $img.gif]]\ - -font $fontNormal - } - if {$backUpFileShow == "No"} { - if {[file isdirectory $fileName] == 1} { - $tree insert end $node $subNode -text $fileName \ - -data [file join $dir $fileName] -open 1\ - -image [Bitmap::get [file join $imgDir $img.gif]]\ - -font $fontNormal - } else { - if {[string index $fileName end] != "~"} { - $tree insert end $node $subNode -text $fileName \ - -data [file join $dir $fileName] -open 1\ - -image [Bitmap::get [file join $imgDir $img.gif]]\ - -font $fontNormal - } - } - } - } - incr count - } - foreach file [lsort [glob -nocomplain *]] { - lappend rList [list [file join $dir $file]] - set fileName [file join $file] - set img [GetImage $fileName] - set dot "_" - regsub -all {\.} $fileName "_" subNode - set subNode "$activeProject$dot$node$dot$subNode$dot$count" - if {[$tree exists $subNode] == 1} {return} - if {$backUpFileShow == "Yes"} { - $tree insert end $node $subNode -text $fileName \ - -data [file join $dir $fileName] -open 1\ - -image [Bitmap::get [file join $imgDir $img.gif]]\ - -font $fontNormal - } - if {$backUpFileShow == "No"} { - if {[file isdirectory $fileName] == 1} { - $tree insert end $node $subNode -text $fileName \ - -data [file join $dir $fileName] -open 1\ - -image [Bitmap::get [file join $imgDir $img.gif]]\ - -font $fontNormal - } else { - if {[string index $fileName end] != "~"} { - $tree insert end $node $subNode -text $fileName \ - -data [file join $dir $fileName] -open 1\ - -image [Bitmap::get [file join $imgDir $img.gif]]\ - -font $fontNormal - } - } - } - incr count - } - $tree itemconfigure $node -open 1 -} -## GETTING FILES FROM PROJECT DIR AND INSERT INTO TREE WIDGET ## -proc GetFiles {dir project tree} { - global fontNormal backUpFileShow imgDir - set rList "" - set count 1 - if {[catch {cd $dir}] != 0} { - return "" - } - foreach file [lsort [glob -nocomplain .*]] { - if {$file == "." || $file == ".."} { - puts $file - } else { - lappend rList [list [file join $dir $file]] - set fileName [file join $file] - set img [GetImage $fileName] - set dot "_" - regsub -all {\.} $fileName "_" subNode - set subNode "$project$dot$subNode$dot$count" - if {$backUpFileShow == "Yes"} { - $tree insert end $project $subNode -text $fileName \ - -data [file join $dir $fileName] -open 1\ - -image [Bitmap::get [file join $imgDir $img.gif]]\ - -font $fontNormal - } - if {$backUpFileShow == "No"} { - if {[string index $fileName end] != "~"} { - $tree insert end $project $subNode -text $fileName \ - -data [file join $dir $fileName] -open 1\ - -image [Bitmap::get [file join $imgDir $img.gif]]\ - -font $fontNormal - } - } - } - incr count - } - - foreach file [lsort [glob -nocomplain *]] { - lappend rList [list [file join $dir $file]] - set fileName [file join $file] - set img [GetImage $fileName] - set dot "_" - regsub -all {\.} $fileName "_" subNode - set subNode "$project$dot$subNode$dot$count" - if {$backUpFileShow == "Yes"} { - $tree insert end $project $subNode -text $fileName \ - -data [file join $dir $fileName] -open 1\ - -image [Bitmap::get [file join $imgDir $img.gif]]\ - -font $fontNormal - } - if {$backUpFileShow == "No"} { - if {[string index $fileName end] != "~"} { - $tree insert end $project $subNode -text $fileName \ - -data [file join $dir $fileName] -open 1\ - -image [Bitmap::get [file join $imgDir $img.gif]]\ - -font $fontNormal - } - } - incr count - } - $tree configure -redraw 1 -} -## GETTING PROJECT NAMES FROM DIR AND PUTS INTO -proc GetProj {tree} { - global projDir workDir fontNormal imgDir module - set rList "" - if {[catch {cd $workDir}] != 0} { - return "" - } - foreach proj [lsort [glob -nocomplain *.proj]] { - lappend rList [list [file join $workDir $proj]] - set projFile [open [file join $workDir $proj] r] - set prjName [file rootname $proj] - while {[gets $projFile 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"} { - regsub -all " " $string "_" project - set projName "$string" - } - if {$keyWord == "ProjectDirName"} { - set projList($prjName) [file dirname $string] - puts "$projList($prjName) - $string" - $tree insert end root $prjName -text "$projName" -font $fontNormal \ - -data "prj_$prjName" -open 0\ - -image [Bitmap::get [file join $imgDir folder.gif]] - GetFiles [file join $string] $prjName $tree - set dir $string - } - } - } - $tree configure -redraw 1 -} - -## ABOUT PROGRAMM DIALOG ## -proc AboutDialog {} { - global docDir imgDir tree noteBook ver fontNormal dataDir env - set w {} - # prevent double creation "About" page - if { [catch {set w [$noteBook insert end about -text [::msgcat::mc "About ..."]]} ] } { - $noteBook raise about - return - } - frame $w.frmImg -borderwidth 2 -relief ridge -background white - image create photo imgAbout -format gif -file [file join $imgDir projman.gif] - label $w.frmImg.lblImg -image imgAbout - pack $w.frmImg.lblImg -side top -pady 5 -padx 5 - - frame $w.frmlbl -borderwidth 2 -relief ridge - label $w.frmlbl.lblVersion -text "[::msgcat::mc Version] $ver" - label $w.frmlbl.lblCompany -text "License: GPL" - label $w.frmlbl.lblAuthorName -text "[::msgcat::mc Author]: Sergey Kalinin" - label $w.frmlbl.lblEmail -text "[::msgcat::mc E-mail]: banzaj28@gmail.com" - label $w.frmlbl.lblWWW -fg black \ - -text "[::msgcat::mc "Home page"]: https://bitbucket.org/svk28/projman/ , https://nuk-svk.ru" - - pack $w.frmlbl.lblVersion $w.frmlbl.lblCompany $w.frmlbl.lblAuthorName \ - $w.frmlbl.lblEmail $w.frmlbl.lblWWW -side top -padx 5 - frame $w.frmThanks -borderwidth 2 -relief ridge - label $w.frmThanks.lblThanks -text "[::msgcat::mc Thanks]" -font $fontNormal - text $w.frmThanks.txtThanks -width 10 -height 10 -font $fontNormal\ - -selectborderwidth 0 -selectbackground #55c4d1 -width 10 - pack $w.frmThanks.lblThanks -pady 5 - pack $w.frmThanks.txtThanks -fill both -expand true - - frame $w.frmBtn -borderwidth 2 -relief ridge - button $w.frmBtn.btnOk -text [::msgcat::mc "Close"] -borderwidth {1} \ - -command { - $noteBook delete about - $noteBook raise [$noteBook page end] - } - pack $w.frmBtn.btnOk -pady 2 - pack $w.frmImg -side top -fill x - pack $w.frmlbl -side top -expand true -fill both - pack $w.frmThanks -side top -expand true -fill both - pack $w.frmBtn -side top -fill x - - bind $w "$noteBook delete about" - bind $w "$noteBook delete about" - bind $w {$noteBook delete about} - # - #bind $w.frmlbl.lblWWW { - # .frmBody.frmWork.noteBook.fabout.frmlbl.lblWWW configure -fg blue -cursor hand1 - # LabelUpdate .frmStatus.frmHelp.lblHelp "Goto http://nuk-svk.ru" - #} - #bind $w.frmlbl.lblWWW { - # .frmBody.frmWork.noteBook.fabout.frmlbl.lblWWW configure -fg black - # LabelUpdate .frmStatus.frmHelp.lblHelp "" - #} - #bind $w.frmlbl.lblWWW {GoToURL "http://nuk-svk.ru"} - # - bind $w.frmlbl.lblEmail { - .frmBody.frmWork.noteBook.fabout.frmlbl.lblEmail configure -fg blue -cursor hand1 - LabelUpdate .frmStatus.frmHelp.lblHelp "Send email \"banzaj28@yandex.ru\"" - } - bind $w.frmlbl.lblEmail { - .frmBody.frmWork.noteBook.fabout.frmlbl.lblEmail configure -fg black - LabelUpdate .frmStatus.frmHelp.lblHelp "" - } - #bind $w.frmlbl.lblEmail {SendEmail "http://nuk-svk.ru"} - - - $noteBook raise about - focus $w.frmBtn.btnOk - if {[file exists $env(HOME)/projects/tcl/projman]==1} { - set file [open [file join $dataDir THANKS] r] - } else { - set file [open [file join $docDir THANKS] r] - } - while {[gets $file line]>=0} { - $w.frmThanks.txtThanks insert end "$line\n" - } - close $file - $w.frmThanks.txtThanks configure -state disable -} -## CLOSE FILE ## -proc CloseFile {} { - global docDir imgDir tree noteBook ver fontNormal node - set w [$noteBook itemcget page option insert end settings -text [::msgcat::mc "Settings"]] - - $noteBook raise settings -} -## GET LOCALE NAMES FROM MESSAGES FILE ## -proc GetLocale {} { - global msgDir localeList - set localeList "" - if {[catch {cd $msgDir}] != 0} { - return "" - } - foreach file [lsort [glob -nocomplain *.msg]] { - lappend localeList [list [file rootname $file]] - } - return $localeList -} -## MAKING TAR ARCHIVE ## -proc MakeTGZ {} { - global activeProject tgzDir tgzNamed workDir projDir env tcl_platform - 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 == "ProjectDirName"} { - set dir "$string" - } - if {$keyWord == "ProjectVersion"} { - set version "$string" - } - if {$keyWord == "ProjectRelease"} { - set release "$string" - } - } - close $file - set res [split $tgzNamed "-"] - set name [lindex $res 0] - set ver [lindex $res 1] - set rel [lindex $res 2] - if {$name == "projectName"} { - set name $activeProject - } - if {$ver == "version"} { - append name "-$version" - } - if {$rel == "release"} { - append name "-$release" - } - # multiplatform featuring # - if {$tcl_platform(platform) == "windows"} { - append name ".zip" - } elseif {$tcl_platform(platform) == "mac"} { - append name ".zip" - } elseif {$tcl_platform(platform) == "unix"} { - append name ".tar.gz" - } - catch {cd $projDir} res - if {[file exists [file join $tgzDir $name]] == 1} { - set answer [tk_messageBox\ - -message "[::msgcat::mc "File already exists. Overwrite?"] \"$name\" ?"\ - -type yesno -icon question -default yes\ - -title [::msgcat::mc "Question"]] - case $answer { - yes {file delete [file join $tgzDir $name]} - no {return 0} - } - } - # multiplatform featuring # - if {$tcl_platform(platform) == "windows"} { - catch [exec pkzip -r -p [file join $tgzDir $name] [file join $activeProject *]] err - } elseif {$tcl_platform(platform) == "mac"} { - catch [exec zip -c [file join $tgzDir $name] $activeProject] err - } elseif {$tcl_platform(platform) == "unix"} { - catch [exec tar -czvf [file join $tgzDir $name] $activeProject] err - } - # message dialog # - set msg "[::msgcat::mc "Archive created in"] [file join $tgzDir $name]" - set icon info - set answer [tk_messageBox\ - -message "$msg"\ - -type ok -icon $icon] - case $answer { - ok {return 0} - } -} - -## MAKING RPM ## -proc MakeRPM {} { - global activeProject tgzDir tgzNamed workDir projDir env tcl_platform - - set answer [tk_messageBox\ - -message "[::msgcat::mc "Not implemented yet"]"\ - -type ok -icon info] - case $answer { - ok {return 0} - } - - - 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 == "ProjectDirName"} { - set dir "$string" - } - if {$keyWord == "ProjectVersion"} { - set version "$string" - } - if {$keyWord == "ProjectRelease"} { - set release "$string" - } - } - close $file - set res [split $tgzNamed "-"] - set name [lindex $res 0] - set ver [lindex $res 1] - set rel [lindex $res 2] - if {$name == "projectName"} { - set name $activeProject - } - if {$ver == "version"} { - append name "-$version" - } - if {$rel == "release"} { - append name "-$release" - } - append name ".tar.gz" - catch {cd $projDir} res - if {[file exists $tgzDir/$name] == 1} { - set answer [tk_messageBox\ - -message "[::msgcat::mc "File already exists. Overwrite?"] \"$name\" ?"\ - -type yesno -icon question -default yes] - case $answer { - yes {file delete $tgzDir/$name} - no {return 0} - } - } - catch [exec tar -czvf $tgzDir/$name $activeProject] pipe -} - -## PROGRESS DIALOG ## -proc Progress {oper} { - global progval - if {$oper == "start"} { - set prg [ProgressBar .frmStatus.frmProgress.lblProgress.progress\ - -variable progval -type infinite -borderwidth 0] - pack $prg -side left -fill both -expand true - } elseif {$oper == "stop"} { - destroy .frmStatus.frmProgress.lblProgress.progress - } - # ProgUpdate -} -proc ProgUpdate { } { - global progval - set progval 5 -} - -## SHOW HELP WINDOW ## -proc ShowHelp {} { - global dataDir - if {[winfo exists .help] == 1} { - focus -force .help - raise .help - } else { - TopLevelHelp - } - if {[catch {set word [selection get]} error] != 0} { - set word " " - } else { - puts $word - TopLevelHelp - SearchWord $word - } -} - -## EXEC EXTERNAL BROWSER AND GOTO URL ## -proc GoToURL {url} { - global env tcl_platform - if {$tcl_platform(platform) == "windows"} { - set pipe [open "|iexplore $url" "r"] - } elseif {$tcl_platform(platform) == "mac"} { - set pipe [open "|iexplore $url" "r"] - } elseif {$tcl_platform(platform) == "unix"} { - set pipe [open "|$env(BROWSER) $url" "r"] - } - fileevent $pipe readable - fconfigure $pipe -buffering none -blocking no -} -## SEND EMAIL PROCEDURE ## -proc SendEmail {mail} { - global env tcl_platform - if {$tcl_platform(platform) == "windows"} { - - } elseif {$tcl_platform(platform) == "mac"} { - - } elseif {$tcl_platform(platform) == "unix"} { -# set pipe [open "|$env(BROWSER) $url" "r"] - set answer [tk_messageBox\ - -message "[::msgcat::mc "Not implemented yet"]"\ - -type ok -icon info] - case $answer { - ok {return 0} - } -} -# fileevent $pipe readable -# fconfigure $pipe -buffering none -blocking no -} -## QUIT PROJECT MANAGER PROCEDURE ## -proc Quit {} { - set v [FileDialog close_all] - if {$v == "cancel"} { - return - } else { - exit - } -} -## PRINT DIALOG ## -proc PrintDialog {} { - global fontNormal fontBold selectPrint - set wp .print - # destroy the print window if it already exists - if {[winfo exists $wp]} { - destroy $wp - } - # create the new "find" window - toplevel $wp - wm transient $wp . - wm title $wp [::msgcat::mc "Print ..."] - wm resizable $wp 0 0 - frame $wp.frmLbl - frame $wp.frmEnt - frame $wp.frmField - frame $wp.frmBtn - pack $wp.frmLbl $wp.frmEnt $wp.frmField $wp.frmBtn -side top -fill x - label $wp.frmLbl.lblPrint -text [::msgcat::mc "Print command"] -font $fontNormal - pack $wp.frmLbl.lblPrint -fill x -expand true -padx 2 - entry $wp.frmEnt.entPrint -font $fontNormal - pack $wp.frmEnt.entPrint -fill x -expand true -padx 2 - - checkbutton $wp.frmField.chkSelect -text [::msgcat::mc "Print selected text"] -variable selectPrint\ - -font $fontNormal -onvalue true -offvalue false ;#-command Check - pack $wp.frmField.chkSelect -fill x -expand true -padx 2 - - button $wp.frmBtn.btnPrint -text [::msgcat::mc "Print"] -font $fontNormal -width 12 -relief groove\ - -command { - Print [.print.frmEnt.entPrint get] - destroy .print - } - button $wp.frmBtn.btnCancel -text [::msgcat::mc "Cancel"] -font $fontNormal -width 12 -relief groove\ - -command "destroy .print" - pack $wp.frmBtn.btnPrint $wp.frmBtn.btnCancel -side left -padx 2 -pady 2 -fill x -expand true - InsertEnt $wp.frmEnt.entPrint "lpr" - bind $wp "destroy .print" -} -## PRINT COMMAND ## -proc Print {command} { - global noteBook fontNormal fontBold fileList selectPrint tmpDir - set node [$noteBook raise] - set text "$noteBook.f$node.frame.text" - set command lpr - - if {$node == "newproj" || $node == "settings" || $node == "about" || $node == ""} { - set answer [tk_messageBox\ - -message "[::msgcat::mc "Don't selected file"]"\ - -type ok -icon warning\ - -title [::msgcat::mc "Warning"]] - case $answer { - ok {return 0} - } - } - if {$selectPrint == "true"} { - set selIndex [$text tag ranges sel] - set start [lindex $selIndex 0] - set end [lindex $selIndex 1] - set prnText [$text get $start $end] - set file [file join $tmpDir projprn.tmp] - set f [open $file "w"] - puts $f $prnText - close $f - } else { - set file [lindex $fileList($node) 0] - } - set pipe [open "|$command $file" "r"] - fileevent $pipe readable - fconfigure $pipe -buffering none -blocking no -} - -## GETTING EXTERNAL MODULES ## -proc Modules {} { - global tcl_platform - global module tclDir dataDir binDir - # TkDIFF loading - foreach m {tkcvs tkdiff gitk tkregexp} { - if {$tcl_platform(platform) == "unix"} { - if {$m == "tkregexp"} { - set module($m) "[file join $binDir tkregexp.tcl]" - break - } - set string [exec whereis $m] - scan $string "%s%s" v module($m) - if {[info exists module($m)] && [file isdirectory $module($m)] == 0} { - puts "Find $module($m)" - } else { - set module($m) "" - } - } - } -} - -## RUNNING MODULE ## -proc DoModule {mod} { - global tcl_platform - global module activeProject projDir tree tclDir dataDir workDir - 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 projName "$string" - } - if {$keyWord == "ProjectFileName"} { - set projFileName "$string" - } - if {$keyWord == "ProjectDirName"} { - set dir "$string" - } - if {$keyWord == "ProjectCompiler"} { - set projCompiler "$string" - } - if {$keyWord == "ProjectInterp"} { - set projInterp "$string" - } - } - close $file - - #puts "project dir - $dir" - - set curDir [pwd] - case $mod { - tkcvs { - set pipe [open "|$module(tkcvs) -dir $dir" "r"] - fileevent $pipe readable - fconfigure $pipe -buffering none -blocking no - } - tkdiff { - set files [$tree selection get] - if {[llength $files] == 0} { - set answer [tk_messageBox\ - -message "[::msgcat::mc "Don't selected file"]"\ - -type ok -icon warning\ - -title [::msgcat::mc "Warning"]] - case $answer { - ok {return 0} - } - } - if {[llength $files] == 1} { - if {$files != ""} { - set file1 [$tree itemcget $files -data] - } - set command "-r $file1" - } - if {[llength $files] == 2} { - if {[lindex $files 0] != ""} { - set file1 [$tree itemcget [lindex $files 0] -data] - } - if {[lindex $files 1] != ""} { - set file2 [$tree itemcget [lindex $files 1] -data] - } - set command "$file1 $file2" - } - if {[llength $files] > 2} { - set answer [tk_messageBox\ - -message "[::msgcat::mc "Must be one or two file select!"]"\ - -type ok -icon info\ - -title [::msgcat::mc "Warning"]] - case $answer { - ok {return 0} - } - } - set pipe [open "|$module(tkdiff) $command" "r"] - fileevent $pipe readable - fconfigure $pipe -buffering none -blocking no - } - tkregexp { - set files [$tree selection get] - if {[llength $files] == 0} { - set command "" - } elseif {[llength $files] == 1} { - if {$files != ""} { - set file [$tree itemcget $files -data] - } - set command "$file" - } else { - set answer [tk_messageBox\ - -message "[::msgcat::mc "Must be one file select!"]"\ - -type ok -icon info\ - -title [::msgcat::mc "Warning"]] - case $answer { - ok {return 0} - } - } - puts "$module(tkregexp) $command" - set pipe [open "|$module(tkregexp) $command" "r"] - fileevent $pipe readable - fconfigure $pipe -buffering none -blocking no - } - gitk { - cd $dir - #puts "========== $projDir $dir $curDir" - set pipe [open "|$module(gitk)" "r"] - fileevent $pipe readable - fconfigure $pipe -buffering none -blocking no - } - } -} - -proc SelectDir {dir} { - global projDir workDir openProjDir - set dirName [tk_chooseDirectory -initialdir $dir\ - -title "[::msgcat::mc "Select directory"]"\ - -parent .] - return $dirName -} -## UPDATE TREE ## -proc UpdateTree {} { - global tree - $tree delete [$tree nodes root] - GetProj $tree -} -## TOOLBAR ON/OFF PROCEDURE ## -proc ToolBar {} { - global toolBar - if {$toolBar == "Yes"} { - CreateToolBar - } elseif {$toolBar == "No"} { - destroy .frmTool.btnNew .frmTool.btnSave .frmTool.btnSaveAs .frmTool.btnSaveAll\ - .frmTool.btnCopy .frmTool.btnPaste .frmTool.btnCut .frmTool.btnDo .frmTool.btnPrint\ - .frmTool.btnDoFile .frmTool.btnTGZ .frmTool.btnHelp .frmTool.btnClose - .frmTool configure -height 1 - } -} - - -## LOADING HIGHLIGHT FILES ## -proc HighLight {ext text line lineNumber node} { - global font tree color noteBook hlDir - - if {[file exists [file join $hlDir $ext.tcl]] == 1} { - HighLight[string toupper $ext] $text $line $lineNumber $node - } elseif {($ext == "htm") || ($ext == "xml") || ($ext == "fm") || ($ext == "html")} { - HighLightHTML $text $line $lineNumber $node - } elseif {($ext == "pl")} { - HighLightPERL $text $line $lineNumber $node - } elseif {($ext == "for")} { - HighLightFORTRAN $text $line $lineNumber $node - } elseif {($ext == "ml") || ($ext == "mli")} { - HighLightML $text $line $lineNumber $node - } elseif {($ext == "rvt") || ($ext == "tml")} { - HighLightRIVET $text $line $lineNumber $node - } elseif {($ext == "php") || ($ext == "phtml")} { - HighLightPHP $text $line $lineNumber $node - } elseif {($ext == "rb")} { - HighLightRUBY $text $line $lineNumber $node - } else { - HighLightTCL $text $line $lineNumber $node - } -} - -## GET IMAGE FOR tree AND notebook WIDGETS ## -proc GetImage {fileName} { - global imgDir - if {[file isdirectory $fileName] == 1} { - set img "folder" - set data "dir" - } elseif {[string match "*.tcl" $fileName] == 1} { - set img "tcl" - set data "src" - } elseif {[string match "*.tk" $fileName] == 1} { - set img "tk" - set data "src" - } elseif {[string match "*.rvt" $fileName] == 1} { - set img "rvt" - set data "src" - } elseif {[string match "*.tex" $fileName] == 1} { - set img "tex" - set data "src" - } elseif {[string match "*.html" $fileName] == 1 || [string match "*.htm" $fileName] == 1} { - set img "html" - set data "src" - } elseif {[string match "*.gif" $fileName] == 1 || [string match "*.xpm" $fileName] == 1 || \ - [string match "*.png" $fileName] == 1 || [string match "*.jpg" $fileName] == 1 || \ - [string match "*.xbm" $fileName] == 1 || [string match "*.jpeg" $fileName] == 1 || \ - [string match "*.bmp" $fileName] == 1} { - set img "img" - set data "img" - } elseif {[string match "*.xml" $fileName] == 1} { - set img "xml" - set data "xml" - } elseif {[string match "*.java" $fileName] == 1 || [string match "*.ja" $fileName] == 1} { - set img "java" - set data "src" - } elseif {[string match "*.c" $fileName] == 1} { - set img "c" - set data "src" - } elseif {[string match "*.cpp" $fileName] == 1} { - set img "cpp" - set data "src" - } elseif {[string match "*.spec" $fileName] == 1} { - set img "rpm" - set data "src" - } elseif {[string match "*.pl" $fileName] == 1} { - set img "perl" - set data "src" - } elseif {[string match "*.for" $fileName] == 1 || [string match "*.f" $fileName] == 1} { - set img "fortran" - set data "src" - } elseif {[string match "*.ml" $fileName] == 1 || [string match "*.mli" $fileName] == 1} { - set img "caml" - set data "src" - } elseif {[string match "*.tml" $fileName] == 1 || [string match "*.rvt" $fileName] == 1} { - set img "tclhtml" - set data "src" - } elseif {[string match "*.php" $fileName] == 1 || [string match "*.phtml" $fileName] == 1} { - set img "php" - set data "src" - } elseif {[string match "*.rb" $fileName] == 1} { - set img "ruby" - set data "src" - } else { - set img "file" - set data "txt" - } - - return $img -} - -proc GetExtention {node} { - global fileList - set ext [string range [file extension [file tail [lindex $fileList($node) 0]]] 1 end] - return $ext -} - - -proc TextOperation {oper} { - global noteBook - set nb [$noteBook raise] - if {$nb == "" || $nb == "newproj" || $nb == "about" || $nb == "debug"} { - return - } - set nb "$noteBook.f$nb" - switch $oper { - "copy" {tk_textCopy $nb.text} - "paste" {tk_textPaste $nb.text} - "cut" {tk_textCut $nb.text} - "redo" {$nb.text edit redo} - "undo" {$nb.text edit undo} - } - unset nb -} - - - - - - - - - - - - - - - - diff --git a/projects.tcl b/projects.tcl deleted file mode 100644 index 4e771ae..0000000 --- a/projects.tcl +++ /dev/null @@ -1,908 +0,0 @@ -######################################################### -# Tcl/Tk project Manager -# Distributed under GNU Public License -# Author: Sergey Kalinin banzaj28@yandex.ru -# Copyright (c) "Sergey Kalinin", 2002, http://nuk-svk.ru -######################################################### - -proc NewProjDialog {type} { - global fontNormal tree projDir workDir activeProject fileList noteBook imgDir prjDir prjName - global openProjDir tclDir - set w .newProj - # destroy the find window if it already exists - if {[winfo exists $w]} { - - destroy $w - } - - set typeProjects "Tcl Java Perl Fortran O'Caml PHP Ruby Erlang" - - toplevel $w - wm title $w [::msgcat::mc "New project"] - wm resizable $w 0 0 - wm transient $w . - frame $w.frmCombo -borderwidth 1 - frame $w.frmBtn -borderwidth 1 - pack $w.frmCombo $w.frmBtn -side top -fill x - - # set combo [entry $w.frmCombo.entFind] - set combo [ComboBox $w.frmCombo.txtLocale\ - -textvariable lang -editable false\ - -selectbackground "#55c4d1" -selectborderwidth 0\ - -values $typeProjects] - - pack $combo -fill x -padx 2 -pady 2 - if {$type=="new"} { - button $w.frmBtn.btnFind -text "[::msgcat::mc "Create"]"\ - -font $fontNormal -width 12 -relief groove\ - -command { - NewProj add "" $lang - destroy .newProj - } - } elseif {$type=="open"} { - button $w.frmBtn.btnFind -text "[::msgcat::mc "Open"]"\ - -font $fontNormal -width 12 -relief groove\ - -command { - NewProj open "$prjName" $lang - destroy .newProj - } - } - button $w.frmBtn.btnCancel -text "[::msgcat::mc "Close"] - Esc"\ - -relief groove -width 12 -font $fontNormal\ - -command "destroy $w" - pack $w.frmBtn.btnFind $w.frmBtn.btnCancel -fill x -padx 2 -pady 2 -side left - if {$type=="open"} { - bind $w {NewProj open $prjName $lang; destroy .newProj} - } elseif {$type=="new"} { - bind $w {NewProj add "" $lang; destroy .newProj} - } - bind $w "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 "$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 "" - 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 "destroy .addtoproj" - bind $w.frmCanv.entImgTcl { - 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 "destroy .addtoproj" - bind $w.frmCanv.entImgTcl { - 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 { - set cmdCompile [.cmd.frmCombo.txtString get] - destroy .cmd - } - bind $w "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 { - $noteBook delete debug - $noteBook raise [$noteBook page end] - # return 0 - } - bind $w.frmBtn.btnOk { - $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 "\n\n\n\n\n\n\n\n\n\n" - } 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 "" - } elseif {$type == "tml"} { - set fileTitle "\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 -} - - - diff --git a/projman.conf b/projman.conf index d63d5b6..5b84553 100644 --- a/projman.conf +++ b/projman.conf @@ -1,9 +1,9 @@ ########################################################### # TCL/Tk Project Manager # -# version 0.3.8 # +# version 0.4.5 # # # -# Copyright (c) "Sergey Kalinin", 2001, http://nuk-svk.ru # -# Authors: Sergey Kalinin banzaj28@yandex.ru # +# Copyright (c) "Sergey Kalinin", 2001, http://nuk-svk.ru # +# Authors: Sergey Kalinin banzaj28@yandex.ru # ########################################################### # Modification date: Чт янв 11 10:38:33 MSK 2018 ########################################################### @@ -69,3 +69,5 @@ set color(label) "#c9c9c9" set color(sixFG) "#ff0000" set color(sixBG) "#ffdbdb" set color(sql) "#ffff828f0000" + + diff --git a/projman.tcl b/projman.tcl index 7e29ca1..e804249 100755 --- a/projman.tcl +++ b/projman.tcl @@ -1,10 +1,9 @@ #!/usr/bin/wish - ########################################################### # Tcl/Tk Project Manager # # Distrubuted under GPL # -# Copyright (c) "Sergey Kalinin", 2002, http://nuk-svk.ru # -# Author: Sergey Kalinin banzaj28@yandex.ru # +# Copyright (c) "Sergey Kalinin", 2001, http://nuk-svk.ru # +# Author: Sergey Kalinin banzaj28@yandex.ru # ########################################################### ########## VERSION INFORMATION ########## @@ -17,7 +16,6 @@ package require msgcat set rootDir "/usr" set tclDir "/usr/bin" -## if {[file exists $env(HOME)/projects/tcl/projman]==1} { set dataDir "[file join $env(HOME) projects tcl projman lib]" set docDir "[file join $env(HOME) projects tcl projman hlp ru]" @@ -88,9 +86,6 @@ foreach modFile [lsort [glob -nocomplain [file join $hlDir *.tcl]]] { source [file join $dataDir main.tcl] - -#set editor(selectBorder) "0" - #option add *tree.foreground red widgetDefault # Set colors for widgets option add *Frame.background $editor(bg) startupFile @@ -122,3 +117,4 @@ option add *Listbox.foreground $editor(fg) startupFile option add *Listbox.background $editor(bg) startupFile option add *Scrollbar.background $editor(bg) startupFile + diff --git a/settings.tcl b/settings.tcl deleted file mode 100644 index a1cf575..0000000 --- a/settings.tcl +++ /dev/null @@ -1,867 +0,0 @@ -###################################################### -# Tcl/Tk project Manager -# Distributed under GNU Public License -# Author: Sergey Kalinin banzaj28@yandex.ru -# Home page: http://nuk-svk.ru -###################################################### - -## SETTING DIALOG ## -proc Settings {} { - global fontNormal fontBold imgDir workDir - global editor color nb - global main editFrm network - global toolBar autoFormat backUpDel backUpCreate backUpShow localeSet localeList wrapSet wrapList - - set w .pref - # destroy the find window if it already exists - if {[winfo exists $w]} { - destroy $w - } - - toplevel $w - wm title $w [::msgcat::mc "Settings"] - # wm resizable $w 0 0 - wm geometry $w 464x450+0+0 - wm transient $w . - frame $w.frmMain -borderwidth 1 -bg $editor(bg) - pack $w.frmMain -side top -fill both -expand 1 - frame $w.frmBtn -borderwidth 1 -bg $editor(bg) - pack $w.frmBtn -side top -fill x - - set nb [NoteBook $w.frmMain.noteBook -font $fontBold -side top -bg $editor(bg) -fg $editor(fg)] - pack $nb -fill both -expand true -padx 2 -pady 2 - - button $w.frmBtn.btnFind -text [::msgcat::mc "Save"] -font $fontNormal -width 12 -relief groove \ - -bg $editor(bg) -fg $editor(fg) \ - -command { - file copy -force [file join $workDir projman.conf] [file join $workDir projman.conf.old] - set file [open [file join $workDir projman.conf] w] - puts $file "###########################################################" - puts $file "# TCL/Tk Project Manager #" - puts $file "# version $ver #" - puts $file "# #" - puts $file "# Copyright \(c\) \"Sergey Kalinin\", 2001, http://nuk-svk.ru #" - puts $file "# Authors: Sergey Kalinin \(aka BanZaj\) banzaj28@yandex.ru #" - puts $file "###########################################################" - puts $file "# Modification date: [exec date]" - puts $file "###########################################################\n" - - puts $file "# Normal Font" - puts $file "set fontNormal \"[$main.frmFontNormal.txtFontNormal get]\"" - puts $file "# Bold Font #" - puts $file "set fontBold \"[$main.frmFontBold.txtFontBold get]\"" - puts $file "# ToolBar on/off \(Yes/No\)" - if {$toolBar == "false"} { - puts $file "set toolBar \"No\"\n" - } else { - puts $file "set toolBar \"Yes\"\n" - } - if {$backUpShow == "false"} { - puts $file "set backUpFileShow \"No\"" - } else { - puts $file "set backUpFileShow \"Yes\"" - } - if {$backUpCreate == "false"} { - puts $file "set backUpFileCreate \"No\"" - } else { - puts $file "set backUpFileCreate \"Yes\"" - } - if {$backUpDel == "false"} { - puts $file "set backUpFileDelete \"No\"" - } else { - puts $file "set backUpFileDelete \"Yes\"" - } - puts $file "\n# Don't edit this line" - puts $file "# Directorys Settings #" - puts $file "set projDir \"[$main.frmProjDir.txtProjDir get]\"" - puts $file "set rpmDir \"[$main.frmRpmDir.txtRpmDir get]\"" - puts $file "set tgzDir \"[$main.frmTgzDir.txtTgzDir get]\"" - puts $file "# File mask #" - puts $file "set rpmNamed \"[$main.frmRpmNamed.txtRpmNamed get]\"" - puts $file "set tgzNamed \"[$main.frmTgzNamed.txtTgzNamed get]\"" - puts $file "\n# Locale setting\nset locale \"$localeSet\"" - - if {$autoFormat == "false"} { - puts $file "set autoFormat \"No\"\n" - } else { - puts $file "set autoFormat \"Yes\"\n" - } - puts $file "# Editor Font #" - puts $file "set editor(font) \"[$editFrm.frmEditorFont.txtEditorFont get]\"" - puts $file "# Editor Bold Font #" - puts $file "set editor(fontBold) \"[$editFrm.frmEditorFontBold.txtEditorFontBold get]\"" - puts $file "# background color #" - puts $file "set editor(bg) \"[$editFrm.frmColorEditBG.txtColorEditBG get]\"" - puts $file "# foreground color #" - puts $file "set editor(fg) \"[$editFrm.frmColorEditFG.txtColorEditFG get]\"" - puts $file "# selection background color #" - puts $file "set editor(selectbg) \"[$editFrm.frmColorSelectBG.txtColorSelectBG get]\"" - puts $file "# NoteBook title normal font color #" - puts $file "set editor(nbNormal) \"[$editFrm.frmColorNbNormal.txtColorNbNormal get]\"" - puts $file "# NoteBook title modify font color #" - puts $file "set editor(nbModify) \"[$editFrm.frmColorNbModify.txtColorNbModify get]\"" - puts $file "# selection border width #" - puts $file "set editor(selectBorder) \"0\"" - puts $file "# Editor wraping #" - puts $file "# must be: none, word or char" - puts $file "set editor(wrap) \"$wrapSet\"" - - puts $file "## SOURCE CODE HIGHLIGTNING ##" - puts $file "set color(procName) \"[$editFrm.frmColorProc.txtColorProc get]\"" - puts $file "set color(keyWord) \"[$editFrm.frmColorKeyWord.txtColorKeyWord get]\"" - puts $file "set color(param) \"[$editFrm.frmColorParam.txtColorParam get]\"" - puts $file "set color(subParam) \"[$editFrm.frmColorSubParam.txtColorSubParam get]\"" - puts $file "set color(comments) \"[$editFrm.frmColorComments.txtColorComments get]\"" - puts $file "set color(var) \"[$editFrm.frmColorVar.txtColorVar get]\"" - puts $file "set color(string) \"[$editFrm.frmColorString.txtColorString get]\"" - puts $file "set color(brace) \"[$editFrm.frmColorBrace.txtColorBrace get]\"" - puts $file "set color(bracequad) \"[$editFrm.frmColorBraceQuad.txtColorBraceQuad get]\"" - puts $file "set color(braceBG) \"[$editFrm.frmColorBraceBG.txtColorBraceBG get]\"" - puts $file "set color(braceFG) \"[$editFrm.frmColorBraceFG.txtColorBraceFG get]\"" - puts $file "set color(percent) \"[$editFrm.frmColorPercent.txtColorPercent get]\"" - puts $file "set color(bindKey) \"[$editFrm.frmColorBindKey.txtColorBindKey get]\"" - puts $file "set color(label) \"[$editFrm.frmColorLabel.txtColorLabel get]\"" - puts $file "set color(sixFG) \"[$editFrm.frmColorSixFG.txtColorSixFG get]\"" - puts $file "set color(sixBG) \"[$editFrm.frmColorSixBG.txtColorSixBG get]\"" - puts $file "set color(sql) \"[$editFrm.frmColorSQL.txtColorSQL get]\"" - - close $file - destroy .pref - } - button $w.frmBtn.btnCancel -text [::msgcat::mc "Close"] -relief groove -width 12\ - -font $fontNormal -command "destroy $w" -bg $editor(bg) -fg $editor(fg) - pack $w.frmBtn.btnFind $w.frmBtn.btnCancel -fill x -padx 2 -pady 2 -side left - - ################## MAIN PREF ########################## - set main [$nb insert end main -text "[::msgcat::mc "Main"]"] - - set scrwin [ScrolledWindow $main.scrwin -relief groove -bd 2 -bg $editor(bg)] - #pack $scrwin -fill both -expand true - set scrfrm [ScrollableFrame $main.frm -bg $editor(bg)] - pack $scrwin -fill both -expand true - pack $scrfrm -fill both -expand true - - $scrwin setwidget $scrfrm - set main [$scrfrm getframe] - - set frm_1 [frame $main.frmFontNormal -bg $editor(bg)] - label $frm_1.lblFontNormal -text [::msgcat::mc "Font normal"] -width 30\ - -anchor w -font $fontNormal -fg $editor(fg) -bg $editor(bg) - entry $frm_1.txtFontNormal - button $frm_1.btnFontNormal -borderwidth {1} -font $fontNormal \ - -command {SelectFontDlg $fontNormal $main.frmFontNormal.txtFontNormal} \ - -image [Bitmap::get [file join $imgDir font_selector.gif]] - pack $frm_1.lblFontNormal -side left - pack $frm_1.txtFontNormal -side left -fill x -expand true - pack $frm_1.btnFontNormal -side left - - set frm_2 [frame $main.frmFontBold -bg $editor(bg)] - label $frm_2.lblFontBold -text [::msgcat::mc "Font bold"] -width 30 -anchor w \ - -font $fontNormal -fg $editor(fg) -bg $editor(bg) - entry $frm_2.txtFontBold - button $frm_2.btnFontBold -borderwidth {1} -font $fontNormal \ - -command {SelectFontDlg $fontBold $main.frmFontBold.txtFontBold} \ - -image [Bitmap::get [file join $imgDir font_selector.gif]] - pack $frm_2.lblFontBold -side left - pack $frm_2.txtFontBold -side left -fill x -expand true - pack $frm_2.btnFontBold -side left - - set frm_3 [frame $main.frmToolBar -bg $editor(bg)] - label $frm_3.lblToolBar -text [::msgcat::mc "Toolbar"] -width 30 -anchor w \ - -font $fontNormal -fg $editor(fg) -bg $editor(bg) - checkbutton $frm_3.chkToolBar -text "" -variable toolBar \ - -font $fontNormal -onvalue true -offvalue false -bg $editor(bg) - pack $frm_3.lblToolBar -side left - pack $frm_3.chkToolBar -side left - - set frm_4 [frame $main.frmProjDir -bg $editor(bg)] - label $frm_4.lblProjDir -text [::msgcat::mc "Projects"] -width 30 -anchor w \ - -font $fontNormal -fg $editor(fg) -bg $editor(bg) - entry $frm_4.txtProjDir -bg $editor(bg) - button $frm_4.btnProjDir -borderwidth {1} -font $fontNormal -bg $editor(bg)\ - -image [Bitmap::get [file join $imgDir folder.gif]]\ - -command { - InsertEnt $main.frmProjDir.txtProjDir [SelectDir $projDir] - } - pack $frm_4.lblProjDir -side left - pack $frm_4.txtProjDir -side left -fill x -expand true - pack $frm_4.btnProjDir -side left - - set frm_5 [frame $main.frmLocale -bg $editor(bg)] - label $frm_5.lblLocale -text [::msgcat::mc "Interface language"]\ - -width 30 -anchor w -font $fontNormal -fg $editor(fg) -bg $editor(bg) - set combo [ComboBox $frm_5.txtLocale \ - -textvariable localeSet -command "puts 123"\ - -selectbackground "#55c4d1" -selectborderwidth 0\ - -values [GetLocale]] - pack $frm_5.lblLocale -side left - pack $frm_5.txtLocale -side left -fill x -expand true - - set frm_6 [frame $main.frmRpmDir -bg $editor(bg)] - label $frm_6.lblRpmDir -text [::msgcat::mc "RPM dir"] -width 30 -anchor w \ - -font $fontNormal -fg $editor(fg) -bg $editor(bg) - entry $frm_6.txtRpmDir -fg $editor(fg) -bg $editor(bg) - button $frm_6.btnRpmDir -borderwidth {1} -font $fontNormal -bg $editor(bg) \ - -image [Bitmap::get [file join $imgDir folder.gif]]\ - -command { - InsertEnt $main.frmRpmDir.txtRpmDir [SelectDir $workDir] - } - pack $frm_6.lblRpmDir -side left - pack $frm_6.txtRpmDir -side left -fill x -expand true - pack $frm_6.btnRpmDir -side left - - set frm_7 [frame $main.frmTgzDir -bg $editor(bg)] - label $frm_7.lblTgzDir -text [::msgcat::mc "TGZ dir"] -width 30 -anchor w -font $fontNormal -fg $editor(fg) - entry $frm_7.txtTgzDir - button $frm_7.btnTgzDir -borderwidth {1} -font $fontNormal \ - -image [Bitmap::get [file join $imgDir folder.gif]]\ - -command { - InsertEnt $main.frmTgzDir.txtTgzDir [SelectDir $workDir] - } - pack $frm_7.lblTgzDir -side left - pack $frm_7.txtTgzDir -side left -fill x -expand true - pack $frm_7.btnTgzDir -side left - - set frm_8 [frame $main.frmRpmNamed -bg $editor(bg)] - label $frm_8.lblRpmNamed -text [::msgcat::mc "RPM file mask"] -width 30 -anchor w\ - -font $fontNormal -fg $editor(fg) - entry $frm_8.txtRpmNamed - pack $frm_8.lblRpmNamed -side left - pack $frm_8.txtRpmNamed -side left -fill x -expand true - - set frm_9 [frame $main.frmTgzNamed -bg $editor(bg)] - label $frm_9.lblTgzNamed -text [::msgcat::mc "TGZ file mask"] -width 30 -anchor w\ - -font $fontNormal -fg $editor(fg) - entry $frm_9.txtTgzNamed - pack $frm_9.lblTgzNamed -side left - pack $frm_9.txtTgzNamed -side left -fill x -expand true - - set frm_10 [frame $main.frmBackUpCreate -bg $editor(bg)] - label $frm_10.lblBackUpCreate -text [::msgcat::mc "Create backup files"]\ - -width 30 -anchor w -font $fontNormal -fg $editor(fg) - checkbutton $frm_10.chkBackUpCreate -text "" -variable backUpCreate \ - -font $fontNormal -onvalue true -offvalue false - pack $frm_10.lblBackUpCreate -side left - pack $frm_10.chkBackUpCreate -side left - - set frm_11 [frame $main.frmBackUpShow -bg $editor(bg)] - label $frm_11.lblBackUpShow -text [::msgcat::mc "Show backup files"]\ - -width 30 -anchor w -font $fontNormal -fg $editor(fg) - checkbutton $frm_11.chkBackUpShow -text "" -variable backUpShow \ - -font $fontNormal -onvalue true -offvalue false - pack $frm_11.lblBackUpShow -side left - pack $frm_11.chkBackUpShow -side left - - set frm_12 [frame $main.frmBackUpDel -bg $editor(bg)] - label $frm_12.lblBackUpDel -text [::msgcat::mc "Delete backup files"]\ - -width 30 -anchor w -font $fontNormal -fg $editor(fg) - checkbutton $frm_12.chkBackUpDel -text "" -variable backUpDel \ - -font $fontNormal -onvalue true -offvalue false - pack $frm_12.lblBackUpDel -side left - pack $frm_12.chkBackUpDel -side left - - pack $frm_1 $frm_2 $frm_5 $frm_3 $frm_4 $frm_6 $frm_7 \ - $frm_8 $frm_9 $frm_10 $frm_11 $frm_12 -side top -fill both -expand true - - #################### EDITOR PREF ######################### - set editFrm [$nb insert end editor -text "[::msgcat::mc "Editor"]"] - - set scrwin [ScrolledWindow $editFrm.scrwin -relief groove -bd 2 -bg $editor(bg)] - set scrfrm [ScrollableFrame $editFrm.frm -bg $editor(bg)] - pack $scrwin -fill both -expand true - pack $scrfrm -fill both -expand true - $scrwin setwidget $scrfrm - - set editFrm [$scrfrm getframe] - - set frm_13 [frame $editFrm.frmEditorFont -bg $editor(bg)] - label $frm_13.lblEditorFont -text [::msgcat::mc "Editor font"] -width 30\ - -anchor w -font $fontNormal - entry $frm_13.txtEditorFont - button $frm_13.btnEditorFont -borderwidth {1} -font $fontNormal \ - -command {SelectFontDlg $editor(font) $editFrm.frmEditorFont.txtEditorFont} \ - -image [Bitmap::get [file join $imgDir font_selector.gif]] - pack $frm_13.lblEditorFont -side left - pack $frm_13.txtEditorFont -side left -fill x -expand true - pack $frm_13.btnEditorFont -side left - - set frm_14 [frame $editFrm.frmEditorFontBold -bg $editor(bg)] - label $frm_14.lblEditorFontBold -text [::msgcat::mc "Editor font bold"]\ -width 30 -anchor w -font $fontNormal - entry $frm_14.txtEditorFontBold - button $frm_14.btnEditorFontBold -borderwidth {1} -font $fontNormal \ - -command {SelectFontDlg $editor(fontBold) $editFrm.frmEditorFontBold.txtEditorFontBold} \ - -image [Bitmap::get [file join $imgDir font_selector.gif]] - pack $frm_14.lblEditorFontBold -side left - pack $frm_14.txtEditorFontBold -side left -fill x -expand true - pack $frm_14.btnEditorFontBold -side left - - set frm_21 [frame $editFrm.frmColorEditBG -bg $editor(bg)] - label $frm_21.lblColorEditBG -text [::msgcat::mc "Editor background"]\ - -width 30 -anchor w -font $fontNormal - entry $frm_21.txtColorEditBG - button $frm_21.btnColorEditBG -borderwidth {1} -font $fontNormal \ - -text "Select color" -image [Bitmap::get [file join $imgDir color_selector.gif]]\ - -command { - ColorSelect $editFrm.frmColorEditBG.txtColorEditBG $editFrm.frmColorEditBG.btnColorEditBG - ConfigureEnt [Text $editFrm.frmColorEditBG.txtColorEditBG] - } - pack $frm_21.lblColorEditBG -side left - pack $frm_21.txtColorEditBG -side left -fill x -expand true - pack $frm_21.btnColorEditBG -side left - - set frm_22 [frame $editFrm.frmColorEditFG -bg $editor(bg)] - label $frm_22.lblColorEditFG -text [::msgcat::mc "Editor foreground"]\ - -width 30 -anchor w -font $fontNormal - entry $frm_22.txtColorEditFG - button $frm_22.btnColorEditFG -borderwidth {1} -font $fontNormal \ - -command { - ColorSelect $editFrm.frmColorEditFG.txtColorEditFG $editFrm.frmColorEditFG.btnColorEditFG - } \ - -text "Select color"\ - -image [Bitmap::get [file join $imgDir color_selector.gif]] - pack $frm_22.lblColorEditFG -side left - pack $frm_22.txtColorEditFG -side left -fill x -expand true - pack $frm_22.btnColorEditFG -side left - - set frm_15 [frame $editFrm.frmAutoFormat -bg $editor(bg)] - label $frm_15.lblAutoFormat -text [::msgcat::mc "Text autoformat"]\ - -width 30 -anchor w -font $fontNormal - checkbutton $frm_15.chkAutoFormat -text "" -variable autoFormat \ - -font $fontNormal -onvalue true -offvalue false - pack $frm_15.lblAutoFormat -side left - pack $frm_15.chkAutoFormat -side left - - set wrapList [list none word char] - - set frm_28 [frame $editFrm.frmWrap -bg $editor(bg)] - label $frm_28.lblWrap -text [::msgcat::mc "Word wrapping"]\ - -width 30 -anchor w -font $fontNormal - set combo2 [ComboBox $frm_28.txtWrap\ - -textvariable wrapSet -command "puts 123"\ - -selectbackground "#55c4d1" -selectborderwidth 0\ - -values "$wrapList"] - pack $frm_28.lblWrap -side left - pack $combo2 -side left - - set frm_16 [frame $editFrm.frmColorProc -bg $editor(bg)] - label $frm_16.lblColorProc -text [::msgcat::mc "Procedure name"]\ - -width 30 -anchor w -font $fontNormal - entry $frm_16.txtColorProc -background $editor(bg) - button $frm_16.btnColorProc -borderwidth {1} -font $fontNormal \ - -command {ColorSelect $editFrm.frmColorProc.txtColorProc $editFrm.frmColorProc.btnColorProc} \ - -text "Select color"\ - -image [Bitmap::get [file join $imgDir color_selector.gif]] - pack $frm_16.lblColorProc -side left - pack $frm_16.txtColorProc -side left -fill x -expand true - pack $frm_16.btnColorProc -side left - - set frm_17 [frame $editFrm.frmColorKeyWord -bg $editor(bg)] - label $frm_17.lblColorKeyWord -text [::msgcat::mc "Operators"]\ - -width 30 -anchor w -font $fontNormal - entry $frm_17.txtColorKeyWord -background $editor(bg) - button $frm_17.btnColorKeyWord -borderwidth {1} -font $fontNormal \ - -command {ColorSelect $editFrm.frmColorKeyWord.txtColorKeyWord $editFrm.frmColorKeyWord.btnColorKeyWord} \ - -text "Select color"\ - -image [Bitmap::get [file join $imgDir color_selector.gif]] - pack $frm_17.lblColorKeyWord -side left - pack $frm_17.txtColorKeyWord -side left -fill x -expand true - pack $frm_17.btnColorKeyWord -side left - - set frm_35 [frame $editFrm.frmColorParam -bg $editor(bg)] - label $frm_35.lblColorParam -text [::msgcat::mc "Parameters"]\ - -width 30 -anchor w -font $fontNormal - entry $frm_35.txtColorParam -background $editor(bg) - button $frm_35.btnColorParam -borderwidth {1} -font $fontNormal \ - -command {ColorSelect $editFrm.frmColorParam.txtColorParam $editFrm.frmColorParam.btnColorParam} \ - -text "Select color"\ - -image [Bitmap::get [file join $imgDir color_selector.gif]] - pack $frm_35.lblColorParam -side left - pack $frm_35.txtColorParam -side left -fill x -expand true - pack $frm_35.btnColorParam -side left - - set frm_36 [frame $editFrm.frmColorSubParam -bg $editor(bg)] - label $frm_36.lblColorSubParam -text [::msgcat::mc "Subparameters"]\ - -width 30 -anchor w -font $fontNormal - entry $frm_36.txtColorSubParam -background $editor(bg) - button $frm_36.btnColorSubParam -borderwidth {1} -font $fontNormal \ - -command {ColorSelect $editFrm.frmColorSubParam.txtColorSubParam $editFrm.frmColorSubParam.btnColorSubParam} \ - -text "Select color"\ - -image [Bitmap::get [file join $imgDir color_selector.gif]] - pack $frm_36.lblColorSubParam -side left - pack $frm_36.txtColorSubParam -side left -fill x -expand true - pack $frm_36.btnColorSubParam -side left - - set frm_18 [frame $editFrm.frmColorComments -bg $editor(bg)] - label $frm_18.lblColorComments -text [::msgcat::mc "Comments"]\ - -width 30 -anchor w -font $fontNormal - entry $frm_18.txtColorComments -background $editor(bg) - button $frm_18.btnColorComments -borderwidth {1} -font $fontNormal \ - -command {ColorSelect $editFrm.frmColorComments.txtColorComments $editFrm.frmColorComments.btnColorComments} \ - -text "Select color"\ - -image [Bitmap::get [file join $imgDir color_selector.gif]] - pack $frm_18.lblColorComments -side left - pack $frm_18.txtColorComments -side left -fill x -expand true - pack $frm_18.btnColorComments -side left - - set frm_19 [frame $editFrm.frmColorVar -bg $editor(bg)] - label $frm_19.lblColorVar -text [::msgcat::mc "Variables"]\ - -width 30 -anchor w -font $fontNormal - entry $frm_19.txtColorVar -background $editor(bg) - button $frm_19.btnColorVar -borderwidth {1} -font $fontNormal \ - -command {ColorSelect $editFrm.frmColorVar.txtColorVar $editFrm.frmColorVar.btnColorVar} \ - -text "Select color"\ - -image [Bitmap::get [file join $imgDir color_selector.gif]] - pack $frm_19.lblColorVar -side left - pack $frm_19.txtColorVar -side left -fill x -expand true - pack $frm_19.btnColorVar -side left - - set frm_20 [frame $editFrm.frmColorString -bg $editor(bg)] - label $frm_20.lblColorString -text [::msgcat::mc "Quote string"]\ - -width 30 -anchor w -font $fontNormal - entry $frm_20.txtColorString -background $editor(bg) - button $frm_20.btnColorString -borderwidth {1} -font $fontNormal \ - -command {ColorSelect $editFrm.frmColorString.txtColorString $editFrm.frmColorString.btnColorString} \ - -text "Select color"\ - -image [Bitmap::get [file join $imgDir color_selector.gif]] - pack $frm_20.lblColorString -side left - pack $frm_20.txtColorString -side left -fill x -expand true - pack $frm_20.btnColorString -side left - - set frm_23 [frame $editFrm.frmColorBrace -bg $editor(bg)] - label $frm_23.lblColorBrace -text [::msgcat::mc "Braces"]\ - -width 30 -anchor w -font $fontNormal - entry $frm_23.txtColorBrace -background $editor(bg) - button $frm_23.btnColorBrace -borderwidth {1} -font $fontNormal \ - -command {ColorSelect $editFrm.frmColorBrace.txtColorBrace $editFrm.frmColorBrace.btnColorBrace} \ - -text "Select color"\ - -image [Bitmap::get [file join $imgDir color_selector.gif]] - pack $frm_23.lblColorBrace -side left - pack $frm_23.txtColorBrace -side left -fill x -expand true - pack $frm_23.btnColorBrace -side left - - set frm_24 [frame $editFrm.frmColorBraceBG -bg $editor(bg)] - label $frm_24.lblColorBraceBG -text [::msgcat::mc "Braces background"]\ - -width 30 -anchor w -font $fontNormal - entry $frm_24.txtColorBraceBG -background $editor(bg) - button $frm_24.btnColorBraceBG -borderwidth {1} -font $fontNormal \ - -command { - ColorSelect $editFrm.frmColorBraceBG.txtColorBraceBG $editFrm.frmColorBraceBG.btnColorBraceBG - $editFrm.frmColorBraceFG.txtColorBraceFG configure -background [Text $editFrm.frmColorBraceBG.txtColorBraceBG] - } \ - -text "Select color"\ - -image [Bitmap::get [file join $imgDir color_selector.gif]] - pack $frm_24.lblColorBraceBG -side left - pack $frm_24.txtColorBraceBG -side left -fill x -expand true - pack $frm_24.btnColorBraceBG -side left - - set frm_25 [frame $editFrm.frmColorBraceFG -bg $editor(bg)] - label $frm_25.lblColorBraceFG -text [::msgcat::mc "Braces foreground"]\ - -width 30 -anchor w -font $fontNormal - entry $frm_25.txtColorBraceFG -background $color(braceBG) - button $frm_25.btnColorBraceFG -borderwidth {1} -font $fontNormal \ - -command {ColorSelect $editFrm.frmColorBraceFG.txtColorBraceFG $editFrm.frmColorBraceFG.btnColorBraceFG} \ - -text "Select color"\ - -image [Bitmap::get [file join $imgDir color_selector.gif]] - pack $frm_25.lblColorBraceFG -side left - pack $frm_25.txtColorBraceFG -side left -fill x -expand true - pack $frm_25.btnColorBraceFG -side left - - set frm_26 [frame $editFrm.frmColorPercent -bg $editor(bg)] - label $frm_26.lblColorPercent -text [::msgcat::mc "Percent \%"]\ - -width 30 -anchor w -font $fontNormal - entry $frm_26.txtColorPercent -background $editor(bg) - button $frm_26.btnColorPercent -borderwidth {1} -font $fontNormal \ - -command {ColorSelect $editFrm.frmColorPercent.txtColorPercent $editFrm.frmColorPercent.btnColorPercent} \ - -text "Select color"\ - -image [Bitmap::get [file join $imgDir color_selector.gif]] - pack $frm_26.lblColorPercent -side left - pack $frm_26.txtColorPercent -side left -fill x -expand true - pack $frm_26.btnColorPercent -side left - - set frm_27 [frame $editFrm.frmColorBindKey -bg $editor(bg)] - label $frm_27.lblColorBindKey -text [::msgcat::mc "Key bindings "]\ - -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] -} - - - diff --git a/supertext.tcl b/supertext.tcl deleted file mode 100644 index 1f2c75e..0000000 --- a/supertext.tcl +++ /dev/null @@ -1,387 +0,0 @@ -# supertext.tcl v1.01 -# -# Copyright (c) 1998 Bryan Oakley -# All Rights Reserved -# -# this code is freely distributable, but is provided as-is with -# no waranty expressed or implied. - -# send comments to oakley@channelpoint.com - -# What is this? -# -# This is a replacement for (or superset of , or subclass of, ...) -# the tk text widget. Its big feature is that it supports unlimited -# undo. It also has two poorly documented options: -preproc and -# -postproc. - -# The entry point to this widget is supertext::text; it takes all of -# the same arguments as the standard text widget and exhibits all of -# the same behaviors. The proc supertext::overrideTextCommand may be -# called to have the supertext widget be used whenever the command -# "text" is used (ie: it imports supertext::text as the command "text"). -# Use at your own risk... - -# To access the undo feature, use ".widget undo". It will undo the -# most recent insertion or deletion. On windows and the mac -# this command is bound to ; on unix it is bound to -# - -# 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 <> - event add <> - } - windows { - event add <> - event add <> - } - macintosh { - event add <> - event add <> - } - } - bind $w <> "$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 -} - - - - - diff --git a/taglist.tcl b/taglist.tcl deleted file mode 100644 index d74824c..0000000 --- a/taglist.tcl +++ /dev/null @@ -1,56 +0,0 @@ -######################################################### -# Tcl/Tk project Manager -# Distributed under GNU Public License -# Author: Sergey Kalinin banzaj28@yandex.ru -# Copyright (c) "Sergey Kalinin", 2002, http://nuk-svk.ru -######################################################### - -proc GetTagList {tagFile} { - global tmpDir projDir workDir procList activeProject - - if {[file exists $tagFile] == 0} { - return - } - - set file [open $tagFile r] - set procList($activeProject) "" - while {[gets $file line]>=0} { - scan $line "%s%s" proc procFile - if {[regexp -nocase -all -- {\s\{.*?\}+\s} $line par]} { - if [info exists procList($activeProject)] { - lappend procList($activeProject) [list $proc $par $procFile] - } else { - set procList($activeProject) [list [list $proc $par $procFile]] - } - } - } -} - - -proc GetTagList_ {tagFile} { - global tmpDir projDir workDir procList activeProject - if {[file exists $tagFile] == 0} { - return - } - set projName [file rootname $tagFile] - set file [open $tagFile r] - set procList($projName) "" - while {[gets $file line]>=0} { - scan $line "%s%s" proc procFile - if {[regexp -nocase -all -- {\s\{.*?\}+\s} $line par]} { - if [info exists procList($projName)] { - lappend procList($projName) [list $proc $par $procFile] - } else { - set procList($projName) [list [list $proc $par $procFile]] - } - } - } -} - - - - - - - -