summaryrefslogtreecommitdiff
path: root/lib/tcl/library.tcl
blob: e939f30b9b26e0268d4c4ae5368bd75dbbc0c559 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
#----------------------------------------
# Library management for XCircuit
#----------------------------------------

set XCOps(module,library) 1

#----------------------------------------

proc xcircuit::raisemanager {} {
   makelibmanager
   set midx [.xcircuit.menubar.filebutton.filemenu index *Manager*]
   .xcircuit.menubar.filebutton.filemenu entryconfigure \
         $midx -label "Hide Library Manager" -command {xcircuit::lowermanager}  
}

#----------------------------------------

proc xcircuit::lowermanager {} {
   destroy .libmgr
   set midx [.xcircuit.menubar.filebutton.filemenu index *Manager*]
   .xcircuit.menubar.filebutton.filemenu entryconfigure \
         $midx -label "Library Manager" -command {xcircuit::raisemanager}  
}

#----------------------------------------

proc xcircuit::promptadddirectory {} {
   .filelist.bbar.okay configure -command \
        {.libmgr.search.list insert 0 [.filelist.textent.txt get];\
         updatelibmanager; wm withdraw .filelist}
   .filelist.listwin.win configure -data "lps"
   .filelist.textent.title.field configure -text "Select directory to add to search:"
   .filelist.textent.txt delete 0 end
   wm deiconify .filelist
   focus .filelist.textent.txt
}

#----------------------------------------

proc xcircuit::promptnewlibrary {} {
  .dialog.bbar.okay configure -command \
        {library make [.dialog.textent.txt get]; updatelibmanager; \
	wm withdraw .dialog}
  .dialog.textent.title.field configure -text "Enter name for new library page:"
  .dialog.textent.txt delete 0 end
  wm deiconify .dialog
  focus .dialog.textent.txt
}

#----------------------------------------

proc xcircuit::prompttechtarget {} {
  .dialog.bbar.okay configure -command \
	{foreach i [.libmgr.object.list curselection] \
	{technology objects [.dialog.textent.txt get] \
	[.libmgr.object.list get $i]}; \
        updatelibmanager; wm withdraw .dialog}
  .dialog.textent.title.field configure -text "Enter name of target technology:"
  .dialog.textent.txt delete 0 end
  wm deiconify .dialog
  focus .dialog.textent.txt
}

#----------------------------------------

proc makelibmanager {} {
   global XCOps
   global XCIRCUIT_LIB_DIR

   toplevel .libmgr

   wm protocol .libmgr WM_DELETE_WINDOW {xcircuit::lowermanager}

   label .libmgr.title1 -text "Source Technology File" -foreground "blue"
   label .libmgr.title2 -text "Target Library Page" -foreground "blue"
   label .libmgr.title3 -text "Search Directories" -foreground "blue"
   frame .libmgr.tblock

   label .libmgr.tblock.title -text "Objects" -foreground "blue"

   menubutton .libmgr.srclib -text "" -menu .libmgr.srclib.menu -relief groove
   menubutton .libmgr.tgtlib -text "" -menu .libmgr.tgtlib.menu -relief groove

   frame .libmgr.object
   frame .libmgr.search

   listbox .libmgr.object.list -relief groove -background white \
	-yscrollcommand ".libmgr.object.scroll set" -width 30 \
	-selectmode extended
   listbox .libmgr.search.list -relief groove -background white \
	-yscrollcommand ".libmgr.object.scroll set" -width 30

   scrollbar .libmgr.object.scroll -orient vertical \
	-command ".libmgr.object.list yview"
   scrollbar .libmgr.search.scroll -orient vertical \
	-command ".libmgr.search.list yview"

   pack .libmgr.object.list	-side left -fill both -expand true
   pack .libmgr.object.scroll   -side right -fill y

   pack .libmgr.search.list	-side left -fill both -expand true
   pack .libmgr.search.scroll   -side right -fill y

   frame .libmgr.buttons

   button .libmgr.buttons.add -text "Add Directory" \
	-command {xcircuit::promptadddirectory}
   button .libmgr.buttons.new -text "Add New Library Page" \
	-command {xcircuit::promptnewlibrary}
   button .libmgr.buttons.done -text "Load Selected" \
	-command {foreach i [.libmgr.object.list curselection] \
	{library $XCOps(tgtlib) import $XCOps(srclib) \
	[.libmgr.object.list get $i]}; updateobjects $XCOps(srclib); \
	refresh}
   button .libmgr.buttons.all -text "Load All" \
	-command {library $XCOps(tgtlib) load $XCOps(srclib); \
	updateobjects $XCOps(srclib); refresh}
   button .libmgr.buttons.move -text "Move Selected" \
	-command {xcircuit::prompttechtarget}

   checkbutton .libmgr.tblock.check -text "Show Loaded" \
	-variable XCOps(showloaded) -onvalue 1 -offvalue 0 \
	-command {updateobjects $XCOps(srclib)}

   set XCOps(showloaded) 0

   pack .libmgr.buttons.add -side left
   pack .libmgr.buttons.new -side left
   pack .libmgr.buttons.done -side left
   pack .libmgr.buttons.all -side left
   # pack .libmgr.buttons.move -side left

   grid .libmgr.title1 -row 0 -column 0 -sticky news
   grid .libmgr.title2 -row 0 -column 1 -sticky news
   grid .libmgr.title3 -row 2 -column 0 -sticky news
   grid .libmgr.tblock -row 2 -column 1 -sticky news

   pack .libmgr.tblock.title  -side left
   pack .libmgr.tblock.check  -side left

   grid .libmgr.srclib -row 1 -column 0 -sticky news -padx 4
   grid .libmgr.tgtlib -row 1 -column 1 -sticky news -padx 4
   grid .libmgr.object -row 3 -column 1 -sticky news
   grid .libmgr.search -row 3 -column 0 -sticky news
   grid .libmgr.buttons -row 4 -column 0 -columnspan 2 -sticky news

   grid columnconfigure .libmgr 0 -weight 1
   grid columnconfigure .libmgr 1 -weight 1
   grid rowconfigure .libmgr 3 -weight 1

   menu .libmgr.srclib.menu -tearoff 0
   menu .libmgr.tgtlib.menu -tearoff 0

   # Initial set of library directories to search
   set searchpath [config search lib]
   if {$searchpath == {}} {
      .libmgr.search.list insert end $XCIRCUIT_LIB_DIR
      .libmgr.search.list insert end "."
   } else {
      set searchlist [string map {: " "} $searchpath]
      foreach i $searchlist {
         .libmgr.search.list insert end $i
      }
   }

   # Do an update
   updatelibmanager
}

#----------------------------------------

proc updateobjects {techfile} {
   global XCOps

   # Erase the current entries
   .libmgr.object.list delete 0 end
   catch unset XObjs(objects)

   # Find all the objects defined in library "techfile"
   set objlist {}
   set fileId [open $techfile]
   foreach line [split [read $fileId] \n] {
      switch -glob -- $line {
	 "/* \{" {
	    lappend objlist [string range [lindex [split $line] 0] 1 end]
	 }
      }
   }
   close $fileId

   set objlist [lsort -dictionary $objlist]
   foreach objname $objlist {
      if {[catch {object handle $objname}]} {
	 .libmgr.object.list insert end $objname
      } elseif {$XCOps(showloaded) == 1} {
	 .libmgr.object.list insert end $objname
	 .libmgr.object.list itemconfigure end -fg forestgreen
      }
   }
}

#----------------------------------------------
# Filename sorting function---sort by root name
#----------------------------------------------

proc FileCompare {a b} {
   set aname [file rootname [file tail $a]]
   set bname [file rootname [file tail $b]]
   set res [string compare $aname $bname]
   if {$res != 0} {
      return $res
   } else {
      # If the root matches, then order by order of search directory
      set dlist [.libmgr.search.list get 0 end]
      set aidx [lsearch $dlist [file dirname $a]]
      set bidx [lsearch $dlist [file dirname $b]]
      if {$aidx > $bidx} {	
	 return 1
      } elseif {$aidx < $bidx} {
	 return -1
      } else {
	 return 0
      }
   }
}

#----------------------------------------

proc updatelibmanager {} {
   global XCOps

   # Get the list of directories in which to search for libraries
   set dirlist [.libmgr.search.list get 0 end]

   # Erase the current entries
   .libmgr.tgtlib.menu delete 0 end
   .libmgr.srclib.menu delete 0 end

   # Create the list of source libraries
   set srclist {}
   foreach i $dirlist {
      if {[file isdirectory $i]} {       
	 set srclist [concat $srclist [glob -nocomplain ${i}/*.lps]]
      }
   }
   set srclist [lsort -command FileCompare $srclist]

   foreach j $srclist {
      set libname [file rootname [file tail $j]]
      if {[.libmgr.srclib.menu entrycget end -label] != $libname} {
	 .libmgr.srclib.menu add radio -label $libname -variable XCOps(srclib) \
		-value $j -command ".libmgr.srclib configure \
		-text $libname; updateobjects $j"
      }
   }

   # Reset "Source Technology" only if not set before, or if the name doesn't match
   # the menu entry.
   set cres [catch {set entry [.libmgr.srclib.menu index [file rootname \
		[file tail $XCOps(srclib)]]]}]
   if {$cres == 0} {
      if {[.libmgr.srclib cget -text] == [.libmgr.srclib.menu entrycget $entry -label]} {
	 set cres 1
      }
   }
   if {$cres == 1} {
      set XCOps(srclib) [.libmgr.srclib.menu entrycget 0 -value]
      .libmgr.srclib configure -text [.libmgr.srclib.menu entrycget 0 -label]
   }

   # Find the number of technologies in XCircuit
   set numlibs [library "User Library"]

   # Create the list of target libraries
   for {set i 1} {$i <= $numlibs} {incr i} {
      .libmgr.tgtlib.menu add radio -label [library $i] -variable XCOps(tgtlib) \
		-value $i -command ".libmgr.tgtlib configure -text {[library $i]}"
   }

   # Reset "Target Library" only if not set before, or if the name doesn't match
   # the menu entry.
   set cres [catch {set entry [.libmgr.srclib.menu index $XCOps(tgtlib)]}]
   if {$cres == 0} {
      if {[.libmgr.tgtlib cget -text] == [.libmgr.tgtlib.menu entrycget $entry -label]} {
	 set cres 1
      }
   }
   if {$cres == 1} {
      set XCOps(tgtlib) $numlibs
      .libmgr.tgtlib configure -text [library $numlibs]
   }

  # Create the object list for the first source library entry
  updateobjects $XCOps(srclib)
}

#----------------------------------------