[Emacs-diffs] Changes to emacs/lisp/progmodes/f90.el

[Glenn Morris]

Index: emacs/lisp/progmodes/f90.el
diff -c emacs/lisp/progmodes/f90.el:1.68 emacs/lisp/progmodes/f90.el:1.69
*** emacs/lisp/progmodes/f90.el:1.68    Tue Apr 15 15:18:23 2003
--- emacs/lisp/progmodes/f90.el Wed Apr 16 07:08:58 2003
***************
*** 770,776 ****
                                   f90-font-lock-keywords-3
                                   f90-font-lock-keywords-4)
           nil t))
-   ;; Tell imenu how to handle f90.
    (set (make-local-variable 'imenu-case-fold-search) t)
    (set (make-local-variable 'imenu-generic-expression)
         f90-imenu-generic-expression)
--- 770,775 ----
***************
*** 817,822 ****
--- 816,824 ----
      (skip-chars-backward " \t")
      (= (preceding-char) ?&)))
  
+ ;; GM this is not right, eg a continuation line starting with a number.
+ ;; Need f90-code-start-position function.
+ ;; And yet, things seems to work with this...
  (defsubst f90-current-indentation ()
    "Return indentation of current line.
  Line-numbers are considered whitespace characters."
***************
*** 827,838 ****
  If optional argument NO-LINE-NUMBER is nil, jump over a possible
  line-number before indenting."
    (beginning-of-line)
!   (if (not no-line-number)
        (skip-chars-forward " \t0-9"))
    (delete-horizontal-space)
!   (if (zerop (current-column))
!       (indent-to col)
!     (indent-to col 1)))                 ; leave >= 1 space after line number
  
  (defsubst f90-get-present-comment-type ()
    "If point lies within a comment, return the string starting the comment.
--- 829,839 ----
  If optional argument NO-LINE-NUMBER is nil, jump over a possible
  line-number before indenting."
    (beginning-of-line)
!   (or no-line-number
        (skip-chars-forward " \t0-9"))
    (delete-horizontal-space)
!   ;; Leave >= 1 space after line number.
!   (indent-to col (if (zerop (current-column)) 0 1)))
  
  (defsubst f90-get-present-comment-type ()
    "If point lies within a comment, return the string starting the comment.
***************
*** 850,871 ****
    (equal (if a (downcase a) nil)
           (if b (downcase b) nil)))
  
- ;; XEmacs 19.11 & 19.12 return a single char when matching an empty regexp.
- ;; The next 2 functions are therefore longer than necessary.
  (defsubst f90-looking-at-do ()
    "Return (\"do\" NAME) if a do statement starts after point.
  NAME is nil if the statement has no label."
    (if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(do\\)\\>")
!       (list (match-string 3)
!             (if (looking-at "\\(\\sw+\\)[ \t]*:") (match-string 1)))))
  
  (defsubst f90-looking-at-select-case ()
    "Return (\"select\" NAME) if a select-case statement starts after point.
  NAME is nil if the statement has no label."
    (if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\
  \\(select\\)[ \t]*case[ \t]*(")
!       (list (match-string 3)
!             (if (looking-at "\\(\\sw+\\)[ \t]*:") (match-string 1)))))
  
  (defsubst f90-looking-at-if-then ()
    "Return (\"if\" NAME) if an if () then statement starts after point.
--- 851,868 ----
    (equal (if a (downcase a) nil)
           (if b (downcase b) nil)))
  
  (defsubst f90-looking-at-do ()
    "Return (\"do\" NAME) if a do statement starts after point.
  NAME is nil if the statement has no label."
    (if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(do\\)\\>")
!       (list (match-string 3) (match-string 2)))
  
  (defsubst f90-looking-at-select-case ()
    "Return (\"select\" NAME) if a select-case statement starts after point.
  NAME is nil if the statement has no label."
    (if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\
  \\(select\\)[ \t]*case[ \t]*(")
!       (list (match-string 3) (match-string 2))))
  
  (defsubst f90-looking-at-if-then ()
    "Return (\"if\" NAME) if an if () then statement starts after point.
***************
*** 873,879 ****
    (save-excursion
      (when (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(if\\)\\>")
        (let ((struct (match-string 3))
!             (label (if (looking-at "\\(\\sw+\\)[ \t]*:") (match-string 1)))
              (pos (scan-lists (point) 1 0)))
          (and pos (goto-char pos))
          (skip-chars-forward " \t")
--- 870,876 ----
    (save-excursion
      (when (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(if\\)\\>")
        (let ((struct (match-string 3))
!             (label (match-string 2))
              (pos (scan-lists (point) 1 0)))
          (and pos (goto-char pos))
          (skip-chars-forward " \t")
***************
*** 891,897 ****
      (when (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\
  \\(where\\|forall\\)\\>")
        (let ((struct (match-string 3))
!             (label (if (looking-at "\\(\\sw+\\)[ \t]*:") (match-string 1)))
              (pos (scan-lists (point) 1 0)))
          (and pos (goto-char pos))
          (skip-chars-forward " \t")
--- 888,894 ----
      (when (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\
  \\(where\\|forall\\)\\>")
        (let ((struct (match-string 3))
!             (label (match-string 2))
              (pos (scan-lists (point) 1 0)))
          (and pos (goto-char pos))
          (skip-chars-forward " \t")
***************
*** 915,922 ****
         (looking-at "\\(module\\)[ \t]+\\(\\sw+\\)\\>"))
      (list (match-string 1) (match-string 2)))
     ((and (not (looking-at "end[ \t]*\\(function\\|subroutine\\)"))
!        (looking-at "[^!'\"\&\n]*\\(function\\|subroutine\\)\
! [ \t]+\\(\\sw+\\)"))
      (list (match-string 1) (match-string 2)))))
  
  (defsubst f90-looking-at-program-block-end ()
--- 912,919 ----
         (looking-at "\\(module\\)[ \t]+\\(\\sw+\\)\\>"))
      (list (match-string 1) (match-string 2)))
     ((and (not (looking-at "end[ \t]*\\(function\\|subroutine\\)"))
!        (looking-at "[^!'\"\&\n]*\\(function\\|subroutine\\)[ \t]+\
! \\(\\sw+\\)"))
      (list (match-string 1) (match-string 2)))))
  
  (defsubst f90-looking-at-program-block-end ()
***************
*** 966,989 ****
    "If `f90-leave-line-no' is nil, left-justify a line number.
  Leaves point at the first non-blank character after the line number.
  Call from beginning of line."
!   (if (and (null f90-leave-line-no) (looking-at "[ \t]+[0-9]"))
!       (delete-horizontal-space))
    (skip-chars-forward " \t0-9"))
  
  (defsubst f90-no-block-limit ()
    "Return nil if point is at the edge of a code block.
  Searches line forward for \"function\" or \"subroutine\",
  if all else fails."
!   (let ((eol (line-end-position)))
!     (save-excursion
!       (not (or (looking-at "end")
!              (looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\
  \\|select[ \t]*case\\|case\\|where\\|forall\\)\\>")
!              (looking-at "\\(program\\|module\\|interface\\|\
  block[ \t]*data\\)\\>")
!              (looking-at "\\(contains\\|\\sw+[ \t]*:\\)")
!              (looking-at f90-type-def-re)
!              (re-search-forward "\\(function\\|subroutine\\)" eol t))))))
  
  (defsubst f90-update-line ()
    "Change case of current line as per `f90-auto-keyword-case'."
--- 963,986 ----
    "If `f90-leave-line-no' is nil, left-justify a line number.
  Leaves point at the first non-blank character after the line number.
  Call from beginning of line."
!   (and (null f90-leave-line-no) (looking-at "[ \t]+[0-9]")
!        (delete-horizontal-space))
    (skip-chars-forward " \t0-9"))
  
  (defsubst f90-no-block-limit ()
    "Return nil if point is at the edge of a code block.
  Searches line forward for \"function\" or \"subroutine\",
  if all else fails."
!   (save-excursion
!     (not (or (looking-at "end")
!              (looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\
  \\|select[ \t]*case\\|case\\|where\\|forall\\)\\>")
!              (looking-at "\\(program\\|module\\|interface\\|\
  block[ \t]*data\\)\\>")
!              (looking-at "\\(contains\\|\\sw+[ \t]*:\\)")
!              (looking-at f90-type-def-re)
!              (re-search-forward "\\(function\\|subroutine\\)"
!                                 (line-end-position) t)))))
  
  (defsubst f90-update-line ()
    "Change case of current line as per `f90-auto-keyword-case'."
***************
*** 1196,1205 ****
                       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))
--- 1193,1202 ----
                       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))
***************
*** 1221,1227 ****
    (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))
--- 1218,1225 ----
    (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))
***************
*** 1250,1259 ****
                       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"))))
--- 1248,1257 ----
                       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))))))
       (if (> count 0) (error "Missing block start"))))
***************
*** 1313,1327 ****
  Insert the variable `f90-comment-region' at the start of every line
  in the region, or, if already present, remove it."
    (interactive "*r")
!   (let ((end (make-marker)))
!     (set-marker end end-region)
      (goto-char beg-region)
      (beginning-of-line)
      (if (looking-at (regexp-quote f90-comment-region))
        (delete-region (point) (match-end 0))
        (insert f90-comment-region))
      (while (and (zerop (forward-line 1))
!               (< (point) (marker-position end)))
        (if (looking-at (regexp-quote f90-comment-region))
          (delete-region (point) (match-end 0))
        (insert f90-comment-region)))
--- 1311,1324 ----
  Insert the variable `f90-comment-region' at the start of every line
  in the region, or, if already present, remove it."
    (interactive "*r")
!   (let ((end (copy-marker end-region)))
      (goto-char beg-region)
      (beginning-of-line)
      (if (looking-at (regexp-quote f90-comment-region))
        (delete-region (point) (match-end 0))
        (insert f90-comment-region))
      (while (and (zerop (forward-line 1))
!               (< (point) end))
        (if (looking-at (regexp-quote f90-comment-region))
          (delete-region (point) (match-end 0))
        (insert f90-comment-region)))
***************
*** 1332,1357 ****
  Unless optional argument NO-UPDATE is non-nil, call `f90-update-line'
  after indenting."
    (interactive "*P")
!   (let (indent no-line-number (pos (make-marker)) (case-fold-search t))
!     (set-marker pos (point))
!     (beginning-of-line)                ; digits after & \n are not line-nos
!     (if (save-excursion (and (f90-previous-statement) (f90-line-continued)))
!       (progn (setq no-line-number t) (skip-chars-forward " \t"))
!       (f90-indent-line-no))
      (if (looking-at "!")
        (setq indent (f90-comment-indent))
!       (if (and (looking-at "end") f90-smart-end)
!           (f90-match-end))
        (setq indent (f90-calculate-indent)))
!     (if (not (zerop (- indent (current-column))))
          (f90-indent-to indent no-line-number))
      ;; If initial point was within line's indentation,
      ;; position after the indentation.  Else stay at same point in text.
!     (if (< (point) (marker-position pos))
!       (goto-char (marker-position pos)))
      (if auto-fill-function
          (f90-do-auto-fill)              ; also updates line
!       (if (not no-update) (f90-update-line)))
      (set-marker pos nil)))
  
  (defun f90-indent-new-line ()
--- 1329,1357 ----
  Unless optional argument NO-UPDATE is non-nil, call `f90-update-line'
  after indenting."
    (interactive "*P")
!   (let ((case-fold-search t)
!         (pos (point-marker))
!         indent no-line-number)
!     (beginning-of-line)           ; digits after & \n are not line-nos
!     (if (not (save-excursion (and (f90-previous-statement)
!                                   (f90-line-continued))))
!         (f90-indent-line-no)
!       (setq no-line-number t)
!       (skip-chars-forward " \t"))
      (if (looking-at "!")
        (setq indent (f90-comment-indent))
!       (and f90-smart-end (looking-at "end")
!            (f90-match-end))
        (setq indent (f90-calculate-indent)))
!     (or (= indent (current-column))
          (f90-indent-to indent no-line-number))
      ;; If initial point was within line's indentation,
      ;; position after the indentation.  Else stay at same point in text.
!     (and (< (point) pos)
!          (goto-char pos))
      (if auto-fill-function
          (f90-do-auto-fill)              ; also updates line
!       (or no-update (f90-update-line)))
      (set-marker pos nil)))
  
  (defun f90-indent-new-line ()
***************
*** 1359,1388 ****
  An abbrev before point is expanded if the variable `abbrev-mode' is non-nil.
  If run in the middle of a line, the line is not broken."
    (interactive "*")
!   (let (string cont (case-fold-search t))
!     (if abbrev-mode (expand-abbrev))
!     (beginning-of-line)                ; reindent where likely to be needed
!     (f90-indent-line-no)
!     (f90-indent-line 'no-update)
!     (end-of-line)
!     (delete-horizontal-space)         ; destroy trailing whitespace
!     (setq string (f90-in-string)
!           cont (f90-line-continued))
!     (if (and string (not cont)) (insert "&"))
      (f90-update-line)
      (newline)
!     (if (or string (and cont f90-beginning-ampersand)) (insert "&"))
!     (f90-indent-line 'no-update)))
  
  
  (defun f90-indent-region (beg-region end-region)
    "Indent every line in region by forward parsing."
    (interactive "*r")
!   (let ((end-region-mark (make-marker))
          (save-point (point-marker))
!       block-list ind-lev ind-curr ind-b cont
!       struct beg-struct end-struct)
!     (set-marker end-region-mark end-region)
      (goto-char beg-region)
      ;; First find a line which is not a continuation line or comment.
      (beginning-of-line)
--- 1359,1385 ----
  An abbrev before point is expanded if the variable `abbrev-mode' is non-nil.
  If run in the middle of a line, the line is not broken."
    (interactive "*")
!   (if abbrev-mode (expand-abbrev))
!   (beginning-of-line)             ; reindent where likely to be needed
!   (f90-indent-line-no)
!   (f90-indent-line 'no-update)
!   (end-of-line)
!   (delete-horizontal-space)           ; destroy trailing whitespace
!   (let ((string (f90-in-string))
!         (cont (f90-line-continued)))
!     (and string (not cont) (insert "&"))
      (f90-update-line)
      (newline)
!     (if (or string (and cont f90-beginning-ampersand)) (insert "&")))
!   (f90-indent-line 'no-update))
  
  
  (defun f90-indent-region (beg-region end-region)
    "Indent every line in region by forward parsing."
    (interactive "*r")
!   (let ((end-region-mark (copy-marker end-region))
          (save-point (point-marker))
!       block-list ind-lev ind-curr ind-b cont struct beg-struct end-struct)
      (goto-char beg-region)
      ;; First find a line which is not a continuation line or comment.
      (beginning-of-line)
***************
*** 1419,1426 ****
                (< (point) end-region-mark))
        (if (looking-at "[ \t]*!")
            (f90-indent-to (f90-comment-indent))
!         (if (not (zerop (- (current-indentation)
!                            (+ ind-curr f90-continuation-indent))))
              (f90-indent-to (+ ind-curr f90-continuation-indent) 
'no-line-no))))
      ;; Process all following lines.
      (while (and (zerop (forward-line 1)) (< (point) end-region-mark))
--- 1416,1423 ----
                (< (point) end-region-mark))
        (if (looking-at "[ \t]*!")
            (f90-indent-to (f90-comment-indent))
!         (or (= (current-indentation)
!                (+ ind-curr f90-continuation-indent))
              (f90-indent-to (+ ind-curr f90-continuation-indent) 
'no-line-no))))
      ;; Process all following lines.
      (while (and (zerop (forward-line 1)) (< (point) end-region-mark))
***************
*** 1465,1478 ****
             (setq ind-curr ind-lev))
            (t (setq ind-curr ind-lev)))
        ;; Do the indentation if necessary.
!       (if (not (zerop (- ind-curr (current-column))))
          (f90-indent-to ind-curr))
        (while (and (f90-line-continued) (zerop (forward-line 1))
                  (< (point) end-region-mark))
          (if (looking-at "[ \t]*!")
              (f90-indent-to (f90-comment-indent))
!           (if (not (zerop (- (current-indentation)
!                              (+ ind-curr f90-continuation-indent))))
                (f90-indent-to
                 (+ ind-curr f90-continuation-indent) 'no-line-no)))))
      ;; Restore point, etc.
--- 1462,1475 ----
             (setq ind-curr ind-lev))
            (t (setq ind-curr ind-lev)))
        ;; Do the indentation if necessary.
!       (or (= ind-curr (current-column))
          (f90-indent-to ind-curr))
        (while (and (f90-line-continued) (zerop (forward-line 1))
                  (< (point) end-region-mark))
          (if (looking-at "[ \t]*!")
              (f90-indent-to (f90-comment-indent))
!           (or (= (current-indentation)
!                  (+ ind-curr f90-continuation-indent))
                (f90-indent-to
                 (+ ind-curr f90-continuation-indent) 'no-line-no)))))
      ;; Restore point, etc.
***************
*** 1517,1531 ****
  
  (defun f90-find-breakpoint ()
    "From `fill-column', search backward for break-delimiter."
!   (let ((bol (line-beginning-position)))
!     (re-search-backward f90-break-delimiters bol)
!     (if (not f90-break-before-delimiters)
!         (if (looking-at f90-no-break-re)
!             (forward-char 2)
!           (forward-char))
!       (backward-char)
!       (if (not (looking-at f90-no-break-re))
!           (forward-char)))))
  
  (defun f90-do-auto-fill ()
    "Break line if non-white characters beyond `fill-column'.
--- 1514,1525 ----
  
  (defun f90-find-breakpoint ()
    "From `fill-column', search backward for break-delimiter."
!   (re-search-backward f90-break-delimiters (line-beginning-position))
!   (if (not f90-break-before-delimiters)
!       (forward-char (if (looking-at f90-no-break-re) 2 1))
!     (backward-char)
!     (or (looking-at f90-no-break-re)
!         (forward-char)))))
  
  (defun f90-do-auto-fill ()
    "Break line if non-white characters beyond `fill-column'.
***************
*** 1570,1579 ****
  (defun f90-fill-region (beg-region end-region)
    "Fill every line in region by forward parsing.  Join lines if possible."
    (interactive "*r")
!   (let ((end-region-mark (make-marker))
          (go-on t)
        f90-smart-end f90-auto-keyword-case auto-fill-function)
-     (set-marker end-region-mark end-region)
      (goto-char beg-region)
      (while go-on
        ;; Join as much as possible.
--- 1564,1572 ----
  (defun f90-fill-region (beg-region end-region)
    "Fill every line in region by forward parsing.  Join lines if possible."
    (interactive "*r")
!   (let ((end-region-mark (copy-marker end-region))
          (go-on t)
        f90-smart-end f90-auto-keyword-case auto-fill-function)
      (goto-char beg-region)
      (while go-on
        ;; Join as much as possible.
***************
*** 1588,1597 ****
        (move-to-column fill-column)
        (f90-find-breakpoint)
        (f90-break-line 'no-update))
!       (setq go-on (and (< (point) (marker-position end-region-mark))
                         (zerop (forward-line 1)))
              f90-cache-position (point)))
      (setq f90-cache-position nil)
      (if (fboundp 'zmacs-deactivate-region)
        (zmacs-deactivate-region)
        (deactivate-mark))))
--- 1581,1591 ----
        (move-to-column fill-column)
        (f90-find-breakpoint)
        (f90-break-line 'no-update))
!       (setq go-on (and (< (point) end-region-mark)
                         (zerop (forward-line 1)))
              f90-cache-position (point)))
      (setq f90-cache-position nil)
+     (set-marker end-region-mark nil)
      (if (fboundp 'zmacs-deactivate-region)
        (zmacs-deactivate-region)
        (deactivate-mark))))
***************
*** 1605,1639 ****
  Leave point at the end of line."
    (search-forward "end" (line-end-position))
    (catch 'no-match
!     (if (not (f90-equal-symbols beg-block end-block))
!       (if end-block
!           (progn
!             (message "END %s does not match %s." end-block beg-block)
!             (end-of-line)
!             (throw 'no-match nil))
!         (message "Inserting %s." beg-block)
!         (insert (concat " " beg-block)))
!       (search-forward end-block))
!     (if (not (f90-equal-symbols beg-name end-name))
!       (cond ((and beg-name (not end-name))
!              (message "Inserting %s." beg-name)
!              (insert (concat " " beg-name)))
!             ((and beg-name end-name)
!              (message "Replacing %s with %s." end-name beg-name)
!              (search-forward end-name)
!              (replace-match beg-name))
!             ((and (not beg-name) end-name)
!              (message "Deleting %s." end-name)
!              (search-forward end-name)
!              (replace-match "")))
!       (if end-name (search-forward end-name)))
!     (if (not (looking-at "[ \t]*!")) (delete-horizontal-space))))
  
  (defun f90-match-end ()
    "From an end block statement, find the corresponding block and name."
    (interactive)
!   (let ((count 1) (top-of-window (window-start))
!       (end-point (point)) (case-fold-search t)
        matching-beg beg-name end-name beg-block end-block end-struct)
      (when (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9")
                            (setq end-struct 
(f90-looking-at-program-block-end)))
--- 1599,1635 ----
  Leave point at the end of line."
    (search-forward "end" (line-end-position))
    (catch 'no-match
!     (if (f90-equal-symbols beg-block end-block)
!         (search-forward end-block)
!       (if end-block
!           (progn
!             (message "END %s does not match %s." end-block beg-block)
!             (end-of-line)
!             (throw 'no-match nil))
!         (message "Inserting %s." beg-block)
!         (insert (concat " " beg-block))))
!     (if (f90-equal-symbols beg-name end-name)
!         (and end-name (search-forward end-name))
!       (cond ((and beg-name (not end-name))
!              (message "Inserting %s." beg-name)
!              (insert (concat " " beg-name)))
!             ((and beg-name end-name)
!              (message "Replacing %s with %s." end-name beg-name)
!              (search-forward end-name)
!              (replace-match beg-name))
!             ((and (not beg-name) end-name)
!              (message "Deleting %s." end-name)
!              (search-forward end-name)
!              (replace-match ""))))
!     (or (looking-at "[ \t]*!") (delete-horizontal-space))))
  
  (defun f90-match-end ()
    "From an end block statement, find the corresponding block and name."
    (interactive)
!   (let ((count 1)
!         (top-of-window (window-start))
!       (end-point (point))
!         (case-fold-search t)
        matching-beg beg-name end-name beg-block end-block end-struct)
      (when (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9")
                            (setq end-struct 
(f90-looking-at-program-block-end)))
***************
*** 1643,1648 ****
--- 1639,1647 ----
          (beginning-of-line)
          (while (and (> count 0) (re-search-backward f90-blocks-re nil t))
            (beginning-of-line)
+           ;; GM not a line number if continued line.
+ ;;;          (skip-chars-forward " \t")
+ ;;;          (skip-chars-forward "0-9")
            (skip-chars-forward " \t0-9")
            (cond ((or (f90-in-string) (f90-in-comment)))
                  ((setq matching-beg
***************
*** 1764,1769 ****
--- 1763,1769 ----
            (unless (progn
                        (setq state (parse-partial-sexp ref-point (point)))
                        (or (nth 3 state) (nth 4 state)
+                           ;; GM f90-directive-comment-re?
                            (save-excursion ; check for cpp directive
                              (beginning-of-line)
                              (skip-chars-forward " \t0-9")