Add HTML::Mason lexer

lib/rouge/demos/mason

@@ -0,0 +1,21 @@
+<%doc>
+    This is a mason component.
+</%doc>
+
+<%args>
+    $color         # this argument is required!
+    $size => 20    # default size
+    $country => undef   # this argument is optional, default value is 'undef'
+    @items => (1, 2, 'something else')
+    %pairs => (name => "John", age => 29)
+</%args>
+
+# A random block of Perl code
+<%perl>
+    my @people = ('mary' 'john' 'pete' 'david');
+</%perl>
+
+# Note how each line of code begins with the mandatory %
+% foreach my $person (@people) {
+    Name: <% $person %>
+% }

lib/rouge/guessers/disambiguation.rb

@@ -82,6 +82,8 @@ def match?(filename)
         next ObjectiveC if contains?('@"')
 
         next Matlab if matches?(/^\s*?%/)
+
+        next Mason if matches?(/(<\/?%|<&)/)
       end
 
       disambiguate '*.php' do

lib/rouge/lexers/mason.rb

@@ -0,0 +1,105 @@
+# -*- coding: utf-8 -*- #
+
+module Rouge
+  module Lexers
+    class Mason < TemplateLexer
+      title 'Mason'
+      desc 'HTML::Mason'
+      tag 'mason'
+      filenames '*.mi', '*.mc', '*.mas', '*.m', '*.mhtml', '*.mcomp', 'autohandler', 'dhandler'
+      mimetypes 'text/x-mason', 'application/x-mason'
+
+      def initialize(*)
+        super
+        @perl = Perl.new
+      end
+
+      def self.detect?(text)
+        return false if text.doctype?(/[html|xml]/)
+        return true if text.doctype?
+      end
+
+      textblocks = %w(text doc)
+      perlblocks = %w(args flags attr init once shared perl cleanup filter)
+      components = %w(def method)
+
+      state :root do
+        mixin :mason_tags
+      end
+
+      state :mason_tags do
+        rule /<%(#{textblocks.join('|')})>/i, Keyword::Constant, :text_block
+
+        rule /<%(#{perlblocks.join('|')})>/i, Keyword::Constant, :perl_block
+
+        rule /(<%(#{components.join('|')}))([^>]*)(>)/i do |m|
+          token Keyword::Constant, m[1]
+          token Name, m[3]
+          token Keyword::Constant, m[4]
+          push :component_block
+        end
+
+        # other perl blocks
+        rule /<%([a-zA-Z_]*)>/i, Keyword::Constant, :other_perl_blocks
+
+        # perl comment
+        rule /^(#.*)$/, Comment
+
+        # perl line
+        rule /^%(.*)$/ do |m|
+          token Keyword::Constant, '%'
+          delegate @perl, m[1]
+        end
+
+        # start of component call
+        rule /<%/, Keyword::Constant, :component_call
+
+        # start of component substitution
+        rule /<&/, Keyword::Constant, :component_sub
+
+        # fallback to HTML until a mason tag is encountered
+        rule(/(.+?)(?=(<&|<%|<\/%|^%|^#))/m) { delegate parent }
+
+        # if we get here, there's no more mason tags, so we parse the rest of the doc as HTML
+        rule(/.+/m) { delegate parent }
+      end
+
+      state :perl_block do
+        rule /<\/%(#{perlblocks.join('|')})>/i, Keyword::Constant, :pop!
+
+        rule(/(.*?[^"])(?=<\/%)/m) { delegate @perl; }
+      end
+
+      state :other_perl_blocks do
+        rule /<\/%[a-zA-Z_]*>/i, Keyword::Constant, :pop!
+
+        rule(/(.*?[^"])(?=<\/%)/m) { delegate @perl; }
+      end
+
+      state :text_block do
+        rule /<\/%(#{textblocks.join('|')})>/i, Keyword::Constant, :pop!
+
+        rule /(.*?[^"])(?=<\/%)/m, Comment
+      end
+
+      state :component_block do
+        rule /<\/%(#{components.join('|')})>/i, Keyword::Constant, :pop!
+
+        mixin :mason_tags
+      end
+
+      state :component_sub do
+        rule /&>/, Keyword::Constant, :pop!
+
+        rule(/(.*?)(?=&>)/m) { delegate @perl; }
+      end
+
+      state :component_call do
+        rule /%>/, Keyword::Constant, :pop!
+
+        rule(/(.*?)(?=%>)/m) { delegate @perl; }
+      end
+    end
+  end
+end
+

spec/lexers/mason_spec.rb

@@ -0,0 +1,27 @@
+# -*- coding: utf-8 -*- #
+
+describe Rouge::Lexers::Mason do
+  let(:subject) { Rouge::Lexers::Mason.new }
+  let(:bom) { "\xEF\xBB\xBF" }
+
+  describe 'guessing' do
+    include Support::Guessing
+
+    it 'guesses by filename' do
+      assert_guess :filename => 'foo.m', :source => '<%'
+      assert_guess :filename => 'foo.mas'
+      assert_guess :filename => 'foo.mi'
+      assert_guess :filename => 'foo.mc'
+      assert_guess :filename => 'foo.mhtml'
+      assert_guess :filename => 'foo.mcomp'
+      assert_guess :filename => 'autohandler'
+      assert_guess :filename => 'dhandler'
+    end
+
+    it 'guesses by mimetype' do
+      assert_guess :mimetype => 'text/x-mason'
+      assert_guess :mimetype => 'application/x-mason'
+    end
+
+  end
+end

spec/visual/samples/mason

@@ -0,0 +1,150 @@
+<%doc>
+    This is a mason component. 
+</%doc>
+
+<%args>
+    $color         # this argument is required!
+    $size => 20    # default size
+    $country => undef   # this argument is optional, default value is 'undef'
+    @items => (1, 2, 'something else')
+    %pairs => (name => "John", age => 29)
+    $x => "</%args>"
+</%argS>
+
+<%flags>
+    inherit => "page-framework.mi"
+    inherit => "</%flags>"
+</%flags>
+
+<%attr>
+author => 'maria ines parnisari'
+</%attr>
+
+<%once>
+    $Schema = Apprentice::Data->$schema;
+</%once>
+
+<%shared>
+    my $shared_var = 25;
+</%shared>
+
+<%init>
+    my $cookies = Apache::Cookie->fetch;
+</%init>
+
+# A random block of Perl code
+<%perl>
+    my @people = ('mary' 'john' 'pete' 'david');
+    my $moduloOperation = $totalNumber % $numColumns ? 1 : 0;
+</%perl>
+
+# Note how each line of code begins with the mandatory %
+% foreach my $person (@people) {
+    Name: <% $person %> age: <& 'path/to/component' &> location: (unkown!)
+% }
+
+            % this is not perl code. the % is not the first character of the line!
+
+<h1>Here at wally world you will find all the finest accoutrements.</h1>
+
+<h2>What follows is a table.</h2>
+
+<input type="password" name="pwd" />
+
+% my @array = qw(zero one two);
+
+<table>
+%       foreach my $row (0..$#array) {
+            <tr>
+                <td><% $row          %></td>
+                <td><% $array[$row]  %></td>
+            </tr>
+%        }
+</table>
+
+# These are all component calls
+<& 'path/to/component' &>
+<& $component &>
+<& menu, width => 100, height => 200 &>
+
+# Special globals $m and $r
+%   my $result = $m->base_comp;
+%   my $apache = $r->name;
+
+# a nice PRIVATE subcomponent that renders a hyperlink
+<%def .make_a_link>
+    <a href="<% $url %>"> <% $text %></a>
+<%args>
+    $path
+    %query => ()
+    $text
+</%args>
+<%init>
+    my $url = $path;
+    if (scalar (keys %query) > 0) {
+        $url = $url . "?"
+    }
+    foreach my $queryParam (keys %query) {
+        $url = $url . $queryParam . "=" . $query{$queryParam} . "&";
+    }
+</%init>
+<%perl>
+    my $someothervar = 42;
+</%perl>
+</%def>
+
+<%method getPublic>
+%    my $text = "hello world";
+<b><% $text %></b>
+</%method>
+
+<%method getPrivate>
+    <%perl>
+        print "<font color=\"red\">some text!</font>";
+        return 42;
+    </%perl>
+</%method>
+
+<%text>
+# This is not interpreted and is printed as is
+%   my $variable = "hello";
+</%text>
+
+# This code runs at the very end of the component
+<%filter>
+    s/(\w+)/\U$1/g #uppercase the entire thing
+</%filter>
+
+<%cleanup>
+# This runs at the end.
+    $db->disconnect();
+</%cleanup>
+
+<!-- BEGIN HTML -->
+<style>
+%   my $wow = "master";
+    .normal {
+        background: url("http://img.url/");
+    }
+
+# TODO this should work but it doesn't 
+#   .dashed {
+#        background: url("<% $someUrl %>");
+#   }
+
+    .<% $wow %> .normal {
+        background: url("http://img.url/");
+    }
+
+</style>
+
+<script type="text/javascript">
+    alert('hello world');
+%   my $superVar = 2;
+</script>
+
+<!-- END HTML -->
+
+# Random Perl blocks
+<%perl>my $hello = "world";</%perl>
+<%perl> } </%perl>