summaryrefslogtreecommitdiffstats
path: root/usr.bin/global/htags/htags.pl
diff options
context:
space:
mode:
Diffstat (limited to 'usr.bin/global/htags/htags.pl')
-rwxr-xr-xusr.bin/global/htags/htags.pl1043
1 files changed, 1043 insertions, 0 deletions
diff --git a/usr.bin/global/htags/htags.pl b/usr.bin/global/htags/htags.pl
new file mode 100755
index 0000000..9c1a275
--- /dev/null
+++ b/usr.bin/global/htags/htags.pl
@@ -0,0 +1,1043 @@
+#!/usr/bin/perl
+#
+# Copyright (c) 1996, 1997 Shigio Yamaguchi. All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+# 3. All advertising materials mentioning features or use of this software
+# must display the following acknowledgement:
+# This product includes software developed by Shigio Yamaguchi.
+# 4. Neither the name of the author nor the names of any co-contributors
+# may be used to endorse or promote products derived from this software
+# without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+#
+# htags.pl 5-Apr-97
+#
+$com = $0;
+$com =~ s/.*\///;
+$usage = "usage: $com [-a][-v][-w][-t title][-d tagdir][dir]";
+#-------------------------------------------------------------------------
+# CONFIGURATION
+#-------------------------------------------------------------------------
+# columns of line number
+$ncol = 4;
+# font
+$comment_begin = '<I><FONT COLOR=green>'; # /* ... */
+$comment_end = '</FONT></I>';
+$sharp_begin = '<FONT COLOR=darkred>'; # #define, #include or so on
+$sharp_end = '</FONT>';
+$brace_begin = '<FONT COLOR=blue>'; # { ... }
+$brace_end = '</FONT>';
+$reserved_begin = '<B>'; # if, while, for or so on
+$reserved_end = '</B>';
+# reserved words
+$reserved_words = "auto|break|case|char|continue|default|do|double|else|extern|float|for|goto|if|int|long|register|return|short|sizeof|static|struct|switch|typedef|union|unsigned|void|while";
+# temporary directory
+$tmp = '/tmp';
+#-------------------------------------------------------------------------
+# DEFINITION
+#-------------------------------------------------------------------------
+# unit for a path
+$SEP = ' '; # source file path must not include $SEP charactor
+$ESCSEP = &escape($SEP);
+$SRCS = 'S';
+$DEFS = 'D';
+$REFS = 'R';
+$FILES = 'files';
+$FUNCS = 'funcs';
+#-------------------------------------------------------------------------
+# JAVASCRIPT PARTS
+#-------------------------------------------------------------------------
+# escaped angle
+$langle = sprintf("unescape('%s')", &escape('<'));
+$rangle = sprintf("unescape('%s')", &escape('>'));
+# frame name
+$f_mains = 'mains'; # for main view
+$f_funcs = 'funcs'; # for function index
+$f_files = 'files'; # for file index
+$begin_script="<SCRIPT LANGUAGE=javascript>\n<!--\n";
+$end_script="<!-- end of script -->\n</SCRIPT>\n";
+$defaultview=
+ "// if your browser doesn't support javascript, write a BASE tag statically.\n" .
+ "if (parent.frames.length)\n" .
+ " document.write($langle+'BASE TARGET=$f_mains'+$rangle)\n";
+$rewrite_href_funcs =
+ "// IE3.0 seems to be not able to treat following code.\n" .
+ "if (parent.frames.length && parent.$f_funcs == self) {\n" .
+ " document.links[0].href = '../funcs.html';\n" .
+ " document.links[document.links.length - 1].href = '../funcs.html';\n" .
+ "}\n";
+$rewrite_href_files =
+ "// IE3.0 seems to be not able to treat following code.\n" .
+ "if (parent.frames.length && parent.$f_files == self) {\n" .
+ " document.links[0].href = '../files.html';\n" .
+ " document.links[document.links.length - 1].href = '../files.html';\n" .
+ "}\n";
+#-------------------------------------------------------------------------
+# UTIRITIES
+#-------------------------------------------------------------------------
+sub getcwd {
+ local($dir) = `/bin/pwd`;
+ chop($dir);
+ $dir;
+}
+sub date {
+ local($date) = `date`;
+ chop($date);
+ $date;
+}
+sub error {
+ local($msg) = @_;
+ &clean();
+ die($msg);
+}
+sub clean {
+ &anchor'finish();
+ &cache'close();
+}
+sub escape {
+ local($c) = @_;
+ '%' . sprintf("%x", ord($c));
+}
+#-------------------------------------------------------------------------
+# PROCESS START
+#-------------------------------------------------------------------------
+#
+# options check
+#
+$aflag = $vflag = $wflag = $sflag = ''; # $sflag is set internally
+while ($ARGV[0] =~ /^-/) {
+ $opt = shift;
+ if ($opt =~ /[^-avwdt]/) {
+ print STDERR "$usage\n";
+ exit 1;
+ }
+ if ($opt =~ /a/) { $aflag = 1; }
+ if ($opt =~ /v/) { $vflag = 1; }
+ if ($opt =~ /w/) { $wflag = 1; }
+ if ($opt =~ /t/) {
+ $opt = shift;
+ last if ($opt eq '');
+ $title = $opt;
+ } elsif ($opt =~ /d/) {
+ $opt = shift;
+ last if ($opt eq '');
+ $dbpath = $opt;
+ }
+}
+if (!$title) {
+ @cwd = split('/', &getcwd);
+ $title = $cwd[$#cwd];
+}
+if (!$dbpath) {
+ $dbpath = '.';
+}
+unless (-r "$dbpath/GTAGS" && -r "$dbpath/GRTAGS") {
+ &error("GTAGS and GRTAGS not found. please type 'gtags[RET]'\n");
+}
+$html = &getcwd() . '/HTML';
+if ($ARGV[0]) {
+ $cwd = &getcwd();
+ unless (-w $ARGV[0]) {
+ &error("$ARGV[0] is not writable directory.\n");
+ }
+ chdir($ARGV[0]) || &error("directory $ARGV[0] not found.\n");
+ $html = &getcwd() . '/HTML';
+ chdir($cwd) || &error("cannot return directory.\n");
+}
+#
+# set sflag if *.[sS] are included.
+#
+open(CHECK, "btreeop $dbpath/GTAGS |") || &error("btreeop $dbpath/GTAGS failed.\n");
+while (<CHECK>) {
+ local($tag, $lno, $filename) = split;
+ if ($filename =~ /\.[sS]$/) {
+ $'sflag = 1;
+ last;
+ }
+}
+close(CHECK);
+#-------------------------------------------------------------------------
+# MAKE FILES
+#-------------------------------------------------------------------------
+# HTML/help.html ... help file (2)
+# HTML/funcs.html ... function index (3)
+# HTML/$FUNCS/* ... function index (3)
+# HTML/$REFS/* ... referencies (4)
+# HTML/$DEFS/* ... definitions (4)
+# HTML/files.html ... file index (5)
+# HTML/$FILES/* ... file index (5)
+# HTML/index.html ... index file (6)
+# HTML/mains.html ... main index (7)
+# HTML/$SRCS/ ... source files (8)
+#-------------------------------------------------------------------------
+print STDERR "[", &date, "] ", "Htags started\n" if ($vflag);
+#
+# (1) make directories
+#
+print STDERR "[", &date, "] ", "(1) making directories ...\n" if ($vflag);
+mkdir($html, 0777) || &error("cannot make directory <$html>.\n") if (! -d $html);
+foreach $d ($SRCS, $REFS, $DEFS, $FILES, $FUNCS) {
+ mkdir("$html/$d", 0775) || &error("cannot make HTML directory\n") if (! -d "$html/$d");
+}
+#
+# (2) make help file
+#
+print STDERR "[", &date, "] ", "(2) making help.html ...\n" if ($vflag);
+&makehelp("$html/help.html");
+#
+# (3) make function index (funcs.html and $FUNCS/*)
+# PRODUCE @funcs
+#
+print STDERR "[", &date, "] ", "(3) making function index ...\n" if ($vflag);
+$func_total = &makefuncindex("$html/funcs.html");
+print STDERR "Total $func_total functions.\n" if ($vflag);
+#
+# (4) make function entries ($DEFS/* and $REFS/*)
+# MAKING TAG CACHE
+#
+print STDERR "[", &date, "] ", "(4) making duplicate entries ...\n" if ($vflag);
+sub suddenly { &clean(); exit 1}
+$SIG{'INT'} = 'suddenly';
+$SIG{'QUIT'} = 'suddenly';
+$SIG{'TERM'} = 'suddenly';
+&cache'open(100000);
+$func_total = &makedupindex($func_total);
+print STDERR "Total $func_total functions.\n" if ($vflag);
+#
+# (5) make file index (files.html and $FILES/*)
+# PRODUCE @files
+#
+print STDERR "[", &date, "] ", "(5) making file index ...\n" if ($vflag);
+$file_total = &makefileindex("$html/files.html");
+print STDERR "Total $file_total files.\n" if ($vflag);
+#
+# [#] make a common part for mains.html and index.html
+# USING @funcs @files
+#
+print STDERR "[", &date, "] ", "(#) making a common part ...\n" if ($vflag);
+$index = &makecommonpart($title);
+#
+# (6)make index file (index.html)
+#
+print STDERR "[", &date, "] ", "(6) making index file ...\n" if ($vflag);
+&makeindex("$html/index.html", $title, $index);
+#
+# (7) make main index (mains.html)
+#
+print STDERR "[", &date, "] ", "(7) making main index ...\n" if ($vflag);
+&makemainindex("$html/mains.html", $index);
+#
+# (#) make anchor database
+#
+print STDERR "[", &date, "] ", "(#) making temporary database ...\n" if ($vflag);
+&anchor'create();
+#
+# (8) make HTML files ($SRCS/*)
+# USING TAG CACHE
+#
+print STDERR "[", &date, "] ", "(8) making hypertext from source code ...\n" if ($vflag);
+&makehtml($file_total);
+&clean();
+print STDERR "[", &date, "] ", "Done.\n" if ($vflag);
+exit 0;
+#-------------------------------------------------------------------------
+# SUBROUTINES
+#-------------------------------------------------------------------------
+#
+# makehelp: make help file
+#
+sub makehelp {
+ local($file) = @_;
+
+ open(HELP, ">$file") || &error("cannot make help file.\n");
+ print HELP "<HTML>\n<HEAD><TITLE>HELP</TITLE></HEAD>\n<BODY>\n";
+ print HELP "<H2>Usage of Links</H2>\n";
+ print HELP "<PRE>/* [&lt;][&gt;][^][v] [top][bottom][index][help] */</PRE>\n";
+ print HELP "<DL>\n";
+ print HELP "<DT>[&lt;]<DD>Previous function.\n";
+ print HELP "<DT>[&gt;]<DD>Next function.\n";
+ print HELP "<DT>[^]<DD>First function in this file.\n";
+ print HELP "<DT>[v]<DD>Last function in this file.\n";
+ print HELP "<DT>[top]<DD>Top of this file.\n";
+ print HELP "<DT>[bottom]<DD>Bottom of this file.\n";
+ print HELP "<DT>[index]<DD>Return to index page (mains.html).\n";
+ print HELP "<DT>[help]<DD>You are seeing now.\n";
+ print HELP "</DL>\n";
+ print HELP "</BODY>\n</HTML>\n";
+ close(HELP);
+}
+#
+# makefuncindex: make function index (including alphabetic index)
+#
+# i) file function index file
+# go) @funcs
+#
+sub makefuncindex {
+ local($file) = @_;
+ local($count) = 0;
+
+ open(FUNCTIONS, ">$file") || &error("cannot make function index <$file>.\n");
+ print FUNCTIONS "<HTML>\n<HEAD><TITLE>FUNCTION INDEX</TITLE>\n";
+ print FUNCTIONS "$begin_script$defaultview$end_script</HEAD>\n<BODY>\n";
+ print FUNCTIONS "<H2>FUNCTION INDEX</H2>\n";
+ print FUNCTIONS "<OL>\n" if (!$aflag);
+ local($old) = select(FUNCTIONS);
+ open(TAGS, "btreeop $dbpath/GTAGS | awk '{print \$1}' | sort | uniq |") || &error("btreeop $dbpath/GTAGS failed.\n");
+ local($alpha) = '';
+ @funcs = (); # [A][B][C]...
+ while (<TAGS>) {
+ $count++;
+ chop;
+ local($tag) = $_;
+ print STDERR " [$count] adding $tag\n" if ($vflag);
+ if ($aflag && $alpha ne substr($tag, 0, 1)) {
+ if ($alpha) {
+ print ALPHA "</OL>\n";
+ print ALPHA "<A HREF=../mains.html TARGET=_self>[index]</A>\n";
+ print ALPHA "$begin_script$rewrite_href_funcs$end_script";
+ print ALPHA "</BODY>\n</HTML>\n";
+ close(ALPHA);
+ }
+ $alpha = substr($tag, 0, 1);
+ push(@funcs, "<A HREF=$FUNCS/$alpha.html TARGET=_self>[$alpha]</A>\n");
+ open(ALPHA, ">$html/$FUNCS/$alpha.html") || &error("cannot make alphabetical function index.\n");
+ print ALPHA "<HTML>\n<HEAD><TITLE>$alpha</TITLE>\n";
+ print ALPHA "$begin_script$defaultview$end_script";
+ print ALPHA "</HEAD>\n<BODY>\n<H2>[$alpha]</H2>\n";
+ print ALPHA "<A HREF=../mains.html TARGET=_self>[index]</A>\n";
+ print ALPHA "<OL>\n";
+ select(ALPHA);
+ }
+ open(LIST, "btreeop -K $tag $dbpath/GTAGS |") || &error("btreeop -K $tag $dbpath/GTAGS failed.\n");;
+ local($line1, $line2);
+ if ($line1 = <LIST>) {
+ $line2 = <LIST>;
+ }
+ close(LIST);
+ if ($line2) {
+ print "<LI><A HREF=", ($aflag) ? "../" : "", "D/$tag.html>$tag</A>\n";
+ } else {
+ local($nouse, $lno, $filename) = split(/[ \t]+/, $line1);
+ $nouse = ''; # to make perl quiet
+ $filename =~ s/^\.\///;
+ $filename =~ s/\//$ESCSEP/g;
+ print "<LI><A HREF=", ($aflag) ? "../" : "", "$SRCS/$filename.html#$lno>$tag</A>\n";
+ }
+ close(LIST);
+ }
+ close(TAGS);
+ select($old);
+ if ($aflag) {
+ print ALPHA "</OL>\n";
+ print ALPHA "<A HREF=../mains.html TARGET=_self>[index]</A>\n";
+ print ALPHA "$begin_script$rewrite_href_funcs$end_script";
+ print ALPHA "</BODY>\n</HTML>\n";
+ close(ALPHA);
+
+ print FUNCTIONS @funcs;
+ }
+ print FUNCTIONS "</OL>\n" if (!$aflag);
+ print FUNCTIONS "</BODY>\n</HTML>\n";
+ close(FUNCTIONS);
+ $count;
+}
+#
+# makedupindex: make duplicate entries index ($DEFS/* and $REFS/*)
+#
+# i) $total functions total
+# r) $count
+#
+sub makedupindex {
+ local($total) = @_;
+ local($count) = 0;
+
+ open(TAGS, "btreeop $dbpath/GTAGS | awk '{print \$1}' | sort | uniq |") || &error("btreeop $dbpath/GTAGS failed.\n");
+ while (<TAGS>) {
+ $count++;
+ chop;
+ local($tag) = $_;
+ print STDERR " [$count/$total] adding $tag\n" if ($vflag);
+ foreach $db ('GTAGS', 'GRTAGS') {
+ open(LIST, "btreeop -K $tag $dbpath/$db | sort +0b -1 +2b -3 +1n -2|") || &error("btreeop -K $tag $dbpath/$db failed.\n");;
+ local($line1, $line2);
+ if ($line1 = <LIST>) {
+ $line2 = <LIST>;
+ }
+ &cache'put($db, $tag, ($line2) ? '' : $line1) if ($line1);
+ if ($line2) { # two or more entries exist
+ local($type) = ($db eq 'GTAGS') ? $'DEFS : $'REFS;
+ open(FILE, ">$html/$type/$tag.html") || &error("cannot make file <$html/$type/$tag.html>.\n");
+ print FILE "<HTML>\n<HEAD><TITLE>$tag</TITLE></HEAD>\n<BODY>\n";
+ print FILE "<PRE>\n";
+ for (;;) {
+ if ($line1) {
+ $_ = $line1;
+ $line1 = '';
+ } elsif ($line2) {
+ $_ = $line2;
+ $line2 = '';
+ } elsif (!($_ = <LIST>)) {
+ last;
+ }
+ s/\.\///;
+ s/&/&amp;/g;
+ s/</&lt;/g;
+ s/>/&gt;/g;
+ local($nouse, $lno, $filename) = split;
+ $nouse = ''; # to make perl quiet
+ $filename =~ s/\//$ESCSEP/g;
+ s/^$tag/<A HREF=..\/$SRCS\/$filename.html#$lno>$tag<\/A>/;
+ print FILE;
+ }
+ print FILE "</PRE>\n</BODY>\n</HTML>\n";
+ close(FILE);
+ }
+ close(LIST);
+ }
+ }
+ close(TAGS);
+ $count;
+}
+#
+# makefileindex: make file index
+#
+# i) file name
+# go) @files
+#
+sub makefileindex {
+ local($file) = @_;
+ local($count) = 0;
+
+ open(FILES, ">$file") || &error("cannot make file <$file>.\n");
+ print FILES "<HTML>\n<HEAD><TITLE>FILES</TITLE>\n";
+ print FILES "$begin_script$defaultview$end_script";
+ print FILES "</HEAD>\n<BODY>\n<H2>FILE INDEX</H2>\n";
+ print FILES "<OL>\n";
+ local($old) = select(FILES);
+ open(FIND, "find . -name '*.[chysS]' -print | sort |") || &error("cannot exec find.\n");
+ local($lastdir) = '';
+ @files = ();
+ while (<FIND>) {
+ $count++;
+ chop;
+ s/^\.\///;
+ next if /(y\.tab\.c|y\.tab\.h)$/;
+ next if (!$'sflag && /\.[sS]$/);
+ local($filename) = $_;
+ print STDERR " [$count] adding $filename\n" if ($vflag);
+ local($dir);
+ if (index($filename, '/') >= 0) {
+ @split = split('/');
+ $dir = $split[0];
+ } else {
+ $dir = '';
+ }
+ #if ($dir && $dir ne $lastdir) {
+ if ($dir ne $lastdir) {
+ if ($lastdir) {
+ print DIR "</OL>\n";
+ print DIR "<A HREF=../mains.html TARGET=_self>[index]</A>\n";
+ print DIR "$begin_script$rewrite_href_files$end_script";
+ print DIR "</BODY>\n</HTML>\n";
+ close(DIR);
+ }
+ if ($dir) {
+ push(@files, "<LI><A HREF=$FILES/$dir.html TARGET=_self>$dir/</A>\n");
+ open(DIR, ">$html/$FILES/$dir.html") || &error("cannot make directory index.\n");
+ print DIR "<HTML>\n<HEAD><TITLE>$dir/</TITLE>\n";
+ print DIR "$begin_script$defaultview$end_script";
+ print DIR "</HEAD>\n<BODY>\n<H2>$dir/</H2>\n";
+ print DIR "<A HREF=../mains.html TARGET=_self>[index]</A>\n";
+ print DIR "<OL>\n";
+ }
+ $lastdir = $dir;
+ }
+ local($path) = $filename;
+ $path =~ s/\//$ESCSEP/g;
+ if ($dir eq '') {
+ push(@files, "<LI><A HREF=", ($dir) ? "../" : "", "$SRCS/$path.html>$filename</A>\n");
+ } else {
+ print DIR "<LI><A HREF=../$SRCS/$path.html>$filename</A>\n";
+ }
+ }
+ close(FIND);
+ select($old);
+ if ($lastdir) {
+ print DIR "</OL>\n";
+ print DIR "<A HREF=../mains.html TARGET=_self>[index]</A>\n";
+ print DIR "$begin_script$rewrite_href_files$end_script";
+ print DIR "</BODY>\n</HTML>\n";
+ close(DIR);
+ }
+ print FILES @files;
+ print FILES "</OL>\n";
+ print FILES "</BODY>\n</HTML>\n";
+ close(FILES);
+
+ $count;
+}
+#
+# makecommonpart: make a common part for mains.html and index.html
+#
+# gi) @files
+# gi) @funcs
+#
+sub makecommonpart {
+ local($title) = @_;
+ local($index) = '';
+
+ $index .= "<H1><FONT COLOR=#cc0000>$title</FONT></H1>\n";
+ $index .= "<P ALIGN=right>";
+ $index .= "Last updated " . &date . "<BR>\n";
+ $index .= "This hypertext was generated by <A HREF=http://wafu.netgate.net/tama/unix/indexe.html#global TARGET=_top>GLOBAL</A>.<BR>\n";
+ $index .= "$begin_script";
+ $index .= "if (parent.frames.length && parent.$f_mains == self)\n";
+ $index .= " document.write($langle+'A HREF=mains.html TARGET=_top'+$rangle+'[No frame version is here.]'+$langle+'/A'+$rangle)\n";
+ $index .= "$end_script";
+ $index .= "</P>\n<HR>\n";
+ $index .= "<H2>MAINS</H2>\n";
+ $index .= "<PRE>\n";
+ open(PIPE, "btreeop -K main $dbpath/GTAGS | sort +0b -1 +2b -3 +1n -2 |") || &error("btreeop -K main $dbpath/GTAGS failed.\n");
+ while (<PIPE>) {
+ local($nouse, $lno, $filename) = split;
+ $nouse = ''; # to make perl quiet
+ $filename =~ s/^\.\///;
+ $filename =~ s/\//$ESCSEP/g;
+ s/(main)/<A HREF=$SRCS\/$filename.html#$lno>$1<\/A>/;
+ $index .= $_;
+ }
+ close(PIPE);
+ $index .= "</PRE>\n<HR>\n<H2>FUNCTIONS</H2>\n";
+ if ($aflag) {
+ foreach $f (@funcs) {
+ $index .= $f;
+ }
+ } else {
+ $index .= "<PRE><A HREF=funcs.html>function index</A></PRE>\n";
+ }
+ $index .= "<HR>\n<H2>FILES</H2>\n";
+ $index .= "<OL>\n";
+ foreach $f (@files) {
+ $index .= $f;
+ }
+ $index .= "</OL>\n<HR>\n";
+ $index;
+}
+#
+# makeindex: make index file
+#
+# i) $file file name
+# i) $title title of index file
+# i) $index common part
+#
+sub makeindex {
+ local($file, $title, $index) = @_;
+
+ open(FRAME, ">$file") || &error("cannot open file <$file>.\n");
+ print FRAME "<HTML>\n<HEAD><TITLE>$title</TITLE></HEAD>\n";
+ print FRAME "<FRAMESET COLS='200,*'>\n";
+ print FRAME "<NOFRAME>\n$index</NOFRAME>\n";
+ print FRAME "<FRAMESET ROWS='50%,50%'>\n";
+ print FRAME "<FRAME NAME=$f_funcs SRC=funcs.html>\n";
+ print FRAME "<FRAME NAME=$f_files SRC=files.html>\n";
+ print FRAME "</FRAMESET>\n";
+ print FRAME "<FRAME NAME=$f_mains SRC=mains.html>\n";
+ print FRAME "</FRAMESET>\n";
+ print FRAME "</HTML>\n";
+ close(FRAME);
+}
+#
+# makemainindex: make main index
+#
+# i) $file file name
+# i) $index common part
+#
+sub makemainindex {
+ local($file, $index) = @_;
+
+ open(INDEX, ">$file") || &error("cannot create file <$file>.\n");
+ print INDEX "<HTML>\n<HEAD><TITLE>MAINS</TITLE></HEAD>\n";
+ print INDEX "<BODY>\n$index</BODY>\n</HTML>\n";
+ close(INDEX);
+}
+#
+# makehtml: make html files
+#
+sub makehtml {
+ local($total) = @_;
+ local($count) = 0;
+
+ open(FIND, "find . -name '*.[chysS]' -print|") || &error("cannot exec find.\n");
+ while (<FIND>) {
+ $count++;
+ chop;
+ s/^\.\///;
+ next if /y\.tab\.c|y\.tab\.h/;
+ next if (!$'sflag && /\.[sS]$/);
+ local($path) = $_;
+ $path =~ s/\//$SEP/g;
+ print STDERR " [$count/$total] converting $_\n" if ($vflag);
+ &convert'src2html($_, "$html/$SRCS/$path.html");
+ }
+ close(FIND);
+}
+#=========================================================================
+# CONVERT PACKAGE
+#=========================================================================
+package convert;
+#
+# src2html: convert source code into HTML
+#
+# i) $file source file - Read from
+# i) $html HTML file - Write to
+#
+sub src2html {
+ local($file, $html) = @_;
+ local($ncol) = $'ncol;
+
+ open(HTML, ">$html") || &error("cannot create file <$html>.\n");
+ local($old) = select(HTML);
+ #
+ # load tags belonging to this file.
+ #
+ $file =~ s/^\.\///;
+ &anchor'load($file);
+ open(C, $file) || &error("cannot open file <$file>.\n");
+ #
+ # print the header
+ #
+ print "<HTML>\n<HEAD><TITLE>$file</TITLE></HEAD>\n";
+ print "<BODY><A NAME=TOP><H2>$file</H2>\n";
+ print &link_format(&anchor'getlinks(0));
+ print "\n<HR>\n";
+ print "<H2>FUNCTIONS</H2>\n";
+ print "This source file includes following functions.\n";
+ print "<OL>\n";
+ local($lno, $tag, $type);
+ for (($lno, $tag, $type) = &anchor'first(); $lno; ($lno, $tag, $type) = &anchor'next()) {
+ print "<LI><A HREF=#$lno>$tag</A>\n" if ($type eq 'D');
+ }
+ print "</OL>\n";
+ print "<HR>\n";
+ #
+ # print source code
+ #
+ print "<PRE>\n";
+ $INCOMMENT = 0; # initial status is out of comment
+ local($LNO, $TAG, $TYPE) = &anchor'first();
+ while (<C>) {
+ s/\r$//;
+ s/&/&amp;/g; # '<', '>' and '&' are used for HTML tag
+ s/</&lt;/g;
+ s/>/&gt;/g;
+ &protect_line(); # protect quoted char, strings and comments
+ # painting source code
+ s/({|})/$'brace_begin$1$'brace_end/g;
+ $sharp = s/^(#\w+)// ? $1 : ''; # protect macro
+ s/\b($'reserved_words)\b/$'reserved_begin$1$'reserved_end/go if ($sharp ne '#include');
+ s/^/$'sharp_begin$sharp$'sharp_end/ if ($sharp); # recover macro
+
+ local($define_line) = 0;
+ local(@links) = ();
+ local($count) = 0;
+ local($first);
+
+ for ($first = 1; int($LNO) == $.; ($LNO, $TAG, $TYPE) = &anchor'next()) {
+ if ($first) {
+ $first = 0;
+ print "<A NAME=$LNO>"
+ }
+ $define_line = $LNO if ($TYPE eq 'D');
+ $db = ($TYPE eq 'D') ? 'GRTAGS' : 'GTAGS';
+ local($line) = &cache'get($db, $TAG);
+ if (defined($line)) {
+ local($href, $dir);
+ if ($line) {
+ local($nouse, $lno, $filename) = split(/[ \t]+/, $line);
+ $nouse = ''; # to make perl quiet
+ $filename =~ s/^\.\///;
+ $filename =~ s/\//$'ESCSEP/g;
+ $href = "<A HREF=../$'SRCS/$filename.html#$lno>$TAG</A>";
+ } else {
+ $dir = ($TYPE eq 'D') ? $'REFS : $'DEFS;
+ $href = "<A HREF=../$dir/$TAG.html>$TAG</A>";
+ }
+ # set tag marks and push hyperlink into @links
+ if (s/\b$TAG\b/\005$count\005/) {
+ $count++;
+ push(@links, $href);
+ } else {
+ print STDERR "Error: $file $LNO $TAG($TYPE) tag must exist.\n" if ($'wflag);
+ }
+ } else {
+ print STDERR "Warning: $file $LNO $TAG($TYPE) found but not refered.\n" if ($'wflag);
+ }
+ }
+ # implant links
+ local($s);
+ for ($count = 0; @links; $count++) {
+ $s = shift @links;
+ unless (s/\005$count\005/$s/) {
+ print STDERR "Error: $file $LNO $TAG($TYPE) tag must exist.\n" if ($'wflag);
+ }
+ }
+ &unprotect_line();
+ # print a line
+ printf "%${ncol}d ", $.;
+ print;
+ # print hyperlinks
+ if ($define_line && $file !~ /\.h$/) {
+ print ' ' x ($ncol + 1);
+ print &link_format(&anchor'getlinks($define_line));
+ print "\n";
+ }
+ }
+ print "</PRE>\n";
+ print "<HR>\n";
+ print "<A NAME=BOTTOM>\n";
+ print &link_format(&anchor'getlinks(-1));
+ print "\n";
+ print "</BODY>\n</HTML>\n";
+ close(C);
+ close(HTML);
+ select($old);
+
+}
+#
+# protect_line: protect quoted strings
+#
+# io) $_ source line
+#
+# \001 quoted(\) char
+# \002 quoted('') char
+# \003 quoted string
+# \004 comment
+# \032 temporary mark
+#
+sub protect_line {
+ @quoted_char1 = ();
+ while (/(\\.)/) {
+ push(@quoted_char1, $1);
+ s/\\./\001/;
+ }
+ @quoted_char2 = ();
+ while (/('[^']')/) {
+ push(@quoted_char2, $1);
+ s/'[^']'/\002/;
+ }
+ @quoted_strings = ();
+ while (/("[^"]*")/) {
+ push(@quoted_strings, $1);
+ s/"[^"]*"/\003/;
+ }
+ @comments = ();
+ s/^/\032/ if ($INCOMMENT);
+ while (1) {
+ if ($INCOMMENT == 0) {
+ if (/\/\*/) { # start comment
+ s/\/\*/\032\/\*/;
+ $INCOMMENT = 1;
+ } else {
+ last;
+ }
+ } else {
+ # Thanks to Jeffrey Friedl for his code.
+ if (m!\032(/\*)?[^*]*\*+([^/*][^*]*\*+)*/!) {
+ $INCOMMENT = 0;
+ # minimum matching
+ s!\032((/\*)?[^*]*\*+([^/*][^*]*\*+)*/)!\004!;
+ push(@comments, $1);
+ } else {
+ s/\032(.*)$/\004/; # mark comment
+ push(@comments, $1);
+ }
+ last if ($INCOMMENT);
+ }
+ }
+}
+#
+# unprotect_line: recover quoted strings
+#
+# i) $_ source line
+#
+sub unprotect_line {
+ local($s);
+
+ while (@comments) {
+ $s = shift @comments;
+ s/\004/$'comment_begin$s$'comment_end/;
+ }
+ while (@quoted_strings) {
+ $s = shift @quoted_strings;
+ s/\003/$s/;
+ }
+ while (@quoted_char2) {
+ $s = shift @quoted_char2;
+ s/\002/$s/;
+ }
+ while (@quoted_char1) {
+ $s = shift @quoted_char1;
+ s/\001/$s/;
+ }
+}
+#
+# link_format: format hyperlinks.
+#
+# i) (previous, next, first, last, top, bottom)
+#
+sub link_format {
+ local(@tag) = @_;
+ local(@label) = ('&lt;', '&gt;', '^', 'v', 'top', 'bottom');
+
+ local($line) = "$'comment_begin/* ";
+ while ($label = shift @label) {
+ local($tag) = shift @tag;
+ $line .= "<A HREF=#$tag>" if ($tag);
+ $line .= "[$label]";
+ $line .= "</A>" if ($tag);
+ }
+ $line .= "<A HREF=../mains.html>[index]</A>";
+ $line .= "<A HREF=../help.html>[help]</A>";
+ $line .= " */$'comment_end";
+
+ $line;
+}
+
+#=========================================================================
+# ANCHOR PACKAGE
+#=========================================================================
+package anchor;
+#
+# create: create anchors temporary database
+#
+sub create {
+ $ANCH = "$'tmp/ANCH$$";
+ open(ANCH, "| btreeop -C $ANCH") || &error("btreeop -C $ANCH failed.\n");
+ foreach $db ('GTAGS', 'GRTAGS') {
+ local($type) = ($db eq 'GTAGS') ? 'D' : 'R';
+ open(PIPE, "btreeop $'dbpath/$db |") || &error("btreeop $'dbpath/$db failed.\n");
+ while (<PIPE>) {
+ local($tag, $lno, $filename) = split;
+ print ANCH "$filename $lno $tag $type\n";
+ }
+ close(PIPE);
+ }
+ close(ANCH);
+}
+#
+# finish: remove anchors database
+#
+sub finish {
+ unlink("$ANCH") if (defined($ANCH));
+}
+#
+# load: load anchors in a file from database
+#
+# i) $file source file
+#
+sub load {
+ local($file) = @_;
+
+ $file = './' . $file if ($file !~ /^\.\//);
+
+ @ANCHORS = ();
+ open(ANCH, "btreeop -K $file $ANCH|") || &error("btreeop -K $file $ANCH failed.\n");
+$n = 0;
+ while (<ANCH>) {
+ local($filename, $lno, $tag, $type) = split;
+ local($line);
+ # START for DTFLAG
+ # don't refer to macros which is defined in other C source.
+ if ($type eq 'R' && ($line = &cache'get('GTAGS', $tag))) {
+ local($nouse1, $nouse2, $f, $def) = split(/[ \t]+/, $line);
+ if ($f !~ /\.h$/ && $f !~ $filename && $def =~ /^#/) {
+ print STDERR "Information: skip <$filename $lno $tag> because this is a macro which is defined in other C source.\n" if ($'wflag);
+ next;
+ }
+ }
+ # END for DTFLAG
+ push(@ANCHORS, "$lno,$tag,$type");
+ }
+ close(ANCH);
+ local(@keys);
+ foreach (@ANCHORS) {
+ push(@keys, (split(/,/))[0]);
+ }
+ sub compare { $keys[$a] <=> $keys[$b]; }
+ @ANCHORS = @ANCHORS[sort compare 0 .. $#keys];
+ local($c);
+ for ($c = 0; $c < @ANCHORS; $c++) {
+ local($lno, $tag, $type) = split(/,/, $ANCHORS[$c]);
+ if ($type eq 'D') {
+ $FIRST = $lno;
+ last;
+ }
+ }
+ for ($c = $#ANCHORS; $c >= 0; $c--) {
+ local($lno, $tag, $type) = split(/,/, $ANCHORS[$c]);
+ if ($type eq 'D') {
+ $LAST = $lno;
+ last;
+ }
+ }
+}
+#
+# first: get first anchor
+#
+sub first {
+ $CURRENT = 0;
+ local($lno, $tag, $type) = split(/,/, $ANCHORS[$CURRENT]);
+ $CURRENTDEF = $CURRENT if ($type eq 'D');
+
+ ($lno, $tag, $type);
+}
+#
+# next: get next anchor
+#
+sub next {
+ if (++$CURRENT > $#ANCHORS) {
+ return ('', '', '');
+ }
+ local($lno, $tag, $type) = split(/,/, $ANCHORS[$CURRENT]);
+ $CURRENTDEF = $CURRENT if ($type eq 'D');
+
+ ($lno, $tag, $type);
+}
+#
+# getlinks: get links
+#
+# i) linenumber >= 1: line number
+# 0: header, -1: tailer
+# gi) @ANCHORS tag table in current file
+# r) (previous, next, first, last, top, bottom)
+#
+sub getlinks {
+ local($linenumber) = @_;
+ local($prev, $next, $first, $last, $top, $bottom);
+
+ $prev = $next = $first = $last = $top = $bottom = 0;
+ if ($linenumber >= 1) {
+ local($c, $p, $n);
+ if ($CURRENTDEF == 0) {
+ for ($c = 0; $c <= $#ANCHORS; $c++) {
+ local($lno, $tag, $type) = split(/,/, $ANCHORS[$c]);
+ if ($lno == $linenumber && $type eq 'D') {
+ last;
+ }
+ }
+ $CURRENTDEF = $c;
+ } else {
+ for ($c = $CURRENTDEF; $c >= 0; $c--) {
+ local($lno, $tag, $type) = split(/,/, $ANCHORS[$c]);
+ if ($lno == $linenumber && $type eq 'D') {
+ last;
+ }
+ }
+ }
+ $p = $n = $c;
+ while (--$p >= 0) {
+ local($lno, $tag, $type) = split(/,/, $ANCHORS[$p]);
+ if ($type eq 'D') {
+ $prev = $lno;
+ last;
+ }
+ }
+ while (++$n <= $#ANCHORS) {
+ local($lno, $tag, $type) = split(/,/, $ANCHORS[$n]);
+ if ($type eq 'D') {
+ $next = $lno;
+ last;
+ }
+ }
+ }
+ $first = $FIRST if ($linenumber != $FIRST);
+ $last = $LAST if ($linenumber != $LAST);
+ $top = 'TOP' if ($linenumber != 0);
+ $bottom = 'BOTTOM' if ($linenumber != -1);
+ if ($FIRST == $LAST) {
+ $last = '' if ($linenumber == 0);
+ $first = '' if ($linenumber == -1);
+ }
+
+ ($prev, $next, $first, $last, $top, $bottom);
+}
+
+#=========================================================================
+# CACHE PACKAGE
+#=========================================================================
+package cache;
+#
+# open: open tag cache
+#
+# i) size cache size
+# -1: all cache
+# 0: no cache
+# other: sized cache
+#
+sub open {
+ ($cachesize) = @_;
+
+ if ($cachesize == -1) {
+ return;
+ }
+ undef %CACH if defined(%CACH);
+ $cachecount = 0;
+}
+#
+# put: put tag into cache
+#
+# i) $db database name
+# i) $tag tag name
+# i) $line tag line
+#
+sub put {
+ local($db, $tag, $line) = @_;
+ local($label) = ($db eq 'GTAGS') ? 'D' : 'R';
+
+ $cachecount++;
+ if ($cachesize >= 0 && $cachecount > $cachesize) {
+ $CACH = "$'tmp/CACH$$";
+ dbmopen(%CACH, $CACH, 0600) || &error("make cache database.\n");
+ $cachesize = -1;
+ }
+ $CACH{$label.$tag} = $line;
+}
+#
+# get: get tag from cache
+#
+# i) $db database name
+# i) $tag tag name
+# r) tag line
+#
+sub get {
+ local($db, $tag) = @_;
+ local($label) = ($db eq 'GTAGS') ? 'D' : 'R';
+
+ defined($CACH{$label.$tag}) ? $CACH{$label.$tag} : undef;
+}
+#
+# close: close cache
+#
+sub close {
+ #dbmclose(%CACH);
+ unlink("$CACH.db") if (defined($CACH));
+}
OpenPOWER on IntegriCloud