[Qemacs-commit] qemacs perl.c

[Charlie Gordon]

CVSROOT:        /sources/qemacs
Module name:    qemacs
Changes by:     Charlie Gordon <chqrlie>        14/03/01 19:05:30

Modified files:
        .              : perl.c 

Log message:
        add POD support in perl-mode
        
        * support inline Perl documentation
        * improve HERE doc support, allow spaces after <<

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/qemacs/perl.c?cvsroot=qemacs&r1=1.12&r2=1.13

Patches:
Index: perl.c
===================================================================
RCS file: /sources/qemacs/qemacs/perl.c,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -b -r1.12 -r1.13
--- perl.c      6 Feb 2014 00:22:18 -0000       1.12
+++ perl.c      1 Mar 2014 19:05:30 -0000       1.13
@@ -34,7 +34,8 @@
 #define IN_STRING1      0x01    /* single quote */
 #define IN_STRING2      0x02    /* double quote */
 #define IN_FORMAT       0x04    /* format = ... */
-#define IN_INPUT        0x08
+#define IN_HEREDOC      0x08
+#define IN_POD          0x10
 
 /* CG: bogus if multiple regions are colorized, should use signature */
 /* XXX: should move this to mode data */
@@ -120,15 +121,30 @@
             colstate &= ~IN_FORMAT;
         set_color(str + j, str + i, PERL_STRING);
     }
-    if (colstate & IN_INPUT) {
+    if (colstate & IN_HEREDOC) {
         i = n;
         if (n == perl_eos_len && !umemcmp(perl_eos, str, n)) {
-            colstate &= ~IN_INPUT;
+            colstate &= ~IN_HEREDOC;
             set_color(str + j, str + i, PERL_KEYWORD);
         } else {
             set_color(str + j, str + i, PERL_STRING);
         }
     }
+    if (str[i] == '=' && qe_isalpha(str[i + 1])) {
+        colstate |= IN_POD;
+    }
+    if (colstate & IN_POD) {
+        if (ustrstart(str + i, "=cut", NULL)) {
+            colstate &= ~IN_POD;
+        }
+        if (str[i] == '=' && qe_isalpha(str[i + 1])) {
+            i = n;
+            set_color(str + j, str + i, PERL_KEYWORD);
+        } else {
+            i = n;
+            set_color(str + j, str + i, PERL_COMMENT);
+        }
+    }
 
     while (i < n) {
         j = i + 1;
@@ -179,6 +195,8 @@
             if (c1 == '<') {
                 /* Should check for unary context */
                 s1 = i + 2;
+                while (qe_isspace(str[s1]))
+                    s1++;
                 c2 = str[s1];
                 if (c2 == '"' || c2 == '\'' || c2 == '`') {
                     s2 = perl_string(str, c2, ++s1, n);
@@ -189,7 +207,7 @@
                     perl_eos_len = min((int)(s2 - s1), countof(perl_eos) - 1);
                     umemcpy(perl_eos, str + s1, perl_eos_len);
                     perl_eos[perl_eos_len] = '\0';
-                    colstate |= IN_INPUT;
+                    colstate |= IN_HEREDOC;
                 }
                 i += 2;
                 continue;
@@ -328,7 +346,8 @@
 #undef IN_STRING1
 #undef IN_STRING2
 #undef IN_FORMAT
-#undef IN_INPUT
+#undef IN_HEREDOC
+#undef IN_POD
 
 static int perl_mode_probe(ModeDef *mode, ModeProbeData *p)
 {
@@ -336,8 +355,8 @@
     if (match_extension(p->filename, mode->extensions))
         return 80;
 
-    if (p->buf[0] == '#' && p->buf[1] == '!' &&
-          memstr(p->buf, p->line_len, "bin/perl"))
+    if (p->buf[0] == '#' && p->buf[1] == '!'
+    &&  memstr(p->buf, p->line_len, "bin/perl"))
         return 80;
 
     return 1;