Close bug#3992.

[gnu-emacs] / lisp / progmodes / fortran.el

diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el
index 71913d0eca0406b3f4e3085597315816c0b0296c..3784ba787c4fbae998fe6f8db5e51170256f7466 100644 (file)
--- a/lisp/progmodes/fortran.el
+++ b/lisp/progmodes/fortran.el
@@ -1,7 +1,7 @@
 ;;; fortran.el --- Fortran mode for GNU Emacs
 
 ;; Copyright (C) 1986, 1993, 1994, 1995, 1997, 1998, 1999, 2000, 2001,
-;;   2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+;;   2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
 ;;   Free Software Foundation, Inc.
 
 ;; Author: Michael D. Prange <prange@erl.mit.edu>
@@ -403,6 +403,28 @@ program\\|subroutine\\)\\>[ \t]*\\(\\sw+\\)?"
            '("^ *\\([0-9]+\\)" . font-lock-constant-face)))
   "Medium level highlighting for Fortran mode.")
 
+;; See bug#1385. Never really looked into _why_ this matters...
+(defun fortran-match-and-skip-declaration (limit)
+  "Like `font-lock-match-c-style-declaration-item-and-skip-to-next'.
+The only difference is, it returns t in a case when the default returns nil."
+  (when (looking-at "[ \n\t*]*\\(\\sw+\\)[ \t\n]*\\(((?\\)?")
+    (when (and (match-end 2) (> (- (match-end 2) (match-beginning 2)) 1))
+      (let ((pos (point)))
+       (skip-chars-backward " \t\n")
+       (skip-syntax-backward "w")
+       (unless (looking-at "\\(\\sw+\\)[ \t\n]*\\sw+[ \t\n]*\\(((?\\)?")
+         (goto-char pos)
+         (looking-at "[ \n\t*]*\\(\\sw+\\)[ \t\n]*\\(((?\\)?"))))
+    (save-match-data
+      (condition-case nil
+         (save-restriction
+           (narrow-to-region (point-min) limit)
+           (goto-char (match-end 1))
+           (while (not (looking-at "[ \t\n]*\\(\\(,\\)\\|;\\|\\'\\)"))
+             (goto-char (or (scan-sexps (point) 1) (point-max))))
+            (goto-char (match-end 2)))
+       (error t)))))
+
 (defvar fortran-font-lock-keywords-3
   (append
    fortran-font-lock-keywords-1
@@ -412,7 +434,7 @@ program\\|subroutine\\)\\>[ \t]*\\(\\sw+\\)?"
           ;; Type specifier.
           '(1 font-lock-type-face)
           ;; Declaration item (or just /.../ block name).
-          `(font-lock-match-c-style-declaration-item-and-skip-to-next
+          `(fortran-match-and-skip-declaration
             ;; Start after any *(...) expression.
             (condition-case nil
                 (and (match-beginning ,(1+ (regexp-opt-depth
@@ -1295,7 +1317,7 @@ If NUM is negative, go backward to the start of a block.  Does
 not check for consistency of block types.  Interactively, pushes
 mark before moving point."
   (interactive "p")
-  (if (interactive-p) (push-mark (point) t))
+  (if (called-interactively-p 'any) (push-mark (point) t))
   (and num (< num 0) (fortran-beginning-of-block (- num)))
   (let ((case-fold-search t)
         (count (or num 1)))
@@ -1328,7 +1350,7 @@ blocks.  If NUM is negative, go forward to the end of a block.
 Does not check for consistency of block types.  Interactively,
 pushes mark before moving point."
   (interactive "p")
-  (if (interactive-p) (push-mark (point) t))
+  (if (called-interactively-p 'any) (push-mark (point) t))
   (and num (< num 0) (fortran-end-of-block (- num)))
   (let ((case-fold-search t)
         (count (or num 1)))