Index by: file name | procedure name | procedure call | annotation
gscope_export.tcl (annotations | original source)

#rR gscope_export.tcl 

proc iii {} {
    global Bornes
    return [dict info $Bornes]
}

proc cava {} {
    return [CaVa]
}

proc CaVa {{Comment ""}} {
    global CaVa
    set Comment [string toupper $Comment]
    if {$Comment==""} { set Comment "?" }
    if {[info exists CaVa($Comment)]} { return $CaVa($Comment) }

    set Science [Science]
    set Date [Date Nice]
    set CaVa(RUNNINGSINCEDATE) $Date
    set CaVa(SCIENCE)          $Science
    set CaVa(?)                "$Science running since $Date"
    return [CaVa $Comment]
}

proc Environ {{Comment ""} {Quoi ""}} {
    if {$Comment==""} { set Comment "Short" }
    if {$Comment=="Short"} {
	set Quoi "WithoutEnv"
	set Comment "GetIt"
    }
    return [AfficheLEnvironnementDeGscope $Comment $Quoi] 
}

proc AfficheLEnvironnementDeGscope {{Comment ""} {Quoi ""}} {
    global env
    global InfoScript
    global FichierGscopeSource
    global WithPackage

    if {$Comment==""} { set Comment "Show" }

    set LaPage {}
    catch {lappend LaPage [format "%-30s %s" RunningSince "[CaVa RunningSinceDate] as [CaVa Science]"] } 
    catch {lappend LaPage [format "%-30s %s" HostName [Hostname]]}
    catch {lappend LaPage [format "%-30s %s" Dialog [DialogPort "GetAll"]]}
    catch {lappend LaPage [format "%-30s %s" GscopeDir [GscopeDir]]} 
    catch {lappend LaPage [format "%-30s %s" GscopeContrib [GscopeContrib]] }
    catch {lappend LaPage [format "%-30s %s" GscopeSource $FichierGscopeSource]} 
    catch {lappend LaPage [format "%-30s %s" RepertoireDuGenome [RepertoireDuGenome]]} 
    catch {lappend LaPage [format "%-30s %s" RepertoireDeTravail [RepertoireDeTravail]]}
    catch {lappend LaPage [format "%-30s %s" HumanGenomeDir [HumanGenomeDir]]}
    catch {lappend LaPage [format "%-30s %s" OntologyDir [OntologyDir]]}
    catch {lappend LaPage ""}
    catch {lappend LaPage [format "%-30s %s" script [InfoScript]] }
    catch {lappend LaPage ""}
    catch {lappend LaPage [format "%-30s %s" OutsideCSTB [OutsideCSTB]] }
    lappend LaPage ""
    foreach P [array names WithPackage] {
	if {[regexp "Default" $P]} { continue }
	lappend LaPage [format "%-30s %s" "Pack $P" [WithPackage $P]] 
    }
    if {$Quoi!="WithoutEnv"} {
	lappend LaPage ""
	foreach V [array names env] {
	    lappend LaPage [format "%-30s %s" $V [set env($V)]] 
	}
    }
    set Display "not set"
    if {[info exists env(DISPLAY)]} { set Display $env(DISPLAY) }
    lappend LaPage [format "%-30s %s" DISPLAY $Display]

    set Page [join $LaPage "\n"]
    if {$Comment=="GetItAsText"} { return $Page }
    if {[PourWscope]} { return [Html_DuTexteTelQuel $Page] }
    if {$Comment=="GetIt"} { return $Page }
    return [AfficheVariable $Page "" "Gscope's environment"]
}

proc OffreLesMots Texte {
    regsub -all {[\|\n\;\,?]} $Texte " " Texte
    regsub -all { +} $Texte " " Texte
    return [Affiche [join [split $Texte " "] "\n"] "AvecShow" "Splitted_line"]
}

proc AfficheLesFichiersApresSplit {Selection {Maniere ""}} {
    FaireLire "AfficheLesFichiersApresSplit obsolete, use AfficheLesFichiers"
    return [AfficheLesFichiers $Selection $Maniere]
}

proc AfficheLesFichiers {Selection {Maniere ""}} {
    set Dernier ""
    foreach Ligne [split $Selection "\n"] {
	foreach Fichier [split $Ligne " "] {
	    if {[FileAbsent $Fichier]} {continue}
	    set Dernier [AfficheFichier $Fichier $Maniere]
	}
    }
    return $Dernier
}

proc AfficheFichier {Fichier {Maniere ""}} {
    
    if { $Fichier == "" } return ""
    if { [FileAbsent $Fichier]} {
	if { ! [regexp {.gz$} $Fichier] && [FileExists "$Fichier.gz"]} {
	    return [AfficheFichier "$Fichier.gz" $Maniere]
	}
	FaireLire "I wanted to show the file \n$Fichier\n It doesn't exist. Sorry."
	return ""
    }
    if {[file isdirectory $Fichier]} {
	set Page "[file dirname $Fichier]\n"
	if { ! [regexp "/" $Page]} { set Page "./$Page" }
	append Page [join [lsort [glob -nocomplain "$Fichier/*"]] "\n"]
    } else {
	if {[EstUnFichierImage $Fichier]} { return [ShowImage $Fichier] }
	set Page [ContenuDuFichier $Fichier]
    }
    return [Affiche $Page $Maniere $Fichier]
}

proc AfficheListe {Liste {Maniere ""} {NomDuFichierOrigine ""}} {
    return [Affiche [join $Liste "\n"] $Maniere $NomDuFichierOrigine]
}

proc TrieEtAffiche {Texte {CommandeDeTri ""} {Maniere ""} {NomDuFichierOrigine ""}}  {
    set LesLignes [split $Texte "\n"] 

    if {$CommandeDeTri==""} { set CommandeDeTri "Alpha" }
	
    if {[regexp -nocase "^Alpha" $CommandeDeTri]} {
	set LesTriees [lsort $LesLignes]
    } elseif {[regexp {^[0-9]+$} $CommandeDeTri]}  {
	set Colonne $CommandeDeTri
	set LesTriees [lsort -index $Colonne $LesLignes]
    } else {
	set Commande [Entre "lsort -index 1 "]
	if {$Commande==""} { return "" }
	set LesTriees [eval $Commande \$LesLignes]
    }
    return [AfficheListe $LesTriees $Maniere $NomDuFichierOrigine]
}

proc ShowDirectories {Page NomDuFichierOrigine {Maniere ""}} {
    foreach Ligne [split $Page "\n"] {
	if {[regexp {^ *(P[0-9]+) } $Ligne Match P]} {
	    set DirOli "[RepertoireDuGenome]/oligos/$P"
	    regsub $P $Ligne $DirOli Ligne
	    lappend LesNouvelles $Ligne
	    continue
	}
	if {[regexp {^ *(N[0-9]+) } $Ligne Match N]} {
	    set DirRec1 "[RepertoireDuGenome]/ppcr_virtuels/$N"
	    regsub $N $Ligne $DirRec1 Ligne
	    lappend LesNouvelles $Ligne
	    continue
	}
	lappend LesNouvelles $Ligne
	continue
    }
    return [Affiche [join $LesNouvelles "\n"] $NomDuFichierOrigine $Maniere]
}

proc NouveauBouton {W Action {Nom ""} {NomDuFichierOrigine ""}} {
    global CommandeNouveauBouton 
    if {[info exists CommandeNouveauBouton] && $Action=="Same"} {
	set Commande $CommandeNouveauBouton
    } else {
	set Commande [Entre "NAME_OF_PROC using OrfName FileName WindowName AllPage Selection"]
    }
    if {$Commande==""} { return "" }
    set NdFO "UnknownOriginFile"
    scan $NomDuFichierOrigine "%s" NdFO
    set CommandeNouveauBouton $Commande
    regsub -all "Selection"   $Commande "\[selection get\]"      Commande
    regsub -all "AllPage"     $Commande "\[set PagePropre($W)\]" Commande
    regsub -all "OrfName"     $Commande $Nom                     Commande
    regsub -all "FileName"    $Commande $NdFO                    Commande
    regsub -all "WindowName"  $Commande $W                       Commande

    set Texte [string range $Commande 0 10] 
    set B [BoutonneLaFenetre $W $Texte $Commande]
    $B configure -background "blue"
    return $B
}

proc CodeSecret {Code {V ""}} {
    global CodeSecret
    if {$Code=="Enter"} { set CodeSecret "" ; return }
    if {$Code=="Leave"} { set CodeSecret "" ; return }
    append CodeSecret $Code
    switch $CodeSecret {
	"00" { Boum }
	"10" { Boum }
	"0100" { eval [Entre] }
	"0101" { AfficheLesProcs }
	"0110" { DemandeEtExecute }
	"111000000" { AfficheLesBoutonsNonOpen $V}
	"111000111" { AfficheLaProc CodeSecret }
	default {}
    }
    return $CodeSecret
}

proc AfficheLesBoutonsNonOpen {{V ""}} {
    global LesBoutonsNonOpen

#    if {$V==""} { set V [Vitrine "GetVitrine"] }
    foreach b $LesBoutonsNonOpen {
	pack $b -fill both
    }
}

proc SortColumnForTreeView {column TV} {
    set old [$TV sort cget -column] 
    set decreasing 0
    if { "$old" == "$column" } {
	set decreasing [$TV sort cget -decreasing]
	set decreasing [expr !$decreasing]
    }
    $TV sort configure -decreasing $decreasing -column $column -mode integer
    if { ![$TV cget -flat] } {
	$TV configure -flat yes
    }
    $TV sort auto yes

    blt::busy hold $TV
    update
    blt::busy release $TV
}

proc FormatMode { mode } {
    array set modes {
	0    ---
	1    --x
	2    -w-
	3    -wx
	4    r-- 
	5    r-x
	6    rw-
	7    rwx
    }

   set mode [format %o [expr $mode & 07777]]
   set owner $modes([string index $mode 0])
   set group $modes([string index $mode 1])
   set world $modes([string index $mode 2])

   return "${owner}${group}${world}"
}

proc FormatSize { size } {
   set string ""
   while { $size > 0 } {
       set rem [expr $size % 1000]
       set size [expr $size / 1000]
       if { $size > 0 } {
           set rem [format "%03d" $rem]
       } 
       if { $string != "" } {
           set string "$rem,$string"
       } else {
           set string "$rem"
       }
   } 
   return $string
}

proc CreateTreeFromDirectory {T parent dir} {
    set saved [pwd]

    cd $dir
    foreach f [glob -nocomplain *] {
	puts $f
	set name [file tail $f]
	if { [catch { file stat $f info }] != 0 } {
	    set node [$T insert $parent -label $name]
	} else {
	    if { $info(type) == "file" } {
		set info(type) [list @blt::tv::normalOpenFolder $name]
	    } else {
		set info(type) ""
	    }
	    set info(mtime) [clock format $info(mtime) -format "%b %d, %Y"]
	    set info(atime) [clock format $info(atime) -format "%b %d, %Y"]
	    set info(ctime) [clock format $info(ctime) -format "%b %d, %Y"]
            set info(size)  [FormatSize $info(size)]
	    set info(mode)  [FormatMode $info(mode)]
	    set node [$T insert $parent -label $name -data [array get info]]
	}
	if { [file type $f] == "directory" } {
	     CreateTreeFromDirectory $T $node $f
	}
    }
    cd $saved
}


proc GetAbsolutePath { dir } {
    set saved [pwd]
    cd $dir
    set path [pwd] 
    cd $saved
    return $path
}

proc ShowTreeFromDirectory Dir {

    package require BLT
    namespace import blt::*

    set top [GetAbsolutePath $Dir]
    set trim "$top"
    
    set T [tree create]

    CreateTreeFromDirectory $T root $top

    set w [NomDe fenetre]
    toplevel $w

    set Ta $w
    if {$Ta==""} { set Ta "." }

    set TV "$w.tv"

    set HoSb "$w.hs"
    set VeSb "$w.vs"

    scrollbar $HoSb -orient vertical   -command "$TV yview"
    scrollbar $VeSb -orient horizontal -command "$TV xview"

    treeview $TV \
	    -width 100 \
	    -yscrollcommand "$HoSb set" \
	    -xscrollcommand "$VeSb set" \
	    -selectmode single \
	    -tree $T
    $TV column configure treeView -text "Salut toi" 
    #file
    $TV column insert end mtime atime gid 
    $TV column insert end nlink mode type ctime uid ino size dev
    $TV column configure uid -background \#eaeaff -relief raised 
    $TV column configure mtime -hide no -bg \#ffeaea -relief raised
    $TV column configure size gid nlink uid ino dev -justify left -edit yes
    $TV column configure size type -justify left -edit yes
    $TV column configure treeView -hide no -edit no -icon blt::tv::normalOpenFolder
    focus $TV

    $T find root -glob *.html -addtag "html_files"
    
    $TV entry configure "html_files" -foreground magenta
    
    $TV column bind all <ButtonRelease-3> {
	%W configure -flat no
    }
    
    foreach Colonne [$TV column names] {
	$TV column configure $Colonne -command [list SortColumnForTreeView $Colonne $TV]
    }



    table $Ta \
	    0,0 $TV   -fill both \
	    0,1 $HoSb -fill y \
	    1,0 $VeSb -fill x
    table configure $Ta c1 r1 -resize none    

}


Index by: file name | procedure name | procedure call | annotation
File generated 2022-04-05 at 12:55.