sub
new {
my
(
$class
,
$type
,
$spec
,
%options
) =
@_
;
my
$descriptor
=
$STATE
->lookupMapping(
'PARAMETER_TYPES'
,
$type
);
if
(!
defined
$descriptor
) {
if
(
$type
=~ /^Optional(.+)$/) {
my
$basetype
= $1;
if
(
$descriptor
=
$STATE
->lookupMapping(
'PARAMETER_TYPES'
,
$basetype
)) { }
elsif
(
my
$reader
= checkReaderFunction(
"Read$type"
) || checkReaderFunction(
"Read$basetype"
)) {
$descriptor
= {
reader
=>
$reader
}; }
$descriptor
= {
%$descriptor
,
optional
=> 1 }
if
$descriptor
; }
elsif
(
$type
=~ /^Skip(.+)$/) {
my
$basetype
= $1;
if
(
$descriptor
=
$STATE
->lookupMapping(
'PARAMETER_TYPES'
,
$basetype
)) { }
elsif
(
my
$reader
= checkReaderFunction(
$type
) || checkReaderFunction(
"Read$basetype"
)) {
$descriptor
= {
reader
=>
$reader
}; }
$descriptor
= {
%$descriptor
,
novalue
=> 1,
optional
=> 1 }
if
$descriptor
; }
else
{
my
$reader
= checkReaderFunction(
"Read$type"
);
$descriptor
= {
reader
=>
$reader
}
if
$reader
; } }
Fatal(
'misdefined'
,
$type
||
'no_type'
,
undef
,
"Unrecognized parameter type in \"$spec\""
)
unless
$descriptor
;
my
%data
= (%{
$descriptor
},
%options
);
$data
{semiverbatim} = []
if
$data
{semiverbatim} && (
ref
$data
{semiverbatim} ne
'ARRAY'
);
return
bless
{
spec
=>
$spec
,
type
=>
$type
,
%data
},
$class
; }
sub
checkReaderFunction {
my
(
$function
) =
@_
;
if
(
defined
$LaTeXML::Package::Pool::
{
$function
}) {
local
*reader
=
$LaTeXML::Package::Pool::
{
$function
};
if
(
defined
&reader
) {
return
\
&reader
; } } }
sub
stringify {
my
(
$self
) =
@_
;
return
$$self
{spec}; }
sub
setupCatcodes {
my
(
$self
) =
@_
;
if
(
$$self
{semiverbatim}) {
$STATE
->beginSemiverbatim(@{
$$self
{semiverbatim} }); }
return
; }
sub
revertCatcodes {
my
(
$self
) =
@_
;
if
(
$$self
{semiverbatim}) {
$STATE
->endSemiverbatim(); }
return
; }
sub
read
{
my
(
$self
,
$gullet
,
$fordefn
) =
@_
;
if
(
$$self
{semiverbatim}) {
$STATE
->beginSemiverbatim(@{
$$self
{semiverbatim} }); }
my
$value
= &{
$$self
{reader} }(
$gullet
, @{
$$self
{extra} || [] });
$value
=
$value
->neutralize(@{
$$self
{semiverbatim} })
if
$$self
{semiverbatim} && (
ref
$value
)
&&
$value
->can(
'neutralize'
);
$value
=
$value
->packParameters
if
$value
&&
$$self
{packParameters};
if
(
$$self
{semiverbatim}) {
$STATE
->endSemiverbatim(); }
if
((!
defined
$value
) && !
$$self
{optional}) {
Error(
'expected'
,
$self
,
$gullet
,
"Missing argument "
. Stringify(
$self
) .
" for "
. Stringify(
$fordefn
),
"Ended at "
. ToString(
$gullet
->getLocator));
$value
= T_OTHER(
'missing'
); }
return
$value
; }
sub
reparse {
my
(
$self
,
$gullet
,
$tokens
) =
@_
;
$tokens
=
$tokens
->packParameters
if
$tokens
&&
$$self
{packParameters};
if
((
$$self
{type} eq
'Plain'
) ||
$$self
{undigested}) {
return
$tokens
; }
elsif
(
$$self
{semiverbatim}) {
return
$tokens
->neutralize(@{
$$self
{semiverbatim} }); }
else
{
return
$gullet
->readingFromMouth(LaTeXML::Core::Mouth->new(),
sub
{
my
(
$gulletx
) =
@_
;
my
@tokens
=
$tokens
->unlist;
if
(
@tokens
&& (
$$self
{type} =~ /^(?:Number|Dimension|Glue|MuDimension|MuGlue)$/)
&&
$tokens
[0]->equals(T_BEGIN) &&
$tokens
[-1]->equals(T_END)) {
shift
(
@tokens
);
pop
(
@tokens
); }
$gulletx
->unread(
@tokens
);
my
$value
=
$self
->
read
(
$gulletx
);
$gulletx
->skipSpaces;
return
$value
; }); } }
sub
digest {
my
(
$self
,
$stomach
,
$value
,
$fordefn
) =
@_
;
if
(
$$self
{semiverbatim}) {
$STATE
->beginSemiverbatim(@{
$$self
{semiverbatim} });
if
((
ref
$value
eq
'LaTeXML::Core::Token'
) || (
ref
$value
eq
'LaTeXML::Core::Tokens'
)) {
$stomach
->getGullet->readingFromMouth(LaTeXML::Core::Mouth->new(),
sub
{
my
(
$igullet
) =
@_
;
$igullet
->unread(
$value
);
my
@tokens
= ();
while
(
defined
(
my
$token
=
$igullet
->readXToken(1, 1))) {
push
(
@tokens
,
$token
); }
$value
= Tokens(
@tokens
);
$value
=
$value
->neutralize; }); } }
if
(
my
$pre
=
$$self
{beforeDigest}) {
&$pre
(
$stomach
); }
$value
=
$value
->beDigested(
$stomach
)
if
(
ref
$value
) && !
$$self
{undigested};
if
(
my
$post
=
$$self
{afterDigest}) {
&$post
(
$stomach
); }
$STATE
->endSemiverbatim()
if
$$self
{semiverbatim};
return
$value
; }
sub
revert {
my
(
$self
,
$value
) =
@_
;
if
(
my
$reverter
=
$$self
{reversion}) {
return
&$reverter
(
$value
, @{
$$self
{extra} || [] }); }
else
{
return
Revert(
$value
); } }
1;