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