home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / LISPMODE.ZIP / LISPMODE.E < prev   
Encoding:
Text File  |  1990-07-28  |  12.1 KB  |  480 lines
  1. /* Lisp mode for Epsilon.  This editor mode is intended to be used with
  2.    programs written in Common Lisp or Scheme.  It attempts to be compatible
  3.    with Symbolics Zmacs and GNU Emacs.
  4.  
  5.    (c) Copyright 1990 Carl W. Hoffman.  All rights reserved.
  6.  
  7.    This file may be freely copied, distributed, or modified for non-commercial
  8.    use provided that this copyright notice is not removed.  For further
  9.    information about other Common Lisp and Scheme utilities, contact the
  10.    following address:
  11.  
  12.    Carl W. Hoffman, 363 Marlborough Street, Boston, MA 02115, U.S.A.
  13.    Internet: CWH@AI.MIT.EDU    CompuServe: 76416,3365    Fax: 617-262-4284
  14.  
  15.    This code has been tested with Epsilon version 4.13.
  16.  
  17.    This file expects that FILLPREF.E will also be loaded so as to enable the
  18.    filling of Lisp comments. */
  19.  
  20. #include <eel.h>
  21.  
  22. #define OPEN_PAREN  '('
  23. #define CLOSE_PAREN ')'
  24.  
  25. buffer char fill_prefix[60];
  26. keytable lisp_tab;
  27.  
  28. #define NOT_WHITESPACE           "[^ \t\n]"
  29. #define NOT_WHITESPACE_OR_OPEN   "[^ \t\n(]"
  30. #define NOT_WHITESPACE_OR_CLOSE  "[^ \t\n)]"
  31. #define LISP_BREAK               "[^\\][ \t\n\"|()]"
  32.  
  33. forward_one_sexp()
  34. {
  35.   int start = point;
  36.   int level = 0;
  37.  
  38.   /* Jump over whitespace and close parentheses.
  39.      Abort if we reach the end of the buffer.
  40.      Leave point on the first non-whitespace-or-close character we see. */
  41.  
  42.   if (!re_search(1, NOT_WHITESPACE_OR_CLOSE)) {
  43.     say("At end of buffer");
  44.     point = start;
  45.     return 1;
  46.     }
  47.   point = matchstart;
  48.  
  49.   /* Loop skipping forward over Lisp tokens.  The variable LEVEL keeps
  50.      track of the current nesting level. */
  51.  
  52.   while (1) {
  53.     switch (curchar()) {
  54.  
  55.       case OPEN_PAREN:
  56.         point++;
  57.         level++;
  58.         break;
  59.  
  60.       case CLOSE_PAREN:
  61.         point++;
  62.         if (level > 0) level--;
  63.         break;
  64.  
  65.       case ';':
  66.         nl_forward();
  67.         goto next_token;
  68.  
  69.       case '\'':
  70.       case '`':
  71.       case ',':
  72.         point++;
  73.         goto next_token;
  74.  
  75.       case '#':
  76.         point++;
  77.         switch (curchar()) {
  78.  
  79.           case OPEN_PAREN:                    /* #( */
  80.             point++;
  81.             level++;
  82.             break;
  83.  
  84.           case '+':                           /* #+ */
  85.           case '-':                           /* #- */
  86.             point++;
  87.             goto next_token;
  88.  
  89.           case '\\':                          /* #\ */
  90.             point++;
  91.             if (re_search(1, LISP_BREAK))
  92.               point--;
  93.             break;
  94.  
  95.           default:
  96.             break;
  97.           }
  98.         break;
  99.  
  100.       /* We're inside a string.  Search for the next two-character sequence
  101.          where the first character is not backslash and the second character
  102.          is double quote. */
  103.  
  104.       case '"':
  105.         re_search(1, "[^\\]\"");
  106.         break;
  107.  
  108.       /* We're inside a quoted symbol.  Search for the next two-character
  109.          sequence where the first character is not backslash and the second
  110.          character is vertical bar. */
  111.  
  112.       case '|':
  113.         re_search(1, "[^\\]%|");
  114.         break;
  115.  
  116.       /* We're inside an ordinary symbol.  Search for the next two-character
  117.          sequence where the first character is not a backslash and the second
  118.          character is a Lisp token break character. */
  119.  
  120.       default:
  121.         if (re_search(1, LISP_BREAK))
  122.           point--;
  123.         break;
  124.       }
  125.  
  126.     if (level == 0) return 1;
  127.  
  128.     /* Skip over whitespace to find the start of the next token.  Leave point
  129.        on the break character, if we find one, or at the end of the buffer. */
  130.  
  131.     next_token:
  132.     if (!re_search(1, NOT_WHITESPACE))
  133.       break;
  134.     point = matchstart;
  135.     }
  136.  
  137.   say("Unmatched parentheses");
  138.   point = start;
  139.   return 0;
  140.   }
  141.  
  142. backward_one_sexp()
  143. {
  144.   int start = point;
  145.   int level = 0;
  146.  
  147.   /* Jump over whitespace and open parentheses.
  148.      Abort if we reach the beginning of the buffer. */
  149.  
  150.   if (!re_search(-1, NOT_WHITESPACE_OR_OPEN)) {
  151.     say("At beginning of buffer");
  152.     point = start;
  153.     return 1;
  154.     }
  155.  
  156.   /* Loop skipping backward over Lisp tokens.  The variable LEVEL keeps
  157.      track of the current nesting level. */
  158.  
  159.   while (1) {
  160.     switch (curchar()) {
  161.  
  162.       /* If we see a slashified open paren at the end of a token,
  163.          it is either a character constant or a symbol ending in a
  164.          slashified paren. */
  165.  
  166.       case CLOSE_PAREN:
  167.         if (character(point-1) == '\\') {
  168.           re_search(-1, LISP_BREAK);
  169.           point++;
  170.           }
  171.         else
  172.           level++;
  173.         break;
  174.  
  175.       case OPEN_PAREN:
  176.         if (character(point-1) == '\\') {
  177.           re_search(-1, LISP_BREAK);
  178.           point++;
  179.           }
  180.         else {
  181.           if (level > 0) level--;
  182.           if (index("'`,#", character(point-1)))
  183.             point--;
  184.           else if (index("+-", character(point-1)) &&
  185.                    (character(point-2) == '#'))
  186.                  point -= 2;
  187.           }
  188.         break;
  189.  
  190.       /* We're inside a string.  Search for the next two-character sequence
  191.          where the first character is not backslash and the second character
  192.          is double quote. */
  193.  
  194.       case '"':
  195.         re_search(-1, "[^\\]\"");
  196.         point++;
  197.         break;
  198.  
  199.       /* We're inside a quoted symbol.  Search for the next two-character
  200.          sequence where the first character is not backslash and the second
  201.          character is vertical bar. */
  202.  
  203.       case '|':
  204.         re_search(-1, "[^\\]%|");
  205.         if (!index("'`,", curchar()))
  206.           point++;
  207.         break;
  208.  
  209.       /* We're inside an ordinary symbol.  Search for the next two-character
  210.          sequence where the first character is not a backslash and the second
  211.          character is a Lisp token break character. */
  212.  
  213.       /* We must treat the case of a single Lisp break character at the
  214.          beginnning of the buffer specially, since we won't find it as
  215.          a two-character sequence. */
  216.  
  217.       default:
  218.         if (re_search(-1, LISP_BREAK))
  219.           point = matchstart;
  220.         else if (index("()|\"#", curchar()))
  221.           point++;
  222.         break;
  223.       }
  224.  
  225.     if (level == 0) return 1;
  226.  
  227.     if (!re_search(-1, NOT_WHITESPACE))
  228.       break;
  229.     }
  230.  
  231.   say("Unmatched parentheses");
  232.   point = start;
  233.   return 0;
  234.   }
  235.  
  236. command forward_sexp() on lisp_tab[ALT(CTRL('F'))]
  237. {
  238.   if (iter < 0)
  239.     while (iter++ < 0)
  240.       backward_one_sexp();
  241.   else
  242.     while (iter-- > 0)
  243.       forward_one_sexp();
  244.   }
  245.  
  246. command backward_sexp() on lisp_tab[ALT(CTRL('B'))]
  247. {
  248.   if (iter < 0)
  249.     while (iter++ < 0)
  250.       forward_one_sexp();
  251.   else
  252.     while (iter-- > 0)
  253.       backward_one_sexp();
  254.   }
  255.  
  256. command kill_sexp() on lisp_tab[ALT(CTRL('K'))]
  257. {
  258.   int start = point;
  259.   forward_sexp();
  260.   do_save_kill(start, point);
  261.   }
  262.  
  263. command up_sexp() on lisp_tab[ALT(CTRL('U'))]
  264. {
  265.   while (1) {
  266.     if (!re_search(-1, "[^ \t\n]"))
  267.       break;
  268.     if (curchar() == OPEN_PAREN)
  269.       break;
  270.     point++;
  271.     if (!backward_one_sexp())
  272.       break;
  273.     if (current_column() == 0)
  274.       break;
  275.     }
  276.   }
  277.  
  278. /* What should this command do when the cursor is on an open paren?
  279.    At first I thought it should move forward one character and then
  280.    try to go down a level.  However, this means that C-M-D followed
  281.    by C-M-U doesn't leave you where you began.  So, now I have it
  282.    defined to just go forward one character. */
  283.  
  284. command down_sexp() on lisp_tab[ALT(CTRL('D'))]
  285. {
  286.   int start = point;
  287.   /* Must treat this as a special case since the re_search
  288.      will only look for two character sequences. */
  289.   if (curchar() == OPEN_PAREN) {
  290.     point++;
  291.     return;
  292.     }
  293.   if (!re_search(1, "[^\\][()]"))
  294.     return;
  295.   if (character(point-1) == CLOSE_PAREN) {
  296.     point = start;
  297.     }
  298.   }
  299.  
  300. command begin_defun() on lisp_tab[ALT(CTRL('A'))]
  301. {
  302.   while (1) {
  303.     if (!search(-1, "("))
  304.       break;
  305.     if (current_column() == 0)
  306.       break;
  307.     }
  308.   }
  309.  
  310. lisp_compute_indent()
  311. {
  312.   int start, indent;
  313.   start = point;
  314.  
  315.   /* Find first open or close paren above the current line. */
  316.   to_begin_line();
  317.   if (!re_search(-1, "[()]")) {
  318.     /* No parens at all before point.  
  319.        Leave point at the end of the indentation on the current line. */
  320.     point = start;
  321.     to_indentation();
  322.     indent = current_column();
  323.     /* point = start; */
  324.     return indent;
  325.     }
  326.  
  327.   /* Skip backward over the preceding S-expression.  Then search backward
  328.      for either the beginning of the line or the operator of the current form.
  329.      To correctly indent DO, DO*, UNWIND-PROTECT, and LOOP, it is necessary to
  330.      always search for the operator of the current form. */
  331.  
  332.   if (curchar() == CLOSE_PAREN)
  333.     while (1) {
  334.       point++;
  335.       backward_one_sexp();
  336.       indent = current_column();
  337.       if (!re_search(-1, "[()\n]")) {
  338.         point = start;
  339.         return indent;
  340.         }
  341.       if (curchar() == '\n') {
  342.         point++;
  343.         to_indentation();
  344.         indent = current_column();
  345.         point = start;
  346.         return indent;
  347.         }
  348.       if (curchar() == OPEN_PAREN)
  349.         break;
  350.       }
  351.  
  352.   /* The point is just before an open paren.  Find the indentation of the
  353.      first S-expression following the operator.  Also check the operator name
  354.      for certain special forms. */
  355.  
  356.   {
  357.     int operator_start, operator_end;
  358.     int open_paren_column = current_column();
  359.     point++;
  360.     operator_start = point;
  361.     re_search(1, "[ \t\n(]");
  362.     point--;
  363.     operator_end = point;
  364.     if ((curchar() == ' ') || (curchar() == '\t')) {
  365.       re_search(1, "[^ \t]");
  366.       point--;
  367.       }
  368.     if (curchar() == '\n')
  369.       indent = open_paren_column + 2;
  370.     else {
  371.       /* It might be better to do this with a regexp. */
  372.       char operator[80];
  373.       grab(operator_start, operator_end, operator);
  374.       if (!(   strnfcmp(operator, "def", 3)
  375.             && strnfcmp(operator, "let", 3)
  376.             && strnfcmp(operator, "with", 4)
  377.             &&  strfcmp(operator, "case")
  378.             &&  strfcmp(operator, "flet")
  379.             &&  strfcmp(operator, "when")
  380.             &&  strfcmp(operator, "ccase")
  381.             &&  strfcmp(operator, "ecase")
  382.             &&  strfcmp(operator, "labels")
  383.             &&  strfcmp(operator, "lambda")
  384.             &&  strfcmp(operator, "unless")
  385.             &&  strfcmp(operator, "dolist")
  386.             &&  strfcmp(operator, "dotimes")
  387.             &&  strfcmp(operator, "macrolet")
  388.             &&  strfcmp(operator, "ctypecase")
  389.             &&  strfcmp(operator, "etypecase")
  390.             ))
  391.         indent = open_paren_column + 2;
  392.       else
  393.         indent = current_column();
  394.       }
  395.     }
  396.  
  397.   point = start;
  398.   return indent;
  399.   }
  400.  
  401. lisp_indent() on lisp_tab['\t']
  402. {
  403.   int start = point;
  404.   int offset = 0;
  405.   to_indentation();
  406.   if (point < start) offset = start - point;
  407.   to_column(lisp_compute_indent());
  408.   point += offset;
  409.   }
  410.  
  411. command indent_sexp() on lisp_tab[ALT(CTRL('Q'))]
  412. {
  413.   int start = point;
  414.   int *end = alloc_spot();
  415.   forward_one_sexp();
  416.   *end = point;
  417.   point = start;
  418.   while (1) {
  419.     if (!nl_forward())
  420.       break;
  421.     if (point >= *end)
  422.       break;
  423.     to_column(lisp_compute_indent());
  424.     }
  425.   point = start;
  426.   }
  427.  
  428. /* The command show_matching_delimiter tests to see if move_level
  429.    returns 1, and only then does a show_line.  Should we do the same? */
  430.  
  431. command show_matching_paren() on lisp_tab[CLOSE_PAREN]
  432. {
  433.   int start;
  434.   normal_character();
  435.   start = point;
  436.   say("");
  437.   backward_one_sexp();
  438.   show_line();
  439.   point = start;
  440.   }
  441.  
  442. command insert_parens() on lisp_tab[ALT(OPEN_PAREN)]
  443. {
  444.   stuff("()");
  445.   point--;
  446.   }
  447.  
  448. command move_over_close_paren() on lisp_tab[ALT(CLOSE_PAREN)]
  449. {
  450.   re_search(1, ")");
  451.   }
  452.  
  453. lisp_indenter() { to_column(lisp_compute_indent()); }
  454.  
  455. command lisp_mode ()
  456. {
  457.   mode_keys = lisp_tab;
  458.   indenter = lisp_indenter;
  459.   auto_indent = 1;
  460.   margin_right = 79;
  461.   fill_mode = 0;
  462.   strcpy(fill_prefix, ";; ");
  463.   major_mode = "Lisp";
  464.   make_mode();
  465.   }
  466.  
  467. suffix_lsp()  { lisp_mode(); }
  468. suffix_scm()  { lisp_mode(); }
  469.  
  470. /* Tag all Lisp functions in this file */
  471.  
  472. /*
  473. tag_suffix_lsp()
  474. {
  475.   }
  476.  
  477. tag_suffix_scm() { tag_suffix_lsp(); }
  478.  
  479. */
  480.