package Autodoc::DumpDocs;

###############################################################################
###############################################################################
##
##    Written by Adam Swift (c) 1995 by Friday Software and Consulting
##                           All rights reserved.
##
##	  This notice may not be removed from this source code.
##
##    This program is included in the MiscKit by permission from the author
##    and its use is governed by the MiscKit license, found in the file
##    "LICENSE.rtf" in the MiscKit distribution.  Please refer to that file
##    for a list of all applicable permissions and restrictions.
##
##    Because AutoDoc is licensed free of charge, there is no warranty 
##    for the program.  Copyright holder, Friday Software and Consulting, 
##    is providing this program "as is" and this program 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.
##
###############################################################################
###############################################################################

require 5.000;
require "flush.pl";

##########################
# load required packages #
##########################
use Exporter;
use Autodoc::GenerateRTF;
use Autodoc::LogDebug;
use Autodoc::ReadSource;

@ISA      = qw(Exporter);
@EXPORT   = qw(dump_documentation
			   set_copyrightowner
			   copyrightowner
			   set_usetimestamp
			   usetimestamp
			   doc_bold_words
			   doc_italic_words
			  );

$module_version = '$Revision: 1.3 $';
$module_version =~ s!(\$\w+: | \$)!!g;
$module_id	    = '$Id: DumpDocs.pm,v 1.3 1995/10/20 22:16:25 aswift Exp $';
$module_id      =~ s!(\$\w+: | \$)!!g;
$module_name	= $module_id;
$module_name	=~ s!^([^\,]+).*$!$1!;

############################################################################
# 
# Purpose: Module that encapsulates the creation of documentation from the
#          source code parsed with autodoc.
#
# HISTORY: START
# $Log: DumpDocs.pm,v $
# Revision 1.3  1995/10/20  22:16:25  aswift
# Added DevMan style changes Log support
#
#
# HISTORY: END
############################################################################
#
# GLOBAL VARIABLES THAT AFFECT DOCUMENTATION DUMP
#
#  $format_italicwords  The array of words to italicize in &format_paragraph
#  $dump_rtf            If the documentation should produce RTF formatted docs.
#
#############################################################################


#############################################################################
#
# NAME:       module_version
#
# ACTION:     returns the version number of this module
#
# RETURN:     the module version
#
#############################################################################
sub module_version
{
    return $module_version;
}

sub module_versionstamp
{
    return "$module_name (rev-$module_version)";
}

#############################################################################
#
# Module variable access 
#
#############################################################################
sub set_copyrightowner
{
    $copyrightowner = $_[0];
}

sub copyrightowner
{
    return $copyrightowner 
	  if (defined($copyrightowner));
    return "";
}

sub set_usetimestamp
{
    $usetimestamp = $_[0];
}

sub usetimestamp
{
    return $usetimestamp 
	  if (defined($usetimestamp)); 
    return 0;
}

sub doc_italic_words
  {
	return @format_italicwords
	  if (defined (@format_italicwords));
	return ();
  }

sub doc_bold_words
  {
	return ("self", "nil", "super", "id", "NULL");
  }


###############################################################################
#
# DOCUMENTATION DUMPING TO OBJECT RTF FILE
#
#    Use the information scanned into the global object variables to create
#  a Rich Text Formatted documentation file, in the directory specified by
#  $dest_dir.
#

#
# Locate and write the documentation file for the object passed as the one
# argument to this subroutine. 
#
sub dump_documentation
  {
    local ($obj_root, $obj_r, $opt_silent) = @_;
	
	$dump_rtf = 1;
	
    dblog (0, "Writing documentation for:\t$obj_root");
    dblog (1, "Writing documentation to file: $obj_r");
    
    # open the documentation file
    if (!open(DUMPFILE, ">$obj_r")) {
	  warn ("Can't open $obj_r: $!\n");
	  return 0;
    } else {
	  if (!$opt_silent) {
		print ("autodoc producing $obj_r ... ");
		flush (STDOUT);
	  }
    }
    
    # Header	
    dump_header();
    
    # Body
    dump_copyrightinfo();
    dump_objectname();
    dump_inheritsfrom_declaredin();
    dump_classdescription()
	  if (!object_noobjectdefined());
    dump_typedefs();
    dump_defines();
    dump_macros();
    dump_functions();
    dump_globals();
    dump_instancevariables();
    dump_methodtypes();
	
    dump_methods(1, object_classmethods())
	  if (object_classmethods());
    dump_methods(0, object_instmethods())
	  if (object_instmethods());
    
    # Footer
    dump_footer();	
	
    # close the docuentation file and message the user
    close (DUMPFILE);
    if (!$opt_silent) {
	  print ("done\n");
    }
    return 1;
}				


#
# Dump the instance (or class) methods with full formatting, setup the 
# format_italicwords so that the method documentaiton italicizes the 
# arguments to the method.
#
sub dump_methods
  {
	local ($class_meth) = shift (@_);
    local (@o_methods) = @_;
    local ($index, $meth, $methname);
	
    if ($class_meth) {
	  dump_majorheading ("Class Methods");
	} else {
	  dump_majorheading ("Instance Methods");
	}

    @o_methods = sort bymethodname @o_methods;
	
    for ($index = 0; $index < @o_methods; $index ++) {
	  if ($dump_rtf) {
		dump_line (rtf_newline_small(3))
		  if ($index);
	  }
	  $meth = $o_methods[$index];
	  if ($class_meth) {
		$methname = "+";
	  } else {
		$methname = "-";
	  }
	  $methname .= extract_methodname ($meth);
	  dump_method ($meth, $methname);
	}
  }


#
# dump a formatted method with documentation
#
sub dump_method
  {
	local ($meth, $methname, $methname_raw, $methtype, $f_method, $i_words);
	local (%o_methoddocs);
	
	$meth		  = $_[0];		# the full method declaration 
	$methname	  = $_[1];		# the abbrv. unique name
	$methname	  =~ m/^([\+\-])/;
	$methname_raw = $';		    # methname_raw is methname w/o + or -
	$meth	      = $1 . $meth;	# prepend the + or - onto the method name
	
	if ($dump_rtf) {
	  # write the raw methodname (no args or type info)
	  dump_paragraph(rtf_setfont_helvetica() . rtf_boldify($methname_raw));

	  ($f_method, $i_words) = rtf_format_method ($meth);

	  # write the formatted method with args and type info
	  dump_line (rtf_setfont_times() . rtf_newline_micro());
	  dump_methodline ($f_method);
	}

	# set up the italic words for dumping the description documentation 
	if ($i_words) {
	  @format_italicwords = split (" ", $i_words);
	} else {
	  @format_italicwords = ();
	}

    # dump the method documentation
    %o_methoddocs = object_methoddocs();
    if (defined($o_methoddocs{$methname}) && 
		$o_methoddocs{$methname} ne "") {
	  
	  dump_paragraph ($o_methoddocs{$methname});
    } else {
	  dump_paragraph ("No method description.");
    }
    @format_italicwords = ();
  }


#
# Dump the formatted method names with block names before the methods they
# were assigned to.
#
sub dump_methodtypes
  {
    local ($index);
    local ($methname, $methname_raw, $methtype, $block);
    local (@o_methodnames, %o_methodblocks);
	
    @o_methodnames = object_methodnames();
    return 
	  if (scalar(@o_methodnames) == 0);
    %o_methodblocks = object_methodblocks();
	
    dump_majorheading ("Method Types");
    dump_keyvalue();

    for ($index=0; $index < @o_methodnames; $index++) {
	  $methname = $o_methodnames[$index];
	  
	  # If there is a method block assigned to this method
	  if (($block = $o_methodblocks{$methname})) {
		dump_line (rtf_newline_small())
		  if ($dump_rtf && $index > 0);
	    dump_string ("$block");
		
	    # long block names push methods to the next line
	    if (length($block) > 30) {
		  dump_string (rtf_newline());
	    } 
	  } 
	  $methname_raw = $methname;
	  $methname_raw =~ s/^([\+\-])//;
	  $methtype = $1;

	  if ($dump_rtf) {
		if ($methtype eq "-") {
		  dump_line ("\t" . rtf_emdash . " $methname_raw" . rtf_newline());
		} else {
		  dump_line ("\t+ $methname_raw" . rtf_newline());
		}
	  }
    }
  }


sub dump_defines
  {
    local ($title, @names, %docs, %values, $fmt_expr);
	
    $title	  = "Symbolic Constants";
    @names	  = object_defines();
    %docs	  = object_definedocs();
    %values	  = object_definevals();
	$fmt_expr = 's!(.*)!\\\b $1\\\b0!'
	  if ($dump_rtf);
    dump_synopsis_description (*title, *names, *docs, *values, $fmt_expr);
  }


sub dump_macros
  {
    local ($title, @names, %docs, %values, $fmt_expr);
	
    $title	   = "Macro Definitions";
    @names	   = object_macros();
    %docs	   = object_macrodocs();
    %values	   = {};
    $fmt_expr = 's!(\\S+\\s*\\()([^\\(]*)\\)$!\\\b $1\\\b0$2\\\b \)\\\b0!'
	  if ($dump_rtf);
    dump_synopsis_description (*title, *names, *docs, *values, $fmt_expr);
  }


sub dump_functions
  {
    local ($title, @names, %docs, %values, $fmt_expr);
	
    $title	   = "Functions";
    @names	   = object_functions();
    %docs	   = object_functiondocs();
    %values	   = {};
    $fmt_expr = 's!(\\S+\\s*\\()([^\\(]*)\\)$!\\\b $1\\\b0$2\\\b \)\\\b0!'
	  if ($dump_rtf);
    dump_synopsis_description (*title, *names, *docs, *values, $fmt_expr);
  }


sub dump_globals
  {
    local ($title, @names, %docs, %values, $fmt_expr);
	
    $title	  = "Global Variables";
    @names	  = object_globals();
    %docs	  = object_globaldocs();
    %values	  = {};
	$fmt_expr = 's!(\\S+)\\;$!\\\b $1\\\b0\\;!'
	  if ($dump_rtf);
    dump_synopsis_description (*title, *names, *docs, *values, $fmt_expr);
  }


sub dump_typedefs
  {
    local ($title, @names, %docs, %values, $fmt_expr);
	
    $title	  = "Defined Types";
    @names	  = object_typedefs();
    %docs	  = object_typedefdocs();
    %values	  = object_typedefvals();
	$fmt_expr = 's!(.*)!\\\b $1\\\b0!'
	  if ($dump_rtf);
    dump_synopsis_description (*title, *names, *docs, *values, $fmt_expr);
  }


sub dump_synopsis_description
  {
    local (*title, *names, *docs, *values) = @_;
    local ($docs, $value, $show_synopsis, $name_expr);
    local ($i, $max, $name);

    return 
	  if (!scalar(@names));

	# check for the special 4th argument - the executable formatting string
    $name_expr = ""
	  if ((scalar(@_) < 5) || (($name_expr = $_[4]) eq ""));
	
    dump_majorheading($title);
	
    $show_synopsis = 1;
    $show_docs	   = 0;
	$docs		   = "";
    $max		   = scalar (@names);
	
    for ($i = 0; $i < $max; $i++) {
	  $name = $names[$i];
	  
	  if (defined($values{$name})) {
	    local ($valline, @valarray, $indent);

		$value = "$values{$name}";

		# reformat special characters to preserve them in the output
		if ($dump_rtf) {
		  $value =~ s!([\{\}])!\\$1!g;
		  $value =~ s!\n!\\\n\t!g;

		  $value = " $value "; # add extra spaces to help matching
		  $value =~ s!(\W)$name(\W)!$1\\b $name\\b0$2!;
		  $value =~ s!^ | $!!g; # remove the extra spaces

		  # do some fancy indentation on the value (if curlies are there)
		  if ($value =~ m!\{!) {
			$indent = "";
			@valarray = split(m!\n!, $value);

			# for each line in the value, add indents to the approriate level
			foreach $valline (@valarray) {
			  $indent =~ s!\t!!
				if ($valline =~ m!\}!);
			  $valline = "$indent$valline"
				if ($indent =~ m!\t!);
			  
			  if ($valline =~ m!\{!) {
				$indent = "\t$indent";
				$valline =~ s!\{\s*(\S+)!\{$indent$1!;
			  }
			}
			$value = join("\n", @valarray);
		  }
		}		  
	  } else {
	    $value = "";
	  }
	  
	  if ($show_synopsis) {
		dump_minorheading("SYNOPSIS");
		dump_synopsis();
	    $show_synopsis = 0;
	  }
	  if ($name_expr ne "") {
	    local ($fname) = $name;
	    # dblog(-5, "expr = $name_expr");
	    eval ("\$fname =~ $name_expr");
	    warn ("Error formatting names: $@")
		  if ($@ ne "");
	    dump_line ("$fname\t$value" . rtf_newline())
		  if ($dump_rtf);
	  } else {
	    dump_line ("$name\t$value" . rtf_newline())
		  if ($dump_rtf);
	  }
	  
	  $show_docs = 1
	    if (($i == ($max - 1)) || defined($docs{$names[$i+1]}));
	  $docs = "$docs{$name}"
		if (defined($docs{$name}));
	  
	  if (($docs ne "") && ($show_docs == 1)) {
	    dump_line (rtf_newline_small())
		  if ($dump_rtf);
		dump_minorheading("DESCRIPTION");
	    dump_paragraph ($docs);
	    dump_line (rtf_newline_small(2))
		  if ($dump_rtf && ($i != ($max - 1)));
	    $show_docs = 0;
	    $show_synopsis = 1;
	  }
    }
  }


#
# Dump the instance variables and their descriptions to the documentation file
# descriptions are formatted by format_words
#
sub dump_instancevariables
  {
	my ($ivar, $lastivar, $docs);
    my (@o_ivars, %o_ivartypes, %o_ivardocs);
	my ($ivar_out) = "";
	
    @o_ivars = object_ivars();
    return 
	  if (scalar(@o_ivars) == 0);
    
    %o_ivartypes = object_ivartypes();
    %o_ivardocs  = object_ivardocs();
	
    dump_majorheading ("Instance Variables");

	# output ivar type list
	if ($dump_rtf) {
	  foreach $ivar (@o_ivars) {
		$ivar_out .= $o_ivartypes{$ivar} . rtf_boldify($ivar) . ";";
		$ivar_out .= rtf_newline();
	  }
	  dump_paragraph ($ivar_out);

	  # output ivar description list
	  dump_line (rtf_newline_small(2));
	  $lastivar = $o_ivars[$#o_ivars];
	  foreach $ivar (@o_ivars) {
		$docs = rtf_format_words ($o_ivardocs{$ivar});
		dump_keyvalue ("$ivar\t$docs");
		dump_line (rtf_newline_small())
		  if ($ivar ne $lastivar);
	  }
	}
  }


#
# Dump the formatted class description to the docs.  Boldify any instance
# variables or methods that appear in the description
#
sub dump_classdescription
  {
    # Problem here may be that both an obj and category are defined
    # in the same .m file.  Maybe figuring out how to dump two
    # seperate .rtf files would be optimal, but until then we should
    # allow for both to be included in the same .m and thus .rtf.
    dump_majorheading ("Class Description") 
      if (object_inherits());
    dump_majorheading ("Protocol Description")
      if (object_protocol());
    dump_majorheading ("Category Description") 
      if (object_category());

	dump_paragraph (object_classdocs());
  }

#
# dump the formatting and text necessary to put the inheritance and
# declaration location in the docs
# This has been expanded to allow categories...
#
sub dump_inheritsfrom_declaredin
  {
	my ($o_name) = object_name();
	my ($o_inh)	 = object_inherits();
	my ($o_cat)	 = object_category();
	my ($o_decl) = object_declaredin();
	my (@o_conf) = object_conformsto();
	
	if (object_noobjectdefined()) {
	  dump_subtitle ("Resource Collection");
	} else {
	  if ($o_inh) {
		if ($o_inh =~ m!^none$!) {
		  $o_inh .= rtf_italicize(" ($o_name is a root class)")
			if ($dump_rtf);
		}
		dump_subtitle ("Inherits From:", $o_inh);
	  } else {
		dump_subtitle ("Category Name:", $o_cat)
		  if ($o_cat);
	  }
	  
	  dump_subtitle ("Conforms To:", @o_conf)
		if (scalar (@o_conf) > 0);
	}
	dump_subtitle ("Declared In:", $o_decl);
  }


#
# dump the formatting and text necessary to put the copyright info in the docs
#
sub dump_copyrightinfo
  {
    my ($head)		  = "";
    my ($timestamp)	  = "";
	my ($copyright)	  = "";
    my ($bycopyowner) = "";
	my ($o_version)	  = "";

	$timestamp = scalar (localtime (time ()))
	  if (usetimestamp());
	$bycopyowner .= " by " . copyrightowner()
	  if (copyrightowner());
	$o_version = object_version() . " "
	  if (object_version());

	if ($dump_rtf) {
	  $copyright = rtf_copyright() . " ";
	  $timestamp = rtf_italicize($timestamp);
	}
	
	$head = $o_version . "Copyright " . $copyright . object_year();
	$head .= $bycopyowner . " All Rights Reserved.  " . $timestamp;

	if ($dump_rtf) {
	  dump_line (rtf_head($head));
	}
  }


#
# Compares the methods passed in $a and $b for alphabetical sorting, ignoring
# the typecasting
#
sub bymethodname
  {
    local ($one, $two);
    if ($a =~/^\([^\)]+\)\s*/) {
	  $one = $';
    } else {
	  $one = $a;
    }
    if ($b =~/^\([^\)]+\)\s*/) {
	  $two = $';
    } else {
	  $two = $b;
    }
    return $one cmp $two;
  }


#
# Write out all the arguments to the DUMPFILE and finish it off with a newline
#
sub dump_line
  {
    local ($buffer);
    foreach $buffer (@_) {
	  print DUMPFILE ("$buffer");
    }
    print DUMPFILE ("\n");
  }


#
# Write out all the arguments to the DUMPFILE 
#
sub dump_string
  {
    local ($buffer);
    foreach $buffer (@_) {
	  print DUMPFILE ("$buffer");
    }
  }


#
# Dump the standard spacer to the docs
#
sub dump_spacer
  {
    if ($dump_rtf) {
	  dump_line (rtf_spacer());
	}
  }


#
# Write the file header, to start the documentation file.
#
sub dump_header
  {
	if ($dump_rtf) {
	  dump_line (rtf_fileheader());
	  dump_line (rtf_fonttable());
	  dump_line (rtf_stylesheet());
	}
  }

#
# Write the file footer, to terminate the documentation file
#
sub dump_footer
  {
	if ($dump_rtf) {
	  dump_line (rtf_filefooter());
	}
  }


#
# dump the formatting and text necessary to put the object name in the docs
#
sub dump_objectname
  {
	dump_line (rtf_title (object_name()))
	  if ($dump_rtf);
  }


sub dump_majorheading
  {
	dump_line (rtf_majorheading (@_))
	  if ($dump_rtf);
  }


sub dump_minorheading
  {
	dump_line (rtf_minorheading (@_))
	  if ($dump_rtf);
  }


sub dump_subtitle
  {
	dump_line (rtf_subtitle (@_))
	  if ($dump_rtf);
  }


sub dump_paragraph
  {
	dump_line (rtf_paragraph (@_))
	  if ($dump_rtf);
  }


sub dump_synopsis
  {
	dump_line (rtf_synopsis (@_))
	  if ($dump_rtf);
  }

sub dump_keyvalue
  {
	dump_line (rtf_keyvalue (@_))
	  if ($dump_rtf);
  }

sub dump_methodline
  {
	dump_line (rtf_methodline (@_))
	  if ($dump_rtf);
  }


1;
