lib/tcl/library.tcl

   1 #----------------------------------------
   2 # Library management for XCircuit
   3 #----------------------------------------
   4
   5 set XCOps(module,library) 1
   6
   7 #----------------------------------------
   8
   9 proc xcircuit::raisemanager {} {
  10    makelibmanager
  11    set midx [.xcircuit.menubar.filebutton.filemenu index *Manager*]
  12    .xcircuit.menubar.filebutton.filemenu entryconfigure \
  13          $midx -label "Hide Library Manager" -command {xcircuit::lowermanager}
  14 }
  15
  16 #----------------------------------------
  17
  18 proc xcircuit::lowermanager {} {
  19    destroy .libmgr
  20    set midx [.xcircuit.menubar.filebutton.filemenu index *Manager*]
  21    .xcircuit.menubar.filebutton.filemenu entryconfigure \
  22          $midx -label "Library Manager" -command {xcircuit::raisemanager}
  23 }
  24
  25 #----------------------------------------
  26
  27 proc xcircuit::promptadddirectory {} {
  28    .filelist.bbar.okay configure -command \
  29         {.libmgr.search.list insert 0 [.filelist.textent.txt get];\
  30          updatelibmanager; wm withdraw .filelist}
  31    .filelist.listwin.win configure -data "lps"
  32    .filelist.textent.title.field configure -text "Select directory to add to search:"
  33    .filelist.textent.txt delete 0 end
  34    wm deiconify .filelist
  35    focus .filelist.textent.txt
  36 }
  37
  38 #----------------------------------------
  39
  40 proc xcircuit::promptnewlibrary {} {
  41   .dialog.bbar.okay configure -command \
  42         {library make [.dialog.textent.txt get]; updatelibmanager; \
  43         wm withdraw .dialog}
  44   .dialog.textent.title.field configure -text "Enter name for new library page:"
  45   .dialog.textent.txt delete 0 end
  46   wm deiconify .dialog
  47   focus .dialog.textent.txt
  48 }
  49
  50 #----------------------------------------
  51
  52 proc xcircuit::prompttechtarget {} {
  53   .dialog.bbar.okay configure -command \
  54         {foreach i [.libmgr.object.list curselection] \
  55         {technology objects [.dialog.textent.txt get] \
  56         [.libmgr.object.list get $i]}; \
  57         updatelibmanager; wm withdraw .dialog}
  58   .dialog.textent.title.field configure -text "Enter name of target technology:"
  59   .dialog.textent.txt delete 0 end
  60   wm deiconify .dialog
  61   focus .dialog.textent.txt
  62 }
  63
  64 #----------------------------------------
  65
  66 proc makelibmanager {} {
  67    global XCOps
  68    global XCIRCUIT_LIB_DIR
  69
  70    toplevel .libmgr
  71
  72    wm protocol .libmgr WM_DELETE_WINDOW {xcircuit::lowermanager}
  73
  74    label .libmgr.title1 -text "Source Technology File" -foreground "blue"
  75    label .libmgr.title2 -text "Target Library Page" -foreground "blue"
  76    label .libmgr.title3 -text "Search Directories" -foreground "blue"
  77    frame .libmgr.tblock
  78
  79    label .libmgr.tblock.title -text "Objects" -foreground "blue"
  80
  81    menubutton .libmgr.srclib -text "" -menu .libmgr.srclib.menu -relief groove
  82    menubutton .libmgr.tgtlib -text "" -menu .libmgr.tgtlib.menu -relief groove
  83
  84    frame .libmgr.object
  85    frame .libmgr.search
  86
  87    listbox .libmgr.object.list -relief groove -background white \
  88         -yscrollcommand ".libmgr.object.scroll set" -width 30 \
  89         -selectmode extended
  90    listbox .libmgr.search.list -relief groove -background white \
  91         -yscrollcommand ".libmgr.object.scroll set" -width 30
  92
  93    scrollbar .libmgr.object.scroll -orient vertical \
  94         -command ".libmgr.object.list yview"
  95    scrollbar .libmgr.search.scroll -orient vertical \
  96         -command ".libmgr.search.list yview"
  97
  98    pack .libmgr.object.list     -side left -fill both -expand true
  99    pack .libmgr.object.scroll   -side right -fill y
 100
 101    pack .libmgr.search.list     -side left -fill both -expand true
 102    pack .libmgr.search.scroll   -side right -fill y
 103
 104    frame .libmgr.buttons
 105
 106    button .libmgr.buttons.add -text "Add Directory" \
 107         -command {xcircuit::promptadddirectory}
 108    button .libmgr.buttons.new -text "Add New Library Page" \
 109         -command {xcircuit::promptnewlibrary}
 110    button .libmgr.buttons.done -text "Load Selected" \
 111         -command {foreach i [.libmgr.object.list curselection] \
 112         {library $XCOps(tgtlib) import $XCOps(srclib) \
 113         [.libmgr.object.list get $i]}; updateobjects $XCOps(srclib); \
 114         refresh}
 115    button .libmgr.buttons.all -text "Load All" \
 116         -command {library $XCOps(tgtlib) load $XCOps(srclib); \
 117         updateobjects $XCOps(srclib); refresh}
 118    button .libmgr.buttons.move -text "Move Selected" \
 119         -command {xcircuit::prompttechtarget}
 120
 121    checkbutton .libmgr.tblock.check -text "Show Loaded" \
 122         -variable XCOps(showloaded) -onvalue 1 -offvalue 0 \
 123         -command {updateobjects $XCOps(srclib)}
 124
 125    set XCOps(showloaded) 0
 126
 127    pack .libmgr.buttons.add -side left
 128    pack .libmgr.buttons.new -side left
 129    pack .libmgr.buttons.done -side left
 130    pack .libmgr.buttons.all -side left
 131    # pack .libmgr.buttons.move -side left
 132
 133    grid .libmgr.title1 -row 0 -column 0 -sticky news
 134    grid .libmgr.title2 -row 0 -column 1 -sticky news
 135    grid .libmgr.title3 -row 2 -column 0 -sticky news
 136    grid .libmgr.tblock -row 2 -column 1 -sticky news
 137
 138    pack .libmgr.tblock.title  -side left
 139    pack .libmgr.tblock.check  -side left
 140
 141    grid .libmgr.srclib -row 1 -column 0 -sticky news -padx 4
 142    grid .libmgr.tgtlib -row 1 -column 1 -sticky news -padx 4
 143    grid .libmgr.object -row 3 -column 1 -sticky news
 144    grid .libmgr.search -row 3 -column 0 -sticky news
 145    grid .libmgr.buttons -row 4 -column 0 -columnspan 2 -sticky news
 146
 147    grid columnconfigure .libmgr 0 -weight 1
 148    grid columnconfigure .libmgr 1 -weight 1
 149    grid rowconfigure .libmgr 3 -weight 1
 150
 151    menu .libmgr.srclib.menu -tearoff 0
 152    menu .libmgr.tgtlib.menu -tearoff 0
 153
 154    # Initial set of library directories to search
 155    set searchpath [config search lib]
 156    if {$searchpath == {}} {
 157       .libmgr.search.list insert end $XCIRCUIT_LIB_DIR
 158       .libmgr.search.list insert end "."
 159    } else {
 160       set searchlist [string map {: " "} $searchpath]
 161       foreach i $searchlist {
 162          .libmgr.search.list insert end $i
 163       }
 164    }
 165
 166    # Do an update
 167    updatelibmanager
 168 }
 169
 170 #----------------------------------------
 171
 172 proc updateobjects {techfile} {
 173    global XCOps
 174
 175    # Erase the current entries
 176    .libmgr.object.list delete 0 end
 177    catch unset XObjs(objects)
 178
 179    # Find all the objects defined in library "techfile"
 180    set objlist {}
 181    set fileId [open $techfile]
 182    foreach line [split [read $fileId] \n] {
 183       switch -glob -- $line {
 184          "/* \{" {
 185             lappend objlist [string range [lindex [split $line] 0] 1 end]
 186          }
 187       }
 188    }
 189    close $fileId
 190
 191    set objlist [lsort -dictionary $objlist]
 192    foreach objname $objlist {
 193       if {[catch {object handle $objname}]} {
 194          .libmgr.object.list insert end $objname
 195       } elseif {$XCOps(showloaded) == 1} {
 196          .libmgr.object.list insert end $objname
 197          .libmgr.object.list itemconfigure end -fg forestgreen
 198       }
 199    }
 200 }
 201
 202 #----------------------------------------------
 203 # Filename sorting function---sort by root name
 204 #----------------------------------------------
 205
 206 proc FileCompare {a b} {
 207    set aname [file rootname [file tail $a]]
 208    set bname [file rootname [file tail $b]]
 209    set res [string compare $aname $bname]
 210    if {$res != 0} {
 211       return $res
 212    } else {
 213       # If the root matches, then order by order of search directory
 214       set dlist [.libmgr.search.list get 0 end]
 215       set aidx [lsearch $dlist [file dirname $a]]
 216       set bidx [lsearch $dlist [file dirname $b]]
 217       if {$aidx > $bidx} {
 218          return 1
 219       } elseif {$aidx < $bidx} {
 220          return -1
 221       } else {
 222          return 0
 223       }
 224    }
 225 }
 226
 227 #----------------------------------------
 228
 229 proc updatelibmanager {} {
 230    global XCOps
 231
 232    # Get the list of directories in which to search for libraries
 233    set dirlist [.libmgr.search.list get 0 end]
 234
 235    # Erase the current entries
 236    .libmgr.tgtlib.menu delete 0 end
 237    .libmgr.srclib.menu delete 0 end
 238
 239    # Create the list of source libraries
 240    set srclist {}
 241    foreach i $dirlist {
 242       if {[file isdirectory $i]} {
 243          set srclist [concat $srclist [glob -nocomplain ${i}/*.lps]]
 244       }
 245    }
 246    set srclist [lsort -command FileCompare $srclist]
 247
 248    foreach j $srclist {
 249       set libname [file rootname [file tail $j]]
 250       if {[.libmgr.srclib.menu entrycget end -label] != $libname} {
 251          .libmgr.srclib.menu add radio -label $libname -variable XCOps(srclib) \
 252                 -value $j -command ".libmgr.srclib configure \
 253                 -text $libname; updateobjects $j"
 254       }
 255    }
 256
 257    # Reset "Source Technology" only if not set before, or if the name doesn't match
 258    # the menu entry.
 259    set cres [catch {set entry [.libmgr.srclib.menu index [file rootname \
 260                 [file tail $XCOps(srclib)]]]}]
 261    if {$cres == 0} {
 262       if {[.libmgr.srclib cget -text] == [.libmgr.srclib.menu entrycget $entry -label]} {
 263          set cres 1
 264       }
 265    }
 266    if {$cres == 1} {
 267       set XCOps(srclib) [.libmgr.srclib.menu entrycget 0 -value]
 268       .libmgr.srclib configure -text [.libmgr.srclib.menu entrycget 0 -label]
 269    }
 270
 271    # Find the number of technologies in XCircuit
 272    set numlibs [library "User Library"]
 273
 274    # Create the list of target libraries
 275    for {set i 1} {$i <= $numlibs} {incr i} {
 276       .libmgr.tgtlib.menu add radio -label [library $i] -variable XCOps(tgtlib) \
 277                 -value $i -command ".libmgr.tgtlib configure -text {[library $i]}"
 278    }
 279
 280    # Reset "Target Library" only if not set before, or if the name doesn't match
 281    # the menu entry.
 282    set cres [catch {set entry [.libmgr.srclib.menu index $XCOps(tgtlib)]}]
 283    if {$cres == 0} {
 284       if {[.libmgr.tgtlib cget -text] == [.libmgr.tgtlib.menu entrycget $entry -label]} {
 285          set cres 1
 286       }
 287    }
 288    if {$cres == 1} {
 289       set XCOps(tgtlib) $numlibs
 290       .libmgr.tgtlib configure -text [library $numlibs]
 291    }
 292
 293   # Create the object list for the first source library entry
 294   updateobjects $XCOps(srclib)
 295 }
 296
 297 #----------------------------------------