editor/kate_syntax.pl

   1 #! perl
   2
   3 # Create Kate syntax highlighting XML file for IMCC
   4 # Language:     Parrot IMCC
   5 # Maintainer:   Andy Bussey <andybussey@yahoo.co.uk>
   6 # Last change:  2003 Aug 19
   7
   8 use strict;
   9 use warnings;
  10
  11 my $parrot = $ARGV[0];
  12
  13 if ($parrot eq '-h') {
  14     print "kate_syntax.pl\n\n",
  15         "Create Kate syntax highlighting file for Parrot IMCC.\n",
  16         "Supply the path to your Parrot directory as the only\n",
  17         "argument. The XML file will be written to the standard\n",
  18         "output.\n\n";
  19     exit;
  20 }
  21
  22 $parrot =~ s/\/$//;
  23
  24 my @imcc_oplike = qw(.sym .arg prototyped non_prototyped .class
  25     .endclass .param inc dec new defined addr global clone saveall
  26     restoreall);
  27 my @imcc_spdirec = qw(.pcc_call .result .return .local .const .globalconst
  28     end goto if unless call branch jump jsr ret invoke invokecc throw
  29     rethrow die_hard .emit .eom .sub .end .pcc_begin
  30     .pcc_end .pcc_sub .pcc_begin_return .pcc_end_return .pcc_begin_yield
  31     .pcc_end_yield .loadlib .namespace .endnamespace .macro .include);
  32 my @pod_start = qw(head[1-6] over back item for begin end pod);
  33 my $pod_start_rx = join '|', @pod_start;
  34 my @imcc_basic_types = qw(int float string);
  35 my $parrot_pmcsh_file = "include/parrot/core_pmcs.h";
  36 my $date = localtime(time);
  37
  38
  39 opendir PARROT, "$parrot" or die "Supply Parrot directory as argument!";
  40 my @ops_files = map { "$parrot/$_"} grep /\.ops$/, readdir PARROT;
  41 closedir PARROT;
  42
  43
  44 print <<END;
  45 <?xml version="1.0" encoding="UTF-8"?>
  46  <!DOCTYPE language SYSTEM "language.dtd">
  47  <!-- Created automatically by kate_syntax.pl  $date -->
  48
  49 <language name="IMCC" version="0.2" kateversion="2.0"
  50           section="Sources" extensions="*.imc;*.pasm" mimetype="">
  51
  52   <highlighting>
  53
  54     <list name="special_directives">
  55 END
  56
  57 my %ops;
  58 for my $dir (@imcc_spdirec) {
  59     $dir =~ s/\.//g;
  60     print "      <item>$dir</item>\n";
  61     $ops{$dir} = 1;
  62 }
  63
  64 print <<END;
  65     </list>
  66
  67     <list name="ops">
  68 END
  69
  70 for my $ops_file (@ops_files) {
  71     open OPS, "<$ops_file" or die "Can't read $ops_file!";
  72     while (<OPS>) {
  73         next unless (/^(inline\s+)?op\s+([a-zA-Z]\w*)/);
  74         my $op = $2;
  75         $op =~ s/\.//g;
  76         next if ($ops{$op});
  77         print "      <item>$op</item>\n";
  78         $ops{$op} = 1;
  79     }
  80 }
  81
  82 for my $op (@imcc_oplike) {
  83     $op =~ s/\.//g;
  84     next if ($ops{$op});
  85     print "      <item>$op</item>\n";
  86     $ops{$op} = 1;
  87 }
  88
  89 print <<END;
  90     </list>
  91
  92     <list name="types">
  93 END
  94
  95 my %types;
  96 for my $type (@imcc_basic_types) {
  97     $type =~ s/\./\&046;/g;
  98     next if ($types{$type});
  99     print "      <item>$type</item>\n";
 100     $types{$type} = 1;
 101 }
 102
 103 open TYPES, "<$parrot/$parrot_pmcsh_file" or
 104   die "Can't read $parrot/$parrot_pmcsh_file!";
 105 while (<TYPES>) {
 106     next unless (/^\s+enum_class_(\w+)\,/);
 107     my $type = $1;
 108     $type =~ s/\./\&046;/g;
 109     print "      <item>$type</item>\n";
 110     $types{$type} = 1;
 111 }
 112
 113 print <<END;
 114     </list>
 115
 116     <contexts>
 117
 118       <context name="default" attribute="Normal Text" lineEndContext="#stay">
 119           <RegExpr attribute="Label" context="#stay" String="[_\\w]+\\:" />
 120           <keyword attribute="Op" context="#stay" String="ops" />
 121           <keyword attribute="Special Directive" context="#stay"
 122                    String="special_directives" />
 123           <keyword attribute="Type" context="#stay" String="types" />
 124           <RegExpr attribute="Comment" context="#stay" String="#.*\$" />
 125           <RegExpr attribute="Comment" context="pod"
 126                    String="^\\=($pod_start_rx).*" />
 127           <HlCOct attribute="Octal" context="#stay" />
 128           <HlCHex attribute="Hex" context="#stay" />
 129           <Float attribute="Float" context="#stay" />
 130           <Int attribute="Int" context="#stay" />
 131 END
 132
 133 print <<END;
 134           <RegExpr attribute="Register" context="#stay"
 135                    String="[INSP](\\d|[12]\\d|3[01])" />
 136           <RegExpr attribute="TempRegister" context="#stay"
 137                    String="\\\$[INSP]\\d+" />
 138           <RegExpr attribute="String" context="string" String="'" />
 139           <RegExpr attribute="String Interp" context="string_interp"
 140                    String="&quot;" />
 141           <RegExpr attribute="Identifier" context="#stay"
 142                    String="[a-zA-Z_][\\w_]*" />
 143       </context>
 144
 145 END
 146
 147 print <<END;
 148       <context name="pod" attribute="Comment" lineEndContext="#stay">
 149           <LineContinue attribute="Comment" context="#stay" />
 150           <RegExpr attribute="Comment" context="#stay" String="[^\=]*" />
 151           <RegExpr attribute="Comment" context="#pop" String="^\\=cut\\s*\$" />
 152       </context>
 153
 154 END
 155
 156 print <<END;
 157       <context name="string" attribute="String" lineEndContext="#pop">
 158           <RegExpr attribute="String" context="#stay" String="'" />
 159       </context>
 160
 161 END
 162
 163 print <<END;
 164       <context name="string_interp" attribute="String Interp"
 165                lineEndContext="#pop">
 166           <HlCStringChar attribute="SpChar" context="#stay" />
 167           <RegExpr attribute="String Interp" context="#pop" String="&quot;" />
 168       </context>
 169
 170     </contexts>
 171
 172 END
 173
 174 print <<END;
 175     <itemDatas>
 176       <itemData name="Normal Text" defStyleNum="dsNormal" />
 177       <itemData name="Op" defStyleNum="dsNormal" color="#000080"
 178                 selColor="#ffffff" bold="0" italic="0" />
 179       <itemData name="Special Directive" defStyleNum="dsKeyword" />
 180       <itemData name="Type" defStyleNum="dsDataType" />
 181       <itemData name="Comment" defStyleNum="dsComment" />
 182       <itemData name="Octal" defStyleNum="dsBaseN" />
 183       <itemData name="Hex" defStyleNum="dsBaseN" />
 184       <itemData name="Float" defStyleNum="dsFloat" />
 185       <itemData name="Int" defStyleNum="dsDecVal" />
 186       <itemData name="Label" defStyleNum="dsKeyword" />
 187       <itemData name="Register" defStyleNum="dsDecVal" />
 188       <itemData name="TempRegister" defStyleNum="dsDecVal" />
 189       <itemData name="String" defStyleNum="dsString" color="#FF6C6C"
 190                 selColor="#FF6C6C" bold="0" italic="0" />
 191       <itemData name="String Interp" defStyleNum="dsString" />
 192       <itemData name="Identifier" defStyleNum="dsDataType" color="#C00000"
 193                 selColor="#C00000" bold="0" italic="0" />
 194       <itemData name="SpChar" defStyleNum="dsChar" />
 195     </itemDatas>
 196
 197   </highlighting>
 198
 199 END
 200
 201 print <<END;
 202   <general>
 203
 204     <comments>
 205       <comment name="singleLine" start="#" />
 206     </comments>
 207
 208     <keywords casesensitive="1" />
 209
 210   </general>
 211
 212 </language>
 213
 214 END
 215
 216 # Local Variables:
 217 # mode: cperl
 218 # cperl-indent-level: 4
 219 # fill-column: 100
 220 # End:
 221 # vim: expandtab shiftwidth=4: