Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | # Copyright (c) 1995-1999 Nick Ing-Simmons. All rights reserved. |
2 | # This program is free software; you can redistribute it and/or | |
3 | # modify it under the same terms as Perl itself. | |
4 | package Tk::MMutil; | |
5 | use ExtUtils::MakeMaker; | |
6 | use Cwd; | |
7 | use Config; | |
8 | use Carp; | |
9 | use File::Basename; | |
10 | ||
11 | use vars qw($VERSION); | |
12 | $VERSION = '3.050'; # $Id: //depot/Tk8/Tk/MMutil.pm#50 $ | |
13 | ||
14 | use Tk::MakeDepend; | |
15 | ||
16 | use Tk::Config qw(!$VERSION); | |
17 | use vars qw($IsWin32); | |
18 | ||
19 | *IsWin32 = \$main::IsWin32; | |
20 | $IsWin32 = ($^O eq 'MSWin32' || $Config{'ccflags'} =~ /-D_?WIN32_?/) | |
21 | unless defined $IsWin32; | |
22 | ||
23 | @MYEXPORT = qw(perldepend cflags const_config constants installbin c_o xs_o makefile manifypods); | |
24 | ||
25 | sub arch_prune | |
26 | { | |
27 | my $hash = shift; | |
28 | foreach (keys %$hash) | |
29 | { | |
30 | if ($win_arch eq 'x') | |
31 | { | |
32 | delete $hash->{$_} if /Win[A-Z0-9]/ or /OS2/ or /ImgUtil/ or /^x/; | |
33 | } | |
34 | elsif ($win_arch eq 'open32') | |
35 | { | |
36 | delete $hash->{$_} if /Unix|Mwm/ and not /tclUnix/; | |
37 | delete $hash->{$_} if /winMain|dllMain/; | |
38 | } | |
39 | elsif ($win_arch eq 'pm') | |
40 | { | |
41 | delete $hash->{$_} | |
42 | if /Unix|Mwm/ and not | |
43 | /tclUnix|Unix(3d|Button|Dialog|Color|Embed|Focus|Font|Menu|Scrlbr|Send|Int\.|Scale)/; | |
44 | delete $hash->{$_} if /os2Main|dllMain|tkOS2Dll|^x(colors\.c|gc\.)/; | |
45 | delete $hash->{$_} if /ImgUtil|tkWin[A-Z0-9]/ and not /OS2/; | |
46 | } | |
47 | elsif ($win_arch eq 'MSWin32') | |
48 | { | |
49 | delete $hash->{$_} if /Mwm/ and not /tclUnix/; | |
50 | delete $hash->{$_} if /winMain|dllMain/; | |
51 | # delete $hash->{$_} if /^Xrm/; | |
52 | } | |
53 | } | |
54 | } | |
55 | ||
56 | sub mTk_postamble | |
57 | { | |
58 | my ($self) = @_; | |
59 | my $dep = "config :: \$(C_FILES) \$(H_FILES)\n\t$self->{NOECHO}\$(NOOP)\n"; | |
60 | my $mTk = $self->{'MTK'}; | |
61 | $dep .= "# Begin Munging dependancies\n"; | |
62 | foreach my $file (sort keys %$mTk) | |
63 | { | |
64 | $dep .= "$file : ".$mTk->{$file}." \$(TKDIR)/pTk/Tcl-pTk\n"; | |
65 | $dep .= "\t\$(PERL) \$(TKDIR)/pTk/Tcl-pTk ".$mTk->{$file}." $file\n"; | |
66 | } | |
67 | $dep .= "# End Munging dependancies\n\n"; | |
68 | return $dep; | |
69 | } | |
70 | ||
71 | sub mTk_CHO | |
72 | { | |
73 | my $self = shift; | |
74 | my $mTk = shift; | |
75 | my %c; | |
76 | my %h; | |
77 | foreach (@{$self->{H}}) { $h{$_} = 1 } | |
78 | foreach (@{$self->{C}}) { $c{$_} = 1 } | |
79 | foreach (keys %$mTk) | |
80 | { | |
81 | if (/\.c$/) | |
82 | { | |
83 | $c{$_} = 1; | |
84 | } | |
85 | elsif (/\.h$/) | |
86 | { | |
87 | $h{$_} = 1; | |
88 | } | |
89 | } | |
90 | while (@_) | |
91 | { | |
92 | my $name = shift; | |
93 | carp("No $name") unless (exists $c{$name}); | |
94 | delete $c{$name} | |
95 | } | |
96 | arch_prune(\%h); | |
97 | arch_prune(\%c); | |
98 | $self->{'H'} = [sort keys %h]; | |
99 | $self->{'C'} = [sort keys %c]; | |
100 | my(@o_files) = @{$self->{C}}; | |
101 | $self->{O_FILES} = [grep s/\.c(pp|xx|c)?$/$self->{OBJ_EXT}/i, @o_files] ; | |
102 | $self->{'MTK'} = $mTk; | |
103 | my $tk = installed_tk(); | |
104 | my $perl = $self->{'PERL'}; | |
105 | if ($IsWin32 && !-f $perl && -f "$perl.exe") | |
106 | { | |
107 | print "perl=$perl X=$^X\n"; | |
108 | $perl = "$perl.exe"; | |
109 | $self->{'PERL'} = $perl; | |
110 | } | |
111 | foreach my $file (sort keys %$mTk) | |
112 | { | |
113 | unless (-f $file) | |
114 | { | |
115 | warn "Extracting $file\n"; | |
116 | system($perl,"$tk/pTk/Tcl-pTk",$mTk->{$file},$file); | |
117 | } | |
118 | } | |
119 | } | |
120 | ||
121 | my %visited; | |
122 | ||
123 | sub abspath | |
124 | { | |
125 | my $dir = shift; | |
126 | my $here = getcwd() || die "Cannot get current directory:$!"; | |
127 | if (chdir($dir)) | |
128 | { | |
129 | $dir = getcwd(); | |
130 | chdir($here) || die "Cannot cd back to $here:$!"; | |
131 | } | |
132 | return $dir; | |
133 | } | |
134 | ||
135 | sub relpath | |
136 | { | |
137 | my ($path,$dir) = @_; | |
138 | unless (defined $dir) | |
139 | { | |
140 | $dir = (-d $path) ? $path : dirname($path); | |
141 | } | |
142 | if (defined $dir and -d $dir) | |
143 | { | |
144 | if ($path =~ m#^\Q$dir\E([/\\]?.*)$#) | |
145 | { | |
146 | my $base = $1; | |
147 | my $here = getcwd; | |
148 | if ($here =~ m#^\Q$dir\E([/\\]?.*)#) | |
149 | { | |
150 | my $depth = reverse($1); | |
151 | if ($depth) | |
152 | { | |
153 | $depth =~ s,[^/\\]+,..,g; | |
154 | } | |
155 | else | |
156 | { | |
157 | $depth = '.' ; | |
158 | } | |
159 | $depth =~ s,[/\\]+$,,; | |
160 | $base =~ s,^[/\\]+,,; | |
161 | $depth .= "/$base" if ($base); | |
162 | if (-e $depth) | |
163 | { | |
164 | # print "$path is $depth from $here\n"; | |
165 | return $depth; | |
166 | } | |
167 | else | |
168 | { | |
169 | warn "Cannot find $depth\n"; | |
170 | } | |
171 | } | |
172 | else | |
173 | { | |
174 | unless(exists $visited{$here}) | |
175 | { | |
176 | $visited{$here} = 1; | |
177 | warn "$here does not start with $dir\n"; | |
178 | warn "i.e. building outside Tk itself\n"; | |
179 | } | |
180 | } | |
181 | } | |
182 | else | |
183 | { | |
184 | die "'$path' not under '$dir'\n"; | |
185 | } | |
186 | } | |
187 | else | |
188 | { | |
189 | die "Cannot get directory for $path\n"; | |
190 | } | |
191 | return $path; | |
192 | } | |
193 | ||
194 | use strict; | |
195 | ||
196 | sub upgrade_pic | |
197 | { | |
198 | my $flags = ''; | |
199 | die 'upgrade_pic is obsolete'; | |
200 | return $flags; | |
201 | } | |
202 | ||
203 | sub perldepend | |
204 | { | |
205 | my $self = shift; | |
206 | my $str = $self->MM::perldepend; | |
207 | my $name; | |
208 | my %c; | |
209 | foreach my $file (@{$self->{'C'}}) | |
210 | { | |
211 | $c{$file} = 1; | |
212 | } | |
213 | foreach my $file (keys %{$self->{'XS'}}) | |
214 | { | |
215 | $c{$file} = 1; | |
216 | delete $c{$self->{'XS'}{$file}}; | |
217 | } | |
218 | my @files = grep(-f $_,sort(keys %c)); | |
219 | if (@files) | |
220 | { | |
221 | my $tk = installed_tk(); | |
222 | my @inc = split(/\s+/,$self->{'INC'}); | |
223 | my @def = split(/\s+/,$self->{'DEFINE'}); | |
224 | push(@def,qw(-DWIN32 -D__WIN32__)) if ($IsWin32); | |
225 | if ($^O eq 'cygwin') | |
226 | { | |
227 | push(@def,qw(-D__CYGWIN__)); | |
228 | if ($win_arch eq 'MSWin32') | |
229 | { | |
230 | push(@def,qw(-D__WIN32__)) unless $self->{'DEFINE'} =~ /-D__WIN32__/; | |
231 | push(@def,qw(-DWIN32)) if $self->{'NAME'} eq 'Tk::pTk'; | |
232 | } | |
233 | elsif ($win_arch eq 'x') | |
234 | { | |
235 | push(@def,qw(-U_WIN32)); | |
236 | } | |
237 | } | |
238 | foreach (@inc) | |
239 | { | |
240 | s/\$\(TKDIR\)/$tk/g; | |
241 | warn "Odd:$_" if /\$\(/; | |
242 | } | |
243 | $str .= Tk::MakeDepend::command_line(@inc,@def,@files) unless ($ENV{'TKNOMAKEDEPEND'}); | |
244 | } | |
245 | return $str; | |
246 | } | |
247 | ||
248 | sub const_config | |
249 | { | |
250 | my $self = shift; | |
251 | my $name; | |
252 | foreach $name (grep /(%|\.(old|bak|q4|orig|rej))$/,keys %{$self->{PM}}) | |
253 | { | |
254 | delete $self->{PM}->{$name}; | |
255 | } | |
256 | my $flags = $self->{'CCCDLFLAGS'}; | |
257 | $flags =~ s/(-[fK]?\s*)pic\b/${1}PIC/; | |
258 | $self->{'CCCDLFLAGS'} = $flags; | |
259 | if ($^O eq 'MSWin32' && $Config{'ccflags'} =~ /-DPERL_OBJECT/) | |
260 | { | |
261 | $self->{'LDFLAGS'} =~ s/-(debug|pdb:\w+)\s+//g; | |
262 | $self->{'LDDLFLAGS'} =~ s/-(debug|pdb:\w+)\s+//g; | |
263 | } | |
264 | elsif ($^O =~ /(openbsd)/i) | |
265 | { | |
266 | # -Bforcearchive is bad news for Tk - we don't want all of libpTk.a in all .so-s. | |
267 | $self->{'LDDLFLAGS'} =~ s/-Bforcearchive\s*//g; | |
268 | } | |
269 | return $self->MM::const_config; | |
270 | } | |
271 | ||
272 | sub constants | |
273 | { | |
274 | my $self = shift; | |
275 | local $_ = $self->MM::constants; | |
276 | s/(\.SUFFIXES)/$1:\n$1/; | |
277 | $_ .= "\nGCCOPT = $Tk::Config::gccopt\n"; | |
278 | if ($IsWin32) | |
279 | { | |
280 | } | |
281 | $_; | |
282 | } | |
283 | ||
284 | sub cflags | |
285 | { | |
286 | my $self = shift; | |
287 | local $_ = $self->MM::cflags; | |
288 | if (0 && $IsWin32) | |
289 | { | |
290 | if ($Config::Config{cc} =~ /^bcc/i) { | |
291 | # s/(CCFLAGS\s*=)/$1/; | |
292 | } | |
293 | else { | |
294 | s/(CCFLAGS\s*=)/$1 \$(cflags) \$(cvarsdll)/; | |
295 | s/(OPTIMIZE\s*=).*/$1 \$(cdebug)/; | |
296 | } | |
297 | } | |
298 | $_; | |
299 | } | |
300 | ||
301 | sub c_o | |
302 | { | |
303 | my $self = shift; | |
304 | local $_ = $self->MM::c_o; | |
305 | s/\$\(DEFINE\)/\$(DEFINE) \$(GCCOPT)/g; | |
306 | $_; | |
307 | } | |
308 | ||
309 | sub xs_o | |
310 | { | |
311 | my $self = shift; | |
312 | local $_ = $self->MM::xs_o; | |
313 | s/\$\(DEFINE\)/\$(DEFINE) \$(GCCOPT)/g; | |
314 | $_; | |
315 | } | |
316 | ||
317 | sub manifypods | |
318 | { | |
319 | my $self = shift; | |
320 | # Maybe always call UNIX version - we HTMLize them later | |
321 | local $_ = $self->MM::manifypods; | |
322 | if ($] >= 5.00565) | |
323 | { | |
324 | s/(POD2MAN_EXE.*pod2man)/$1 --center "perl\/Tk Documentation" --release "Tk\$(VERSION)"/; | |
325 | } | |
326 | elsif ($] >= 5.003) | |
327 | { | |
328 | s/(POD2MAN_EXE.*pod2man)/$1 -center "perl\/Tk Documentation" -release "Tk\$(VERSION)"/; | |
329 | } | |
330 | else | |
331 | { | |
332 | s/(POD2MAN_EXE.*pod2man)/$1 -center \\"perl\/Tk Documentation\\" -release \\"Tk\$(VERSION)\\"/; | |
333 | } | |
334 | s/\bpod::/Tk::/mg; | |
335 | s/\bpTk:://mg; | |
336 | $_; | |
337 | } | |
338 | ||
339 | sub findINC | |
340 | { | |
341 | my $file = shift; | |
342 | my $dir; | |
343 | foreach $dir (@INC) | |
344 | { | |
345 | my $try = "$dir/$file"; | |
346 | return $try if (-f $try); | |
347 | } | |
348 | die "Cannot find $file in \@INC\n"; | |
349 | } | |
350 | ||
351 | ||
352 | sub makefile | |
353 | { | |
354 | my $self = shift; | |
355 | my $str = $self->MM::makefile; | |
356 | my $mm = findINC('Tk/MMutil.pm'); | |
357 | my $cf = findINC('Tk/Config.pm'); | |
358 | $str =~ s/(\$\(CONFIGDEP\))/$1 $cf $mm/; | |
359 | $str =~ s/\$\(OBJECT\)\s*:.*\n//; | |
360 | return $str; | |
361 | } | |
362 | ||
363 | sub installed_tk | |
364 | { | |
365 | my $tk; | |
366 | my $dir; | |
367 | foreach $dir (@INC) | |
368 | { | |
369 | if (-f "$dir/tkGlue.h") | |
370 | { | |
371 | $tk = relpath($dir); | |
372 | last; | |
373 | } | |
374 | my $try = "$dir/Tk"; | |
375 | if (-f "$try/tkGlue.h") | |
376 | { | |
377 | $tk = relpath($try,$dir); | |
378 | last; | |
379 | } | |
380 | } | |
381 | die "Cannot find perl/Tk include files\n" unless (defined $tk); | |
382 | $tk =~ s,^(\./)+,,; | |
383 | return $tk; | |
384 | } | |
385 | ||
386 | sub installbin | |
387 | { | |
388 | my ($self) = @_; | |
389 | my $str = $self->MM::installbin; | |
390 | my $prog = 'perl'; # $self->{'MAP_TARGET'} || 'perl'; | |
391 | my $inc = findINC('Tk/MMutil.pm'); | |
392 | $inc =~ s,/Tk/MMutil.pm$,,; | |
393 | $inc = relpath($inc); | |
394 | $str =~ s/^\tcp\s/\t\$(PERL) -I$inc -MTk::install -e installbin $prog /mg; | |
395 | return $str; | |
396 | } | |
397 | ||
398 | sub findpTk | |
399 | { | |
400 | my $ptk; | |
401 | my $dir; | |
402 | foreach $dir (map(abspath($_),@_),@INC) | |
403 | { | |
404 | my $try = "$dir/pTk"; | |
405 | if (-d $try && (-f "$try/Lang.h" || -f "$try/libpTk\$(LIB_EXT)")) | |
406 | { | |
407 | $ptk = relpath($try,$dir); | |
408 | last; | |
409 | } | |
410 | } | |
411 | confess "Cannot locate pTk\n" unless (defined $ptk); | |
412 | return $ptk; | |
413 | } | |
414 | ||
415 | sub find_subdir | |
416 | { | |
417 | my %dir; | |
418 | opendir(DIR,'.') || die "Cannot opendir:$!"; | |
419 | foreach my $dir (readdir(DIR)) | |
420 | { | |
421 | next if $dir =~ /^\.\.?$/; | |
422 | next if -l $dir; | |
423 | next unless -d $dir; | |
424 | if (-f "$dir/Makefile.PL") | |
425 | { | |
426 | my $exc = ($win_arch eq 'x') ? 'Unix' : 'Win'; | |
427 | if (-f "$dir/Not${exc}.exc") | |
428 | { | |
429 | warn "Skip $dir on $win_arch\n" | |
430 | } | |
431 | else | |
432 | { | |
433 | $dir{$dir} = 1 | |
434 | } | |
435 | } | |
436 | } | |
437 | closedir(DIR); | |
438 | return \%dir; | |
439 | } | |
440 | ||
441 | sub TkExtMakefile | |
442 | { | |
443 | my (%att) = @_; | |
444 | if ($Config{'ccflags'} =~ /-DPERL_OBJECT/) | |
445 | { | |
446 | $att{'CAPI'} = 'TRUE' unless exists $att{'CAPI'}; | |
447 | } | |
448 | unless (exists $att{'DIR'}) | |
449 | { | |
450 | my $dir = find_subdir(); | |
451 | $att{'DIR'} = [sort(keys %$dir)]; | |
452 | } | |
453 | unless (exists $att{'NAME'}) | |
454 | { | |
455 | my $dir = getcwd; | |
456 | my ($pack) = $dir =~ m#/([^/]+)$#; | |
457 | if (defined $pack) | |
458 | { | |
459 | $att{NAME} = 'Tk::'.$pack; | |
460 | } | |
461 | else | |
462 | { | |
463 | warn "No Name and cannot deduce from '$dir'"; | |
464 | } | |
465 | } | |
466 | my $tk = installed_tk(); | |
467 | $att{'macro'} = {} unless (exists $att{'macro'}); | |
468 | $att{'macro'}{'TKDIR'} = $tk; | |
469 | my @opt = ('VERSION' => $Tk::Config::VERSION, | |
470 | 'XS_VERSION' => $Tk::Config::VERSION); | |
471 | push(@opt,'clean' => {} ) unless (exists $att{'clean'}); | |
472 | $att{'clean'}->{FILES} = '' unless (exists $att{'clean'}->{FILES}); | |
473 | $att{'clean'}->{FILES} .= ' *.bak'; | |
474 | unless (exists($att{'linkext'}) && $att{linkext}{LINKTYPE} eq '') | |
475 | { | |
476 | my $ptk = findpTk($tk); | |
477 | my @tm = (findINC('Tk/typemap')); | |
478 | unshift(@tm,@{$att{'TYPEMAPS'}}) if (exists $att{'TYPEMAPS'}); | |
479 | $att{'TYPEMAPS'} = \@tm; | |
480 | my $i = delete ($att{'INC'}); | |
481 | $i = (defined $i) ? "$i $inc" : $inc; | |
482 | if (delete $att{'dynamic_ptk'}) | |
483 | { | |
484 | push(@opt, | |
485 | 'MYEXTLIB' => "$ptk/libpTk\$(LIB_EXT)", | |
486 | # 'dynamic_lib' => { INST_DYNAMIC_DEP => "$ptk/libpTk\$(LIB_EXT)" } | |
487 | ); | |
488 | } | |
489 | if ($IsWin32 && $Config{'cc'} =~ /^bcc/) | |
490 | { | |
491 | # Borland compiler is very dumb at finding files | |
492 | $i = "-I$tk $i"; | |
493 | $i = "-I$ptk $i"; | |
494 | } | |
495 | if ($IsWin32 && $Config{'cc'} =~ /^gcc/i) | |
496 | { | |
497 | my $base = $Config{'libpth'}; | |
498 | $base =~ s#lib$#i386-mingw32/lib#; | |
499 | my $extra = "-L$base -lcomdlg32 -lgdi32"; | |
500 | my $libs = $att{'LIBS'}->[0]; | |
501 | $att{'LIBS'}->[0] = "$extra $libs"; | |
502 | } | |
503 | if ($^O eq 'cygwin') | |
504 | { | |
505 | # NOTE: use gcc -shared instead of dllwrap (ld2), | |
506 | # dllwrap tries to resolve all symbols, even those | |
507 | # that are brought in from libraries like libpTk.a | |
508 | push(@opt,'LD' => 'gcc -shared'); | |
509 | if ($win_arch eq 'MSWin32') | |
510 | { | |
511 | my $extra = "-lcomdlg32 -lgdi32"; | |
512 | my $libs = $att{'LIBS'}->[0]; | |
513 | $att{'LIBS'}->[0] = "$extra $libs"; | |
514 | $att{'DEFINE'} .= ' -D__WIN32__'; | |
515 | $att{'DEFINE'} .= ' -DWIN32' if($att{'NAME'} eq 'Tk::pTk'); | |
516 | } | |
517 | elsif ($win_arch eq 'x') | |
518 | { | |
519 | $att{'DEFINE'} .= ' -U_WIN32'; | |
520 | } | |
521 | } | |
522 | if (delete $att{'ptk_include'}) | |
523 | { | |
524 | $i = "-I$ptk $i" unless ($ptk eq '.'); | |
525 | } | |
526 | else | |
527 | { | |
528 | $i = "-I$tk $i" unless ($tk eq '.'); | |
529 | } | |
530 | push(@opt,'DEFINE' => $define, 'INC' => $i); | |
531 | } | |
532 | WriteMakefile(@opt, %att); | |
533 | } | |
534 | ||
535 | sub import | |
536 | { | |
537 | no strict 'refs'; | |
538 | my $class = shift; | |
539 | my @list = (@_) ? @_ : @{"${class}::MYEXPORT"}; | |
540 | my $name; | |
541 | foreach $name (@list) | |
542 | { | |
543 | *{"MY::$name"} = \&{"$name"}; | |
544 | } | |
545 | } | |
546 | ||
547 | ||
548 | 1; |