#!/usr/bin/perl

#
# Doxygenのperlmod出力をサクラエディタのキーワードヘルプファイルに変換
# written by Nickle 2005/6/14-
#
# 1. doxyfileに GENERATE_PERLMOD = YES と書く
# 2. perlmod/DoxyDocs.pm が出力される
# 3. DoxyDocs.pmをカレントに置いて実行
#

# 既知の問題
#	名前の重複判定がネームスペースを考慮しない
#	→ 仕様。サクラもネームスペースの概念持たないし
#
#	関数ポインタのtypedefが正しく出力されない (perlmod側のバグ)
#	例: typedef int (PASCAL *SpiFuncIsSupported)(LPSTR, DWORD);
#		→ typedef int(PASCAL* SpiFuncIsSupported;
#
#	全角スペースが化ける (perlmod側のバグ)
#	例: [注意点]　DirectSoundは、ボリューム値に-1000を指定したとすると、
#		→ [注意点]≠ﾍ、ボリューム値に-1000を指定したとすると、

# TODO
#	structはメンバが全部表示されたほうが便利
#	→ typedefのtypeを見て、元のtypeを探し出さなければならない。結構面倒
#
#	ネームスペースを考慮しないといっても、チップヘルプにはクラス名が入ったほうが便利かも。
#	ClassHoge::Invoke() みたいに


### 設定項目 ################################

# stderrに入力補完単語ファイルを出力
$OUTPUT_KWD = 1;

# 出力対象識別子
@OUTPUT_CATEGORY_FILES = qw/typedefs variables functions/;
@OUTPUT_CATEGORY_CLASSES = qw/public_typedefs public_methods public_members
                              protected_typedefs protected_methods protected_members
                              private_typedefs private_methods private_members/;

# 簡易ドキュメント(@brief)を出力する
$OUTPUT_BRIEF = 1;

# 詳細ドキュメントを出力する
$OUTPUT_DETAILED = 1;

# 引数の説明(@param)を出力する
$OUTPUT_PARAM = 1;

# 戻り値の説明(@return)を出力する
$OUTPUT_RETURN = 1;

# 1行の文字数制限
$LINE_MAX_CHAR = 70;

### 設定項目ここまで ########################


use DoxyDocs;

foreach($$doxydocs{'files'})
{
	# ファイル列挙
	$files = $_;
	foreach(@$files)
	{
		$file = $_;
		foreach(@OUTPUT_CATEGORY_FILES)
		{
			# いろいろ列挙
			$category = $_;
			$members = $$file{$_}{'members'};
			foreach(@$members)
			{
				&out_typedef($_)	if($category eq "typedefs");
				&out_member($_)		if($category eq "variables");
				&out_func($_)		if($category eq "functions");
			}
		}
	}
}

foreach($$doxydocs{'classes'})
{
	# クラス列挙
	$classes = $_;
	foreach(@$classes)
	{
		$class = $_;
		foreach(@OUTPUT_CATEGORY_CLASSES)
		{
			# いろいろ列挙
			$category = $_;
			$members = $$class{$_}{'members'};
			foreach(@$members)
			{
				&out_typedef($_)	if(grep(/$category/, qw/public_typedefs protected_typedefs private_typedefs/));
				&out_member($_)		if(grep(/$category/, qw/public_members protected_members private_members/));
				&out_func($_)		if(grep(/$category/, qw/public_methods protected_methods private_methods/));
			}
		}
	}
}

if($OUTPUT_KWD)
{
	foreach(sort keys %found_ident)
	{
		print stderr "$_\n";
	}
}


sub out_member()
{
	my $ref = @_[0];

	# 変数名
	my $name = $$ref{'name'};

	# なにかと同じシンボルが複数回出力されるので回避
	return if($found_ident{$name});

	$found_ident{$name} = 1;

	print "$name /// ";

	my $type = $$ref{'type'};
	$type = &format_type($type);
	$type = &escape_khp($type);

	my $init;
	if($$ref{'initializer'})
	{
		$init = " = " . &escape_khp($$ref{'initializer'});
	}
	
	print "$type $name$init;";

	# briefとdetailedを出力
	out_docs_both($ref);

	print "\n";
}

sub out_typedef()
{
	my $ref = @_[0];

	# enumのタグ名はとりあえず出力しない
	return if($$ref{'kind'} eq "enum");

	# typedef名
	my $name = $$ref{'name'};

	# なにかと同じシンボルが複数回出力されるので回避
	return if($found_ident{$name});

	$found_ident{$name} = 1;

	print "$name /// ";

	my $type = $$ref{'type'};

	my $init;
	if($$ref{'initializer'})
	{
		$init = " = " . &escape_khp($$ref{'initializer'});
	}
	
	if($type ne "@")
	{
		$type = &format_type($type);
		$type = &escape_khp($type);

		# initializerあるのか？まあ一応
		print "typedef $type $name$init;";
	}
	else
	{
		print "enum { $name$init };";
	}

	# briefとdetailedを出力
	out_docs_both($ref);

	print "\n";
}

sub out_func()
{
	my $ref = @_[0];

	# 関数名
	my $name = $$ref{'name'};

	# ヘッダにプロトタイプがあると同じ関数が複数回出力されるので回避
	return if($found_ident{$name});

	$found_ident{$name} = 1;

	print "$name /// ";

	my $type = $$ref{'type'};
	$type = &format_type($type);
	$type = &escape_khp($type);
	if($type)
	{
		print "$type $name (";
	}
	else
	{
		print "$name ("; # コンストラクタは型がない
	}
	
	# 関数パラメータ
	my $params = $$ref{'parameters'};
	my @params = ();
	foreach(@$params)
	{
		my $type = $$_{'type'};
		$type = &format_type($type);
		$type = &escape_khp($type);
		my $decl_name = $$_{'declaration_name'};
		push(@params, "$type $decl_name");
	}
	my $param = join(", ", @params);
	$param =~ s/^\s+|\s+$//g;
	print $param . ');\n';
	
	# 引数の説明
	$params = $$ref{'detailed'}{'params'};
	if($OUTPUT_PARAM && $params)
	{
		print '\n';
		foreach(@$params)
		{
			# 引数名
			print "$$_{'parameters'}[0]{'name'}  ";

			# 引数の説明
			out_param_docs($$_{'doc'});
			
			print '\n';
		}
	}
	
	# 戻り値の説明
	my $ret = $$ref{'detailed'}{'return'};
	if($OUTPUT_RETURN && $ret)
	{
		print '\n戻り値  ';
		out_param_docs($ret);
		print '\n';
	}
	
	# briefとdetailedを出力
	out_docs_both($ref);

	print "\n";
}


# khpでは\nは改行とみなされてしまう
# それと&がショートカットキーのアレとみなされて下線つきになる
# ついでに前後の空白も除去
sub escape_khp()
{
	my $s = @_[0];
	$s =~ s/^\s+|\s+$//g;
	$s =~ s/\\n/￥n/g;
	$s =~ s/&/＆/g;
	return wrap_around($s, $LINE_MAX_CHAR);
}

# briefとdetailedを出力
sub out_docs_both()
{
	my $ref = @_[0];

	# 簡易ドキュメント(@brief)
	my $docs = $$ref{'brief'}{'doc'};
	if($OUTPUT_BRIEF && $docs)
	{
		print '\n';
		out_docs($docs);
	}

	# 詳細ドキュメント
	$docs = $$ref{'detailed'}{'doc'};
	if($OUTPUT_DETAILED && $docs)
	{
		print '\n';
		out_docs($docs);
	}
}

# 最初か最後にparbreak, linebreakがあったら削除
sub out_docs()
{
	my $docs = @_[0];
	my $out = "";
	foreach(@$docs)
	{
		$out .= &escape_khp($$_{'content'}) if($$_{'type'} eq "text");
		$out .= '\n\n' if($$_{'type'} eq "parbreak");
		$out .= '\n' if($$_{'type'} eq "linebreak");
	}
	
	$out =~ s/^(\\n)+|(\\n)+$//g;
	print $out;
}

# 引数の説明はparbreakしない
sub out_param_docs()
{
	my $docs = @_[0];
	foreach(@$docs)
	{
		print &escape_khp($$_{'content'}) if($$_{'type'} eq "text");
		print ' ' if($$_{'type'} eq "linebreak");
	}
}

# 悪しきShift-JISを考慮して指定バイト数ごとに改行を入れる
sub wrap_around()
{
	my $str = @_[0];
	my $num = @_[1] - 1;
	
	my @ret = ();

	# Shift-JISの1バイト目が行末に来ないように切る
	while($str =~ /(.{0,$num}[^\x81-\x9F\xE0-\xFC])/gc)
	{
		push(@ret, $1);
	}

	# 末尾の"後(8ce3)"などを取りこぼすので回収
	$str =~ /(.*)/gc;
	return join('\n', @ret) . $1;
}

# 型名を俺好みに整形
sub format_type()
{
	my $type = @_[0];
	$type =~ s/ \*/*/g; # "int *" → "int*"
	$type =~ s/ \&/&/g; # "int &" → "int&"
	$type =~ s/< /</g; # "vector< T >" → "vector<T >"
	$type =~ s/ >/>/g; # "vector<T >" → "vector<T>"

	return $type;
}