home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / mlepm.zip / pmode.e < prev    next >
Text File  |  1995-09-14  |  10KB  |  299 lines
  1. /* pmode.e - this is the E part of the Pascal mode package   940522 */
  2.  
  3. /* The enter and space bar keys have been defined to do             */
  4. /* specific Pascal editing features.                                */
  5.  
  6. /* 940522: Martin Lafaix (lafaix@sophia.inria.fr)                   */
  7. /*                                                                  */
  8. /*  .A new function : Pascal_mode.  It sets current editing mode to */
  9. /*   be Pascal mode.                                                */
  10. /*                                                                  */
  11. /* 940510: Martin Lafaix (lafaix@sophia.inria.fr)                   */
  12. /*                                                                  */
  13. /*  .Adapting pkeys.e to hooks.                                     */
  14. /*                                                                  */
  15.  
  16. /* This file is an adaptation of the EPM 'pkeys.e' E Macro file     */
  17.  
  18. compile if not defined(BLACK)
  19. const
  20.    my_p_keys_is_external = 1
  21.    INCLUDING_FILE = 'PMODE.E'
  22.    EXTRA_EX = 0
  23.    include 'stdconst.e'
  24. compile else
  25.    const my_p_keys_is_external = 0
  26. compile endif
  27.  
  28. compile if my_p_keys_is_external = 1
  29.    P_TABS = 3
  30.    P_MARGINS = 1 MAXMARGIN 1
  31.    WANT_CUA_MARKING = 'SWITCH'
  32.    ASSIST_TRIGGER = 'ENTER'
  33.    ENHANCED_ENTER_KEYS = 1
  34.    ENTER_ACTION   = 'ADDATEND'
  35.    c_ENTER_ACTION = 'ADDLINE'
  36.    SYNTAX_INDENT = 3
  37. compile endif
  38.  
  39. compile if INCLUDING_FILE <> 'EXTRA.E'  -- Following only gets defined in the base
  40.  
  41. definit
  42. compile if my_p_keys_is_external=0
  43.    'maddhook load_hook p_load_hook'
  44. compile endif
  45.  
  46. defc Pascal_mode
  47.    keys my_pas_keys
  48.    'msetfilemode Pascal Mode'
  49.  
  50. defc p_load_hook
  51.    universal load_ext
  52.    universal load_var
  53.    if load_ext='PAS' or load_ext='PASCAL' then
  54.  compile if P_TABS <> 0
  55.       if not (load_var // 2) then  -- 1 would be on if tabs set from EA EPM.TABS
  56.          'tabs' P_TABS
  57.       endif
  58.  compile endif
  59.  compile if P_MARGINS <> 0
  60.       if not (load_var%2 - 2*(load_var%4)) then  -- 2 would be on if tabs set from EA EPM.MARGINS
  61.          'ma'   P_MARGINS
  62.       endif
  63.  compile endif
  64.       'Pascal_mode'
  65.    endif
  66.  
  67. compile if WANT_CUA_MARKING & EPM
  68.  defkeys my_pas_keys clear
  69. compile else
  70.  defkeys my_pas_keys
  71. compile endif
  72.  
  73. compile if EVERSION >= 5
  74. def space=
  75. compile else
  76. def ' '=
  77. compile endif
  78.    universal expand_on
  79.    if expand_on then
  80.       if  not pas_first_expansion() then
  81.          keyin ' '
  82.       endif
  83.    else
  84.       keyin ' '
  85.    endif
  86.    undoaction 1, junk                -- Create a new state
  87.  
  88. compile if ASSIST_TRIGGER = 'ENTER'
  89. def enter=
  90.  compile if ENHANCED_ENTER_KEYS & ENTER_ACTION <> ''
  91.    universal enterkey
  92.  compile endif
  93. compile else
  94. def c_enter=
  95.  compile if ENHANCED_ENTER_KEYS & c_ENTER_ACTION <> ''
  96.    universal c_enterkey
  97.  compile endif
  98. compile endif
  99.    universal expand_on
  100.  
  101.    if expand_on then
  102.       if not pas_second_expansion() then
  103. compile if ASSIST_TRIGGER = 'ENTER'
  104.  compile if ENHANCED_ENTER_KEYS & ENTER_ACTION <> ''
  105.          call enter_common(enterkey)
  106.  compile else
  107.          call my_enter()
  108.  compile endif
  109. compile else  -- ASSIST_TRIGGER
  110.  compile if ENHANCED_ENTER_KEYS & c_ENTER_ACTION <> ''
  111.          call enter_common(c_enterkey)
  112.  compile else
  113.          call my_c_enter()
  114.  compile endif
  115. compile endif -- ASSIST_TRIGGER
  116.       endif
  117.    else
  118. compile if ASSIST_TRIGGER = 'ENTER'
  119.  compile if ENHANCED_ENTER_KEYS & ENTER_ACTION <> ''
  120.       call enter_common(enterkey)
  121.  compile else
  122.       call my_enter()
  123.  compile endif
  124. compile else  -- ASSIST_TRIGGER
  125.  compile if ENHANCED_ENTER_KEYS & c_ENTER_ACTION <> ''
  126.       call enter_common(c_enterkey)
  127.  compile else
  128.       call my_c_enter()
  129.  compile endif
  130. compile endif -- ASSIST_TRIGGER
  131.    endif
  132.  
  133. /* Taken out, interferes with some people's c_enter. */
  134. ;def c_enter=   /* I like Ctrl-Enter to finish the comment field also. */
  135. ;   getline line
  136. ;   if pos('{',line) then
  137. ;      if not pos('}',line) then
  138. ;         end_line;keyin' }'
  139. ;      endif
  140. ;   endif
  141. ;   down;begin_line
  142.  
  143. def c_x=       /* Force expansion if we don't have it turned on automatic */
  144.    if not pas_first_expansion() then
  145.       call pas_second_expansion()
  146.    endif
  147. compile endif  -- EXTRA
  148.  
  149. compile if not EXTRA_EX or INCLUDING_FILE = 'EXTRA.E'  -- Following gets defined in EXTRA.EX if it's being used
  150. defproc pas_first_expansion
  151.    retc=1
  152.    if .line then
  153.       getline line
  154.       line=strip(line,'T')
  155.       w=line
  156.       wrd=upcase(w)
  157.       if wrd='FOR' then
  158.          replaceline w' :=  to  do begin'
  159.          insertline substr(wrd,1,length(wrd)-3)'end; {endfor}',.line+1
  160.          if not insert_state() then insert_toggle
  161.              call fixup_cursor()
  162.          endif
  163.          keyin ' '
  164.       elseif wrd='IF' then
  165.          replaceline w' then begin'
  166.          insertline substr(wrd,1,length(wrd)-2)'end else begin',.line+1
  167.          insertline substr(wrd,1,length(wrd)-2)'end; {endif}',.line+2
  168.          if not insert_state() then insert_toggle
  169.              call fixup_cursor()
  170.          endif
  171.          keyin ' '
  172.      elseif wrd='WHILE' then
  173.          replaceline w' do begin'
  174.          insertline substr(wrd,1,length(wrd)-5)'end; {endwhile}',.line+1
  175.          if not insert_state() then insert_toggle
  176.              call fixup_cursor()
  177.          endif
  178.          keyin ' '
  179.       elseif wrd='REPEAT' then
  180.          replaceline w
  181.          insertline substr(wrd,1,length(wrd)-6)'until  ; {endrepeat}',.line+1
  182.          call einsert_line()
  183.          .col=.col+SYNTAX_INDENT
  184.       elseif wrd='CASE' then
  185.          replaceline w' of'
  186.          insertline substr(wrd,1,length(wrd)-4)'end; {endcase}',.line+1
  187.          if not insert_state() then insert_toggle
  188.              call fixup_cursor()
  189.          endif
  190.          keyin ' '
  191.       else
  192.          retc=0
  193.       endif
  194.    else
  195.       retc=0
  196.    endif
  197.    return retc
  198.  
  199. defproc pas_second_expansion
  200.    retc=1
  201.    if .line then
  202.       getline line
  203.       parse value upcase(line) with 'BEGIN' +0 a /* get stuff after begin */
  204.       parse value line with wrd rest
  205.       firstword=upcase(wrd)
  206.       if firstword='FOR' then
  207.          /* do tabs to fields of pascal for statement */
  208.          parse value upcase(line) with a ':='
  209.          if length(a)>=.col then
  210.             .col=length(a)+4
  211.          else
  212.             parse value upcase(line) with a 'TO'
  213.             if length(a)>=.col then
  214.                .col=length(a)+4
  215.             else
  216.                call einsert_line()
  217.                .col=.col+SYNTAX_INDENT
  218.             endif
  219.          endif
  220.       elseif a='BEGIN' or firstword='BEGIN' or firstword='CASE' or firstword='REPEAT' then  /* firstword or last word begin?*/
  221. ;        if firstword='BEGIN' then
  222. ;           replaceline  wrd rest
  223. ;           insert;.col=SYNTAX_INDENT+1
  224. ;        else
  225.             call einsert_line()
  226.             .col=.col+SYNTAX_INDENT
  227. ;        endif
  228.       elseif firstword='VAR' or firstword='CONST' or firstword='TYPE' or firstword='LABEL' then
  229.          if substr(line,1,2)<>'  ' or substr(line,1,3)='   ' then
  230.             getline line2
  231.             replaceline substr('',1,SYNTAX_INDENT)||wrd rest  -- <indent> spaces
  232.             call einsert_line();.col=.col+SYNTAX_INDENT
  233.          else
  234.             call einsert_line()
  235.          endif
  236.       elseif firstword='PROGRAM' then
  237.          /* make up a nice program block */
  238.          parse value rest with name ';'
  239.          getline bottomline,.last
  240.          parse value bottomline with lastname .
  241.          if  lastname = 'end.' then
  242.             retc= 0     /* no expansion */
  243.          else
  244. ;           replaceline  wrd rest
  245.             call einsert_line()
  246.             insertline 'begin {' name '}',.last+1
  247.             insertline 'end. {' name '}',.last+1
  248.          endif
  249.       elseif firstword='UNIT' then       -- Added by M. Such
  250.          /* make up a nice unit block */
  251.          parse value rest with name ';'
  252.          getline bottomline,.last
  253.          parse value bottomline with lastname .
  254.          if  lastname = 'end.' then
  255.             retc= 0     /* no expansion */
  256.          else
  257. ;           replaceline  wrd rest
  258.             call einsert_line()
  259.             insertline 'interface',.last+1
  260.             insertline 'implementation',.last+1
  261.             insertline 'end. {' name '}',.last+1
  262.          endif
  263.       elseif firstword='PROCEDURE' then
  264.          /* make up a nice program block */
  265.          name= getheading_name(rest)
  266. ;        replaceline  wrd rest
  267.          call einsert_line()
  268.          insertline 'begin {' name '}',.line+1
  269.          insertline 'end; {' name '}',.line+2
  270.       elseif firstword='FUNCTION' then
  271.          /* make up a nice program block */
  272.          name=getheading_name(rest)
  273. ;        replaceline  wrd rest
  274.          call einsert_line()
  275.          insertline 'begin {' name '}',.line+1
  276.          insertline 'end; {' name '}',.line+2
  277.       elseif pos('{',line) then
  278.          if not pos('}',line) then
  279.             end_line;keyin' }'
  280.          endif
  281.          call einsert_line()
  282.       else
  283.          retc=0
  284.       endif
  285.    else
  286.       retc=0
  287.    endif
  288.    return retc
  289.  
  290. defproc getheading_name          /*  (heading ) name of heading */
  291.    return substr(arg(1),1,max(0,verify(upcase(arg(1)),
  292.                                 'ABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789')-1))
  293. compile endif  -- EXTRA
  294.  
  295. compile if EVERSION >= 6
  296.    EA_comment 'This is a Pascal editing mode, with automatic syntax expansion and indentation'
  297. compile endif
  298.  
  299.