|
| ProWikiCenter | RecentChanges Preferences Edit |
|||||||||
|
Code / Part6
[[code] sub CreateMarkerBasic { my ($body,$h pars,$color,$plus strike)=@_; my ($ret,$rind,$tind); my $strike=HvnRetVal($h pars,'','Streichung','strike'); my $tcol= HvnRetColor($h pars,'','Textfarbe','textcolor');} sub CdmlMarker { my($body,$h pars)=@_; HashAddContextDefaultsMissing($h pars,'cdml.mark.defaults'); my $color= HvnRetColor($h pars,'#aaccff','Farbe','color'); return CreateMarkerBasic($body,$h pars,$color);} sub CdmlRed { my($body,$h pars)=@_; return CreateMarkerBasic($body,$h pars,'#ffaabb');} sub CdmlGreen { my($body,$h pars)=@_; return CreateMarkerBasic($body,$h pars,'#99ffcc');} sub CdmlBlue { my($body,$h pars)=@_; return CreateMarkerBasic($body,$h pars,'#aaccff');} sub CdmlYellow { my($body,$h pars)=@_; return CreateMarkerBasic($body,$h pars,'#ffffaa');} sub CdmlOrange { my($body,$h pars)=@_; return CreateMarkerBasic($body,$h pars,'#ffddbb');} sub CdmlPink { my($body,$h pars)=@_; return CreateMarkerBasic($body,$h pars,'#ffbbff');} sub CdmlStrike { my($body,$h pars)=@_; return CreateMarkerBasic($body,$h pars,'#e7e7e7',1);} sub TableCvtLineColorWidth { # my($table,$lcolor,$width)=@_; my $lcolor=$_[1]; my $width=$_[2]; my $twid=Cover($width," width="); my $lih=" bgcolor='$lcolor'"; $_[0]="<table border='0' cellpadding='0' cellspacing='0' $lih$twid><tr><td>$_[0]</td></tr></table>";} $CdmlHash{'Tabelle'} = \&CdmlTable; $CdmlHash{'table'} = \&CdmlTable; sub CdmlTable { my ($body, $h pars)=@_; HashAddContextDefaultsMissing($h pars,'cdml.table.defaults'); my ($table,$line,@lines,@parts,$oldcell,$cell,@cells,$ncells,$n,$bg,$al,$c,$cal,$sw,@swar,$colspan); my ($test,$fmt,$fmtcol,$twid,@mar,$ufont); my $lsep= HvnRetVal($h pars,"\n",'Zeilentrennzeichen','lineseparator'); my $width= HvnWidth($h pars,''); my $scale= HvnRetVal($h pars,1,'Skalierungsfaktor','scalefactor'); my $ausrichtung=HvnRetVal($h pars,'llllllllllllllllllll','Ausrichtung','alignment','align'); my $swid=HvnRetVal($h pars,'','Spaltenbreite','columnwidth'); my $colfmtlist=HvnRetVal($h pars,'','Spaltenformat','columnformat'); my $vbc=HvnRetVal($h pars,'','Formatzeichen','formatseparator'); my $lwidth=HvnRetVal($h pars,2,'Linienbreite','linewidth'); my $abstand=HvnRetVal($h pars,$TableDistance,'Abstand','distance'); my $markups=HvnRetVal($h pars,'','Markups','markups'); my $markup=HvnRetVal($h pars,1,'Markup','markup'); my $linienfarbe= HvnRetColor($h pars,'#cccccc','Linienfarbe','linecolor'); my $titelhintergrund=HvnRetColor($h pars,$TableTitlebackground,'Titelhintergrund','titlebackground'); my $texthintergrund=HvnRetColor($h pars,$TableTextbackground,'Texthintergrund','textbackground'); my $texthintergrund2=HvnRetColor($h pars,$texthintergrund,'Texthintergrund2','textbackground2'); my $footerbg=HvnRetColor($h pars,'',"Fußhintergrund",Unicode("Fußhintergrund"),'footerbackground'); my $art=HvnRetVal($h pars,'','Art','type'); my $luft=HvnRetVal($h pars,3,'Luft','padding'); my $sep=HvnRetVal($h pars,'','Trennzeichen','separator'); # later default=',' my $tfont= HvnRetVal($h pars,'','Titelschriftart','titlefont'); my $xfont= HvnRetVal($h pars,'','Textschriftart','textfont'); my $ffont= HvnRetVal($h pars,'',"Fußschriftart",Unicode("Fußschriftart"),'footerfont'); my $cnames=HvnRetVal($h pars,'','Spaltennamen','columnnames'); my (@ctab,%cind,%cval,@cells0,$key,$val,$ind,$rows,$cells,$bcol,$bcol0,@colfmt);LINE:
foreach $line (@lines) {
if($line =~ m/^\s*$/) {
next LINE;
}
if($n==0) {
$bg=$tih; $ufont=$tfont; $bcol0=$titelhintergrund;
} elsif($n & 1) {
$bg=$teh; $ufont=$xfont; $bcol0=$texthintergrund;
} else {
$bg=$teh2; $ufont=$xfont; $bcol0=$texthintergrund2;
}
if(($n==$#lines) && ($footerbg ne '')) {
if($#lines!=0) {
$bg=$fh; $ufont=$ffont;
}
}
if($cnames ne '') {
@cells=();
foreach $cell (split($sep,$line)) {
if( ($key,$val) = ( $cell =~ m/^\s*([^\s:=]+)\s*[:=](.*)$/s ) ) {
if(defined $cind{$key}) {
$cells[$cind{$key}]=$val;
}
}
}
} else {
@cells=split($sep,$line);
}
if($RtfMode) { $table=RtfRowsRetTable($rows); } else { my $marker='@@@314@@@'; $table="<table border='0' cellspacing='$lwidth' cellpadding='$luft' $twid1>$marker</table>"; TableCvtLineColorWidth($table,$linienfarbe,$width); TableCvtAbstandWidth($table,$abstand,$width); $table =~ s/$marker/$rows/; # hack saving memory }} sub FieldVarRetVal { my ($var)=@_; my $ret;} sub FieldDefaultRetStr { my ($deflist)=@_; my $ret=$deflist; my @ar; my $def;do ret: return $ret;} $CdmlHash{Eingabefeld} = \&CdmlInputfield; $CdmlHash{input} = \&CdmlInputfield; $CdmlHash{inputfield} = \&CdmlInputfield; sub CdmlInputfield { my ($body, $h pars)=@_; my $var=HvnRetVal($h pars,'test','Variable','variable'); my $object=HvnRetVal($h pars,'','Vorgabe','Default','default'); my $size=HvnSize($h pars,20); my $rows=HvnRetVal($h pars,1,'Zeilen','rows'); my $cols=HvnRetVal($h pars,$size,'Spalten','columns'); my $wrap=HvnRetVal($h pars,0,'Umbruch','wrap'); my $hidden=HvnRetVal($h pars,'','Unsichtbar','hidden');} ] [[code] sub CommandProcess {
my ($s)=@_;
my $app;
if($s =~ m/\$/) {
$s =~ s/\{\$REFERER\}/{WikiRetRefererPage();}/ge;
$s =~ s/\{\$PAGECUR.name\}/{$PageCur;}/ge;
}
return $s.$app;
}
$CdmlHash{"Schaltfläche"} = \&CdmlButton; $CdmlHash{Unicode("Schaltfläche")} = \&CdmlButton; $CdmlHash{button} = \&CdmlButton; sub CdmlButton { my ($body, $h pars)=@_; my $exec=HvnRetVal($h pars,'','Befehl','command'); my $label=HvnRetVal($h pars,'','Beschriftung','label'); if($label eq '') { $label=$body; } if($label eq '') { $label=Lu("Execute|Ausführen|Execute|Ejecutar"); } $exec = CommandProcess($exec); $exec =~ s/&/&/g; # Unquote common URL HTML if($exec ne '') { $exec='exec '.$exec; } return FormButton($exec,$label);} $CdmlHash{"Kontrollkästchen"} = \&CdmlCheckbox; $CdmlHash{Unicode("Kontrollkästchen")} = \&CdmlCheckbox; $CdmlHash{check} = \&CdmlCheckbox; $CdmlHash{checkbox} = \&CdmlCheckbox; sub CdmlCheckbox { my ($body, $h pars)=@_; my $var=HvnRetVal($h pars,'test','Variable','variable'); my $label=HvnRetVal($h pars,Su("Ausführen"),'Beschriftung','label'); my $object=HvnRetVal($h pars,'','Default','default'); return FormCheck($var,$object,$label);} $CdmlHash{"Optionsschaltfläche"} = \&CdmlRadiobutton; $CdmlHash{Unicode("Optionsschaltfläche")} = \&CdmlRadiobutton; $CdmlHash{radio} = \&CdmlRadiobutton; $CdmlHash{radiobutton} = \&CdmlRadiobutton; sub CdmlRadiobutton { my ($body, $h pars)=@_; my $var=HvnRetVal($h pars,'test','Variable','variable'); my $label=HvnRetVal($h pars,'','Beschriftung','label'); my $value=HvnRetVal($h pars,'','Wert','value'); my $object=HvnRetVal($h pars,'','Default','default'); return FormRadio($var,$value,$object,$label);} $CdmlHash{Formular} = \&CdmlForm; $CdmlHash{form} = \&CdmlForm; sub CdmlForm { my ($body, $h pars)=@_; my ($ret,%pars,$key,$fstart); my $type=HvnRetVal($h pars,'Suchen','Typ','type'); my $url=HvnRetVal($h pars,'','Url','url');} sub LangRetColor { my ($lang)=@_; my $ret=$Context} $CdmlHash{Mehrsprachig} = \&CdmlMultilingual; $CdmlHash{multilingual} = \&CdmlMultilingual; sub CdmlMultilingual { my ($body, $h pars)=@_; my (%pars,$key,$nlang,$proc,%lang,$line,$cell,@lang,$cnames,$cn,$cw,$cf); my ($i,@par,@far,$width); my $sep=">>"; my $lsep=">>>>";} sub TocBuild {
my ($lines,$size,$name,$entry,$line,$head,$key,$ret);
my $cnt=Lu('Table of contents of this page|Inhaltsverzeichnis dieser Seite|Table Des Matières|Tabla de materias');
my $th=HvnRetColor(\%TocParsHash,'#dddddd','Titelhintergrund','titlebackground');
my $ch=HvnRetColor(\%TocParsHash,'#eeeeee','Texthintergrund','textbackground');
my $lwidth=HvnRetVal(\%TocParsHash,4,'Linienbreite','linewidth');
my $abstand=HvnRetVal(\%TocParsHash,$TocAbstandDef,'Abstand','distance');
my $lcolor=HvnRetColor(\%TocParsHash,'#cccccc','Linienfarbe','linecolor');
my $title=HvnRetVal(\%TocParsHash,'','body','body');
my $luft=HvnRetVal(\%TocParsHash,3,'Luft','padding');
my $zluft=HvnRetVal(\%TocParsHash,2,'Zeilenluft','linepadding');
my $ein=HvnRetVal(\%TocParsHash,5,'Einrückung',Unicode('Einrückung'),'indentation');
my $tiefe=HvnRetVal(\%TocParsHash,20,'Tiefe','depth');
my $width=HvnWidth(\%TocParsHash,'');
my @parts;
my $maxsize;
my $indent;
}
$CdmlHash{Inhaltsverzeichnis} = \&CdmlToc; $CdmlHash{toc} = \&CdmlToc; sub CdmlToc { my($body, $h pars)=@_; $TocTopFlag=HvnRetVal($h pars,1,'Link','link'); $$h pars{body}=$body; HashAddContextDefaultsMissing($h pars,'cdml.toc.defaults',$CdmlTocDefaults); %TocParsHash=%$h pars; $TocFlag=1; return $TocMagic;} $CdmlHash{"Überschrift"} = \&CdmlTitle; $CdmlHash{Unicode("Überschrift")} = \&CdmlTitle; $CdmlHash{title} = \&CdmlTitle; sub CdmlTitle { my($body, $h pars)=@_; HashAddContextDefaultsMissing($h pars,'cdml.title.defaults'); my $name=HvnRetVal($h pars,'','Name','name'); my $luft=HvnRetVal($h pars,$TitlePadding,'Luft','padding'); my $size=HvnSize($h pars,''); my $bcol=HvnRetColor($h pars,$TitleColor,'Farbe','color'); my $fcol=HvnRetColor($h pars,$TitleFontColor,'Schriftfarbe','textcolor'); my $pos=HvnRetVal($h pars,0,'Position','pos');}
'()'=>'lr', '(x)'=>'lxr', '(q)'=>'lqr', '(?)'=>'lqr', '(v)'=>'lvr', '.()'=>'plr', '(.)'=>'lpr', 'p()'=>'plr', '(n)'=>'lnr', '(())'=>'llrr', '[]'=>'oc', '[x]'=>'oxc', '); $CdmlHash{Symbol} = \&CdmlSymbol; $CdmlHash{symbol} = \&CdmlSymbol; sub CdmlSymbol { my($body, $h pars)=@_; my ($name,$ret);do icon: $ret=NameStyleRetImageGif($name,$LinkTypeIconStyle);do ret: return $ret;} $CdmlHash{Gnuplot} = \&CdmlGnuplot; $CdmlHash{gnuplot} = \&CdmlGnuplot; sub CdmlGnuplot { my ($body,$h pars)=@_; my ($cmd,$out); my $rdir="graf/$PageCur"; my $dir="$ConfigDir/$rdir";do return: $GrafletFiles{$grfile}++; return ImageUrlRetHtml("$rdir/$fnam");} $CdmlHash{Tex} = \&CdmlTex; $CdmlHash{TeX} = \&CdmlTex; $CdmlHash{tex} = \&CdmlTex; sub CdmlTex { my ($body,$h pars)=@_; HashAddContextDefaultsMissing($h pars,'cdml.tex.defaults'); my ($cmd,$out); my $width=HvnWidth($h pars,$TexWidth); my $height=HvnHeight($h pars,$TexHeight); my $scale=HvnRetVal($h pars,$TexScale,'Skalierung','scale'); my $rdir="graf/$PageCur"; my $dir="$ConfigDir/$rdir";do return: $GrafletFiles{$infile}++; $GrafletFiles{$grfile}++; $GrafletFiles{'missfont.log'}++; return ImageUrlRetHtml("$rdir/$fnam");} sub IsColor {
my ($s)=@_;
if(substr($s,0,1) eq '#') {
return $s;
}
return ColorDefaultRetCode($s);
}
sub IsInteger {
my ($s)=@_;
my $ret;
if($s =~ m#^\d+$#) {
$ret=$s;
}
return $ret;
}
sub IsFontsize {
my ($s)=@_;
my $ret;
if($s =~ m#^(\d+)pt$#) {
$ret=$1;
if($ret<2) {
$ret=2;
}
if($ret>256) {
$ret=256;
}
}
return $ret;
}
sub IsLabel { my ($s)=@_; my ($ret); my $c=substr($s,0,1);} sub IsUrl { my ($s)=@_; my ($ret); if(NameIsUrl($s)) { $ret=$s; } return $ret;} sub IsAt {
my ($s,$x,$y)=@_;
my ($ret,$ix,$iy);
if($s =~ m#^@([+-]?)(\d*),*([+-]?)(\d*)$#) {
$ret=$s;
if($1 eq '+') {
$ix=$x+$2;
} elsif($1 eq '-') {
$ix=$x-$2;
} else {
$ix=$2;
}
if($3 eq '+') {
$iy=$y+$4;
} elsif($3 eq '-') {
$iy=$y-$4;
} else {
$iy=$4;
}
}
return ($ret,$ix,$iy);
}
sub IsSize {
my ($s)=@_;
my ($ret,$iw,$ih);
if($s =~ m#^(\d*)[xX](\d*)$#) {
$ret=$s; $iw=$1; $ih=$2;
}
return ($ret,$iw,$ih);
}
sub IsPage { my ($s)=@_; my ($ret,$name,$url);} sub ColorRetGray {
my ($s)=@_;
my $ret=255;
if($s =~ m/(([0-9A-Fa-f]{2}))(([0-9A-Fa-f]{2}))(([0-9A-Fa-f]{2}))/) {
$ret=HexRetInt($1)+HexRetInt($2)+HexRetInt($3);
}
return $ret;
}
sub LabelFontsizeRetWidth { my ($label,$fontsize)=@_; my ($ret,$u,$l,$s,$c);} sub HashSetXminXmaxYminYmax { my($h s,$xmin,$xmax,$ymin,$ymax)=@_;} sub PointPointRetDistFast { my ($x1,$y1,$x2,$y2)=@_; my $dx=$x2-$x1; my $dy=$y2-$y1; my $dist=$dx*$dx+$dy*$dy; return $dist;} sub ObjectFindNearest { my ($h o,$x1,$y1,$x2,$y2)=@_; my $xmin=$$h o{xmin}; my $ymin=$$h o{ymin}; my $xmax=$$h o{xmax}; my $ymax=$$h o{ymax}; my $rmin=PointPointRetDistFast($x1,$y1,$x2,$y2); my $r;} sub SvgRenderVertex { my ($h s,$h v,$xoff,$yoff)=@_; my ($ret,$id1,$id2,$x1,$x2,$y1,$y2,$h o1,$h o2); my ($mh,$mt,$mhflag,$mtflag); my $type=$$h v{type};do exit: return $ret;} sub SvgRenderObject { my ($h s,$h o,$xoff,$yoff)=@_; my ($ret,$off,$textcolor,$starget,$cx,$cy,$xtext,$ytext,$hsize,$sx,$sy); my $type=First($$h o{type},$$h s{type}); my $x=First($$h o{x},$$h s{x}); my $y=First($$h o{y},$$h s{y}); my $w=First($$h o{w},$$h s{w}); my $h=First($$h o{h},$$h s{h}); my $fontsize=First($$h o{fontsize},$$h s{fontsize},14); my $color=First($$h o{color},$$h s{color}); my $symbol=$$h o{symbol}; my $label=First($$h o{label},$$h o{page},$$h o{url},$$h o{name},$$h o{emptylabel}); $label=~ s/_/ /g; my $labelheight=$fontsize; my $labelwidth=LabelFontsizeRetWidth($label,$fontsize); my $url=First($$h o{url}); my $padding=First($$h o{padding},$$h s{padding},2); my $target=RetParam('target');
$starget=" target='pane'";
$ret="<a xlink:href='$url'$starget>\n$ret</a>\n";
}
}
sub ObjectsSetObjectDefaultSystem { my ($a objects,$h object,$h default,$h system,$dir)=@_; my ($ref,$defx,$defy); if($$h object{x} eq '') { $$h object{x}=$$h system{x}; } else { $$h system{x}=$$h object{x}; } if($$h object{y} eq '') { $$h object{y}=$$h system{y}; } else { $$h system{y}=$$h object{y}; } if($dir eq ',') { $defx=200; $defy=0; } else { $defx=0; $defy=40; }} sub ObjectsFindNameRetObject { my ($a objects,$word)=@_; my ($ret,$id,$h o); foreach(@$a objects) { $h o=$_; $id=$$h o{id}; if($$h o{page} eq $word) { goto do ret; } if($$h o{id} eq $word) { goto do ret; } if($$h o{name} eq $word) { goto do ret; } if($$h o{label} eq $word) { goto do ret; } } return '';do ret: return $h o;} sub SvgRetFrame { return "<g font-family='Verdana, Arial, sans serif' font-size='16'>\n" . "<defs>\n" . " <marker id='ArrowHead' viewBox='0 0 25 30' refX='25' refY='15' fill='gray'\n" . " markerWidth='4' markerHeight='4' orient='auto' >\n" . " <path d='M 0,0 L 25,15 L 0,30 z' />\n" . " </marker>\n" . " <marker id='ArrowTail' viewBox='0 0 25 30' refX='0' refY='15' fill='gray'\n" . " markerWidth='4' markerHeight='4' orient='auto' >\n" . " <path d='M 0,15 L 25,0 L 25,30 z' />\n" . " </marker>\n" . "</defs>\n" . "{SvgBody}" . "</g>\n";} sub SvgUnderstand { my ($body,$width,$height,$fontsize)=@_; my ($ret,$word,%system,@objects,$expect,$default,@vertices); my ($iscolor,$isinteger,$islabel,$isurl,$isat,$ix,$iy,$iw,$ih,$ispage,$pagename,$pageurl,$isfontsize); my (%default,%object,$issize,$color,$id,$id1,$id2,$fromid,$frame); my ($x,$y,$w,$h,$xmin,$xmax,$ymin,$ymax,$xmin2,$ymin2,$xoff,$yoff,$h o); my $mx=$width/2; my $my=$height/2; my %expect=('color'=>1, 'fontsize'=>1, 'from'=>1, 'label'=>1, 'padding'=>1, 'radius'=>1, 'symbol'=>1); my %type=('circle'=>1, 'ellipse'=>1, 'rect'=>1); my %arrows=( '->'=>1, '<->'=>1, '<-'=>1, '-'=>1 ); my %translate=('Kreis'=>'circle', 'r'=>'radius', 'to'=>'->', 'connect'=>'-', 'fromto'=>'<->', 'back'=>'<-' ); my $center=0; # autosize too
$system{w}=$width;
$system{h}=$height;
$system{r}=$height*0.3;
$system{color}='skyblue';
$system{type}='rect';
$system{fontsize}='12';
$system{padding}=5;
do label:
if($object{label} ne '') {
ObjectsSetObjectDefaultSystem(\@objects,\%object,\%default,\%system);
}
$object{label}=$islabel; $object{count}++;
} elsif($isat ne '') {
$object{x}=$ix; $object{y}=$iy; $object{count}++;
} elsif($isfontsize ne '') {
$object{fontsize}=$isfontsize; $object{count}++;
if($default) {
$default{fontsize}=$isfontsize;
}
} elsif($isurl ne '') {
if(($object{url} ne ) || ($object{page} ne )) {
ObjectsSetObjectDefaultSystem(\@objects,\%object,\%default,\%system);
}
$object{url}=$isurl; $object{count}++;
} elsif($ispage ne '') {
if(($object{url} ne ) || ($object{page} ne )) {
ObjectsSetObjectDefaultSystem(\@objects,\%object,\%default,\%system);
}
$object{page}=$pagename; $object{count}++;
$object{url}=$pageurl;
} elsif($issize ne '') {
$object{w}=$iw; $object{h}=$ih; $object{count}++;
} elsif($isinteger ne '') {
$object{integer}=$isinteger; $object{count}++;
} elsif($word eq 'center') {
$center=1;
} elsif($word eq 'default') {
$default=1;
} elsif($arrows{$word}) {
$id1=$object{id};
if($object{count}) {
ObjectsSetObjectDefaultSystem(\@objects,\%object,\%default,\%system);
}
$id2=$id1+1;
if($fromid ne '') {
$id1=$fromid;
}
push(@vertices,{ 'from'=>$id1, 'to'=>$id2, 'type'=>$word });
} elsif($type{$word}) {
$object{type}=$word; $object{count}++;
} elsif($expect{$word}) {
$expect=$word;
} else {
$islabel=$word;
goto do label;
}
}
}
if($object{count}) {
ObjectsSetObjectDefaultSystem(\@objects,\%object,\%default,\%system);
}
}
sub CreateSvgType { my ($body,$h pars,$svgtype)=@_; my $width=HvnWidth($h pars,320); my $height=HvnHeight($h pars,240); my $show=HvnRetVal($h pars,0,'showcode'); my $rdir="graf/$PageCur"; my $dir="$ConfigDir/$rdir"; my ($ret,$out,$code,$bnam,$fnam,$grfile,$body1,$body2); my $body0=$body;do return: $GrafletFiles{$grfile}++; $ret="<object data=\"$rdir/$fnam\" type=\"image/svg+xml\" width=\"$width\" height=\"$height\" >".LiSvgMissing()."</object>";} $CdmlHash{map}=\&CdmlMap; $CdmlHash{Map}=\&CdmlMap; sub CdmlMap { my ($body,$h pars)=@_; my $name=HvnRetVal($h pars,'','name'); my $section=RetParam('section'); my ($ret,$action,$title,$target,$icon);} $CdmlHash{SVG} = \&CdmlSvg; sub CdmlSvg { my ($body,$h pars)=@_; HashAddContextDefaultsMissing($h pars,'cdml.svg.defaults'); return CreateSvgType($body,$h pars,0);} $CdmlHash{Video} = \&CdmlVideo; $CdmlHash{video} = \&CdmlVideo; sub CdmlVideo { my ($body,$h pars)=@_; HashAddContextDefaultsMissing($h pars,'cdml.video.defaults'); my $server=HvnRetVal($h pars,'youtube','Server','server'); my $astart=HvnRetVal($h pars,'0','autostart'); my $starttime=HvnRetVal($h pars,'','starttime'); my $movie=HvnRetVal($h pars,'fJ3juM6vHwg','Film','movie'); my $width=HvnWidth($h pars,425); my $height=HvnHeight($h pars,350); my ($ret,$ascode,$stcode,$sec);} $CdmlHash{Graph} = \&CdmlGraph; $CdmlHash{graph} = \&CdmlGraph; sub CdmlGraph { my ($body,$h pars)=@_; HashAddContextDefaultsMissing($h pars,'cdml.graph.defaults'); my ($cmd,$out); my $width=HvnWidth($h pars,400); my $height=HvnHeight($h pars,300); my $rdir="graf/$PageCur"; my $dir="$ConfigDir/$rdir";do return: $GrafletFiles{$infile}++; $GrafletFiles{$grfile}++; return "<object data=\"$rdir/$fnam\" type=\"image/svg+xml\" width='$width' height='$height' >".LiSvgMissing()."</object>";} sub TextCmdParsBodyRetRaw { my ($ctext,$cmd,$h pars,$body)=@_; my (%pars,$raw,$f proc);} sub GetSaveUrl { my ($nr)=@_; my $ret=$SaveUrl{$nr}; if($ret eq $TocMagic) { $ret=TocBuild(); } return $ret;} sub TextCdmlRetText { my ($text)=@_; my ($ctext,$cmd,%pars,$body,$cstart,$pstart,$posequ,$possep); my ($clen,$bstart,$bend,$pnam,$pval,$c,$n,$i,$slen,$part);FRAME:
while( $text =~ /\[\[/g ) {
$n=2; $slen=length($text); $cstart=pos($text)-2;
$ctext=""; $cmd=""; $body=""; $bstart=$cstart+1; $pstart=$cstart+2; $posequ=0; $possep=0;
%pars=();
$pars{'pos'} = $cstart;
for($i=$pstart; $i<$slen; $i++) {
$c=substr($text,$i,1);
if($c eq ']') {
$n--;
if($n==0) {
$bend=$i;
if($bend>$bstart) {
$body .= substr($text,$bstart,$bend-$bstart);
}
$clen=$i+1-$cstart;
substr($text,$cstart,$clen)=TextCmdParsBodyRetRaw(substr($text,$cstart,$clen),$cmd,\%pars,$body);
next FRAME;
} elsif($n==1) {
$bend=$pstart-1;
if($bend>$bstart) {
$part=substr($text,$bstart,$bend-$bstart);
$body.=$part;
}
$bstart=$i+1;
if($posequ>$pstart && $possep==0) {
$pnam=substr($text,$pstart,$posequ-$pstart);
$pval=substr($text,$posequ+1,$i-($posequ+1));
$pars{$pnam}=$pval;
} elsif($cmd eq '') {
$cmd=substr($text,$pstart,$i-$pstart);
} else {
$body.=substr($text,$pstart-1,$i-$pstart+2);
}
}
} elsif($c eq '[') {
$n++;
if($n==2) {
$pstart=$i+1;
$posequ=0; $possep=0;
}
} elsif($n==2) {
if($posequ==0) {
if($c eq '=') {
$posequ=$i;
} elsif(ord($c)<48 || $c eq ':') {
$possep=$i;
}
}
}
}
}
}
sub TextWikiRetHtmlBasic { my ($text,$forcelinks)=@_; my ($html,$slen); my $showlinks=1;} sub TextWikiRetHtml { my ($text,$forcelinks)=@_; my ($rlink,$fntext);
return $text;} sub StoreRaw { my ($html)=@_;} sub StorePre { my ($html)=@_;} sub StoreHref { my ($anchor, $text)=@_;} sub UrlpRetLinkPunct { my ($rawname,$showImage,$style)=@_; my ($url,$label,$punct,$link);} sub UrlLabelTargetTypeRetLink { my ($url,$label,$target,$type)=@_; my ($dom,$base,$icon,$proto,$blockspam);
$label=~s/\@/ (AT) /g;
$blockspam=1;
}
}
}
if($LinkTypeIcons) {
if($type eq '-') {
goto do ret;
}
if($type eq '') {
$h=$Context
do check:
if($icon eq '-') {
goto do ret;
}
if($icon eq '') {
$icon=$LinkTypeIconDefault;
}
$icon=ImageUrlRetHtmlPlus($icon,0,undef,undef,undef,undef,$LinkTypeIconStyle);
if($LinkTypeFront) {
$label="$icon $label";
} else {
$label.=" $icon";
}
}
if($blockspam) {
return $label;
}
do ret:
StrHexCvtTextSave($label); if($PagenameReduction) { $dom=UrlRetDomain($url); $base=$Context} sub UrlLabelTypeRetLink { my ($url,$label,$type)=@_; return UrlLabelTargetTypeRetLink($url,$label,'',$type);} sub StoreUrl { my ($name,$showImage)=@_; my ($link,$punct)=UrlpRetLinkPunct($name,$showImage); if($link ne "") { # no empty links are stored $link = StoreRaw($link) } return $link.$punct;} sub StoreUploadLink { my ($fnam)=@_; my $url= "$UploadUrl/$fnam"; if(NameIsImage($fnam)) { StoreRaw(ImageUrlRetHtml($url)); } else { StoreRaw(UrlLabelTypeRetLink($url,"} sub StoreRFC { my ($num)=@_; my $link=UrlLabelTypeRetLink("} sub ISBNLink { my ($rawnum)=@_; my ($rawprint,$html,$num,$first,$h,$land);} sub StoreISBN { my ($num)=@_; return StoreRaw(ISBNLink($num));} sub RequestLock { my $n = 0; while(mkdir($LockDir, 0555) == 0) { # EEXIST == 17 is OK, try later. $! == 17 || die("can't make $LockDir: $!\n"); $n++ < 10 || die("timed out waiting for $LockDir\n"); sleep(3); }} sub ReleaseLock { rmdir($LockDir);} ] |
|
|||||||||
| RecentChanges Preferences Edit |
||||||||||
'=>'smile', '
'=>'wink', '
'=>'frown', 'link' => '
http://www.prowiki2.org/image/$symbol.gif'/>
http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd
MAIL /MAIL /;