#! /usr/local/bin/perl
# This part is generated automatically by convert.pl from htags/manual.in.
$program = 'htags';
$usage_const = "Usage: htags [-a][-c][-f][-F][-n][-o][-s][-v][-w][-d dir][-S dir][-t title][dir]";
$help_const = "$usage_const\
Options:\
-a, --alphabet\
       Make an alphabetical function index, suitable for a large project.\
--caution\
       Include caution message to prohibit downloading.\
-c, --compact\
       Compress html files  by gzip(1).\
       You need to set up an HTTP server so that gzip(1)\
       is invoked for each compressed file.\
       See 'HTML/.htaccess' that is generated by htags.\
-f, --form\
       Support search form using CGI program.\
       You need to set up an HTTP server for this.\
-F, --frame\
       Use frame for each part of the contents.\
--gtagsconf file\
       Load user's configuration from file.\
-n, --line-number\
       Print the line numbers. By default, doesn't print it.\
-o, --other\
       Pick up not only source files but also other files except for\
       binary files.\
-v, --verbose\
       Verbose mode.\
-w, --warning\
       Print warning messages.\
-d, --dbpath dir\
       Specifies the directory in which 'GTAGS' and 'GRTAGS'\
       exist. The default is the current directory.\
-S, --secure-cgi dir\
       write cgi script into dir to realize a centralised\
       cgi script. Script alias is '/cgi-bin' by default.\
       You can overwrite this value with config variable\
       script_alias in 'gtags.conf'.\
-t, --title title\
       The title of this hypertext. The default is the last\
       component of the current directory.\
dir\
       The directory in which hypertext is generated.\
       The default is the current directory.\
";
# end of generated part.
#
# Copyright (c) 1996, 1997, 1998, 1999
#             Shigio Yamaguchi. All rights reserved.
# Copyright (c) 1999, 2000, 2001, 2002
#             Tama Communications Corporation. All rights reserved.
#
# This file is part of GNU GLOBAL.
#
# GNU GLOBAL is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# GNU GLOBAL is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
$'w32 = ($^O =~ /^(ms)?(dos|win(32|nt))/i) ? 1 : 0;
$www = "http://www.gnu.org/software/global/";
$caution_message = <<END_OF_CAUTION;
<CENTER>
<BLOCKQUOTE>
<FONT SIEZE=+3 COLOR=red>CAUTION</FONT><BR>
This hypertext is HUGE.
Please don't download whole hypertext using hypertext copy tools.
Our network cannot afford such traffic.
Instead, you can generate same thing in your computer using
<A HREF=$www TARGET=_top>GLOBAL source code tag system</A>.
Thank you. 
</BLOCKQUOTE>
</CENTER>
END_OF_CAUTION
#-------------------------------------------------------------------------
# COMMAND EXISTENCE CHECK
#-------------------------------------------------------------------------
foreach $c ('sort', 'gtags', 'global', 'btreeop') {
	if (!&'usable($c)) {
		&'error("'$c' command is required but not found.");
	}
}
#
# find filter
#
$'gtags = &'usable("gtags");
$'findcom = "$'gtags --find";
#-------------------------------------------------------------------------
# CONFIGURATION
#-------------------------------------------------------------------------
$version = `global --version`;
chop($version);
# null device
$'null_device = $'w32 ? 'NUL' : '/dev/null';
# temporary directory
$'tmp = '/tmp';
if (defined($ENV{'TMPDIR'}) && -d $ENV{'TMPDIR'}) {
	$tmp = $ENV{'TMPDIR'};
}
if (! -d $tmp || ! -w $tmp) {
	&'error("temporary directory '$tmp' not exist or not writable.");
}
$'ncol = 4;					# columns of line number
$'tabs = 8;					# tab skip
$'full_path = 0;				# file index format
$'icon_list = '';				# use icon for file index
$'prolog_script = '';				# include script at first
$'epilog_script = '';				# include script at last
$'show_position = 0;				# show current position
$'table_list = 0;				# tag list using table tag
$'script_alias = '/cgi-bin';			# script alias of WWW server
$'gzipped_suffix = 'ghtml';			# suffix of gzipped html file
$'normal_suffix = 'html';			# suffix of normal html file
$'action = 'cgi-bin/global.cgi';		# default action
$'id = '';					# id (default non)
$'cgi = 1;					# 1: make cgi-bin/
$'definition_header='after';			# {no|after|before}
$'other_files = 0;				# 1: list other files
#
# tag
#
$'body_begin     = '<BODY>';
$'body_end       = '</BODY>';
$'table_begin    = '<TABLE>';
$'table_end      = '</TABLE>';
$'title_begin	 = '<FONT COLOR=#cc0000>';
$'title_end	 = '</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>';
$'position_begin = '<FONT COLOR=gray>';
$'position_end   = '</FONT>';
#
# Reserved words for C and Java are hard coded.
# (configuration parameter 'reserved_words' was deleted.)
#
$'c_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";
$'cpp_reserved_words =	"catch,class,delete,enum,friend,inline,new,operator," .
		"private,protected,public,template,this,throw,try," .
		"virtual,volatile" .
		$'c_reserved_words;
$'java_reserved_words  = "abstract,boolean,break,byte,case,catch,char,class," .
		"const,continue,default,do,double,else,extends,false," .
		"final,finally,float,for,goto,if,implements,import," .
		"instanceof,int,interface,long,native,new,null," .
		"package,private,protected,public,return,short," .
		"static,super,switch,synchronized,this,throw,throws," .
		"union,transient,true,try,void,volatile,while";
$'sharp_macros = "assert,define,elif,else,endif,error,ident,ifdef,ifndef,if," .
		"include,line,pragma,undef,warning";
$'c_reserved_words    =~ s/,/|/g;
$'cpp_reserved_words  =~ s/,/|/g;
$'java_reserved_words =~ s/,/|/g;
$'sharp_macros        =~ s/,/|/g;
{
	#
	# extract --gtagsconf=<config file>.
	#
	local(@a, $confpath);
	for ($i = 0; $i < @ARGV; $i++) {
		if ($ARGV[$i] =~ /^--gtagsconf/) {
			if ($ARGV[$i] =~ /^--gtagsconf=(.*)$/) {
				$confpath = $1;
			} elsif ($ARGV[$i] =~ /^--gtagsconf$/) {
				if (++$i >= @ARGV) {
					&'error("--gtagsconf needs file name.");
				}
				$confpath = $ARGV[$i];
			}
			if (! -f $confpath) {
				&'error("config file '$confpath' not found.");
			}
			$ENV{'GTAGSCONF'} = &realpath($confpath);
		} else {
			push(@a, $ARGV[$i]);
		}
	}
	@ARGV = @a;
}
if ($var1 = &'getconf('ncol')) {
	if ($var1 < 1 || $var1 > 10) {
		print STDERR "Warning: parameter 'ncol' ignored becase the value is too large or too small.\n";
	} else {
		$'ncol = $var1;
	}
}
if ($var1 = &'getconf('tabs')) {
	if ($var1 < 1 || $var1 > 32) {
		print STDERR "Warning: parameter 'tabs' ignored becase the value is too large or too small.\n";
	} else {
		$'tabs = $var1;
	}
}
if ($var1 = &'getconf('gzipped_suffix')) {
	$'gzipped_suffix = $var1;
}
if ($var1 = &'getconf('normal_suffix')) {
	$'normal_suffix = $var1;
}
if ($var1 = &'getconf('definition_header')) {
	$'definition_header = $var1;
}
if ($var1 = &'getconf('other_files')) {
	$'other_files = $var1;
}
if ($var1 = &'getconf('enable_grep')) {
	$'enable_grep = $var1;
}
if ($var1 = &'getconf('enable_idutils')) {
	$'enable_idutils = $var1;
}
if ($var1 = &'getconf('full_path')) {
	$'full_path = $var1;
}
if ($var1 = &'getconf('table_list')) {
	$'table_list = $var1;
}
if ($var1 = &'getconf('icon_list')) {
	$'icon_list = $var1;
}
if ($var1 = &'getconf('prolog_script')) {
	$'prolog_script = $var1;
}
if ($var1 = &'getconf('epilog_script')) {
	$'epilog_script = $var1;
}
if ($var1 = &'getconf('show_position')) {
	$'show_position = $var1;
}
if ($var1 = &'getconf('script_alias')) {
	$'script_alias = $var1;
	$'script_alias =~ s!/$!!;
}
if (($var1 = &'getconf('body_begin')) && ($var2 = &'getconf('body_end'))) {
	$'body_begin  = $var1;
	$'body_end    = $var2;
}
if (($var1 = &'getconf('table_begin')) && ($var2 = &'getconf('table_end'))) {
	$'table_begin  = $var1;
	$'table_end    = $var2;
}
if (($var1 = &'getconf('title_begin')) && ($var2 = &'getconf('title_end'))) {
	$'title_begin  = $var1;
	$'title_end    = $var2;
}
if (($var1 = &'getconf('comment_begin')) && ($var2 = &'getconf('comment_end'))) {
	$'comment_begin  = $var1;
	$'comment_end    = $var2;
}
if (($var1 = &'getconf('sharp_begin')) && ($var2 = &'getconf('sharp_end'))) {
	$'sharp_begin  = $var1;
	$'sharp_end    = $var2;
}
if (($var1 = &'getconf('brace_begin')) && ($var2 = &'getconf('brace_end'))) {
	$'brace_begin  = $var1;
	$'brace_end    = $var2;
}
if (($var1 = &'getconf('reserved_begin')) && ($var2 = &'getconf('reserved_end'))) {
	$'reserved_begin  = $var1;
	$'reserved_end    = $var2;
}
if (($var1 = &'getconf('position_begin')) && ($var2 = &'getconf('position_end'))) {
	$'position_begin  = $var1;
	$'position_end    = $var2;
}
# insert htags_options into the head of ARGSV array.
if (($var1 = &'getconf('htags_options'))) {
	$'htags_options = $var1;
}
# HTML tag
$'html_begin  = '<HTML>';
$'html_end    = '</HTML>';
$'meta_robots = "<META NAME='ROBOTS' CONTENT='NOINDEX,NOFOLLOW'>";
$'meta_generator = "<META NAME='GENERATOR' CONTENT='GLOBAL-$version'>";
# Titles
$'title_define_index = 'DEFINITIONS';
$'title_file_index = 'FILES';

# Anchor image
@anchor_label = ('&lt;', '&gt;', '^', 'v', 'top', 'bottom', 'index', 'help');
@anchor_icons = ('left.jpg', 'right.jpg', 'first.jpg', 'last.jpg', 'top.jpg', 'bottom.jpg', 'index.jpg', 'help.jpg');
@anchor_comment = ('previous', 'next', 'first', 'last', 'top', 'bottom', 'index', 'help');
$back_icon = 'back.jpg';
$dir_icon  = 'dir.jpg';
$file_icon = 'c.jpg';
@anchor_msg   = ('Previous definition.',
		'Next definition.',
		'First definition in this file.',
		'Last definition in this file.',
		'Top of this file.',
		'Bottom of this file.',
		'Return to index page.',
		'You are seeing now.',
);
#-------------------------------------------------------------------------
# JAVASCRIPT PARTS
#-------------------------------------------------------------------------
$'begin_script="<SCRIPT LANGUAGE=javascript>\n<!--\n";
$'end_script="<!-- end of script -->\n</SCRIPT>\n";
# escaped angle
$'langle  = sprintf("unescape('%s')", &'escape('<'));
$'rangle  = sprintf("unescape('%s')", &'escape('>'));
# staus line
$'status_line  =
"function show(type, lno, file) {\n" .
"	if (lno > 0) {\n" .
"		msg = (type == 'R') ? 'Defined at' : 'Refered from';\n" .
"		msg += ' ' + lno;\n" .
"		if (file != '')\n" .
"			msg += ' in ' + file;\n" .
"	} else {\n" .
"		msg = 'Multiple ';\n" .
"		msg += (type == 'R') ? 'defined' : 'refered';\n" .
"	}\n" .
"	msg += '.';\n" .
"	self.status = msg;\n" .
"}\n";
#-------------------------------------------------------------------------
# DEFINITION
#-------------------------------------------------------------------------
# unit for a path
$'SRCS   = 'S';
$'DEFS   = 'D';
$'REFS   = 'R';
$'INCS   = 'I';
sub set_header {
	local($title) = @_;
	local($head) = '';
	$head .= "<HEAD>\n";
	$head .= "<TITLE>$title</TITLE>\n";
	$head .= "$'meta_robots\n$'meta_generator\n";
	$head .= $'begin_script;
	$head .= "self.defaultStatus = '$title'\n";
	$head .= $'status_line;
	$head .= $'end_script;	
	$head .= "</HEAD>\n";
	$head;
}
#-------------------------------------------------------------------------
# UTILITIES
#-------------------------------------------------------------------------
sub getcwd {
        local($dir) = `$'gtags --pwd`;
	if ($'w32) { $dir =~ s!\\!/!g; }
        chop($dir);
        $dir;
}
sub realpath {
        local($path) = @_;
        local($cwd) = &getcwd;		# for recovery
        local($real);			# real directory

        if (! -d $path && ! -f $path) {
		&'error("'$path' not found.");
	}
        local($dir,$file) = ($path =~ m#^(.*/)?(.*)#);
	if ($dir) {
		chdir($dir) || &'error("directory '$dir' not found.");
	}
        $real = &getcwd;
        $path = $real . '/' . $file;
        $path =~ s!//!/!;
        chdir($cwd) || &'error("cannot recover current directory '$cwd'.");
        $path;
}
sub date {
	local($date) = `$'gtags --date`;
	chop($date);
	$date;
}
sub error {
	&clean();
	printf STDERR "$program: $_[0]\n";
	exit 1;
}
sub clean {
	&anchor'finish();
	&cache'close();
}
sub escape {
	local($c) = @_;
	'%' . sprintf("%x", ord($c));
}
sub usable {
	local($command) = @_;
	local($pathsep) = ($'w32) ? ';' : ':';
	foreach (split(/$pathsep/, $ENV{'PATH'})) {
		if ($'w32) {
			return "$_\\$command.com" if (-f "$_\\$command.com");
			return "$_\\$command.exe" if (-f "$_\\$command.exe");
		} else {
			return "$_/$command" if (-x "$_/$command");
		}
	}
	return '';
}
sub duplicatefile {
	local($file, $from, $to) = @_;
	if ($'w32) {
		&'copy("$from/$file", "$to/$file")
			|| &'error("cannot copy $file.");
	} else {
		link("$from/$file", "$to/$file")
			|| &'copy("$from/$file", "$to/$file")
			|| &'error("cannot copy $file.");
	}
}
sub copy {
	local($from, $to) = @_;
	open(FROM, $from) || return 0;
	open(TO, ">$to") || return 0;
	print TO <FROM>;
	close(TO);
	close(FROM);
	return 1;
}
sub getconf {
	local($name) = @_;
	local($val);
	chop($val = `$'gtags --config $name`);
	if ($? != 0) { $val = ''; }
	$val;
}
sub path2url {
	local($path) = @_;
	$path = './' . $path if ($path !~ /^\./);
	if (!defined($'GPATH{$path})) {
		$'GPATH{$path} = ++$nextkey;
	}
	$'GPATH{$path} . '.' . $'HTML;
}
#-------------------------------------------------------------------------
# LIST PROCEDURE
#-------------------------------------------------------------------------
sub list_begin {
	$'table_list ? "$'table_begin\n<TR><TH NOWRAP ALIGN=left>tag</TH><TH NOWRAP ALIGN=right>line</TH><TH NOWRAP ALIGN=center>file</TH><TH NOWRAP ALIGN=left>source code</TH></TR>\n" :  "<PRE>\n";
}
sub list_body {
	local($srcdir, $s) = @_;	# $s must be choped.
	local($name, $lno, $filename, $line) = ($s =~ /^(\S+)\s+(\d+)\s+\.\/(\S+) (.*)$/);
	local($html) = &'path2url($filename);

	$s =~ s/\.\///;
	$s =~ s/&/&amp;/g;
	$s =~ s/</&lt;/g;
	$s =~ s/>/&gt;/g;
	if ($'table_list) {
		$line =~ s/ /&nbsp;&nbsp;/g;
		$line =~ s/	/&nbsp;&nbsp;&nbsp;&nbsp;/g;
		$s = "<TR><TD NOWRAP><A HREF=$srcdir\/$html#$lno>$name</A></TD><TD NOWRAP ALIGN=right>$lno</TD><TD NOWRAP ALIGN=left>$filename</TD><TD NOWRAP>$line</TD></TR>";
	} else {
		$s =~ s/^($name)/<A HREF=$srcdir\/$html#$lno>$1<\/A>/;
	}
	$s . "\n";
}
sub list_end {
	local($s) = $'table_list ? $'table_end : "</PRE>";
	$s . "\n";
}
#-------------------------------------------------------------------------
# PROCESS START
#-------------------------------------------------------------------------
# include prolog_script if needed.
require($'prolog_script) if ($'prolog_script && -f $'prolog_script);
#
# save config values and option values.
#
$save_config = `$'gtags --config`;
chop($save_config);
$save_config =~ s/'/'"'"'/g;			# keep single quote
$save_argv   = '';
foreach (@ARGV) {
	$save_argv .= ' ' if ($save_argv);
	$save_argv .= (/[ \t]/) ? "'$_'" : $_;	# quote arg include blank.
}
if ($'htags_options) {
	#
	# insert $'htags_options at the head of ARGV.
	#
	local($a) = $'htags_options;
	local(@a, $skip);
	while ($a) {
		$a =~ s/^[ \t]+//;
		if ($a =~ s/^'([^']*)'// || $a =~ s/^"([^"]*)"// || $a =~ s/^([^ \t]+)//) {
			push(@a, $1);
		}
	}
	@ARGV = (@a, @ARGV);
}
#
# options check.
#
$'aflag = $'cflag = $'fflag = $'Fflag = $'nflag = $'Sflag = $'vflag = $'wflag = '';
$show_version = 0;
$show_help = 0;
$include_caution = 0;
$action_value = '';
$id_value = '';
$cgidir = '';
while ($ARGV[0] =~ /^-/) {
	$opt = shift;
	if ($opt =~ /^--action=(.*)$/) {
		$action_value = $1;
	} elsif ($opt =~ /^--id=(.*)$/) {
		$id_value = $1;
	} elsif ($opt =~ /^--nocgi$/) {
		$'cgi = 0;
	} elsif ($opt =~ /^--version$/) {
		$show_version = 1;
	} elsif ($opt =~ /^--help$/) {
		$show_help = 1;
	} elsif ($opt =~ /^--alphabet$/) {
		$'aflag = 'a';
	} elsif ($opt =~ /^--compact$/) {
		$'cflag = 'c';
	} elsif ($opt =~ /^--each-line-tag$/) {
		;		# for backward compatibility.
	} elsif ($opt =~ /^--form$/) {
		$'fflag = 'f';
	} elsif ($opt =~ /^--frame$/) {
		$'Fflag = 'F';
	} elsif ($opt =~ /^--gtagsconf=(.*)$/) {
		;		# --gtagsconf is estimated only once.
	} elsif ($opt =~ /^--gtagsconf$/) {
		shift;		# --gtagsconf is estimated only once.
	} elsif ($opt =~ /^--line-number$/) {
		$'nflag = 'n';
	} elsif ($opt =~ /^--other$/) {
		$'oflag = 'o';
	} elsif ($opt =~ /^--verbose$/) {
		$'vflag = 'v';
	} elsif ($opt =~ /^--warning$/) {
		$'wflag = 'w';
	} elsif ($opt =~ /^--caution$/) {
		$'include_caution = 1;
	} elsif ($opt =~ /^--title$/) {
		$opt = shift;
		last if ($opt eq '');
		$title = $opt;
	} elsif ($opt =~ /^--dbpath$/) {
		$opt = shift;
		last if ($opt eq '');
		$dbpath = $opt;
	} elsif ($opt =~ /^--secure-cgi=(.*)$/) {
		$'Sflag = 'S';
		$'cgidir = $1;
	} elsif ($opt =~ /^--secure-cgi$/) {
		$'Sflag = 'S';
		$'cgidir = shift;
	} elsif ($opt =~ /^--/) {
		print STDERR $usage_const, "\n";
		exit 1;
	} elsif ($opt =~ /[^-acdfFlnosStvwtd]/) {
				# include 'l' for backward compatibility.
		print STDERR $usage_const, "\n";
		exit 1;
	} else {
		if ($opt =~ /a/) { $'aflag = 'a'; }
		if ($opt =~ /c/) { $'cflag = 'c'; }
		if ($opt =~ /f/) { $'fflag = 'f'; }
		if ($opt =~ /F/) { $'Fflag = 'F'; }
		if ($opt =~ /n/) { $'nflag = 'n'; }
		if ($opt =~ /o/) { $'oflag = 'o'; }
		if ($opt =~ /v/) { $'vflag = 'v'; }
		if ($opt =~ /w/) { $'wflag = 'w'; }
		if ($opt =~ /t/) {
			$opt = shift;
			last if ($opt eq '');
			$title = $opt;
		} elsif ($opt =~ /d/) {
			$opt = shift;
			last if ($opt eq '');
			$dbpath = $opt;
		} elsif ($opt =~ /S/) {
			$'Sflag = 'S';
			$'cgidir = shift;
		}
	}
}
if ($show_version) {
	local($command) = 'global --version';
	$command .= ' --verbose' if ($vflag);
	$command .= ' htags';
	system($command);
	exit 0;
}
if ($show_help) {
	print STDOUT $help_const;
	exit 1;
}
if ($'cflag && !&'usable('gzip')) {
	print STDERR "Warning: 'gzip' command not found. -c option ignored.\n";
	$'cflag = '';
}
if ($'oflag) {
	$'other_files = 1;
}
if (!$title) {
	@cwd = split('/', &'getcwd);
	$title = $cwd[$#cwd];
}
#
# decide directory in which we make hypertext.
#
$dist = &'getcwd() . '/HTML';
if ($ARGV[0]) {
	$cwd = &'getcwd();
	unless (-w $ARGV[0]) {
		 &'error("'$ARGV[0]' is not writable directory.");
	}
	chdir($ARGV[0]) || &'error("directory '$ARGV[0]' not found.");
	$dist = &'getcwd() . '/HTML';
	chdir($cwd) || &'error("cannot return to original directory.");
}
if ($'Sflag) {
	$'action = "$'script_alias/global.cgi";
	$'id = $dist;
}
# --action, --id overwrite Sflag's value.
if ($action_value) {
	$'action = $action_value;
}
if ($id_value) {
	$'id = $id_value;
}
# If $dbpath is not specified then listen to global(1).
if (!$dbpath) {
	local($cwd) = &'getcwd();
	local($root) = `global -pqr`;
	chop($root);
	if ($cwd eq $root) {
		$dbpath = `global -pq`;
		chop($dbpath);
	} else {
		$dbpath = '.';
	}
}
unless (-r "$dbpath/GTAGS" && -r "$dbpath/GRTAGS") {
	&'error("GTAGS and/or GRTAGS not found. Htags needs both of them.");
}
$dbpath = &'realpath($dbpath);
#
# for global(1)
#
$ENV{'GTAGSROOT'} = &'getcwd();
$ENV{'GTAGSDBPATH'} = $dbpath;
delete $ENV{'GTAGSLIBPATH'};
#
# check directories
#
if ($'fflag || $'cflag) {
	if ($'cgidir && ! -d $'cgidir) {
		&'error("'$'cgidir' not found.");
	}
	if (!$'Sflag) {
		$'cgidir = "$dist/cgi-bin";
	}
} else {
	$'Sflag = $'cgidir = '';
}
#-------------------------------------------------------------------------
# MAKE FILES
#-------------------------------------------------------------------------
#	HTML/cgi-bin/global.cgi	... CGI program (1)
#	HTML/cgi-bin/ghtml.cgi	... unzip script (1)
#	HTML/.htaccess		... skelton of .htaccess (1)
#	HTML/help.html		... help file (2)
#	HTML/$REFS/*		... references (3)
#	HTML/$DEFS/*		... definitions (3)
#	HTML/search.html	... search index (4)
#	HTML/defines.html	... definitions index (5)
#	HTML/defines/*		... definitions index (5)
#	HTML/files.html		... file index (6)
#	HTML/files/*		... file index (6)
#	HTML/index.html		... index file (7)
#	HTML/mains.html		... main index (8)
#	HTML/null.html		... main null html (8)
#	HTML/$SRCS/		... source files (9)
#	HTML/$INCS/		... include file index (9)
#	HTML/rebuild.sh		... rebuild script (10)
#-------------------------------------------------------------------------
$'HTML = ($'cflag) ? $'gzipped_suffix : $'normal_suffix;
print STDERR "[", &'date, "] ", "Htags started\n" if ($'vflag);
#
# (#) check if GTAGS, GRTAGS is the latest.
#
print STDERR "[", &'date, "] ", "(#) checking tag files ...\n" if ($'vflag);
$gtags_ctime = (stat("$dbpath/GTAGS"))[10];
open(FIND, "$'findcom |") || &'error("cannot fork.");
while (<FIND>) {
	chop;
	if ($gtags_ctime < (stat($_))[10]) {
		&'error("GTAGS is not the latest one. Please remake it.");
	}
}
close(FIND);
if ($?) { &'error("cannot traverse directory."); }
#
# (0) make directories
#
print STDERR "[", &'date, "] ", "(0) making directories ...\n" if ($'vflag);
mkdir($dist, 0777) || &'error("cannot make directory '$dist'.") if (! -d $dist);
foreach $d ($SRCS, $INCS, $DEFS, $REFS, 'files', 'defines') {
	mkdir("$dist/$d", 0775) || &'error("cannot make HTML directory") if (! -d "$dist/$d");
}
if ($'cgi && ($'fflag || $'cflag)) {
	mkdir("$dist/cgi-bin", 0775) || &'error("cannot make cgi-bin directory") if (! -d "$dist/cgi-bin");
}
#
# (1) make CGI program
#
if ($'cgi && $'fflag) {
	if ($'cgidir) {
		print STDERR "[", &'date, "] ", "(1) making CGI program ...\n" if ($'vflag);
		&makeprogram("$cgidir/global.cgi") || &'error("cannot make CGI program.");
		chmod(0755, "$cgidir/global.cgi") || &'error("cannot chmod CGI program.");
	}
	# Always make bless.sh.
	# Don't grant execute permission to bless script.
	&makebless("$dist/bless.sh") || &'error("cannot make bless script.");
	chmod(0640, "$dist/bless.sh") || &'error("cannot chmod bless script.");

	foreach $f ('GTAGS', 'GRTAGS', 'GSYMS', 'GPATH') {
		if (-f "$dbpath/$f") {
			unlink("$dist/cgi-bin/$f");
			&duplicatefile($f, $dbpath, "$dist/cgi-bin");
		}
	}
}
if ($'cgi && $'cflag) {
	&makehtaccess("$dist/.htaccess") || &'error("cannot make .htaccess skelton.");
	chmod(0644, "$dist/.htaccess") || &'error("cannot chmod .htaccess skelton.");
	if ($'cgidir) {
		&makeghtml("$cgidir/ghtml.cgi") || &'error("cannot make unzip script.");
		chmod(0755, "$cgidir/ghtml.cgi") || &'error("cannot chmod unzip script.");
	}
}
#
# (2) make help file
#
print STDERR "[", &'date, "] ", "(2) making help.html ...\n" if ($'vflag);
&makehelp("$dist/help.$'normal_suffix");
#
# (#) load GPATH
#
local($command) = "btreeop -L2 -k \"./\" \"$dbpath/GPATH\"";
open(GPATH, "$command |") || &'error("cannot fork.");
$nextkey = 0;
while (<GPATH>) {
	chop;
	local($path, $no) = split;
	$'GPATH{$path} = $no;
	if ($no > $nextkey) {
		$nextkey = $no;
	}
}
close(GPATH);
if ($?) {&'error("'$command' failed."); }
#
# (3) make function entries ($DEFS/* and $REFS/*)
#     MAKING TAG CACHE
#
print STDERR "[", &'date, "] ", "(3) making duplicate entries ...\n" if ($'vflag);
sub suddenly { &'clean(); exit 1}
$SIG{'INT'} = 'suddenly';
$SIG{'QUIT'} = 'suddenly';
$SIG{'TERM'} = 'suddenly';
&cache'open();
$func_total = &makedupindex($dist);
print STDERR "Total $func_total functions.\n" if ($'vflag);
#
# (4) search index. (search.html)
#
if ($'Fflag && $'fflag) {
	print STDERR "[", &'date, "] ", "(4) making search index ...\n" if ($'vflag);
	&makesearchindex("$dist/search.$'normal_suffix");
}
#
# (5) make function index (defines.html and defines/*)
#     PRODUCE @defines
#
print STDERR "[", &'date, "] ", "(5) making function index ...\n" if ($'vflag);
$func_total = &makedefineindex($dist, "$dist/defines.$'normal_suffix", $func_total);
print STDERR "Total $func_total functions.\n" if ($'vflag);
#
# (6) make file index (files.html and files/*)
#     PRODUCE @files %includes
#
print STDERR "[", &'date, "] ", "(6) making file index ...\n" if ($'vflag);
$file_total = &makefileindex($dist, "$dist/files.$'normal_suffix", "$dist/$INCS");
print STDERR "Total $file_total files.\n" if ($'vflag);
#
# [#] make a common part for mains.html and index.html
#     USING @defines @files
#
print STDERR "[", &'date, "] ", "(#) making a common part ...\n" if ($'vflag);
$index = &makecommonpart($title);
#
# (7)make index file (index.html)
#
print STDERR "[", &'date, "] ", "(7) making index file ...\n" if ($'vflag);
&makeindex("$dist/index.$'normal_suffix", $title, $index);
#
# (8) make main index (mains.html)
#
print STDERR "[", &'date, "] ", "(8) making main index ...\n" if ($'vflag);
&makemainindex("$dist/mains.$'normal_suffix", $index);
#
# (#) make anchor database
#
print STDERR "[", &'date, "] ", "(#) making temporary database ...\n" if ($'vflag);
&anchor'create();
#
# (9) make HTML files ($SRCS/*)
#     USING TAG CACHE, %includes and anchor database.
#
print STDERR "[", &'date, "] ", "(9) making hypertext from source code ...\n" if ($'vflag);
&makehtml($dist, $file_total);
#
# (10) rebuild script. (rebuild.sh)
#
# Don't grant execute permission to rebuild script.
&makerebuild("$dist/rebuild.sh");
chmod(0640, "$dist/rebuild.sh") || &'error("cannot chmod rebuild script.");

&'clean();
print STDERR "[", &'date, "] ", "Done.\n" if ($'vflag);
if ($'vflag && $'cgi && ($'cflag || $'fflag)) {
	print STDERR "\n";
	print STDERR "[Information]\n";
	print STDERR "\n";
	if ($'cflag) {
		print STDERR " Your system may need to be setup to decompress *.$'gzipped_suffix files.\n";
		print STDERR " This can be done by having your browser compiled with the relevant\n";
		print STDERR " options, or by configuring your http server to treat these as\n";
		print STDERR " gzipped files. (Please see 'HTML/.htaccess')\n";
		print STDERR "\n";
	}
	if ($'fflag) {
		local($path) = ($'action =~ /^\//) ? "DOCUMENT_ROOT$'action" : "HTML/$'action";
		print STDERR " You need to setup http server so that $path\n";
		print STDERR " is executed as a CGI script. (DOCUMENT_ROOT means WWW server's data root.)\n";
		print STDERR "\n";
	}
	print STDERR " Good luck!\n";
	print STDERR "\n";
}
# This is not supported.
if ($'icon_list && -f $'icon_list) {
	system("tar xzf $'icon_list -C $dist");
}
# include epilog_script if needed.
require($'epilog_script) if ($'epilog_script && -f $'epilog_script);
exit 0;
#-------------------------------------------------------------------------
# SUBROUTINES
#-------------------------------------------------------------------------
#
# makeprogram: make CGI program
#
sub makeprogram {
	local($file) = @_;
	local($globalpath) = &'usable('global');
	local($btreeoppath) = &'usable('btreeop');

	open(PROGRAM, ">$file") || &'error("cannot make CGI program.");
	local($script) = <<'END_OF_SCRIPT';
#! /usr/local/bin/perl
#------------------------------------------------------------------
# SORRY TO HAVE SURPRISED YOU!
# IF YOU SEE THIS UNREASONABLE FILE WHILE BROUSING, FORGET PLEASE.
# IF YOU ARE A ADMINISTRATOR OF THIS SITE, PLEASE SETUP HTTP SERVER
# SO THAT THIS SCRIPT CAN BE EXECUTED AS A CGI COMMAND. THANK YOU.
#------------------------------------------------------------------
$htmlbase = $ENV{'HTTP_REFERER'};
if ($htmlbase) {
	$htmlbase =~ s/\/[^\/]*$//;
} else {
	$htmlbase = '..';
}
print "Content-type: text/html\n\n";
print "@html_begin@\n";
print "@body_begin@\n";
if (! -x '@globalpath@' || ! -x '@btreeoppath@') {
	print "<H1><FONT COLOR=#cc0000>Error</FONT></H1>\n";
	print "<H3>Server side command not found. <A HREF=$htmlbase/mains.@normal_suffix@>[return]</A></H3>\n";
	print "@body_end@\n";
	print "@html_end@\n";
	exit 0;
}
@pairs = split (/&/, $ENV{'QUERY_STRING'});
foreach $p (@pairs) {
	($name, $value) = split(/=/, $p);
	$value =~ tr/+/ /;
	$value =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack("C", hex($1))/eg;
	$form{$name} = $value;
}
if ($form{'pattern'} eq '') {
	print "<H1><FONT COLOR=#cc0000>Error</FONT></H1>\n";
	print "<H3>Pattern not specified. <A HREF=$htmlbase/mains.@normal_suffix@>[return]</A></H3>\n";
	print "@body_end@\n";
	print "@html_end@\n";
	exit 0;
}
$pattern = $form{'pattern'};
$flag = '';
$words = 'definitions';
if ($form{'type'} eq 'reference') {
	$flag = 'r';
	$words = 'references';
} elsif ($form{'type'} eq 'symbol') {
	$flag = 's';
	$words = 'symbols';
} elsif ($form{'type'} eq 'path') {
	$flag = 'P';
	$words = 'paths';
} elsif ($form{'type'} eq 'grep') {
	$flag = 'g';
	$words = 'patterns';
} elsif ($form{'type'} eq 'idutils') {
	$flag = 'I';
	$words = 'patterns';
}
if ($form{'id'}) {
	chdir("$form{'id'}/cgi-bin");
	if ($?) {	
		print "<H1><FONT COLOR=#cc0000>Error</FONT></H1>\n";
		print "<H3>Couldn't find tag directory in secure mode. <A HREF=$htmlbase/mains.@normal_suffix@>[return]</A></H3>\n";
		print "@body_end@\n";
		print "@html_end@\n";
		exit 0;
	}
}
if ($flag eq 'g' || $flag eq 'I') {
	if ($flag eq 'g' && ! -f "../../GTAGS" || $flag eq 'I' && ! -f "../../ID") {
		print "<H1><FONT COLOR=#cc0000>Error</FONT></H1>\n";
		print "<H3>Couldn't execute command. <A HREF=$htmlbase/mains.@normal_suffix@>[return]</A></H3>\n";
		print "@body_end@\n";
		print "@html_end@\n";
		exit 0;
	}
	chdir("../..");
	if ($?) {	
		print "<H1><FONT COLOR=#cc0000>Error</FONT></H1>\n";
		print "<H3>Couldn't change directory for $form{'type'} search. <A HREF=$htmlbase/mains.@normal_suffix@>[return]</A></H3>\n";
		print "@body_end@\n";
		print "@html_end@\n";
		exit 0;
	}
}
#
# fork and exec global(1) to avoid command substitutions in $pattern.
#
open(PIPE, "-|") || exec '@globalpath@', '-x'.$flag, $pattern;
if ($?) {	
	print "<H1><FONT COLOR=#cc0000>Error</FONT></H1>\n";
	print "<H3>Cannot execute global. <A HREF=$htmlbase/mains.@normal_suffix@>[return]</A></H3>\n";
	print "@body_end@\n";
	print "@html_end@\n";
	exit 0;
}
print "<H1><FONT COLOR=#cc0000>" . $pattern . "</FONT></H1>\n";
print "Following $words are matched to above pattern.<HR>\n";
$cnt = 0;
local($tag, $lno, $filename, $fileno);
print "<PRE>\n";
while (<PIPE>) {
	$cnt++;
	($tag, $lno, $filename) = split;
	chop($fileno = `@btreeoppath@ -K "./$filename" GPATH`);
	s!($tag)!<A HREF=$htmlbase/@SRCS@/$fileno.@HTML@#$lno>$1<\/A>!;
	print;
}
close(PIPE);
print "</PRE>\n";
if ($cnt == 0) {
	print "<H3>Pattern not found. <A HREF=$htmlbase/mains.@normal_suffix@>[return]</A></H3>\n";
}
print "@body_end@\n";
print "@html_end@\n";
exit 0;
#------------------------------------------------------------------
# SORRY TO HAVE SURPRISED YOU!
# IF YOU SEE THIS UNREASONABLE FILE WHILE BROUSING, FORGET PLEASE.
# IF YOU ARE A ADMINISTRATOR OF THIS SITE, PLEASE SETUP HTTP SERVER
# SO THAT THIS SCRIPT CAN BE EXECUTED AS A CGI COMMAND. THANK YOU.
#------------------------------------------------------------------
END_OF_SCRIPT

	$quoted_body_begin = $'body_begin;
	$quoted_body_begin =~ s/"/\\"/g;
	$quoted_body_end = $'body_end;
	$quoted_body_end =~ s/"/\\"/g;
	$script =~ s/\@html_begin\@/$'html_begin/g;
	$script =~ s/\@html_end\@/$'html_end/g;
	$script =~ s/\@body_begin\@/$quoted_body_begin/g;
	$script =~ s/\@body_end\@/$quoted_body_end/g;
	$script =~ s/\@normal_suffix\@/$'normal_suffix/g;
	$script =~ s/\@SRCS\@/$'SRCS/g;
	$script =~ s/\@HTML\@/$'HTML/g;
	$script =~ s/\@globalpath\@/$globalpath/g;
	$script =~ s/\@btreeoppath\@/$btreeoppath/g;
	print PROGRAM $script;
	close(PROGRAM);
}
#
# makebless: make bless script
#
sub makebless {
	local($file) = @_;
	local($action) = "$'script_alias/global.cgi";

	open(SCRIPT, ">$file") || &'error("cannot make bless script.");
	local($script) = <<'END_OF_SCRIPT';
#!/bin/sh
#
# Bless.sh: rewrite id's value of html for centralised cgi script.
#
# Usage:
#	% htags -fS		<- works well at generated place.
#	% mv HTML /var/obj	<- move to another place. It doesn't work.
#	% cd /var/obj/HTML
#	% sh bless.sh		<- OK. It will work well!
#
pattern1='INPUT TYPE=hidden NAME=id VALUE'
pattern2='FORM METHOD=GET ACTION'
action=@action@
case $1 in
-v)	verbose=1;;
esac
id=`pwd`
for f in mains.html index.html search.html; do
	if [ -f $f ]; then
		sed -e "s!<$pattern1=.*>!<$pattern1=$id>!" -e "s!<$pattern2=[^ >]*!<$pattern2=$action!" $f > $f.new;
		if cmp $f $f.new >@null_device@; then
			rm -f $f.new
		else
			mv $f.new $f
			[ $verbose ] && echo "$f was blessed."
		fi
	fi
done
rm -f cgi-bin/global.cgi
END_OF_SCRIPT
	$script =~ s/\@null_device\@/$'null_device/g;
	$script =~ s/\@action\@/$action/g;
	print SCRIPT $script;
	close(SCRIPT);
}
#
# makeghtml: make unzip script
#
sub makeghtml {
	local($file) = @_;
	open(PROGRAM, ">$file") || &'error("cannot make unzip script.");
	local($script) = <<END_OF_SCRIPT;
#!/bin/sh
echo "content-type: text/html"
echo
gzip -S $'HTML -d -c "\$PATH_TRANSLATED"
END_OF_SCRIPT

	print PROGRAM $script;
	close(PROGRAM);
}
#
# makehtaccess: make .htaccess skelton file.
#
sub makehtaccess {
	local($file) = @_;
	open(SKELTON, ">$file") || &'error("cannot make .htaccess skelton file.");
	$skelton = <<END_OF_SCRIPT;
#
# Skelton file for .htaccess -- This file was generated by htags(1).
#
# Htags have made gzipped hypertext because you specified -c option.
# If your browser doesn't decompress gzipped hypertext, you will need to
# setup your http server to treat this hypertext as gzipped files first.
# There are many way to do it, but one of the method is to put .htaccess
# file in 'HTML' directory.
#
# Please rewrite '/cgi-bin/ghtml.cgi' to the true value in your web site.
#
AddHandler htags-gzipped-html $'gzipped_suffix
Action htags-gzipped-html /cgi-bin/ghtml.cgi
END_OF_SCRIPT
	print SKELTON $skelton;
	close(SKELTON);
}
#
# makerebuild: make rebuild script
#
sub makerebuild {
	local($file) = @_;
	local($cwd) = getcwd;
	open(FILE, ">$file") || &'error("cannot make rebuild script.");
	print FILE "#!/bin/sh\n";
	print FILE "#\n";
	print FILE "# rebuild.sh: rebuild hypertext with the previous context.\n";
	print FILE "#\n";
	print FILE "# Usage:\n";
	print FILE "#\t% sh rebuild.sh\n";
	print FILE "#\n";
	print FILE "cd $cwd && GTAGSCONF='$save_config' htags $save_argv\n";
	close(FILE);
}
#
# makehelp: make help file
#
sub makehelp {
	local($file) = @_;
	local(@label) = ($'icon_list) ? @'anchor_comment : @'anchor_label;
	local(@icons) = @'anchor_icons;
	local(@msg)   = @'anchor_msg;

	open(HELP, ">$file") || &'error("cannot make help file.");
	print HELP $'html_begin, "\n";
	print HELP &'set_header('HELP');
	print HELP $'body_begin, "\n";
	print HELP "<H2>Usage of Links</H2>\n";

	print HELP "<PRE>/* ";
	foreach $n (0 .. $#label) {
		if ($'icon_list) {
			print HELP "<IMG SRC=icons/$icons[$n] ALT=\[$label[$n]\] HSPACE=3 BORDER=0>";
			if ($n < $#label) {
				print HELP " ";
			}
		} else {
			print HELP "\[$label[$n]\]";
		}
	}
	if ($'show_position) {
		print HELP "[+line file]";
	}
	print HELP " */</PRE>\n";
	print HELP "<DL>\n";
	foreach $n (0 .. $#label) {
		print HELP "<DT>";
		if ($'icon_list) {
			print HELP "<IMG SRC=icons/$icons[$n] ALT=\[$label[$n]\] HSPACE=3 BORDER=0>";
		} else {
			print HELP "[$label[$n]]";
		}
		print HELP "<DD>$msg[$n]\n";
	}
	if ($'show_position) {
		print HELP "<DT>[+line file]";
		print HELP "<DD>Current position (line number and file name).\n";
	}
	print HELP "</DL>\n";
	print HELP $'body_end, "\n";
	print HELP $'html_end, "\n";
	close(HELP);
}
#
# makedupindex: make duplicate entries index ($DEFS/* and $REFS/*)
#
#	go)	tag cache
#	r)	$count
#
sub makedupindex {
	local($dist) = @_;
	local($count) = 0;
	local($srcdir) = "../$'SRCS";

	foreach $db ('GRTAGS', 'GTAGS') {
		local($kind) = $db eq 'GTAGS' ? "definitions" : "references";
		local($option) = $db eq 'GTAGS' ? '' : 'r';
		local($prev) = '';
		local($first_line);
		local($writing) = 0;

		$count = 0;
		local($command) = "global -nx$option \".*\" | sort +0 -1 +2 -3 +1n -2";
		open(LIST, "$command |") || &'error("cannot fork.");
		while (<LIST>) {
			chop;
			local($tag) = split;
			if ($prev ne $tag) {
				$count++;
				print STDERR " [$count] adding $tag $kind\n" if ($'vflag);
				if ($writing) {
					print FILE &'list_end;
					print FILE $'body_end, "\n";
					print FILE $'html_end, "\n";
					close(FILE);
					$writing = 0;
				}
				# single entry
				if ($first_line) {
					&cache'put($db, $prev, $first_line);
				}
				$first_line = $_;
				$prev = $tag;
			} else {
				# duplicate entry
				if ($first_line) {
					&cache'put($db, $tag, " $count");
					local($type) = ($db eq 'GTAGS') ? $'DEFS : $'REFS;
					if ($'cflag) {
						open(FILE, "| gzip -c >$dist/$type/$count.$'HTML") || &'error("cannot make file '$dist/$type/$count.$'HTML'.");
					} else {
						open(FILE, ">$dist/$type/$count.$'HTML") || &'error("cannot make file '$dist/$type/$count.$'HTML'.");
					}
					$writing = 1;
					print FILE $'html_begin, "\n";
					print FILE &'set_header($tag);
					print FILE $'body_begin, "\n";
					print FILE &'list_begin;
					print FILE &'list_body($srcdir, $first_line);
					$first_line = '';
				}
				print FILE &'list_body($srcdir, $_);
			}
		}
		close(LIST);
		if ($?) { &'error("'$command' failed."); }
		if ($writing) {
			print FILE &'list_end;
			print FILE $'body_end, "\n";
			print FILE $'html_end, "\n";
			close(FILE);
		}
		if ($first_line) {
			&cache'put($db, $prev, $first_line);
		}
	}
	$count;
}
#
# makedefineindex: make definition index (including alphabetic index)
#
#	i)	dist		distribution directory
#	i)	file		definition index file
#	i)	total		definitions total
#	gi)	tag cache
#	go)	@defines
#
sub makedefineindex {
	local($dist, $file, $total) = @_;
	local($count) = 0;
	local($indexlink) = ($'Fflag) ? "../defines.$'normal_suffix" : "../mains.$'normal_suffix";
	local($target) = ($'Fflag) ? 'mains' : '_top';
	open(DEFINES, ">$file") || &'error("cannot make function index '$file'.");
	print DEFINES $'html_begin, "\n";
	print DEFINES &'set_header($'title_define_index);
	print DEFINES $'body_begin, "\n";
	if ($'Fflag) {
		print DEFINES "<A HREF=defines.$'normal_suffix><H2>$'title_define_index</H2></A>\n";
	} else {
		print DEFINES "<H2>$'title_define_index</H2>\n";
	}
	if (!$'aflag && !$'Fflag) {
		$indexlink = "mains.$'normal_suffix";
		print DEFINES "<A HREF=$indexlink>[..]</A>\n";
	}
	print DEFINES "<OL>\n" if (!$'aflag);
	local($old) = select(DEFINES);
	local($command) = "global -c";
	open(TAGS, "$command |") || &'error("cannot fork.");
	local($alpha, $alpha_f);
	@defines = ();	# [A][B][C]...
	while (<TAGS>) {
		$count++;
		chop;
		local($tag) = $_;
		print STDERR " [$count/$total] adding $tag\n" if ($'vflag);
		if ($'aflag && ($alpha eq '' || $tag !~ /^$alpha/)) {
			if ($alpha) {
				print ALPHA "</OL>\n";
				print ALPHA "<A HREF=$indexlink>";
				print ALPHA $'icon_list ? "<IMG SRC=../icons/$'back_icon ALT='[..]' HSPACE=3 BORDER=0>" : "[..]";
				print ALPHA "</A>\n";
				print ALPHA $'body_end, "\n";
				print ALPHA $'html_end, "\n";
				close(ALPHA);
			}
			# for multi-byte code
			local($c0, $c1);
			$c0 = substr($tag, 0, 1);
			if (ord($c0) > 127) {
				$c1 = substr($tag, 1, 1);
				$alpha   = $c0 . $c1;
				$alpha_f = "" . ord($c0) . ord($c1);
			} else {
				$alpha = $alpha_f = $c0;
				# for CD9660 or FAT file system
				# 97 == 'a', 122 == 'z'
				if (ord($c0) >= 97 && ord($c0) <= 122) {
					$alpha_f = "l$c0";
				}
			}
			push(@defines, "<A HREF=defines/$alpha_f.$'HTML>[$alpha]</A>\n");
			if ($'cflag) {
				open(ALPHA, "| gzip -c >$dist/defines/$alpha_f.$'HTML") || &'error("cannot make alphabetical function index.");
			} else {
				open(ALPHA, ">$dist/defines/$alpha_f.$'HTML") || &'error("cannot make alphabetical function index.");
			}
			print ALPHA $'html_begin, "\n";
			print ALPHA &'set_header("[$alpha]");
			print ALPHA $'body_begin, "\n";
			print ALPHA "<H2>[$alpha]</H2>\n";
			print ALPHA "<A HREF=$indexlink>";
			print ALPHA $'icon_list ? "<IMG SRC=../icons/$'back_icon ALT='[..]' HSPACE=3 BORDER=0>" : "[..]";
			print ALPHA "</A>\n";
			print ALPHA "<OL>\n";
			select(ALPHA);
		}
		local($line) = &cache'get('GTAGS', $tag);
		if ($line =~ /^ (.*)/) {
			print "<LI><A HREF=", ($'aflag) ? "../" : "", "$'DEFS/$1.$'HTML TARGET=$target>$tag</A>\n";
		} else {
			local($tag, $lno, $filename) = split(/[ \t]+/, $line);
			$filename = &'path2url($filename);
			print "<LI><A HREF=", ($'aflag) ? "../" : "", "$'SRCS/$filename#$lno TARGET=$target>$tag</A>\n";
		}
	}
	close(TAGS);
	if ($?) { &'error("'$command' failed."); }
	select($old);
	if ($'aflag) {
		print ALPHA "</OL>\n";
		print ALPHA "<A HREF=$indexlink>";
		print ALPHA $'icon_list ? "<IMG SRC=../icons/$'back_icon ALT='[..]' HSPACE=3 BORDER=0>" : "[..]";
		print ALPHA "</A>\n";
		print ALPHA $'body_end, "\n";
		print ALPHA $'html_end, "\n";
		close(ALPHA);

		print DEFINES @defines;
	}
	print DEFINES "</OL>\n" if (!$'aflag);
	if (!$'aflag && !$'Fflag) {
		print DEFINES "<A HREF=$indexlink>[..]</A>\n";
	}
	print DEFINES $'body_end, "\n";
	print DEFINES $'html_end, "\n";
	close(DEFINES);
	$count;
}
#
# makefileindex: make file index
#
#	i)	dist		distribution directory
#	i)	file		file name
#	i)	$incdir		$INC directory
#	go)	@files
#	go)	%includes
#
sub makefileindex {
	local($dist, $file, $incdir) = @_;
	local($count) = 0;
	local($indexlink) = ($'Fflag) ? "../files.$'normal_suffix" : "../mains.$'normal_suffix";
	local($target) = ($'Fflag) ? 'mains' : '_top';
	local(@dirstack, @fdstack);
	local($findcom) = ($'other_files) ? "$'findcom --other | sort -t / +1" : $'findcom;

	open(FIND, "$findcom |") || &'error("cannot fork.");
	open(FILES, ">$file") || &'error("cannot make file '$file'.");
	print FILES $'html_begin, "\n";
	print FILES &'set_header($'title_file_index);
	print FILES $'body_begin, "\n";
	print FILES "<A HREF=files.$'normal_suffix><H2>$'title_file_index</H2></A>\n";
	print FILES "<OL>\n";

	local($org) = select(FILES);
	local(@push, @pop, $file);

	while (<FIND>) {
		local($notsource) = 0;
		chop;
		if (/^ /) {
			next if (!$'other_files);
			s/^ //;
			next if (-B $_);
			$notsource = 1;
		}
		$count++;
		s!^\./!!;
		print STDERR " [$count] adding $_\n" if ($'vflag);
		@push = split('/');
		$file = pop(@push);
		@pop  = @dirstack;
		while ($push[0] && $pop[0] && $push[0] eq $pop[0]) {
			shift @push;
			shift @pop;
		}
		if (@push || @pop) {
			while (@pop) {
				pop(@dirstack);
				local($parent) = (@dirstack) ? &'path2url(join('/', @dirstack)) : $indexlink;
				print "</OL>\n";
				print "<A HREF=$parent>" .
					($'icon_list ? "<IMG SRC=../icons/$'back_icon ALT='[..]' HSPACE=3 BORDER=0>" : "[..]") .
					"</A>\n";
				print $'body_end, "\n";
				print $'html_end, "\n";
				$path = pop(@fdstack);
				close($path);
				select($fdstack[$#fdstack]) if (@fdstack);
				pop(@pop);
			}
			while (@push) {
				local($parent) = (@dirstack) ? &'path2url(join('/', @dirstack)) : $indexlink;
				push(@dirstack, shift @push);
				$path = join('/', @dirstack);
				$cur = "$dist/files/" . &'path2url($path);
				local($last) = $path;
				if (!$'full_path) {
					$last =~ s!.*/!!;
				}
				local($li) = "<LI>" .
					"<A HREF=" . (@dirstack == 1 ? 'files/' : '') . &path2url($path) . ">" .
					($'icon_list ? "<IMG SRC=" . (@dirstack == 1 ? '' : '../') . "icons/$'dir_icon ALT=[$path/] HSPACE=3 BORDER=0>" : '') .
					"$last/</A>\n";
				if (@dirstack == 1) {
					push(@files, $li);
				} else {
					print $li;
				}
				if ($'cflag) {
					open($cur, "| gzip -c >\"$cur\"") || &'error("cannot make directory index.");
				} else {
					open($cur, ">$cur") || &'error("cannot make directory index.");
				}
				select($cur);
				push(@fdstack, $cur);
				print $'html_begin, "\n";
				print &'set_header("$path/");
				print $'body_begin, "\n";
				print "<H2>";
				local(@p);
				foreach $n (0 .. $#dirstack) {
					push(@p, $dirstack[$n]);
					local($url) = &'path2url(join('/', @p));
					print "<A HREF=$url>" if ($n < $#dirstack);
					print "$dirstack[$n]";
					print "</A>" if ($n < $#dirstack);
					print "/";
				}
				print "</H2>\n";
				print "<A HREF=$parent>" .
					($'icon_list ? "<IMG SRC=../icons/$'back_icon ALT='[..]' HSPACE=3 BORDER=0>" : "[..]") .
					"</A>\n";
				print "<OL>\n";
			}
		}
		# collect include files. format is
		#	counter + '\n' + path1 + '\n' + path2 ...
		if (/.*\.[hH]$/) {
			if (! defined $includes{$file}) {
				$includes{$file} = "$count\n$_";
			} else {
				# duplicate entries
				$includes{$file} = "$includes{$file}\n$_";
			}
		}
		local($url) = &'path2url($_);
		local($last) = $_;
		if (!$'full_path) {
			$last =~ s!.*/!!;
		}
		local($li) = "<LI>" .
			"<A HREF=" . (@dirstack == 0 ? '' : '../') . "S/$url TARGET=$target>" .
			($'icon_list ? "<IMG SRC=" . (@dirstack == 0 ? '' : '../') . "icons/$'file_icon ALT=[$_] HSPACE=3 BORDER=0>" : '') .
			"$last</A>\n";
		if (@dirstack == 0) {
			push(@files, $li);
		} else {
			print $li;
		}
	}
	close(FIND);
	if ($?) { &'error("cannot traverse directory.($findcom)"); }
	while (@dirstack) {
		pop(@dirstack);
		local($parent) = (@dirstack) ? &'path2url(join('/', @dirstack)) : $indexlink;
		print "</OL>\n";
		print "<A HREF=$parent>" .
			($'icon_list ? "<IMG SRC=../icons/$'back_icon ALT='[..]' HSPACE=3 BORDER=0>" : "[..]") .
			"</A>\n";
		print $'body_end, "\n";
		print $'html_end, "\n";
		$path = pop(@fdstack);
		close($path);
		select($fdstack[$#fdstack]) if (@fdstack);
	}
	print FILES @files;
	print FILES "</OL>\n";
	print FILES $'body_end, "\n";
	print FILES $'html_end, "\n";
        close(FILES);

	select($org);
	foreach $last (keys %includes) {
		local($no, @incs) = split(/\n/, $includes{$last});
		if (@incs > 1) {
			local($path) = "$incdir/$no.$'HTML";
			if ($'cflag) {
				open(INCLUDE, "| gzip -c >$path") || &'error("cannot open file '$path'.");
			} else {
				open(INCLUDE, ">$path") || &'error("cannot open file '$path'.");
			}
			print INCLUDE $'html_begin, "\n";
			print INCLUDE &'set_header($last);
			print INCLUDE $'body_begin, "\n";
			print INCLUDE "<PRE>\n";
			foreach $filename (@incs) {
				$path = &'path2url($filename);
				print INCLUDE "<A HREF=../$'SRCS/$path TARGET=$target>$filename</A>\n";
			}
			print INCLUDE "</PRE>\n";
			print INCLUDE $'body_end, "\n";
			print INCLUDE $'html_end, "\n";
			close(INCLUDE);
			# '' means that information already written to file.
			$includes{$last} = $no;
		}
	}
	$count;
}
#
# makesearchpart: make search part
#
#	i)	$action	action url
#	i)	$id	hidden variable
#	i)	$target	target
#	r)		html
#
sub makesearchpart {
	local($action, $id, $target) = @_;
	local($index) = '';

	if ($'Fflag) {
		$index .= "<A HREF=search.$'normal_suffix><H2>SEARCH</H2></A>\n";
	} else {
		$index .= "<H2>SEARCH</H2>\n";
	}
	if (!$target) {
		$index .= "Please input object name and select [Search]. POSIX's regular expression is allowed.<P>\n"; 
	}
	$index .= "<FORM METHOD=GET ACTION=$action";
	$index .= " TARGET=$target" if ($target);
	$index .= ">\n";
	$index .= "<INPUT NAME=pattern>\n";
	$index .= "<INPUT TYPE=hidden NAME=id VALUE=$id>\n";
	$index .= "<INPUT TYPE=submit VALUE=Search>\n";
	$index .= "<INPUT TYPE=reset VALUE=Reset><BR>\n";
	$index .= "<INPUT TYPE=radio NAME=type VALUE=definition CHECKED>";
	$index .= ($target) ? "Def" : "Definition";
	$index .= "\n<INPUT TYPE=radio NAME=type VALUE=reference>";
	$index .= ($target) ? "Ref" : "Reference";
	if (-f "$dbpath/GSYMS") {
		$index .= "\n<INPUT TYPE=radio NAME=type VALUE=symbol>";
		$index .= ($target) ? "Sym" : "Other symbol";
	}
	$index .= "\n<INPUT TYPE=radio NAME=type VALUE=path>";
	$index .= ($target) ? "Path" : "Path name";
	if ($'enable_grep) {
		$index .= "\n<INPUT TYPE=radio NAME=type VALUE=grep>";
		$index .= ($target) ? "Grep" : "Grep pattern";
	}
	if ($'enable_idutils && -f "$dbpath/ID") {
		$index .= "\n<INPUT TYPE=radio NAME=type VALUE=idutils>";
		$index .= ($target) ? "Id" : "Id pattern";
	}
	$index .= "\n</FORM>\n";
	$index;
}
#
# makecommonpart: make a common part for mains.html and index.html
#
#	gi)	@files
#	gi)	@defines
#
sub makecommonpart {
	local($title) = @_;
	local($index) = '';

	$index .= "<H1>$'title_begin$'title$'title_end</H1>\n";
	$index .= "<P ALIGN=right>\n";
	$index .= "Last updated " . &'date . "<BR>\n";
	$index .= "This hypertext was generated by <A HREF=$'www TARGET=_top>GLOBAL-$'version</A>.<BR>\n";
	$index .= "</P>\n";
	$index .= "<HR>\n";
	if ($'include_caution) {
		$index .= $'caution_message;
		$index .= "\n<HR>\n";
	}
	if ($'fflag) {
		$index .= &makesearchpart($'action, $'id);
		$index .= "<HR>\n";
	}
	$index .= "<H2>MAINS</H2>\n";
	local($command) = "global -nx main | sort +0 -1 +2 -3 +1n -2";
	open(PIPE, "$command |") || &'error("cannot fork.");
	$index .= &'list_begin();
	while (<PIPE>) {
		chop;
		$index .= &'list_body($'SRCS, $_);
	}
	$index .= &'list_end();
	close(PIPE);
	if ($?) { &'error("'$command' failed."); }
	$index .= "<HR>\n";
	if ($'aflag && !$'Fflag) {
		$index .= "<H2>$'title_define_index</H2>\n";
		foreach $f (@defines) {
			$index .= $f;
		}
	} else {
		$index .= "<H2><A HREF=defines.$'normal_suffix>$'title_define_index</A></H2>\n";
	}
	$index .= "<HR>\n";
	if ($'Fflag) {
		$index .= "<H2><A HREF=files.$'normal_suffix>$'title_file_index</A></H2>\n";
	} else {
		$index .= "<H2>$'title_file_index</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) = @_;

	if ($'Fflag) {
		open(FRAME, ">$file") || &'error("cannot open file '$file'.");
		print FRAME $'html_begin, "\n";
		print FRAME "<HEAD>\n<TITLE>$title</TITLE>\n$'meta_robots\n$'meta_generator\n</HEAD>\n";
		print FRAME "<FRAMESET COLS='200,*'>\n";
		if ($'fflag) {
			print FRAME "<FRAMESET ROWS='33%,33%,*'>\n";
			print FRAME "<FRAME NAME=search SRC=search.$'normal_suffix>\n";
		} else {
			print FRAME "<FRAMESET ROWS='50%,*'>\n";
		}
		print FRAME "<FRAME NAME=defines SRC=defines.$'normal_suffix>\n";
		print FRAME "<FRAME NAME=files SRC=files.$'normal_suffix>\n";
		print FRAME "</FRAMESET>\n";
		print FRAME "<FRAME NAME=mains SRC=mains.$'normal_suffix>\n";
		print FRAME "<NOFRAMES>\n";
		print FRAME $'body_begin, "\n";
		print FRAME $index;
		print FRAME $'body_end, "\n";
		print FRAME "</NOFRAMES>\n";
		print FRAME "</FRAMESET>\n";
		print FRAME $'html_end, "\n";
		close(FRAME);
	} else {
		open(FILE, ">$file") || &'error("cannot open file '$file'.");
		print FILE $'html_begin, "\n";
		print FILE &'set_header($title);
		print FILE $'body_begin, "\n";
		print FILE $index;
		print FILE $'body_end, "\n";
		print FILE $'html_end, "\n";
		close(FILE);
	}
}
#
# 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'.");
	print INDEX $'html_begin, "\n";
	print INDEX &'set_header($title);
	print INDEX $'body_begin, "\n";
	print INDEX $index;
	print INDEX $'body_end, "\n";
	print INDEX $'html_end, "\n";
	close(INDEX);
}
#
# makesearchindex: make search html
#
#	i)	$file	file name
#
sub makesearchindex {
	local($file) = @_;

	open(SEARCH, ">$file") || &'error("cannot create file '$file'.");
	print SEARCH $'html_begin, "\n";
	print SEARCH &'set_header('SEARCH');
	print SEARCH $'body_begin, "\n";
	print SEARCH &makesearchpart($'action, $'id, 'mains');
	print SEARCH $'body_end, "\n";
	print SEARCH $'html_end, "\n";
	close(SEARCH);
}
#
# makehtml: make html files
#
#	i)	total	number of files.
#
sub makehtml {
	local($dist, $total) = @_;
	local($count) = 0;
	local($findcom) = ($'other_files) ? "$'findcom --other | sort -t / +1" : $'findcom;

	open(FIND, "$findcom |") || &'error("cannot fork.");
	while (<FIND>) {
		local($notsource) = 0;
		chop;
		if (/^ /) {
			next if (!$'other_files);
			s/^ //;
			if (-B $_) {
				print STDERR "Warning: '$_' is binary file. (skipped)\n" if ($'wflag);
				next;
			}
			$notsource = 1;
		}
		$count++;
		local($path) = $_;
		$path =~ s/^\.\///;
		print STDERR " [$count/$total] converting $_\n" if ($'vflag);
		$path = &'path2url($path);
		&convert'src2html($_, "$dist/$'SRCS/$path", $notsource);
	}
	close(FIND);
	if ($?) { &'error("cannot traverse directory.($findcom)"); }
}
#=========================================================================
# CONVERT PACKAGE
#=========================================================================
package convert;
#
# src2html: convert source code into HTML
#
#	i)	$file	source file	- Read from
#	i)	$hfile	HTML file	- Write to
#	i)	$notsource 1: isn't source, 0: source.
#	gi)	%includes
#			pairs of include file and the path
#
sub src2html {
	local($file, $hfile, $notsource) = @_;
	local($ncol) = $'ncol;
	local($tabs) = $'tabs;
	local(%ctab) = ('&', '&amp;', '<', '&lt;', '>', '&gt;');
	local($isjava) = ($file =~ /\.java$/) ? 1 : 0;
	local($iscpp) = ($file =~ /\.(h|c\+\+|cc|cpp|cxx|hxx|C|H)$/) ? 1 : 0;
	local($command);

	if ($'cflag) {
		$command = "gzip -c >";
		$command .= ($'w32) ? "\"$hfile\"" : "'$hfile'";
		open(HTML, "| $command") || &'error("cannot create file '$hfile'.");
	} else {
		open(HTML, ">$hfile") || &'error("cannot create file '$hfile'.");
	}
	local($old) = select(HTML);
	#
	# load tags belonging to this file.
	#
	&anchor'load($file);
	$command = "$'gtags --expand -$tabs ";
	$command .= ($'w32) ? "\"$file\"" : "'$file'";
	open(SRC, "$command |") || &'error("cannot fork.");
	$file =~ s/^\.\///;

	print $'html_begin, "\n";
	print &'set_header($file);
	print $'body_begin, "\n";
	if ($notsource) {
		#
		# It is not source file.
		#
		print "<PRE>\n";
		while (<SRC>) {
			s/([&<>])/$ctab{$1}/ge;
			print "<A NAME=$.>";
			print;
		}
		print "<PRE>\n";
	} else {
		#
		# print the header
		#
		print "<A NAME=TOP><H2>";
		print &fill_anchor($file);
		print "</H2>\n";
		print "$'comment_begin/* ";
		print &link_format(&anchor'getlinks(0));
		if ($'show_position) {
			print $'position_begin;
			print "[+1 $file]";
			print $'position_end;
		}
		print " */$'comment_end";
		print "\n<HR>\n";
		print "<H2>$'title_define_index</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 onMouseOver=\"show('R',$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 (<SRC>) {
			local($converted);
			s/\r$//;
			# make link for include file
			if (!$INCOMMENT && /^#[ \t]*include/) {
				local($last, $sep) = m![</"]([^</"]+)([">])!;
				if (defined $'includes{$last}) {
					local($link);
					local($no, @incs) = split(/\n/, $'includes{$last});
					if (@incs == 1) {
						$link = &'path2url($incs[0]);
					} else {
						$link = "../$'INCS/$no.$'HTML";
					}
					# quote path name.
					$last =~ s/([\[\]\.\*\+])/\\\1/g;
					if ($sep eq '"') {
						s!"(.*$last)"!"<A HREF=$link>$1</A>"!;
					} else {
						s!<(.*$last)>!&lt;<A HREF=$link>$1</A>&gt;!;
					}
					$converted = 1;
				}
			}
			# translate '<', '>' and '&' into entity name
			if (!$converted) { s/([&<>])/$ctab{$1}/ge; }
			&protect_line();	# protect quoted char, strings and comments
			# painting source code
			s/({|})/$'brace_begin$1$'brace_end/g;
			local($sharp) = s/^(#[ \t]*($'sharp_macros))// ? $1 : '';
			if ($sharp !~ '#[ \t]*include') {
				if ($isjava) {
					s/\b($'java_reserved_words)\b/$'reserved_begin$1$'reserved_end/go;
				} elsif ($iscpp) {
					s/\b($'cpp_reserved_words)\b/$'reserved_begin$1$'reserved_end/go;
				} else {
					s/\b($'c_reserved_words)\b/$'reserved_begin$1$'reserved_end/go;
				}
			}
			s/^/$'sharp_begin$sharp$'sharp_end/ if ($sharp);	# recover macro
			local($define_line) = 0;
			local(@links) = ();
			local($count) = 0;

			print "<A NAME=$.>";
			for (; int($LNO) == $.; ($LNO, $TAG, $TYPE) = &anchor'next()) {
				$define_line = $LNO if ($TYPE eq 'D');
				$db = ($TYPE eq 'R') ? 'GTAGS' : 'GRTAGS';
				local($line) = &cache'get($db, $TAG);
				if (defined($line)) {
					local($href);
					if ($line =~ /^ (.*)/) {
						local($type) = ($TYPE eq 'R') ? $'DEFS : $'REFS;
						local($msg) = 'Multiple ';
						$msg .= ($TYPE eq 'R') ? 'defined.' : 'refered.';
						$href = "<A HREF=../$type/$1.$'HTML onMouseOver=\"show('$TYPE',-1,'')\">$TAG</A>";
					} else {
						local($nouse, $lno, $filename) = split(/[ \t]+/, $line);
						$nouse = '';	# to make perl quiet
						local($url) = &'path2url($filename);
						$filename =~ s!\./!!; 
						local($msg) = ($TYPE eq 'R') ? 'Defined at' : 'Refered from';
						$href = "<A HREF=../$'SRCS/$url#$lno onMouseOver=\"show('$TYPE',$lno,'$filename')\">$TAG</A>";
					}
					# set tag marks and save hyperlink into @links
					if (ord($TAG) > 127) {	# for multi-byte code
						if (s/([\x00-\x7f])$TAG([ \t]*\()/$1\005$count\005$2/ || s/([\x00-\x7f])$TAG([\x00-\x7f])/$1\005$count\005$2/) {
							$count++;
							push(@links, $href);
						} else {
							print STDERR "Error: $file $LNO $TAG($TYPE) tag must exist.\n" if ($'wflag);
						}
					} else {
						if (s/\b$TAG([ \t]*\()/\005$count\005$1/ || s/\b$TAG\b/\005$count\005/ || 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 referred.\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();
			# make guide
			if ($define_line) {
				$guide = '';
				$guide .= ' ' x ($ncol + 1) if ($'nflag);
				$guide .= "$'comment_begin/* ";
				$guide .= &link_format(&anchor'getlinks($define_line));
				if ($'show_position) {
					$guide .= $'position_begin;
					$guide .= "[+$define_line $file]";
					$guide .= $'position_end;
				}
				$guide .= " */$'comment_end\n";
			}
			# print a line
			if ($define_line && $'definition_header eq 'before') {
				print $guide;
			}
			printf "%${ncol}d ", $. if ($'nflag);
			print;
			if ($define_line && $'definition_header eq 'after') {
				print $guide;
			}
		}
		print "</PRE>\n";
		print "<HR>\n";
		print "<A NAME=BOTTOM>\n";
		print "$'comment_begin/* ";
		print &link_format(&anchor'getlinks(-1));
		if ($'show_position) {
			print $'position_begin;
			print "[+$. $file]";
			print $'position_end;
		}
		print " */$'comment_end";
		print "\n";
	}
	print $'body_end, "\n";
	print $'html_end, "\n";

	close(SRC);
	if ($?) { &'error("cannot open file '$file'."); }
	close(HTML);
	select($old);

}
#
# fill_anchor: fill anchor into file name
#
#	i)	$file	file name
#	r)		hypertext file name string
#
sub fill_anchor {
	local(@file) = split(/\//, $_[0]);
	local(@path, $url);

	while (@file) {
		local($unit) = shift(@file);
		if (@file == 0) {
			$url .= $unit;
			last;
		}
		push(@path, $unit);
		$url .= "<A HREF=../files/";
		$url .= &'path2url(join('/', @path));
		$url .= ">";
		$url .= $unit;
		$url .= "</A>/";
	}
	$url;
}
#
# protect_line: protect quoted strings
#
#	io)	$_	source line
#
#	\001	quoted(\) char
#	\002	quoted('') char
#	\003	quoted string
#	\004	comment
#	\005	line comment
#	\032	temporary mark
#
sub protect_line {
	@quoted_char1 = ();
	while (s/(\\.)/\001/) {
		push(@quoted_char1, $1);
	}
	@quoted_char2 = ();
	while (s/('[^']')/\002/) {
		push(@quoted_char2, $1);
	}
	@quoted_strings = ();
	while (s/("[^"]*")/\003/) {
		push(@quoted_strings, $1);
	}
	@comments = ();
	s/^/\032/ if ($INCOMMENT);
	while (1) {
		if ($INCOMMENT == 0) {
			if (s/\/\*/\032\/\*/) {		# start comment
				$INCOMMENT = 1;
			} else {
				last;
			}
		} else {
			# This regular expression was drived from
			# perl FAQ 4.27 (ftp://ftp.cis.ufl.edu/pub/perl/faq/FAQ)
			if (s!\032((/\*)?[^*]*\*+([^/*][^*]*\*+)*/)!\004!) {
				push(@comments, $1);
				$INCOMMENT = 0;
			} else {
				s/\032(.*)$/\004/;	# mark comment
				push(@comments, $1);
			}
			last if ($INCOMMENT);
		}
	}
	$line_comment = '';
	if (s!(//.*)$!\005! || s!(/\004.*)$!\005!) {
		$line_comment = $1;
		# ^     //   /*   $	... '//' invalidate '/*'.
		# ^     //*       $	... Assumed '//' + '*', not '/' + '/*'.
		$INCOMMENT = 0;
	}
}
#
# unprotect_line: recover quoted strings
#
#	i)	$_	source line
#
sub unprotect_line {
	local($s);

	if ($line_comment) {
		s/\005/$'comment_begin$line_comment$'comment_end/;
	}
	while (@comments) {
		$s = shift @comments;
		# nested tag can be occured but no problem.
		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) = ($'icon_list) ? @'anchor_comment : @'anchor_label;
	local(@icons) = @'anchor_icons;
	local($line);

	for $n (0 .. $#label) {
		if ($n == 6) {
			$line .=  "<A HREF=../mains.$'normal_suffix>";
		} elsif ($n == 7) {
			$line .=  "<A HREF=../help.$'normal_suffix>";
		} elsif ($tag[$n]) {
			$line .=  "<A HREF=#$tag[$n]>";
		}
		if ($'icon_list) {
			$icon = ($tag[$n] || $n > 5) ? "$icons[$n]" : "n_$icons[$n]";
			$line .= "<IMG SRC=../icons/$icon ALT=\[$label[$n]\] BORDER=0 ALIGN=MIDDLE>";
		} else {
			$line .=  "\[$label[$n]\]";
		}
		$line .=  "</A>" if ($n > 5 || $tag[$n]);
		if ($'icon_list && $n < $#label) {
			$line .= ' ';
		}
	}
	$line;
}

#=========================================================================
# ANCHOR PACKAGE
#=========================================================================
package anchor;
#
# create: create anchors temporary database
#
#	go)	%PATHLIST
#
sub create {
	$ANCH = "$'tmp/ANCH$$";
	open(ANCH, ">$ANCH") || &'error("cannot create file '$ANCH'.");
	close(ANCH);
	chmod ($ANCH, 0600);
	local($command) = "btreeop -C $ANCH";
	open(ANCH, "| $command") || &'error("cannot fork.");
	local($fcount) = 1;
	local($fnumber);
	foreach $db ('GTAGS', 'GRTAGS') {
		local($option) = ($db eq 'GTAGS') ? '' : 'r';
		local($command) = "global -nnx$option \".*\"";
		open(PIPE, "$command |") || &'error("cannot fork.");
		while (<PIPE>) {
			local($tag, $lno, $filename, $image) = split;
			$fnumber = $PATHLIST{$filename};
			if (!$fnumber) {
				$PATHLIST{$filename} = $fnumber = $fcount++;
			}
			if ($db eq 'GTAGS') {
				$type = ($image =~ /^#[ \t]*define/) ? 'M' : 'D';
			} else {
				$type = 'R';
			}
			print ANCH "$fnumber $lno $tag $type\n";
		}
		close(PIPE);
		if ($?) { &'error("'$command' failed."); }
	}
	close(ANCH);
	if ($?) { &'error("'$command' failed."); }
}
#
# finish: remove anchors database
#
sub finish {
	unlink("$ANCH") if (defined($ANCH));
}
#
# load: load anchors belonging to specified file.
#
#	i)	$file	source file
#	gi)	%PATHLIST
#	go)	FIRST	first definition
#	go)	LAST	last definition
#
sub load {
	local($file) = @_;
	local($fnumber);

	@ANCHORS = ();
	$FIRST = $LAST = 0;

	$file = './' . $file if ($file !~ /^\.\//);
	if (!($fnumber = $PATHLIST{$file})) {
		return;
	}
	local($command) = "btreeop -K $fnumber $ANCH";
	open(ANCH, "$command |") || &'error("cannot fork.");
	while (<ANCH>) {
		local($fnumber, $lno, $tag, $type) = split;
		push(@ANCHORS, "$lno,$tag,$type");
	}
	close(ANCH);
	if ($?) {&'error("'$command' failed."); }
	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 ($FIRST > 0 && $linenumber != $FIRST);
	$last  = $LAST if ($LAST > 0 && $linenumber != $LAST);
	$top = 'TOP' if ($linenumber != 0);
	$bottom = 'BOTTOM' if ($linenumber != -1);
	if ($FIRST > 0 && $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 {
	$CACH  = "$'tmp/CACH$$";
	dbmopen(%CACH, $CACH, 0600) || &'error("cannot make cache database.");
}
#
# 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';

	$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 {
	if ($CACH) {
		dbmclose(%CACH);
		unlink("$CACH.db", "$CACH.pag", "$CACH.dir");
	}
}
