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