editor/kate_syntax.pl

   1 #! perl
   2
   3 # Copyright (C) 2003-2006, Parrot Foundation.
   4 # $Id$
   5
   6 # Create Kate syntax highlighting XML file for IMCC
   7 # Language:     Parrot IMCC
   8 # Maintainer:   Andy Bussey <andybussey@yahoo.co.uk>, Parrot Team
   9 # Last change:  2007 May 22
  10
  11 use strict;
  12 use warnings;
  13
  14 my $parrot = $ARGV[0];
  15
  16 if ( $parrot eq '-h' ) {
  17     print "kate_syntax.pl\n\n", "Create Kate syntax highlighting file for Parrot IMCC.\n",
  18         "Supply the path to your Parrot directory as the only\n",
  19         "argument. The XML file will be written to the standard\n", "output.\n\n";
  20     exit;
  21 }
  22
  23 $parrot =~ s/\/$//;
  24
  25 my @imcc_oplike = qw( .sym .arg prototyped non_prototyped .class
  26     .endclass .param inc dec new defined global clone );
  27
  28 my @imcc_spdirec = qw(.call .result .return .local .const .globalconst
  29     end goto if unless call branch jump jsr ret invoke invokecc throw
  30     rethrow die_hard .emit .eom .sub .end .begin_call
  31     .end_call .pcc_sub .begin_return .end_return .begin_yield
  32     .end_yield .loadlib .namespace .endnamespace .macro .include);
  33 my @pod_start         = qw(head[1-6] over back item for begin end pod);
  34 my $pod_start_rx      = join '|', @pod_start;
  35 my @imcc_basic_types  = qw(int float string pmc);
  36 my $parrot_pmcsh_file = "include/parrot/core_pmcs.h";
  37 my $date              = localtime(time);
  38
  39 my $ops_dir = "$parrot/src/ops";
  40 opendir my $PARROT, "$ops_dir" or die "Supply Parrot directory as argument!";
  41 my @ops_files = map { "$ops_dir/$_" } grep /\.ops$/, readdir $PARROT;
  42 closedir $PARROT;
  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="*.pasm;*.pir" 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 my $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 my $TYPES, "<", "$parrot/$parrot_pmcsh_file"
 104     or 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 close $TYPES;
 113
 114 print <<END;
 115     </list>
 116
 117     <contexts>
 118
 119       <context name="default" attribute="Normal Text" lineEndContext="#stay">
 120           <RegExpr attribute="Label" context="#stay" String="[_\\w]+\\:" />
 121           <keyword attribute="Op" context="#stay" String="ops" />
 122           <keyword attribute="Special Directive" context="#stay"
 123                    String="special_directives" />
 124           <keyword attribute="Type" context="#stay" String="types" />
 125           <RegExpr attribute="Comment" context="#stay" String="#.*\$" />
 126           <RegExpr attribute="Comment" context="pod"
 127                    String="^\\=($pod_start_rx).*" />
 128           <HlCOct attribute="Octal" context="#stay" />
 129           <HlCHex attribute="Hex" context="#stay" />
 130           <Float attribute="Float" context="#stay" />
 131           <Int attribute="Int" context="#stay" />
 132 END
 133
 134 print <<END;
 135           <RegExpr attribute="Register" context="#stay"
 136                    String="[INSP](\\d|[12]\\d|3[01])" />
 137           <RegExpr attribute="TempRegister" context="#stay"
 138                    String="\\\$[INSP]\\d+" />
 139           <RegExpr attribute="String" context="string" String="'" />
 140           <RegExpr attribute="String Interp" context="string_interp"
 141                    String="&quot;" />
 142           <RegExpr attribute="Identifier" context="#stay"
 143                    String="[a-zA-Z_][\\w_]*" />
 144       </context>
 145
 146 END
 147
 148 print <<END;
 149       <context name="pod" attribute="Comment" lineEndContext="#stay">
 150           <LineContinue attribute="Comment" context="#stay" />
 151           <RegExpr attribute="Comment" context="#stay" String="[^\=]*" />
 152           <RegExpr attribute="Comment" context="#pop" String="^\\=cut\\s*\$" />
 153       </context>
 154
 155 END
 156
 157 print <<END;
 158       <context name="string" attribute="String" lineEndContext="#pop">
 159           <RegExpr attribute="String" context="#pop" String="'" />
 160       </context>
 161
 162 END
 163
 164 print <<END;
 165       <context name="string_interp" attribute="String Interp"
 166                lineEndContext="#pop">
 167           <HlCStringChar attribute="SpChar" context="#stay" />
 168           <RegExpr attribute="String Interp" context="#pop" String="&quot;" />
 169       </context>
 170
 171     </contexts>
 172
 173 END
 174
 175 print <<END;
 176     <itemDatas>
 177       <itemData name="Normal Text" defStyleNum="dsNormal" />
 178       <itemData name="Op" defStyleNum="dsNormal" color="#000080"
 179                 selColor="#ffffff" bold="0" italic="0" />
 180       <itemData name="Special Directive" defStyleNum="dsKeyword" />
 181       <itemData name="Type" defStyleNum="dsDataType" />
 182       <itemData name="Comment" defStyleNum="dsComment" />
 183       <itemData name="Octal" defStyleNum="dsBaseN" />
 184       <itemData name="Hex" defStyleNum="dsBaseN" />
 185       <itemData name="Float" defStyleNum="dsFloat" />
 186       <itemData name="Int" defStyleNum="dsDecVal" />
 187       <itemData name="Label" defStyleNum="dsKeyword" />
 188       <itemData name="Register" defStyleNum="dsDecVal" />
 189       <itemData name="TempRegister" defStyleNum="dsDecVal" />
 190       <itemData name="String" defStyleNum="dsString" color="#FF6C6C"
 191                 selColor="#FF6C6C" bold="0" italic="0" />
 192       <itemData name="String Interp" defStyleNum="dsString" />
 193       <itemData name="Identifier" defStyleNum="dsDataType" color="#C00000"
 194                 selColor="#C00000" bold="0" italic="0" />
 195       <itemData name="SpChar" defStyleNum="dsChar" />
 196     </itemDatas>
 197
 198   </highlighting>
 199
 200 END
 201
 202 print <<END;
 203   <general>
 204
 205     <comments>
 206       <comment name="singleLine" start="#" />
 207     </comments>
 208
 209     <keywords casesensitive="1" />
 210
 211   </general>
 212
 213 </language>
 214
 215 END
 216
 217 # Local Variables:
 218 #   mode: cperl
 219 #   cperl-indent-level: 4
 220 #   fill-column: 100
 221 # End:
 222 # vim: expandtab shiftwidth=4: