fxt_me.cmd

Graphically Assisted Programming Interface

;*****************************************************************************
;
;   FXT_ME.CMD - MicroEMACS MACRO FUNCTIONS FOR
;
;       FFTN (TM) FORTRAN FUNCTION TREE NAVIGATOR
;
;   Copyright (C) Juergen Mueller (J.M.) 1992-1994
;   All rights reserved.
;
;   You are expressly prohibited from selling this software in any form,
;   distributing it with another product, or removing this notice.
;
;   Limited permission is given to registered FXT users to modify this
;   file for their own personal use only. This file may not be used for any
;   purpose other than in conjunction with the FXT software package.
;
;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND,
;   EITHER EXPRESSED OR IMPLIED, INCLUDING, WITHOUT LIMITATION, THE
;   IMPLIED WARRANTIES OF MERCHANTIBILITY OR FITNESS FOR A PARTICULAR
;   PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
;   PROGRAM AND DOCUMENTATION IS WITH YOU.
;
;   written by: Juergen Mueller, Aldingerstrasse 22, D-70806 Kornwestheim,
;               GERMANY
;
;   FILE       : FXT_ME.CMD
;   REVISION   : 16-Mar-1994
;                20:49:49
;
;*****************************************************************************

; NOTE: for OS/2 you should exchange "fftn" with "fftn4os2"
; NOTE: for NT you should exchange "fftn" with "fftn4nt"

;*****************************************************************************
;**** write initial message ****
;*****************************************************************************
write-message "Loading FXT macro package"

;*****************************************************************************
;**** macro package initialization section ****
;*****************************************************************************
set %fxt_item ""                ; set internal variables
set %fxt_file ""
set %fxt_line ""
set %fxtn_cmd ""
set %char_set "_$abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"

set %fft_base &env "FFTNBASE"   ; get environment variables, if set

;*****************************************************************************
;**** definition of user macros ****
;*****************************************************************************

;**** find function ****
store-procedure fft
        execute-procedure _extract_item         ; get tagged item
        execute-procedure _fxt_fft
!endm

;**** find function ****
store-procedure fftmark
        execute-procedure _extract_marked_item  ; get marked item
        execute-procedure _fxt_fft
!endm

;**** find function ****
store-procedure fftfind
        set %fxt_item "FFT function name: "
        set %fxt_item @%fxt_item                ; get user input
        execute-procedure _fxt_fft
!endm

;**** set FFT database name ****
store-procedure fftbase
        set %fft_base "FFT database name: "
        set %fft_base @%fft_base                ; get user input
!endm

;**** FFT file list
store-procedure fftfile
        write-message "Extracting FFT filelist"

        !if &not &seq &len %fft_base 0
          set %tmp &cat &cat "-f" %fft_base " "         ; database access path
        !else
          set %tmp ""
        !endif

        set %fxtn_cmd &cat "fftn -F " %tmp
        pipe-command %fxtn_cmd          ; perform database access, shell command
!endm

;*****************************************************************************
;**** internal macro execution functions ****
;*****************************************************************************

;*****************************************************************************
;* FFT front-end *
;*****************************************************************************
store-procedure _fxt_fft
        !if &seq &len %fxt_item 0
          write-message "No function selected"
          !return
        !endif

        write-message &cat &cat "Searching for function: '" %fxt_item "'"

        !if &not &seq &len %fft_base 0
          set %tmp &cat &cat "-f" %fft_base " "         ; database access path
        !else
          set %tmp ""
        !endif

        set %fxtn_cmd &cat &cat "fftn -b " %tmp %fxt_item
        execute-procedure _fxt_search                   ; start search
!endm

;*****************************************************************************
;* the database retrieval function *
;*****************************************************************************
store-procedure _fxt_search
        set %fxt_file ""                ; clear variables
        set %fxt_line ""

!force  pipe-command %fxtn_cmd          ; perform database access, shell command
        !if &seq $status FALSE
          !return
        !endif

!force  select-buffer command           ; get result buffer from pipe-command
        !if &seq $status FALSE
          !return
        !endif

!force  beginning-of-file               ; go to file begin
        !if &seq $status FALSE
          !return
        !endif

        set-mark                        ; extract target file name

!force  search-forward " "              ; search for first blank after file name
        !if &seq $status FALSE
          !return
        !endif

        backward-character
        copy-region
        set %fxt_file $kill             ; store target file name
        forward-character
        set-mark                        ; extract target file line
        end-of-line
        copy-region
        set %fxt_line $kill             ; store target file line

!force  delete-window                   ; delete command window
!force  delete-buffer command           ; delete command buffer
!force  next-buffer                     ; switch to next buffer just to hide command buf

        !if &not &exist %fxt_file       ; test if file exists
          write-message &cat &cat "Target file ~"" %fxt_file "~" not found"
          !return
        !endif

!force  find-file %fxt_file             ; open target file

        !if &seq $status TRUE
!force    goto-line %fxt_line           ; jump to target line

          !if &seq $status FALSE
            clear-message-line
            !return
          !endif

          delete-other-windows          ; just for safety
          redraw-display                ; center target line
          clear-message-line
        !endif
!endm

;*****************************************************************************
;* read search item from current buffer *
;*****************************************************************************
store-procedure _extract_item
        set %fxt_item ""                ; clear variable

        !if &seq &sindex %char_set &chr $curchar 0
          !return                       ; not on a valid character
        !endif

!force  end-of-word

        !while TRUE
!force  previous-word
!force  backward-character
        !if &seq &sindex %char_set &chr $curchar 0
!force    forward-character
          !break
        !endif
        !endwhile

        set-mark                        ; mark first item character

        !while TRUE
!force  end-of-word                     ; goto end of item
        !if &seq &sindex %char_set &chr $curchar 0
          !break
        !endif
        !endwhile

        copy-region
        set %fxt_item $kill             ; store item name
!endm

;*****************************************************************************
;* read marked search item *
;*****************************************************************************
store-procedure _extract_marked_item
        set %fxt_item ""                                ; clear variable
!force  copy-region
        set %fxt_item $kill                             ; store item name

        !if &not &seq &len %fxt_item 0
          set %fxt_item &cat &cat "~"" %fxt_item "~""   ; quote
        !endif
!endm

;*****************************************************************************
;* bind macros to WINDOWS menu, only if MicroEMACS for WINDOWS is present *
;*****************************************************************************
!if &seq $sres "MSWIN"          ; test, if this is running under MS Windows
  ; insert separator
  bind-to-menu  nop     ">&Miscellaneous>-@5"

  ; create a new underlying pop-up menu for the FFT macros
  macro-to-menu fft     ">&Miscellaneous>F&FT macros@6>FFT &function search@0"
  macro-to-menu fftmark "FFT function search &mark"
  macro-to-menu fftfind "FFT function search &prompt"
  macro-to-menu fftfile "FFT file&list"
  macro-to-menu fftbase "FFT data&base name"
!endif

;*****************************************************************************
;**** write final message ****
;*****************************************************************************
write-message "FXT macro package loaded"

;**** THIS IS THE END THIS IS THE END THIS IS THE END THIS IS THE END ****