+
+(defun f90-end-of-block (&optional num)
+ "Move point forward to the end of the current code block.
+With optional argument NUM, go forward that many balanced blocks.
+If NUM is negative, go backward to the start of a block. Checks
+for consistency of block types and labels (if present), and
+completes outermost block if `f90-smart-end' is non-nil.
+Interactively, pushes mark before moving point."
+ (interactive "p")
+ (if (interactive-p) (push-mark (point) t)) ; can move some distance
+ (and num (< num 0) (f90-beginning-of-block (- num)))
+ (let ((f90-smart-end (if f90-smart-end 'no-blink)) ; for final match-end
+ (case-fold-search t)
+ (count (or num 1))
+ start-list start-this start-type start-label end-type end-label)
+ (end-of-line) ; probably want this
+ (while (and (> count 0) (re-search-forward f90-blocks-re nil 'move))
+ (beginning-of-line)
+ (skip-chars-forward " \t0-9")
+ (cond ((or (f90-in-string) (f90-in-comment)))
+ ((setq start-this
+ (or
+ (f90-looking-at-do)
+ (f90-looking-at-select-case)
+ (f90-looking-at-type-like)
+ (f90-looking-at-program-block-start)
+ (f90-looking-at-if-then)
+ (f90-looking-at-where-or-forall)))
+ (setq start-list (cons start-this start-list) ; not add-to-list!
+ count (1+ count)))
+ ((looking-at (concat "end[ \t]*" f90-blocks-re
+ "[ \t]*\\(\\sw+\\)?"))
+ (setq end-type (match-string 1)
+ end-label (match-string 2)
+ count (1- count))
+ ;; Check any internal blocks.
+ (when start-list
+ (setq start-this (car start-list)
+ start-list (cdr start-list)
+ start-type (car start-this)
+ start-label (cadr start-this))
+ (or (f90-equal-symbols start-type end-type)
+ (error "End type `%s' does not match start type `%s'"
+ end-type start-type))
+ (or (f90-equal-symbols start-label end-label)
+ (error "End label `%s' does not match start label `%s'"
+ end-label start-label)))))
+ (end-of-line))
+ (if (> count 0) (error "Missing block end"))
+ ;; Check outermost block.
+ (when f90-smart-end
+ (save-excursion
+ (beginning-of-line)
+ (skip-chars-forward " \t0-9")
+ (f90-match-end)))))
+
+(defun f90-beginning-of-block (&optional num)
+ "Move point backwards to the start of the current code block.
+With optional argument NUM, go backward that many balanced blocks.
+If NUM is negative, go forward to the end of a block.
+Checks for consistency of block types and labels (if present).
+Does not check the outermost block, because it may be incomplete.
+Interactively, pushes mark before moving point."
+ (interactive "p")
+ (if (interactive-p) (push-mark (point) t))
+ (and num (< num 0) (f90-end-of-block (- num)))
+ (let ((case-fold-search t)
+ (count (or num 1))
+ end-list end-this end-type end-label
+ start-this start-type start-label)
+ (beginning-of-line) ; probably want this
+ (while (and (> count 0) (re-search-backward f90-blocks-re nil 'move))
+ (beginning-of-line)
+ (skip-chars-forward " \t0-9")
+ (cond ((or (f90-in-string) (f90-in-comment)))
+ ((looking-at (concat "end[ \t]*" f90-blocks-re
+ "[ \t]*\\(\\sw+\\)?"))
+ (setq end-list (cons (list (match-string 1) (match-string 2))
+ end-list)
+ count (1+ count)))
+ ((setq start-this
+ (or
+ (f90-looking-at-do)
+ (f90-looking-at-select-case)
+ (f90-looking-at-type-like)
+ (f90-looking-at-program-block-start)
+ (f90-looking-at-if-then)
+ (f90-looking-at-where-or-forall)))
+ (setq start-type (car start-this)
+ start-label (cadr start-this)
+ count (1- count))
+ ;; Check any internal blocks.
+ (when end-list
+ (setq end-this (car end-list)
+ end-list (cdr end-list)
+ end-type (car end-this)
+ end-label (cadr end-this))
+ (or (f90-equal-symbols start-type end-type)
+ (error "Start type `%s' does not match end type `%s'"
+ start-type end-type))
+ (or (f90-equal-symbols start-label end-label)
+ (error "Start label `%s' does not match end label `%s'"
+ start-label end-label))))))
+ ;; Includes an un-named main program block.
+ (if (> count 0) (error "Missing block start"))))
+
+(defun f90-next-block (&optional num)
+ "Move point forward to the next end or start of a code block.
+With optional argument NUM, go forward that many blocks.
+If NUM is negative, go backwards.
+A block is a subroutine, if-endif, etc."
+ (interactive "p")
+ (let ((case-fold-search t)
+ (count (if num (abs num) 1)))
+ (while (and (> count 0)
+ (if (> num 0) (re-search-forward f90-blocks-re nil 'move)
+ (re-search-backward f90-blocks-re nil 'move)))
+ (beginning-of-line)
+ (skip-chars-forward " \t0-9")
+ (cond ((or (f90-in-string) (f90-in-comment)))
+ ((or
+ (looking-at "end[ \t]*")
+ (f90-looking-at-do)
+ (f90-looking-at-select-case)
+ (f90-looking-at-type-like)
+ (f90-looking-at-program-block-start)
+ (f90-looking-at-if-then)
+ (f90-looking-at-where-or-forall))
+ (setq count (1- count))))
+ (if (> num 0) (end-of-line)
+ (beginning-of-line)))))
+
+
+(defun f90-previous-block (&optional num)
+ "Move point backward to the previous end or start of a code block.
+With optional argument NUM, go backward that many blocks.
+If NUM is negative, go forwards.
+A block is a subroutine, if-endif, etc."
+ (interactive "p")
+ (f90-next-block (- (or num 1))))
+
+