# HG changeset patch # User Dave Love # Date 891975584 0 # Node ID d68f866455c6b0e1c3bff2fd6f1a328622882a55 # Parent 3e8b7782f4f57dd00272168a77449a52b1609980 Use regexp-opt and eval-and-compile to build font-lock patterns. (fortran-mode): Define indent-region-function, indent-line-function. (fortran-tab-mode-string): Make buffer-local. (fortran-comment-indent-style): Custom tweak. (fortran-comment-region, fortran-electric-line-number, fortran-analyze-depth, fortran-break-before-delimiters, fortran-mode): Doc fix. (fortran-startup-message, bug-fortran-mode): Variables deleted. (fortran-font-lock-keywords-1): Add "select", "case"; allow double-quoted strings. (fortran-mode-map): Add fill-paragraph menu item. Don't define \t. (fortran-mode): Make `fill-column' buffer-local; set `fill-paragraph-function', `indent-region-function', `indent-line-function'. (calculate-fortran-indent): Renamed to: (fortran-calculate-indent): (fortran-split-line): Simplify. (fortran-remove-continuation): New function. (fortran-join-line): Use it. (fortran-end-prog-re1, fortran-end-prog-re): New variables. (beginning-of-fortran-subprogram, end-of-fortran-subprogram): Use them. (fortran-blink-matching-if, fortran-blink-matching-do, fortran-indent-new-line): Bind case-fold-search. (fortran-end-do, fortran-beginning-do, fortran-end-if, fortran-beginning-if): Bind case-fold-search. Allow labelled blocks. Use fortran-end-prog-re. (fortran-if-start-re): New variable. (fortran-calculate-indent): Allow labelled blocks. Simplify the conds. Make select case indentation work. (fortran-is-in-string-p): Ignore Emacs 18 bug kluge. (fortran-fill): Allow double quotes in check for string. (fortran-fill-paragraph): New function. (fortran-fill-statement): New function. diff -r 3e8b7782f4f5 -r d68f866455c6 lisp/progmodes/fortran.el --- a/lisp/progmodes/fortran.el Tue Apr 07 18:22:28 1998 +0000 +++ b/lisp/progmodes/fortran.el Tue Apr 07 18:59:44 1998 +0000 @@ -42,6 +42,13 @@ ;;; Code: +;; Todo: + +;; * 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 other f90-style stuff grokked by GNU Fortran. + (require 'easymenu) (defgroup fortran nil @@ -73,6 +80,7 @@ "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,7 +110,7 @@ `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 @@ -168,19 +176,14 @@ :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) @@ -204,11 +207,11 @@ "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) @@ -252,115 +255,109 @@ (defconst fortran-font-lock-keywords-3 nil "Gaudy level highlighting for Fortran mode.") -(let ((comment-chars "c!*") - (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\\)")) +(eval-and-compile + (let ((comment-chars "c!*") + (fortran-type-types + (regexp-opt + (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)))) + (fortran-keywords + (regexp-opt '("continue" "format" "end" "enddo" "if" "then" + "else" "endif" "elseif" "while" "inquire" "stop" + "return" "include" "open" "close" "read" "write" + "format" "print" "select" "case"))) (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")) + (regexp-opt '("and" "or" "not" "lt" "le" "eq" "ge" "gt" "ne" + "true" "false")))) - (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)))) + (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)) + '("\\(\\s\"\\)\"[^\n]*\\1?" . 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)))) - (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-constant-face nil t)) - (cons "^ *\\([0-9]+\\)" 'font-lock-constant-face)))) + (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-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-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)))) - ) + (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)) + ;; 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.") @@ -378,8 +375,9 @@ ;; index. [This will be fooled by `end function' allowed by G77. ;; Also, it assumes sensible whitespace is employed.] (concat "^\\s-+\\(\ -\\(\\sw\\|\\s-\\|[*()+]\\)*\\\\)") (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) (not (= icol fortran-minimum-statement-indent))) (message "Warning: `end' not in column %d. Probably\ an unclosed block." fortran-minimum-statement-indent)))))) @@ -1459,7 +1468,7 @@ (point)))) (beginning-of-line) (and (re-search-backward - (concat "\\(^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]\\)\\|" + (concat "\\(" fortran-end-prog-re "\\)\\|" "\\(^[ \t0-9]*do[ \t]*0*" charnum "\\b\\)\\|" "\\(^[ \t]*0*" charnum "\\b\\)") nil t) @@ -1468,10 +1477,10 @@ (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 @@ -1489,8 +1498,8 @@ t)) nil)) -;;;From: simon@gnu (Simon Marshall) -;;; Find the next ! not in a string. +;;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)) @@ -1509,8 +1518,8 @@ ;; (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 iff WHERE (a buffer position) is inside a Fortran string." (save-excursion @@ -1518,7 +1527,8 @@ (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 @@ -1542,8 +1552,7 @@ 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 @@ -1582,7 +1591,7 @@ (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))) @@ -1602,19 +1611,16 @@ (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 @@ -1626,19 +1632,18 @@ (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. @@ -1663,7 +1668,7 @@ (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)))))) @@ -1680,8 +1685,8 @@ (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 @@ -1725,6 +1730,70 @@ (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))))) + +(defun fortran-fill-statement () + "Fill a fortran statement up to `fill-column'." + (interactive) + (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) + t) ; must return t for fill-paragraph + (provide 'fortran) ;;; fortran.el ends here