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