$VERSION
{
''
.__FILE__} =
'$Revision$'
;
@_CLASS_PARAMS
= (
'Name Type Rule'
,
'data boolean'
,
'cited boolean'
,
'root string'
,
'columns string'
,
'style string'
,
'compact boolean'
,
'wide boolean'
,
'headings boolean'
,
'where string'
,
'sort string'
,
'select string'
,
'delete string'
,
'colaligns string'
,
'colvaligns string'
,
'wrap integer'
,
'variables boolean'
,
);
%_loaded
= ();
%var
= ();
%macro
= ();
%export
= ();
%page_hf
= ();
%_class
= ();
%obj_name
= ();
%obj_long
= ();
@_file_info
= ();
%subsection_prefix
= ();
@evcode_paragraph
= ();
@evmask_paragraph
= ();
@evid_paragraph
= ();
@evcode_phrase
= ();
@evmask_phrase
= ();
@evid_phrase
= ();
@evcode_variable
= ();
@evmask_variable
= ();
@evid_variable
= ();
@evcode_macro
= ();
@evmask_macro
= ();
@evid_macro
= ();
@evcode_filter
= ();
@evmask_filter
= ();
@evid_filter
= ();
@evcode_table
= ();
@evmask_table
= ();
@evid_table
= ();
%restricted
= ();
%readonly
= ();
sub
InitMacros {
local
(
$name
);
%_loaded
= ();
%var
= ();
%macro
= ();
%export
= ();
%page_hf
= ();
%_class
= ();
%obj_name
= ();
%obj_long
= ();
@_file_info
= ();
%subsection_prefix
= ();
@evcode_paragraph
= ();
@evmask_paragraph
= ();
@evid_paragraph
= ();
@evcode_phrase
= ();
@evmask_phrase
= ();
@evid_phrase
= ();
@evcode_variable
= ();
@evmask_variable
= ();
@evid_variable
= ();
@evcode_macro
= ();
@evmask_macro
= ();
@evid_macro
= ();
@evcode_filter
= ();
@evmask_filter
= ();
@evid_filter
= ();
@evcode_table
= ();
@evmask_table
= ();
@evid_table
= ();
%readonly
= ();
%restricted
= ();
for
$name
(
keys
%'sdf_target) {
$name
=~
tr
/a-z/A-Z/;
$restricted
{
$name
} = 1;
}
}
sub
_PageHF {
local
(
$type
,
$overwrite
,
$component
,
*pages
,
*parts
) =
@_
;
local
(
@result
);
local
(
$page
,
$comp_page
);
local
(
$mac_name
,
$mac_value
,
%mac_parts
);
local
(
$line
,
$first
,
$last
);
local
(
$posn
,
@posns
);
local
(
$sep
,
$part
,
$varname
);
for
$page
(
@pages
) {
$comp_page
=
$component
ne
''
?
"\U${component}_$page"
:
"\U$page"
;
$mac_name
=
"PAGE_${comp_page}_$type"
;
if
(
$overwrite
) {
%mac_parts
=
%parts
;
}
else
{
%mac_parts
= &'SdfAttrSplit(
$page_hf
{
$comp_page
});
@mac_parts
{
keys
%parts
} =
values
%parts
;
}
$page_hf
{
$comp_page
} = &'SdfAttrJoin(
*mac_parts
);
$first
= 1;
$last
=
$var
{
'OPT_HEADINGS'
};
if
(
$type
eq
'HEADER'
) {
$last
= 2
if
$last
> 2;
}
elsif
(
$last
> 3) {
$first
--;
$last
--;
}
@posns
=
"\U$page"
eq
'LEFT'
?
(
'outer'
,
'center'
,
'inner'
) :
(
'inner'
,
'center'
,
'outer'
);
$mac_value
=
$last
>= 3 ?
"${type}[size='7pt']"
:
"$type:"
;
$sep
=
''
;
for
$line
(
$first
..
$last
) {
for
$posn
(
@posns
) {
$part
=
$posn
.
$line
;
$varname
=
$mac_name
.
"_\U$part"
;
$var
{
$varname
} =
$mac_parts
{
$part
};
$var
{
$varname
} =
''
unless
defined
$var
{
$varname
};
$mac_value
.=
$sep
.
'[['
.
$varname
.
']]'
;
$sep
=
'[[tab]]'
;
}
$sep
=
'[[nl]]'
;
}
push
(
@result
,
"!macro $mac_name"
,
$mac_value
,
"!endmacro"
);
}
return
@result
;
}
sub
_EventFind {
local
(
*stack
,
$name
) =
@_
;
local
(
$index
);
for
(
$index
=
$#stack
;
$index
>= 0;
$index
--) {
return
$index
if
$stack
[
$index
] eq
$name
;
}
return
-1;
}
sub
_ClassHandler {
local
(
$class
,
*rules
,
*text
,
%param
) =
@_
;
local
(
@tbl
,
@flds
,
$rec
,
%values
);
local
(
$name_style
,
$name_fld
,
$long_fld
);
local
(
$process
);
local
(
@out_fields
,
@out_styles
,
$out_values
);
local
(
$field
,
$style
,
$value
);
local
(
$root
);
local
(
$name
,
$long
,
$jump
);
local
(
$params
);
local
(
$tbl_style
);
local
(
$view
);
local
(
$make_vars
,
$var_name
);
@tbl
= &'TableParse(
@text
);
@text
= ();
&'TableValidate(
*tbl
,
*rules
);
$name_style
=
$_class
{
$class
,
'name_style'
};
$name_fld
=
$_class
{
$class
,
'name_fld'
};
$long_fld
=
$_class
{
$class
,
'long_fld'
};
if
(
$param
{
'data'
}) {
$process
=
'data'
;
}
elsif
(
$param
{
'cited'
}) {
$process
=
'cited'
;
}
else
{
$process
=
'display'
;
}
$make_vars
=
$param
{
'variables'
};
$var_name
=
''
;
@out_fields
= ();
@out_styles
= ();
if
(
$process
eq
'display'
) {
if
(
$param
{
'columns'
}) {
for
$field
(
split
(/,/,
$param
{
'columns'
})) {
if
(
$field
=~ /^(\w+):(.+)$/) {
push
(
@out_fields
, $2);
push
(
@out_styles
, $1);
}
else
{
push
(
@out_fields
,
$field
);
push
(
@out_styles
,
''
);
}
}
}
else
{
@out_fields
= (
$name_fld
,
$long_fld
);
@out_styles
= (
$name_style
,
''
);
}
}
(
@flds
) = &'TableFields(
shift
@tbl
);
$root
=
$param
{
'root'
};
for
$rec
(
@tbl
) {
if
(
$rec
=~ /^!/) {
push
(
@text
,
$rec
);
next
;
}
%values
= &'TableRecSplit(
*flds
,
$rec
);
$name
=
$values
{
$name_fld
};
$long
=
$values
{
$long_fld
};
$long
=
$obj_name
{
$class
,
$name
,
$long_fld
}
if
$long
eq
''
;
$jump
=
$values
{
'Jump'
};
$jump
=
$root
.
$jump
if
$jump
ne
''
;
$jump
=
$obj_name
{
$class
,
$name
,
'Jump'
}
if
$jump
eq
''
;
if
(
$make_vars
) {
$var_name
=
$name
;
$var_name
=~ s/\W/_/g;
}
$values
{
'Jump'
} =
$jump
;
push
(
@text
,
"!_store_ "
.
join
(
"\000"
,
$class
,
$process
ne
'data'
,
$name_fld
,
$name
,
$long_fld
,
$long
,
%values
));
push
(
@text
,
"!define $var_name '{{$name_style:$name}}'"
)
if
$var_name
ne
''
;
if
(
$process
eq
'display'
) {
if
(
$long_fld
&&
$long
eq
''
&&
$jump
eq
''
) {
&
'AppMsg("warning", "unknown object '
$name
' in class '
$class
'");
}
@out_values
= ();
for
(
$i
= 0;
$i
<=
$#out_fields
;
$i
++) {
$field
=
$out_fields
[
$i
];
$style
=
$out_styles
[
$i
];
if
(
$field
=~ /^(\w+)\&/) {
$field
= $1;
$view
= $';
}
else
{
$view
=
''
;
}
if
(
$field
eq
$name_fld
) {
$value
=
$name
;
}
elsif
(
$field
eq
$long_fld
) {
$value
=
$long
;
}
elsif
(
defined
(
$values
{
$field
})) {
$value
=
$values
{
$field
};
}
else
{
my
$ok_class
=
$class
;
$ok_class
=~ s/['\\]/\\$&/g;
my
$ok_name
=
$name
;
$ok_name
=~ s/['\\]/\\$&/g;
my
$ok_field
=
$field
;
$ok_field
=~ s/['\\]/\\$&/g;
my
$ok_view
=
$view
;
$ok_view
=~ s/['\\]/\\$&/g;
$value
=
"[[&Value('$ok_class', '$ok_name', '$ok_field', '$ok_view')]]"
;
}
if
(
$style
ne
''
) {
if
(
defined
(
$var
{
"FORMAT_$style"
})) {
if
(
substr
(
$value
, 0, 2) eq
'[['
) {
$value
=
"[[$style:"
.
substr
(
$value
, 2);
}
else
{
$value
=
"[[$style:$value]]"
;
}
}
else
{
$params
=
$view
?
"[view='$view']"
:
":"
;
$value
=
"{{$style$params$value}}"
;
}
}
push
(
@out_values
,
$value
);
}
push
(
@text
,
join
(
"~"
,
@out_values
));
}
}
my
$fields_heading
=
join
(
"~"
,
@out_fields
);
$fields_heading
=~
tr
/&/_/;
if
(
$process
eq
'display'
) {
$tbl_style
=
$param
{
'style'
} ?
$param
{
'style'
} :
'plain'
;
$params
=
"style='$tbl_style'"
;
$params
.=
"; cellpadding=0; cellspacing=0"
if
$param
{
'compact'
};
$params
.=
"; wide"
if
$param
{
'wide'
};
$params
.=
"; noheadings"
unless
$param
{
'headings'
};
$params
.=
"; where='$param{'where'}'"
if
$param
{
'where'
} ne
''
;
$params
.=
"; sort='$param{'sort'}'"
if
$param
{
'sort'
} ne
''
;
$params
.=
"; select='$param{'select'}'"
if
$param
{
'select'
} ne
''
;
$params
.=
"; delete='$param{'delete'}'"
if
$param
{
'delete'
} ne
''
;
$params
.=
"; colaligns='$param{'colaligns'}'"
if
$param
{
'colaligns'
} ne
''
;
$params
.=
"; colvaligns='$param{'colvaligns'}'"
if
$param
{
'colvaligns'
} ne
''
;
$params
.=
"; wrap='$param{'wrap'}'"
if
$param
{
'wrap'
} ne
''
;
unshift
(
@text
,
"!block table; $params"
,
$fields_heading
);
push
(
@text
,
"!endblock"
);
}
}
sub
_ObjectNameEP {
local
(
$class
,
$long_style
,
$long_fld
) =
@_
;
if
(!
$obj_name
{
$class
,
$text
}) {
&
'AppMsg("warning", "unknown object '
$text
' in class '
$class
' (name EP)");
}
if
(
$attr
{
'jump'
} eq
''
&&
defined
$obj_name
{
$class
,
$text
,
'Jump'
}) {
$attr
{
'jump'
} =
$obj_name
{
$class
,
$text
,
'Jump'
};
}
if
(
$attr
{
'expand'
}) {
delete
$attr
{
'expand'
};
if
(
$long_fld
&&
$obj_name
{
$class
,
$text
,
$long_fld
} ne
''
) {
$style
=
$long_style
if
$long_style
ne
''
;
$text
=
$obj_name
{
$class
,
$text
,
$long_fld
};
}
else
{
&
'AppMsg("warning", "unable to expand object '
$text
' in class '
$class
'");
}
}
elsif
(
$attr
{
'cite'
}) {
delete
$attr
{
'cite'
};
$style
=
'N'
;
$text
=
&Value
(
$class
,
$text
,
'Cite'
,
$attr
{
'view'
});
}
}
sub
_ObjectLongEP {
local
(
$class
,
$name_style
,
$name_fld
) =
@_
;
if
(!
$obj_long
{
$class
,
$text
}) {
&
'AppMsg("warning", "unknown object '
$text
' in class '
$class
' (long EP)");
}
if
(
$attr
{
'jump'
} eq
''
&&
defined
$obj_long
{
$class
,
$text
,
'Jump'
}) {
$attr
{
'jump'
} =
$obj_long
{
$class
,
$text
,
'Jump'
};
}
if
(
$attr
{
'shrink'
}) {
delete
$attr
{
'shrink'
};
if
(
$obj_long
{
$class
,
$text
,
$name_fld
} ne
''
) {
$style
=
$name_style
;
$text
=
$obj_long
{
$class
,
$text
,
$name_fld
};
}
else
{
&
'AppMsg("warning", "unable to shrink object '
$text
' in class '
$class
'");
}
}
elsif
(
$attr
{
'cite'
}) {
delete
$attr
{
'cite'
};
$style
=
'N'
;
$text
=
&Value
(
$class
,
$text
,
'Cite'
,
$attr
{
'view'
});
}
}
@_block_MacroArgs
= (
'Name Type Default Rule'
,
'filter filter'
,
'params rest _NULL_'
,
);
sub
block_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
$
'sdf_block_start = $'
app_lineno;
$
'sdf_block_type = '
block';
@'sdf_block_text = ();
%'sdf_block_arg =
%arg
;
return
();
}
@_endblock_MacroArgs
= ();
sub
endblock_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
if
($
'sdf_block_type ne '
block') {
&'AppMsg(
"error"
,
"endblock macro not expected"
);
return
();
}
$
'sdf_block_type = '
';
&ExecFilter
($
'sdf_block_arg{'
filter
'}, *'
sdf_block_text,
$
'sdf_block_arg{'
params
'}, $'
sdf_block_start, $
'ARGV, '
filter on ');
if
(@'sdf_block_text) {
unshift
(@'sdf_block_text,
"!_bos_ $'sdf_block_start;block on "
);
push
(@
'sdf_block_text, "!_eos_ $'
app_lineno;$'app_context");
}
return
@'sdf_block_text;
}
@_include_MacroArgs
= (
'Name Type Default Rule'
,
'filename string'
,
'filter filter _NULL_'
,
'params rest _NULL_'
,
);
sub
include_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$filename
,
$fullname
);
local
(
$outfile
);
$filename
=
$arg
{
'filename'
};
$fullname
=
&FindFile
(
$filename
);
if
(
$fullname
eq
''
) {
&
'AppMsg("warning", "unable to find '
$filename
'");
return
();
}
unless
(
&FileFetch
(
*text
,
$fullname
)) {
&
'AppMsg("warning", "unable to read '
$fullname
'");
return
();
}
&ExecFilter
(
$arg
{
'filter'
},
*text
,
$arg
{
'params'
});
return
(
"!_bof_ '$fullname'"
,
@text
,
"!_eof_"
);
}
@_use_MacroArgs
= (
'Name Type Default Rule'
,
'filename string'
,
'filter filter sdf'
,
'params rest _NULL_'
,
);
sub
use_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$filename
,
$fullname
);
$filename
=
$arg
{
'filename'
};
$filename
.=
".sdm"
unless
$filename
=~ /\.\w+$/;
$fullname
=
&FindModule
(
$filename
);
if
(
$fullname
eq
''
) {
&
'AppMsg("warning", "unable to find '
$filename
'");
return
();
}
return
()
if
$_loaded
{
$fullname
};
unless
(
&FileFetch
(
*text
,
$fullname
)) {
&
'AppMsg("warning", "unable to read '
$fullname
'");
return
();
}
$_loaded
{
$fullname
} = 1;
&ExecFilter
(
$arg
{
'filter'
},
*text
,
$arg
{
'params'
});
return
(
"!_bof_ '$fullname'"
,
@text
,
"!_eof_"
);
}
@_inherit_MacroArgs
= (
'Name Type Default Rule'
,
'library string'
,
);
sub
inherit_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$library
,
$dos_library
);
local
(
$module
);
$library
=
$arg
{
'library'
};
$dos_library
=
$library
;
$dos_library
=~ s
$module
= (&'NameSplit(
$library
))[1];
if
(-f
"$module.sdm"
) {
$library
=
'.'
;
}
elsif
(&'NameIsAbsolute(
$library
)) {
push
(
@include_path
,
$library
);
push
(
@module_path
,
$library
);
$var
{
'HLP_OPTIONS_ROOT'
} .=
", $dos_library"
;
}
else
{
my
$lib_dir
=
&FindLibrary
(
$library
);
if
(
$lib_dir
ne
''
) {
push
(
@include_path
,
$lib_dir
);
push
(
@module_path
,
$lib_dir
);
$var
{
'HLP_OPTIONS_ROOT'
} .=
", $var{'SDF_DOSHOME'}\\$dos_library"
;
}
else
{
&
'AppMsg("warning", "unable to find library '
$library
'");
return
();
}
}
@text
= (
"!use '$library/$module'"
);
return
@text
;
}
@_execute_MacroArgs
= (
'Name Type Default Rule'
,
'cmd string'
,
'filter filter sdf'
,
'params rest _NULL_'
,
);
sub
execute_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$cmd
);
$cmd
=
$arg
{
'cmd'
};
unless
(
&FileFetch
(
*text
,
"$cmd|"
)) {
&
'AppMsg("error", "failed to execute '
$cmd
'");
return
();
}
&ExecFilter
(
$arg
{
'filter'
},
*text
,
$arg
{
'params'
});
return
(
"!_bof_ '$cmd'"
,
@text
,
"!_eof_"
);
}
@_import_MacroArgs
= (
'Name Type Default Rule'
,
'filename string'
,
'params rest _NULL_'
,
);
sub
import_Macro {
local
(
%arg
) =
@_
;
local
(
$filename
);
local
(
%params
);
$filename
=
$arg
{
'filename'
};
%params
= &
'SdfAttrSplit($arg{'
params'});
&ProcessImageAttrs
(
*filename
,
*params
);
return
(&
'SdfJoin('
__import',
$filename
,
%params
));
}
@_jumps_MacroArgs
= (
'Name Type Default Rule'
,
'labels string'
,
'layout string Center <Left|Center|Right|left|center|right>'
,
);
sub
jumps_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
@subs
,
$sub
,
$jump
);
local
(
$sep
);
local
(
$layout
);
@subs
=
split
(/,/,
$arg
{
'labels'
});
$sep
=
''
;
for
$sub
(
@subs
) {
if
(
$sub
eq
''
) {
$sub
=
"{{CHAR:nl}}"
;
$sep
=
''
;
}
else
{
$jump
=
&TextToId
(
$sub
);
$sub
=
$sep
.
"{{[jump='#$jump']$sub}}"
;
$sep
=
' | '
;
}
}
@text
= ();
$layout
=
$arg
{
'layout'
};
substr
(
$layout
, 0, 1) =~
tr
/a-z/A-Z/;
@text
= (
"[align='$layout']"
.
join
(
""
,
@subs
));
return
@text
;
}
@_subsections_MacroArgs
= (
'Name Type Default Rule'
,
'labels string'
,
'prefix string Topic <Topic|Noprefix|noprefix>'
,
'layout string Left <Left|Center|Right|None|left|center|right|none>'
,
);
sub
subsections_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
@subs
,
$sub
,
$jump
);
local
(
$prefix
);
local
(
$sep
);
local
(
$layout
);
@subs
=
split
(/,/,
$arg
{
'labels'
});
$prefix
=
''
;
if
(
$arg
{
'prefix'
} eq
'Topic'
) {
$prefix
=
$topic
ne
''
?
"$topic - "
:
''
;
}
$sep
=
''
;
for
$sub
(
@subs
) {
if
(
$sub
eq
''
) {
$sub
=
"{{CHAR:nl}}"
;
$sep
=
''
;
}
else
{
$subsection_prefix
{
$sub
} =
$prefix
;
$jump
=
&TextToId
(
$prefix
.
$sub
);
$sub
=
$sep
.
"{{[jump='#$jump']$sub}}"
;
$sep
=
' | '
;
}
}
@text
= ();
if
(
$var
{
'OPT_TARGET'
} eq
'html'
) {
$layout
=
$arg
{
'layout'
};
substr
(
$layout
, 0, 1) =~
tr
/a-z/A-Z/;
if
(
$layout
ne
'None'
) {
@text
= (
"[align='$layout']"
.
join
(
""
,
@subs
));
}
}
return
@text
;
}
@_continued_MacroArgs
= (
'Name Type Default Rule'
,
'style string'
,
'suffix string , {{N:Continued}}'
,
);
sub
continued_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$target
);
local
(
$style
,
$suffix
);
$target
=
$var
{
'OPT_TARGET'
};
if
(
$target
eq
'html'
||
$target
eq
'hlp'
) {
@text
= ();
}
else
{
$style
=
$arg
{
'style'
};
$suffix
=
$arg
{
'suffix'
};
@text
=
$style
.
"[notoc;noid;continued][[&Previous($style)]]$suffix"
;
}
return
@text
;
}
@_clear_MacroArgs
= (
'Name Type Default Rule'
,
'type string All <Left|Right|All>'
,
);
sub
clear_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
if
(
$var
{
'OPT_TARGET'
} eq
'html'
) {
@text
= (
"!block inline"
,
"<BR CLEAR=\""
.
$arg
{
'type'
} .
'">'
,
"!endblock"
);
}
else
{
@text
= ();
}
return
@text
;
}
@_catalog_MacroArgs
= (
'Name Type Default Rule'
,
'class symbol'
,
'mask string'
,
'params rest _NULL_'
,
);
sub
catalog_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$class
,
$name_fld
);
local
(
$object
,
$mask
);
$class
=
$arg
{
'class'
};
$name_fld
=
$_class
{
$class
,
'name_fld'
};
@text
= (
"!block $class; $arg{'params'}"
,
$name_fld
);
$mask
=
$arg
{
'mask'
};
if
(
$mask
eq
'cited'
) {
for
$object
(
split
(
"\n"
,
$_class
{
$class
,
'cited'
})) {
push
(
@text
,
$object
);
}
}
elsif
(
$mask
=~ /^(\w+):/) {
my
$attr
= $1;
$mask
= $';
my
$value
;
for
$object
(
split
(
"\n"
,
$_class
{
$class
,
'catalog'
})) {
$value
=
&Value
(
$class
,
$object
,
$attr
);
next
if
$mask
ne
''
&&
$value
!~ /^
$mask
$/;
push
(
@text
,
$object
);
}
}
else
{
for
$object
(
split
(
"\n"
,
$_class
{
$class
,
'catalog'
})) {
next
if
$mask
ne
''
&&
$object
!~ /^
$mask
$/;
push
(
@text
,
$object
);
}
}
push
(
@text
,
"!endblock"
);
return
@text
;
}
@_namevalues_MacroArgs
= (
'Name Type Default Rule'
,
'class string'
,
'object string'
,
'attributes string'
,
'params rest _NULL_'
,
);
sub
namevalues_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$class
,
$object
,
@attrs
,
$attr
);
$class
=
$arg
{
'class'
};
$object
=
$arg
{
'object'
};
@attrs
=
sort
split
(/,/,
$arg
{
'attributes'
});
@text
= (
"!block namevalues; $arg{'params'}"
,
"Name|Value"
);
for
$attr
(
@attrs
) {
push
(
@text
,
"$attr:|"
.
&Value
(
$class
,
$object
,
$attr
));
}
push
(
@text
,
"!endblock"
);
return
@text
;
}
@_define_MacroArgs
= (
'Name Type Default Rule'
,
'name symbol'
,
'value string 1'
,
);
sub
define_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$name
,
$value
);
local
(
$type
,
$rule
);
$name
=
$arg
{
'name'
};
$value
=
$arg
{
'value'
};
if
(
$name
=~ /^([A-Z]+)_/ &&
$restricted
{$1} &&
!
$variables_name
{
$name
}) {
$status
= (
defined
(
$var
{
$name
}) ||
$readonly
{$1}) ?
'read-only'
:
'unknown'
;
&
'AppMsg("warning", "'
$1
' variable '
$name
' is
$status
- ignoring definition");
return
();
}
if
(
$variables_name
{
$name
}) {
$type
=
$variables_type
{
$name
};
$rule
=
$variables_rule
{
$name
};
unless
(&'MiscCheckRule(
$value
,
$rule
,
$type
)) {
&
'AppMsg("warning", "bad value '
$value
' for variable '
$name
'");
}
}
$var
{
$name
} =
$value
;
if
(
$export
{
$name
}) {
@text
= (&
'SdfJoin('
__object
', '
Variable',
'Name'
,
$name
,
'value'
,
$value
));
}
return
(
@text
);
}
@_default_MacroArgs
= (
'Name Type Default Rule'
,
'name symbol'
,
'value string 1'
,
);
sub
default_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$name
);
$name
=
$arg
{
'name'
};
&define_Macro
(
%arg
)
unless
defined
(
$var
{
$name
});
return
();
}
@_undef_MacroArgs
= (
'Name Type Default Rule'
,
'name symbol'
,
);
sub
undef_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
delete
$var
{
$arg
{
'name'
}};
return
();
}
@_init_MacroArgs
= (
'Name Type Default Rule'
,
'vars rest _NULL_'
,
);
sub
init_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
%vars
,
$name
,
$value
);
%vars
= &
'SdfAttrSplit($arg{'
vars'});
for
$name
(
sort
keys
%vars
) {
$value
=
$vars
{
$name
};
$value
=~ s/
'/\\'
/g;
push
(
@text
,
"!default $name '$value'"
);
}
return
@text
;
}
@_export_MacroArgs
= (
'Name Type Default Rule'
,
'name symbol'
,
);
sub
export_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$name
);
$name
=
$arg
{
'name'
};
$export
{
$name
} = 1;
if
(
defined
$var
{
$name
}) {
@text
= (&
'SdfJoin('
__object
', '
Variable',
'Name'
,
$name
,
'value'
,
$var
{
$name
}));
}
return
@text
;
}
@_macro_MacroArgs
= (
'Name Type Default Rule'
,
'name symbol'
,
);
sub
macro_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
$
'sdf_block_start = $'
app_lineno;
$
'sdf_block_type = '
macro';
@'sdf_block_text = ();
%'sdf_block_arg =
%arg
;
return
();
}
@_endmacro_MacroArgs
= ();
sub
endmacro_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
if
($
'sdf_block_type ne '
macro') {
&'AppMsg(
"error"
,
"endmacro macro not expected"
);
return
();
}
$
'sdf_block_type = '
';
$macro
{$
'sdf_block_arg{'
name
'}} = join("\n", @'
sdf_block_text);
return
();
}
@_class_MacroArgs
= (
'Name Type Default Rule'
,
'name symbol'
,
'styles string'
,
'ids string Name,Long'
,
'properties string Jump'
,
);
sub
class_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$name
);
local
(
$name_style
,
$long_style
);
local
(
$name_fld
,
$long_fld
);
local
(
$fld
,
@rest
,
@rules
);
local
(
$code
);
$name
=
$arg
{
'name'
};
(
$name_style
,
$long_style
) =
split
(/,/,
$arg
{
'styles'
});
(
$name_fld
,
$long_fld
) =
split
(/,/,
$arg
{
'ids'
});
$_class
{
$name
} = 1;
$_class
{
$name
,
'name_style'
} =
$name_style
;
$_class
{
$name
,
'long_style'
} =
$long_style
;
$_class
{
$name
,
'name_fld'
} =
$name_fld
;
$_class
{
$name
,
'long_fld'
} =
$long_fld
;
$_class
{
$name
,
'properties'
} =
$arg
{
'properties'
};
(
$fld
,
@rest
) =
split
(/,/,
$arg
{
'ids'
});
push
(
@rest
,
split
(/,/,
$arg
{
'properties'
}));
@rules
= (
'Field:Category:Rule'
,
"$fld:mandatory"
);
push
(
@rules
,
"$fld:optional"
)
while
(
$fld
=
shift
(
@rest
));
$code
=
<<end_of_code;
\@_${name}_FilterParams = \@_CLASS_PARAMS;
\@_${name}_FilterModel = &'TableParse(\@rules);
sub ${name}_Filter {
local(*text, %param) = \@_;
&_ClassHandler('$name', *_${name}_FilterModel, *text, %param);
}
end_of_code
eval
$code
;
if
($@) {
&'AppMsg(
"error"
,
"filter creation failed: $@"
);
}
@text
= (
"!block phrasestyles"
,
"Name"
,
$name_style
);
push
(
@text
,
$long_style
)
if
$long_style
ne
''
;
push
(
@text
,
"!endblock"
);
push
(
@text
,
"!on phrase '$name_style';;"
.
"&_ObjectNameEP('$name', '$long_style', '$long_fld')"
);
push
(
@text
,
"!on phrase '$long_style';;"
.
"&_ObjectLongEP('$name', '$name_style', '$name_fld')"
)
if
$long_style
;
return
@text
;
}
@_restrict_MacroArgs
= (
'Name Type Default Rule'
,
'name string'
,
);
sub
restrict_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
$restricted
{
$arg
{
'name'
}} = 1;
return
();
}
@_readonly_MacroArgs
= (
'Name Type Default Rule'
,
'name string'
,
);
sub
readonly_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
$readonly
{
$arg
{
'name'
}} = 1;
return
();
}
@_path_prepend_MacroArgs
= (
'Name Type Default Rule'
,
'dir string'
,
);
sub
path_prepend_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$dir
);
$dir
=
$arg
{
'dir'
};
unshift
(
@include_path
,
$dir
)
unless
$include_path
[0] eq
$dir
;
return
();
}
@_path_append_MacroArgs
= (
'Name Type Default Rule'
,
'dir string'
,
);
sub
path_append_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$dir
);
$dir
=
$arg
{
'dir'
};
push
(
@include_path
,
$dir
)
unless
$include_path
[
$#include_path
] eq
$dir
;
return
();
}
@_script_MacroArgs
= (
'Name Type Default Rule'
,
'code rest'
,
);
sub
script_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
eval
$arg
{
'code'
};
if
($@) {
&'AppMsg(
"error"
,
"script failed: $@"
);
}
return
();
}
@_targetobject_MacroArgs
= (
'Name Type Default Rule'
,
'type string'
,
'name string'
,
'parent string _NULL_'
,
'attributes rest _NULL_'
,
);
sub
targetobject_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$type
,
$name
,
$parent
,
$attrs
);
$type
=
$arg
{
'type'
};
$name
=
$arg
{
'name'
};
$parent
=
$arg
{
'parent'
};
$attrs
=
$arg
{
'attributes'
};
return
(
"__object[Name='$name';Parent='$parent';$attrs]$type"
);
}
@_div_MacroArgs
= (
'Name Type Default Rule'
,
'name symbol'
,
);
sub
div_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
return
(&
'SdfJoin("__div", $arg{'
name'}, ()));
}
@_enddiv_MacroArgs
= ();
sub
enddiv_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
return
(&'SdfJoin(
"__enddiv"
,
""
, ()));
}
@_if_MacroArgs
= (
'Name Type Default Rule'
,
'value condition'
,
);
sub
if_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$expr_value
);
push
(@
'sdf_if_start, $'
app_lineno);
if
(@
'sdf_if_now && ! $'
sdf_if_now[
$#main
'sdf_if_now]) {
push
(@'sdf_if_now, 0);
push
(@'sdf_if_yet, 1);
push
(@'sdf_if_else, 0);
}
else
{
$expr_value
=
$arg
{
'value'
};
push
(@'sdf_if_now,
$expr_value
);
push
(@'sdf_if_yet,
$expr_value
);
push
(@'sdf_if_else, 0);
}
return
();
}
@_elsif_MacroArgs
= (
'Name Type Default Rule'
,
'value condition'
,
);
sub
elsif_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$level
);
local
(
$expr_value
);
unless
(@'sdf_if_now) {
&'AppMsg(
"error"
,
"!elsif not expected"
);
return
();
}
$level
=
$#main
'sdf_if_yet;
if
($'sdf_if_else[
$level
]) {
&'AppMsg(
"error"
,
"!elsif found after else macro"
);
return
();
}
if
(! $'sdf_if_yet[
$level
]) {
$expr_value
=
$arg
{
'value'
};
$'sdf_if_now[
$level
] =
$expr_value
;
$'sdf_if_yet[
$level
] =
$expr_value
;
}
else
{
$'sdf_if_now[
$level
] = 0;
}
return
();
}
@_elseif_MacroArgs
=
@_elsif_MacroArgs
;
sub
elseif_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
return
&elsif_Macro
(
%arg
);
}
@_else_MacroArgs
= ();
sub
else_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$level
);
unless
(@'sdf_if_now) {
&'AppMsg(
"error"
,
"!else not expected"
);
return
();
}
$level
=
$#main
'sdf_if_yet;
$'sdf_if_else[
$level
] = 1;
if
(! $'sdf_if_yet[
$level
]) {
$'sdf_if_now[
$level
] = 1;
$'sdf_if_yet[
$level
] = 1;
}
else
{
$'sdf_if_now[
$level
] = 0;
}
return
();
}
@_endif_MacroArgs
= ();
sub
endif_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
unless
(@'sdf_if_now) {
&'AppMsg(
"error"
,
"!endif not expected"
);
return
();
}
pop
(@'sdf_if_start);
pop
(@'sdf_if_now);
pop
(@'sdf_if_yet);
pop
(@'sdf_if_else);
return
();
}
@_for_MacroArgs
= (
'Name Type Default Rule'
,
'name symbol'
,
'values rest'
,
);
sub
for_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
return
();
}
@_endfor_MacroArgs
= ();
sub
endfor_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
@text
= ();
return
@text
;
}
@_table_MacroArgs
= (
'Name Type Default Rule'
,
'columns integer'
,
'params rest _NULL_'
,
);
sub
table_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
@format
,
$format
);
local
(
$lower
,
$sep
,
$upper
);
local
(
%param
);
local
(
$col
,
$unspecified
);
push
(@'sdf_tbl_state, 1);
push
(@
'sdf_tbl_start, $'
app_lineno);
%param
=
&SdfTableParams
(
'table'
,
$arg
{
'params'
},
*tableparams_name
,
*tableparams_type
,
*tableparams_rule
);
$param
{
'style'
} =
&Var
(
'DEFAULT_TABLE_STYLE'
)
if
$param
{
'style'
} eq
''
;
@format
= ();
if
(
$param
{
'format'
} =~ /^\d+$/) {
for
$format
(
split
(//,
$param
{
'format'
})) {
push
(
@format
,
$format
* 10 .
"%"
);
}
}
else
{
for
$format
(
split
(/\s*,\s*/,
$param
{
'format'
})) {
if
(
$format
=~ /^\d+$/) {
$format
.=
'%'
;
}
elsif
(
$format
eq
'*'
) {
$format
=
"1*"
;
}
elsif
(
$format
=~ /([-=])/) {
$lower
= $` eq
''
?
'0%'
: $`;
$sep
= $1;
$upper
= $
' eq '
' ? '
100%
' : $'
;
$lower
.=
'%'
if
$lower
=~ /^\d+$/;
$upper
.=
'%'
if
$upper
=~ /^\d+$/;
$format
=
"$lower$sep$upper"
;
}
push
(
@format
,
$format
);
}
}
$unspecified
=
$param
{
'narrow'
} ?
'0%-100%'
:
'1*'
;
for
(
$col
=
$arg
{
'columns'
} - 1;
$col
>= 0;
$col
--) {
if
(
$format
[
$col
] eq
''
) {
$format
[
$col
] =
$unspecified
;
$unspecified
=
'0%-100%'
;
}
}
$param
{
'format'
} =
join
(
","
,
@format
);
delete
$param
{
'narrow'
};
@text
= (&
'SdfJoin("__table", $arg{'
columns'},
%param
));
return
@text
;
}
@_row_MacroArgs
= (
'Name Type Default Rule'
,
'type string Body <Body|Heading|Footing|Group>'
,
'params rest _NULL_'
,
);
sub
row_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
%param
);
unless
(@'sdf_tbl_state) {
&'AppMsg(
"error"
,
"!row not expected"
);
return
();
}
return
(
'__row[]Body'
)
unless
$arg
{
'type'
}.
$arg
{
'params'
};
%param
=
&SdfTableParams
(
'row'
,
$arg
{
'params'
},
*rowparams_name
,
*rowparams_type
,
*rowparams_rule
);
@text
= (&
'SdfJoin("__row", $arg{'
type'},
%param
));
return
@text
;
}
@_cell_MacroArgs
= (
'Name Type Default Rule'
,
'params rest _NULL_'
,
);
sub
cell_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
%param
);
unless
(@'sdf_tbl_state) {
&'AppMsg(
"error"
,
"!cell not expected"
);
return
();
}
return
(
'__cell[]'
)
if
$arg
{
'params'
} eq
''
;
%param
=
&SdfTableParams
(
'cell'
,
$arg
{
'params'
},
*cellparams_name
,
*cellparams_type
,
*cellparams_rule
);
@text
= (&
'SdfJoin("__cell", '
',
%param
));
return
@text
;
}
@_endtable_MacroArgs
= ();
sub
endtable_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
unless
(@'sdf_tbl_state) {
&'AppMsg(
"error"
,
"!endtable not expected"
);
return
();
}
pop
(@'sdf_tbl_state);
pop
(@'sdf_tbl_start);
@text
= (&
'SdfJoin("__endtable", '
'));
return
@text
;
}
@_build_header_MacroArgs
= (
'Name Type Default Rule'
,
'pages string'
,
'component string _NULL_'
,
'parts rest _NULL_'
,
);
sub
build_header_Macro {
local
(
%arg
) =
@_
;
local
(
@pages
,
%parts
);
@pages
=
split
(/,/,
$arg
{
'pages'
});
%parts
= &
'SdfAttrSplit($arg{'
parts'});
return
&_PageHF
(
'HEADER'
, 1,
$arg
{
'component'
},
*pages
,
*parts
);
}
@_build_footer_MacroArgs
= (
'Name Type Default Rule'
,
'pages string'
,
'component string _NULL_'
,
'parts rest _NULL_'
,
);
sub
build_footer_Macro {
local
(
%arg
) =
@_
;
local
(
@pages
,
%parts
);
@pages
=
split
(/,/,
$arg
{
'pages'
});
%parts
= &
'SdfAttrSplit($arg{'
parts'});
return
&_PageHF
(
'FOOTER'
, 1,
$arg
{
'component'
},
*pages
,
*parts
);
}
@_edit_header_MacroArgs
= (
'Name Type Default Rule'
,
'pages string'
,
'component string _NULL_'
,
'parts rest _NULL_'
,
);
sub
edit_header_Macro {
local
(
%arg
) =
@_
;
local
(
@pages
,
%parts
);
@pages
=
split
(/,/,
$arg
{
'pages'
});
%parts
= &
'SdfAttrSplit($arg{'
parts'});
return
&_PageHF
(
'HEADER'
, 0,
$arg
{
'component'
},
*pages
,
*parts
);
}
@_edit_footer_MacroArgs
= (
'Name Type Default Rule'
,
'pages string'
,
'component string _NULL_'
,
'parts rest _NULL_'
,
);
sub
edit_footer_Macro {
local
(
%arg
) =
@_
;
local
(
@pages
,
%parts
);
@pages
=
split
(/,/,
$arg
{
'pages'
});
%parts
= &
'SdfAttrSplit($arg{'
parts'});
return
&_PageHF
(
'FOOTER'
, 0,
$arg
{
'component'
},
*pages
,
*parts
);
}
@_getdoc_MacroArgs
=
@_include_MacroArgs
;
sub
getdoc_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
return
&CommandMacro
(
"sdfget -r -g"
,
%arg
);
}
@_getcode_MacroArgs
=
@_include_MacroArgs
;
sub
getcode_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
return
&CommandMacro
(
"sdfget -i -g"
,
%arg
);
}
@_getusage_MacroArgs
= (
'Name Type Default Rule'
,
'command string'
,
'filter filter _NULL_'
,
'params rest _NULL_'
,
);
sub
getusage_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
my
$command
=
$arg
{
'command'
};
unless
(
&FileFetch
(
*text
,
"sdfcli $command|"
)) {
&
'AppMsg("warning", "unable to execute sdfcli on '
$command
'");
return
();
}
&ExecFilter
(
$arg
{
'filter'
},
*text
,
$arg
{
'params'
});
return
(
"!_bof_ 'sdfcli $command'"
,
@text
,
"!_eof_"
);
}
@_perlapi_MacroArgs
=
@_include_MacroArgs
;
sub
perlapi_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
return
&CommandMacro
(
'sdfapi -j'
,
%arg
);
}
@_on_MacroArgs
= (
'Name Type Default Rule'
,
'type symbol <paragraph|phrase|macro|filter|table>'
,
'mask string'
,
'id eventid _NULL_ <\w+>'
,
'code rest'
,
);
sub
on_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$type
);
$type
=
$arg
{
'type'
};
if
(
$type
eq
'paragraph'
) {
push
(
@evcode_paragraph
,
$arg
{
'code'
});
push
(
@evmask_paragraph
,
$arg
{
'mask'
});
push
(
@evid_paragraph
,
$arg
{
'id'
});
}
elsif
(
$type
eq
'phrase'
) {
push
(
@evcode_phrase
,
$arg
{
'code'
});
push
(
@evmask_phrase
,
$arg
{
'mask'
});
push
(
@evid_phrase
,
$arg
{
'id'
});
}
elsif
(
$type
eq
'macro'
) {
push
(
@evcode_macro
,
$arg
{
'code'
});
push
(
@evmask_macro
,
$arg
{
'mask'
});
push
(
@evid_macro
,
$arg
{
'id'
});
}
elsif
(
$type
eq
'filter'
) {
push
(
@evcode_filter
,
$arg
{
'code'
});
push
(
@evmask_filter
,
$arg
{
'mask'
});
push
(
@evid_filter
,
$arg
{
'id'
});
}
elsif
(
$type
eq
'table'
) {
push
(
@evcode_table
,
$arg
{
'code'
});
push
(
@evmask_table
,
$arg
{
'mask'
});
push
(
@evid_table
,
$arg
{
'id'
});
}
return
();
}
@_off_MacroArgs
= (
'Name Type Default Rule'
,
'type symbol <paragraph|phrase|macro|filter|table>'
,
'id eventid <\w+>'
,
);
sub
off_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$type
,
$id
,
$num
);
$type
=
$arg
{
'type'
};
$id
=
$arg
{
'id'
};
if
(
$type
eq
'paragraph'
) {
$num
=
&_EventFind
(
*evid_paragraph
,
$id
);
if
(
$num
!= -1) {
$evcode_paragraph
[
$num
] =
''
;
$evid_paragraph
[
$num
] =
''
;
}
}
elsif
(
$type
eq
'phrase'
) {
$num
=
&_EventFind
(
*evid_phrase
,
$id
);
if
(
$num
!= -1) {
$evcode_phrase
[
$num
] =
''
;
$evid_phrase
[
$num
] =
''
;
}
}
elsif
(
$type
eq
'macro'
) {
$num
=
&_EventFind
(
*evid_macro
,
$id
);
if
(
$num
!= -1) {
$evcode_macro
[
$num
] =
''
;
$evid_macro
[
$num
] =
''
;
}
}
elsif
(
$type
eq
'filter'
) {
$num
=
&_EventFind
(
*evid_filter
,
$id
);
if
(
$num
!= -1) {
$evcode_filter
[
$num
] =
''
;
$evid_filter
[
$num
] =
''
;
}
}
elsif
(
$type
eq
'table'
) {
$num
=
&_EventFind
(
*evid_table
,
$id
);
if
(
$num
!= -1) {
$evcode_table
[
$num
] =
''
;
$evid_table
[
$num
] =
''
;
}
}
if
(
$num
== -1) {
&
'AppMsg("warning", "unknown event '
$id
'");
}
return
();
}
@_insert_MacroArgs
= (
'Name Type Default Rule'
,
'macro string'
,
'missing string ok <ok|error|warning>'
,
);
sub
insert_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$name
,
$args
);
(
$name
,
$args
) =
split
(/\s+/,
$arg
{
'macro'
}, 2);
return
&ExecMacro
(
$name
,
$args
,
$arg
{
'missing'
});
}
@_output_MacroArgs
= (
'Name Type Default Rule'
,
'outfile string'
,
);
sub
output_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
return
(
"__output[]"
.
$arg
{
'outfile'
});
}
@_message_MacroArgs
= (
'Name Type Default Rule'
,
'text string'
,
'type string Object <Object|Warning|Error|warning|error>'
,
);
sub
message_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$type
);
$type
=
"\L$arg{'type'}"
;
&
'AppMsg($type, $arg{'
text'});
return
();
}
@_line_MacroArgs
= (
'Name Type Default Rule'
,
'lineno integer'
,
'filename string _NULL_'
,
'context string line'
,
);
sub
line_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
$
'app_lineno = $arg{'
lineno'};
$
'app_context = $arg{'
context'};
$
'app_context .= " " unless $'
app_context =~ / $/;
if
(
$arg
{
'filename'
} ne
''
) {
$
'ARGV = $arg{'
filename'};
$var
{
'FILE_PATH'
} = &
'NameAbsolute($'
ARGV);
@var
{
'FILE_DIR'
,
'FILE_BASE'
,
'FILE_EXT'
,
'FILE_SHORT'
} =
&
'NameSplit($var{'
FILE_PATH'});
$var
{
'FILE_MODIFIED'
} =
$var
{
'SDF_TEST'
} ? 1e9 : (
stat
($'ARGV))[9];
$var
{
'DOC_MODIFIED'
} =
$var
{
'FILE_MODIFIED'
}
if
$var
{
'DOC_MODIFIED'
} <
$var
{
'FILE_MODIFIED'
};
if
(!
defined
$var
{
'DOC_BASE'
}) {
$var
{
'DOC_PATH'
} =
$var
{
'FILE_PATH'
};
$var
{
'DOC_DIR'
} =
$var
{
'FILE_DIR'
};
$var
{
'DOC_BASE'
} =
$var
{
'FILE_BASE'
};
$var
{
'DOC_EXT'
} =
$var
{
'FILE_EXT'
};
$var
{
'DOC_SHORT'
} =
$var
{
'FILE_SHORT'
};
}
}
return
();
}
@_macro_interface_MacroArgs
= (
'Name Type Default Rule'
,
'name string'
,
'sep_reqd string _NULL_'
,
);
sub
macro_interface_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$name
,
@arg_list
);
local
(
$format
,
@rules
);
local
(
@flds
,
$rec
,
%values
);
local
(
$sep_reqd
,
$sep
,
$arg
,
$type
);
$name
=
$arg
{
'name'
};
@text
= (
"The general syntax is:"
,
"E: !{{2:$name}}"
);
@arg_list
=
eval
"\@_${name}_MacroArgs"
;
if
(
@arg_list
) {
push
(
@text
,
""
,
"The arguments are:"
,
""
,
"!block table; format='16,16,20,48'"
,
@arg_list
,
"!endblock"
);
(
$format
,
@rules
) = &'TableParse(
@arg_list
);
@flds
= &'TableFields(
$format
);
$sep
=
''
;
$sep_reqd
=
$arg
{
'sep_reqd'
};
for
$rec
(
@rules
) {
%values
= &'TableRecSplit(
*flds
,
$rec
);
$arg
=
$values
{
'Name'
};
if
(
$sep_reqd
eq
$arg
) {
$arg
=
"$sep [$arg]"
;
}
else
{
$arg
=
"$sep $arg"
if
$sep
;
$arg
=
"[$arg]"
if
$values
{
'Default'
} ne
''
;
}
$text
[1] .=
" $arg"
;
$type
=
$values
{
'Type'
};
$sep
= (
$type
=~ /^symbol$|^rest$/) ?
''
:
';'
;
}
}
unshift
(
@text
,
"!insert 'MACRO_INTERFACE_BEGIN'"
);
push
(
@text
,
"!insert 'MACRO_INTERFACE_END'"
);
return
@text
;
}
@_filter_interface_MacroArgs
= (
'Name Type Default Rule'
,
'name string'
,
);
sub
filter_interface_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$name
,
@params
,
@fields
);
$name
=
$arg
{
'name'
};
@text
= (
"The general syntax is:"
,
"E: !block {{2:$name}}"
,
"E: ..."
,
"E: !endblock"
);
@params
=
eval
"\@_${name}_FilterParams"
;
if
(
@params
) {
$text
[1] .=
"[; parameters]"
;
if
(
$params
[0] ne
'ANY'
) {
push
(
@text
,
""
,
"The parameters are:"
,
""
,
"!block table"
,
@params
,
"!endblock"
);
}
}
@fields
=
eval
"\@_${name}_FilterModel"
;
if
(
@fields
) {
$text
[2] =~ s/\.\.\./{{table}}/;
push
(
@text
,
""
,
"The table fields are:"
,
""
,
"!block table"
,
@fields
,
"!endblock"
);
}
unshift
(
@text
,
"!insert 'FILTER_INTERFACE_BEGIN'"
);
push
(
@text
,
"!insert 'FILTER_INTERFACE_END'"
);
return
@text
;
}
@_class_interface_MacroArgs
= (
'Name Type Default Rule'
,
'name string'
,
);
sub
class_interface_Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$name
,
@fields
);
$name
=
$arg
{
'name'
};
@text
= (
"The general syntax is:"
,
"E: !block {{2:$name}}[; parameters]"
,
"E: table of objects"
,
"E: !endblock"
);
@fields
=
eval
"\@_${name}_FilterModel"
;
if
(
@fields
) {
push
(
@text
,
""
,
"The object attributes are:"
,
""
,
"!block table"
,
&'TableFormat(
*fields
),
"!endblock"
);
}
unshift
(
@text
,
"!insert 'CLASS_INTERFACE_BEGIN'"
);
push
(
@text
,
"!insert 'CLASS_INTERFACE_END'"
);
return
@text
;
}
@__bof__MacroArgs
= (
'Name Type Default Rule'
,
'filename string _NULL_'
,
);
sub
_bof__Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$new_file
);
push
(
@_file_info
,
join
(
"\000"
, $
'ARGV, $'
app_lineno, $'app_context,
scalar
(@
'sdf_if_now), scalar(@'
sdf_tbl_state)));
$new_file
=
$arg
{
'filename'
};
if
(
$new_file
ne
''
) {
@text
= (
"!line 0; '$new_file'"
);
}
return
(
@text
);
}
@__eof__MacroArgs
= ();
sub
_eof__Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$old_file
,
$old_line
,
$if_level
,
$tbl_level
);
local
(
$start
);
local
(
$missing
,
$last_index
);
(
$old_file
,
$old_line
,
$old_context
,
$if_level
,
$tbl_level
) =
split
(/\000/,
pop
(
@_file_info
));
$'app_lineno--;
$'app_context =
"EOF at "
;
if
($
'sdf_block_type ne '
') {
$start
= $'sdf_block_start;
&
'AppMsg("error", "!end$'
sdf_block_type missing
for
!$'sdf_block_type on line
$start
");
$
'sdf_block_type = '
';
}
$missing
=
scalar
(@'sdf_if_now) -
$if_level
;
if
(
$missing
!= 0) {
$start
= $
'sdf_if_start[$#main'
sdf_if_start];
&'AppMsg(
"error"
,
"!endif missing for !if on line $start"
);
$last_index
=
$if_level
- 1;
$#main
'sdf_if_start =
$last_index
;
$#main
'sdf_if_now =
$last_index
;
$#main
'sdf_if_yet =
$last_index
;
$#main
'sdf_if_else =
$last_index
;
}
$missing
=
scalar
(@'sdf_tbl_state) -
$tbl_level
;
if
(
$missing
!= 0) {
$start
= $
'sdf_tbl_start[$#main'
sdf_tbl_start];
&'AppMsg(
"error"
,
"!endtable missing for !table on line $start"
);
$last_index
=
$tbl_level
- 1;
$#main
'sdf_tbl_start =
$last_index
;
$#main
'sdf_tbl_state =
$last_index
;
}
@text
= (
"!line $old_line; '$old_file'; '$old_context'"
);
return
(
@text
);
}
sub
_bos__Macro {
local
(
$args
) =
@_
;
($
'app_lineno, $'
app_context) =
split
(/\;/,
$args
, 2);
$'sdf_sections++;
}
sub
_eos__Macro {
local
(
$args
) =
@_
;
($
'app_lineno, $'
app_context) =
split
(/\;/,
$args
, 2);
$'sdf_sections--;
}
@__bor__MacroArgs
= (
'Name Type Default Rule'
,
'name symbol'
,
'params rest _NULL_'
,
);
sub
_bor__Macro {
local
(
%arg
) =
@_
;
local
(
$name
);
local
(
$rpt_file
);
local
(
$begin_fn
);
$name
=
$arg
{
'name'
};
push
(@'sdf_report_names,
$name
);
$rpt_file
=
&FindModule
(&
'NameJoin('
', $name, '
sdr'));
if
(
$rpt_file
) {
unless
(
require
$rpt_file
) {
&
'AppMsg("error", "unable to load report '
$rpt_file
'");
return
();
}
}
else
{
&
'AppMsg("error", "unable to find report '
$name
'");
return
();
}
$begin_fn
=
$name
.
"_ReportBegin"
;
if
(
defined
&$begin_fn
) {
&$begin_fn
(
&SdfFilterParams
(
$name
,
$params
));
}
return
();
}
@__eor__MacroArgs
= ();
sub
_eor__Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$name
);
local
(
$end_fn
);
$name
=
pop
(@'sdf_report_names);
$end_fn
=
$name
.
"_ReportEnd"
;
if
(
defined
&$end_fn
) {
@text
=
&$end_fn
();
}
else
{
&
'AppMsg("warning", "unable to find report end routine '
$end_fn
'");
}
return
@text
;
}
@__store__MacroArgs
= (
'Name Type Default Rule'
,
'object rest'
,
);
sub
_store__Macro {
local
(
%arg
) =
@_
;
local
(
$args
);
local
(
$class
,
$cited
,
$name_fld
,
$name
,
$long_fld
,
$long
,
%values
);
local
(
$cite
);
local
(
$prop
,
@properties
);
$args
=
$arg
{
'object'
};
(
$class
,
$cited
,
$name_fld
,
$name
,
$long_fld
,
$long
,
%values
) =
$args
=~ /\000$/ ?
(
split
(/\000/,
$args
),
''
) :
split
(/\000/,
$args
);
$_class
{
$class
,
'catalog'
} .=
"$name\n"
unless
$obj_name
{
$class
,
$name
};
if
(
$cited
&& !
$obj_name
{
$class
,
$name
,
'Cite'
}) {
$_class
{
$class
,
'cited'
} .=
"$name\n"
;
$cite
= ++
$_class
{
$class
,
'cite_count'
};
$values
{
'Cite'
} =
"[$cite]"
;
}
$obj_name
{
$class
,
$name
} = 1;
$obj_name
{
$class
,
$name
,
$long_fld
} =
$long
;
$obj_long
{
$class
,
$long
} = 1;
$obj_long
{
$class
,
$long
,
$name_fld
} =
$name
;
@properties
=
split
(/,/,
$_class
{
$class
,
'properties'
});
push
(
@properties
,
'Cite'
)
if
$cited
;
for
$prop
(
@properties
) {
if
(
$values
{
$prop
} ne
''
) {
$obj_name
{
$class
,
$name
,
$prop
} =
$values
{
$prop
};
$obj_long
{
$class
,
$long
,
$prop
} =
$values
{
$prop
};
}
}
}
@__load_look__MacroArgs
= ();
sub
_load_look__Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$look
);
local
(
$style
);
$look
=
$var
{
'OPT_LOOK'
};
$style
=
$var
{
'OPT_STYLE'
};
if
(
$look
eq
'plain'
) {
$look
=
'simple'
;
$var
{
'OPT_LOOK'
} =
$look
;
}
if
(
$style
eq
'newsletter'
) {
$style
=
'newslttr'
;
$var
{
'OPT_STYLE'
} =
$style
;
}
@text
= ();
if
(
$var
{
'DOC_PAGED'
}) {
push
(
@text
,
"!_init_page_size_"
,
"!inherit 'look/$look'"
,
"!use '$style.sds'"
,
"!_calc_layout_vars_"
);
}
return
@text
;
}
@_init_page_size__MacroArgs
= ();
sub
_init_page_size__Macro {
local
(
$page_size
,
$page_width
,
$page_height
);
$page_size
= $
'sdf_pagesize{$var{'
OPT_PAGE_SIZE'}};
if
(
$page_size
ne
''
) {
(
$page_width
,
$page_height
) =
split
(/\000/,
$page_size
, 2);
}
else
{
(
$page_width
,
$page_height
) =
split
(/x/,
$var
{
'OPT_PAGE_SIZE'
}, 2);
}
$page_width
= &'SdfPoints(
$page_width
);
$page_height
= &'SdfPoints(
$page_height
);
$var
{
'DOC_PAGE_WIDTH'
} =
$page_width
;
$var
{
'DOC_PAGE_HEIGHT'
} =
$page_height
;
return
();
}
@__calc_layout_vars__MacroArgs
= ();
sub
_calc_layout_vars__Macro {
local
(
$h_top
,
$h_height
,
$f_height
,
$f_top
,
$m_top
,
$m_height
);
local
(
$full_width
,
$text_width
,
$columns
,
$col_width
);
$h_top
= &'SdfVarPoints(
"OPT_MARGIN_TOP"
);
$h_height
= &'SdfPageInfo(
"RIGHT"
,
"HEADER_HEIGHT"
,
"pt"
);
$f_height
= &'SdfPageInfo(
"RIGHT"
,
"FOOTER_HEIGHT"
,
"pt"
);
$f_top
=
$var
{
'DOC_PAGE_HEIGHT'
} -
$f_height
-
&'SdfVarPoints(
"OPT_MARGIN_BOTTOM"
);
$m_top
=
$h_top
+
$h_height
+
&'SdfPageInfo(
"RIGHT"
,
"HEADER_GAP"
,
"pt"
);
$m_height
=
$f_top
-
$m_top
-
&'SdfPageInfo(
"RIGHT"
,
"FOOTER_GAP"
,
"pt"
);
$var
{
'OPT_COLUMNS'
} = 1
if
$var
{
'OPT_COLUMNS'
} < 1;
$columns
=
$var
{
'OPT_COLUMNS'
};
$full_width
=
$var
{
'DOC_PAGE_WIDTH'
} - &'SdfVarPoints(
"OPT_MARGIN_OUTER"
) -
&'SdfVarPoints(
"OPT_MARGIN_INNER"
);
$text_width
=
$full_width
- &'SdfVarPoints(
"OPT_SIDEHEAD_WIDTH"
) -
&'SdfVarPoints(
"OPT_SIDEHEAD_GAP"
);
$col_width
= (
$text_width
- (
$columns
- 1) *
$var
{
"OPT_COLUMN_GAP"
}) /
$columns
;
$var
{
'DOC_TEXT_HEIGHT'
} =
$m_height
;
$var
{
'DOC_FULL_WIDTH'
} =
$full_width
;
$var
{
'DOC_TEXT_WIDTH'
} =
$text_width
;
$var
{
'DOC_COLUMN_WIDTH'
} =
$col_width
;
return
();
}
@_load_tuning__MacroArgs
= ();
sub
_load_tuning__Macro {
local
(
%arg
) =
@_
;
local
(
@text
);
local
(
$name
);
local
(
$target_module
);
$name
=
$var
{
'OPT_TUNING'
};
@text
= (&'SdfJoin(
"__tuning"
,
$name
));
$target_module
=
&FindModule
(&
'NameJoin('
', $var{'
OPT_DRIVER
'}, '
sdn'));
if
(
$target_module
) {
push
(
@text
,
"!include '$target_module'"
);
}
push
(
@text
,
"__endtuning[]"
);
return
@text
;
}
@_load_config__MacroArgs
= ();
sub
_load_config__Macro {
local
(
$config
);
$config
=
$var
{
'OPT_CONFIG'
};
return
(
$config
ne
''
) ? (
"!inherit '$config'"
) : ();
}
1;