home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _e742701f22733f6217685aabbd554474 < prev    next >
Text File  |  2000-03-15  |  21KB  |  671 lines
  1. <HTML><!-- Hey Emacs, please edit in -*- perl -*- mode -->
  2.  
  3. <!-- We need some JScript until the PerlScript bugs are fixed. :-( -->
  4. <SCRIPT>
  5. function rollon(frame) {
  6.     var event = window.parent.frames(frame).event;
  7.     var element = event.srcElement;
  8.     if (element.tagName != "TD") {
  9.     element = element.parentElement;
  10.     }
  11.     if (element.className == "Inactive") {
  12.         element.className = "Active";
  13.         event.cancelBubble = true;
  14.     }
  15.     else if (element.className == "InactiveHidden") {
  16.         element.className = "ActiveHidden";
  17.         event.cancelBubble = true;
  18.     }
  19. }
  20. function rolloff(frame) {
  21.     var event = window.parent.frames(frame).event;
  22.     var element = event.srcElement;
  23.     if (element.tagName != "TD") {
  24.     element = element.parentElement;
  25.     }
  26.     if (element.className == "Active") {
  27.         element.className = "Inactive";
  28.         event.cancelBubble = true;
  29.     }
  30.     else if (element.className == "ActiveHidden") {
  31.         element.className = "InactiveHidden";
  32.         event.cancelBubble = true;
  33.     }
  34. }
  35.  
  36. </SCRIPT>
  37.  
  38. <SCRIPT LANGUAGE="PerlScript">
  39.  
  40. sub rollonx {
  41.     my $event = $window->parent->frames(shift)->event;
  42.     my $element = $event->srcElement;
  43.     $element = $element->parentElement unless $element->tagName eq "TD";
  44.     if ($element->className =~ /^Inactive(Hidden)?$/) {
  45.     $element->{className} = "Active$1";
  46.     $event->{cancelBubble} = 1;
  47.     }
  48. }
  49.  
  50. sub rolloffx {
  51.     my $event = $window->parent->frames(shift)->event;
  52.     my $element = $event->srcElement;
  53.     $element = $element->parentElement unless $element->tagName eq "TD";
  54.     if ($element->className =~ /^Active(Hidden)?$/) {
  55.     $element->{className} = "Inactive$1";
  56.     $event->{cancelBubble} = 1;
  57.     }
  58. }
  59.  
  60. # Start PerlScript
  61. # ================
  62.  
  63. use Config;            # determine $confix{prefix} for CSS path
  64. use Win32::OLE::Const;
  65. use Win32::OLE::TypeInfo;
  66.  
  67. # Global Variables
  68. # ================
  69.  
  70. # global flags (changed by checkboxes)
  71. my $ShowHidden  = '';        # set to '' or 'CHECKED'
  72. my $GroupByType = '';        # set to '' or 'CHECKED'
  73.  
  74. # for showHelpfile() event
  75. my ($HelpFile,$HelpContext);
  76.  
  77. # list of all registered type libraries
  78. my @Library;
  79. sub libCLSID    () {0}
  80. sub libNAME     () {1}
  81. sub libMAJOR    () {2}
  82. sub libMINOR    () {3}
  83. sub libLANGUAGE () {4}
  84. sub libFILENAME () {5}
  85.  
  86. # list of all types
  87. my @Type;
  88. sub typeLIB    () {0}
  89. sub typeINFO   () {1}
  90. sub typeDOC    () {2}
  91. sub typeATTR   () {3}
  92. sub typeHIDDEN () {4}
  93.  
  94. # list of all members
  95. my @Member;
  96. sub membTYPE     () {0}
  97. sub membDESC     () {1}
  98. sub membDOC      () {2}
  99. sub membICON     () {3}
  100. sub membREADONLY () {4}
  101. sub membHIDDEN   () {5}
  102.  
  103. # index to the currently selected entries or C<undef>
  104. my ($Library,$Type,$Member);
  105.  
  106. # hash of frame objects
  107. my %frame;
  108.  
  109. # Use the ActivePerl documentation stylesheet for all frames
  110. # ==========================================================
  111.  
  112. my $css = "$Config{prefix}\\html\\win32prk.css";
  113. foreach my $frame (qw(Header Libraries Types Members Footer)) {
  114.     $frame{$frame} = $window->parent->frames($frame);
  115.     $frame{$frame}->document->createStyleSheet($css);
  116. }
  117.  
  118. # Rollon/Rolloff highlighting styles for Libraries, Types and Members
  119. # ===================================================================
  120.  
  121. foreach my $frame (qw(Libraries Types Members)) {
  122.     my $ss = $frame{$frame}->document->createStyleSheet;
  123.     my $cursor = "cursor: hand";
  124.     $ss->addRule(".Inactive",        "$cursor; color: black");
  125.     $ss->addRule(".Active",        "$cursor; color: blue");
  126.     $ss->addRule(".InactiveHidden", "$cursor; color: silver");
  127.     $ss->addRule(".ActiveHidden",   "$cursor; color: cornflowerblue");
  128. }
  129.  
  130. # String comparison
  131. # =================
  132.  
  133. sub strcmp {
  134.     my ($x,$y) = @_;
  135.     # skip leading underscores and translate to lowercase
  136.     s/^_*(.*)/\l$1/ for $x, $y;
  137.     return $x cmp $y;
  138. }
  139.  
  140. # showHelpfile event
  141. # ==================
  142.  
  143. sub showHelpfile {
  144.     return unless $HelpFile;
  145.     $window->{status} = "Show Helpfile: $HelpFile  Context: $HelpContext";
  146.     # showHelp doesn't seem to work correctly :-(
  147.     # $window->showHelp($HelpFile, $HelpContext);
  148.     Win32::OLE::Const::_ShowHelpContext($HelpFile, $HelpContext);
  149. }
  150.  
  151. sub onHelp {
  152.     $window->parent->frames(shift)->event->{returnValue} = 0;
  153.     showHelpfile();
  154. }
  155.  
  156. # Initialize the "Header" frame
  157. # =============================
  158.  
  159. my $html = <<HTML;
  160.     <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH=100%>
  161.     <TR><TD CLASS=block VALIGN=MIDDLE WIDTH=100% BGCOLOR=#cc0066>
  162.         <FONT SIZE=+1 COLOR=#ff99cc><STRONG> 
  163.         Win32::OLE - Type Library Browser
  164.         </STRONG></FONT>
  165.     </TD></TR>
  166.     </TABLE>
  167.  
  168.     <TABLE BORDER=0 CELLPADDING=0>
  169.     <TR><TD>Show hidden elements:</TD>
  170.         <TD><INPUT TYPE="checkbox" $ShowHidden
  171.          onclick="parent.Libraries.ShowHidden"></TD></TR>
  172.     <TR><TD>Group elements by type:</TD>
  173.         <TD><INPUT TYPE="checkbox" $GroupByType
  174.          onclick="parent.Libraries.GroupByType"></TD></TR>
  175.     </TABLE>
  176. HTML
  177.  
  178. $frame{Header}->document->body->{innerHTML} = $html;
  179.  
  180. sub ShowHidden {
  181.     $ShowHidden = $frame{Header}->event->srcElement->checked;
  182.     createTypeTable();
  183. }
  184.  
  185. sub GroupByType {
  186.     $GroupByType = $frame{Header}->event->srcElement->checked;
  187.     createTypeTable();
  188. }
  189.  
  190.  
  191. # Initialize the "Footer" frame
  192. # =============================
  193.  
  194. my $ss = $frame{Footer}->document->createStyleSheet;
  195. $ss->addRule(".Indented", "margin-left:48; margin-top:0");
  196. undef $ss;
  197.  
  198.  
  199. # Get a list of all type libraries from the registry
  200. # ==================================================
  201.  
  202. Win32::OLE::Const->EnumTypeLibs(sub {
  203.     my ($clsid,$title,$version,$langid,$filename) = @_;
  204.     return unless $version =~ /^([0-9a-fA-F]+)\.([0-9a-fA-F]+)$/;
  205.     my ($maj,$min) = (hex($1), hex($2));
  206.     push @Library, [$clsid,$title,$maj,$min,$langid,$filename];
  207. });
  208.  
  209.  
  210. @Library = sort {lc $a->[libNAME] cmp lc $b->[libNAME]} @Library;
  211.  
  212.  
  213. # Create list of type libraries
  214. # =============================
  215.  
  216. $html = "<TABLE onhelp=onHelp('Libraries')>\n";
  217. for my $id (0..@Library-1) {
  218.     $html .= <<HTML;
  219.     <TR><TD NOWRAP ID=LIB_$id CLASS=Inactive
  220.         onclick=selectLibrary()
  221.         onmouseover=rollon("Libraries")
  222.         onmouseout=rolloff("Libraries")>
  223.             <IMG SRC="Library.png" WIDTH=16 HEIGHT=16>
  224.         $Library[$id]->[libNAME]</TD>
  225.     <TD>$Library[$id]->[libMAJOR].$Library[$id]->[libMINOR]</TD></TR>
  226. HTML
  227. }
  228. $html .= "</TABLE>";
  229. # $frame{Libraries}->document->body->{innerHTML} = $html;
  230. $window->document->write($html);
  231.  
  232. # Select a type library and display the types
  233. # ===========================================
  234.  
  235. my @icon;
  236. $icon[TKIND_COCLASS]  = 'Class';
  237. $icon[TKIND_DISPATCH] = 'Class';
  238. $icon[TKIND_ENUM]     = 'Enum';
  239. $icon[TKIND_MODULE]   = 'Module';
  240.  
  241. my $tlib; # XXX Hack alert!
  242.  
  243. sub selectLibrary {
  244.     my $element = $window->event->srcElement;
  245.     $element = $element->parentElement if $element->tagName ne 'TD';
  246.     my ($id) = ($element->id =~ /^LIB_(\d+)/);
  247.     return unless defined $id;
  248.  
  249.     # Load new type library
  250.     my @def = @{$Library[$id]}[libNAME,libMAJOR,libMINOR,libLANGUAGE];
  251.     $def[0] = quotemeta $def[0];
  252.     my $typelib = Win32::OLE::Const->LoadRegTypeLib(@def);
  253.     if (Win32::OLE->LastError) {
  254.     $window->alert("Cannot load library: ".Win32::OLE->LastError);
  255.     return;
  256.     }
  257.     $tlib = $typelib;
  258.     my $tcount = $tlib->_GetTypeInfoCount;
  259.  
  260.     # Change selection marker
  261.     $window->document->all("LIB_$Library")->style->{fontWeight} = 'normal'
  262.     if defined $Library;
  263.     $Library = $id;
  264.     $window->document->all("LIB_$Library")->style->{fontWeight} = 'bold';
  265.  
  266.     # Hide all interfaces mentioned in a COCLASS definition
  267.     my %hide;
  268.     for (0..$tcount-1) {
  269.     my $tinfo = $tlib->_GetTypeInfo($_);
  270.     ++$hide{$tinfo->_GetImplTypeInfo($_)->_GetTypeAttr->{guid}}
  271.       foreach 0..$tinfo->_GetTypeAttr->{cImplTypes}-1;
  272.     }
  273.  
  274.     # Make a sorted list of all type information
  275.     undef @Type;
  276.     for (0..$tcount-1) {
  277.     my $tinfo = $tlib->_GetTypeInfo($_);
  278.     my $doc  = $tinfo->_GetDocumentation;
  279.     my $attr = $tinfo->_GetTypeAttr;
  280.     my $tflags = $attr->{wTypeFlags};
  281.     next if $tflags & TYPEFLAG_FRESTRICTED;
  282.     next if $hide{$attr->{guid}};
  283.     next unless $icon[$attr->{typekind}];
  284.     my $hidden = $tflags & TYPEFLAG_FHIDDEN;
  285.     $hidden = 1 if $doc->{Name} =~ /^_/;
  286.     push @Type, [$tlib, $tinfo, $doc, $attr, $hidden];
  287.     }
  288.  
  289.     # Invalidate previous selections and redraw type table
  290.     undef $Type; undef $Member; undef @Member;
  291.     createTypeTable();
  292. }
  293.  
  294. sub showLibraryInfo {
  295.     # Insert type library information into footer frame
  296.     my $doc = $tlib->_GetDocumentation;
  297.     ($HelpFile,$HelpContext) = ($doc->{HelpFile}, $doc->{HelpContext});
  298.     my $html = '';
  299.     my $opaque = -f $HelpFile ? '' : 'filter:alpha(opacity=50);';
  300.     $html .= <<HTML if $HelpFile;
  301.     <IMG SRC="Help.png" WIDTH=16 HEIGHT=16
  302.      STYLE="$opaque cursor:hand"
  303.      onclick="parent.Libraries.showHelpfile"> 
  304. HTML
  305.     $html .= "Library <B>$doc->{Name}</B>";
  306.     $html .= "<P CLASS=Indented>$doc->{HelpFile}" if HelpFile;
  307.     $html .= "<P CLASS=Indented>$doc->{DocString}" if $doc->{DocString};
  308.     $frame{Footer}->document->body->{innerHTML} = $html;
  309. }
  310.  
  311. # TYPEKIND sort order:
  312. my @tkorder;
  313. $tkorder[TKIND_COCLASS]  = -4; # Treat COCLASS/DISPATCH the same for sorting
  314. $tkorder[TKIND_DISPATCH] = -4;
  315. $tkorder[TKIND_MODULE]   = -3;
  316. $tkorder[TKIND_TYPE]     = -2;
  317. $tkorder[TKIND_ENUM]     = -1;
  318.  
  319. sub createTypeTable {
  320.     $frame{Footer}->document->body->{innerText} = '';
  321.     $frame{Members}->document->body->{innerText} = '';
  322.     $frame{Types}->document->body->{innerText} = '';
  323.  
  324.     # Make a sorted index of visible Types
  325.     my @Index = sort {
  326.     my ($a,$b) = @Type[$a,$b];
  327.     my $cmp = 0;
  328.     if ($GroupByType) {
  329.         my $ranka = $tkorder[$a->[typeATTR]->{typekind}] || 0;
  330.         my $rankb = $tkorder[$b->[typeATTR]->{typekind}] || 0;
  331.         $cmp = $ranka <=> $rankb;
  332.     }
  333.     $cmp || strcmp($a->[typeDOC]->{Name}, $b->[typeDOC]->{Name});
  334.     } grep {
  335.     $ShowHidden || !$Type[$_]->[typeHIDDEN]
  336.     } 0..@Type-1;
  337.  
  338.     # Create a table of available types
  339.     my $html = "<TABLE onhelp=\"parent.Libraries.onHelp('Types')\">\n";
  340.     foreach (0..@Index-1) {
  341.     my $id = $Index[$_];
  342.     my $name = $Type[$id]->[typeDOC]->{Name};
  343.     my $icon = $icon[$Type[$id]->[typeATTR]->{typekind}];
  344.     my $src = $icon ? qq(SRC="$icon.png") : '';
  345.     my $hidden = $Type[$id]->[typeHIDDEN] ? 'Hidden' : '';
  346.     $html .= <<HTML;
  347.         <TR><TD NOWRAP ID=TYPE_$id CLASS=Inactive$hidden
  348.             onmouseover="parent.Libraries.rollon('Types')"
  349.             onmouseout="parent.Libraries.rolloff('Types')"
  350.             onclick="parent.Libraries.selectType">
  351.         <IMG $src WIDTH=16 HEIGHT=16>$name</TD></TR>
  352. HTML
  353.     }
  354.     $html .= "</TABLE>";
  355.     $frame{Types}->document->body->{innerHTML} = $html;
  356.  
  357.     # Make sure the previous selection is maintained
  358.     if (defined $Type) {
  359.     my $type = $frame{Types}->document->all("TYPE_$Type");
  360.     if (ref $type) {
  361.         $type->style->{fontWeight} = 'bold';
  362.         $type->ScrollIntoView;
  363.     }
  364.     else {
  365.         undef $Type; undef $Member; undef @Member;
  366.     }
  367.     }
  368.     createMemberTable();
  369. }
  370.  
  371. # Select a type and display the members
  372. # ======================================
  373.  
  374. sub selectType {
  375.     my $element = $frame{Types}->event->srcElement;
  376.     $element = $element->parentElement if $element->tagName ne 'TD';
  377.     my ($id) = ($element->id =~ /^TYPE_(\d+)/);
  378.     return unless defined $id;
  379.  
  380.     # Change selection marker
  381.     $frame{Types}->document->all("TYPE_$Type")->style->{fontWeight} = 'normal'
  382.     if defined $Type;
  383.     $Type = $id;
  384.     $frame{Types}->document->all("TYPE_$Type")->style->{fontWeight} = 'bold';
  385.  
  386.     undef @Member;
  387.     my $tkind = $Type[$Type]->[typeATTR]->{typekind};
  388.     if ($tkind == TKIND_COCLASS) {
  389.     my ($dispatch,$event);
  390.     my $tinfo = $Type[$Type]->[typeINFO];
  391.     for my $impltype (0 .. $Type[$Type]->[typeATTR]->{cImplTypes}-1) {
  392.         my $tflags = $tinfo->_GetImplTypeFlags($impltype);
  393.         next unless $tflags & IMPLTYPEFLAG_FDEFAULT;
  394.         ($tflags & IMPLTYPEFLAG_FSOURCE ? $event : $dispatch) =
  395.           $tinfo->_GetImplTypeInfo($impltype);
  396.     }
  397.     addFunctions($dispatch);
  398.     addFunctions($event, 'Event');
  399.     }
  400.     else {
  401.     addFunctions($Type[$Type]->[typeINFO]);
  402.     addVariables($Type[$Type]->[typeINFO]);
  403.     }
  404.  
  405.     # Invalidate previous selections and redraw type table
  406.     undef $Member;
  407.     createMemberTable();
  408. }
  409.  
  410. sub addFunctions {
  411.     my ($tinfo,$event) = @_;
  412.     return unless defined $tinfo;
  413.     my $attr = $tinfo->_GetTypeAttr;
  414.     my %property;
  415.     for my $func (0 .. $attr->{cFuncs}-1) {
  416.     my $desc = $tinfo->_GetFuncDesc($func);
  417.     next if $desc->{wFuncFlags} & FUNCFLAG_FRESTRICTED;
  418.     my $doc = $tinfo->_GetDocumentation($desc->{memid});
  419.     my $name = $doc->{Name};
  420.     my $invkind = $desc->{invkind};
  421.     next if $event && $invkind != INVOKE_FUNC;
  422.  
  423.     if ($invkind != INVOKE_FUNC && exists $property{$name}) {
  424.         if ($invkind & (INVOKE_PROPERTYPUT | INVOKE_PROPERTYPUTREF)) {
  425.         $Member[$property{$name}]->[membREADONLY] = 0;
  426.         }
  427.         if ($invkind == INVOKE_PROPERTYGET) { # prefer GET syntax
  428.         $Member[$property{$name}]->[membDESC] = $desc;
  429.         }
  430.     }
  431.     else {
  432.         $property{$name} = @Member if $invkind != INVOKE_FUNC;
  433.         my $icon = $invkind == INVOKE_FUNC ? ($event||'Function') : 'Property';
  434.         my $readonly = $invkind == INVOKE_PROPERTYGET;
  435.         my $hidden = $desc->{wFuncFlags} & FUNCFLAG_FHIDDEN;
  436.         $hidden = 1 if $doc->{Name} =~ /^_/;
  437.         push @Member, [$tinfo, $desc, $doc, $icon, $readonly, $hidden];
  438.     }
  439.     }
  440. }
  441.  
  442. sub addVariables {
  443.     my $tinfo = shift;
  444.     return unless defined $tinfo;
  445.     my $attr = $tinfo->_GetTypeAttr;
  446.     for my $var (0 .. $attr->{cVars}-1) {
  447.     my $desc = $tinfo->_GetVarDesc($var);
  448.     next if $desc->{wVarFlags} & VARFLAG_FRESTRICTED;
  449.     my $doc = $tinfo->_GetDocumentation($desc->{memid});
  450.     push @Member, [$tinfo, $desc, $doc, 'Const'];
  451.     }
  452. }
  453.  
  454. sub showTypeInfo {
  455.     return showLibraryInfo() unless defined $Type;
  456.  
  457.     # Insert type information into footer frame
  458.     my $doc = $Type[$Type]->[typeDOC];
  459.     ($HelpFile,$HelpContext) = ($doc->{HelpFile}, $doc->{HelpContext});
  460.     my $html = '';
  461.     $html .= <<HTML if $doc->{HelpFile};
  462.     <IMG SRC="Help.png" WIDTH=16 HEIGHT=16
  463.      STYLE="cursor:hand" onclick="parent.Libraries.showHelpfile"> 
  464. HTML
  465.     my $type = $icon[$Type[$Type]->[typeATTR]->{typekind}] || '???';
  466.     $html .= "$type <B>$doc->{Name}</B>";
  467.     #$html .= "<P CLASS=Indented>$doc->{HelpFile}" if $doc->{HelpFile};
  468.     $html .= "<P CLASS=Indented>$doc->{DocString}" if $doc->{DocString};
  469.     $frame{Footer}->document->body->{innerHTML} = $html;
  470. }
  471.  
  472. # member kind sort order
  473. my %mkorder = (Property => -4, Method => -3, Event => -2, Const => -1);
  474.  
  475. sub createMemberTable {
  476.     $frame{Footer}->document->body->{innerText} = '';
  477.     $frame{Members}->document->body->{innerText} = '';
  478.  
  479.     # Make a sorted index of visible Types
  480.     my @Index = sort {
  481.     my ($a,$b) = @Member[$a,$b];
  482.     my $cmp = 0;
  483.     if ($GroupByType) {
  484.         my $ranka = $mkorder{$a->[membICON]} || 0;
  485.         my $rankb = $mkorder{$b->[membICON]} || 0;
  486.         $cmp = $ranka <=> $rankb;
  487.     }
  488.     $cmp || strcmp($a->[membDOC]->{Name}, $b->[membDOC]->{Name});
  489.     } grep {
  490.     $ShowHidden || !$Member[$_]->[membHIDDEN]
  491.     } 0..@Member-1;
  492.  
  493.     # Create a table of all members
  494.     my $html = "<TABLE onhelp=\"parent.Libraries.onHelp('Members')\">\n";
  495.     foreach (0..@Index-1) {
  496.     my $id = $Index[$_];
  497.     my $hidden = $Member[$id]->[membHIDDEN] ? 'Hidden' : '';
  498.     my ($default,$adjust) = ('','');
  499.     if ($Member[$id]->[membDESC]->{memid} == 0) {
  500.         $default .= '<IMG SRC="Default.png" WIDTH=5 HEIGHT=5 ';
  501.         $default .= 'STYLE="position:relative;left:-16;top:-11;z-index:1">';
  502.         $adjust  .= 'STYLE="position:relative;left:-5"';
  503.     }
  504.     $html .= <<HTML;
  505.         <TR><TD NOWRAP ID=MEMBER_$id CLASS=Inactive$hidden
  506.             onmouseover="parent.Libraries.rollon('Members')"
  507.             onmouseout="parent.Libraries.rolloff('Members')"
  508.             onclick="parent.Libraries.selectMember">
  509.         <IMG SRC="$Member[$id]->[membICON].png"
  510.                     WIDTH=16 HEIGHT=16>$default
  511.         <SPAN $adjust>$Member[$id]->[membDOC]->{Name}</SPAN></TD></TR>
  512. HTML
  513.     }
  514.     $html .= "</TABLE>";
  515.     $frame{Members}->document->body->{innerHTML} = $html;
  516.  
  517.     # Make sure the previous selection is maintained
  518.     if (defined $Member) {
  519.     my $member = $frame{Members}->document->all("MEMBER_$Member");
  520.     if (ref $member) {
  521.         $member->style->{fontWeight} = 'bold';
  522.         $member->scrollIntoView;
  523.     }
  524.     else {
  525.         undef $Member;
  526.     }
  527.     }
  528.     showMemberInfo();
  529. }
  530.  
  531. # Select a member
  532. # ===============
  533.  
  534. sub selectMember {
  535.     my $element = $frame{Members}->event->srcElement;
  536.     $element = $element->parentElement if $element->tagName ne 'TD';
  537.     my ($id) = ($element->id =~ /^MEMBER_(\d+)/);
  538.     return unless defined $id;
  539.  
  540.     # Change selection marker
  541.     $frame{Members}->document->all("MEMBER_$Member")->style->{fontWeight} = 'normal'
  542.     if defined $Member;
  543.     $Member = $id;
  544.     $frame{Members}->document->all("MEMBER_$Member")->style->{fontWeight} = 'bold';
  545.  
  546.     # Show member information
  547.     showMemberInfo();
  548. }
  549.  
  550. # Insert member information into footer frame
  551. # ============================================
  552.  
  553. sub showMemberInfo {
  554.     return showTypeInfo() unless defined $Member;
  555.  
  556.     my $doc = $Member[$Member]->[membDOC];
  557.     ($HelpFile,$HelpContext) = ($doc->{HelpFile}, $doc->{HelpContext});
  558.     my $html = '';
  559.     $html .= <<HTML if $doc->{HelpFile};
  560.     <IMG SRC="Help.png" WIDTH=16 HEIGHT=16
  561.      STYLE="cursor:hand" onclick="parent.Libraries.showHelpfile">
  562. HTML
  563.  
  564.     my $type = $Member[$Member]->[membICON];
  565.     my $desc = $Member[$Member]->[membDESC];
  566.     my $decl = '';
  567.  
  568.     # Function declaration
  569.     if (exists $desc->{wFuncFlags}) {
  570.     my $tinfo = $Member[$Member]->[membTYPE];
  571.     # Parameter names
  572.     my $cParams = $desc->{cParams};
  573.     my $names = $tinfo->_GetNames($desc->{memid}, $cParams+1);
  574.     shift @$names;
  575.  
  576.     # Last arg of PROPERTYPUT is property type
  577.     my $retval = ElemDesc($desc->{elemdescFunc});
  578.     my $invkind = $desc->{invkind};
  579.     $retval = ElemDesc($desc->{rgelemdescParam}->[--$cParams])
  580.       if $invkind == INVOKE_PROPERTYPUT ||
  581.          $invkind == INVOKE_PROPERTYPUTREF;
  582.  
  583.     # Decode function arguments
  584.     my @arg;
  585.     for my $param (0 .. $cParams-1) {
  586.         my $elem = $desc->{rgelemdescParam}->[$param];
  587.         my $arg  = ElemDesc($elem);
  588.         if (my $name = $names->[$param]) {
  589.         $arg = $arg eq 'Variant' ? $name : "$name As $arg";
  590.         }
  591.         if (defined $elem->{varDefaultValue}) {
  592.         my $default = $elem->{varDefaultValue};
  593.         # Lookup symbolic name in enum definition
  594.         my $tinfo = $elem->{vt}->[-1];
  595.         $default = getConstantName($tinfo, $default) if ref $tinfo;
  596.         $arg .= " = $default" if $default ne '0';
  597.         }
  598.         $arg = "[$arg]" if $elem->{wParamFlags} & PARAMFLAG_FOPT;
  599.         push @arg, $arg;
  600.     }
  601.     $decl = sprintf "<B>(</B>%s<B>)</B>", join(', ', @arg)
  602.       if @arg || $type ne 'Property';
  603.  
  604.     # Return type
  605.     $type = 'Sub' if $type eq 'Function' && $retval eq 'Void';
  606.     $retval = '' if $retval eq 'Void';
  607.     $retval = '' if $retval eq 'Variant' && $type eq 'Function';
  608.     $decl .= " As $retval" if $retval;
  609.     }
  610.     # Variable declaration
  611.     elsif (exists $desc->{wVarFlags}) {
  612.     my $value = $desc->{varValue};
  613.     if ($value =~ /^-?\d+$/) {
  614.         $decl = " = $value";
  615.         $decl .= sprintf " (0x%X)", $value if $value < 0 || $value > 9;
  616.     }
  617.     else {
  618.         $decl = " = \"$value\"";
  619.     }
  620.     }
  621.  
  622.     $html .= "$type <B>$doc->{Name}</B>$decl";
  623.     #$html .= "<P CLASS=Indented>$doc->{HelpFile}" if $doc->{HelpFile};
  624.     $html .= "<P CLASS=Indented>readonly" if $Member[$Member]->[membREADONLY];
  625.     $html .= "<P CLASS=Indented>$doc->{DocString}" if $doc->{DocString};
  626.     $frame{Footer}->document->body->{innerHTML} = $html;
  627. }
  628.  
  629. sub getConstantName {
  630.     my ($tinfo,$value) = @_;
  631.     # XXX only int constants supported right now
  632.     # ... everything else is treated as a string XXX
  633.     return qq("$value") unless $value =~ /^-?\d+$/;
  634.  
  635.     my $attr = $tinfo->_GetTypeAttr;
  636.     for my $var (0 .. $attr->{cVars}-1) {
  637.     my $desc = $tinfo->_GetVarDesc($var);
  638.     next if $desc->{wVarFlags} & VARFLAG_FRESTRICTED;
  639.     return $tinfo->_GetDocumentation($desc->{memid})->{Name}
  640.       if $value == $desc->{varValue};
  641.     }
  642.     # sorry, not found (this is a typelib bug!)
  643.     return $value;
  644. }
  645.  
  646. my @vt;
  647. $vt[VT_BOOL]     = 'Boolean';
  648. $vt[VT_BSTR]     = 'String';
  649. $vt[VT_DISPATCH] = 'Object';
  650. $vt[VT_INT]      = 'Long';
  651. $vt[VT_I2]       = 'Short';
  652. $vt[VT_I4]       = 'Long';
  653. $vt[VT_R8]       = 'Double';
  654. $vt[VT_UNKNOWN]  = 'Unknown';
  655. $vt[VT_VARIANT]  = 'Variant';
  656. $vt[VT_VOID]     = 'Void';
  657.  
  658. sub ElemDesc {
  659.     my $desc = shift;
  660.     my $vt = $desc->{vt}->[-1];
  661.     if (ref $vt) {
  662.     return $vt->_GetDocumentation(-1)->{Name};
  663.     }
  664.     return $vt[$vt] || $VT[$vt];
  665. }
  666.  
  667.  
  668. </SCRIPT>
  669. </BODY>
  670. </HTML>
  671.