ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/WINDOWS/APPS/MEWIN.ZIP/LEVELS_F.CMD

Text File | 1990-02-25 | 5.0 KB | 208 lines

;  levels_f.cmd,  MicroEmacs,  24 Feb 90,  S.D. Maley
;
;  collapse and expand display
;  of lines between matching "fences"
;  for Fortran source code files
;
;  NOTE: you must be on a fence token when you invoke collapse
;
set %fences_1 "IDE"
set %fences_2 "FON"
set %fences_3 "  D"
set %fence_id "(     "
set %fence_e4 "     ID"
set %fence_e5 "IDFO"
set %fence_e6 "FO"

store-procedure chk-fences
;-- presumes caller has placed us at start of "word"
;-- returns %status= 0 (not fence), 1 (IF or DO), -1 (END), 13 (DO <label>)
  set %status 0
  set %i &sindex %fences_1 &upper &chr $curchar
  !if &less %i 1
    !return
  !else
    forward-character
    !if ¬ &sequ &mid %fences_2 %i 1 &upper &chr $curchar
      !return
    !else
      forward-character
      set %chr &upper &chr $curchar
      set %i_id &sindex %fence_id %chr    ;-- check for IF or DO token end
      !if &and &equ %i 1 &less 0 %i_id    ;   (&gre did NOT seem to work here)
        execute-procedure chk-then    ;-- check whether it's a block IF
      !else
      !if &and &equ %i 2 &less 1 %i_id
        execute-procedure chk-do-num
      !else
      !if ¬ &sequ &mid %fences_3 %i 1 %chr
        !return
      !else
        execute-procedure chk-end-trail
      !endif
      !endif
      !endif
    !endif
  !endif
!endm

store-procedure chk-do-num
  end-of-word    ;-- align with token following DO
  previous-word
  !if &less 57 $curchar    ;-- 57: "9"
    set %status 1
  !else
    set %status 13
    set %flabel ""    ; nil
    !while &less 47 $curchar    ; q&d check, 48: "0"
      set %flabel &cat %flabel &chr $curchar
      forward-character
    !endwhile
  !endif
!endm

store-procedure chk-end-trail
;-- check trailing part of END for its many possibilities
  forward-character
  set %i &sindex %fence_e4 &upper &chr $curchar
  !if &less %i 1
    !return
  !endif
  forward-character
  set %chr &upper &chr $curchar
  !if &less %i 3
    set %i &sindex %fence_e5 %i 1 %chr
    !if &or &less %i 0 &less 2 %i
      !return
    !else
      forward-character
      !if ¬ &sequ &mid %fence_e6 %i 1 &upper &chr $curchar
        !return
      !endif
    !endif
  !else    ;-- trailing part of END is contiguous
    !if ¬ &sequ &mid %fence_e5 %i 1 %chr
      !return
    !endif
  !endif
  set %status -1
!endm

set %then "THEN"

store-procedure chk-then
;-- depends on being called from chk-fences, after we know it's an IF
  !force search-forward "("
  !if ¬ $status
    !return
  !endif
  backward-character
  !force goto-matching-fence
  !if ¬ $status
    !return
  !endif
  next-word
  set %rem ""
  set %i 1
  !while &and &less %i 5 ¬ &equ $curchar 13    ;-- 13: newline
    set %rem &cat %rem &upper &chr $curchar
    set %i &add %i 1
    forward-character
  !endwhile
  !if &sequ %rem "THEN"
    !if &less $curchar 34    ;-- token terminate valid
      set %status 1        ;-- a valid block IF statement
    !endif
  !endif
!endm

store-procedure collapse
  set %bfl $curline
  execute-procedure goto-fence-match
  !if %status
    !if &less $curline %bfl
      set %efl %bfl
    !else
      set %efl $curline
      set $curline %bfl
    !endif
    update-screen
    set %whalf &div $wline 2
    !if &less %whalf $cwline
      &sub $cwline %whalf move-window-down
    !endif
    split-current-window
    !if &less $cwline $wline
      &sub $wline $cwline shrink-window
    !endif
    next-window
    set $curline %efl
    &sub $cwline 1 move-window-down
  !else
    write-message "Unmatched"
  !endif
!endm

store-procedure expand
  delete-window
  set $curline %bfl
!endm


store-procedure goto-fence-match
;-- for fences with embedded whitespace, cursor must be on the first "word"
  end-of-word
  previous-word
  execute-procedure chk-fences
  !if &equ %status 0
    set %status FALSE
    write-message "Place cursor on a valid Fortran fence."
    !return
  !endif
  !if &less 1 %status
    !while &less 7 $curcol    ;-- restrict search to Fortran label columns
      !force search-forward %flabel
      !if ¬ $status
        !break
      !endif
    !endwhile
    set %status $status
  !else
    set %nmatch %status
    !if &less %status 0    ;-- find match for END
      !while ¬ &equ %nmatch 0
        !force previous-line
        !if ¬ $status
          set %status FALSE
          !return
        !endif
        execute-procedure tally-fence    ;-- bumps %nmatch
      !endwhile
    !else            ;-- find match for IF or DO
      !while ¬ &equ %nmatch 0
        !force next-line
        !if ¬ $status
          goto %bfl
          set %status FALSE
          !return
        !endif
        execute-procedure tally-fence
      !endwhile
    !endif
    set %status TRUE
  !endif
!endm

store-procedure tally-fence
  !force set $curcol 5
  !if $status
    next-word
    execute-procedure chk-fences
    set %nmatch &add %status %nmatch
  !endif
!endm

;-----------------------------------------------
macro-to-key expand    M-FNC    ;-- <Meta> <Ins>
macro-to-key collapse    M-FND    ;-- <Meta> <Del>