GPL_bin_fullset/NaturalDocs/Modules/NaturalDocs/Languages/Pascal.pm

   1 ###############################################################################
   2 #
   3 #   Class: NaturalDocs::Languages::Pascal
   4 #
   5 ###############################################################################
   6 #
   7 #   A subclass to handle the language variations of Pascal and Delphi.
   8 #
   9 ###############################################################################
  10
  11 # This file is part of Natural Docs, which is Copyright © 2003-2010 Greg Valure
  12 # Natural Docs is licensed under version 3 of the GNU Affero General Public License (AGPL)
  13 # Refer to License.txt for the complete details
  14
  15 use strict;
  16 use integer;
  17
  18 package NaturalDocs::Languages::Pascal;
  19
  20 use base 'NaturalDocs::Languages::Simple';
  21
  22
  23 #
  24 #   hash: prototypeDirectives
  25 #
  26 #   An existence hash of all the directives that can appear after a function prototype and will be included.  The keys are the all
  27 #   lowercase keywords.
  28 #
  29 my %prototypeDirectives = ( 'overload' => 1,
  30                                            'override' => 1,
  31                                            'virtual' => 1,
  32                                            'abstract' => 1,
  33                                            'reintroduce' => 1,
  34                                            'export' => 1,
  35                                            'public' => 1,
  36                                            'interrupt' => 1,
  37                                            'register' => 1,
  38                                            'pascal' => 1,
  39                                            'cdecl' => 1,
  40                                            'stdcall' => 1,
  41                                            'popstack' => 1,
  42                                            'saveregisters' => 1,
  43                                            'inline' => 1,
  44                                            'safecall' => 1 );
  45
  46 #
  47 #   hash: longPrototypeDirectives
  48 #
  49 #   An existence hash of all the directives with parameters that can appear after a function prototype and will be included.  The
  50 #   keys are the all lowercase keywords.
  51 #
  52 my %longPrototypeDirectives = ( 'alias' => 1,
  53                                                  'external' => 1 );
  54
  55 #
  56 #   bool: checkingForDirectives
  57 #
  58 #   Set after the first function semicolon, which means we're in directives mode.
  59 #
  60 my $checkingForDirectives;
  61
  62
  63 #
  64 #   Function: OnCode
  65 #
  66 #   Just overridden to reset <checkingForDirectives>.
  67 #
  68 sub OnCode #(...)
  69     {
  70     my ($self, @parameters) = @_;
  71
  72     $checkingForDirectives = 0;
  73
  74     return $self->SUPER::OnCode(@parameters);
  75     };
  76
  77
  78 #
  79 #   Function: OnPrototypeEnd
  80 #
  81 #   Pascal's syntax has directives after the prototype that should be included.
  82 #
  83 #   > function MyFunction ( param1: type ); virtual; abstract;
  84 #
  85 #   Parameters:
  86 #
  87 #       type - The <TopicType> of the prototype.
  88 #       prototypeRef - A reference to the prototype so far, minus the ender in dispute.
  89 #       ender - The ender symbol.
  90 #
  91 #   Returns:
  92 #
  93 #       ENDER_ACCEPT - The ender is accepted and the prototype is finished.
  94 #       ENDER_IGNORE - The ender is rejected and parsing should continue.  Note that the prototype will be rejected as a whole
  95 #                                  if all enders are ignored before reaching the end of the code.
  96 #       ENDER_ACCEPT_AND_CONTINUE - The ender is accepted so the prototype may stand as is.  However, the prototype might
  97 #                                                          also continue on so continue parsing.  If there is no accepted ender between here and
  98 #                                                          the end of the code this version will be accepted instead.
  99 #       ENDER_REVERT_TO_ACCEPTED - The expedition from ENDER_ACCEPT_AND_CONTINUE failed.  Use the last accepted
 100 #                                                        version and end parsing.
 101 #
 102 sub OnPrototypeEnd #(type, prototypeRef, ender)
 103     {
 104     my ($self, $type, $prototypeRef, $ender) = @_;
 105
 106     if ($type eq ::TOPIC_FUNCTION() && $ender eq ';')
 107         {
 108         if (!$checkingForDirectives)
 109             {
 110             $checkingForDirectives = 1;
 111             return ::ENDER_ACCEPT_AND_CONTINUE();
 112             }
 113         elsif ($$prototypeRef =~ /;[ \t]*([a-z]+)([^;]*)$/i)
 114             {
 115             my ($lastDirective, $extra) = (lc($1), $2);
 116
 117             if (exists $prototypeDirectives{$lastDirective} && $extra =~ /^[ \t]*$/)
 118                 {  return ::ENDER_ACCEPT_AND_CONTINUE();  }
 119             elsif (exists $longPrototypeDirectives{$lastDirective})
 120                 {  return ::ENDER_ACCEPT_AND_CONTINUE();  }
 121             else
 122                 {  return ::ENDER_REVERT_TO_ACCEPTED();  };
 123             }
 124         else
 125             {  return ::ENDER_REVERT_TO_ACCEPTED();  };
 126         }
 127     else
 128         {  return ::ENDER_ACCEPT();  };
 129     };
 130
 131
 132 sub ParseParameterLine #(...)
 133     {
 134     my ($self, @params) = @_;
 135     return $self->SUPER::ParsePascalParameterLine(@params);
 136     };
 137
 138 sub TypeBeforeParameter
 139     {
 140     return 0;
 141     };
 142
 143
 144 1;