+
+(defun fortran-blink-matching-do ()
+ "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"))
+ (progn
+ (if (not (setq matching-do (fortran-beginning-do)))
+ (setq message "No matching do.")
+ (if (< matching-do top-of-window)
+ (save-excursion
+ (goto-char matching-do)
+ (beginning-of-line)
+ (setq message
+ (concat "Matches "
+ (buffer-substring
+ (point) (progn (end-of-line) (point))))))))
+ (if message
+ (message "%s" message)
+ (goto-char matching-do)
+ (sit-for 1)
+ (goto-char enddo-point))))))
+
+(defun fortran-mark-do ()
+ "Put mark at end of Fortran DO [WHILE]-ENDDO construct, point at beginning.
+The marks are pushed."
+ (interactive)
+ (let (enddo-point do-point)
+ (if (setq enddo-point (fortran-end-do))
+ (if (not (setq do-point (fortran-beginning-do)))
+ (message "No matching do.")
+ ;; Set mark, move point.
+ (goto-char enddo-point)
+ (push-mark)
+ (goto-char do-point)))))
+
+(defun fortran-end-do ()
+ "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 (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)))))))
+
+(defun fortran-beginning-do ()
+ "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 (and (looking-at fortran-end-prog-re)
+ (fortran-check-end-prog-re))))
+
+ (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)))))))
+
+(defun fortran-mark-if ()
+ "Put mark at end of Fortran IF-ENDIF construct, point at beginning.
+The marks are pushed."
+ (interactive)
+ (let (endif-point if-point)
+ (if (setq endif-point (fortran-end-if))
+ (if (not (setq if-point (fortran-beginning-if)))
+ (message "No matching if.")
+ ;; Set mark, move point.
+ (goto-char endif-point)
+ (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."
+ (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 (and (looking-at fortran-end-prog-re)
+ (fortran-check-end-prog-re))))
+
+ (skip-chars-forward " \t0-9")
+ (cond ((looking-at "end[ \t]*if\\b")
+ (setq count (- count 1)))
+
+ ((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))
+ (setq count (+ count 1)))))))
+
+ (and (= count 0)
+ ;; All pairs accounted for.
+ (point)))))))
+
+(defun fortran-beginning-if ()
+ "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))
+ (while (and (not (= count 0))
+ (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))
+ (setq count (- count 1)))))
+ ((looking-at "end[ \t]*if\\b")
+ (setq count (+ count 1)))))
+
+ (and (= count 0)
+ ;; All pairs accounted for.
+ (point)))))))