home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / mlepm.zip / mlhilite.e < prev    next >
Text File  |  1995-09-19  |  27KB  |  715 lines

  1. /* mlhilite.e - this is the E part of the MlHilite package   940810 */
  2.  
  3. /* Copyright (c) 1994 Martin Lafaix.  All Rights Reserved.          */
  4.  
  5. /* 950819: Martin Lafaix (lafaix@alto.unice.fr)                     */
  6. /*                                                                  */
  7. /*  .Removing all reference to .userstring.  Use msetfilelanguage/  */
  8. /*   mgetfilelanguage instead.                                      */
  9. /*                                                                  */
  10. /* 950810: Martin Lafaix (lafaix@alto.unice.fr)                     */
  11. /*                                                                  */
  12. /*  .User-defined highlighting rules are now used even when there's */
  13. /*   a mode-specific highlighting function.                         */
  14. /*                                                                  */
  15. /* 941026: Martin Lafaix (lafaix@mimosa.unice.fr)                   */
  16. /*                                                                  */
  17. /*  .Bug fixed in mhilite (autohiliting is now disabled while       */
  18. /*   hiliting).                                                     */
  19. /*                                                                  */
  20. /* 940507: Martin Lafaix (lafaix@sophia.inria.fr)                   */
  21. /*                                                                  */
  22. /*  .Hooks used.  So, on-the-fly hiliting is there!                 */
  23. /*  .Improved loadattribute/saveattribute scheme added.             */
  24. /*                                                                  */
  25. /* 940504: Martin Lafaix (lafaix@sophia.inria.fr)                   */
  26. /*                                                                  */
  27. /*  .Added munhilitemark and mpackhilite.                           */
  28. /*                                                                  */
  29. /* 940501: Martin Lafaix (lafaix@sophia.inria.fr)                   */
  30. /*                                                                  */
  31. /*  .Writing docs.                                                  */
  32. /*  .Speed improvements (stdctrl.e now takes 5'34 -- was ~8')       */
  33. /*                                                                  */
  34. /* 940428: Martin Lafaix (lafaix@sophia.inria.fr)                   */
  35. /*                                                                  */
  36. /*  .Initial work :                                                 */
  37. /*    mhilitedef language extensions                                */
  38. /*    mhiliteadd language level style expr                          */
  39. /*    mhiliteclr language [level]                                   */
  40. /*    mhilite[file]                                                 */
  41. /*    munhilite[file]                                               */
  42. /*    mrehilite[file]                                               */
  43. /*    [and all 'highlight' synonyms]                                */
  44. /*                                                                  */
  45.  
  46.  
  47. ;  Usage:
  48. ;
  49. ;  Preliminary notes
  50. ;
  51. ;     This package is designed to be used as an external module.
  52. ;     Put MLHILITE.EX somewhere along your EPMPATH, and insert the
  53. ;     following statement in your profile.erx (you can issue the
  54. ;     command, if you just want to try it) :
  55. ;
  56. ;        link MLHILITE
  57. ;
  58. ;     All functions names are prefixed with an 'm', in order to
  59. ;     prevent name-clash with future (possible) EPM functions.
  60. ;     (We can't expect them to share the same definition, can we? :)
  61. ;
  62. ;     Whenever a function has the string 'hilite' in it, this string
  63. ;     can be replaced with 'highlight'.  And if a part of a function
  64. ;     name is enclosed in square-brackets, this part is optional.  So,
  65. ;     the function
  66. ;
  67. ;        mhilite[file]
  68. ;
  69. ;     stands for
  70. ;
  71. ;        mhilite, mhighlight, mhilitefile and mhighlightfile
  72. ;
  73. ;     Autohiliting requires MLHOOK to be loaded and MPOPUP.EXE to be
  74. ;     up and running.
  75. ;
  76. ;  mhilitedef language extensions
  77. ;
  78. ;     This command defines a new language, or redefines an existing
  79. ;     one.  A file whose extension matches one in 'extensions' will be
  80. ;     handled with the rules defined for 'language'.  If an extension
  81. ;     is part of more than one language, the last defined language
  82. ;     will win the race.  Extensions are case-insensitive.
  83. ;
  84. ;     Example:
  85. ;
  86. ;        mhilitedef REXX CMD ERX
  87. ;
  88. ;     It defines the REXX language.  Files ending with '.cmd' or
  89. ;     '.erx' will be recognized as 'REXX' files
  90. ;
  91. ;  mhiliteadd language level style expr
  92. ;
  93. ;     This command defines a new language rule.  If 'language' has not
  94. ;     be previously defined, an error occurs.  'level' is an integer
  95. ;     (in range 1..4) which defines the "priority" of the rule.  Level
  96. ;     1 is the highest priority.  (See example below for more
  97. ;     explanations on levels.)  'style' is any style defined in the
  98. ;     Style...  dialog box (reachable via the Edit menu).  Specifying
  99. ;     an unknown style name is not an error -- but no styles will be
  100. ;     assigned to the matching expressions in files.  (Styles ARE
  101. ;     case- sensitive.)  'expr' is a string which specifies the
  102. ;     matching expressions.  Its format is:
  103. ;
  104. ;        <delim>expr1<delim>[expr2<delim>]
  105. ;
  106. ;     where <delim> is any character, and expr1 a regular expression.
  107. ;     (If present, expr2 is a regexp, too.)  A matching expression is
  108. ;     defined by expr1, or, if expr2 is present, included between
  109. ;     expr1 and expr2.
  110. ;
  111. ;     Examples:
  112. ;
  113. ;        mhiliteadd REXX 1 Commentaire _/\*_\*/_
  114. ;        mhiliteadd REXX 4 Function ~^[a-zA-Z_][a-zA-Z0-9_]*:~
  115. ;
  116. ;     The first line defines a rule which matches a REXX comment.
  117. ;     The language is REXX, the level is 1, the style name is
  118. ;     'Commentaire', and the expression is composed of a '_'
  119. ;     delimiter, a first expression, '/\*' and a second one, '\*/'.
  120. ;     The first expression matches the REXX opening comment, and the
  121. ;     second matches the closing comment token.  Note the '\'
  122. ;     character in front of '*', as both expressions are regular
  123. ;     expressions.
  124. ;
  125. ;     The second line defines a REXX label, that is, something which
  126. ;     starts on column 1, composed of letters, digits or underscores,
  127. ;     and immediately followed by ':'.  Note that the REXX label rule
  128. ;     level is 4, too.  This means that, if a text matching the rule
  129. ;     (A) is found inside a region of text which has already been
  130. ;     matched by a rule (B) of a higher level, the rule (A) will not
  131. ;     be applied on this matching occurrence.  While I realize it's
  132. ;     not that clear :), let me try an example.  Suppose we have the
  133. ;     following REXX fragment :
  134. ;
  135. ;        /* bla bla bla
  136. ;        foo: ggffggf
  137. ;        bar: 940401
  138. ;        */
  139. ;        baz:
  140. ;
  141. ;     The first rule matches the comment (/* bla ... */), and the
  142. ;     second matches (baz:).  It does not match 'foo:' nor 'bar:',
  143. ;     as theses two expressions are in a region of text which as been
  144. ;     recognized by our first rule (of a higher level).
  145. ;
  146. ;     So, here is the golden rule on levels :
  147. ;
  148. ;     "A rule of a level l does not apply to an expression if this
  149. ;     expression is enclosed in an expression matched by a rule of a
  150. ;     level m <= l."
  151. ;
  152. ;     Note the '<=';  It means that the rules' order is important in
  153. ;     a given level.  Rules are tried in a first-defined/first-tried
  154. ;     order.
  155. ;
  156. ;  mhiliteclr language [level]
  157. ;
  158. ;     This command erases rules defined for a specified language.  If
  159. ;     'language' has not been previously defined, an error occurs.  If
  160. ;     'level' is given, only rules of level 'level' will be removed;
  161. ;     otherwise, ALL rules will be removed.
  162. ;
  163. ;     Example:
  164. ;
  165. ;        mhiliteclr REXX 4
  166. ;
  167. ;     It will remove the 'REXX label' rule (assuming we were using the
  168. ;     previously defined samples statements.)
  169. ;
  170. ;  mhilite[file]
  171. ;
  172. ;     This command highlights the current file.  If the file's
  173. ;     language has a specific highlight function, this function is
  174. ;     used.  Otherwise, language's rules are used.
  175. ;     A specific highlight function is a function whose name follows
  176. ;     the format:
  177. ;
  178. ;        'mhilite_'language'_mark'
  179. ;
  180. ;     [The MyCKeys package defines such a function, mlhilite_C_mark.]
  181. ;
  182. ;  munhilite[file]
  183. ;
  184. ;     This command unhighlights the current file.  That is, all
  185. ;     attributes are removed from the file.
  186. ;
  187. ;     Note: It removes bookmarks, too.
  188. ;
  189. ;  mrehilite[file]
  190. ;
  191. ;     This command first unhighlights the file, and then rehighlights
  192. ;     it.  It's just the same as issuing 'munhilite' followed by
  193. ;     'mhilite'.
  194. ;
  195. ;  munhilitemark
  196. ;
  197. ;     This command unhighlights the current mark.  That is, all
  198. ;     attributes are removed from the mark.
  199. ;
  200. ;  mpackhilite [Not yet completed]
  201. ;
  202. ;     This command packs highlight-attributes, in order to save space
  203. ;     and time while saving attributes.
  204. ;
  205. ;  mautohilite
  206. ;
  207. ;     This command actives or desactives autohighlighting.  The following
  208. ;     parameters are allowed : on, off, 0, 1 or nothing.
  209. ;
  210. ;     Examples:
  211. ;
  212. ;        mautohilite
  213. ;        mautohilite on
  214. ;
  215. ;     The first example shows the current state.  The second sets
  216. ;     autohighlighting mode on.
  217. ;
  218. ;  msetfilelanguage language
  219. ;
  220. ;     This command sets current file language.
  221. ;
  222. ;  hilite_modify_hook
  223. ;
  224. ;     This hook enables autohighlighting.  Add this hook on modify_hook:
  225. ;
  226. ;        maddhook modify_hook hilite_modify_hook
  227. ;
  228. ;  hilite_load_hook
  229. ;
  230. ;     This hook is used to find out a file's language.  Add this hook on
  231. ;     load_hook:
  232. ;
  233. ;        maddhook load_hook hilite_load_hook
  234. ;
  235.  
  236.  
  237.  
  238. compile if not defined(BLACK)
  239. const
  240.    ml_hilite_is_external = 1
  241.    INCLUDING_FILE = 'MLHILITE.E'
  242.    EXTRA_EX = 0
  243.    include 'stdconst.e'
  244. compile else
  245.    const ml_hilite_is_external = 0
  246. compile endif
  247. compile if not defined(NLS_LANGUAGE)
  248.    const NLS_LANGUAGE = 'ENGLISH'
  249. compile endif
  250. include NLS_LANGUAGE'.e'
  251.  
  252. definit
  253.    universal ML_array_ID
  254.    universal ML_autohilite
  255.    universal curline, curlinedone
  256.    ML_autohilite = 1
  257.    curlinedone=1
  258.    curline=0
  259.    do_array 6, ML_array_ID, 'MLARRAY'
  260.    if ML_array_ID='' then
  261.       do_array 1, ML_array_ID, 'MLARRAY'
  262.    endif
  263.  
  264. defproc mgetfilelanguage
  265.    universal ML_array_ID
  266.    getfileid fileid
  267.    if get_array_value(ML_array_ID, fileid'.language', mode) then
  268.       return ''
  269.    else
  270.       return mode
  271.    endif
  272.  
  273. defc msetfilelanguage
  274.    universal ML_array_ID
  275.    getfileid fileid
  276.    parse arg mode
  277.    do_array 2, ML_array_ID, fileid'.language', mode
  278.    'mcallhook select_hook'
  279.  
  280. defc mautohilite, mautohighlight
  281.    universal ML_autohilite
  282.    uparg=upcase(arg(1))
  283.    if uparg=ON__MSG then
  284.       ML_autohilite = 1
  285.       call select_edit_keys()
  286.    elseif uparg=OFF__MSG then
  287.       ML_autohilite = 0
  288.       call select_edit_keys()
  289.    elseif uparg='' then
  290.       sayerror 'AUTOHILITE:' word(OFF__MSG ON__MSG, ML_autohilite+1)
  291.    else
  292.       sayerror INVALID_ARG__MSG ON_OFF__MSG')'
  293.       stop
  294.    endif
  295.  
  296. defc mhighlightadd, mhiliteadd=
  297.    universal ML_array_ID
  298.    parse arg language level style expr
  299.    do_array 3, ML_array_ID, 'languages', languages
  300.    if wordpos(language,languages)=0 then
  301.       sayerror 'Undefined language 'language
  302.    else
  303.       if get_array_value(ML_array_ID,'hl.'language'.'level'.0',item) then
  304.          item=0
  305.       endif
  306.       item=item+1
  307.       do_array 2, ML_array_ID, 'hl.'language'.'level'.0', item
  308.       stem=style expr
  309.       do_array 2, ML_array_ID, 'hl.'language'.'level'.'item, stem
  310.    endif
  311.    return
  312.  
  313. defc mhighlightdef, mhilitedef=
  314.    universal ML_array_ID
  315.    parse arg language extensions
  316.    call get_array_value(ML_array_ID, 'languages', languages)
  317.    if wordpos(language,languages)=0 then
  318.       languages = language' 'languages
  319.    endif
  320.    do_array 2, ML_array_ID, 'lg.'language, extensions
  321.    do_array 2, ML_array_ID, 'languages', languages
  322.    return
  323.  
  324. defc mhighlightclr, mhiliteclr=
  325.    universal ML_array_ID
  326.    parse arg language level
  327.    if level='' then
  328.       for i = 1 to 4
  329.          do_array 4, ML_array_ID, 'hl.'language'.'i'.0'
  330.       endfor
  331.    else
  332.       do_array 4, ML_array_ID, 'hl.'language'.'level'.0'
  333.    endif
  334.  
  335. defc munhighlightfile, munhilitefile, munhilite, munhighlight=
  336.    call psave_mark(savemark)
  337.    class=0; line=0; col=0; off=-255
  338.    attribute_action 1, class, off, col, line
  339.    while class do
  340.       attribute_action 16, class, off, col, line
  341.       class=0; off=-255
  342.       attribute_action 1, class, off, col, line
  343.    endwhile
  344.    call prestore_mark(savemark)
  345.  
  346. defc mrehighlightfile, mrehilitefile, mrehilite, mrehighlight=
  347.    'munhilitefile'
  348.    'mhilitefile'
  349.  
  350. defc munhilitemark, munhighlightmark=
  351.    call checkmark()
  352.    mt = leftstr(marktype(),1)
  353.    getmark fstline, lstline, fstcol, lstcol, fid
  354.    class=0; line=fstline; col=fstcol; off=-255
  355.    attribute_action 1, class, off, col, line
  356.    while class & line<=lstline do
  357.       if mt='L' |
  358.          (mt='B' & col >= fstcol & col <= lstcol) |
  359.          (mt='G' & (line < lstline | col <= lstcol)) then
  360.          attribute_action 16, class, off, col, line
  361.       endif
  362.       class=0; off=-255
  363.       attribute_action 1, class, off, col, line
  364.    endwhile
  365.  
  366. defc mpackhilite
  367.    call psave_mark(savemark)
  368.    class=14; line=0; col=0; off=-255; oldval=0; oldline=0; oldcol=0; oldoff=0
  369.    attribute_action 1, class, off, col, line
  370.    while class do
  371.       query_attribute class, val, IsPush, off, col, line
  372.       if IsPush=0 & val=oldval then
  373.          -- si cote à cote, supprimer
  374.          attribute_action 16, class, oldoff, oldcol, oldline
  375.          attribute_action 16, class, off, col, line
  376.       endif
  377.    endwhile
  378.    call prestore_mark(savemark)
  379.  
  380. defproc isinside(pure)
  381.    universal ML_array_ID
  382.    class=14; line=.line; col=.col; off=-255
  383.    attribute_action 1, class, off, col, line
  384.    if class=14 then
  385.       query_attribute class, val, IsPush, off, col, line
  386.       if IsPush=1 then
  387.          return 0
  388.       else
  389.          -- A ack, here : we're inside, but we're on the starting line
  390.          off2=off; col2=col; line2=line
  391.          attribute_action 3, class, off2, col2, line2
  392.          if class=0 then
  393.             return 0
  394.          endif
  395.          if pure=0 then
  396.             .line=line; .col=col -- side-effect!
  397.          endif
  398.          return 1
  399.       endif
  400.    else
  401.       return 0
  402.    endif
  403.  
  404. defc hilite_load_hook, highlight_load_hook
  405.    universal ML_array_ID, vDEFAULT_AUTOSAVE
  406.    parse value reverse(.filename) with ext'.'remainder
  407.    ext=upcase(reverse(ext)); language=''
  408.    do_array 3, ML_array_ID, 'languages', languages
  409.    for i=1 to words(languages)
  410.       do_array 3, ML_array_ID, 'lg.'word(languages,i), extensions
  411.       if wordpos(ext,extensions) then
  412.          language=word(languages,i)
  413.          leave
  414.       endif
  415.    endfor
  416.    if language<>'' then
  417.       'msetfilelanguage' language
  418.       .autosave=1
  419.    endif
  420.  
  421. defc hilite_modify_hook, highlight_modify_hook
  422.    universal curline, curlinedone, ML_autohilite
  423.    if mgetfilelanguage()='' | .modify=0 | ML_autohilite=0 then
  424.       return
  425.    endif
  426.    .modify=1
  427.    if curline=0 then curline=.line; endif
  428.    if .line<>curline then
  429.       if not curlinedone then
  430.          'ml_hilite_line'
  431.       endif
  432.       curline=.line
  433.    endif
  434.    curlinedone=0
  435.    popupid=dynalink('PMWIN','WINWINDOWFROMID',atoi(0)||atoi(1)||atoi(1234),2)
  436.    choice=windowmessage(0,popupid,4098,getpminfo(EPMINFO_EDITCLIENT),curline)
  437.  
  438. defc ml_hilite_line
  439.    universal ML_array_ID, ML_autohilite
  440.    universal EPM_utility_array_ID
  441.    universal app_hini
  442.    universal curline, curlinedone
  443.    if curlinedone then return; else curlinedone=1; endif
  444.    if curline>.last then return; endif
  445.    oldah=ML_autohilite
  446.    ML_autohilite=0
  447.    language=mgetfilelanguage()
  448.    getsearch oldsearch
  449.    call psave_pos(savepos)
  450.    call psave_mark(savemark)
  451.    .line=curline; .col=1
  452.    if isinside(1)=0 then
  453.       mark_line
  454.       display -12
  455. compile if EVERSION < 5.60
  456.       oldmod=.modify
  457. compile endif
  458.       -- unhilite_line
  459. ;     getline line
  460. ;     replaceline line
  461.       class=0; line=curline; col=0; off=-255
  462.       attribute_action 1, class, off, col, line
  463.       while class & line=curline do
  464.          attribute_action 16, class, off, col, line
  465.          class=0; off=-255
  466.          attribute_action 1, class, off, col, line
  467.       endwhile
  468.       -- rehilite_line
  469.       for i=1 to 4
  470.          do_array 3, ML_array_ID, 'hl.'language'.'i'.0', item
  471.          if item='' then
  472.             iterate
  473.          endif
  474.          for j=1 to item
  475.             do_array 3, ML_array_ID, 'hl.'language'.'i'.'j, stem
  476.             parse value stem with stylename exp
  477.             -- extracting stylename infos
  478.             stylestuff = queryprofile(app_hini, 'Style', stylename)
  479.             if stylestuff='' then return; endif  -- Shouldn't happen
  480.             parse value stylestuff with fontname '.' fontsize '.' fontsel '.' fg '.' bg
  481.             if bg<>'' then fg=bg*16 + fg; else fg=''; endif
  482.             if fontsel<>'' then
  483.                fontid=registerfont(fontname, fontsize, fontsel)
  484.             else
  485.                fontid=''
  486.             endif
  487.             if get_array_value(EPM_utility_array_ID, 'sn.'stylename, styleindex) then  -- See if we have an index
  488.                do_array 3, EPM_utility_array_ID, 'si.0', styleindex          -- Get the
  489.                styleindex = styleindex + 1                                 --   next index
  490.                do_array 2, EPM_utility_array_ID, 'si.0', styleindex          -- Save next index
  491.                do_array 2, EPM_utility_array_ID, 'si.'styleindex, stylename  -- Save index.name
  492.                do_array 2, EPM_utility_array_ID, 'sn.'stylename, styleindex  -- Save name.index
  493.             endif
  494.             -- extracting regexps
  495.             parse value exp with delim 2 starte (delim) ende (delim)
  496. -- sayerror '==> 'starte' / 'ende' <=='i','j','style
  497.             -- Here starts the time-critical part
  498.             .line=curline; .col=0
  499.             if ende='' then
  500.                do forever
  501.                   if .line<>curline then
  502.                      leave
  503.                   endif
  504. compile if EVERSION < 5.60
  505.                   'xcom l 'delim||starte||delim'+gm'
  506. compile else
  507.                   'xcom l 'delim||starte||delim'+xm'
  508. compile endif
  509.                   if rc=-273 then leave; endif -- sayerror 'String not found'
  510.                   if i+j>1 & isinside(0) then iterate; endif
  511.                   fstline=.line; fstcol=.col
  512.                   .col=.col+getpminfo(EPMINFO_LSLENGTH)
  513.                   -- process_style stylename
  514.                   if fg<>'' then
  515.                      insert_attribute 1, fg, 1, -1, fstcol, fstline
  516.                      insert_attribute 1, fg, 0, -1, .col, .line
  517.                   endif
  518.                   if fontid<>'' then
  519.                      insert_attribute 16, fontid, 1, -2, fstcol, fstline
  520.                      insert_attribute 16, fontid, 0, -2, .col, .line
  521.                   endif
  522.                   insert_attribute 14, styleindex, 1, -3, fstcol, fstline
  523.                   insert_attribute 14, styleindex, 0, -3, .col, .line
  524. --                repeatfind
  525.                enddo
  526.             else
  527.                do forever
  528.                   if .line<>curline then
  529.                      leave
  530.                   endif
  531. compile if EVERSION < 5.60
  532.                   'xcom l 'delim||starte||delim'+gm'
  533. compile else
  534.                   'xcom l 'delim||starte||delim'+xm'
  535. compile endif
  536.                   if rc=-273 then leave; endif -- sayerror 'String not found'
  537.                   if i+j>1 & isinside(0) then iterate; endif
  538.                   -- process_style stylename
  539.                   if fg<>'' then
  540.                      insert_attribute 1, fg, 1, -1, .col, .line
  541.                   endif
  542.                   if fontid<>'' then
  543.                      insert_attribute 16, fontid, 1, -2, .col, .line
  544.                   endif
  545.                   insert_attribute 14, styleindex, 1, -3, .col, .line
  546.                   .col=.col+getpminfo(EPMINFO_LSLENGTH)
  547. --                repeatfind
  548.                enddo
  549.                .line=curline; .col=0
  550.                do forever
  551. compile if EVERSION < 5.60
  552.                   'xcom l 'delim||ende||delim'+gm'
  553. compile else
  554.                   'xcom l 'delim||ende||delim'+xm'
  555. compile endif
  556.                   if rc=-273 then leave; endif -- sayerror 'String not found'
  557.                   .col=.col+getpminfo(EPMINFO_LSLENGTH)
  558.                   -- process_style stylename
  559.                   if fg<>'' then
  560.                      insert_attribute 1, fg, 0, -1, .col, .line
  561.                   endif
  562.                   if fontid<>'' then
  563.                      insert_attribute 16, fontid, 0, -2, .col, .line
  564.                   endif
  565.                   insert_attribute 14, styleindex, 0, -3, .col, .line
  566. --                repeatfind
  567.                enddo
  568.             endif
  569.          endfor
  570.       endfor
  571. compile if EVERSION < 5.60
  572.       .modify=oldmod
  573. compile else
  574.       .modify=1
  575. compile endif
  576.       display 12
  577.    endif
  578.    ML_autohilite=oldah
  579.    call prestore_mark(savemark)
  580.    call prestore_pos(savepos)
  581.    setsearch oldsearch
  582.  
  583. defc mhighlightfile, mhilitefile, mhilite, mhighlight=
  584.    universal ML_array_ID, ML_autohilite
  585.    parse value reverse(.filename) with ext'.'remainder
  586.    ext=upcase(reverse(ext)); language=''
  587.    do_array 3, ML_array_ID, 'languages', languages
  588.    for i=1 to words(languages)
  589.       do_array 3, ML_array_ID, 'lg.'word(languages,i), extensions
  590.       if wordpos(ext,extensions) then
  591.          language=word(languages,i)
  592.          leave
  593.       endif
  594.    endfor
  595.    if language='' then
  596.       sayerror 'Unknown file type <'ext'>'
  597.       return
  598.    endif
  599.    oldah=ML_autohilite
  600.    ML_autohilite=0
  601.    if isadefc('mhilite_'language'_mark') then
  602.       'mhilite_'language'_mark'
  603.    endif
  604.    call hiliteit(language)
  605.    ML_autohilite=oldah
  606.  
  607. defproc hiliteit
  608.    universal ML_array_ID
  609.    universal EPM_utility_array_ID
  610.    universal app_hini
  611.    parse arg language
  612.    sayerror 'Highlighting...'
  613.    display -3
  614.    getsearch oldsearch
  615.    call psave_pos(savepos)
  616.    call psave_mark(savemark)
  617.    oldmod=.modify
  618.    for i=1 to 4
  619.       do_array 3, ML_array_ID, 'hl.'language'.'i'.0', item
  620.       if item='' then
  621.          iterate
  622.       endif
  623.       for j=1 to item
  624.          do_array 3, ML_array_ID, 'hl.'language'.'i'.'j, stem
  625.          parse value stem with stylename exp
  626.          -- extracting stylename infos
  627.          stylestuff = queryprofile(app_hini, 'Style', stylename)
  628.          if stylestuff='' then return; endif  -- Shouldn't happen
  629.          parse value stylestuff with fontname '.' fontsize '.' fontsel '.' fg '.' bg
  630.          if bg<>'' then fg=bg*16 + fg; else fg=''; endif
  631.          if fontsel<>'' then
  632.             fontid=registerfont(fontname, fontsize, fontsel)
  633.          else
  634.             fontid=''
  635.          endif
  636.          if get_array_value(EPM_utility_array_ID, 'sn.'stylename, styleindex) then  -- See if we have an index
  637.             do_array 3, EPM_utility_array_ID, 'si.0', styleindex          -- Get the
  638.             styleindex = styleindex + 1                                 --   next index
  639.             do_array 2, EPM_utility_array_ID, 'si.0', styleindex          -- Save next index
  640.             do_array 2, EPM_utility_array_ID, 'si.'styleindex, stylename  -- Save index.name
  641.             do_array 2, EPM_utility_array_ID, 'sn.'stylename, styleindex  -- Save name.index
  642.          endif
  643.          -- extracting regexps
  644.          parse value exp with delim 2 starte (delim) ende (delim)
  645. -- sayerror '==> 'starte' / 'ende' <=='i','j','style
  646.          -- Here starts the time-critical part
  647.          .line=0
  648.          if ende='' then
  649.             do forever
  650. compile if EVERSION < 5.60
  651.                'xcom l 'delim||starte||delim'+g'
  652. compile else
  653.                'xcom l 'delim||starte||delim'+x'
  654. compile endif
  655.                if rc=-273 then leave; endif -- sayerror 'String not found'
  656.                if i>1 & isinside(0) then iterate; endif
  657.                fstline=.line; fstcol=.col
  658.                .col=.col+getpminfo(EPMINFO_LSLENGTH)
  659.                -- process_style stylename
  660.                if fg<>'' then
  661.                   insert_attribute 1, fg, 1, -1, fstcol, fstline
  662.                   insert_attribute 1, fg, 0, -1, .col, .line
  663.                endif
  664.                if fontid<>'' then
  665.                   insert_attribute 16, fontid, 1, -2, fstcol, fstline
  666.                   insert_attribute 16, fontid, 0, -2, .col, .line
  667.                endif
  668.                insert_attribute 14, styleindex, 1, -3, fstcol, fstline
  669.                insert_attribute 14, styleindex, 0, -3, .col, .line
  670.             enddo
  671.          else
  672.             do forever
  673. compile if EVERSION < 5.60
  674.                'xcom l 'delim||starte||delim'+g'
  675. compile else
  676.                'xcom l 'delim||starte||delim'+x'
  677. compile endif
  678.                if rc=-273 then leave; endif -- sayerror 'String not found'
  679.                if i>1 & isinside(0) then iterate; endif
  680.                fstline=.line;fstcol=.col; .col=.col+getpminfo(EPMINFO_LSLENGTH)
  681. compile if EVERSION < 5.60
  682.                'xcom l 'delim||ende||delim'+g'
  683. compile else
  684.                'xcom l 'delim||ende||delim'+x'
  685. compile endif
  686.                .col=.col+getpminfo(EPMINFO_LSLENGTH)
  687.                -- process_style stylename
  688.                if fg<>'' then
  689.                   insert_attribute 1, fg, 1, -1, fstcol, fstline
  690.                   insert_attribute 1, fg, 0, -1, .col, .line
  691.                endif
  692.                if fontid<>'' then
  693.                   insert_attribute 16, fontid, 1, -2, fstcol, fstline
  694.                   insert_attribute 16, fontid, 0, -2, .col, .line
  695.                endif
  696.                insert_attribute 14, styleindex, 1, -3, fstcol, fstline
  697.                insert_attribute 14, styleindex, 0, -3, .col, .line
  698.             enddo
  699.          endif
  700.       endfor
  701.    endfor
  702.    .modify=oldmod+1
  703.    call attribute_on(4)  -- Mixed fonts flag
  704.    call attribute_on(1)  -- Colors flag
  705.    call attribute_on(8)  -- "Save attributes" flag
  706.    call prestore_mark(savemark)
  707.    call prestore_pos(savepos)
  708.    setsearch oldsearch
  709.    display 3
  710.    sayerror 0
  711.  
  712. compile if EVERSION >= 6
  713.    EA_comment 'Provides highlighting for EPM (both on-the-fly and on request)'
  714. compile endif
  715.