# $Id$
#
# >>Title:: Delphi Module
#
# >>Copyright::
# Copyright (c) 1992-1997, Ian Clatworthy (ianc@mincom.com).
# You may distribute under the terms specified in the LICENSE file.
#
# >>History::
# -----------------------------------------------------------------------
# Date Who Change
# 29-Feb-96 ianc SDF 2.000
# (With lots of initial work from Tim Hudson)
# -----------------------------------------------------------------------
#
# >>Purpose::
# {{MOD:delphi}} is the [[SDF]] module for
# the building {{PRD:Delphi}} documentation.
#
# >>Description::
# A {{very}} nice way of doing [[Delphi]] help without having to
# jump through major hoops and still be able to get {{great}}
# hardcopy documentation. Beat that!
#
# >>Limitations::
# TJH notes:
# * still lots of work to do in controlling table formatting stuff
# where we don't yet have things such that we can squish things
# as nicely as we need ... too much whitespace
# * I'd like to be able to say ... take all SpBefore and SpAfter
# down by 50% or something like that.
#
# Some outstanding issues:
# * How do we jump to topics inside the standard Delphi help files?
# * Should H2s be H3s so that H2 can be reserved for the optional level
# shown in the Delphi library reference?
# * What's the best way of extracting properties, etc., from the code:
# - How are 'key' entities marked?
# - How are parent classes found?
# - How often do we 'go to file' vs 'access the cache'?
#
# grab things not yet "installed" in the kernel modules
!use "misc.sdm"
# Load the images library
!inherit "images"
# Make 'delphi' a filter for formatting source code
!on filter 'delphi';; $name='example'; $params .= ';lang="Delphi"'
# Define the new paragraph attributes
!block paraattrs
Name
delphi_unit
delphi_image
!endblock
#
# On a level heading, delphi_unit triggers some nice things:
# * for help, the unit is prepended before the next heading
# * otherwise, the unit name is added to the heading.
#
#
!if $var{'OPT_TARGET'} eq 'hlp'
!on paragraph '[HAP]\d';; $delphi_unit = $attr{'delphi_unit'}
!on paragraph '[HAP]\d';; \
if ($delphi_unit) {\
&PrependText("$style: Unit", "N:{{UNIT:$delphi_unit}}");\
$delphi_unit = '';\
}
!else
#!on paragraph '[HAP]\d';; $attr{'label'} = $attr{'delphi_unit'};\
# $attr{'mif.NumAtEnd'} = 1
!on paragraph '[HAP]\d';; \
if ($attr{'delphi_unit'} ne '') {\
$text .= " (" . $attr{'delphi_unit'} . ")";\
}
!endif
# these should be moved into the images library?
# At the moment, we use IMPORT for paper-based stuff to force 'inline'
# importing, rather than 'below' importing.
!define IMG_ARROW "{{IMPORT:arrow}}"
!define IMG_KEY "{{IMPORT:key}}"
# Control the font mapping so that things are by default in
# "normal" Delphi mode ... which the user can override where
# they see fit!
!if $var{'OPT_TARGET'} eq 'hlp'
# Just the entities in the contents
!on paragraph '[HAP][2-9]';; $attr{'notoc'} = 1
# all top level headings are blue for Delphi-style help!
!on paragraph '[HAP]1';; $attr{'color'} = 'Blue';
# Delphi help is always in a nice "Arial" font ...
!on paragraph ;; $attr{'family'} = 'Arial';
!on phrase ;; $attr{'family'} = 'Arial';
# 12 point for headers ...
!on paragraph '[HAP]1';; $attr{'size'} = '12 pt'; $attr{'bold'} = '1';
# 19 point for second level headers ...
!on paragraph '[HAP]2';; $attr{'size'} = '10 pt'; $attr{'bold'} = '1';
# 10 point by default for everything else
!on paragraph '';; $attr{'size'} = '10 pt';
# Make Tasks and Example separate topics
!on paragraph '[HAP]2';; \
if ($text eq 'Tasks' || $text eq 'Example') {\
$attr{'top'} = 1;\
$attr{'id'} = "jump_${topic}_$text";\
}
!else
# Start level 1 headings on a new page (and make plain)
!on paragraph '[HAP]1';; $style =~ tr/HA/PP/; $attr{'top'} = 1
# Remove level 2+ headings from the contents (and make plain)
!on paragraph '[HA][2-9]';; $style =~ tr/HA/PP/; $attr{'notoc'} = 1
# For PostScript output, the 'Description' heading gets junked.
!if $var{'OPT_TARGET'} eq 'ps'
!on paragraph '[HAP]2';; if ($text eq 'Description') \
{$text = ""; %attr = ('sp_before', '0 pt')}
!endif
!endif
# Commonly used phrase styles
!block phrasestyles
Name To
CLASS =1
COMP =1
EVENT =1
EXCEPT =1
FUNC =1
METH =1
OBJ =1
PROC =1
PROP =1
TYPE =1
UNIT =1
VAR =1
!endblock
################# Hypertext Generation Stuff #####################
# Declare short <-> long mapping tables
!block script
%delphi_s2l = (
'class', 'class',
'comp', 'component',
'event', 'event',
'except', 'exception',
'func', 'function',
'meth', 'method',
'obj', 'object',
'proc', 'procedure',
'prop', 'property',
'type', 'type',
'unit', 'unit',
'var', 'variable',
);
%delphi_l2s = (
'class', 'class',
'component', 'comp',
'event', 'event',
'exception', 'except',
'function', 'func',
'method', 'meth',
'object', 'obj',
'procedure', 'proc',
'property', 'prop',
'type', 'type',
'unit', 'unit',
'variable', 'var',
);
sub _DelphiGenerateHyperText {
local($tmp, $group, $prefix);
$tmp = $style;
$tmp =~ tr/A-Z/a-z/;
$prefix = '';
if ($text =~ /\./) {
($group, $text) = split(/\./, $text, 2);
unless (defined($_delphi_groups{$group})) {
&'AppMsg("warning", "unknown delphi group '$group'");
}
$prefix = $_delphi_groups{$group};
}
$attr{'jump'} = $prefix . "#${tmp}_$text";
}
!endblock
# Generate hypertext jumps
!on phrase 'CLASS|COMP|EVENT|EXCEPT|FUNC|METH|OBJ|PROC|PROP|TYPE|UNIT|VAR';; \
&_DelphiGenerateHyperText()
# Generate hypertext targets
!on paragraph '[HAP][12]';; \
($tmp1, $tmp2) = split(/\s+/, $text, 2); \
$tmp2 =~ tr/A-Z/a-z/; \
$tmp2 = $delphi_l2s{$tmp2}; \
$attr{'id'} = "${tmp2}_$tmp1" if $tmp2
################# Filters #####################
!block script
# Table of "groups" - a logical name for a jump prefix
%_delphi_groups = ();
# delphi_groups - table of logical group names and matching jump prefixes
@_delphi_groups_FilterParams = ();
@_delphi_groups_FilterModel = &'TableParse(
'Field Category Rule',
'Name key',
'Prefix optional',
);
sub delphi_groups_Filter {
local(*text, %param) = @_;
local(@tbl, @flds, $rec, %values);
# Parse and validate the data
@tbl = &'TableParse(@text);
@text = ();
&'TableValidate(*tbl, *_delphi_groups_FilterModel);
# Process the data
(@flds) = &'TableFields(shift @tbl);
for $rec (@tbl) {
%values = &'TableRecSplit(*flds, $rec);
$_delphi_groups{$values{'Name'}} = $values{'Prefix'};
}
}
# delphi_properties - table of properties for a Delphi class
@_delphi_properties_FilterParams = ();
@_delphi_properties_FilterModel = &'TableParse(
'Field Category Rule',
'Name key',
'Key optional <yes>',
'RO optional <yes>'
);
sub delphi_properties_Filter {
local(*text, %param) = @_;
local(@tbl, @flds, $rec, %values);
local($line_count,$row_count,@items);
local($row,$line,$pos);
# Parse and validate the data
@tbl = &'TableParse(@text);
@text = ();
&'TableValidate(*tbl, *_delphi_properties_FilterModel);
# Sort the data
@tbl = &'TableSort(*tbl, 'Name');
# Get the line and row counts
(@flds) = &'TableFields(shift @tbl);
$line_count=scalar(@tbl);
$row_count=int(($line_count+2)/3);
#print STDERR "LINE_COUNT $line_count ROW_COUNT $row_count\n";
# Build the section "header"
if ($var{'OPT_TARGET'} eq 'hlp') {
push(@text,
"!block hlp_window",
"!squish on ; ",
"H2[notoc;hlp.topic='jump_${topic}_Properties'] Properties",
"!block table; noheadings;style=\"plain\";format=\"3,30,6,27\"",
"1a|1b|2a|2b",
"[[IMG_ARROW]]|{{B:Run-time only}}|[[IMG_KEY]]|{{B:Key properties}}",
"!endblock",
"!block table; noheadings;style='plain';" .
"tags=',,PROP,,,PROP,,,PROP';format=\"2,6,25,2,6,25,2,6,25\"",
"1a|1b|1c|2a|2b|2c|3a|3b|3c"
);
} else {
push(@text,
"P2[notoc] Properties",
"!block table; noheadings;style='plain';" .
"tags=',,PROP,,,PROP,,,PROP';format=\"2,6,25,2,6,25,2,6,25\"",
"1a|1b|1c|2a|2b|2c|3a|3b|3c"
);
}
# Process the data
@items = ();
for($line=0;$line<$row_count;$line++) {
$item='';
for($row=0;$row<3;$row++) {
# access in the right location
# alphabetically down with three cols
$pos=$line+($row*$row_count);
if ($pos>$line_count) {
$rec='';
#print STDERR "TBL[$line,$row,$pos]=<BLANK>\n";
} else {
$rec=$tbl[$pos];
#print STDERR "TBL[$line,$row,$pos]=$rec\n";
}
%values = &'TableRecSplit(*flds, $rec);
# divide into a three column table ...
if ($values{'RO'}) {
$item .= "[[IMG_ARROW]]|";
} else {
$item .= "|";
}
if ($values{'Key'}) {
$item .= "[[IMG_KEY]]|";
} else {
$item .= "|";
}
if ($values{'Name'}) {
$item .= "$values{'Name'}";
} else {
$item .= "";
}
$item .= "|" if ($row<2);
}
push(@items, $item);
}
# Let the reader know if there are none
@items = ('||None.') if $line_count == 0;
# add in the table body
push(@text,@items);
push(@text,"!endblock");
if ($var{'OPT_TARGET'} eq 'hlp') {
push(@text, "!endblock", "!squish off");
}
#print STDERR "Properties:\n" . join("\n",@text);
}
# delphi_methods - table of methods for a Delphi class
@_delphi_methods_FilterParams = ();
sub delphi_methods_Filter {
local(*text, %param) = @_;
&_delphi_keytable(*text, 'Methods');
}
# delphi_events - table of events for a Delphi class
@_delphi_events_FilterParams = ();
sub delphi_events_Filter {
local(*text, %param) = @_;
&_delphi_keytable(*text, 'Events');
}
# generic processing for methods & events
@_delphi_keytable_FilterModel = &'TableParse(
'Field Category Rule',
'Name key',
'Key optional <yes>'
);
sub _delphi_keytable {
local(*text, $label) = @_;
# local();
local($lc_label);
local($tags_value);
local(@tbl, @flds, $rec, %values);
local($line_count,$row_count,@items);
local($row,$line,$pos);
# Get a lower-case version of the label
$lc_label = $label;
$lc_label =~ tr/A-Z/a-z/;
# Gets the value of the tags parameter
if ($label eq 'Methods') {
$tags_value = ',,METH,,,METH,,,METH';
}
else {
$tags_value = ',,EVENT,,,EVENT,,,EVENT';
}
# Parse and validate the data
@tbl = &'TableParse(@text);
@text = ();
&'TableValidate(*tbl, *_delphi_keytable_FilterModel);
# Sort the data
@tbl = &'TableSort(*tbl, 'Name');
# Get the line and row counts
(@flds) = &'TableFields(shift @tbl);
$line_count=scalar(@tbl);
$row_count=int(($line_count+2)/3);
#print STDERR "LINE_COUNT $line_count ROW_COUNT $row_count\n";
# Build the section "header"
if ($var{'OPT_TARGET'} eq 'hlp') {
unshift(@text,
"!block hlp_window",
"!squish on ; ",
"H2[notoc;hlp.topic='jump_${topic}_$label'] $label",
"!block table; noheadings;style=\"plain\";format=\"6,27\"",
"1a|1b",
"[[IMG_KEY]]|{{B:Key $lc_label}}",
"!endblock",
"!block table; noheadings;style='plain';" .
"tags='$tags_value';format=\"2,6,25,2,6,25,2,6,25\"",
"1a|1b|1c|2a|2b|2c|3a|3b|3c"
);
} else {
push(@text,
"P2[notoc] $label",
"!block table; noheadings;style='plain';" .
"tags='$tags_value';format=\"2,6,25,2,6,25,2,6,25\"",
"1a|1b|1c|2a|2b|2c|3a|3b|3c"
);
}
# Process the data
@items = ();
for($line=0;$line<$row_count;$line++) {
$item='';
for($row=0;$row<3;$row++) {
# access in the right location
# alphabetically down with three cols
$pos=$line+($row*$row_count);
if ($pos>$line_count) {
$rec='';
#print STDERR "TBL[$line,$row,$pos]=<BLANK>\n";
} else {
$rec=$tbl[$pos];
#print STDERR "TBL[$line,$row,$pos]=$rec\n";
}
%values = &'TableRecSplit(*flds, $rec);
# method/event doesn't have the RO field but does still
# use the same table formatting ... cute huh!
$item .= "|";
if ($values{'Key'}) {
$item .= "[[IMG_KEY]]|";
} else {
$item .= "|";
}
if ($values{'Name'}) {
$item .= "$values{'Name'}";
} else {
$item .= "";
}
$item .= "|" if ($row<2);
}
push(@items, $item);
}
# Let the reader know if there are none
@items = ('||None.') if $line_count == 0;
# add in the table body
push(@text,@items);
push(@text,"!endblock");
if ($var{'OPT_TARGET'} eq 'hlp') {
push(@text, "!endblock", "!squish off");
}
#print STDERR "Methods:\n" . join("\n",@text);
}
# delphi_see_also - a table of related entities
@_delphi_see_also_FilterParams = ();
@_delphi_see_also_FilterModel = &'TableParse(
'Field Category Rule',
'Name key',
'Category optional <component|object|exception|type|property|method|event|function|procedure>'
);
sub delphi_see_also_Filter {
local(*text, %param) = @_;
# local();
local(@tbl, @flds, $rec, %values);
local($item, @items, $style);
# Parse and validate the data
@tbl = &'TableParse(@text);
@text = ();
&'TableValidate(*tbl, *_delphi_see_also_FilterModel);
# Process the data
(@flds) = &'TableFields(shift @tbl);
for $rec (@tbl) {
%values = &'TableRecSplit(*flds, $rec);
if ($values{'Category'}) {
$style = $delphi_l2s{$values{'Category'}};
$style =~ tr/a-z/A-Z/;
$item = "{{$style: $values{'Name'}}} $values{'Category'}";
} else {
$item = "{{JUMP: $values{'Name'}}}";
}
push(@items, $item);
}
# Format the output
if ($var{'OPT_TARGET'} eq 'hlp') {
@text = (
"!squish on ; ",
"!block hlp_window",
"H2[id='jump_${topic}_See also']See also",
grep(s/^/N:/, @items),
"!endblock",
"!squish off"
);
}
else {
@text = ("H2:See also", "N:" . join(", ", @items));
}
#print STDERR "See Also:\n" . join("\n",@text);
}
# delphi_components - table of components for a Delphi unit
@_delphi_components_FilterParams = ();
sub delphi_components_Filter {
local(*text, %param) = @_;
&_delphi_list(*text, 'Components', 'COMP');
}
# delphi_objects - table of objects for a Delphi unit
@_delphi_objects_FilterParams = ();
sub delphi_objects_Filter {
local(*text, %param) = @_;
&_delphi_list(*text, 'Objects', 'OBJ');
}
# delphi_types - table of types for a Delphi unit
@_delphi_types_FilterParams = ();
sub delphi_types_Filter {
local(*text, %param) = @_;
&_delphi_list(*text, 'Types', 'TYPE');
}
# delphi_routines - table of routines for a Delphi unit
@_delphi_routines_FilterParams = ();
sub delphi_routines_Filter {
local(*text, %param) = @_;
&_delphi_list(*text, 'Routines', 'FUNC');
}
# delphi_exceptions - table of exceptions for a Delphi unit
@_delphi_exceptions_FilterParams = ();
sub delphi_exceptions_Filter {
local(*text, %param) = @_;
&_delphi_list(*text, 'Exceptions', 'EXCEPT');
}
# delphi_variables - table of variables for a Delphi unit
@_delphi_variables_FilterParams = ();
sub delphi_variables_Filter {
local(*text, %param) = @_;
&_delphi_list(*text, 'Variables', 'VAR');
}
# generic processing for components, objects, types and routines
@_delphi_list_FilterModel = &'TableParse(
'Field Category Rule',
'Name key',
'Style optional',
);
sub _delphi_list {
local(*text, $label, $style) = @_;
# local();
local(@tbl, @flds, $rec, %values);
local($item_style, $item, @items);
# Parse and validate the data
@tbl = &'TableParse(@text);
@text = ();
&'TableValidate(*tbl, *_delphi_list_FilterModel);
# Sort the data
@tbl = &'TableSort(*tbl, 'Name');
# Process the data
(@flds) = &'TableFields(shift @tbl);
for $rec (@tbl) {
%values = &'TableRecSplit(*flds, $rec);
$item_style = $values{'Style'} ne '' ? $values{'Style'} : $style;
$item = "{{$item_style: $values{'Name'}}}";
push(@items, $item);
}
# Format the output
if ($var{'OPT_TARGET'} eq 'hlp') {
@text = (
"!squish on ; ",
"H2:$label",
grep(s/^/N:/, @items),
"N:",
"!squish off"
);
}
else {
@text = ("H2:$label", "N:" . join(", ", @items));
}
}
!endblock