projman/help.tcl
2015-10-19 14:27:31 +04:00

363 lines
15 KiB
Tcl
Raw Blame History

##!/usr/bin/wish
###########################################################
# Tcl/Tk Project Manager #
# version 0.0.1 #
# help module #
# Copyright (c) "CONERO lab", 2002, http://conero.lrn.ru #
# Author: Sergey Kalinin (aka BanZaj) banzaj@lrn.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
$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} {
# if {$line == ""} {
# set html "<h1><3E><><EFBFBD><EFBFBD> $file <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD></h1>"
# }
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
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]
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} \
-background "#d3d3d3" -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]
pack $hlpNoteBook -fill both -expand true -padx 2 -pady 2
GetTOC
}
}
##################################################
#TopLevelHelp
#GetTOC
#GetContent $docDir/tcl.toc.html