[Qemacs-commit] qemacs perl.c

[Charlie Gordon]

CVSROOT:        /cvsroot/qemacs
Module name:    qemacs
Changes by:     Charlie Gordon <chqrlie>        07/12/26 10:24:11

Modified files:
        .              : perl.c 

Log message:
        recognise perl module extension .pm
        use qe_isalpha_ and qe_isalnum_
        use more conservative method for special variable matching
        recognize numbers starting with .

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

Patches:
Index: perl.c
===================================================================
RCS file: /cvsroot/qemacs/qemacs/perl.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -b -r1.2 -r1.3
--- perl.c      21 Dec 2007 14:29:54 -0000      1.2
+++ perl.c      26 Dec 2007 10:24:11 -0000      1.3
@@ -20,7 +20,7 @@
 
 #include "qe.h"
 
-static const char *perl_mode_extensions = "pl|perl";
+static const char *perl_mode_extensions = "pl|perl|pm";
 
 /*---------------- Perl colors ----------------*/
 
@@ -44,15 +44,12 @@
 
 static int perl_var(const unsigned int *str, int j, int n)
 {
-    n = n;
-
     if (qe_isdigit(str[j]))
        return j;
     for (; j < n; j++) {
-       if (qe_isalnum(str[j]) || str[j] == '_')
+       if (qe_isalnum_(str[j]))
            continue;
-       if (str[j] == '\''
-       &&  (qe_isalpha(str[j + 1]) || str[j + 1] == '_'))
+       if (str[j] == '\'' && qe_isalpha_(str[j + 1]))
            j++;
        else
            break;
@@ -60,10 +57,8 @@
     return j;
 }
 
-static int perl_number(const unsigned int *str, int j, int n)
+static int perl_number(const unsigned int *str, int j, __unused__ int n)
 {
-    n = n;
-
     if (str[j] == '0') {
        j++;
        if (str[j] == 'x' || str[j] == 'X') {
@@ -92,7 +87,8 @@
 }
 
 /* return offset of matching delimiter or end of string */
-static int perl_string(const unsigned int *str, unsigned int delim, int j, int 
n)
+static int perl_string(const unsigned int *str, unsigned int delim,
+                       int j, int n)
 {
     for (; j < n; j++) {
        if (str[j] == '\\')
@@ -104,7 +100,8 @@
     return j;
 }
 
-static void perl_colorize_line(unsigned int *str, int n, int *statep, int 
state_only)
+static void perl_colorize_line(unsigned int *str, int n, int *statep,
+                               __unused__ int state_only)
 {
     int i = 0, c, c1, c2, j = i, s1, s2, delim = 0;
     int colstate = *statep;
@@ -125,7 +122,6 @@
        set_color(str + j, str + i, PERL_STRING);
     }
     if (colstate & IN_INPUT) {
-       //vdm_noRetrievalKey = 1;
        i = n;
        if (n == perl_eos_len && !umemcmp(perl_eos, str, n)) {
             colstate &= ~IN_INPUT;
@@ -144,19 +140,18 @@
                j = i + 3;
                goto keyword;
            }
-           if (c1 == '#'
-           &&  (qe_isalpha(str[i + 2]) || str[i + 2] == '_'))
+           if (c1 == '#' && qe_isalpha_(str[i + 2]))
                j++;
            else
-           if (!qe_isalpha(c1) && c1 != '_') {
+           if (memchr("|%=-~^123456789&`'+_./\\,\"#$?*0[];!@", c1, 35)) {
                /* Special variable */
                j = i + 2;
                goto keyword;
            }
            /* FALL THRU */
        case '*':
-       case '@':
-       case '%':
+       case '@':       /* arrays */
+       case '%':       /* associative arrays */
        case '&':
            if (j >= n)
                break;
@@ -235,20 +230,29 @@
                    colstate |= IN_STRING2;
                    continue;
                }
+                /* ` string spanning more than one line treated as
+                 * operator.
+                 */
                break;
            }
            s1++;
            set_color(str + i, str + s1, PERL_STRING);
            i = s1;
            continue;
+        case '.':
+            if (qe_isdigit(c1))
+                goto number;
+            break;
+                  
        default:
            if (qe_isdigit(c)) {
+            number:
                j = perl_number(str, i, n);
                set_color(str + i, str + j, PERL_NUMBER);
                i = j;
                continue;
            }
-           if (!qe_isalpha(c) && c != '_')
+           if (!qe_isalpha_(c))
                break;
 
            j = perl_var(str, i, n);