Mercurial > emacs

comparison lisp/progmodes/f90.el @ 15863:f11b2bfc1275

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
new version from Torbj?Einarsson.
author Erik Naggum <erik@naggum.no>
date Wed, 14 Aug 1996 01:59:41 +0000
parents be4d30237fe6
children f32ed369901c
comparison
equal deleted inserted replaced
15862:d0a061b594a1 15863:f11b2bfc1275
1 ;;; f90.el --- Fortran-90 mode (free format) 1 ;;; f90.el --- Fortran-90 mode (free format)
2 2
3 ;; Copyright (C) 1995, 1996 Free Software Foundation, Inc. 3 ;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
4 4
5 ;; Author: Torbj\"orn Einarsson <T.Einarsson@clab.ericsson.se> 5 ;; Author: Torbj\"orn Einarsson <T.Einarsson@clab.ericsson.se>
6 ;; Created: Apr. 18, 1996 6 ;; Last Change: Aug. 12, 1996
7 ;; Keywords: fortran, f90, languages 7 ;; Keywords: fortran, f90, languages
8 8
9 ;; This file is part of GNU Emacs. 9 ;; This file is part of GNU Emacs.
10 10
11 ;; GNU Emacs is free software; you can redistribute it and/or modify 11 ;; GNU Emacs is free software; you can redistribute it and/or modify
89 ;; f90-smart-end 'blink 89 ;; f90-smart-end 'blink
90 ;; f90-auto-keyword-case nil 90 ;; f90-auto-keyword-case nil
91 ;; f90-leave-line-no nil 91 ;; f90-leave-line-no nil
92 ;; f90-startup-message t 92 ;; f90-startup-message t
93 ;; indent-tabs-mode nil 93 ;; indent-tabs-mode nil
94 ;; f90-font-lock-keywords f90-font-lock-keywords-2
94 ;; ) 95 ;; )
95 ;; ;;The rest is not default. 96 ;; ;;The rest is not default.
96 ;; (abbrev-mode 1) ; turn on abbreviation mode 97 ;; (abbrev-mode 1) ; turn on abbreviation mode
97 ;; (f90-auto-fill-mode 1) ; turn on auto-filling
98 ;; (turn-on-font-lock) ; for highlighting 98 ;; (turn-on-font-lock) ; for highlighting
99 ;; (f90-add-imenu-menu) ; extra menu with functions etc.
99 ;; (if f90-auto-keyword-case ; change case of all keywords on startup 100 ;; (if f90-auto-keyword-case ; change case of all keywords on startup
100 ;; (f90-change-keywords f90-auto-keyword-case)) 101 ;; (f90-change-keywords f90-auto-keyword-case))
101 ;; )) 102 ;; ))
102 ;; in your .emacs file (the shown values are the defaults). You can also 103 ;; in your .emacs file (the shown values are the defaults). You can also
103 ;; change the values of the lists f90-keywords etc. 104 ;; change the values of the lists f90-keywords etc.
104 ;; The auto-fill and abbreviation minor modes are accessible from the menu, 105 ;; The auto-fill and abbreviation minor modes are accessible from the menu,
105 ;; or by using M-x f90-auto-fill-mode and M-x abbrev-mode, respectively. 106 ;; or by using M-x auto-fill-mode and M-x abbrev-mode, respectively.
106 107
107 ;; Remarks 108 ;; Remarks
108 ;; 1) Line numbers are by default left-justified. If f90-leave-line-no is 109 ;; 1) Line numbers are by default left-justified. If f90-leave-line-no is
109 ;; non-nil, the line numbers are never touched. 110 ;; non-nil, the line numbers are never touched.
110 ;; 2) Multi-; statements like > do i=1,20 ; j=j+i ; end do < are not handled 111 ;; 2) Multi-; statements like > do i=1,20 ; j=j+i ; end do < are not handled
125 ;; f90-comment-region 126 ;; f90-comment-region
126 ;; f90-indent-line f90-indent-new-line 127 ;; f90-indent-line f90-indent-new-line
127 ;; f90-indent-region (can be called by calling indent-region) 128 ;; f90-indent-region (can be called by calling indent-region)
128 ;; f90-indent-subprogram 129 ;; f90-indent-subprogram
129 ;; f90-break-line f90-join-lines 130 ;; f90-break-line f90-join-lines
130 ;; f90-auto-fill-mode
131 ;; f90-fill-region 131 ;; f90-fill-region
132 ;; f90-insert-end 132 ;; f90-insert-end
133 ;; f90-upcase-keywords f90-upcase-region-keywords 133 ;; f90-upcase-keywords f90-upcase-region-keywords
134 ;; f90-downcase-keywords f90-downcase-region-keywords 134 ;; f90-downcase-keywords f90-downcase-region-keywords
135 ;; f90-capitalize-keywords f90-capitalize-region-keywords 135 ;; f90-capitalize-keywords f90-capitalize-region-keywords
136 ;; f90-add-imenu-menu
137 ;; f90-font-lock-1, f90-font-lock-2, f90-font-lock-3, f90-font-lock-4
136 138
137 ;; Thanks to all the people who have tested the mode. Special thanks to Jens 139 ;; Thanks to all the people who have tested the mode. Special thanks to Jens
138 ;; Bloch Helmers for encouraging me to write this code, for creative 140 ;; Bloch Helmers for encouraging me to write this code, for creative
139 ;; suggestions as well as for the lists of hpf-commands. 141 ;; suggestions as well as for the lists of hpf-commands.
140 ;; Also thanks to the authors of the fortran and pascal modes, on which some 142 ;; Also thanks to the authors of the fortran and pascal modes, on which some
321 "Regexp for all HPF keywords, procedures and directives.") 323 "Regexp for all HPF keywords, procedures and directives.")
322 324
323 ;; Highlighting patterns 325 ;; Highlighting patterns
324 326
325 (defvar f90-font-lock-keywords-1 327 (defvar f90-font-lock-keywords-1
326 (if (string-match "XEmacs" emacs-version) 328 (list ; Emacs
327 (list ; XEmacs 329 '("\\<\\(end[ \t]*\\(program\\|module\\|function\\|subroutine\\|type\\)\\)\\>[ \t]*\\(\\sw+\\)?"
328 '("\\<\\(end[ \t]*\\(program\\|module\\|function\\|subroutine\\|type\\)\\)\\>" 330 (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t))
329 1 font-lock-keyword-face) 331 '("\\<\\(program\\|call\\|module\\|subroutine\\|function\\|use\\)\\>[ \t]*\\(\\sw+\\)?"
330 '("\\<\\(end[ \t]*\\(program\\|module\\|function\\|subroutine\\|type\\)\\)\\>[ \t]*\\(\\sw+\\)" 332 (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
331 3 font-lock-function-name-face) 333 ;; Special highlighting of "module procedure foo-list"
332 '("\\<\\(program\\|call\\|module\\|subroutine\\|function\\|use\\)\\>" 334 '("\\<\\(module[ \t]*procedure\\)\\>" (1 font-lock-keyword-face t))
333 1 font-lock-keyword-face) 335 ;; Highlight definition of new type
334 '("\\<\\(program\\|call\\|module\\|subroutine\\|function\\|use\\)\\>[ \t]*\\(\\sw+\\)" 336 '("\\<\\(type\\)[ \t]*\\(,.*::[ \t]*\\|[ \t]+\\)\\(\\sw+\\)"
335 2 font-lock-function-name-face nil t) 337 (1 font-lock-keyword-face) (3 font-lock-function-name-face))
336 ;; Special highlighting of "module procedure foo-list" 338 "\\<\\(\\(end[ \t]*\\)?\\(interface\\|block[ \t]*data\\)\\|contains\\)\\>")
337 '("\\<\\(module[ \t]*procedure\\)\\>" 1 font-lock-keyword-face t)
338 ;; Highlight definition of new type
339 '("\\<\\(type\\)[ \t]*\\(,.*::[ \t]*\\|[ \t]+\\)\\(\\sw+\\)"
340 1 font-lock-keyword-face)
341 '("\\<\\(type\\)[ \t]*\\(,.*::[ \t]*\\|[ \t]+\\)\\(\\sw+\\)"
342 3 font-lock-function-name-face)
343 "\\<\\(\\(end[ \t]*\\)?\\(interface\\|block[ \t]*data\\)\\|contains\\)\\>")
344 (list ; Emacs
345 '("\\<\\(end[ \t]*\\(program\\|module\\|function\\|subroutine\\|type\\)\\)\\>[ \t]*\\(\\sw+\\)?"
346 (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t))
347 '("\\<\\(program\\|call\\|module\\|subroutine\\|function\\|use\\)\\>[ \t]*\\(\\sw+\\)?"
348 (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
349 ;; Special highlighting of "module procedure foo-list"
350 '("\\<\\(module[ \t]*procedure\\)\\>" (1 font-lock-keyword-face t))
351 ;; Highlight definition of new type
352 '("\\<\\(type\\)[ \t]*\\(,.*::[ \t]*\\|[ \t]+\\)\\(\\sw+\\)"
353 (1 font-lock-keyword-face) (3 font-lock-function-name-face))
354 "\\<\\(\\(end[ \t]*\\)?\\(interface\\|block[ \t]*data\\)\\|contains\\)\\>"))
355 "This does fairly subdued highlighting of comments and function calls.") 339 "This does fairly subdued highlighting of comments and function calls.")
356 340
357 (defvar f90-font-lock-keywords-2 341 (defvar f90-font-lock-keywords-2
358 (append f90-font-lock-keywords-1 342 (append f90-font-lock-keywords-1
359 (if (string-match "XEmacs" emacs-version) 343 (list
360 (list ; XEmacs
361 ;; Variable declarations (avoid the real function call) 344 ;; Variable declarations (avoid the real function call)
362 '("^[ \t0-9]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|logical\\|type[ \t]*(\\sw+)\\)" 345 '("^[ \t0-9]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|logical\\|type[ \t]*(\\sw+)\\)\\(.*::\\|[ \t]*(.*)\\)?\\([^!\n]*\\)"
363 1 font-lock-type-face)
364 '("^[ \t0-9]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|logical\\|type[ \t]*(\\sw+)\\)\\(.*::\\|[ \t]*(.*)\\)?\\(.*\\)"
365 4 font-lock-doc-string-face)
366 ;; do, if and select constructs
367 '("\\<\\(end[ \t]*\\(do\\|if\\|select\\)\\)\\>"
368 1 font-lock-keyword-face)
369 '("\\<\\(end[ \t]*\\(do\\|if\\|select\\)\\)\\>\\([ \t]+\\(\\sw+\\)\\)"
370 3 font-lock-doc-string-face)
371 '("^[ \t0-9]*\\(\\(\\sw+\\)[ \t]*:[ \t]*\\)\\(\\(if\\|do\\([ \t]*while\\)?\\|select[ \t]*case\\)\\)\\>"
372 2 font-lock-doc-string-face)
373 '("^[ \t0-9]*\\(\\(\\sw+\\)[ \t]*:[ \t]*\\)?\\(\\(if\\|do\\([ \t]*while\\)?\\|select[ \t]*case\\)\\)\\>"
374 3 font-lock-keyword-face)
375 ;; implicit declaration
376 '("\\<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|logical\\|type[ \t]*(\\sw+)\\|none\\)\\>"
377 1 font-lock-keyword-face)
378 '("\\<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|logical\\|type[ \t]*(\\sw+)\\|none\\)\\>"
379 2 font-lock-type-face)
380 '("\\<\\(namelist\\|common\\)[ \t]*\/\\(\\sw+\\)?\/"
381 1 font-lock-keyword-face)
382 '("\\<\\(namelist\\|common\\)[ \t]*\/\\(\\sw+\\)\/"
383 2 font-lock-doc-string-face nil t)
384 '("\\<\\(where\\|forall\\)[ \t]*(" . 1)
385 "\\<e\\(lse\\([ \t]*if\\|where\\)?\\|nd[ \t]*\\(where\\|forall\\)\\)\\>"
386 "\\<\\(then\\|continue\\|format\\|include\\|stop\\|return\\)\\>"
387 '("\\<\\(exit\\|cycle\\)\\>"
388 1 font-lock-keyword-face)
389 '("\\<\\(exit\\|cycle\\)[ \t]*\\(\\sw+\\)2\\>"
390 2 font-lock-doc-string-face)
391 '("\\<\\(case\\)[ \t]*\\(default\\|(\\)" . 1)
392 '("\\<\\(do\\|go *to\\)\\>[ \t]*\\([0-9]+\\)"
393 1 font-lock-keyword-face)
394 '("\\<\\(do\\|go *to\\)\\>[ \t]*\\([0-9]+\\)"
395 2 font-lock-doc-string-face)
396 '("^[ \t]*\\([0-9]+\\)" 1 font-lock-doc-string-face t))
397 (list ; Emacs
398 ;; Variable declarations (avoid the real function call)
399 '("^[ \t0-9]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|logical\\|type[ \t]*(\\sw+)\\)\\(.*::\\|[ \t]*(.*)\\)?\\(.*\\)"
400 (1 font-lock-type-face) (4 font-lock-variable-name-face)) 346 (1 font-lock-type-face) (4 font-lock-variable-name-face))
401 ;; do, if and select constructs 347 ;; do, if and select constructs
402 '("\\<\\(end[ \t]*\\(do\\|if\\|select\\)\\)\\>\\([ \t]+\\(\\sw+\\)\\)?" 348 '("\\<\\(end[ \t]*\\(do\\|if\\|select\\)\\)\\>\\([ \t]+\\(\\sw+\\)\\)?"
403 (1 font-lock-keyword-face) (3 font-lock-reference-face nil t)) 349 (1 font-lock-keyword-face) (3 font-lock-reference-face nil t))
404 '("^[ \t0-9]*\\(\\(\\sw+\\)[ \t]*:[ \t]*\\)?\\(\\(if\\|do\\([ \t]*while\\)?\\|select[ \t]*case\\)\\)\\>" 350 '("^[ \t0-9]*\\(\\(\\sw+\\)[ \t]*:[ \t]*\\)?\\(\\(if\\|do\\([ \t]*while\\)?\\|select[ \t]*case\\)\\)\\>"
412 '("\\<\\(exit\\|cycle\\)[ \t]*\\(\\sw+\\)?\\>" 358 '("\\<\\(exit\\|cycle\\)[ \t]*\\(\\sw+\\)?\\>"
413 (1 font-lock-keyword-face) (2 font-lock-reference-face nil t)) 359 (1 font-lock-keyword-face) (2 font-lock-reference-face nil t))
414 '("\\<\\(case\\)[ \t]*\\(default\\|(\\)" . 1) 360 '("\\<\\(case\\)[ \t]*\\(default\\|(\\)" . 1)
415 '("\\<\\(do\\|go *to\\)\\>[ \t]*\\([0-9]+\\)" 361 '("\\<\\(do\\|go *to\\)\\>[ \t]*\\([0-9]+\\)"
416 (1 font-lock-keyword-face) (2 font-lock-reference-face)) 362 (1 font-lock-keyword-face) (2 font-lock-reference-face))
417 '("^[ \t]*\\([0-9]+\\)" (1 font-lock-reference-face t))))) 363 ;; line numbers (lines whose first character after number is letter)
364 '("^[ \t]*\\([0-9]+\\)[ \t]*[a-z]+" (1 font-lock-reference-face t))))
418 "Highlights declarations, do-loops and other constructions") 365 "Highlights declarations, do-loops and other constructions")
419 366
420 (defvar f90-font-lock-keywords-3 367 (defvar f90-font-lock-keywords-3
421 (append f90-font-lock-keywords-2 368 (append f90-font-lock-keywords-2
422 (list 369 (list
481 (define-key f90-mode-map "\C-c\C-p" 'f90-previous-statement) 428 (define-key f90-mode-map "\C-c\C-p" 'f90-previous-statement)
482 (define-key f90-mode-map "\C-c\C-n" 'f90-next-statement) 429 (define-key f90-mode-map "\C-c\C-n" 'f90-next-statement)
483 (define-key f90-mode-map "\C-c\C-w" 'f90-insert-end) 430 (define-key f90-mode-map "\C-c\C-w" 'f90-insert-end)
484 (define-key f90-mode-map "\t" 'f90-indent-line)) 431 (define-key f90-mode-map "\t" 'f90-indent-line))
485 432
433
486 ;; menus 434 ;; menus
487 (if (string-match "XEmacs" emacs-version) 435 (if (string-match "XEmacs" emacs-version)
488 (defvar f90-xemacs-menu 436 (defvar f90-xemacs-menu
489 '("F90" 437 '("F90"
490 ["Indent Subprogram" f90-indent-subprogram t] 438 ["Indent Subprogram" f90-indent-subprogram t]
497 ["Fill Region" f90-fill-region t] 445 ["Fill Region" f90-fill-region t]
498 "-----" 446 "-----"
499 ["Break Line at Point" f90-break-line t] 447 ["Break Line at Point" f90-break-line t]
500 ["Join with Next Line" f90-join-lines t] 448 ["Join with Next Line" f90-join-lines t]
501 ["Insert Newline" newline t] 449 ["Insert Newline" newline t]
502 ["Insert End" f90-insert-end t] 450 ["Insert Block End" f90-insert-end t]
503 "-----" 451 "-----"
504 ["Upcase Keywords (buffer)" f90-upcase-keywords t] 452 ["Upcase Keywords (buffer)" f90-upcase-keywords t]
505 ["Upcase Keywords (region)" f90-upcase-region-keywords 453 ["Upcase Keywords (region)" f90-upcase-region-keywords
506 t] 454 t]
507 ["Capitalize Keywords (buffer)" f90-capitalize-keywords t] 455 ["Capitalize Keywords (buffer)" f90-capitalize-keywords t]
510 ["Downcase Keywords (buffer)" f90-downcase-keywords t] 458 ["Downcase Keywords (buffer)" f90-downcase-keywords t]
511 ["Downcase Keywords (region)" 459 ["Downcase Keywords (region)"
512 f90-downcase-region-keywords t] 460 f90-downcase-region-keywords t]
513 "-----" 461 "-----"
514 ["Toggle abbrev-mode" abbrev-mode t] 462 ["Toggle abbrev-mode" abbrev-mode t]
515 ["Toggle auto-fill" f90-auto-fill-mode t]) 463 ["Toggle auto-fill" auto-fill-mode t])
516 "XEmacs menu for F90 mode.") 464 "XEmacs menu for F90 mode.")
517 ;; Emacs 465 ;; Emacs
466
467 (defvar f90-change-case-menu
468 (let ((map (make-sparse-keymap "Change Keyword Case")))
469
470 (define-key map [dkr] (cons "Downcase Keywords (region)"
471 'f90-downcase-region-keywords))
472 (put 'f90-downcase-region-keywords 'menu-enable 'mark-active)
473
474 (define-key map [ckr] (cons "Capitalize Keywords (region)"
475 'f90-capitalize-region-keywords))
476 (put 'f90-capitalize-region-keywords 'menu-enable 'mark-active)
477
478 (define-key map [ukr] (cons "Upcase Keywords (region)"
479 'f90-upcase-region-keywords))
480 (put 'f90-upcase-region-keywords 'menu-enable 'mark-active)
481
482 (define-key map [line] (list "-----------------"))
483
484 (define-key map [dkb] (cons "Downcase Keywords (buffer)"
485 'f90-downcase-keywords))
486
487 (define-key map [ckb] (cons "Capitalize Keywords (buffer)"
488 'f90-capitalize-keywords))
489
490 (define-key map [ukb] (cons "Upcase Keywords (buffer)"
491 'f90-upcase-keywords))
492 map)
493 "Submenu for change of case.")
494 (defalias 'f90-change-case-menu f90-change-case-menu)
495
496 ;; font-lock-menu and function calls
497 (defalias 'f90-font-lock-on 'font-lock-mode)
498 (defalias 'f90-font-lock-off 'font-lock-mode)
499 (put 'f90-font-lock-on 'menu-enable 'font-lock-mode)
500 (put 'f90-font-lock-off 'menu-enable '(not font-lock-mode))
501
502 (defun f90-font-lock-1 ()
503 (interactive)
504 "Set font-lock-keywords to f90-font-lock-keywords-1."
505 (font-lock-mode 1)
506 (setq font-lock-keywords f90-font-lock-keywords-1)
507 (font-lock-fontify-buffer))
508
509 (defun f90-font-lock-2 ()
510 (interactive)
511 "Set font-lock-keywords to f90-font-lock-keywords-2."
512 (font-lock-mode 1)
513 (setq font-lock-keywords f90-font-lock-keywords-2)
514 (font-lock-fontify-buffer))
515
516 (defun f90-font-lock-3 ()
517 (interactive)
518 "Set font-lock-keywords to f90-font-lock-keywords-3."
519 (font-lock-mode 1)
520 (setq font-lock-keywords f90-font-lock-keywords-3)
521 (font-lock-fontify-buffer))
522
523 (defun f90-font-lock-4 ()
524 (interactive)
525 "Set font-lock-keywords to f90-font-lock-keywords-4."
526 (font-lock-mode 1)
527 (setq font-lock-keywords f90-font-lock-keywords-4)
528 (font-lock-fontify-buffer))
529
530 (defvar f90-font-lock-menu
531 (let ((map (make-sparse-keymap "f90-font-lock-menu")))
532 (define-key map [h4] (cons "Maximum highlighting (level 4)"
533 'f90-font-lock-4))
534 (define-key map [h3] (cons "Heavy highlighting (level 3)"
535 'f90-font-lock-3))
536 (define-key map [h2] (cons "Default highlighting (level 2)"
537 'f90-font-lock-2))
538 (define-key map [h1] (cons "Light highlighting (level 1)"
539 'f90-font-lock-1))
540 (define-key map [line] (list "-----------------"))
541 (define-key map [floff] (cons "Turn off font-lock-mode"
542 'f90-font-lock-on))
543 (define-key map [flon] (cons "Turn on font-lock-mode"
544 'f90-font-lock-off))
545 map)
546 "Submenu for highlighting using font-lock-mode.")
547 (defalias 'f90-font-lock-menu f90-font-lock-menu)
548
518 (define-key f90-mode-map [menu-bar] (make-sparse-keymap)) 549 (define-key f90-mode-map [menu-bar] (make-sparse-keymap))
519 (define-key f90-mode-map [menu-bar f90] 550 (define-key f90-mode-map [menu-bar f90]
520 (cons "F90" (make-sparse-keymap "f90"))) 551 (cons "F90" (make-sparse-keymap "f90")))
552
553 (define-key f90-mode-map [menu-bar f90 f90-imenu-menu]
554 '("Add imenu Menu" . f90-add-imenu-menu))
521 (define-key f90-mode-map [menu-bar f90 abbrev-mode] 555 (define-key f90-mode-map [menu-bar f90 abbrev-mode]
522 '("Toggle abbrev-mode" . abbrev-mode)) 556 '("Toggle abbrev-mode" . abbrev-mode))
523 (define-key f90-mode-map [menu-bar f90 f90-auto-fill-mode] 557 (define-key f90-mode-map [menu-bar f90 auto-fill-mode]
524 '("Toggle auto-fill" . f90-auto-fill-mode)) 558 '("Toggle auto-fill" . auto-fill-mode))
525 (define-key f90-mode-map [menu-bar f90 f90-downcase-region-keywords] 559 (define-key f90-mode-map [menu-bar f90 line1]
526 '("Downcase Keywords (region)" . f90-downcase-region-keywords)) 560 '("----"))
527 (define-key f90-mode-map [menu-bar f90 f90-downcase-keywords] 561 (define-key f90-mode-map [menu-bar f90 f90-change-case-menu]
528 '("Downcase Keywords (buffer)" . f90-downcase-keywords)) 562 (cons "Change Keyword Case" 'f90-change-case-menu))
529 (define-key f90-mode-map [menu-bar f90 f90-capitalize-keywords] 563 (define-key f90-mode-map [menu-bar f90 f90-font-lock-menu]
530 '("Capitalize Keywords (region)" . f90-capitalize-region-keywords)) 564 (cons "Highlighting" 'f90-font-lock-menu))
531 (define-key f90-mode-map [menu-bar f90 f90-capitalize-region-keywords] 565 (define-key f90-mode-map [menu-bar f90 line2]
532 '("Capitalize Keywords (buffer)" . f90-capitalize-keywords)) 566 '("----"))
533 (define-key f90-mode-map [menu-bar f90 f90-upcase-region-keywords] 567
534 '("Upcase Keywords (region)" . f90-upcase-region-keywords))
535 (define-key f90-mode-map [menu-bar f90 f90-upcase-keywords]
536 '("Upcase Keywords (buffer)" . f90-upcase-keywords))
537 (define-key f90-mode-map [menu-bar f90 f90-insert-end] 568 (define-key f90-mode-map [menu-bar f90 f90-insert-end]
538 '("Insert end" . f90-insert-end)) 569 '("Insert Block End" . f90-insert-end))
539 (define-key f90-mode-map [menu-bar f90 f90-join-lines] 570 (define-key f90-mode-map [menu-bar f90 f90-join-lines]
540 '("Join with Next Line" . f90-join-lines)) 571 '("Join with Next Line" . f90-join-lines))
541 (define-key f90-mode-map [menu-bar f90 f90-break-line] 572 (define-key f90-mode-map [menu-bar f90 f90-break-line]
542 '("Break Line at Point" . f90-break-line)) 573 '("Break Line at Point" . f90-break-line))
574
575 (define-key f90-mode-map [menu-bar f90 line3]
576 '("----"))
577
543 (define-key f90-mode-map [menu-bar f90 f90-fill-region] 578 (define-key f90-mode-map [menu-bar f90 f90-fill-region]
544 '("Fill Region" . f90-fill-region)) 579 '("Fill Region" . f90-fill-region))
580 (put 'f90-fill-region 'menu-enable 'mark-active)
581
545 (define-key f90-mode-map [menu-bar f90 indent-region] 582 (define-key f90-mode-map [menu-bar f90 indent-region]
546 '("Indent Region" . indent-region)) 583 '("Indent Region" . indent-region))
584
547 (define-key f90-mode-map [menu-bar f90 f90-comment-region] 585 (define-key f90-mode-map [menu-bar f90 f90-comment-region]
548 '("(Un)Comment Region" . f90-comment-region)) 586 '("(Un)Comment Region" . f90-comment-region))
587 (put 'f90-comment-region 'menu-enable 'mark-active)
588
589 (define-key f90-mode-map [menu-bar f90 line4]
590 '("----"))
591
549 (define-key f90-mode-map [menu-bar f90 f90-end-of-subprogram] 592 (define-key f90-mode-map [menu-bar f90 f90-end-of-subprogram]
550 '("End of Subprogram" . f90-end-of-subprogram)) 593 '("End of Subprogram" . f90-end-of-subprogram))
551 (define-key f90-mode-map [menu-bar f90 f90-beginning-of-subprogram] 594 (define-key f90-mode-map [menu-bar f90 f90-beginning-of-subprogram]
552 '("Beginning of Subprogram" . f90-beginning-of-subprogram)) 595 '("Beginning of Subprogram" . f90-beginning-of-subprogram))
553 (define-key f90-mode-map [menu-bar f90 f90-mark-subprogram] 596 (define-key f90-mode-map [menu-bar f90 f90-mark-subprogram]
554 '("Mark Subprogram" . f90-mark-subprogram)) 597 '("Mark Subprogram" . f90-mark-subprogram))
555 (define-key f90-mode-map [menu-bar f90 f90-indent-subprogram] 598 (define-key f90-mode-map [menu-bar f90 f90-indent-subprogram]
556 '("Indent Subprogram" . f90-indent-subprogram))) 599 '("Indent Subprogram" . f90-indent-subprogram))
557 600 )
601
558 ;; Regexps for finding program structures. 602 ;; Regexps for finding program structures.
559 (defconst f90-blocks-re 603 (defconst f90-blocks-re
560 "\\(block[ \t]*data\\|do\\|if\\|interface\\|function\\|module\\|\ 604 "\\(block[ \t]*data\\|do\\|if\\|interface\\|function\\|module\\|\
561 program\\|select\\|subroutine\\|type\\|where\\|forall\\)\\>") 605 program\\|select\\|subroutine\\|type\\|where\\|forall\\)\\>")
562 (defconst f90-program-block-re 606 (defconst f90-program-block-re
571 "\\<\\(type\\)[ \t]*\\(,.*::[ \t]*\\|[ \t]+\\)\\(\\sw+\\)") 615 "\\<\\(type\\)[ \t]*\\(,.*::[ \t]*\\|[ \t]+\\)\\(\\sw+\\)")
572 (defconst f90-no-break-re "\\(\\*\\*\\|//\\|=>\\)") 616 (defconst f90-no-break-re "\\(\\*\\*\\|//\\|=>\\)")
573 ;; A temporary position to make region operators faster 617 ;; A temporary position to make region operators faster
574 (defvar f90-cache-position nil) 618 (defvar f90-cache-position nil)
575 (make-variable-buffer-local 'f90-cache-position) 619 (make-variable-buffer-local 'f90-cache-position)
576 620 ;; A flag to tell whether f90-imenu is turned on.
621 (defvar f90-imenu nil)
622 (make-variable-buffer-local 'f90-imenu)
623
624
577 ;; Imenu support 625 ;; Imenu support
578 (defvar f90-imenu-generic-expression 626 (defvar f90-imenu-generic-expression
579 (cons 627 (let ((good-char "[^!\"\&\n \t]") (not-e "[^e!\n\"\& \t]")
580 (concat 628 (not-n "[^n!\n\"\& \t]") (not-d "[^d!\n\"\& \t]"))
581 "^[ \t0-9]*\\(" 629 (list
582 "program[ \t]+\\(\\sw+\\)\\|" 630 '(nil "^[ \t0-9]*program[ \t]+\\(\\sw+\\)" 1)
583 "module[ \t]+\\(\\sw+\\)[ \t]*\\(!\\|$\\)\\|" 631 '("Modules" "^[ \t0-9]*module[ \t]+\\(\\sw+\\)[ \t]*\\(!\\|$\\)" 1)
584 "\\(pure\\|recursive\\|extrinsic([^)]+)\\)?[ \t]*" 632 '("Types" "^[ \t0-9]*type[ \t]+\\(\\sw+\\)" 1)
585 "subroutine[ \t]+\\(\\sw+\\)\\|" 633 (list
586 ; avoid end function, but allow for most other things 634 "Procedures"
587 "\\([^!]*\\([^e!].[^ \t!]\\|.[^n!][^ \t!]\\|..[^d \t!]\\)" 635 (concat
588 "\\|[^!]?[^!]?\\)[ \t]*function[ \t]+\\(\\sw+\\)" 636 "^[ \t0-9]*"
589 "\\)") 637 "\\("
590 (list 2 3 6 9)) 638 ;; At least three non-space characters before function/subroutine
639 ;; Check that the last three non-space characters don't spell E N D
640 "[^!\"\&\n]*\\("
641 not-e good-char good-char "\\|"
642 good-char not-n good-char "\\|"
643 good-char good-char not-d "\\)"
644 "\\|"
645 ;; Less than three non-space characters before function/subroutine
646 good-char "?" good-char "?"
647 "\\)"
648 "[ \t]*\\(function\\|subroutine\\)[ \t]+\\(\\sw+\\)")
649 4)))
591 "imenu generic expression for F90 mode.") 650 "imenu generic expression for F90 mode.")
651
652 (defun f90-add-imenu-menu ()
653 (interactive)
654 "Add an imenu menu to the menubar."
655 (if (not f90-imenu)
656 (progn
657 (imenu-add-to-menubar "F90-imenu")
658 (redraw-frame (selected-frame))
659 (setq f90-imenu t))
660 (message "%s" "F90-imenu already exists.")))
661 (put 'f90-add-imenu-menu 'menu-enable '(not f90-imenu))
662
592 663
593 ;; When compiling under GNU Emacs, load imenu during compilation. If 664 ;; When compiling under GNU Emacs, load imenu during compilation. If
594 ;; you have 19.22 or earlier, comment this out, or get imenu. 665 ;; you have 19.22 or earlier, comment this out, or get imenu.
595 (and (fboundp 'eval-when-compile) 666 (and (fboundp 'eval-when-compile)
596 (eval-when-compile 667 (eval-when-compile
597 (if (not (string-match "XEmacs" emacs-version)) 668 (if (not (string-match "XEmacs" emacs-version))
598 (require 'imenu)) 669 (require 'imenu))
599 ())) 670 ()))
600
601
602 671
603 ;; abbrevs have generally two letters, except standard types `c, `i, `r, `t 672 ;; abbrevs have generally two letters, except standard types `c, `i, `r, `t
604 (defvar f90-mode-abbrev-table nil) 673 (defvar f90-mode-abbrev-table nil)
605 (if f90-mode-abbrev-table 674 (if f90-mode-abbrev-table
606 () 675 ()
741 (setq comment-start-skip "!+ *") 810 (setq comment-start-skip "!+ *")
742 (make-local-variable 'comment-indent-function) 811 (make-local-variable 'comment-indent-function)
743 (setq comment-indent-function 'f90-comment-indent) 812 (setq comment-indent-function 'f90-comment-indent)
744 (make-local-variable 'abbrev-all-caps) 813 (make-local-variable 'abbrev-all-caps)
745 (setq abbrev-all-caps t) 814 (setq abbrev-all-caps t)
815 (make-local-variable 'normal-auto-fill-function)
816 (setq normal-auto-fill-function 'f90-do-auto-fill)
746 (setq indent-tabs-mode nil) 817 (setq indent-tabs-mode nil)
747 ;; Setting up things for font-lock 818 ;; Setting up things for font-lock
748 (if (string-match "Xemacs" emacs-version) 819 (if (string-match "Xemacs" emacs-version)
749 (progn 820 (progn
750 (put 'f90-mode 'font-lock-keywords-case-fold-search t) 821 (put 'f90-mode 'font-lock-keywords-case-fold-search t)
755 (add-submenu nil f90-xemacs-menu))) 826 (add-submenu nil f90-xemacs-menu)))
756 (make-local-variable 'font-lock-keywords) 827 (make-local-variable 'font-lock-keywords)
757 (setq font-lock-keywords f90-font-lock-keywords)) 828 (setq font-lock-keywords f90-font-lock-keywords))
758 ;; Emacs 829 ;; Emacs
759 (make-local-variable 'font-lock-defaults) 830 (make-local-variable 'font-lock-defaults)
760 (setq font-lock-defaults 831 (setq font-lock-defaults '(f90-font-lock-keywords nil t))
761 '((f90-font-lock-keywords f90-font-lock-keywords-1 832
762 f90-font-lock-keywords-2
763 f90-font-lock-keywords-3
764 f90-font-lock-keywords-4)
765 nil t))
766 ;; Tell imenu how to handle f90. 833 ;; Tell imenu how to handle f90.
767 (make-local-variable 'imenu-generic-expression) 834 (make-local-variable 'imenu-generic-expression)
768 (setq imenu-generic-expression f90-imenu-generic-expression)) 835 (setq imenu-generic-expression f90-imenu-generic-expression))
769 (run-hooks 'f90-mode-hook) 836 (run-hooks 'f90-mode-hook)
770 (if f90-startup-message 837 (if f90-startup-message
912 ((looking-at "\\(program\\)[ \t]+\\(\\sw+\\)\\>") 979 ((looking-at "\\(program\\)[ \t]+\\(\\sw+\\)\\>")
913 (list (f90-match-piece 1) (f90-match-piece 2))) 980 (list (f90-match-piece 1) (f90-match-piece 2)))
914 ((and (not (looking-at "module[ \t]*procedure\\>")) 981 ((and (not (looking-at "module[ \t]*procedure\\>"))
915 (looking-at "\\(module\\)[ \t]+\\(\\sw+\\)\\>")) 982 (looking-at "\\(module\\)[ \t]+\\(\\sw+\\)\\>"))
916 (list (f90-match-piece 1) (f90-match-piece 2))) 983 (list (f90-match-piece 1) (f90-match-piece 2)))
917 ((looking-at (concat 984 ((and (not (looking-at "end[ \t]*\\(function\\|subroutine\\)"))
918 "\\(pure\\|recursive\\|extrinsic([^)]+)\\)?[ \t]*" 985 (looking-at "[^!\"\&\n]*\\(function\\|subroutine\\)[ \t]+\\(\\sw+\\)"))
919 "\\(subroutine\\)[ \t]+\\(\\sw+\\)"))
920 (list (f90-match-piece 2) (f90-match-piece 3)))
921 ((and (not (looking-at "end[ \t]*function"))
922 (looking-at "[^!\"\&\\n]*\\(function\\)[ \t]+\\(\\sw+\\)"))
923 (list (f90-match-piece 1) (f90-match-piece 2))))) 986 (list (f90-match-piece 1) (f90-match-piece 2)))))
924 987
925 (defsubst f90-looking-at-program-block-end () 988 (defsubst f90-looking-at-program-block-end ()
926 "Return list of type and name of end of block." 989 "Return list of type and name of end of block."
927 (if (looking-at (concat "end[ \t]*" f90-blocks-re 990 (if (looking-at (concat "end[ \t]*" f90-blocks-re
1317 ;; restore point etc 1380 ;; restore point etc
1318 (setq f90-cache-position nil) 1381 (setq f90-cache-position nil)
1319 (goto-char save-point) 1382 (goto-char save-point)
1320 (set-marker end-region-mark nil) 1383 (set-marker end-region-mark nil)
1321 (set-marker save-point nil) 1384 (set-marker save-point nil)
1322 (if (string-match "Xemacs" emacs-version) 1385 (if (string-match "XEmacs" emacs-version)
1323 (zmacs-deactivate-region) 1386 (zmacs-deactivate-region)
1324 (deactivate-mark)))) 1387 (deactivate-mark))))
1325 1388
1326 (defun f90-indent-subprogram () 1389 (defun f90-indent-subprogram ()
1327 "Properly indent the subprogram which contains point." 1390 "Properly indent the subprogram which contains point."
1346 (interactive) 1409 (interactive)
1347 (let (ctype) 1410 (let (ctype)
1348 (cond ((f90-in-string) 1411 (cond ((f90-in-string)
1349 (insert "&") (newline) (insert "&")) 1412 (insert "&") (newline) (insert "&"))
1350 ((f90-in-comment) 1413 ((f90-in-comment)
1351 (delete-horizontal-space)
1352 (setq ctype (f90-get-present-comment-type)) 1414 (setq ctype (f90-get-present-comment-type))
1353 (newline) (insert (concat ctype " "))) 1415 (newline)
1354 (t (delete-horizontal-space) 1416 (insert ctype))
1355 (insert "&") 1417 (t (insert "&")
1356 (if (not no-update) (f90-update-line)) 1418 (if (not no-update) (f90-update-line))
1357 (newline) 1419 (newline)
1358 (if f90-beginning-ampersand (insert "& "))))) 1420 (if f90-beginning-ampersand (insert "&")))))
1359 (if (not no-update) (f90-indent-line))) 1421 (if (not no-update) (f90-indent-line)))
1360 1422
1361 (defun f90-find-breakpoint () 1423 (defun f90-find-breakpoint ()
1362 "From fill-column, search backward for break-delimiter." 1424 "From fill-column, search backward for break-delimiter."
1363 (let ((bol (f90-get-beg-of-line))) 1425 (let ((bol (f90-get-beg-of-line)))
1368 (forward-char))) 1430 (forward-char)))
1369 (if (looking-at f90-no-break-re) 1431 (if (looking-at f90-no-break-re)
1370 (forward-char 2) 1432 (forward-char 2)
1371 (forward-char))))) 1433 (forward-char)))))
1372 1434
1373 (defun f90-auto-fill-mode (arg)
1374 "Toggle f90-auto-fill mode.
1375 With ARG, turn `f90-auto-fill' mode on iff ARG is positive.
1376 In `f90-auto-fill' mode, inserting a space at a column beyond `fill-column'
1377 automatically breaks the line at a previous space."
1378 (interactive "P")
1379 (prog1 (setq auto-fill-function
1380 (if (if (null arg)
1381 (not auto-fill-function)
1382 (> (prefix-numeric-value arg) 0))
1383 'f90-do-auto-fill))
1384 (force-mode-line-update)))
1385
1386 (defun f90-do-auto-fill () 1435 (defun f90-do-auto-fill ()
1387 "Break line if non-white characters beyond fill-column." 1436 "Break line if non-white characters beyond fill-column."
1388 (interactive) 1437 (interactive)
1389 ;; Break the line before or after the last delimiter (non-word char). 1438 ;; Break the line before or after the last delimiter (non-word char) if
1439 ;; position is beyond fill-column.
1390 ;; Will not break **, //, or => (specified by f90-no-break-re). 1440 ;; Will not break **, //, or => (specified by f90-no-break-re).
1391 ;; Start by checking that line is longer than fill-column. 1441 (while (> (current-column) fill-column)
1392 (if (> (save-excursion (end-of-line) (current-column)) fill-column) 1442 (let ((pos-mark (point-marker)))
1393 (progn
1394 (move-to-column fill-column) 1443 (move-to-column fill-column)
1395 (if (and (looking-at "[ \t]*$") (not (f90-in-string))) 1444 (if (not (f90-in-string))
1396 (delete-horizontal-space) 1445 (f90-find-breakpoint))
1397 (f90-find-breakpoint) 1446 (f90-break-line)
1398 (f90-break-line) 1447 (goto-char pos-mark)
1399 (end-of-line))))) 1448 (set-marker pos-mark nil))))
1449
1400 1450
1401 (defun f90-join-lines () 1451 (defun f90-join-lines ()
1402 "Join present line with next line, if this line ends with \&." 1452 "Join present line with next line, if this line ends with \&."
1403 (interactive) 1453 (interactive)
1404 (let (pos (oldpos (point))) 1454 (let (pos (oldpos (point)))
1521 (if (not (zerop count)) 1571 (if (not (zerop count))
1522 (message "No matching beginning.") 1572 (message "No matching beginning.")
1523 (f90-update-line) 1573 (f90-update-line)
1524 (if (eq f90-smart-end 'blink) 1574 (if (eq f90-smart-end 'blink)
1525 (if (< (point) top-of-window) 1575 (if (< (point) top-of-window)
1526 (message "Matches %d: %s" 1576 (message "Matches %s: %s"
1527 (what-line) 1577 (what-line)
1528 (buffer-substring 1578 (buffer-substring
1529 (progn (beginning-of-line) (point)) 1579 (progn (beginning-of-line) (point))
1530 (progn (end-of-line) (point)))) 1580 (progn (end-of-line) (point))))
1531 (sit-for 1))) 1581 (sit-for 1)))