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