home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / epmmac.zip / TAGS.E < prev    next >
Text File  |  1996-03-27  |  38KB  |  1,096 lines

  1. ;
  2. ; This module is a general purpose engine for providing searching and
  3. ; completion for tagged function names.
  4. ;
  5. ; To add support for another language, update tag_case() if it's a case-sensitive
  6. ; language, update tags_supported to indicate what file extensions are supported,
  7. ; and update proc_search to call the procedure search routine for that language.
  8. ;           tag_case()        Returns 'e' for case sensitive languages and
  9. ;                            'c' for case insensitive languages.
  10. ;
  11. ;     xxxxx_proc_search(var proc_name,find_first)
  12. ;                             If proc_name is null, this function searches
  13. ;                             for a valid procedure in the current buffer. If
  14. ;                             successful, proc_name is set to the procedure
  15. ;                             name and 0 is returned.  The find_first parameter
  16. ;                             when non-zero indicates that the first search
  17. ;                             is being performed.
  18. ;
  19. ;                             If proc_name is NOT null, this function searches
  20. ;                             for the definition of the procedure proc_name in
  21. ;                             the current buffer.  If successful, cursor is
  22. ;                             placed on procedure definition and 0 is returned.
  23. ;                             See one of the procedures C_PROC_SEARCH,
  24. ;                             PAS_PROC_SEARCH, or ASM_PROC_SEARCH for an
  25. ;                             example.
  26.  
  27. define
  28. compile if not defined(C_EXTENSIONS)  -- Keep in sync with CKEYS.E
  29.    C_EXTENSIONS = 'C H SQC'
  30. compile endif
  31.  
  32. compile if not defined(CPP_EXTENSIONS)  -- Keep in sync with CKEYS.E
  33.    CPP_EXTENSIONS = 'CPP HPP CXX HXX SQX JAV JAVA'
  34. compile endif
  35.  
  36. compile if not defined(REXX_EXTENSIONS)  -- Keep in sync with REXXKEYS.E
  37.    REXX_EXTENSIONS = 'BAT CMD ERX EXC EXEC XEDIT REX REXX VRX'
  38. compile endif
  39.  
  40.  
  41. defproc tag_case(filename)
  42.    ext=filetype(filename)
  43.    if wordpos(ext, C_EXTENSIONS CPP_EXTENSIONS ) then   /* Case sensitive language? */
  44.       return 'e'
  45.    endif
  46.    return 'c'  /* Case insensitive language? */
  47.  
  48. defproc tags_supported(ext)
  49.    return wordpos(ext, C_EXTENSIONS CPP_EXTENSIONS  'E ASM PAS PASCAL MODULA' REXX_EXTENSIONS)
  50.  
  51. defproc proc_search(var proc_name, first_flag, ext)
  52.    if wordpos(ext, C_EXTENSIONS CPP_EXTENSIONS ) then
  53.       return c_proc_search(proc_name, first_flag, ext)
  54.    elseif ext = 'ASM' then
  55.       return asm_proc_search(proc_name, first_flag)
  56.    elseif ext = 'PAS' | ext = 'PASCAL' then
  57.       return pas_proc_search(proc_name, first_flag)
  58.    elseif ext = 'MOD' | ext = 'MODULA' then
  59.       return pas_proc_search(proc_name, first_flag, 'e')
  60.    elseif ext = 'E' then
  61.       return e_proc_search(proc_name, first_flag)
  62.    elseif wordpos(ext, REXX_EXTENSIONS) then
  63.       return rexx_proc_search(proc_name, first_flag)
  64.    else
  65.       return 1
  66.    endif
  67.  
  68. /****   The above is all that needs to be modified for adding other languages. *****/
  69.  
  70. compile if not defined(SMALL)  -- If SMALL not defined, then being separately
  71.  define INCLUDING_FILE = 'TAGS.E'
  72. const
  73.    tryinclude 'MYCNF.E'        -- the user's configuration customizations.
  74.  
  75.  compile if not defined(SITE_CONFIG)
  76.     const SITE_CONFIG = 'SITECNF.E'
  77.  compile endif
  78.  compile if SITE_CONFIG
  79.     tryinclude SITE_CONFIG
  80.  compile endif
  81.  
  82. include 'stdconst.e'
  83.  
  84. const
  85.  compile if not defined(NLS_LANGUAGE)
  86.    NLS_LANGUAGE = 'ENGLISH'
  87.  compile endif
  88. include NLS_LANGUAGE'.e'
  89. compile endif
  90.  
  91. const
  92. compile if not defined(TAGS_ANYWHERE)
  93.    TAGS_ANYWHERE = 1          -- Set to 0 if all your procedure definitions start in col. 1
  94. compile endif
  95. compile if not defined(C_TAGS_ANYWHERE)
  96.    C_TAGS_ANYWHERE = TAGS_ANYWHERE
  97. compile endif
  98. compile if not defined(E_TAGS_ANYWHERE)
  99.    E_TAGS_ANYWHERE = TAGS_ANYWHERE
  100. compile endif
  101. compile if not defined(ASM_TAGS_ANYWHERE)
  102.    ASM_TAGS_ANYWHERE = TAGS_ANYWHERE
  103. compile endif
  104. compile if not defined(KEEP_TAGS_FILE_LOADED)
  105.    KEEP_TAGS_FILE_LOADED = 1  -- If you do a lot with tags, you might want to keep the file loaded.
  106. compile endif
  107.    IDENTIFIER_STARTER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ_$'
  108.  
  109.  
  110. defc tagsfile
  111.    universal tags_file
  112. compile if KEEP_TAGS_FILE_LOADED
  113.    universal tags_fileid
  114. compile endif
  115.  
  116.    orig_name = tags_file
  117.    if arg(1)='' then
  118.       parse value entrybox(TAGSNAME__MSG,'/'SET__MSG'/'SETP__MSG'/'Cancel__MSG'/'Help__MSG'/',tags_filename(),'',200,
  119.              atoi(1) || atoi(6070) || gethwndc(APP_HANDLE) ||
  120.              TAGSNAME_PROMPT__MSG) with button 2 newname \0
  121.       if button=\1 | button=\2 then
  122.          tags_file = newname
  123.          if button=\2 & tags_file<>'' then
  124.             call setini('TAGSFILE', tags_file)
  125.          endif
  126.       endif
  127.    else
  128.       tags_file = arg(1)
  129.    endif
  130. compile if KEEP_TAGS_FILE_LOADED
  131.    if tags_fileid <> '' & orig_name <> tags_file then  -- New name; drop tags file
  132.       getfileid startfid
  133.       rc = 0
  134.       activatefile tags_fileid
  135.       if rc=0 then 'quit'; endif
  136.       activatefile startfid
  137.    endif
  138. compile endif
  139.  
  140. defc tagsfile_perm
  141.    universal tags_file
  142. compile if KEEP_TAGS_FILE_LOADED
  143.    universal tags_fileid
  144. compile endif
  145.    orig_name = tags_file
  146.    if arg(1) <>'' then
  147.       tags_file = arg(1)
  148.       call setini('TAGSFILE', tags_file)
  149.    endif
  150. compile if KEEP_TAGS_FILE_LOADED
  151.    if tags_fileid <> '' & orig_name <> tags_file then  -- New name; drop tags file
  152.       getfileid startfid
  153.       rc = 0
  154.       activatefile tags_fileid
  155.       if rc=0 then 'quit'; endif
  156.       activatefile startfid
  157.    endif
  158. compile endif
  159.  
  160.  
  161. defproc tags_filename()
  162.    universal tags_file
  163.    if tags_file='' then
  164.       tags_file=checkini(0, 'TAGSFILE', '')
  165.    endif
  166.    if tags_file='' then
  167.       tags_file=get_env('TAGS.EPM')
  168.    endif
  169.    if tags_file='' then
  170.       tags_file='tags.epm'
  171.    endif
  172.    return(tags_file)
  173.  
  174. defc find_tag, findtag
  175. compile if KEEP_TAGS_FILE_LOADED
  176.    universal tags_fileid
  177. compile endif
  178.    button = ''
  179.    file_type = filetype()
  180.    if arg(1)='' then
  181.       /* Try to find the procedure at the cursor. */
  182.       if substr(textline(.line), .col, 1)='(' then left; endif  -- If on paren, shift
  183.       if wordpos(file_type, REXX_EXTENSIONS) then
  184.          token_separators = ' ~`$%^&*()-+=][{}|\:;/><,''"'\t  -- Rexx accepts '!' & '?' as part of the proc name.
  185.       else
  186.          token_separators = ''  -- Use the default defined in find_token()
  187.       endif
  188.       if not find_token(startcol, endcol, token_separators) then
  189.          return 1
  190.       endif
  191.       if wordpos(file_type, CPP_EXTENSIONS) then
  192.          if substr(textline(.line), endcol+1, 2)='::' & pos(upcase(substr(textline(.line), endcol+3, 1)), 'ABCDEFGHIJKLMNOPQRSTUVWXYZ$_') then
  193.             savecol = .col
  194.             .col = endcol+3
  195.             if find_token(startcol2, endcol2) then
  196.                endcol = endcol2
  197.             endif
  198.             .col = savecol
  199.          elseif .col>3 then
  200.             if substr(textline(.line), startcol-2, 2)='::' & pos(upcase(substr(textline(.line), startcol-3, 1)), 'ABCDEFGHIJKLMNOPQRSTUVWXYZ$_') then
  201.                savecol = .col
  202.                .col = startcol-3
  203.                if find_token(startcol2, endcol2) then
  204.                   startcol = startcol2
  205.                endif
  206.                .col = savecol
  207.             endif
  208.          endif
  209.       endif
  210.  
  211.       proc_name = substr(textline(.line), startcol, (endcol-startcol)+1)
  212.       if pos('.', proc_name) then
  213.          proc_name = substr(proc_name, lastpos('.', proc_name)+1)
  214.       endif
  215.    elseif arg(1)='*' then
  216.       parse value entrybox(FINDTAG__MSG,'/'OK__MSG'/'LIST__MSG'/'Cancel__MSG'/'Help__MSG'/',checkini(0, 'FINDTAG_ARG', ''),'',200,
  217.              atoi(1) || atoi(6010) || gethwndc(APP_HANDLE) ||
  218.              FINDTAG_PROMPT__MSG) with button 2 proc_name \0
  219.       if button<>\1 & button<>\2 then return; endif
  220.       if button=\1 then
  221.          call setini('FINDTAG_ARG', proc_name)
  222.       endif
  223.    else
  224.       proc_name = arg(1)
  225.    endif
  226.    getfileid startfid
  227. compile if KEEP_TAGS_FILE_LOADED
  228.    if tags_fileid<>'' then
  229.       rc = 0
  230.       display -2
  231.       activatefile tags_fileid
  232.       display 2
  233.       if rc then
  234.          tags_fileid = ''
  235.       else
  236.          0              -- Go to top of file
  237.       endif
  238.    endif
  239.    if tags_fileid='' then
  240. compile endif
  241.       'e /d ' tags_filename()
  242.       if rc then
  243.          if rc=-282 then  -- -282 = sayerror("New file")
  244.             'quit'
  245.             sayerror "Tag file '"tags_filename()"' not found"
  246.          else
  247.             sayerror "Error loading tag file '"tags_filename()"' -" sayerrortext(rc)
  248.          endif
  249.          return 1
  250.       endif
  251.       getfileid tags_fileid
  252. compile if KEEP_TAGS_FILE_LOADED
  253.       .visible = 0
  254.    endif
  255. compile endif
  256.    if button=\2 then  -- List (delayed until tags_file was loaded)
  257.       sayerror BUILDING_LIST__MSG
  258.       'xcom e /c tagslist'
  259.       if rc<>-282 then  -- -282 = sayerror("New file")
  260.          sayerror ERROR__MSG rc BAD_TMP_FILE__MSG sayerrortext(rc)
  261.          return
  262.       endif
  263.       browse_mode = browse()     -- query current state
  264.       if browse_mode then call browse(0); endif
  265.       .autosave = 0
  266.       getfileid lb_fid
  267.       display -2
  268.       do i=1 to tags_fileid.last
  269.          getline line, i, tags_fileid
  270.          parse value line with tag .
  271.          if tag<>'' & tag<>'*' then
  272.             insertline tag, .last+1
  273.          endif
  274.       enddo
  275.       if browse_mode then call browse(1); endif  -- restore browse state
  276.       display 2
  277.       if not .modify then  -- Nothing added?
  278.          'xcom quit'
  279. compile if KEEP_TAGS_FILE_LOADED
  280.          activatefile startfid
  281. compile else
  282.          'quit'
  283. compile endif
  284.          sayerror NO_TAGS__MSG
  285.          return
  286.       endif
  287.       if listbox_buffer_from_file(tags_fileid, bufhndl, noflines, usedsize) then return; endif
  288.       parse value listbox(LIST_TAGS__MSG,
  289.     compile if 0 -- POWERPC
  290.                           \0 || atol(usedsize) || atol(bufhndl+32),
  291.     compile elseif EPM32
  292.                           \0 || atol(usedsize) || atoi(32) || atoi(bufhndl),
  293.     compile else
  294.                           \0 || atoi(usedsize) || atoi(bufhndl) || atoi(32),
  295.     compile endif -- EPM32
  296.                           '/'OK__MSG'/'Cancel__MSG'/'Help__MSG,1,5,min(noflines,12),0,
  297.     compile if EVERSION >= 5.60
  298.                           gethwndc(APP_HANDLE) || atoi(1) || atoi(1) || atoi(6012)) with button 2 proc_name \0
  299.     compile else
  300.                           atoi(1) || atoi(1) || atoi(6012) || gethwndc(APP_HANDLE)) with button 2 proc_name \0
  301.     compile endif
  302.       call buffer(FREEBUF, bufhndl)
  303.       if button<>\1 then
  304. compile if KEEP_TAGS_FILE_LOADED
  305.          activatefile startfid
  306. compile else
  307.          'quit'
  308. compile endif
  309.          return
  310.       endif
  311.    endif
  312.    name = proc_name  -- Preserve original name.
  313. compile if 1
  314.    if pos(':', proc_name) then
  315.       grep = 'g'  -- Use the older one, because extended GREP treats colons specially
  316.    else
  317.       grep = 'x'  -- Use the faster one!
  318.    endif
  319. compile else
  320.    tc = pos(':', proc_name)
  321.    if tc then
  322.       temp = ''
  323.       do while tc
  324.          temp = temp || leftstr(proc_name, tc-1) || '\:'
  325.          proc_name = substr(proc_name, tc+1)
  326.          tc = pos(':', proc_name)
  327.       enddo
  328.       proc_name = temp || proc_name
  329.    endif
  330.    grep = 'x'  -- Always use the faster one!
  331. compile endif
  332.    display -2
  333.    tc = tag_case(startfid.filename)
  334.    do i=1 to 2
  335.       'xcom l ^'proc_name' 'grep || tc
  336.       if not rc then leave; endif
  337.       proc_name = '_'proc_name  /* Handle case where C call to assembler function needs '_' */
  338.    enddo
  339.    display 2
  340.    long_msg='.  You may want to rebuild the tag file.'
  341.    if rc then
  342. compile if KEEP_TAGS_FILE_LOADED
  343.       activatefile startfid
  344. compile else
  345.       'quit'
  346. compile endif
  347.       sayerror 'Tag for function "'name'" not found in 'tags_filename()long_msg
  348.       return 1
  349.    endif
  350.    parse_tagline(name, filename, fileline, filedate)
  351.    /* Check if there is more than one */
  352.    if .line < .last then
  353.       found_line = .line
  354.       '+1'
  355.       parse_tagline(next_name, next_filename, next_fileline, next_filedate)
  356.       if upcase(name)=upcase(next_name) then
  357.          getfileid tags_fid
  358.          'xcom e /c temp'
  359.          if rc<>-282 then  -- -282 = sayerror("New file")
  360.             'xcom quit'
  361.             return 1
  362.          endif
  363.          browse_mode = browse()     -- query current state
  364.          if browse_mode then call browse(0); endif
  365.          getfileid temp_fid
  366.          .autosave = 0
  367.          insertline '1. 'filename, 2
  368.          activatefile tags_fid
  369.          i = 2
  370.          loop
  371.             if upcase(next_filename) <> upcase(filename) then
  372.                insertline i'. 'next_filename, temp_fid.last+1, temp_fid
  373.                i = i + 1
  374.             endif
  375.             if .line = .last then
  376.                leave
  377.             endif
  378.             '+1'
  379.             parse_tagline(next_name, next_filename, next_fileline, next_filedate)
  380.             if upcase(name)/==upcase(next_name) then
  381.                leave
  382.             endif
  383.          endloop
  384.          activatefile temp_fid
  385.          .modify = 0
  386.          if browse_mode then call browse(1); endif  -- restore browse state
  387.          if .last>2 then
  388.             if listbox_buffer_from_file(tags_fid, bufhndl, noflines, usedsize) then return; endif
  389.             parse value listbox('Select a file',
  390.           compile if 0 -- POWERPC
  391.                                 \0 || atol(usedsize) || atol(bufhndl+32),
  392.           compile elseif EPM32
  393.                                 \0 || atol(usedsize) || atoi(32) || atoi(bufhndl),
  394.           compile else
  395.                                 \0 || atoi(usedsize) || atoi(bufhndl) || atoi(32),
  396.           compile endif -- EPM32
  397.                                 '/'OK__MSG'/'Cancel__MSG'/'Help__MSG,0,0,min(noflines,12),60,
  398.           compile if EVERSION >= 5.60
  399.                                 gethwndc(APP_HANDLE) || atoi(1) || atoi(1) || atoi(6015) ||
  400.           compile else
  401.                                 atoi(1) || atoi(1) || atoi(6015) || gethwndc(APP_HANDLE) ||
  402.           compile endif
  403. ;;                              "'"name"' appears in multiple files.") with button 2 filename \0
  404.                                 "'"name"' appears in multiple files.") with button 2 i '.' \0
  405.             call buffer(FREEBUF, bufhndl)
  406.             if button<>\1 then  -- Didn't select OK
  407.                filename = ''
  408.             else
  409.                --fileline = ''; filedate = ''  -- For now, don't try to keep track.
  410.                found_line+i-1     -- Go to the corresponding line, & parse the correct info.
  411.                parse_tagline(name, filename, fileline, filedate)
  412.             endif
  413.          else
  414.             'xcom quit'
  415.          endif
  416.          if filename='' then
  417. compile if KEEP_TAGS_FILE_LOADED
  418.             activatefile startfid
  419. compile else
  420.             'quit'  -- quit tags file
  421. compile endif
  422.             return 1
  423.          endif
  424.       endif  -- duplicate names
  425.    endif  -- not on last line
  426. compile if KEEP_TAGS_FILE_LOADED
  427.    activatefile startfid
  428. compile else
  429.    'quit'  -- quit tags file
  430. compile endif
  431.  
  432.    getfileid already_loaded, filename
  433.    'e /v' filename
  434.    if rc then
  435.       if rc=-282 then  -- -282 = sayerror("New file")
  436.          'q'
  437.          sayerror "'"filename"' not found"long_msg
  438.       else
  439.          sayerror "Error loading '"filename"' -" sayerrortext(rc)
  440.       endif
  441.       return 1
  442.    endif
  443.    if tc='e' then
  444.       p = pos(proc_name, textline(fileline))
  445.       lp = lastpos(proc_name, textline(fileline))
  446.    else
  447.       p = pos(upcase(proc_name), upcase(textline(fileline)))
  448.       lp = lastpos(upcase(proc_name), upcase(textline(fileline)))
  449.    endif
  450.    if fileline & p & (p=lp) then
  451.       .cursory=.windowheight%2
  452.       fileline
  453.       .col = p
  454.       return
  455.    endif
  456. compile if 0  -- We already checked if the line # was good; the date no longer matters here.
  457.    if filedate<>''  then  -- Line number and file write date preserved
  458.       if filedate=get_file_date(filename) then  -- Same date means file has not been changed,
  459.          display -8
  460.          sayerror 'Jumping straight to line.'  /**/
  461.          display 8
  462.          fileline                               -- so we can jump right to the line.
  463.          .col = 1
  464.          call proc_search(proc_name, 1, file_type)
  465.          return
  466.       endif
  467.    endif
  468. compile endif
  469.    0
  470.    display -8
  471.    sayerror 'Searching for routine.'  /**/
  472.    display 8
  473.    rc=proc_search(proc_name,1,file_type)
  474.    if rc then
  475.       if already_loaded='' then 'quit' endif
  476.       sayerror proc_name" not found in '"filename"'"long_msg
  477.       return 1
  478.    endif
  479.    if already_loaded<>'' then
  480.       sayerror 'File already loaded, starting new view.'
  481.    endif
  482.  
  483. defproc parse_tagline(var name, var filename, var fileline, var filedate)
  484.    parse value textline(.line) with name filename fileline filedate .
  485.    if leftstr(filename,1)='"' & (rightstr(filename,1)<>'"' | length(filename)=1) then
  486.       parse value textline(.line) with name ' "'filename'"' fileline filedate .
  487.       filename = '"'filename'"'
  488.    endif
  489.  
  490. const
  491.    IGNORE_C_KEYWORDS = 'if while switch for case else return ='
  492. compile if not defined(LOG_TAG_MATCHES)
  493.    LOG_TAG_MATCHES = 0
  494. compile endif
  495.  
  496. defproc c_proc_search(var proc_name, find_first, ext)
  497. compile if LOG_TAG_MATCHES
  498.    universal TAG_LOG_FID
  499. compile endif
  500.    proc_len = length(proc_name)
  501.    if wordpos(ext, CPP_EXTENSIONS) then  -- Presumably C++,
  502.       colon=':'                             -- allow colons.
  503.       cpp_decl = '&'                        -- Can have a reference in a declarator
  504.    else                       -- Plain old C, colons are illegal in procedure names.
  505.       colon=''
  506.       cpp_decl = ''
  507.    endif
  508.    display -2
  509.    if find_first then
  510.       if proc_name=='' then
  511. compile if C_TAGS_ANYWHERE
  512.          'xcom l ^:fex'
  513. compile else
  514.          'xcom l ^[A-Za-z_$].*\(ex'
  515. compile endif
  516.       else
  517. ;;       'xcom l 'proc_name'e'
  518.          'xcom l 'proc_name':o\(x'
  519.       endif
  520.    else
  521.       repeat_find
  522.    endif
  523.    loop
  524.       if rc then
  525.          display 2
  526.          return rc
  527.       endif
  528.       getline line
  529.       line=translate(line, ' ', \t)
  530. compile if LOG_TAG_MATCHES
  531.          if TAG_LOG_FID then
  532.             insertline '  Found line' .line '= "'line'"', TAG_LOG_FID.last+1, TAG_LOG_FID
  533.          endif
  534. compile endif
  535.       if proc_len then  -- Determine if match is a substring of something else
  536.          if .col>1 then
  537.             if pos(upcase(substr(line, .col-1, 1)), IDENTIFIER_STARTER'0123456789') then
  538.                end_line; repeat_find; iterate
  539.             endif
  540.          endif
  541.          .col = .col + proc_len
  542.          if pos(upcase(substr(line, .col, 1)), IDENTIFIER_STARTER'0123456789') then
  543.             end_line; repeat_find; iterate
  544.          endif
  545.          p = pos('(', line, .col)
  546.          if not p then
  547.             end_line; repeat_find; iterate
  548.          endif
  549.          .col = p
  550.       else
  551.          .col = pos('(', line)
  552.       endif
  553.       /* Strip trailing comment.  */
  554.       i=pos('//',line)
  555.       if i then
  556.          line=leftstr(line,i-1)
  557.       endif
  558.       loop
  559.          i=pos('/*',line)
  560.          if not i then leave; endif
  561.          j=pos('*/', line, i+2)
  562.          if j then
  563.             /* line=delstr(line,i,j-i+2) */
  564.             line=overlay('', line, i, j-i+2)  -- Keep column alignment
  565.          else
  566.             line=leftstr(line,i-1)
  567.          endif
  568.       endloop
  569.       line = strip(line, 'T')
  570.       if substr(line, .col, 1)='(' & rightstr(line,1)<>';' then
  571.          call psave_pos(save_pos)
  572.          if rightstr(line,1)<>')' | pos('(',line, .col+1) then
  573. ;;          .col=pos('(',line,.col)
  574.             if find_matching_paren() then  -- No match found?
  575. compile if LOG_TAG_MATCHES
  576.                if TAG_LOG_FID then
  577.                   insertline '  ...skipping; no matching paren found.', TAG_LOG_FID.last+1, TAG_LOG_FID
  578.                endif
  579. compile endif
  580.                call prestore_pos(save_pos)
  581.                end_line; repeat_find; iterate  -- Keep looking
  582.             endif
  583.             after_paren_ch=leftstr(strip(substr(translate(textline(.line), ' ', \t),.col+1)),1)
  584.          else
  585.             after_paren_ch=' '
  586.          endif
  587.          do while after_paren_ch = ' ' & .line<.last
  588.             '+1'
  589.             after_paren_ch=leftstr(strip(translate(textline(.line), ' ', \t)),1)
  590.          enddo
  591.          if pos(after_paren_ch,';),([-+*.=?&|}!<>') then
  592. compile if LOG_TAG_MATCHES
  593.             if TAG_LOG_FID then
  594.                insertline '  ...skipping; after_paren_ch in list.  "'after_paren_ch'"', TAG_LOG_FID.last+1, TAG_LOG_FID
  595.             endif
  596. compile endif
  597.             end_line; repeat_find; iterate
  598.          endif
  599.          call prestore_pos(save_pos)
  600.          parse value strip(line) with line '('
  601.          proc_name = lastword(line)
  602.          v = verify(upcase(proc_name), IDENTIFIER_STARTER, 'M')
  603.          if not v then
  604. compile if LOG_TAG_MATCHES
  605.             if TAG_LOG_FID then
  606.                insertline '  ...skipping; verify =' v, TAG_LOG_FID.last+1, TAG_LOG_FID
  607.             endif
  608. compile endif
  609.             end_line; repeat_find; iterate
  610.          endif
  611.          proc_name = substr(proc_name, v)
  612.          if wordpos(proc_name, IGNORE_C_KEYWORDS) then
  613. compile if LOG_TAG_MATCHES
  614.             if TAG_LOG_FID then
  615.                insertline '  ...skipping; procname "'proc_name'" in ignore list', TAG_LOG_FID.last+1, TAG_LOG_FID
  616.             endif
  617. compile endif
  618.             end_line; repeat_find; iterate
  619.          endif
  620.          if verify(upcase(proc_name), IDENTIFIER_STARTER'0123456789'colon) then
  621. compile if LOG_TAG_MATCHES
  622.             if TAG_LOG_FID then
  623.                insertline '  ...skipping; procname "'proc_name'" contains invalid characters', TAG_LOG_FID.last+1, TAG_LOG_FID
  624.             endif
  625. compile endif
  626.             end_line; repeat_find; iterate
  627.          endif
  628.          w=words(line)
  629.          if w>1 then
  630.             if verify(upcase(subword(line,1,w-1)), IDENTIFIER_STARTER'0123456789*()[] 'colon||cpp_decl) then
  631. compile if LOG_TAG_MATCHES
  632.                if TAG_LOG_FID then
  633.                   insertline '  ...skipping; character invalid in a declarator appears before "'proc_name'" in:  'line, TAG_LOG_FID.last+1, TAG_LOG_FID
  634.                endif
  635. compile endif
  636.                end_line; repeat_find; iterate
  637.             endif
  638.          endif
  639.  
  640.          display 2
  641. compile if LOG_TAG_MATCHES
  642.          if TAG_LOG_FID then
  643.             insertline '  ...accepted; proc_name = "'proc_name'"', TAG_LOG_FID.last+1, TAG_LOG_FID
  644.          endif
  645. compile endif
  646.          return 0
  647. compile if LOG_TAG_MATCHES
  648.       elseif not TAG_LOG_FID then  -- do nothing
  649.       elseif substr(line, .col, 1)<>'(' then
  650.          insertline '  ...skipping; .col =' .col'; char = "'substr(line, .col, 1)'"', TAG_LOG_FID.last+1, TAG_LOG_FID
  651.       elseif rightstr(line,1)=';' then
  652.          insertline '  ...skipping; ends in semicolon; line = "'line'"', TAG_LOG_FID.last+1, TAG_LOG_FID
  653.       else
  654.          insertline '  ...skipping; no idea why.', TAG_LOG_FID.last+1, TAG_LOG_FID
  655. compile endif
  656.       endif
  657.       end_line; repeat_find
  658.    endloop
  659.  
  660.  
  661.  
  662. defproc pas_proc_search(var proc_name,find_first)
  663.    tc=arg(3)
  664.    if tc='' then  /* pascal search?*/
  665.       tc='c'  /* ignore case */
  666.    endif
  667.    proc_len = length(proc_name)
  668.    display -2
  669.    if find_first then
  670.       if tc='e' then  /* Must be modula search */
  671.          keywords='(PROCEDURE)'
  672.       else
  673.          keywords='(overlay:b|)(pro(cedure|gram)|function)'
  674.       endif
  675.       if proc_name=='' then
  676.           'xcom l ^:o'keywords':w:c[( \t;:]xc'
  677.       else
  678.          'xcom l 'proc_name''tc
  679.       endif
  680.    else
  681.       repeat_find
  682.    endif
  683. ;  if tc='e' then /* pos function does not support allow e option*/
  684.       tc=''
  685. ;  endif
  686.    loop
  687.       if rc then
  688.          display 2
  689.          return(rc)
  690.       endif
  691.       getline line
  692.       if proc_len then  -- Determine if match is a substring of something else
  693.          if .col>1 then
  694.             c = upcase(substr(line, .col-1, 1))
  695.             if (c>='A' & c<='Z') | (c>='0' & c<='9') | c='$' | c='_'  then
  696.                end_line; repeat_find; iterate
  697.             endif
  698.          endif
  699.          .col = .col + proc_len
  700.          c = upcase(substr(line, .col, 1))
  701.          if (c>='A' & c<='Z') | (c>='0' & c<='9') | c='$' | c='_'  then
  702.             end_line; repeat_find; iterate
  703.          endif
  704.       else
  705.          .col = pos('(', line)
  706.       endif
  707.       line=translate(line, ' ', \t)
  708.       col=.col
  709.       if not pos(' 'keywords'[ \t]',' 'line,'','x'/*||tc*/) then
  710.          end_line; repeat_find; iterate
  711.       endif
  712.       p=pos('[(;:]',line,'','x')
  713.       if p then
  714.          if substr(line,p,1)=='(' then
  715.             .col=p
  716.             call psave_pos(save_pos)
  717.             if find_matching_paren() then
  718.                end_line; repeat_find; iterate
  719.             endif
  720.             call prestore_pos(save_pos)
  721.          endif
  722.          if pos('forward;',textline(.line)) then
  723.             end_line; repeat_find; iterate
  724.          endif
  725.          line=substr(line,1,p-1)
  726.          i=lastpos(' ',strip(translate(line,' ',\t)))
  727.          proc_name=substr(line,i+1)
  728.          display 2
  729.          return 0
  730.       endif
  731.       end_line; repeat_find
  732.    endloop
  733.  
  734. defproc asm_proc_search(var proc_name, find_first)
  735. compile if LOG_TAG_MATCHES
  736.    universal TAG_LOG_FID
  737. compile endif
  738.    display -2
  739.    if find_first then
  740.       if proc_name=='' then
  741.           proc_name=':c'
  742.       endif
  743. compile if ASM_TAGS_ANYWHERE
  744.       'xcom l ^:o'proc_name':wproc(:w|$)xc'
  745. compile else
  746.       'xcom l ^'proc_name':wproc(:w|$)xc'
  747. compile endif
  748.    else
  749.       repeat_find
  750.    endif
  751.    display 2
  752.    parse value translate(textline(.line), ' ', \t) with proc_name .
  753. compile if LOG_TAG_MATCHES
  754.    if TAG_LOG_FID and not rc then
  755.       insertline '  Found proc_name = "'proc_name'" in line' .line '= "'textline(.line)'"', TAG_LOG_FID.last+1, TAG_LOG_FID
  756.    endif
  757. compile endif
  758.    return rc
  759.  
  760. defproc e_proc_search(var proc_name, find_first)
  761. compile if LOG_TAG_MATCHES
  762.    universal TAG_LOG_FID
  763. compile endif
  764.    display -2
  765.    proc_len = length(proc_name)
  766.    if find_first then
  767.       if proc_name=='' then
  768.           proc_name='[A-Z_]'
  769.       endif
  770. compile if E_TAGS_ANYWHERE
  771.       'xcom l ^:oDEFPROC:w'proc_name'cx'
  772. compile else
  773.       'xcom l ^DEFPROC:w'proc_name'cx'
  774. compile endif
  775.    else
  776.       repeat_find
  777.    endif
  778.    loop
  779.       if rc then
  780.          display 2
  781.          return rc
  782.       endif
  783.       parse value translate(textline(.line), ' ', \t) with . proc_name .
  784.       parse value proc_name with proc_name '('
  785.       if proc_len then
  786.          if length(proc_name)<>proc_len then  -- a substring of something else
  787.             end_line; repeat_find; iterate
  788.          endif
  789.       endif
  790. compile if LOG_TAG_MATCHES
  791.       if TAG_LOG_FID and not rc then
  792.          insertline '  Found proc_name = "'proc_name'" in line' .line '= "'textline(.line)'"', TAG_LOG_FID.last+1, TAG_LOG_FID
  793.       endif
  794. compile endif
  795.       leave
  796.    endloop
  797.    display 2
  798.    return rc
  799.  
  800. defproc rexx_proc_search(var proc_name, find_first)
  801. compile if LOG_TAG_MATCHES
  802.    universal TAG_LOG_FID
  803. compile endif
  804.    display -2
  805.    if find_first then
  806.       if proc_name=='' then
  807.          'xcom l :r\:xe'  -- Exact case is faster, & the :r doesn't care about case.
  808.       else
  809.          'xcom l 'proc_name':c'  -- Must do case-insensitive search.
  810.       endif
  811.    else
  812.       repeat_find
  813.    endif
  814.    proc_len = length(proc_name)
  815.    loop
  816.       if rc then
  817.          display 2
  818.          return rc
  819.       endif
  820.       getline line
  821. --    line=translate(line, ' ', \t)
  822. compile if LOG_TAG_MATCHES
  823.       if TAG_LOG_FID then
  824.          insertline '  Found line' .line '= "'line'"', TAG_LOG_FID.last+1, TAG_LOG_FID
  825.       endif
  826. compile endif
  827.       colon = pos(':', line, .col)
  828.       if proc_len then  -- Determine if match is a substring of something else
  829.          if .col>1 then
  830.             c = upcase(substr(line, .col-1, 1))
  831.             if (c>='A' & c<='Z') | (c>='0' & c<='9') | c='!' | c='?' | c='_'  then
  832.                .col = colon + 1
  833.                repeat_find; iterate
  834.             endif
  835.          endif
  836.       endif
  837.       i = 1
  838.       loop                -- Remove comments & quotes
  839.          c=pos('/*',line, i)
  840.          a=pos("'",line, i)
  841.          q=pos('"',line, i)
  842.          if not c & not a & not q then leave; endif
  843.          if c & (not a | a>c) & (not q | q>c) then  -- Open Comment appears first
  844.             j=pos('*/', line, i+2)
  845.             if j then
  846.                line=overlay('', line, c, j-c+2)  -- Keep column alignment
  847.             else
  848.                line=leftstr(line, c-1)
  849.             endif
  850.          else                           -- Single or double quote appears first
  851.             if not q then               -- Figure out which it is...
  852.                q = a;
  853.             elseif a then
  854.                q = min(q, a)
  855.             endif
  856.             j=pos(substr(line, q, 1), line, q+1)
  857.             if j then
  858.                line=overlay('', line, q, j-q+1)  -- Keep column alignment
  859.             else
  860.                line=leftstr(line, q-1)
  861.             endif
  862.          endif
  863.       endloop
  864.       if substr(line, colon, 1)<>':' then  -- Was in a comment or quoted string
  865. compile if LOG_TAG_MATCHES
  866.          if TAG_LOG_FID then
  867.             insertline "  ...skipping; ':' inside a comment or string.", TAG_LOG_FID.last+1, TAG_LOG_FID
  868.          endif
  869. compile endif
  870.          .col = colon + 1
  871.          repeat_find; iterate
  872.       endif
  873.       display 2
  874.       parse value substr(textline(.line), .col) with proc_name ':'
  875. compile if LOG_TAG_MATCHES
  876.       if TAG_LOG_FID then
  877.          insertline '  ...accepted; proc_name = "'proc_name'"', TAG_LOG_FID.last+1, TAG_LOG_FID
  878.       endif
  879. compile endif
  880.       return 0
  881.    endloop
  882.  
  883. defc make_tags
  884.    'maketags' arg(1)
  885.  
  886. defproc find_matching_paren
  887.    n=1
  888.    GETSEARCH search_command -- Save user's search command.
  889.    display -2
  890.    'xcom L /[\(\)]/ex+F'
  891.    loop
  892.       repeatfind
  893.       if rc then leave; endif
  894.       if substr(textline(.line), .col, 1) = '(' then n=n+1; else n=n-1; endif
  895.       if n=0 then leave; endif
  896.    endloop
  897.    display 2
  898.    SETSEARCH search_command -- Restores user's command so Ctrl-F works.
  899.    return rc  /* 0 if found, else sayerror('String not found') */
  900.  
  901. defproc get_file_date(filename)
  902.          pathname = filename\0
  903.          resultbuf = copies(\0,30)
  904. compile if EVERSION >= 6  -- EPM32:  32-bit version
  905.          ca = dynalink32('DOSCALLS',      /* dynamic link library name       */
  906.                          '#223',           /* ordinal value for DOS32QueryPathInfo  */
  907.                          address(pathname)         ||  -- pathname to be queried
  908.                          atol(1)                   ||  -- PathInfoLevel
  909.                          address(resultbuf)        ||  -- buffer where info is to be returned
  910.                          atol(length(resultbuf)) )     -- size of buffer
  911. compile else
  912.          ca = dynalink('DOSCALLS',      /* dynamic link library name       */
  913.                        '#98',           /* ordinal value for DOSQPATHINFO  */
  914.                        address(pathname)         ||  -- pathname to be queried
  915.                        atoi(1)                   ||  -- PathInfoLevel
  916.                        address(resultbuf)        ||  -- buffer where info is to be returned
  917.                        atoi(length(resultbuf))   ||  -- size of buffer
  918.                        atol(0) )                     -- (reserved)
  919. compile endif -- EVERSION >= 6
  920.          return ltoa(substr(resultbuf, 9, 4), 16)
  921.  
  922. compile if EPM32
  923. defc QueryTagsFiles
  924.    universal app_hini
  925.    parse arg hwnd .
  926.    App = INI_TAGSFILES\0
  927.    inidata = copies(' ', MAXCOL)
  928.    l = dynalink32('PMSHAPI',
  929.                   '#115',               -- PRF32QUERYPROFILESTRING
  930.                   atol(app_hini)    ||  -- HINI_PROFILE
  931.                   address(App)      ||  -- pointer to application name
  932.                   atol(0)           ||  -- Key name is NULL; returns all keys
  933.                   atol(0)           ||  -- Default return string is NULL
  934.                   address(inidata)  ||  -- pointer to returned string buffer
  935.                   atol(MAXCOL), 2)      -- max length of returned string
  936.  
  937.    if not l then  -- No tagsfiles saved
  938.       if tags_filename()<>'' then
  939.          maketags_parm = checkini(0, 'MAKETAGS_PARM', '')
  940.          if maketags_parm <> '' then
  941.             call windowmessage(0,  hwnd,
  942.                                32,               -- WM_COMMAND - 0x0020
  943.                                mpfrom2short(1, 4),  -- This is the default (and only one)
  944.                                put_in_buffer(tags_filename()) )
  945. ;           'querytagsfilelist' hwnd tags_filename()
  946.          endif
  947.       endif
  948.       return
  949.    endif
  950.    inidata=leftstr(inidata,l)
  951.  
  952.    tagsfileU = upcase(tags_filename())  -- loop invariant
  953.    do while inidata<>''
  954.       parse value inidata with tagsname \0 inidata
  955.       call windowmessage(0,  hwnd,
  956.                          32,               -- WM_COMMAND - 0x0020
  957.                          mpfrom2short((upcase(tagsname)=tagsfileU), 4),
  958.                          put_in_buffer(tagsname) )
  959.             'querytagsfilelist' hwnd tagsname
  960.    enddo
  961.  
  962. defc QueryTagsFileList
  963.    parse arg hwnd tagsname
  964.    call windowmessage(0,  hwnd,
  965.                       32,               -- WM_COMMAND - 0x0020
  966.                       5,
  967.                       put_in_buffer(TagsFileList(tagsname)))
  968.  
  969. defproc TagsFileList(tagsname)
  970.    universal app_hini
  971.    App = INI_TAGSFILES\0
  972.    tagsnameZ = upcase(tagsname)\0
  973.    inifilelist = copies(' ', MAXCOL)
  974.    l = dynalink32('PMSHAPI',
  975.                   '#115',               -- PRF32QUERYPROFILESTRING
  976.                   atol(app_hini)       ||  -- HINI_PROFILE
  977.                   address(App)         ||  -- pointer to application name
  978.                   address(tagsnameZ)   ||  -- Return value for this key
  979.                   atol(0)              ||  -- Default return string is NULL
  980.                   address(inifilelist) ||  -- pointer to returned string buffer
  981.                   atol(MAXCOL), 2)         -- max length of returned string
  982.    if not l then  -- Not found in .INI file; try the TAGS file's EA
  983.       getfileid startfid
  984.       getfileid fid, tagsname
  985.       continue = 1
  986.       if not fid then
  987.          'xcom e' tagsname
  988.          if rc then
  989.             continue = 0
  990.             if rc=sayerror('New file') then
  991.                'xcom quit'
  992.             endif
  993.          endif
  994.       else
  995.          activatefile fid
  996.       endif
  997.       if continue then
  998.          inifilelist = get_EAT_ASCII_value('EPM.TAGSARGS')
  999.          l = length(inifilelist)
  1000.          if not fid then
  1001.             'xcom quit'
  1002.          endif
  1003.       endif
  1004.       activatefile startfid
  1005.    endif
  1006.    return leftstr(inifilelist, l)
  1007.  
  1008.  
  1009. defc poptagsdlg
  1010.    call windowmessage(0,  getpminfo(APP_HANDLE),
  1011.                       5158,               -- EPM_POPCTAGSDLG
  1012.                       0,
  1013.                       0)
  1014.  
  1015. defc tagsdlg_make
  1016.    universal appname, app_hini
  1017.    parse arg tagsfilename maketagsargs
  1018.    if maketagsargs='' then sayerror -263; return; endif  -- "Invalid argument"
  1019.    call setprofile(app_hini, INI_TAGSFILES, upcase(tagsfilename), maketagsargs)
  1020.    'tagsfile' tagsfilename
  1021.    'maketags' maketagsargs
  1022.  
  1023. defc add_tags_info
  1024.    universal appname, app_hini
  1025.    parse arg tagsfilename maketagsargs
  1026.    if maketagsargs='' then sayerror -263; return; endif  -- "Invalid argument"
  1027.    call setprofile(app_hini, INI_TAGSFILES, upcase(tagsfilename), maketagsargs)
  1028.  
  1029. defc delete_tags_info
  1030.    universal appname, app_hini
  1031.    if arg(1)='' then sayerror -263; return; endif  -- "Invalid argument"
  1032.    call setprofile(app_hini, INI_TAGSFILES, upcase(arg(1)), '')
  1033. compile endif -- EPM32
  1034.  
  1035. defc tagscan
  1036.    ext=filetype()
  1037.    if not tags_supported(ext) then
  1038.       sayerror "Don't know how to do tags for file of type '"ext"'"
  1039.       return 1
  1040.    endif
  1041.    call psave_pos(savepos)
  1042.    0
  1043.    getfileid sourcefid
  1044.    'xcom e /c tagslist'
  1045.    if rc<>-282 then  -- -282 = sayerror("New file")
  1046.       sayerror ERROR__MSG rc BAD_TMP_FILE__MSG sayerrortext(rc)
  1047.       return
  1048.    endif
  1049.    getfileid lb_fid
  1050.    browse_mode = browse()     -- query current state
  1051.    if browse_mode then call browse(0); endif
  1052.    .autosave = 0
  1053.    activatefile sourcefid
  1054.    proc_name=''
  1055.    sayerror 'Searching for procedures...'
  1056.    rc=proc_search(proc_name, 1, ext)
  1057.    while not rc do
  1058.       insertline proc_name '('.line')', lb_fid.last+1, lb_fid
  1059.       proc_name=''
  1060.       end_line
  1061.       rc=proc_search(proc_name, 0, ext)
  1062.    endwhile
  1063.    call prestore_pos(savepos)
  1064.    if browse_mode then call browse(1); endif  -- restore browse state
  1065.    activatefile lb_fid
  1066.  
  1067.    if not .modify then  -- Nothing added?
  1068.       'xcom quit'
  1069.       activatefile sourcefid
  1070.       sayerror NO_TAGS__MSG
  1071.       return
  1072.    endif
  1073.    sayerror 0
  1074.    if listbox_buffer_from_file(sourcefid, bufhndl, noflines, usedsize) then return; endif
  1075.    parse value listbox(LIST_TAGS__MSG,
  1076.  compile if 0 -- POWERPC
  1077.                        \0 || atol(usedsize) || atol(bufhndl+32),
  1078.  compile elseif EPM32
  1079.                        \0 || atol(usedsize) || atoi(32) || atoi(bufhndl),
  1080.  compile else
  1081.                        \0 || atoi(usedsize) || atoi(bufhndl) || atoi(32),
  1082.  compile endif -- EPM32
  1083.                        '/'OK__MSG'/'Cancel__MSG'/'Help__MSG,1,5,min(noflines,12),0,
  1084.  compile if EVERSION >= 5.60
  1085.                        gethwndc(APP_HANDLE) || atoi(1) || atoi(1) || atoi(6012)) with button 2 proc_name \0
  1086.  compile else
  1087.                        atoi(1) || atoi(1) || atoi(6012) || gethwndc(APP_HANDLE)) with button 2 proc_name \0
  1088.  compile endif
  1089.    call buffer(FREEBUF, bufhndl)
  1090.    if button<>\1 then
  1091.       return
  1092.    endif
  1093.    parse value proc_name with procname ' (' linenum ')'
  1094.    linenum; .col = 1
  1095.    '/'procname
  1096.