X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/60db35943357fffada30fdf38e864a38bae1076e..f687a8793d0135bf14f64904709b8cd178c1697d:/lisp/progmodes/fortran.el diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el index fdf5620584..bd0d0aad00 100644 --- a/lisp/progmodes/fortran.el +++ b/lisp/progmodes/fortran.el @@ -1,10 +1,9 @@ ;;; fortran.el --- Fortran mode for GNU Emacs -;; Copyright (c) 1986, 1993, 1994, 1995, 1997 Free Software Foundation, Inc. +;; Copyright (c) 1986, 93, 94, 95, 97, 98, 1999 Free Software Foundation, Inc. ;; Author: Michael D. Prange -;; Maintainer: bug-fortran-mode@erl.mit.edu (Steve Gildea and others) -;; Version 1.30.6 (July 27, 1995) +;; Maintainer: Dave Love ;; Keywords: languages ;; This file is part of GNU Emacs. @@ -26,33 +25,40 @@ ;;; Commentary: -;; Fortran mode has been upgraded and is now maintained by Stephen A. Wood -;; (saw@cebaf.gov). It now will use either fixed format continuation line -;; markers (character in 6th column), or tab format continuation line style -;; (digit after a TAB character.) A auto-fill mode has been added to -;; automatically wrap fortran lines that get too long. +;; This mode is documented in the Emacs manual. +;; +;; Note that it is for editing Fortran77 or Fortran90 fixed source +;; form. For editing Fortran 90 free format source, use `f90-mode' +;; (f90.el). + +;;; History: + +;; Fortran mode was upgraded by Stephen A. Wood (saw@cebaf.gov). ;; We acknowledge many contributions and valuable suggestions by ;; Lawrence R. Dodd, Ralf Fassel, Ralph Finch, Stephen Gildea, ;; Dr. Anil Gokhale, Ulrich Mueller, Mark Neale, Eric Prestemon, ;; Gary Sabot and Richard Stallman. -;; This file may be used with GNU Emacs version 18.xx if the following -;; variable and function substitutions are made. -;; Replace: -;; frame-width with screen-width -;; auto-fill-function with auto-fill-hook -;; comment-indent-function with comment-indent-hook -;; (setq unread-command-events (list c)) with (setq unread-command-char c) +;;; Code: -;; Bugs to bug-fortran-mode@erl.mit.edu +;; Todo: -;;; Code: +;; * Tidy it all up! (including renaming non-`fortran' prefixed +;; functions). +;; * Implement insertion and removal of statement continuations in +;; mixed f77/f90 style, with the first `&' past column 72 and the +;; second in column 6. +;; * Support any other extensions to f77 grokked by GNU Fortran. +;; * Change fontification to use font-lock-syntactic-keywords for +;; fixed-form comments. (Done, but doesn't work properly with +;; lazy-lock in pre-20.4.) -(defconst fortran-mode-version "version 1.30.6") +(require 'easymenu) (defgroup fortran nil "Fortran mode for Emacs" + :link '(custom-manual "(emacs)Fortran") :group 'languages) (defgroup fortran-indent nil @@ -80,6 +86,7 @@ with a character in column 6." "String to appear in mode line when TAB format mode is on." :type '(choice (const nil) string) :group 'fortran-indent) +(make-variable-buffer-local 'fortran-tab-mode-string) (defcustom fortran-do-indent 3 "*Extra indentation applied to DO blocks." @@ -102,13 +109,14 @@ with a character in column 6." :group 'fortran-indent) (defcustom fortran-comment-indent-style 'fixed - "*nil forces comment lines not to be touched, + "*How to indent comments. +nil forces comment lines not to be touched, 'fixed makes fixed comment indentation to `fortran-comment-line-extra-indent' columns beyond `fortran-minimum-statement-indent-fixed' (for `indent-tabs-mode' of nil) or `fortran-minimum-statement-indent-tab' (for `indent-tabs-mode' of t), and 'relative indents to current Fortran indentation plus `fortran-comment-line-extra-indent'." - :type '(radio (const nil) (const fixed) (const relative)) + :type '(radio (const :tag "Untouched" nil) (const fixed) (const relative)) :group 'fortran-indent) (defcustom fortran-comment-line-extra-indent 0 @@ -174,56 +182,50 @@ Normally $." :group 'fortran) (defcustom fortran-comment-region "c$$$" - "*String inserted by \\[fortran-comment-region]\ - at start of each line in region." + "*String inserted by \\[fortran-comment-region] at start of each \ +line in region." :type 'string :group 'fortran-comment) (defcustom fortran-electric-line-number t - "*Non-nil causes line number digits to be moved to the correct column as\ - typed." - :type 'boolean - :group 'fortran) - -(defcustom fortran-startup-message t - "*Non-nil displays a startup message when Fortran mode is first called." + "*Non-nil causes line number digits to be moved to the correct \ +column as typed." :type 'boolean :group 'fortran) (defvar fortran-column-ruler-fixed "0 4 6 10 20 30 40 5\ -\0 60 70\n\ +0 60 70\n\ \[ ]|{ | | | | | | | | \ \| | | | |}\n" - "*String displayed above current line by \\[fortran-column-ruler]. + "String displayed above current line by \\[fortran-column-ruler]. This variable used in fixed format mode.") (defvar fortran-column-ruler-tab "0 810 20 30 40 5\ -\0 60 70\n\ +0 60 70\n\ \[ ]| { | | | | | | | | \ \| | | | |}\n" - "*String displayed above current line by \\[fortran-column-ruler]. + "String displayed above current line by \\[fortran-column-ruler]. This variable used in TAB format mode.") -(defconst bug-fortran-mode "bug-fortran-mode@erl.mit.edu" - "Address of mailing list for Fortran mode bugs.") - (defvar fortran-mode-syntax-table nil "Syntax table in use in Fortran mode buffers.") (defvar fortran-analyze-depth 100 - "Number of lines to scan to determine whether to use fixed or TAB format\ - style.") + "Number of lines to scan to determine whether to use fixed or TAB \ +format style.") (defcustom fortran-break-before-delimiters t - "*Non-nil causes `fortran-fill' to break lines before delimiters." + "*Non-nil causes filling to break lines before delimiters." :type 'boolean :group 'fortran) (if fortran-mode-syntax-table () (setq fortran-mode-syntax-table (make-syntax-table)) + ;; We might like `;' to be punctuation (g77 multi-statement lines), + ;; but that screws abbrevs. (modify-syntax-entry ?\; "w" fortran-mode-syntax-table) (modify-syntax-entry ?\r " " fortran-mode-syntax-table) (modify-syntax-entry ?+ "." fortran-mode-syntax-table) @@ -233,16 +235,20 @@ This variable used in TAB format mode.") (modify-syntax-entry ?/ "." fortran-mode-syntax-table) (modify-syntax-entry ?\' "\"" fortran-mode-syntax-table) (modify-syntax-entry ?\" "\"" fortran-mode-syntax-table) - (modify-syntax-entry ?\\ "/" fortran-mode-syntax-table) - (modify-syntax-entry ?. "w" fortran-mode-syntax-table) - (modify-syntax-entry ?_ "w" fortran-mode-syntax-table) + (modify-syntax-entry ?\\ "\\" fortran-mode-syntax-table) + ;; This might be better as punctuation, as for C, but this way you + ;; can treat floating-point numbers as symbols. + (modify-syntax-entry ?. "_" fortran-mode-syntax-table) ; e.g. `a.ne.b' + (modify-syntax-entry ?_ "_" fortran-mode-syntax-table) + (modify-syntax-entry ?$ "_" fortran-mode-syntax-table) ; esp. VMSisms (modify-syntax-entry ?\! "<" fortran-mode-syntax-table) (modify-syntax-entry ?\n ">" fortran-mode-syntax-table)) -;; Comments are real pain in Fortran because there is no way to represent the -;; standard comment syntax in an Emacs syntax table (we can for VAX-style). -;; Therefore an unmatched quote in a standard comment will throw fontification -;; off on the wrong track. So we do syntactic fontification with regexps. +;; Comments are real pain in Fortran because there is no way to +;; represent the standard comment syntax in an Emacs syntax table. +;; (We can do so for F90-style). Therefore an unmatched quote in a +;; standard comment will throw fontification off on the wrong track. +;; So we do syntactic fontification with regexps. ;; Regexps done by simon@gnu with help from Ulrik Dickow and ;; probably others Si's forgotten about (sorry). @@ -256,133 +262,153 @@ This variable used in TAB format mode.") (defconst fortran-font-lock-keywords-3 nil "Gaudy level highlighting for Fortran mode.") -(let ((comment-chars "c!*") +(defconst fortran-font-lock-syntactic-keywords nil + "`font-lock-syntactic-keywords' for Fortran. +These get fixed-format comments fontified.") + +(let ((comment-chars "cd") ; `d' for `debugging' comments (fortran-type-types -; (make-regexp -; (let ((simple-types '("character" "byte" "integer" "logical" -; "none" "real" "complex" -; "double[ \t]*precision" "double[ \t]*complex")) -; (structured-types '("structure" "union" "map")) -; (other-types '("record" "dimension" "parameter" "common" "save" -; "external" "intrinsic" "data" "equivalence"))) -; (append -; (mapcar (lambda (x) (concat "implicit[ \t]*" x)) simple-types) -; simple-types -; (mapcar (lambda (x) (concat "end[ \t]*" x)) structured-types) -; structured-types -; other-types))) - (concat "byte\\|c\\(haracter\\|om\\(mon\\|plex\\)\\)\\|" - "d\\(ata\\|imension\\|ouble" - "[ \t]*\\(complex\\|precision\\)\\)\\|" - "e\\(nd[ \t]*\\(map\\|structure\\|union\\)\\|" - "quivalence\\|xternal\\)\\|" - "i\\(mplicit[ \t]*\\(byte\\|" - "c\\(haracter\\|omplex\\)\\|" - "double[ \t]*\\(complex\\|precision\\)\\|" - "integer\\|logical\\|none\\|real\\)\\|" - "nt\\(eger\\|rinsic\\)\\)\\|" - "logical\\|map\\|none\\|parameter\\|re\\(al\\|cord\\)\\|" - "s\\(ave\\|tructure\\)\\|union")) - (fortran-keywords -; ("continue" "format" "end" "enddo" "if" "then" "else" "endif" -; "elseif" "while" "inquire" "stop" "return" "include" "open" -; "close" "read" "write" "format" "print") - (concat "c\\(lose\\|ontinue\\)\\|" - "e\\(lse\\(\\|if\\)\\|nd\\(\\|do\\|if\\)\\)\\|format\\|" - "i\\(f\\|n\\(clude\\|quire\\)\\)\\|open\\|print\\|" - "re\\(ad\\|turn\\)\\|stop\\|then\\|w\\(hile\\|rite\\)")) - (fortran-logicals -; ("and" "or" "not" "lt" "le" "eq" "ge" "gt" "ne" "true" "false") - "and\\|eq\\|false\\|g[et]\\|l[et]\\|n\\(e\\|ot\\)\\|or\\|true")) + (eval-when-compile + (let ((re (regexp-opt + (let ((simple-types + '("character" "byte" "integer" "logical" + "none" "real" "complex" + "double precision" "double complex")) + (structured-types '("structure" "union" "map")) + (other-types '("record" "dimension" + "parameter" "common" "save" + "external" "intrinsic" "data" + "equivalence"))) + (append + (mapcar (lambda (x) (concat "implicit " x)) + simple-types) + simple-types + (mapcar (lambda (x) (concat "end " x)) + structured-types) + structured-types + other-types))))) + ;; In the optimized regexp above, replace spaces by regexp + ;; for optional whitespace, which regexp-opt would have + ;; escaped. + (mapconcat #'identity (split-string re) "[ \t]*")))) + (fortran-keywords + (eval-when-compile + (regexp-opt '("continue" "format" "end" "enddo" "if" "then" + "else" "endif" "elseif" "while" "inquire" "stop" + "return" "include" "open" "close" "read" "write" + "format" "print" "select" "case" "cycle" "exit")))) + (fortran-logicals + (eval-when-compile + (regexp-opt '("and" "or" "not" "lt" "le" "eq" "ge" "gt" "ne" + "true" "false"))))) + + (setq fortran-font-lock-syntactic-keywords + ;; Fixed format comments. (!-style handled normally.) + (list + (list (concat "^[" comment-chars "]") 0 '(11)) + (list (concat "^[^" comment-chars "\t\n]" (make-string 71 ?.) + "\\([^\n]+\\)") + 1 '(11)))) (setq fortran-font-lock-keywords-1 - (list - ;; - ;; Fontify syntactically (assuming strings cannot be quoted or span lines). - (cons (concat "^[" comment-chars "].*") 'font-lock-comment-face) - '(fortran-match-!-comment . font-lock-comment-face) - (list (concat "^[^" comment-chars "\t\n]" (make-string 71 ?.) "\\(.*\\)") - '(1 font-lock-comment-face)) - '("'[^'\n]*'?" . font-lock-string-face) - ;; - ;; Program, subroutine and function declarations, plus calls. - (list (concat "\\<\\(block[ \t]*data\\|call\\|entry\\|function\\|" - "program\\|subroutine\\)\\>[ \t]*\\(\\sw+\\)?") - '(1 font-lock-keyword-face) - '(2 font-lock-function-name-face nil t)))) + (list + ;; + ;; Program, subroutine and function declarations, plus calls. + (list (concat "\\<\\(block[ \t]*data\\|call\\|entry\\|function\\|" + "program\\|subroutine\\)\\>[ \t]*\\(\\sw+\\)?") + '(1 font-lock-keyword-face) + '(2 font-lock-function-name-face nil t)))) (setq fortran-font-lock-keywords-2 - (append fortran-font-lock-keywords-1 - (list - ;; - ;; Fontify all type specifiers (must be first; see below). - (cons (concat "\\<\\(" fortran-type-types "\\)\\>") 'font-lock-type-face) - ;; - ;; Fontify all builtin keywords (except logical, do and goto; see below). - (concat "\\<\\(" fortran-keywords "\\)\\>") - ;; - ;; Fontify all builtin operators. - (concat "\\.\\(" fortran-logicals "\\)\\.") - ;; - ;; Fontify do/goto keywords and targets, and goto tags. - (list "\\<\\(do\\|go *to\\)\\>[ \t]*\\([0-9]+\\)?" - '(1 font-lock-keyword-face) - '(2 font-lock-reference-face nil t)) - (cons "^ *\\([0-9]+\\)" 'font-lock-reference-face)))) + (append fortran-font-lock-keywords-1 + (list + ;; + ;; Fontify all type specifiers (must be first; see below). + (cons (concat "\\<\\(" fortran-type-types "\\)\\>") + 'font-lock-type-face) + ;; + ;; Fontify all builtin keywords (except logical, do + ;; and goto; see below). + (concat "\\<\\(" fortran-keywords "\\)\\>") + ;; + ;; Fontify all builtin operators. + (concat "\\.\\(" fortran-logicals "\\)\\.") + ;; + ;; Fontify do/goto keywords and targets, and goto tags. + (list "\\<\\(do\\|go *to\\)\\>[ \t]*\\([0-9]+\\)?" + '(1 font-lock-keyword-face) + '(2 font-lock-constant-face nil t)) + (cons "^ *\\([0-9]+\\)" 'font-lock-constant-face)))) (setq fortran-font-lock-keywords-3 - (append - ;; - ;; The list `fortran-font-lock-keywords-1'. - fortran-font-lock-keywords-1 - ;; - ;; Fontify all type specifiers plus their declared items. - (list - (list (concat "\\<\\(" fortran-type-types "\\)\\>[ \t(/]*\\(*\\)?") - ;; Fontify the type specifier. - '(1 font-lock-type-face) - ;; Fontify each declaration item (or just the /.../ block name). - '(font-lock-match-c-style-declaration-item-and-skip-to-next - ;; Start after any *(...) expression. - (and (match-beginning 15) (forward-sexp 1)) - ;; No need to clean up. - nil - ;; Fontify as a variable name, functions are fontified elsewhere. - (1 font-lock-variable-name-face nil t)))) - ;; - ;; Things extra to `fortran-font-lock-keywords-3' (must be done first). - (list - ;; - ;; Fontify goto-like `err=label'/`end=label' in read/write statements. - '(", *\\(e\\(nd\\|rr\\)\\)\\> *\\(= *\\([0-9]+\\)\\)?" - (1 font-lock-keyword-face) (4 font-lock-reference-face nil t)) - ;; - ;; Highlight standard continuation character and in a TAB-formatted line. - '("^ \\([^ 0]\\)" 1 font-lock-string-face) - '("^\t\\([1-9]\\)" 1 font-lock-string-face)) - ;; - ;; The list `fortran-font-lock-keywords-2' less that for types (see above). - (cdr (nthcdr (length fortran-font-lock-keywords-1) - fortran-font-lock-keywords-2)))) - ) + (append + ;; + ;; The list `fortran-font-lock-keywords-1'. + fortran-font-lock-keywords-1 + ;; + ;; Fontify all type specifiers plus their declared items. + (list + (list (concat "\\<\\(" fortran-type-types "\\)\\>[ \t(/]*\\(*\\)?") + ;; Fontify the type specifier. + '(1 font-lock-type-face) + ;; Fontify each declaration item (or just the /.../ block name). + `(font-lock-match-c-style-declaration-item-and-skip-to-next + ;; Start after any *(...) expression. + (condition-case nil + (and (and (match-beginning ,(+ 2 (regexp-opt-depth + fortran-type-types))) + (forward-sexp)) + (forward-sexp)) + (error nil)) + ;; No need to clean up. + nil + ;; Fontify as a variable name, functions are + ;; fontified elsewhere. + (1 font-lock-variable-name-face nil t)))) + ;; + ;; Things extra to `fortran-font-lock-keywords-3' + ;; (must be done first). + (list + ;; + ;; Fontify goto-like `err=label'/`end=label' in read/write + ;; statements. + '(", *\\(e\\(nd\\|rr\\)\\)\\> *\\(= *\\([0-9]+\\)\\)?" + (1 font-lock-keyword-face) (4 font-lock-constant-face nil t)) + ;; + ;; Highlight standard continuation character and in a + ;; TAB-formatted line. + '("^ \\([^ 0]\\)" 1 font-lock-string-face) + '("^\t\\([1-9]\\)" 1 font-lock-string-face)) + ;; + ;; The list `fortran-font-lock-keywords-2' less that for types + ;; (see above). + (cdr (nthcdr (length fortran-font-lock-keywords-1) + fortran-font-lock-keywords-2))))) (defvar fortran-font-lock-keywords fortran-font-lock-keywords-1 "Default expressions to highlight in Fortran mode.") (defvar fortran-imenu-generic-expression - (list - (list - nil - ;; Lines are: 1. leading whitespace; 2. function declaration - ;; with optional type, e.g. `real', `double precision', [which - ;; will be fooled by `end function' allowed by G77]; 3. untyped - ;; declarations; 4. the name to index. - "^\\s-+\\(\ -\\(\\sw\\|\\s-\\)*\\ 0 arg) + (setq arg (- arg)) + (forward-line arg)) + (while (not (zerop arg)) + (beginning-of-line) + (or (fortran-remove-continuation) + (delete-indentation)) + (setq arg (1- arg))) + (fortran-indent-line))) (defun fortran-numerical-continuation-char () "Return a digit for tab-digit style of continuation lines. @@ -787,9 +892,10 @@ except that ] is never special and \ quotes ^, - or \." (skip-chars-backward chars) (delete-region (point) (progn (skip-chars-forward chars) (point)))) +(put 'fortran-electric-line-number 'delete-selection t) (defun fortran-electric-line-number (arg) "Self insert, but if part of a Fortran line number indent it automatically. -Auto-indent does not happen if a numeric arg is used." +Auto-indent does not happen if a numeric ARG is used." (interactive "P") (if (or arg (not fortran-electric-line-number)) (if arg @@ -800,8 +906,8 @@ Auto-indent does not happen if a numeric arg is used." (beginning-of-line) (looking-at " ")));In col 5 with only spaces to left. (and (= (if indent-tabs-mode - fortran-minimum-statement-indent-tab - fortran-minimum-statement-indent-fixed) (current-column)) + fortran-minimum-statement-indent-tab + fortran-minimum-statement-indent-fixed) (current-column)) (save-excursion (beginning-of-line) (looking-at "\t"));In col 8 with a single tab to the left. @@ -813,38 +919,69 @@ Auto-indent does not happen if a numeric arg is used." (save-excursion (beginning-of-line) (point)) - t)) ;not a line number - (looking-at "[0-9]") ;within a line number - ) + t)) ;not a line number + (looking-at "[0-9]")) ;within a line number (self-insert-command (prefix-numeric-value arg)) (skip-chars-backward " \t") (insert last-command-char) (fortran-indent-line)))) +(defvar fortran-end-prog-re1 + "end\ +\\([ \t]*\\(program\\|subroutine\\|function\\|block[ \t]*data\\)\\>\ +\\([ \t]*\\(\\sw\\|\\s_\\)+\\)?\\)?") +(defvar fortran-end-prog-re + (concat "^[ \t0-9]*" fortran-end-prog-re1) + "Regexp possibly marking subprogram end.") + +(defun fortran-check-end-prog-re () + "Check a preliminary match against `fortran-end-prog-re'." + ;; Having got a possible match for the subprogram end, we need a + ;; match of whitespace, avoiding possible column 73+ stuff. + (save-match-data + (string-match "^\\s-*\\(\\'\\|\\s<\\)" + (buffer-substring (match-end 0) + (min (line-end-position) + (+ 72 (line-beginning-position))))))) + +;; Note that you can't just check backwards for `subroutine' &c in +;; case of un-marked main programs not at the start of the file. (defun beginning-of-fortran-subprogram () "Moves point to the beginning of the current Fortran subprogram." (interactive) - (let ((case-fold-search t)) - (beginning-of-line -1) - (re-search-backward "^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]" nil 'move) - (if (looking-at "^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]") - (forward-line 1)))) + (save-match-data + (let ((case-fold-search t)) + (beginning-of-line -1) + (if (catch 'ok + (while (re-search-backward fortran-end-prog-re nil 'move) + (if (fortran-check-end-prog-re) + (throw 'ok t)))) + (forward-line))))) (defun end-of-fortran-subprogram () "Moves point to the end of the current Fortran subprogram." (interactive) - (let ((case-fold-search t)) - (beginning-of-line 2) - (re-search-forward "^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]" nil 'move) - (goto-char (match-beginning 0)) - (forward-line 1))) + (save-match-data + (let ((case-fold-search t)) + (if (save-excursion ; on END + (beginning-of-line) + (and (looking-at fortran-end-prog-re) + (fortran-check-end-prog-re))) + (forward-line) + (beginning-of-line 2) + (catch 'ok + (while (re-search-forward fortran-end-prog-re nil 'move) + (if (fortran-check-end-prog-re) + (throw 'ok t)))) + (goto-char (match-beginning 0)) + (forward-line))))) (defun mark-fortran-subprogram () "Put mark at end of Fortran subprogram, point at beginning. The marks are pushed." (interactive) (end-of-fortran-subprogram) - (push-mark (point)) + (push-mark (point) nil t) (beginning-of-fortran-subprogram)) (defun fortran-previous-statement () @@ -892,14 +1029,38 @@ non-comment Fortran statement in the file, and nil otherwise." (looking-at (concat "[ \t]*" comment-start-skip))))) (if (not not-last-statement) 'last-statement))) + +(defun fortran-narrow-to-subprogram () + "Make text outside the current subprogram invisible. +The subprogram visible is the one that contains or follows point." + (interactive) + (save-excursion + (mark-fortran-subprogram) + (narrow-to-region (point) (mark)))) + +(defmacro fortran-with-subprogram-narrowing (&rest forms) + "Execute FORMS with buffer temporarily narrowed to current subprogram. +Doesn't push a mark." + `(save-restriction + (save-excursion + (narrow-to-region (progn + (beginning-of-fortran-subprogram) + (point)) + (progn + (end-of-fortran-subprogram) + (point)))) + ,@forms)) (defun fortran-blink-matching-if () - ;; From a Fortran ENDIF statement, blink the matching IF statement. - (let ((top-of-window (window-start)) matching-if - (endif-point (point)) message) + "From an ENDIF statement, blink the matching IF statement." + (let ((top-of-window (window-start)) + (endif-point (point)) + (case-fold-search t) + matching-if + message) (if (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") - (looking-at "end[ \t]*if\\b")) + (looking-at "e\\(nd[ \t]*if\\|lse\\([ \t]*if\\)?\\)\\b")) (progn (if (not (setq matching-if (fortran-beginning-if))) (setq message "No matching if.") @@ -918,10 +1079,13 @@ non-comment Fortran statement in the file, and nil otherwise." (goto-char endif-point)))))) (defun fortran-blink-matching-do () - ;; From a Fortran ENDDO statement, blink on the matching DO or DO WHILE - ;; statement. This is basically copied from fortran-blink-matching-if. - (let ((top-of-window (window-start)) matching-do - (enddo-point (point)) message) + "From an ENDDO statement, blink the matching DO or DO WHILE statement." + ;; This is basically copied from fortran-blink-matching-if. + (let ((top-of-window (window-start)) + (enddo-point (point)) + (case-fold-search t) + matching-do + message) (if (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") (looking-at "end[ \t]*do\\b")) @@ -956,53 +1120,59 @@ The marks are pushed." (goto-char do-point))))) (defun fortran-end-do () - ;; Search forward for first unmatched ENDDO. Return point or nil. - (if (save-excursion (beginning-of-line) - (skip-chars-forward " \t0-9") - (looking-at "end[ \t]*do\\b")) - ;; Sitting on one. - (match-beginning 0) - ;; Search for one. - (save-excursion - (let ((count 1)) + "Search forward for first unmatched ENDDO. +Return point or nil." + (let ((case-fold-search t)) + (if (save-excursion (beginning-of-line) + (skip-chars-forward " \t0-9") + (looking-at "end[ \t]*do\\b")) + ;; Sitting on one. + (match-beginning 0) + ;; Search for one. + (save-excursion + (let ((count 1)) (while (and (not (= count 0)) - (not (eq (fortran-next-statement) 'last-statement)) - ;; Keep local to subprogram - (not (looking-at "^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]"))) - - (skip-chars-forward " \t0-9") - (cond ((looking-at "end[ \t]*do\\b") - (setq count (- count 1))) - ((looking-at "do[ \t]+[^0-9]") + (not (eq (fortran-next-statement) 'last-statement)) + ;; Keep local to subprogram + (not (and (looking-at fortran-end-prog-re) + (fortran-check-end-prog-re)))) + + (skip-chars-forward " \t0-9") + (cond ((looking-at "end[ \t]*do\\b") + (setq count (1- count))) + ((looking-at "\\(\\(\\sw\\|\\s_\\)+:[ \t]*\\)?do[ \t]+[^0-9]") (setq count (+ count 1))))) (and (= count 0) - ;; All pairs accounted for. - (point)))))) + ;; All pairs accounted for. + (point))))))) (defun fortran-beginning-do () - ;; Search backwards for first unmatched DO [WHILE]. Return point or nil. - (if (save-excursion (beginning-of-line) - (skip-chars-forward " \t0-9") - (looking-at "do[ \t]+")) - ;; Sitting on one. - (match-beginning 0) - ;; Search for one. - (save-excursion - (let ((count 1)) + "Search backwards for first unmatched DO [WHILE]. +Return point or nil." + (let ((case-fold-search t)) + (if (save-excursion (beginning-of-line) + (skip-chars-forward " \t0-9") + (looking-at "\\(\\(\\sw\\|\\s_\\)+:[ \t]*\\)?do[ \t]+")) + ;; Sitting on one. + (match-beginning 0) + ;; Search for one. + (save-excursion + (let ((count 1)) (while (and (not (= count 0)) - (not (eq (fortran-previous-statement) 'first-statement)) - ;; Keep local to subprogram - (not (looking-at "^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]"))) + (not (eq (fortran-previous-statement) 'first-statement)) + ;; Keep local to subprogram + (not (and (looking-at fortran-end-prog-re) + (fortran-check-end-prog-re)))) - (skip-chars-forward " \t0-9") - (cond ((looking-at "do[ \t]+[^0-9]") - (setq count (- count 1))) - ((looking-at "end[ \t]*do\\b") - (setq count (+ count 1))))) + (skip-chars-forward " \t0-9") + (cond ((looking-at "\\(\\(\\sw\\|\\s_\\)+:[ \t]*\\)?do[ \t]+[^0-9]") + (setq count (1- count))) + ((looking-at "end[ \t]*do\\b") + (setq count (1+ count))))) (and (= count 0) - ;; All pairs accounted for. - (point)))))) + ;; All pairs accounted for. + (point))))))) (defun fortran-mark-if () "Put mark at end of Fortran IF-ENDIF construct, point at beginning. @@ -1017,113 +1187,119 @@ The marks are pushed." (push-mark) (goto-char if-point))))) +(defvar fortran-if-start-re "\\(\\(\\sw\\|\\s_\\)+:[ \t]*\\)?if[ \t]*(") + (defun fortran-end-if () - ;; Search forwards for first unmatched ENDIF. Return point or nil. - (if (save-excursion (beginning-of-line) - (skip-chars-forward " \t0-9") - (looking-at "end[ \t]*if\\b")) - ;; Sitting on one. - (match-beginning 0) - ;; Search for one. The point has been already been moved to first - ;; letter on line but this should not cause troubles. - (save-excursion - (let ((count 1)) + "Search forwards for first unmatched ENDIF. +Return point or nil." + (let ((case-fold-search t)) + (if (save-excursion (beginning-of-line) + (skip-chars-forward " \t0-9") + (looking-at "end[ \t]*if\\b")) + ;; Sitting on one. + (match-beginning 0) + ;; Search for one. The point has been already been moved to first + ;; letter on line but this should not cause troubles. + (save-excursion + (let ((count 1)) (while (and (not (= count 0)) - (not (eq (fortran-next-statement) 'last-statement)) - ;; Keep local to subprogram. - (not (looking-at - "^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]"))) + (not (eq (fortran-next-statement) 'last-statement)) + ;; Keep local to subprogram. + (not (and (looking-at fortran-end-prog-re) + (fortran-check-end-prog-re)))) - (skip-chars-forward " \t0-9") - (cond ((looking-at "end[ \t]*if\\b") + (skip-chars-forward " \t0-9") + (cond ((looking-at "end[ \t]*if\\b") (setq count (- count 1))) - ((looking-at "if[ \t]*(") - (save-excursion - (if (or - (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]") - (let (then-test) ; Multi-line if-then. - (while + ((looking-at fortran-if-start-re) + (save-excursion + (if (or + (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]") + (let (then-test) ; Multi-line if-then. + (while (and (= (forward-line 1) 0) - ;; Search forward for then. - (or (looking-at " [^ 0\n]") - (looking-at "\t[1-9]")) - (not - (setq then-test - (looking-at - ".*then\\b[ \t]*[^ \t(=a-z0-9]"))))) - then-test)) + ;; Search forward for then. + (or (looking-at " [^ 0\n]") + (looking-at "\t[1-9]")) + (not + (setq then-test + (looking-at + ".*then\\b[ \t]*[^ \t(=a-z0-9]"))))) + then-test)) (setq count (+ count 1))))))) (and (= count 0) - ;; All pairs accounted for. - (point)))))) + ;; All pairs accounted for. + (point))))))) (defun fortran-beginning-if () - ;; Search backwards for first unmatched IF-THEN. Return point or nil. - (if (save-excursion - ;; May be sitting on multi-line if-then statement, first move to - ;; beginning of current statement. Note: `fortran-previous-statement' - ;; moves to previous statement *unless* current statement is first - ;; one. Only move forward if not first-statement. - (if (not (eq (fortran-previous-statement) 'first-statement)) - (fortran-next-statement)) - (skip-chars-forward " \t0-9") - (and - (looking-at "if[ \t]*(") - (save-match-data - (or (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]") - ;; Multi-line if-then. - (let (then-test) - (while + "Search backwards for first unmatched IF-THEN. +Return point or nil." + (let ((case-fold-search t)) + (if (save-excursion + ;; May be sitting on multi-line if-then statement, first move to + ;; beginning of current statement. Note: `fortran-previous-statement' + ;; moves to previous statement *unless* current statement is first + ;; one. Only move forward if not first-statement. + (if (not (eq (fortran-previous-statement) 'first-statement)) + (fortran-next-statement)) + (skip-chars-forward " \t0-9") + (and + (looking-at fortran-if-start-re) + (save-match-data + (or (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]") + ;; Multi-line if-then. + (let (then-test) + (while (and (= (forward-line 1) 0) - ;; Search forward for then. - (or (looking-at " [^ 0\n]") - (looking-at "\t[1-9]")) - (not - (setq then-test - (looking-at - ".*then\\b[ \t]*[^ \t(=a-z0-9]"))))) - then-test))))) - ;; Sitting on one. - (match-beginning 0) - ;; Search for one. - (save-excursion - (let ((count 1)) + ;; Search forward for then. + (or (looking-at " [^ 0\n]") + (looking-at "\t[1-9]")) + (not + (setq then-test + (looking-at + ".*then\\b[ \t]*[^ \t(=a-z0-9]"))))) + then-test))))) + ;; Sitting on one. + (match-beginning 0) + ;; Search for one. + (save-excursion + (let ((count 1)) (while (and (not (= count 0)) - (not (eq (fortran-previous-statement) 'first-statement)) - ;; Keep local to subprogram. - (not (looking-at - "^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]"))) - - (skip-chars-forward " \t0-9") - (cond ((looking-at "if[ \t]*(") - (save-excursion - (if (or - (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]") - (let (then-test) ; Multi-line if-then. - (while + (not (eq (fortran-previous-statement) 'first-statement)) + ;; Keep local to subprogram. + (not (and (looking-at fortran-end-prog-re) + (fortran-check-end-prog-re)))) + + (skip-chars-forward " \t0-9") + (cond ((looking-at fortran-if-start-re) + (save-excursion + (if (or + (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]") + (let (then-test) ; Multi-line if-then. + (while (and (= (forward-line 1) 0) - ;; Search forward for then. - (or (looking-at " [^ 0\n]") - (looking-at "\t[1-9]")) - (not - (setq then-test - (looking-at - ".*then\\b[ \t]*[^ \t(=a-z0-9]"))))) - then-test)) + ;; Search forward for then. + (or (looking-at " [^ 0\n]") + (looking-at "\t[1-9]")) + (not + (setq then-test + (looking-at + ".*then\\b[ \t]*[^ \t(=a-z0-9]"))))) + then-test)) (setq count (- count 1))))) - ((looking-at "end[ \t]*if\\b") + ((looking-at "end[ \t]*if\\b") (setq count (+ count 1))))) (and (= count 0) - ;; All pairs accounted for. - (point)))))) + ;; All pairs accounted for. + (point))))))) (defun fortran-indent-line () - "Indents current Fortran line based on its contents and on previous lines." + "Indent current Fortran line based on its contents and on previous lines." (interactive) - (let ((cfi (calculate-fortran-indent))) + (let ((cfi (fortran-calculate-indent))) (save-excursion (beginning-of-line) (if (or (not (= cfi (fortran-current-line-indentation))) @@ -1143,28 +1319,29 @@ The marks are pushed." (end-of-line) (fortran-fill))) (if fortran-blink-matching-if - (progn + (progn (fortran-blink-matching-if) (fortran-blink-matching-do))))) (defun fortran-indent-new-line () "Reindent the current Fortran line, insert a newline and indent the newline. -An abbrev before point is expanded if `abbrev-mode' is non-nil." +An abbrev before point is expanded if variable `abbrev-mode' is non-nil." (interactive) (if abbrev-mode (expand-abbrev)) (save-excursion (beginning-of-line) (skip-chars-forward " \t") - (if (or (looking-at "[0-9]") ;Reindent only where it is most - (looking-at "end") ;likely to be necessary - (looking-at "else") - (looking-at (regexp-quote fortran-continuation-string))) - (fortran-indent-line))) + (let ((case-fold-search t)) + (if (or (looking-at "[0-9]") ;Reindent only where it is most + (looking-at "end") ;likely to be necessary + (looking-at "else") + (looking-at (regexp-quote fortran-continuation-string))) + (fortran-indent-line)))) (newline) (fortran-indent-line)) (defun fortran-indent-subprogram () - "Properly indents the Fortran subprogram which contains point." + "Properly indent the Fortran subprogram which contains point." (interactive) (save-excursion (mark-fortran-subprogram) @@ -1172,7 +1349,7 @@ An abbrev before point is expanded if `abbrev-mode' is non-nil." (indent-region (point) (mark) nil)) (message "Indenting subprogram...done.")) -(defun calculate-fortran-indent () +(defun fortran-calculate-indent () "Calculates the Fortran indent column based on previous lines." (let (icol first-statement (case-fold-search t) (fortran-minimum-statement-indent @@ -1188,7 +1365,7 @@ An abbrev before point is expanded if `abbrev-mode' is non-nil." (setq icol fortran-minimum-statement-indent) (setq icol (fortran-current-line-indentation))) (skip-chars-forward " \t0-9") - (cond ((looking-at "if[ \t]*(") + (cond ((looking-at "\\(\\(\\sw\\|\\s_\\)+:[ \t]*\\)?if[ \t]*(") (if (or (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t_$(=a-z0-9]") (let (then-test) ;multi-line if-then (while (and (= (forward-line 1) 0) @@ -1200,11 +1377,11 @@ An abbrev before point is expanded if `abbrev-mode' is non-nil." *[^ \t_$(=a-z0-9]"))))) then-test)) (setq icol (+ icol fortran-if-indent)))) - ((looking-at "\\(else\\|elseif\\)\\b") + ((looking-at "else\\(if\\)?\\b") (setq icol (+ icol fortran-if-indent))) - ((looking-at "select[ \t]*case[ \t](.*)\\b") + ((looking-at "select[ \t]*case[ \t](.*)") (setq icol (+ icol fortran-if-indent))) - ((looking-at "case[ \t]*(.*)[ \t]*\n") + ((looking-at "case[ \t]*(.*)") (setq icol (+ icol fortran-if-indent))) ((looking-at "case[ \t]*default\\b") (setq icol (+ icol fortran-if-indent))) @@ -1217,7 +1394,8 @@ An abbrev before point is expanded if `abbrev-mode' is non-nil." ((looking-at "\\(structure\\|union\\|map\\|interface\\)\\b[ \t]*[^ \t=(a-z]") (setq icol (+ icol fortran-structure-indent))) - ((looking-at "end\\b[ \t]*[^ \t=(a-z]") + ((and (looking-at fortran-end-prog-re1) + (fortran-check-end-prog-re)) ;; Previous END resets indent to minimum (setq icol fortran-minimum-statement-indent)))))) (save-excursion @@ -1245,31 +1423,24 @@ An abbrev before point is expanded if `abbrev-mode' is non-nil." (setq icol (- icol fortran-do-indent))) (t (skip-chars-forward " \t0-9") - (cond ((looking-at "end[ \t]*if\\b") - (setq icol (- icol fortran-if-indent))) - ((looking-at "\\(else\\|elseif\\)\\b") + (cond ((looking-at "end[ \t]*\\(if\\|select\\|where\\)\\b") (setq icol (- icol fortran-if-indent))) - ((looking-at "case[ \t]*(.*)[ \t]*\n") + ((looking-at "else\\(if\\)?\\b") (setq icol (- icol fortran-if-indent))) - ((looking-at "case[ \t]*default\\b") + ((looking-at "case[ \t]*\\((.*)\\|default\\>\\)") (setq icol (- icol fortran-if-indent))) ((looking-at "\\(otherwise\\|else[ \t]*where\\)\\b") (setq icol (- icol fortran-if-indent))) - ((looking-at "end[ \t]*where\\b") - (setq icol (- icol fortran-if-indent))) ((and (looking-at "continue\\b") (fortran-check-for-matching-do)) (setq icol (- icol fortran-do-indent))) ((looking-at "end[ \t]*do\\b") (setq icol (- icol fortran-do-indent))) - ((looking-at - "end[ \t]*\ + ((looking-at "end[ \t]*\ \\(structure\\|union\\|map\\|interface\\)\\b[ \t]*[^ \t=(a-z]") (setq icol (- icol fortran-structure-indent))) - ((looking-at - "end[ \t]*select\\b[ \t]*[^ \t=(a-z]") - (setq icol (- icol fortran-if-indent))) - ((and (looking-at "end\\b[ \t]*[^ \t=(a-z]") + ((and (looking-at fortran-end-prog-re1) + (fortran-check-end-prog-re) (not (= icol fortran-minimum-statement-indent))) (message "Warning: `end' not in column %d. Probably\ an unclosed block." fortran-minimum-statement-indent)))))) @@ -1301,7 +1472,7 @@ non-indentation text within the comment." (current-column))) (defun fortran-indent-to-column (col) - "Indents current line with spaces to column COL. + "Indent current line with spaces to column COL. notes: 1) A non-zero/non-blank character in column 5 indicates a continuation line, and this continuation character is retained on indentation; 2) If `fortran-continuation-string' is the first non-whitespace @@ -1376,8 +1547,8 @@ Do not call if there is no line number." (= (current-column) 5)))))) (defun fortran-check-for-matching-do () - "When called from a numbered statement, returns t if matching DO is found. -Otherwise return a nil." + "When called from a numbered statement, return t if matching DO is found. +Otherwise return nil." (let (charnum (case-fold-search t)) (save-excursion @@ -1390,20 +1561,20 @@ Otherwise return a nil." (progn (skip-chars-forward "0-9") (point)))) (beginning-of-line) - (and (re-search-backward - (concat "\\(^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]\\)\\|" - "\\(^[ \t0-9]*do[ \t]*0*" charnum "\\b\\)\\|" - "\\(^[ \t]*0*" charnum "\\b\\)") - nil t) - (looking-at (concat "^[ \t0-9]*do[ \t]*0*" charnum)))))))) + (fortran-with-subprogram-narrowing + (and (re-search-backward + (concat "\\(^[ \t0-9]*do[ \t]*0*" charnum "\\b\\)\\|" + "\\(^[ \t]*0*" charnum "\\b\\)") + nil t) + (looking-at (concat "^[ \t0-9]*do[ \t]*0*" charnum))))))))) (defun fortran-find-comment-start-skip () "Move to past `comment-start-skip' found on current line. Return t if `comment-start-skip' found, nil if not." -;;; In order to move point only if comment-start-skip is found, -;;; this one uses a lot of save-excursions. Note that re-search-forward -;;; moves point even if comment-start-skip is inside a string-constant. -;;; Some code expects certain values for match-beginning and end + ;; In order to move point only if comment-start-skip is found, this + ;; one uses a lot of save-excursions. Note that re-search-forward + ;; moves point even if comment-start-skip is inside a string-constant. + ;; Some code expects certain values for match-beginning and end (interactive) (if (save-excursion (re-search-forward comment-start-skip @@ -1421,37 +1592,17 @@ Return t if `comment-start-skip' found, nil if not." t)) nil)) -;;;From: simon@gnu (Simon Marshall) -;;; Find the next ! not in a string. -(defun fortran-match-!-comment (limit) - (let (found) - (while (and (setq found (search-forward "!" limit t)) - (fortran-is-in-string-p (point)))) - (if (not found) - nil - ;; Cheaper than `looking-at' "!.*". - (store-match-data - (list (1- (point)) (progn (end-of-line) (min (point) limit)))) - t))) - -;; The above function is about 10% faster than the below... -;;(defun fortran-match-!-comment (limit) -;; (let (found) -;; (while (and (setq found (re-search-forward "!.*" limit t)) -;; (fortran-is-in-string-p (match-beginning 0)))) -;; found)) - -;;;From: ralf@up3aud1.gwdg.de (Ralf Fassel) -;;; Test if TAB format continuation lines work. +;;From: ralf@up3aud1.gwdg.de (Ralf Fassel) +;; Test if TAB format continuation lines work. (defun fortran-is-in-string-p (where) - "Return non-nil if POS (a buffer position) is inside a Fortran string, -nil else." + "Return non-nil iff WHERE (a buffer position) is inside a Fortran string." (save-excursion (goto-char where) (cond ((bolp) nil) ; bol is never inside a string ((save-excursion ; comment lines too - (beginning-of-line)(looking-at comment-line-start-skip)) nil) + (beginning-of-line) + (looking-at comment-line-start-skip)) nil) (t (let (;; ok, serious now. Init some local vars: (parse-state '(0 nil nil nil nil nil 0)) (quoted-comment-start (if comment-start @@ -1475,8 +1626,7 @@ nil else." comment-start (equal comment-start (char-to-string (preceding-char))))) - ;; get around a bug in forward-line in versions <= 18.57 - (if (or (> (forward-line 1) 0) (eobp)) + (if (> (forward-line) 0) (setq not-done nil)) ;; else: ;; if we are at beginning of code line, skip any @@ -1515,7 +1665,7 @@ automatically breaks the line at a previous space." (if (if (null arg) (not auto-fill-function) (> (prefix-numeric-value arg) 0)) - 'fortran-do-auto-fill + #'fortran-do-auto-fill nil)) (force-mode-line-update))) @@ -1525,7 +1675,8 @@ automatically breaks the line at a previous space." (defun fortran-fill () (interactive) - (let* ((opoint (point)) + (let* ((auto-fill-function #'fortran-do-auto-fill) + (opoint (point)) (bol (save-excursion (beginning-of-line) (point))) (eol (save-excursion (end-of-line) (point))) (bos (min eol (+ bol (fortran-current-line-indentation)))) @@ -1535,19 +1686,16 @@ automatically breaks the line at a previous space." (if (looking-at comment-line-start-skip) nil ; OK to break quotes on comment lines. (move-to-column fill-column) - (cond ((fortran-is-in-string-p (point)) - (save-excursion (re-search-backward "[^']'[^']" bol t) - (if fortran-break-before-delimiters - (point) - (1+ (point))))) - (t nil))))) - ;; + (if (fortran-is-in-string-p (point)) + (save-excursion (re-search-backward "\\S\"\\s\"\\S\"" bol t) + (if fortran-break-before-delimiters + (point) + (1+ (point)))))))) ;; decide where to split the line. If a position for a quoted ;; string was found above then use that, else break the line ;; before the last delimiter. ;; Delimiters are whitespace, commas, and operators. ;; Will break before a pair of *'s. - ;; (fill-point (or quote (save-excursion @@ -1559,19 +1707,18 @@ automatically breaks the line at a previous space." (if (<= (point) (1+ bos)) (progn (move-to-column (1+ fill-column)) -;;;what is this doing??? + ;;what is this doing??? (if (not (re-search-forward "[\t\n,'+-/*)=]" eol t)) (goto-char bol)))) (if (bolp) (re-search-forward "[ \t]" opoint t) - (forward-char -1) - (if (looking-at "'") - (forward-char 1) + (backward-char) + (if (looking-at "\\s\"") + (forward-char) (skip-chars-backward " \t\*"))) (if fortran-break-before-delimiters (point) - (1+ (point)))))) - ) + (1+ (point))))))) ;; if we are in an in-line comment, don't break unless the ;; line of code is longer than it should be. Otherwise ;; break the line at the column computed above. @@ -1596,7 +1743,7 @@ automatically breaks the line at a previous space." (if (> (save-excursion (goto-char fill-point) (current-column)) - (+ (calculate-fortran-indent) fortran-continuation-indent)) + (+ (fortran-calculate-indent) fortran-continuation-indent)) (progn (goto-char fill-point) (fortran-break-line)))))) @@ -1613,8 +1760,8 @@ automatically breaks the line at a previous space." (re-search-backward comment-start-skip bol t) (setq comment-string (buffer-substring (point) eol)) (delete-region (point) eol)))) -;;; Forward line 1 really needs to go to next non white line - (if (save-excursion (forward-line 1) + ;; Forward line 1 really needs to go to next non white line + (if (save-excursion (forward-line) (or (looking-at " [^ 0\n]") (looking-at "\t[1-9]"))) (progn @@ -1632,7 +1779,7 @@ automatically breaks the line at a previous space." (insert comment-string))))) (defun fortran-analyze-file-format () - "Returns nil if fixed format is used, t if TAB formatting is used. + "Return nil if fixed format is used, t if TAB formatting is used. Use `fortran-tab-mode-default' if no non-comment statements are found in the file before the end or the first `fortran-analyze-depth' lines." (let ((i 0)) @@ -1658,6 +1805,71 @@ file before the end or the first `fortran-analyze-depth' lines." (indent-tabs-mode fortran-tab-mode-string)) minor-mode-alist))) +(defun fortran-fill-paragraph (&optional justify) + "Fill surrounding comment block as paragraphs, else fill statement. + +Intended as the value of `fill-paragraph-function'." + (interactive "P") + (save-excursion + (beginning-of-line) + (if (not (looking-at "[Cc*]")) + (fortran-fill-statement) + ;; We're in a comment block. Find the start and end of a + ;; paragraph, delimited either by non-comment lines or empty + ;; comments. (Get positions as markers, since the + ;; `indent-region' below can shift the block's end). + (let* ((non-empty-comment (concat "\\(" comment-line-start-skip + "\\)" "[^ \t\n]")) + (start (save-excursion + ;; Find (start of) first line. + (while (and (zerop (forward-line -1)) + (looking-at non-empty-comment))) + (or (looking-at non-empty-comment) + (forward-line)) ; overshot + (point-marker))) + (end (save-excursion + ;; Find start of first line past region to fill. + (while (progn (forward-line) + (looking-at non-empty-comment))) + (point-marker)))) + ;; Indent the block, find the string comprising the effective + ;; comment start skip and use that as a fill-prefix for + ;; filling the region. + (indent-region start end nil) + (let ((paragraph-ignore-fill-prefix nil) + (fill-prefix (progn (beginning-of-line) + (looking-at comment-line-start-skip) + (match-string 0)))) + (let (fill-paragraph-function) + (fill-region start end justify))) ; with normal `fill-paragraph' + (set-marker start nil) + (set-marker end nil)))) + t) + +(defun fortran-fill-statement () + "Fill a fortran statement up to `fill-column'." + (interactive) + (let ((auto-fill-function #'fortran-do-auto-fill)) + (if (not (save-excursion + (beginning-of-line) + (or (looking-at "[ \t]*$") + (looking-at comment-line-start-skip) + (and comment-start-skip + (looking-at (concat "[ \t]*" comment-start-skip)))))) + (save-excursion + ;; Find beginning of statement. + (fortran-next-statement) + (fortran-previous-statement) + ;; Re-indent initially. + (fortran-indent-line) + ;; Replace newline plus continuation field plus indentation with + ;; single space. + (while (progn + (forward-line) + (fortran-remove-continuation))) + (fortran-previous-statement))) + (fortran-indent-line))) + (provide 'fortran) ;;; fortran.el ends here