# Utilities2.tcl # Copyright for URLibService (c) 1995 - 2021, # by Gerald Banon. All rights reserved. package provide dpi.inpe.br/banon/1998/08.02.08.56 2.1 # ---------------------------------------------------------------------- # DirectoryInfo # Return the content size in bytes and the number of files of a directory and all its content if {[info tclversion] <= 8.3} { proc DirectoryInfo {dir {size 0} {numberOfFiles 0}} { set pwd [pwd] if ![file isdirectory $dir] {return "0 0"} if [catch {cd $dir} err] { puts stderr $err return } # set fileList [glob -nocomplain .* *] # set fileList [lrange $fileList 2 end] ;# drop . .. set fileList [glob -nocomplain -- * .?*] set index [lsearch -exact $fileList {..}] set fileList [lreplace $fileList $index $index] foreach file $fileList { catch {set size [expr $size + [file size $file]]} ;# sometimes (UNIX) file size doesn't work (ex: file size .#ltab.doc) # problem with a file named: # ~$unzip.doc # we get the message: # user "$unzip.doc" doesn't exist # when running [file isdirectory $file] # with $file == ~$unzip.doc # # this problem occurs with 8.0 and not with 8.3 # for that reason we put a catch # if [file isdirectory $file] if [catch {file isdirectory $file} isdirectory] { continue ;# ignore such file name } # if $isdirectory { foreach {size numberOfFiles} [DirectoryInfo [file join $dir $file] $size $numberOfFiles] {break} } else { incr numberOfFiles } } cd $pwd return "$size $numberOfFiles" } } else { proc DirectoryInfo {dir {size 0} {numberOfFiles 0}} { set pwd [pwd] if ![file isdirectory $dir] {return "0 0"} if [catch {cd $dir} err] { puts stderr $err return } # set fileList [glob -nocomplain *] ;# commented by GJFB in 2018-03-10 set fileList [ComputeFileList] ;# added by GJFB in 2018-03-10 - to capture the hidden files of Linux as well - ComputeFileList was modified by GJFB in 2018-12-04 to exclude the file name .htaccess and .htaccess2 if [string equal {utf-8} [encoding system]] { ;# same code as in DirectorySize # try iso8859-1 - solves the accent problem in gprb0705, col/urlib.net/www/2012/01.31.12.33/doc contains a file which name (AvaliaçãoRadiograficaSilhuetaCardiacaYorkshireTerrier.pdf) was iso coded - added by GJFB in 2015-01-09 set fileList2 {} foreach file $fileList { if [file exists $file] {lappend fileList2 $file} } encoding system iso8859-1 # set fileList [glob -nocomplain *] ;# commented by GJFB in 2018-03-10 set fileList [ComputeFileList] ;# added by GJFB in 2018-03-10 - to capture the hidden files of Linux as well - ComputeFileList was modified by GJFB in 2018-12-04 to exclude the file name .htaccess and .htaccess2 set fileList3 {} foreach file $fileList { if [file exists $file] {lappend fileList3 $file} } if 0 { # commented by GJFB in 2021-01-17 - doesn't work in plutao, col/dpi.inpe.br/plutao/2012/11.28.17.36/doc contains a file which exists with different names (polizel_caracterização.pdf polizel_caracterização.pdf) in both encoding systems set fileList [concat $fileList2 $fileList3] encoding system utf-8 set fileList [lsort -unique $fileList] } else { # added by GJFB in 2021-01-17 encoding system utf-8 if {[llength $fileList2] > [llength $fileList3]} { set fileList $fileList2 } else { set fileList $fileList3 # => polizel_caracterização.pdf } } } foreach file $fileList { catch {set size [expr $size + [file size $file]]} ;# sometimes (UNIX) file size doesn't work (ex: file size .#ltab.doc) # problem with a file named: # ~$unzip.doc # we get the message: # user "$unzip.doc" doesn't exist # when running [file isdirectory $file] # with $file == ~$unzip.doc # # this problem occurs with 8.0 and not with 8.3 # for that reason we put a catch # if [file isdirectory $file] if [catch {file isdirectory $file} isdirectory] { continue ;# ignore such file name } # if $isdirectory { foreach {size numberOfFiles} [DirectoryInfo [file join $dir $file] $size $numberOfFiles] {break} } else { incr numberOfFiles } } cd $pwd return "$size $numberOfFiles" } } if 0 { # testing source utilities1.tcl ;# ComputeFileList source utilities2.tcl # puts [DirectoryInfo c:/lixo] # puts [DirectoryInfo cgi] # puts [DirectoryInfo {c:/gerald/URLib 2/col/dpi.inpe.br/banon-pc2@1905/2005/06.30.19.31/doc}] # puts [DirectoryInfo {c:/users/geral/URLib 2/col/urlib.net/www/2012/05.14.22.52/doc}] puts [DirectoryInfo {c:/users/geral/URLib 2/col/iconet.com.br/banon/2004/10.01.18.19/doc}] puts [DirectoryInfo {/mnt/dados1/URLibLattes/col/dpi.inpe.br/plutao/2012/11.28.17.36/doc}] } # DirectoryInfo - end # ---------------------------------------------------------------------- # FindFile # inspired from Example 9-11 # Finding a file by name. # Return the the file path proc FindFile {filePathName startDir fileName} { upvar $filePathName filePath if [file exists [file join $startDir $fileName]] { set filePath [file join $startDir $fileName] return -code return } foreach file [glob -nocomplain [file join $startDir *]] { if [file isdirectory $file] { FindFile filePath [file join $startDir $file] \ $fileName } } } # set filePath "" # FindFile filePath C:/ netscape.exe # puts $filePath # => C:/Program Files/Netscape/Communicator/Program/netscape.exe # FindFile - end # ---------------------------------------------------------------------- # DirectoryNewer # Return 1 if the directory content is newer than the referenceTime # content # referenceTime format is %Y:%m.%d.%H.%M.%S # works with gmt if {[info tclversion] <= 8.3} { proc DirectoryNewer {dir referenceTime} { global tcl_platform set pwd [pwd] if ![file isdirectory $dir] {return 1} if [catch {cd $dir} err] { puts stderr $err return } if {$tcl_platform(platform) == "unix"} { set mtime [clock format [file mtime $dir] -format %Y:%m.%d.%H.%M.%S] -gmt 1 } else { # set mtime to 0 because of UNZIP limitation for other platform set mtime 0 } if {[string compare $mtime $referenceTime] > 0} { cd $pwd return 1 } # set fileList [glob -nocomplain .* *] # set fileList [lrange $fileList 2 end] ;# drop . .. set fileList [glob -nocomplain -- * .?*] set index [lsearch -exact $fileList {..}] set fileList [lreplace $fileList $index $index] foreach file $fileList { if [file isdirectory $file] { if [DirectoryNewer [file join $dir $file] \ $referenceTime] { cd $pwd return 1 } } else { set mtime [clock format [file mtime $file] -format %Y:%m.%d.%H.%M.%S] -gmt 1 if {[string compare $mtime $referenceTime] > 0} { cd $pwd return 1 } } } cd $pwd return 0 } } else { proc DirectoryNewer {dir referenceTime} { global tcl_platform set pwd [pwd] if ![file isdirectory $dir] {return 1} if [catch {cd $dir} err] { puts stderr $err return } if {$tcl_platform(platform) == "unix"} { set mtime [clock format [file mtime $dir] -format %Y:%m.%d.%H.%M.%S] -gmt 1 } else { # set mtime to 0 because of UNZIP limitation for other platform set mtime 0 } if {[string compare $mtime $referenceTime] > 0} { cd $pwd return 1 } set fileList [glob -nocomplain *] foreach file $fileList { if [file isdirectory $file] { if [DirectoryNewer [file join $dir $file] \ $referenceTime] { cd $pwd return 1 } } else { set mtime [clock format [file mtime $file] -format %Y:%m.%d.%H.%M.%S] -gmt 1 if {[string compare $mtime $referenceTime] > 0} { cd $pwd return 1 } } } cd $pwd return 0 } } # puts [clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S] # puts [DirectoryNewer \ c:/usuario/gerald/URLib/col/dpi.inpe.br/banon/1999/12.15.21.29/doc \ 1999:01.28.16.44.39] # puts [DirectoryNewer \ c:/usuario/gerald/URLib/col/dpi.inpe.br/banon/1999/12.15.21.29/doc \ 1999:12.27.22.33.01] # DirectoryNewer - end # ---------------------------------------------------------------------- # Warning proc Warning {program string {var1 {}} {var2 {}}} { # runs with start upvar #0 {Text::URLibService} title toplevel .warning -borderwidth 10 wm title .warning $title wm resizable .warning 1 0 set bg [.warning cget -bg] set t [text .warning.text -wrap word -fg black \ -relief flat -bg $bg] set font [lindex [lindex [$t configure -font] end] 0] $t configure -font {$font 10} pack $t -fill x ;# now -tabs is working properly # insert dialog # eval [list ${program}ExtraDialog $t $string $var1 $var2] ${program}ExtraDialog $t $string $var1 $var2 ComputeGeometry .warning $t 2.8c .8c return .warning } # Warning - end # ---------------------------------------------------------------------- # ProcessKeyForDialog proc ProcessKeyForDialog {button underline key} { # runs with start global returnDialog set ib [llength $button] ;# number of buttons incr ib -1 set button0 [lindex $button 0] upvar #0 Text::$button0 textButton0 set underline0 [lindex $underline 0] if {$underline0 >= 0} { set letter [string index $textButton0 $underline0] if [regexp -nocase $letter $key] { set returnDialog 0 return } } if $ib { set button1 [lindex $button 1] upvar #0 Text::$button1 textButton1 set underline1 [lindex $underline 1] if {$underline1 >= 0} { set letter [string index $textButton1 $underline1] if [regexp -nocase $letter $key] { set returnDialog 1 return } } } } # ProcessKeyForDialog - end # ---------------------------------------------------------------------- # DisplayText # Example: # DisplayText $entryWidget $entryName $varName .xxrepository #dddddd 1 0 # # $entryName == spPreference or ddDirectory - used with the reload button # $entryName == {} - not specified when the reload button is not used # $varName == dd(result1) # $w == .ddhelp or .xxdirectory # $bg == #ffffcc # create is 0 or 1; 0 means to don't create widget # (just update if it exists) - used by the SetBackGround procedure, # 1 means to create # fill is 0 or 1; 0 means to don't fill widget # (just to create it if it doesn't exist and create == 1) - used by the # PerformCheck procedure (the fill will happen later through the # call to the CompleteEntry procedure), # 1 means to fill # canvas values are 0 or 1 # 0 means to don't use canvas (just to pack Scrolled_Text) # 1 means to use canvas # close value is the close buttom name (Close or Cancel) # reload value is the reload buttom name (Reload or OK) # Examples: # puts [list $entryWidget $entryName $varName $w $bg] # => .dd {} dd(ok) .ddhelp #ffffcc # => .window.main.dd {} dd(ok) .ddhelp #ffffcc # => .window.main.dd.rep.h1.h2.v2.entry.entry ddRepository dd(result2) .xxrepository #dddddd # # DisplayText .window.main.bc.rep.h2.entry.entry bcRepository bc(result1) .xxrepository #dddddd 1 1 proc DisplayText { entryWidget entryName varName win bg {create {1}} {fill {1}} {close {Close}} {reload {Check}} {canvas {0}} {rep {}} {metadataRep {}} {ref 1} {n 1} {buttonCursorState {}} {referenceType {}} } { # runs with start DisableButtons global w global bcChoice if [winfo exists $w.main.bc.button.reload.reload] { if {[string compare .bchelp $win] != 0} { $w.main.bc.button.reload.reload config -state disabled $w.main.bc.rep.label.lb1.lb1 config -fg #999999 $w.main.bc.rep.label.lb2.lb2 config -fg #999999 $w.main.bc.rep.label.lb3.lb3 config -fg #999999 $w.main.bc.rep.label.lb4.lb4 config -fg #999999 # $w.main.bc.button.reload.reload config -fg #000000 ;# set back to black before computing if it should be red $w.main.bc.button.edit.edit config -state disabled } } # puts $win if [winfo exists $win] { wm deiconify $win $win.f.t configure -state normal # $win.f.t delete 1.0 end $win.button.close.close config -state disabled $win.button.reload.reload config -state disabled set bclose $win.button.close set breload $win.button.reload } else { if !$create { ControlBCButtonState $entryWidget $entryName $varName EnableButtons return } toplevel $win set W [winfo width .window] set H [winfo height .window] if {1024 <= [winfo screenwidth .]} { set width 421 } else { set width 317 } wm geometry $win ${width}x$H+[expr $W + 7]+0 if [regexp {help} $win] {set word Help} if {$win == ".xxdirectory"} {set word Check} if {$win == ".xxrepository"} {set word Check} # if {$win == ".bcmetadata"} {set word Edit} # if {$win == ".ddmetadata"} {set word Edit} if [regexp {metadata} $win] {set word Edit} upvar #0 "Text::URLibService - $word" varText if $canvas { global homePath # global referRepository ;# commented by GJFB in 2013-02-17 # global ${referRepository}::conversionTable ;# commented by GJFB in 2013-02-17 Load $homePath/col/$metadataRep/doc/@metadata.refer fileContent set localMetadataList [ConvertRefer2MetadataList $fileContent $metadataRep 0] # puts $localMetadataList array set localMetadataArray $localMetadataList set currentType $localMetadataArray($metadataRep-0,referencetype) if [string equal {} $referenceType] { set referenceType $currentType } set extension " $ref/$n - $referenceType" } else { set rep {} set metadataRep {} set extension {} } wm title $win "$varText$extension" if [regexp {help} $win] { set word word } else { set word none } if $canvas { regexp {^..} $varName xx ;# dd frame $win.f frame $win.f.f1 canvas $win.f.f1.canvas -width 10 -height 10 \ -yscrollcommand [list $win.f.f1.yscroll set] scrollbar $win.f.f1.yscroll -orient vertical \ -command [list $win.f.f1.canvas yview] pack $win.f.f1.yscroll -side right -fill y pack $win.f.f1.canvas -side left -fill both -expand true frame $win.f.sp1 -height .3c ;# extra space frame $win.f.f2 -borderwidth 2 -relief groove set width .88 ;# inch set height 1.08 ;# cm set bcChoice update # update frame $win.f.f2.r1 -width [format "%si" $width] -height [format "%sc" $height] pack propagate $win.f.f2.r1 false pack $win.f.f2.r1 -side left radiobutton $win.f.f2.r1.1 -variable bcChoice -value update -cursor hand2 ConfigText $win.f.f2.r1.1 {update} pack $win.f.f2.r1.1 -fill both -expand true # add frame $win.f.f2.r2 -width [format "%si" $width] -height [format "%sc" $height] pack propagate $win.f.f2.r2 false pack $win.f.f2.r2 -side left radiobutton $win.f.f2.r2.1 -variable bcChoice -value add -cursor hand2 ConfigText $win.f.f2.r2.1 {add} pack $win.f.f2.r2.1 -fill both -expand true # remove frame $win.f.f2.r3 -width [format "%si" $width] -height [format "%sc" $height] pack propagate $win.f.f2.r3 false pack $win.f.f2.r3 -side left radiobutton $win.f.f2.r3.1 -variable bcChoice -value remove -cursor hand2 ConfigText $win.f.f2.r3.1 {remove} pack $win.f.f2.r3.1 -fill both -expand true frame $win.f.sp2 -height .05c ;# extra space pack $win.f.f1 -side top -fill both -expand true if [string equal bc $xx] { pack $win.f.sp1 -side top pack $win.f.f2 -side top pack $win.f.sp2 -side top } } else { Scrolled_Text $win.f -wrap $word \ -bg $bg -fg black -cursor double_arrow \ -relief raised -borderwidth 2 -padx .2c -pady .2c } # Buttons # puts "$win $reload $close" # => .xxmetadata1 OK Cancel frame $win.sp -height .04c ;# extra space set width 2.2 set height .6 set b [frame $win.button -width 5c -height .6c] # Close Button set bclose [frame $b.close -width [format "%sc" $width] \ -height [format "%sc" $height]] button $bclose.close \ -command [list CloseDisplayText $entryWidget $entryName $varName $win \ $rep $n $buttonCursorState] \ -cursor hand2 -state disabled ConfigText $bclose.close $close # Close Button - end # Reload Button set breload [frame $b.reload -width [format "%sc" $width] \ -height [format "%sc" $height]] button $breload.reload \ -command [list ReloadDisplayText $entryWidget $entryName $varName $win \ $rep $metadataRep $n $buttonCursorState $referenceType] \ -cursor hand2 -state disabled ConfigText $breload.reload $reload # Reload Button - end pack propagate $b false pack propagate $bclose false pack propagate $breload false if [regexp metadata $win] { pack $breload -side left pack $bclose -side right } elseif [regexp {xxdirectory|xxrepository} $win] { # xx directory or xxrepository pack $breload -side left pack $bclose -side top } else { pack $bclose -side top } pack $bclose.close -fill both pack $breload.reload -fill both pack $b -side bottom -pady .2c pack $win.sp -side top ;# extra space # Buttons - end pack $win.f -fill y -expand true bind $win <1> "ProcessButton1 $entryWidget" } if $canvas { Scrolled_EntrySet $win.f.f1.canvas $varName localMetadataArray \ $metadataRep $currentType $referenceType \ [ReturnReferModel $referenceType] $bclose.close configure -state normal $breload.reload config -state normal } else { # Fill Text if !$fill { ControlBCButtonState $entryWidget $entryName $varName EnableButtons return } regexp {.(...)(.*)} $win m first last ;# ddh elp set programName [string toupper $first]$last $programName $entryWidget $entryName $varName ;# DDHelp or XXDirectory or ... # Fill Text - end } raise $win # $win.button.close.close configure -state normal if [regexp help $win] { $bclose.close configure -state normal } } # DisplayText - end # ---------------------------------------------------------------------- # CloseDisplayText # Examples: # CloseDisplayText .window.main.bc.rep.h2.entry.entry bcRepository bc(result1) .xxmetadata1 dpi.inpe.br/banon/1999/09.12.15.10 1 {normal disabled {}} # CloseDisplayText .window.main.dd.rep.h1.h2.v2.entry.entry ddRepository dd(result2) .xxmetadata1 {} 1 {{} {} {}} proc CloseDisplayText { entryWidget entryName varName win rep numberOfMetadata buttonCursorState } { global editMetadataState # puts [list $entryWidget $entryName $varName $win $rep $numberOfMetadata $buttonCursorState] if [regexp {^\.xxmetadata} $win] { upvar #0 $varName var $win.button.reload.reload config -state disabled $win.button.close.close config -state disabled regexp {^..} $varName xx ;# dd for {set i 1} {$i <= $numberOfMetadata} {incr i} { if [string equal $win .xxmetadata$i] {continue} if [winfo exists .xxmetadata$i] { destroy $win return } } # no more Edit Metadata Window exists if $editMetadataState {PerformCheck $entryWidget $entryName $varName} if ![string equal {} $rep] { RestoreBCButtons $entryName } UnsetWaitingState $entryWidget $xx $buttonCursorState } if [regexp {^\.bchelp|^\.xxmetadata} $win] { ControlBCButtonState $entryWidget $entryName $varName } destroy $win EnableButtons } # CloseDisplayText - end # ---------------------------------------------------------------------- # ReloadDisplayText proc ReloadDisplayText { entryWidget entryName varName win rep metadataRep numberOfMetadata buttonCursorState referenceType } { global homePath global editMetadataState global bcChoice global log global multipleLineReferFieldNamePattern global authorFieldNameList global fieldAttributeTable if [regexp {^\.xxdirectory|^\.xxrepository} $win] { # PerformCheck $entryWidget $entryName $varName ;# reload PerformCheck $entryWidget $entryName $varName 0 ;# check } if [regexp {^\.xxmetadata} $win] { upvar #0 $varName var set editMetadataState 1 $win.button.reload.reload config -state disabled $win.button.close.close config -state disabled regexp {^..} $varName xx ;# dd foreach field [ReturnReferModel $referenceType 1] { set fieldName [lindex $field 0] ;# %A set field1 [lindex $field 1] ;# author # drop some fields # if {[string compare {%@parentrepositories} $fieldName] == 0} {continue} if {[info exists fieldAttributeTable($field1,5)] && $fieldAttributeTable($field1,5)} {continue} # if [regexp {^%A|^%E|^%Y|^%\?|^%@group|^%@affiliation|^%@electronicmailaddress} $fieldName] # if [regexp $multipleLineReferFieldNamePattern $fieldName] { # multiple line fields # set fieldValue [string trim [$win.f.f1.canvas.f.entry$fieldName.text.t get 1.0 end] \n] set fieldValue [string trimright [$win.f.f1.canvas.f.entry$fieldName.text.t get 1.0 end] \n] ;# uncommented by GJFB in 2012-04-21 - trim below for empty fieldValue doesn't exempt this trimright # set fieldValue [$win.f.f1.canvas.f.entry$fieldName.text.t get 1.0 end] ;# commented by GJFB in 2012-04-21 # ProcessAuthorField fieldList $fieldName $fieldValue if {[lsearch $authorFieldNameList $field1] != -1} { # author editor... ProcessAuthorField fieldList $fieldName $fieldValue } else { # program receiver resumeid orcid group affiliation secondarymark... # puts "$fieldName = $fieldValue" # puts 1-$fieldList ProcessMultipleLineField fieldList $fieldName $fieldValue # puts 2-$fieldList } } elseif {[regexp {^%T|^%1} $fieldName]} { set fieldValue [string trim [$win.f.f1.canvas.f.entry$fieldName.text.t get 1.0 end] \n] # regsub -all {\$([^ ])} $fieldValue {$ \1} fieldValue ;# cr$30 -> cr$ 30 ;# commented by GJFB in 2018-06-14 - now 30 (in $30) is no more treated as a tcl variable when displayed (see EscapeUntrustedData) ProcessTitleField fieldList $fieldName $fieldValue } elseif {[regexp {^%K} $fieldName]} { set fieldValue [string trim [$win.f.f1.canvas.f.entry$fieldName.text.t get 1.0 end] \n] ProcessKeywordsField fieldList $fieldName $fieldValue } elseif {[regexp {^%X} $fieldName]} { set fieldValue [string trim [$win.f.f1.canvas.f.entry$fieldName.text.t get 1.0 end] \n] # regsub -all {\$([^ ])} $fieldValue {$ \1} fieldValue ;# cr$30 -> cr$ 30 ;# commented by GJFB in 2018-06-14 - now 30 (in $30) is no more treated as a tcl variable when displayed (see EscapeUntrustedData) ProcessAbstractField fieldList $fieldName $fieldValue } elseif {[regexp {^%0} $fieldName]} { lappend fieldList [list $fieldName $referenceType] } elseif {[regexp {^%2} $fieldName]} { lappend fieldList [list $fieldName $metadataRep] } elseif {[regexp {^%4} $fieldName]} { lappend fieldList [list $fieldName $rep] } else { set fieldValue [string trim [$win.f.f1.canvas.f.entry$fieldName.text.t get 1.0 end] \n] if [string equal {} $fieldValue] {continue} lappend fieldList [list $fieldName $fieldValue] } } # puts $fieldList # set fileContent [join $fieldList \n] foreach field $fieldList { set fieldName [lindex $field 0] if [regexp $multipleLineReferFieldNamePattern $fieldName] { # multiple line fields foreach fieldValue [lindex $field 1] { append fileContent [string trim "$fieldName $fieldValue"]\n ;# trim is useful when fieldValue is empty } } else { append fileContent [string trim [join $field]]\n ;# trim is useful when fieldValue is empty } } # puts $fileContent # puts --$metadataRep-- # update if {[info exists bcChoice] && [string equal update $bcChoice]} { Store fileContent $homePath/col/$metadataRep/doc/@metadata.refer } # add if {[info exists bcChoice] && [string equal add $bcChoice]} { Store fileContent $homePath/clipboard/@metadata.refer CreateRepMetadataRep directory $homePath/col/$metadataRep/doc/ } # remove if {[info exists bcChoice] && [string equal remove $bcChoice]} { # Compute the log LogInsert [list [list Insert $log end {new line}]] 1 0 ;# blk line LogInsert [list [list Insert $log end \ {deleting repository <$var1> ...} \ {} $metadataRep] \ [list TagAdd $log fixed9 \ {<$var1>} -forward $metadataRep]] 0 0 LogInsert [list [list Insert $log insert {new line}]] 0 1 # Compute the log - end CleanCollection $metadataRep set metadata2List [Eval GetMetadata $metadataRep-*] ;# extract from the global array: metadataArray # Eval RemoveMetadata $metadata2List 1 ;# metadata2List must not be too big, otherwise Eval doesn't return - commented by GJFB in 2020-08-18 Eval RemoveMetadata2 $metadata2List 1 ;# added by GJFB in 2020-08-18 # Update file service/metadataRepositoryList # added by GJFB in 2015-12-15 in order to have the names of the metadata repositories in the proper original repository - useful when one need to rescue a metadata repository from backup set metadataRepList [FindMetadataRepList $rep $entryWidget $varName] # puts --$metadataRepList-- set fileContent [join $metadataRepList \n] StoreService fileContent $rep metadataRepositoryList 0 1 # Update file service/metadataRepositoryList - end # Compute the log LogInsert [list [list Insert $log end {new line}]] 1 0 ;# blk line LogInsert [list [list Insert $log end \ {repository <$var1> deleted} \ {} $metadataRep] \ [list TagAdd $log fixed9 \ {<$var1>} -forward $metadataRep]] 0 0 LogInsert [list [list Insert $log insert {new line}]] 0 1 # Compute the log - end } # if [info exists bcChoice] {unset bcChoice} ;# bcChoice is used by CreateRepMetadataRep - commented by GJFB in 2015-12-19 - leaves the radio buttons undefined when editing metadata set bcChoice update ;# bcChoice is used by CreateRepMetadataRep - set the default again - added by GJFB in 2015-12-19 for {set i 1} {$i <= $numberOfMetadata} {incr i} { if {[string compare $win .xxmetadata$i] == 0} {continue} if [winfo exists .xxmetadata$i] { destroy $win return } } # no more Edit Metadata Window exists # >>> PerformCheck if ![string equal dd $xx] {PerformCheck $entryWidget $entryName $varName} if ![string equal {} $rep] { RestoreBCButtons $entryName } UnsetWaitingState $entryWidget $xx $buttonCursorState destroy $win } } # ReloadDisplayText - end # ---------------------------------------------------------------------- # Scrolled_EntrySet proc Scrolled_EntrySet {canvas varName arrayName metadataRep currentType referenceType fieldList} { global homePath global referRepository global ${referRepository}::conversionTable global tcl_platform global mirrorLanguageConversionTable global multipleLineReferFieldNamePattern global multipleLineReferFieldNamePatternForCreator global fieldAttributeTable upvar $arrayName localMetadataArray # Create one frame to hold everything # and position it on the canvas set f [frame $canvas.f -bd 0] $canvas create window 0 0 -anchor nw -window $f # Create and grid the labeled entries if {$tcl_platform(platform) == "windows"} { set width 50 } elseif {$tcl_platform(os) == "SunOS"} { set width 36 } else { set width 50 } regexp {^..} $varName xx ;# dd if {[string compare bc $xx] == 0} { set height 6 } else { set height 7 } # puts $fieldList foreach field $fieldList { set fieldName [lindex $field 0] ;# %A set label [lindex $field 1] ;# author # drop some fields # if {[string compare {%@parentrepositories} $fieldName] == 0} {continue} if {[info exists fieldAttributeTable($label,5)] && $fieldAttributeTable($label,5)} {continue} set entry [frame $f.entry$fieldName -bd 2] label $entry.label -text $mirrorLanguageConversionTable($label) set scrolledText [Scrolled_Text $entry.text -width $width -height $height \ -wrap word -padx 4 -bg #FFFFFF] grid $entry -sticky news grid $entry.label grid $entry.text if [info exists conversionTable($currentType,$fieldName)] { if [info exists localMetadataArray($metadataRep-0,$conversionTable($currentType,$fieldName))] { set fieldValue $localMetadataArray($metadataRep-0,$conversionTable($currentType,$fieldName)) } else { set fieldValue {} } } else { set fieldValue {} } # if [regexp {^%A|^%E|^%Y|^%\?|^%@group|^%@affiliation|^%@electronicmailaddress} $fieldName] # if [regexp $multipleLineReferFieldNamePattern $fieldName] { # multiple line fields # if [regexp {^%@group|^%@affiliation|^%@electronicmailaddress} $fieldName] # if ![regexp $multipleLineReferFieldNamePatternForCreator $fieldName] { set fieldValue [MultipleRegsub {,*$} $fieldValue {}] ;# drop trailing comma } else { set fieldValue [MultipleRegsub {(,.+),$|^([^ ]+),$} $fieldValue {\1\2}] ;# drop trailing comma # xx, xx, -> xx, xx (\1) # xx xx, -> xx xx, # xx, -> xx (\2) } set fieldValue [join $fieldValue \n] } $scrolledText insert insert $fieldValue } set fieldName [lindex [lindex $fieldList 0] 0] set child $f.entry$fieldName # Wait for the window to become visible and then # set up the scroll region based on # the requested size of the frame, and set # the scroll increment based on the # requested height of the widgets tkwait visibility $child set bbox [grid bbox $f 0 0] set incr [lindex $bbox 3] set width [winfo reqwidth $f] set height [winfo reqheight $f] $canvas config -scrollregion "0 0 $width $height" $canvas config -yscrollincrement $incr # set max [llength $fieldList] # if {$max > 10} { # set max 10 # } # set height [expr $incr * $max] # $canvas config -width $width -height $height $canvas config -width $width } # Scrolled_EntrySet - end # ---------------------------------------------------------------------- # Scrolled_Text # Adapted form Example 27-1 # Text with one or two scrollbars. # proc Scrolled_Text {f args} { # runs with start frame $f -borderwidth 2 -relief groove eval {text $f.t \ -xscrollcommand [list $f.xscroll set] \ -yscrollcommand [list $f.yscroll set]} $args scrollbar $f.xscroll -orient horizontal \ -command [list $f.t xview] scrollbar $f.yscroll -orient vertical \ -command [list $f.t yview] grid $f.t $f.yscroll -sticky news if ![regexp {help|entry} $f] {grid $f.xscroll -sticky news} grid rowconfigure $f 0 -weight 1 grid columnconfigure $f 0 -weight 1 return $f.t } # Scrolled_Text - end # ---------------------------------------------------------------------- # Selector # example: # set aWhich [Selector $f.dir.h1.h2.v2 ddDirectory dd 1] # flag == 1 <==> pack the check button # flag == 0 <==> doesn't pack the check button proc Selector {parent entryName varName index {listName {}} {flag {1}}} { # runs with start # global environmentArray global typeTable ;# defined in DDDialog for example global w # upvar #0 ${varName}Search search upvar #0 $entryName xxEntry set type $typeTable($xxEntry) # regexp {\.[^.]*\.[^.]*} $parent parentLabel ;# .dd.dir regexp "(.*\.$varName\.\[^.\]*)" $parent m parentLabel ;# .dd.dir set side .6c ;# button size set side2 1.15c set a [frame $parent.entry -borderwidth 2 -bg gray \ -relief sunken -height $side] frame $a.button1 -width $side -height $side frame $a.button2 -width $side -height $side frame $a.button3 -width $side -height $side frame $a.button4 -width $side -height $side frame $a.button5 -width $side -height $side frame $a.button6 -width $side -height $side button $a.button1.1 -text < \ -font {-family courier -size 11 -weight normal} \ -cursor hand2 # if $search {$a.button1.1 configure -state disabled} menubutton $a.button2.2 -text > \ -font {-family courier -size 11 -weight normal} \ -cursor hand2 -relief raised -menu $a.button2.2.menu menubutton $a.button3.3 \ -font {-size 9 -weight normal} \ -cursor hand2 -relief raised -menu $a.button3.3.menu ConfigText $a.button3.3 S button $a.button4.4 -cursor hand2 \ -font {-size 9 -weight normal} ;# Remove/Check # -font {times 9 roman} if [regexp {\.ent\.} $type] { ConfigText $a.button4.4 Remove } else { ConfigText $a.button4.4 C } button $a.button5.5 -cursor hand2 \ -font {-size 9 -weight normal} ;# Reverse button $a.button6.6 -cursor hand2 \ -font {-size 9 -weight normal} ;# Find if [regexp {\.rep\.} $type] { set bg [$w cget -bg] set nc [NewColor $w $bg] ConfigText $a.button5.5 Reverse # upvar #0 ${varName}Reverse$index reverse upvar #0 ${varName}Reverse reverse if $reverse { # repository first $a.button5.5 configure -bg $nc $a.button6.6 configure -state disabled } else { # key first $a.button5.5 configure -bg $bg } ConfigText $a.button6.6 Find upvar #0 ${varName}Search search if $search { $a.button6.6 configure -bg $nc } else { $a.button6.6 configure -bg $bg } } entry $a.entry -textvariable ${varName}(result$index) \ -relief flat \ -font {courier 9 roman} # SET THE ENTRY SetEntry $a ${xxEntry}Entry $varName result$index # SET THE ENTRY - end # Close the window entry if [regexp {\.dir\.|\.rep\.} $parent] { upvar #0 ${varName}Choice$index choice if ![regexp {^dir|^rep} $choice] { DisableEntry $a ${varName}(result$index) } } # Close the window entry - end menu $a.button2.2.menu -tearoff 0 \ -font {courier 9 roman} menu $a.button3.3.menu -tearoff 1 \ -font {courier 9 roman} $a.button1.1 configure \ -command "ReduceEntry $a $entryName \ ${varName}(result$index)" if [regexp {\.ent\.} $type] { $a.button4.4 configure \ -command "RemoveEntry $a $entryName \ ${varName}(result$index)" } else { $a.button4.4 configure -command "PerformCheck $a.entry \ $entryName ${varName}(result$index) 0" } $a.button5.5 configure \ -command "ReverseEntry $a $entryName $varName $index" $a.button6.6 configure \ -command "SearchEntry $a $entryName $varName $index" pack propagate $a false pack $a.button1 -side left pack propagate $a.button1 false pack $a.button3 -side left pack propagate $a.button3 false pack $a.button2 -side left pack propagate $a.button2 false pack $a.entry -side left if $flag { pack $a.button4 -side right pack propagate $a.button4 false } if [regexp {\.rep\.} $type] { pack $a.button5 -side right pack $a.button6 -side right pack propagate $a.button5 false pack propagate $a.button6 false } pack $a.button1.1 -fill both pack $a.button2.2 -fill both pack $a.entry -fill both -expand true pack $a.button3.3 -fill both pack $a.button4.4 -fill both pack $a.button5.5 -fill both pack $a.button6.6 -fill both pack $a -side bottom -fill x -pady .47c # bind $a.entry \ "CompleteEntry %W $entryName ${varName}(result$index) \ {$listName} %A; break" bind $a.entry \ "CompleteEntry %W $entryName ${varName}(result$index) \ %A; break" bindtags $a.entry [list Entry $a.entry all] label $parentLabel.lb1 -bg #ffffcc -relief solid -borderwidth 1 ConfigText $parentLabel.lb1 " Backward " label $parentLabel.lb2 -bg #ffffcc -relief solid -borderwidth 1 ConfigText $parentLabel.lb2 " Forward " label $parentLabel.lb3 -bg #ffffcc -relief solid -borderwidth 1 ConfigText $parentLabel.lb3 \ " Select One of The Most Recent Entries " label $parentLabel.lb4 -bg #ffffcc -relief solid -borderwidth 1 if [regexp {\.ent\.} $type] { ConfigText $parentLabel.lb4 " Remove the Current Entry " } else { ConfigText $parentLabel.lb4 " Check " } label $parentLabel.lb5 -bg #ffffcc -relief solid -borderwidth 1 ConfigText $parentLabel.lb5 \ " Reverse " label $parentLabel.lb6 -bg #ffffcc -relief solid -borderwidth 1 ConfigText $parentLabel.lb6 \ " Find " bind $a.button1 \ "DisplayMessage $parentLabel.lb1 $a nw 0 1 0 3" bind $a.button1 "DeleteMessage" bind $a.button1.1