/[emacs]/emacs/lisp/progmodes/f90.el
ViewVC logotype

Diff of /emacs/lisp/progmodes/f90.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.51 by gm, Sun May 19 22:25:25 2002 UTC revision 1.52 by gm, Sun May 19 23:18:16 2002 UTC
# Line 377  do\\([ \t]*while\\)?\\|select[ \t]*case\ Line 377  do\\([ \t]*while\\)?\\|select[ \t]*case\
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    
# Line 918  For example, \"!\" or \"!!\"." Line 918  For example, \"!\" or \"!!\"."
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)
# Line 964  NAME is nil if the statement has no labe Line 955  NAME is nil if the statement has no labe
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.

Legend:
Removed from v.1.51  
changed lines
  Added in v.1.52

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26