home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / jed098-4.zip / JED / LIB / F90.SL < prev    next >
Text File  |  1997-02-01  |  13KB  |  528 lines
  1. %  Free format source F90 mode        -* SLang -*-
  2. %
  3. % Loading this file, then executing 'f90_mode' will start f90 mode
  4. % on the current buffer.
  5.  
  6. !if (is_defined ("F90_Continue_Char"))
  7. {
  8.    variable F90_Continue_Char = "&";      % default continuation char
  9. }
  10.  
  11. !if (is_defined ("F90_Comment_String"))
  12. {
  13.    variable F90_Comment_String = "!";
  14. }
  15.  
  16. !if (is_defined ("F90_Indent_Amount"))
  17. {
  18.    variable F90_Indent_Amount = 2;
  19. }
  20.  
  21. % f90 indent routine
  22. define f90_indent ()
  23. {
  24.    variable goal = 1;        % at top of buffer it should be 1 n'est pas?
  25.    variable cs = CASE_SEARCH;
  26.  
  27.    % goto beginning of line and skip past tabs and spaces
  28.    USER_BLOCK0
  29.      {
  30.     bol ();
  31.     skip_chars (" \t");
  32.     skip_white ();
  33.      }
  34.  
  35.    push_spot ();
  36.    push_spot ();
  37.    CASE_SEARCH = 0;    % F90 is not case sensitive
  38.    while (up_1 ())
  39.      {
  40.     bol_skip_white();
  41.     if (eolp() or looking_at("!") or looking_at("&") or looking_at("#") )
  42.       continue;
  43.     X_USER_BLOCK0 ();
  44.     goal = what_column ();
  45.  
  46. %    if (goal == 1) continue;
  47.  
  48.     skip_chars (" \t1234567890");
  49.     if (looking_at("do ") or looking_at("else")
  50.         or looking_at("function")
  51.         or looking_at("subroutine")
  52.         or looking_at("case")
  53.         or looking_at("interface")
  54.         or looking_at("recursive")
  55.         or looking_at("program")
  56.         )
  57.       goal += F90_Indent_Amount;
  58.     else if (looking_at("select") )
  59.       goal += F90_Indent_Amount * 2;
  60.     else if (looking_at("if ") or looking_at("if("))
  61.       {
  62.          if (ffind ("then")) goal += F90_Indent_Amount;
  63.       }
  64.     else if (looking_at("type ") or looking_at("module "))
  65.       {
  66.          if (not (ffind ("::"))) goal += F90_Indent_Amount;
  67.       }
  68.     break;
  69.      }
  70.  
  71.    % now check current line
  72.    pop_spot ();
  73.    push_spot ();
  74.    X_USER_BLOCK0 ();
  75.  
  76.    if (looking_at("end") )
  77.      {
  78.     if (ffind ("select")) goal -= F90_Indent_Amount * 2;
  79.     else
  80.       goal -= F90_Indent_Amount;
  81.      }
  82.    else if ( looking_at("continue") or
  83.        looking_at("case") or
  84.        looking_at("else")) goal -= F90_Indent_Amount;
  85.  
  86.    CASE_SEARCH = cs;        % done getting indent
  87.    if (goal < 1) goal = 1;
  88.    pop_spot ();
  89.  
  90.    bol_skip_white ();
  91.  
  92.    % after the label or continuation char and indent the rest to goal
  93.    USER_BLOCK1
  94.      {
  95.     %skip_chars ("0-9");
  96.     trim ();
  97.     if (looking_at (F90_Continue_Char))
  98.       {
  99.          go_right_1 (); trim();
  100.          goal += F90_Indent_Amount;
  101.       }
  102.     insert_spaces (goal - what_column());
  103.      }
  104.  
  105.    switch (char(what_char()))
  106. %     {
  107. %    isdigit (()) :        % label
  108. %
  109. %    if (what_column () >= 6)
  110. %      {
  111. %         bol (); trim ();
  112. %         insert_single_space ();
  113. %      }
  114. %    X_USER_BLOCK1 ();
  115. %     }
  116.      {
  117.     case F90_Continue_Char :    % continuation character
  118.     bol (); trim ();
  119.     X_USER_BLOCK1 ();
  120.      }
  121.      {
  122.     pop (); not (bolp()) or eolp ():    % general case
  123.     bol (); trim ();
  124.     insert_spaces (goal--, goal);
  125.      }
  126.    pop_spot ();
  127.    skip_white ();
  128. }
  129.  
  130. define f90_is_comment ()
  131. {
  132.    bol ();
  133.    looking_at("!");
  134. }
  135.  
  136. define f90_newline ()
  137. {
  138.    variable p, cont , cont1;
  139.  
  140.    if (bolp ())
  141.      {
  142.     newline ();
  143.     return;
  144.      }
  145.  
  146.    f90_indent ();
  147.    push_spot ();
  148.    bskip_white (); trim ();
  149.  
  150.    if (what_column () > 72)
  151.      {
  152.     push_spot ();
  153.     bol_skip_white();
  154.     !if (bolp()) message ("Line exceeds 72 columns.");
  155.     pop_spot ();
  156.      }
  157.  
  158.    p = POINT;
  159.    bskip_chars("-+*=/,(&");
  160.  
  161.    cont = (p != POINT);
  162.    cont1 = cont;
  163.  
  164.    if ( cont )
  165.      {
  166.     if ( looking_at( "&" ) )
  167.       {
  168.          cont1 = 0;
  169.       }
  170.      }
  171.      
  172.    if (f90_is_comment ()) cont = 0;
  173.  
  174.    bol_skip_white ();
  175.    if (looking_at("data ")) cont = 0;
  176.  
  177.    pop_spot ();
  178.  
  179.    if (cont1)
  180.      {
  181.     insert( " " );
  182.     insert(F90_Continue_Char);
  183.      }
  184.    newline ();
  185.    if ( cont ) 
  186.      {
  187.     insert(F90_Continue_Char);
  188.     insert( " " );
  189.      }
  190.    insert_single_space ();
  191.    f90_indent ();
  192. }
  193.  
  194. define f90_continue_newline ()
  195. {
  196.    f90_newline ();
  197.  
  198.    push_spot ();
  199.    bol_skip_white ();
  200.    if (looking_at(F90_Continue_Char)) pop_spot ();
  201.    else
  202.      {
  203.     insert (F90_Continue_Char);
  204.     pop_spot ();
  205.     f90_indent ();
  206.     go_right_1 ();
  207.     skip_white ();
  208.      }
  209. }
  210.  
  211. %
  212. %   electric labels
  213. %
  214. define f90_electric_label ()
  215. {
  216.    insert_char (LAST_CHAR);
  217.    push_spot ();
  218.  
  219.    if (f90_is_comment ()) pop_spot ();
  220.    else
  221.      {
  222.     bol_skip_white ();
  223.     skip_chars ("0-9"); trim ();
  224.     pop_spot ();
  225.     f90_indent ();
  226.      }
  227. }
  228.  
  229. % f90 comment/uncomment functions
  230.  
  231. define f90_uncomment ()
  232. {
  233.    push_spot ();
  234.    if (f90_is_comment ())
  235.      {
  236.     bol ();
  237.     if (looking_at (F90_Comment_String))
  238.       deln (strlen (F90_Comment_String));
  239.     else del ();
  240.      }
  241.  
  242.    f90_indent ();
  243.    pop_spot ();
  244.    go_down_1 ();
  245. }
  246.  
  247. define f90_comment ()
  248. {
  249.    !if (f90_is_comment ())
  250.      {
  251.     push_spot ();
  252.     bol ();
  253.     insert (F90_Comment_String);
  254.      }
  255.    pop_spot ();
  256.    go_down_1 ();
  257. }
  258.  
  259. %
  260. % Look for beginning of current subroutine/function
  261. %
  262. define f90_beg_of_subprogram ()
  263. {
  264.    variable cs = CASE_SEARCH;
  265.  
  266.    CASE_SEARCH = 0;
  267.    do
  268.      {
  269.     bol_skip_white ();
  270.     if (POINT)
  271.       {
  272.          if (looking_at ("program")
  273.          or looking_at ("function")
  274.          or looking_at ("subroutine")) break;
  275.       }
  276.      }
  277.    while (up_1 ());
  278.    CASE_SEARCH = cs;
  279. }
  280.  
  281. %
  282. % Look for end of current subroutine/function
  283. %
  284. define f90_end_of_subprogram ()
  285. {
  286.    variable cs = CASE_SEARCH;
  287.    CASE_SEARCH = 0;
  288.  
  289.    do
  290.      {
  291.     bol_skip_white ();
  292.     if (looking_at ("end"))
  293.       {
  294.          go_right (3);
  295.          skip_white ();
  296.          if (eolp ()) break;
  297.       }
  298.      }
  299.    while (down_1 ());
  300.    CASE_SEARCH = cs;
  301. }
  302.  
  303. define f90_mark_subprogram ()
  304. {
  305.    f90_end_of_subprogram ();
  306.    go_down_1 ();
  307.    push_mark (); call ("set_mark_cmd");
  308.    f90_beg_of_subprogram ();
  309.    bol ();
  310. }
  311.  
  312. %
  313. % shows a ruler for F90 source. Press any key to get rid of
  314. %
  315. define f90_ruler ()
  316. {
  317.    variable c = what_column ();
  318.    variable r = window_line ();
  319.  
  320.    bol ();
  321.    push_mark ();
  322.    insert ("    5 7 10   15   20   25   30   35   40   45   50   55   60   65   70\n");
  323.    insert ("{    }|{ |    |    |    |    |    |    |    |    |    |    |    |    | }\n");
  324.  
  325.    goto_column (c);
  326.    if (r <= 2) r = 3;
  327.    recenter (r);
  328.    message ("Press SPACE to get rid of the ruler.");
  329.    update (1);
  330.    () = getkey ();
  331.    bol ();
  332.    del_region ();
  333.    goto_column (c);
  334.    flush_input ();
  335.    recenter (r);
  336. }
  337.  
  338. define f90_prev_next_statement (dirfun)
  339. {
  340.    while (dirfun)
  341.      {
  342.     bol ();
  343.     skip_chars ("^0-9 \t");
  344.     !if (POINT) break;
  345.      }
  346.    () = goto_column_best_try (1);
  347. }
  348. %
  349. % moves cursor to the next statement, skipping comment lines
  350. %
  351. define f90_next_statement ()
  352. {
  353.    f90_prev_next_statement (&down_1);
  354. }
  355.  
  356. %
  357. % moves cursor to the previous f90 statement, skipping comments
  358. %
  359. define f90_previous_statement ()
  360. {
  361.    f90_prev_next_statement (&up_1);
  362. }
  363.  
  364. %
  365. % main entry point into the f90 mode
  366. %
  367.  
  368. $1 = "F90";
  369. !if (keymap_p ($1)) make_keymap ($1);
  370.  
  371. definekey ("f90_comment",        "\e;",    $1);
  372. definekey ("f90_uncomment",        "\e:",    $1);
  373. definekey ("f90_continue_newline",    "\e\r",    $1);
  374. % next two really needed?  not if using EDT or Emacs
  375. definekey ("self_insert_cmd",        char('\''),    $1);
  376. definekey ("self_insert_cmd",        char('"'),    $1);
  377. definekey ("f90_beg_of_subprogram",    "\e^A",    $1);
  378. definekey ("f90_end_of_subprogram",    "\e^E",    $1);
  379. definekey ("f90_mark_function",        "\e^H", $1);
  380. definekey ("f90_next_statement",        "^C^N",    $1);
  381. definekey ("f90_previous_statement",    "^C^P",    $1);
  382. definekey ("f90_ruler",            "^C^R", $1);
  383. %_for (0, 9, 1)
  384. %{
  385. %   $2 = ();
  386. %   definekey ("f90_electric_label", string($2), $1);
  387. %}
  388.  
  389.  
  390. % Set up syntax table
  391. $1 = "F90";
  392. create_syntax_table ($1);
  393. define_syntax ("!", "", '%', $1);
  394. define_syntax ("([", ")]", '(', $1);
  395. define_syntax ('"', '"', $1);
  396. define_syntax ('\'', '\'', $1);
  397. % define_syntax ('\\', '\\', $1);
  398. define_syntax ("0-9a-zA-Z_", 'w', $1);        % words
  399. define_syntax ("-+0-9eEdD", '0', $1);   % Numbers
  400. define_syntax (",.", ',', $1);
  401. define_syntax ('#', '#', $1);
  402. define_syntax ("-+/*=", '+', $1);
  403. set_syntax_flags ($1, 1);
  404.  
  405. % F77 keywords + include, record, structure, while:
  406. % backspace block
  407. % call character common complex continue
  408. % data dimension do double
  409. % else end enddo endfile endif entry equivalence exit external
  410. % format function
  411. % goto
  412. % if implicit include inquire integer intrinsic
  413. % logical
  414. % parameter pause precision program
  415. % real return rewind
  416. % save stop subroutine
  417. % then
  418. % while
  419. %
  420. % Extensions for Fortran 90:
  421. % allocatable
  422. % allocate
  423. % case
  424. % contains
  425. % deallocate
  426. % elsewhere
  427. % endblockdata
  428. % endfunction
  429. % endinterface
  430. % endmodule
  431. % endprogram
  432. % endselect
  433. % endsubroutine
  434. % endtype
  435. % endwhere
  436. % intent
  437. % interface
  438. % kind
  439. % module
  440. % moduleprocedure
  441. % namelist
  442. % nullify
  443. % optional
  444. % pointer
  445. % private
  446. % public
  447. % recursive
  448. % select
  449. % selectcase
  450. % sequence
  451. % target
  452. % type
  453. % use
  454. % where
  455. % 
  456. () = define_keywords ($1, "dogoifto", 2);
  457. () = define_keywords ($1, "enduse", 3);
  458. () = define_keywords ($1, "callcasedataelseexitgotokindopenreadrealsavestopthentype", 4);
  459. () = define_keywords ($1, "blockcloseenddoendifentrypauseprintwherewhilewrite", 5);
  460. () = define_keywords ($1, "commondoubleformatintentmodulepublicrecordreturnrewindselecttarget", 6);
  461. () = define_keywords ($1, "complexendfileendtypeincludeinquireintegerlogicalnullifypointerprivateprogram", 7);
  462. () = define_keywords ($1, "allocatecontainscontinueendwhereexternalfunctionimplicitnamelistoptionalsequence", 8);
  463. () = define_keywords ($1, "backspacecharacterdimensionelsewhereendmoduleendselectinterfaceintrinsicparameterprecisionrecursivestructure", 9);
  464. () = define_keywords ($1, "deallocateendprogramselectcasesubroutine", 10);
  465. () = define_keywords ($1, "allocatableendfunctionequivalence", 11);
  466. () = define_keywords ($1, "endblockdataendinterface", 12);
  467. () = define_keywords ($1, "endsubroutine", 13);
  468. () = define_keywords ($1, "moduleprocedure", 15);
  469.  
  470. () = define_keywords_n ($1, "eqgegtleltneor", 2, 1);
  471. () = define_keywords_n ($1, "absallandanycosdimexpintiorlenlgelgtllelltlogmaxminmodnotsinsumtan", 3, 1);
  472. () = define_keywords_n ($1, "acosaintasinatancharcoshdblehugeiandieorkindnintpackrealscansignsinhsizesqrttanhtinytrimtrue", 4, 1);
  473. () = define_keywords_n ($1, "aimaganintatan2btestcmplxconjgcountdprodfalseflooribclribitsibseticharindexishftlog10mergeradixrangescaleshape", 5, 1);
  474. () = define_keywords_n ($1, "cshiftdigitsiacharishftclboundmatmulmaxlocmaxvalminlocminvalmodulomvbitsrepeatspreaduboundunpackverify", 6, 1);
  475. () = define_keywords_n ($1, "adjustladjustrceilingeoshiftepsilonlogicalnearestpresentproductreshapespacing", 7, 1);
  476. () = define_keywords_n ($1, "bit_sizeexponentfractionlen_trimtransfer", 8, 1);
  477. () = define_keywords_n ($1, "allocatedprecisionrrspacingtranspose", 9, 1);
  478. () = define_keywords_n ($1, "associated", 10, 1);
  479. () = define_keywords_n ($1, "dot_productmaxexponentminexponentrandom_seed", 11, 1);
  480. () = define_keywords_n ($1, "set_exponentsystem_clock", 12, 1);
  481. () = define_keywords_n ($1, "date_and_timerandom_number", 13, 1);
  482. () = define_keywords_n ($1, "selected_int_kind", 17, 1);
  483. () = define_keywords_n ($1, "selected_real_kind", 18, 1);
  484.  
  485. %!% Mode designed for the purpose of editing F90 files.
  486. %!% After the mode is loaded, the hook 'f90_hook' is called.
  487. %!% Useful functions include
  488. %!%
  489. %!%  Function:                    Default Binding:
  490. %!%   f90_continue_newline          ESC RETURN
  491. %!%     indents current line, and creates a continuation line on next line.
  492. %!%   f90_comment                   ESC ;
  493. %!%     comments out current line
  494. %!%   f90_uncomment                 ESC :
  495. %!%     uncomments current line
  496. %!%   f90_electric_label            0-9
  497. %!%     Generates a label for current line or simply inserts a digit.
  498. %!%   f90_next_statement            ^C^N
  499. %!%     moves to next f90 statementm skips comment lines
  500. %!%   f90_previous_statement        ^C^P
  501. %!%     moves to previous f90 statement, skips comment lines
  502. %!%   f90_ruler                     ^C^R
  503. %!%     inserts a ruler above the current line. Press any key to continue
  504. %!%   f90_beg_of_subprogram         ESC ^A
  505. %!%     moves cursor to beginning of current subroutine/function
  506. %!%   f90_end_of_subprogram         ESC ^E
  507. %!%     moves cursor to end of current subroutine/function
  508. %!%   f90_mark_subprogram           ESC ^H
  509. %!%     mark the current subroutine/function
  510. %!%
  511. %!% Variables include:
  512. %!%   F90_Continue_Char   --- character used as a continuation character.
  513. %!%     By default, its value is ">"
  514. %!%   F90_Comment_String  --- string used by 'f90_comment' to
  515. %!%     comment out a line.  The default string is "C ";
  516. %!%   F90_Indent_Amount   --- number of spaces to indent statements in
  517. %!%                               a block.  The default is 2.
  518. define f90_mode ()
  519. {
  520.    variable mode = "F90";
  521.    set_mode (mode, 0x4 | 0x10);
  522.    use_keymap (mode);
  523.    use_syntax_table (mode);
  524.    set_buffer_hook ("indent_hook", "f90_indent");
  525.    set_buffer_hook ("newline_indent_hook", "f90_newline");
  526.    runhooks ("f90_hook");
  527. }
  528.