377 |
'("\\<\\(case\\)[ \t]*\\(default\\|(\\)" . 1) |
'("\\<\\(case\\)[ \t]*\\(default\\|(\\)" . 1) |
378 |
'("\\<\\(do\\|go *to\\)\\>[ \t]*\\([0-9]+\\)" |
'("\\<\\(do\\|go *to\\)\\>[ \t]*\\([0-9]+\\)" |
379 |
(1 font-lock-keyword-face) (2 font-lock-constant-face)) |
(1 font-lock-keyword-face) (2 font-lock-constant-face)) |
380 |
;; line numbers (lines whose first character after number is letter) |
;; Line numbers (lines whose first character after number is letter). |
381 |
'("^[ \t]*\\([0-9]+\\)[ \t]*[a-z]+" (1 font-lock-constant-face t)))) |
'("^[ \t]*\\([0-9]+\\)[ \t]*[a-z]+" (1 font-lock-constant-face t)))) |
382 |
"Highlights declarations, do-loops and other constructs.") |
"Highlights declarations, do-loops and other constructs.") |
383 |
|
|
918 |
|
|
919 |
(defsubst f90-equal-symbols (a b) |
(defsubst f90-equal-symbols (a b) |
920 |
"Compare strings A and B neglecting case and allowing for nil value." |
"Compare strings A and B neglecting case and allowing for nil value." |
921 |
(let ((a-local (if a (downcase a) nil)) |
(equal (if a (downcase a) nil) |
922 |
(b-local (if b (downcase b) nil))) |
(if b (downcase b) nil))) |
|
(equal a-local b-local))) |
|
923 |
|
|
924 |
;; XEmacs 19.11 & 19.12 return a single char when matching an empty regexp. |
;; XEmacs 19.11 & 19.12 return a single char when matching an empty regexp. |
925 |
;; The next 2 functions are therefore longer than necessary. |
;; The next 2 functions are therefore longer than necessary. |
926 |
(defsubst f90-looking-at-do () |
(defsubst f90-looking-at-do () |
927 |
"Return (\"do\" NAME) if a do statement starts after point. |
"Return (\"do\" NAME) if a do statement starts after point. |
928 |
NAME is nil if the statement has no label." |
NAME is nil if the statement has no label." |
929 |
(if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(do\\)\\>") |
(if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(do\\)\\>") |
930 |
(let (label |
(list (match-string 3) |
931 |
(struct (match-string 3))) |
(if (looking-at "\\(\\sw+\\)[ \t]*:") (match-string 1))))) |
|
(if (looking-at "\\(\\sw+\\)[ \t]*\:") |
|
|
(setq label (match-string 1))) |
|
|
(list struct label)))) |
|
932 |
|
|
933 |
(defsubst f90-looking-at-select-case () |
(defsubst f90-looking-at-select-case () |
934 |
"Return (\"select\" NAME) if a select-case statement starts after point. |
"Return (\"select\" NAME) if a select-case statement starts after point. |
935 |
NAME is nil if the statement has no label." |
NAME is nil if the statement has no label." |
936 |
(if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\ |
(if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\ |
937 |
\\(select\\)[ \t]*case[ \t]*(") |
\\(select\\)[ \t]*case[ \t]*(") |
938 |
(let (label |
(list (match-string 3) |
939 |
(struct (match-string 3))) |
(if (looking-at "\\(\\sw+\\)[ \t]*:") (match-string 1))))) |
|
(if (looking-at "\\(\\sw+\\)[ \t]*\:") |
|
|
(setq label (match-string 1))) |
|
|
(list struct label)))) |
|
940 |
|
|
941 |
(defsubst f90-looking-at-if-then () |
(defsubst f90-looking-at-if-then () |
942 |
"Return (\"if\" NAME) if an if () then statement starts after point. |
"Return (\"if\" NAME) if an if () then statement starts after point. |
943 |
NAME is nil if the statement has no label." |
NAME is nil if the statement has no label." |
944 |
(save-excursion |
(save-excursion |
945 |
(when (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(if\\)\\>") |
(when (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(if\\)\\>") |
946 |
(let (label |
(let ((struct (match-string 3)) |
947 |
(struct (match-string 3))) |
(label (if (looking-at "\\(\\sw+\\)[ \t]*:") (match-string 1))) |
948 |
(if (looking-at "\\(\\sw+\\)[ \t]*\:") |
(pos (scan-lists (point) 1 0))) |
949 |
(setq label (match-string 1))) |
(and pos (goto-char pos)) |
|
(let ((pos (scan-lists (point) 1 0))) |
|
|
(and pos (goto-char pos))) |
|
950 |
(skip-chars-forward " \t") |
(skip-chars-forward " \t") |
951 |
(if (or (looking-at "then\\>") |
(if (or (looking-at "then\\>") |
952 |
(when (f90-line-continued) |
(when (f90-line-continued) |
955 |
(looking-at "then\\>"))) |
(looking-at "then\\>"))) |
956 |
(list struct label)))))) |
(list struct label)))))) |
957 |
|
|
958 |
(defsubst f90-looking-at-where-or-forall () |
(defun f90-looking-at-where-or-forall () |
959 |
"Return (KIND NAME) if a where or forall block starts after point. |
"Return (KIND NAME) if a where or forall block starts after point. |
960 |
NAME is nil if the statement has no label." |
NAME is nil if the statement has no label." |
961 |
(if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\ |
(save-excursion |
962 |
\\(where\\|forall\\)[ \t]*(.*)[ \t]*\\(!\\|$\\)") |
(when (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\ |
963 |
(let (label |
\\(where\\|forall\\)\\>") |
964 |
(struct (match-string 3))) |
(let ((struct (match-string 3)) |
965 |
(if (looking-at "\\(\\sw+\\)[ \t]*\:") |
(label (if (looking-at "\\(\\sw+\\)[ \t]*:") (match-string 1))) |
966 |
(setq label (match-string 1))) |
(pos (scan-lists (point) 1 0))) |
967 |
(list struct label)))) |
(and pos (goto-char pos)) |
968 |
|
(skip-chars-forward " \t") |
969 |
|
(if (looking-at "\\(!\\|$\\)") (list struct label)))))) |
970 |
|
|
971 |
(defsubst f90-looking-at-type-like () |
(defsubst f90-looking-at-type-like () |
972 |
"Return (KIND NAME) if a type/interface/block-data block starts after point. |
"Return (KIND NAME) if a type/interface/block-data block starts after point. |