home *** CD-ROM | disk | FTP | other *** search
/ The Developer Connection…ice Driver Kit for OS/2 3 / DEV3-D1.ISO / editors / epm / e_macros / pkeys.e < prev    next >
Encoding:
Text File  |  1993-09-29  |  9.1 KB  |  298 lines

  1. /*                    PASCAL keys                       */
  2. /*                                                      */
  3. /* The enter and space bar keys have been defined to do */
  4. /* specific Pascal syntax structures.                   */
  5.  
  6. compile if not defined(P_SYNTAX_INDENT)
  7. const
  8.    P_SYNTAX_INDENT = SYNTAX_INDENT
  9. compile endif
  10.  
  11. compile if INCLUDING_FILE <> 'EXTRA.E'  -- Following only gets defined in the base
  12. compile if EVERSION >= '4.12'
  13. ;  Keyset selection is now done once at file load time, not every time
  14. ;  the file is selected.  And because the DEFLOAD procedures don't have to be
  15. ;  kept together in the macros (ET will concatenate all the DEFLOADs the
  16. ;  same way it does DEFINITs), we can put the DEFLOAD here where it belongs,
  17. ;  with the rest of the keyset function.  (what a concept!)
  18. ;
  19. defload
  20.    universal load_ext
  21. compile if EPM
  22.    universal load_var
  23. compile endif
  24.    if load_ext='PAS' or load_ext='PASCAL' then
  25.       keys   Pas_keys
  26.  compile if P_TABS <> 0
  27.   compile if EPM
  28.       if not (load_var // 2) then  -- 1 would be on if tabs set from EA EPM.TABS
  29.   compile endif
  30.       'tabs' P_TABS
  31.   compile if EPM
  32.       endif
  33.   compile endif
  34.  compile endif
  35.  compile if P_MARGINS <> 0
  36.   compile if EPM
  37.       if not (load_var%2 - 2*(load_var%4)) then  -- 2 would be on if tabs set from EA EPM.MARGINS
  38.   compile endif
  39.       'ma'   P_MARGINS
  40.   compile if EPM
  41.       endif
  42.   compile endif
  43.  compile endif
  44.    endif
  45. compile endif
  46.  
  47. compile if WANT_CUA_MARKING & EPM
  48.  defkeys pas_keys clear
  49. compile else
  50.  defkeys pas_keys
  51. compile endif
  52.  
  53. compile if EVERSION >= 5
  54. def space=
  55. compile else
  56. def ' '=
  57. compile endif
  58.    universal expand_on
  59.    if expand_on then
  60.       if  not pas_first_expansion() then
  61.          keyin ' '
  62.       endif
  63.    else
  64.       keyin ' '
  65.    endif
  66.  compile if EVERSION >= '5.20'
  67.    undoaction 1, junk                -- Create a new state
  68.  compile endif
  69.  
  70. compile if ASSIST_TRIGGER = 'ENTER'
  71. def enter=
  72.  compile if ENHANCED_ENTER_KEYS & ENTER_ACTION <> ''
  73.    universal enterkey
  74.  compile endif
  75. compile else
  76. def c_enter=
  77.  compile if ENHANCED_ENTER_KEYS & c_ENTER_ACTION <> ''
  78.    universal c_enterkey
  79.  compile endif
  80. compile endif
  81.    universal expand_on
  82.  
  83. compile if EVERSION >= 5
  84.    if expand_on then
  85. compile else
  86.    if expand_on & not command_state() then
  87. compile endif
  88. compile if EVERSION >= '4.12'
  89.       if not pas_second_expansion() then
  90. compile else
  91.       if pas_second_expansion() then
  92.          call maybe_autosave()
  93.       else
  94. compile endif
  95. compile if ASSIST_TRIGGER = 'ENTER'
  96.  compile if ENHANCED_ENTER_KEYS & ENTER_ACTION <> ''
  97.          call enter_common(enterkey)
  98.  compile else
  99.          call my_enter()
  100.  compile endif
  101. compile else  -- ASSIST_TRIGGER
  102.  compile if ENHANCED_ENTER_KEYS & c_ENTER_ACTION <> ''
  103.          call enter_common(c_enterkey)
  104.  compile else
  105.          call my_c_enter()
  106.  compile endif
  107. compile endif -- ASSIST_TRIGGER
  108.       endif
  109.    else
  110. compile if ASSIST_TRIGGER = 'ENTER'
  111.  compile if ENHANCED_ENTER_KEYS & ENTER_ACTION <> ''
  112.       call enter_common(enterkey)
  113.  compile else
  114.       call my_enter()
  115.  compile endif
  116. compile else  -- ASSIST_TRIGGER
  117.  compile if ENHANCED_ENTER_KEYS & c_ENTER_ACTION <> ''
  118.       call enter_common(c_enterkey)
  119.  compile else
  120.       call my_c_enter()
  121.  compile endif
  122. compile endif -- ASSIST_TRIGGER
  123.    endif
  124.  
  125. /* Taken out, interferes with some people's c_enter. */
  126. ;def c_enter=   /* I like Ctrl-Enter to finish the comment field also. */
  127. ;   getline line
  128. ;   if pos('{',line) then
  129. ;      if not pos('}',line) then
  130. ;         end_line;keyin' }'
  131. ;      endif
  132. ;   endif
  133. ;   down;begin_line
  134.  
  135. def c_x=       /* Force expansion if we don't have it turned on automatic */
  136.    if not pas_first_expansion() then
  137.       call pas_second_expansion()
  138.    endif
  139. compile endif  -- EXTRA
  140.  
  141. compile if not EXTRA_EX or INCLUDING_FILE = 'EXTRA.E'  -- Following gets defined in EXTRA.EX if it's being used
  142. defproc pas_first_expansion
  143.    retc=1
  144. compile if EVERSION >= 5
  145.    if .line then
  146. compile else
  147.    if .line and (not command_state()) then
  148. compile endif
  149.       getline line
  150.       line=strip(line,'T')
  151.       w=line
  152.       wrd=upcase(w)
  153.       if wrd='FOR' then
  154.          replaceline w' :=  to  do begin'
  155.          insertline substr(wrd,1,length(wrd)-3)'end; {endfor}',.line+1
  156.          if not insert_state() then insert_toggle
  157. compile if EVERSION >= '5.50'
  158.              call fixup_cursor()
  159. compile endif
  160.          endif
  161.          keyin ' '
  162.       elseif wrd='IF' then
  163.          replaceline w' then begin'
  164.          insertline substr(wrd,1,length(wrd)-2)'end else begin',.line+1
  165.          insertline substr(wrd,1,length(wrd)-2)'end; {endif}',.line+2
  166.          if not insert_state() then insert_toggle
  167. compile if EVERSION >= '5.50'
  168.              call fixup_cursor()
  169. compile endif
  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. compile if EVERSION >= '5.50'
  177.              call fixup_cursor()
  178. compile endif
  179.          endif
  180.          keyin ' '
  181.       elseif wrd='REPEAT' then
  182.          replaceline w
  183.          insertline substr(wrd,1,length(wrd)-6)'until  ; {endrepeat}',.line+1
  184.          call einsert_line()
  185.          .col=.col+P_SYNTAX_INDENT
  186.       elseif wrd='CASE' then
  187.          replaceline w' of'
  188.          insertline substr(wrd,1,length(wrd)-4)'end; {endcase}',.line+1
  189.          if not insert_state() then insert_toggle
  190. compile if EVERSION >= '5.50'
  191.              call fixup_cursor()
  192. compile endif
  193.          endif
  194.          keyin ' '
  195.       else
  196.          retc=0
  197.       endif
  198.    else
  199.       retc=0
  200.    endif
  201.    return retc
  202.  
  203. defproc pas_second_expansion
  204.    retc=1
  205.    if .line then
  206.       getline line
  207.       parse value upcase(line) with 'BEGIN' +0 a /* get stuff after begin */
  208.       parse value line with wrd rest
  209.       firstword=upcase(wrd)
  210.       if firstword='FOR' then
  211.          /* do tabs to fields of pascal for statement */
  212.          parse value upcase(line) with a ':='
  213.          if length(a)>=.col then
  214.             .col=length(a)+4
  215.          else
  216.             parse value upcase(line) with a 'TO'
  217.             if length(a)>=.col then
  218.                .col=length(a)+4
  219.             else
  220.                call einsert_line()
  221.                .col=.col+P_SYNTAX_INDENT
  222.             endif
  223.          endif
  224.       elseif a='BEGIN' or firstword='BEGIN' or firstword='CASE' or firstword='REPEAT' then  /* firstword or last word begin?*/
  225. ;        if firstword='BEGIN' then
  226. ;           replaceline  wrd rest
  227. ;           insert;.col=P_SYNTAX_INDENT+1
  228. ;        else
  229.             call einsert_line()
  230.             .col=.col+P_SYNTAX_INDENT
  231. ;        endif
  232.       elseif firstword='VAR' or firstword='CONST' or firstword='TYPE' or firstword='LABEL' then
  233.          if substr(line,1,2)<>'  ' or substr(line,1,3)='   ' then
  234.             getline line2
  235.             replaceline substr('',1,P_SYNTAX_INDENT)||wrd rest  -- <indent> spaces
  236.             call einsert_line();.col=.col+P_SYNTAX_INDENT
  237.          else
  238.             call einsert_line()
  239.          endif
  240.       elseif firstword='PROGRAM' then
  241.          /* make up a nice program block */
  242.          parse value rest with name ';'
  243.          getline bottomline,.last
  244.          parse value bottomline with lastname .
  245.          if  lastname = 'end.' then
  246.             retc= 0     /* no expansion */
  247.          else
  248. ;           replaceline  wrd rest
  249.             call einsert_line()
  250.             insertline 'begin {' name '}',.last+1
  251.             insertline 'end. {' name '}',.last+1
  252.          endif
  253.       elseif firstword='UNIT' then       -- Added by M. Such
  254.          /* make up a nice unit block */
  255.          parse value rest with name ';'
  256.          getline bottomline,.last
  257.          parse value bottomline with lastname .
  258.          if  lastname = 'end.' then
  259.             retc= 0     /* no expansion */
  260.          else
  261. ;           replaceline  wrd rest
  262.             call einsert_line()
  263.             insertline 'interface',.last+1
  264.             insertline 'implementation',.last+1
  265.             insertline 'end. {' name '}',.last+1
  266.          endif
  267.       elseif firstword='PROCEDURE' then
  268.          /* make up a nice program block */
  269.          name= getheading_name(rest)
  270. ;        replaceline  wrd rest
  271.          call einsert_line()
  272.          insertline 'begin {' name '}',.line+1
  273.          insertline 'end; {' name '}',.line+2
  274.       elseif firstword='FUNCTION' then
  275.          /* make up a nice program block */
  276.          name=getheading_name(rest)
  277. ;        replaceline  wrd rest
  278.          call einsert_line()
  279.          insertline 'begin {' name '}',.line+1
  280.          insertline 'end; {' name '}',.line+2
  281.       elseif pos('{',line) then
  282.          if not pos('}',line) then
  283.             end_line;keyin' }'
  284.          endif
  285.          call einsert_line()
  286.       else
  287.          retc=0
  288.       endif
  289.    else
  290.       retc=0
  291.    endif
  292.    return retc
  293.  
  294. defproc getheading_name          /*  (heading ) name of heading */
  295.    return substr(arg(1),1,max(0,verify(upcase(arg(1)),
  296.                                 'ABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789')-1))
  297. compile endif  -- EXTRA
  298.