# HG changeset patch # User Glenn Morris # Date 1022277621 0 # Node ID 599066f40ebef530d57b5e3686087c3532876343 # Parent c9b9e61985bdb314d8820abe533df9d275872fa3 (f90-end-of-subprogram): Remove the final (forward-line 1). (f90-end-of-block, f90-beginning-of-block, f90-next-block-end, f90-previous-block-start): New navigation commands. diff -r c9b9e61985bd -r 599066f40ebe lisp/progmodes/f90.el --- a/lisp/progmodes/f90.el Fri May 24 09:59:42 2002 +0000 +++ b/lisp/progmodes/f90.el Fri May 24 22:00:21 2002 +0000 @@ -426,11 +426,15 @@ (define-key map "\C-\M-a" 'f90-beginning-of-subprogram) (define-key map "\C-\M-e" 'f90-end-of-subprogram) (define-key map "\C-\M-h" 'f90-mark-subprogram) + (define-key map "\C-\M-n" 'f90-end-of-block) + (define-key map "\C-\M-p" 'f90-beginning-of-block) (define-key map "\C-\M-q" 'f90-indent-subprogram) (define-key map "\C-j" 'f90-indent-new-line) ; LFD equals C-j (define-key map "\r" 'newline) (define-key map "\C-c\r" 'f90-break-line) ;;; (define-key map [M-return] 'f90-break-line) + (define-key map "\C-c\C-a" 'f90-previous-block-start) + (define-key map "\C-c\C-e" 'f90-next-block-end) (define-key map "\C-c\C-d" 'f90-join-lines) (define-key map "\C-c\C-f" 'f90-fill-region) (define-key map "\C-c\C-p" 'f90-previous-statement) @@ -1226,12 +1230,151 @@ ((setq matching-end (f90-looking-at-program-block-end)) (setq count (1- count)))) (end-of-line)) - (forward-line 1) + ;; This means f90-end-of-subprogram followed by f90-start-of-subprogram + ;; has a net non-zero effect, which seems odd. +;;; (forward-line 1) (if (zerop count) matching-end (message "No end found.") nil))) + +(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 necessary." + (interactive "p") + (if (and num (< num 0)) (f90-beginning-of-block (- num))) + (let ((f90-smart-end nil) ; for the final `f90-match-end' + (case-fold-search t) + (count (or num 1)) + start-list start-this start-type start-label end-type end-label) + (if (interactive-p) (push-mark (point) t)) + (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)) + (if (not (f90-equal-symbols start-type end-type)) + (error "End type `%s' does not match start type `%s'" + end-type start-type)) + (if (not (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 "Unterminated block")) + ;; Check outermost block. + (if (interactive-p) + (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." + (interactive "p") + (if (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) + (if (interactive-p) (push-mark (point) t)) + (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)) + (if (not (f90-equal-symbols start-type end-type)) + (error "Start type `%s' does not match end type `%s'" + start-type end-type)) + (if (not (f90-equal-symbols start-label end-label)) + (error "Start label `%s' does not match end label `%s'" + start-label end-label)))))) + (if (> count 0) (error "Missing block start")))) + +(defun f90-next-block-end (&optional num) + "Move point forward to the next block end. +With optional argument NUM, go forward that many block ends. +If NUM is negative, go backward to the start of a block." + (interactive "p") + (if (and num (< num 0)) (f90-previous-block-start (- num))) + (let ((count (or num 1)) + (end-re (concat "end[ \t]*" f90-blocks-re))) + (while (and (> count 0) (re-search-forward end-re nil 'move)) + (beginning-of-line) + (skip-chars-forward " \t0-9") + (or (f90-in-string) (f90-in-comment) + (setq count (1- count))) + (end-of-line)))) + +(defun f90-previous-block-start (&optional num) + "Move point backward to the previous block start. +With optional argument NUM, go backward that many block starts. +If NUM is negative, go forward to the end of a block." + (interactive "p") + (if (and num (< num 0)) (f90-next-block-end (- num))) + (let ((count (or num 1))) + (while (and (> count 0) (re-search-backward f90-blocks-re nil 'move)) + (beginning-of-line) + (skip-chars-forward " \t0-9") + (or (f90-in-string) (f90-in-comment) + (and (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 count (1- count))))))) + + (defvar f90-mark-subprogram-overlay nil "Used internally by `f90-mark-subprogram' to highlight the subprogram.") (make-variable-buffer-local 'f90-mark-subprogram-overlay)