Mercurial > emacs

comparison lisp/progmodes/f90.el @ 44824:637c10f08055

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(f90-get-beg-of-line): Removed and replaced with line-beginning-position. (f90-get-end-of-line): Removed and replaced with line-end-position. (f90-current-indentation): current-column was superfluous, removed. (f90-match-piece): Removed and replaced with match-string. (f90-get-present-comment-type): Use match-string rather than buffer-substring. (f90-match-end): Use line-beginning-position, line-end-position rather than beginning-of-line, end-of-line.
author Glenn Morris <rgm@gnu.org>
date Wed, 24 Apr 2002 22:06:03 +0000
parents 21cae71e2d9c
children 82abaa8dbf18
comparison
equal deleted inserted replaced
44823:230b150398fa 44824:637c10f08055
850 #'f90-current-defun) 850 #'f90-current-defun)
851 (run-hooks 'f90-mode-hook) 851 (run-hooks 'f90-mode-hook)
852 (setq f90-startup-message nil)) 852 (setq f90-startup-message nil))
853 853
854 ;; inline-functions 854 ;; inline-functions
855 (defsubst f90-get-beg-of-line ()
856 (save-excursion (beginning-of-line) (point)))
857
858 (defsubst f90-get-end-of-line ()
859 (save-excursion (end-of-line) (point)))
860
861 (defsubst f90-in-string () 855 (defsubst f90-in-string ()
862 (let ((beg-pnt 856 (let ((beg-pnt
863 (if (and f90-cache-position (> (point) f90-cache-position)) 857 (if (and f90-cache-position (> (point) f90-cache-position))
864 f90-cache-position 858 f90-cache-position
865 (point-min)))) 859 (point-min))))
872 (point-min)))) 866 (point-min))))
873 (nth 4 (parse-partial-sexp beg-pnt (point))))) 867 (nth 4 (parse-partial-sexp beg-pnt (point)))))
874 868
875 (defsubst f90-line-continued () 869 (defsubst f90-line-continued ()
876 (save-excursion 870 (save-excursion
877 (beginning-of-line) 871 (beginning-of-line)
878 (while (and (looking-at "[ \t]*\\(!\\|$\\)") (zerop (forward-line -1)))) 872 (while (and (looking-at "[ \t]*\\(!\\|$\\)") (zerop (forward-line -1))))
879 (let ((bol (f90-get-beg-of-line))) 873 (let ((bol (line-beginning-position)))
880 (end-of-line) 874 (end-of-line)
881 (while (f90-in-comment) 875 (while (f90-in-comment)
882 (search-backward "!" bol) 876 (search-backward "!" bol)
883 (skip-chars-backward "!")) 877 (skip-chars-backward "!"))
884 (skip-chars-backward " \t") 878 (skip-chars-backward " \t")
886 880
887 (defsubst f90-current-indentation () 881 (defsubst f90-current-indentation ()
888 "Return indentation of current line. 882 "Return indentation of current line.
889 Line-numbers are considered whitespace characters." 883 Line-numbers are considered whitespace characters."
890 (save-excursion 884 (save-excursion
891 (beginning-of-line) (skip-chars-forward " \t0-9") 885 (beginning-of-line) (skip-chars-forward " \t0-9")))
892 (current-column)))
893 886
894 (defsubst f90-indent-to (col &optional no-line-number) 887 (defsubst f90-indent-to (col &optional no-line-number)
895 "Indent current line to column COL. 888 "Indent current line to column COL.
896 If no-line-number nil, jump over a possible line-number." 889 If no-line-number nil, jump over a possible line-number."
897 (beginning-of-line) 890 (beginning-of-line)
900 (delete-horizontal-space) 893 (delete-horizontal-space)
901 (if (zerop (current-column)) 894 (if (zerop (current-column))
902 (indent-to col) 895 (indent-to col)
903 (indent-to col 1))) 896 (indent-to col 1)))
904 897
905 (defsubst f90-match-piece (arg)
906 (if (match-beginning arg)
907 (buffer-substring (match-beginning arg) (match-end arg))))
908
909 (defsubst f90-get-present-comment-type () 898 (defsubst f90-get-present-comment-type ()
910 (save-excursion 899 (save-excursion
911 (let ((type nil) (eol (f90-get-end-of-line))) 900 (let ((type nil) (eol (line-end-position)))
912 (if (f90-in-comment) 901 (if (f90-in-comment)
913 (progn 902 (progn
914 (beginning-of-line) 903 (beginning-of-line)
915 (re-search-forward "[!]+" eol) 904 (re-search-forward "[!]+" eol)
916 (while (f90-in-string) 905 (while (f90-in-string)
917 (re-search-forward "[!]+" eol)) 906 (re-search-forward "[!]+" eol))
918 (setq type (buffer-substring (match-beginning 0) (match-end 0))))) 907 (setq type (match-string 0))))
919 type))) 908 type)))
920 909
921 (defsubst f90-equal-symbols (a b) 910 (defsubst f90-equal-symbols (a b)
922 "Compare strings neglecting case and allowing for nil value." 911 "Compare strings neglecting case and allowing for nil value."
923 (let ((a-local (if a (downcase a) nil)) 912 (let ((a-local (if a (downcase a) nil))
930 (defsubst f90-looking-at-do () 919 (defsubst f90-looking-at-do ()
931 "Return (\"do\" name) if a do statement starts after point. 920 "Return (\"do\" name) if a do statement starts after point.
932 Name is nil if the statement has no label." 921 Name is nil if the statement has no label."
933 (if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(do\\)\\>") 922 (if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(do\\)\\>")
934 (let (label 923 (let (label
935 (struct (f90-match-piece 3))) 924 (struct (match-string 3)))
936 (if (looking-at "\\(\\sw+\\)[ \t]*\:") 925 (if (looking-at "\\(\\sw+\\)[ \t]*\:")
937 (setq label (f90-match-piece 1))) 926 (setq label (match-string 1)))
938 (list struct label)))) 927 (list struct label))))
939 928
940 (defsubst f90-looking-at-select-case () 929 (defsubst f90-looking-at-select-case ()
941 "Return (\"select\" name) if a select-case statement starts after point. 930 "Return (\"select\" name) if a select-case statement starts after point.
942 Name is nil if the statement has no label." 931 Name is nil if the statement has no label."
943 (if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(select\\)[ \t]*case[ \t]*(") 932 (if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(select\\)[ \t]*case[ \t]*(")
944 (let (label 933 (let (label
945 (struct (f90-match-piece 3))) 934 (struct (match-string 3)))
946 (if (looking-at "\\(\\sw+\\)[ \t]*\:") 935 (if (looking-at "\\(\\sw+\\)[ \t]*\:")
947 (setq label (f90-match-piece 1))) 936 (setq label (match-string 1)))
948 (list struct label)))) 937 (list struct label))))
949 938
950 (defsubst f90-looking-at-if-then () 939 (defsubst f90-looking-at-if-then ()
951 "Return (\"if\" name) if an if () then statement starts after point. 940 "Return (\"if\" name) if an if () then statement starts after point.
952 Name is nil if the statement has no label." 941 Name is nil if the statement has no label."
953 (save-excursion 942 (save-excursion
954 (let (struct (label nil)) 943 (let (struct (label nil))
955 (if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(if\\)\\>") 944 (if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(if\\)\\>")
956 (progn 945 (progn
957 (setq struct (f90-match-piece 3)) 946 (setq struct (match-string 3))
958 (if (looking-at "\\(\\sw+\\)[ \t]*\:") 947 (if (looking-at "\\(\\sw+\\)[ \t]*\:")
959 (setq label (f90-match-piece 1))) 948 (setq label (match-string 1)))
960 (let ((pos (scan-lists (point) 1 0))) 949 (let ((pos (scan-lists (point) 1 0)))
961 (and pos (goto-char pos))) 950 (and pos (goto-char pos)))
962 (skip-chars-forward " \t") 951 (skip-chars-forward " \t")
963 (if (or (looking-at "then\\>") 952 (if (or (looking-at "then\\>")
964 (if (f90-line-continued) 953 (if (f90-line-continued)
971 (defsubst f90-looking-at-where-or-forall () 960 (defsubst f90-looking-at-where-or-forall ()
972 "Return (kind name) if a where or forall block starts after point. 961 "Return (kind name) if a where or forall block starts after point.
973 Name is nil if the statement has no label." 962 Name is nil if the statement has no label."
974 (if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(where\\|forall\\)[ \t]*(.*)[ \t]*\\(!\\|$\\)") 963 (if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(where\\|forall\\)[ \t]*(.*)[ \t]*\\(!\\|$\\)")
975 (let (label 964 (let (label
976 (struct (f90-match-piece 3))) 965 (struct (match-string 3)))
977 (if (looking-at "\\(\\sw+\\)[ \t]*\:") 966 (if (looking-at "\\(\\sw+\\)[ \t]*\:")
978 (setq label (f90-match-piece 1))) 967 (setq label (match-string 1)))
979 (list struct label)))) 968 (list struct label))))
980 969
981 (defsubst f90-looking-at-type-like () 970 (defsubst f90-looking-at-type-like ()
982 "Return (kind name) at the start of a type/interface/block-data block. 971 "Return (kind name) at the start of a type/interface/block-data block.
983 Name is non-nil only for type." 972 Name is non-nil only for type."
984 (cond 973 (cond
985 ((looking-at f90-type-def-re) 974 ((looking-at f90-type-def-re)
986 (list (f90-match-piece 1) (f90-match-piece 4))) 975 (list (match-string 1) (match-string 4)))
987 ((looking-at "\\(interface\\|block[\t]*data\\)\\>") 976 ((looking-at "\\(interface\\|block[\t]*data\\)\\>")
988 (list (f90-match-piece 1) nil)))) 977 (list (match-string 1) nil))))
989 978
990 (defsubst f90-looking-at-program-block-start () 979 (defsubst f90-looking-at-program-block-start ()
991 "Return (kind name) if a program block with name name starts after point." 980 "Return (kind name) if a program block with name name starts after point."
992 (cond 981 (cond
993 ((looking-at "\\(program\\)[ \t]+\\(\\sw+\\)\\>") 982 ((looking-at "\\(program\\)[ \t]+\\(\\sw+\\)\\>")
994 (list (f90-match-piece 1) (f90-match-piece 2))) 983 (list (match-string 1) (match-string 2)))
995 ((and (not (looking-at "module[ \t]*procedure\\>")) 984 ((and (not (looking-at "module[ \t]*procedure\\>"))
996 (looking-at "\\(module\\)[ \t]+\\(\\sw+\\)\\>")) 985 (looking-at "\\(module\\)[ \t]+\\(\\sw+\\)\\>"))
997 (list (f90-match-piece 1) (f90-match-piece 2))) 986 (list (match-string 1) (match-string 2)))
998 ((and (not (looking-at "end[ \t]*\\(function\\|subroutine\\)")) 987 ((and (not (looking-at "end[ \t]*\\(function\\|subroutine\\)"))
999 (looking-at "[^!'\"\&\n]*\\(function\\|subroutine\\)[ \t]+\\(\\sw+\\)")) 988 (looking-at "[^!'\"\&\n]*\\(function\\|subroutine\\)[ \t]+\\(\\sw+\\)"))
1000 (list (f90-match-piece 1) (f90-match-piece 2))))) 989 (list (match-string 1) (match-string 2)))))
1001 990
1002 (defsubst f90-looking-at-program-block-end () 991 (defsubst f90-looking-at-program-block-end ()
1003 "Return list of type and name of end of block." 992 "Return list of type and name of end of block."
1004 (if (looking-at (concat "end[ \t]*" f90-blocks-re 993 (if (looking-at (concat "end[ \t]*" f90-blocks-re
1005 "?\\([ \t]+\\(\\sw+\\)\\)?\\>")) 994 "?\\([ \t]+\\(\\sw+\\)\\)?\\>"))
1006 (list (f90-match-piece 1) (f90-match-piece 3)))) 995 (list (match-string 1) (match-string 3))))
1007 996
1008 (defsubst f90-comment-indent () 997 (defsubst f90-comment-indent ()
1009 (cond ((looking-at "!!!") 0) 998 (cond ((looking-at "!!!") 0)
1010 ((and f90-directive-comment-re 999 ((and f90-directive-comment-re
1011 (looking-at f90-directive-comment-re)) 0) 1000 (looking-at f90-directive-comment-re)) 0)
1038 (looking-at "[0-9]")) 1027 (looking-at "[0-9]"))
1039 (delete-horizontal-space))) 1028 (delete-horizontal-space)))
1040 (skip-chars-forward " \t0-9")) 1029 (skip-chars-forward " \t0-9"))
1041 1030
1042 (defsubst f90-no-block-limit () 1031 (defsubst f90-no-block-limit ()
1043 (let ((eol (f90-get-end-of-line))) 1032 (let ((eol (line-end-position)))
1044 (save-excursion 1033 (save-excursion
1045 (not (or (looking-at "end") 1034 (not (or (looking-at "end")
1046 (looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\ 1035 (looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\
1047 \\|select[ \t]*case\\|case\\|where\\|forall\\)\\>") 1036 \\|select[ \t]*case\\|case\\|where\\|forall\\)\\>")
1048 (looking-at "\\(program\\|module\\|interface\\|\ 1037 (looking-at "\\(program\\|module\\|interface\\|\
1052 (re-search-forward "\\(function\\|subroutine\\)" eol t)))))) 1041 (re-search-forward "\\(function\\|subroutine\\)" eol t))))))
1053 1042
1054 (defsubst f90-update-line () 1043 (defsubst f90-update-line ()
1055 (let (bol eol) 1044 (let (bol eol)
1056 (if f90-auto-keyword-case 1045 (if f90-auto-keyword-case
1057 (progn (setq bol (f90-get-beg-of-line) 1046 (progn (setq bol (line-beginning-position)
1058 eol (f90-get-end-of-line)) 1047 eol (line-end-position))
1059 (if f90-auto-keyword-case 1048 (if f90-auto-keyword-case
1060 (f90-change-keywords f90-auto-keyword-case bol eol)))))) 1049 (f90-change-keywords f90-auto-keyword-case bol eol))))))
1061 1050
1062 (defun f90-electric-insert () 1051 (defun f90-electric-insert ()
1063 (interactive) 1052 (interactive)
1067 (if auto-fill-function (f90-do-auto-fill))) 1056 (if auto-fill-function (f90-do-auto-fill)))
1068 1057
1069 (defun f90-get-correct-indent () 1058 (defun f90-get-correct-indent ()
1070 "Get correct indent for a line starting with line number. 1059 "Get correct indent for a line starting with line number.
1071 Does not check type and subprogram indentation." 1060 Does not check type and subprogram indentation."
1072 (let ((epnt (f90-get-end-of-line)) icol cont) 1061 (let ((epnt (line-end-position)) icol cont)
1073 (save-excursion 1062 (save-excursion
1074 (while (and (f90-previous-statement) 1063 (while (and (f90-previous-statement)
1075 (or (progn 1064 (or (progn
1076 (setq cont (f90-present-statement-cont)) 1065 (setq cont (f90-present-statement-cont))
1077 (or (eq cont 'end) (eq cont 'middle))) 1066 (or (eq cont 'end) (eq cont 'middle)))
1078 (looking-at "[ \t]*[0-9]")))) 1067 (looking-at "[ \t]*[0-9]"))))
1079 (setq icol (current-indentation)) 1068 (setq icol (current-indentation))
1080 (beginning-of-line) 1069 (beginning-of-line)
1081 (if (re-search-forward "\\(if\\|do\\|select\\|where\\|forall\\)" 1070 (if (re-search-forward "\\(if\\|do\\|select\\|where\\|forall\\)"
1082 (f90-get-end-of-line) t) 1071 (line-end-position) t)
1083 (progn 1072 (progn
1084 (beginning-of-line) (skip-chars-forward " \t") 1073 (beginning-of-line) (skip-chars-forward " \t")
1085 (cond ((f90-looking-at-do) 1074 (cond ((f90-looking-at-do)
1086 (setq icol (+ icol f90-do-indent))) 1075 (setq icol (+ icol f90-do-indent)))
1087 ((or (f90-looking-at-if-then) 1076 ((or (f90-looking-at-if-then)
1443 (if f90-beginning-ampersand (insert "&"))))) 1432 (if f90-beginning-ampersand (insert "&")))))
1444 (indent-according-to-mode)) 1433 (indent-according-to-mode))
1445 1434
1446 (defun f90-find-breakpoint () 1435 (defun f90-find-breakpoint ()
1447 "From fill-column, search backward for break-delimiter." 1436 "From fill-column, search backward for break-delimiter."
1448 (let ((bol (f90-get-beg-of-line))) 1437 (let ((bol (line-beginning-position)))
1449 (re-search-backward f90-break-delimiters bol) 1438 (re-search-backward f90-break-delimiters bol)
1450 (if f90-break-before-delimiters 1439 (if f90-break-before-delimiters
1451 (progn (backward-char) 1440 (progn (backward-char)
1452 (if (not (looking-at f90-no-break-re)) 1441 (if (not (looking-at f90-no-break-re))
1453 (forward-char))) 1442 (forward-char)))
1521 (deactivate-mark)))) 1510 (deactivate-mark))))
1522 1511
1523 (defun f90-block-match (beg-block beg-name end-block end-name) 1512 (defun f90-block-match (beg-block beg-name end-block end-name)
1524 "Match end-struct with beg-struct and complete end-block if possible. 1513 "Match end-struct with beg-struct and complete end-block if possible.
1525 Leave point at the end of line." 1514 Leave point at the end of line."
1526 (search-forward "end" (f90-get-end-of-line)) 1515 (search-forward "end" (line-end-position))
1527 (catch 'no-match 1516 (catch 'no-match
1528 (if (not (f90-equal-symbols beg-block end-block)) 1517 (if (not (f90-equal-symbols beg-block end-block))
1529 (if end-block 1518 (if end-block
1530 (progn 1519 (progn
1531 (message "END %s does not match %s." end-block beg-block) 1520 (message "END %s does not match %s." end-block beg-block)
1593 (if (eq f90-smart-end 'blink) 1582 (if (eq f90-smart-end 'blink)
1594 (if (< (point) top-of-window) 1583 (if (< (point) top-of-window)
1595 (message "Matches %s: %s" 1584 (message "Matches %s: %s"
1596 (what-line) 1585 (what-line)
1597 (buffer-substring 1586 (buffer-substring
1598 (progn (beginning-of-line) (point)) 1587 (line-beginning-position)
1599 (progn (end-of-line) (point)))) 1588 (line-end-position)))
1600 (sit-for 1))) 1589 (sit-for 1)))
1601 (setq beg-block (car matching-beg)) 1590 (setq beg-block (car matching-beg))
1602 (setq beg-name (car (cdr matching-beg))) 1591 (setq beg-name (car (cdr matching-beg)))
1603 (goto-char end-point) 1592 (goto-char end-point)
1604 (beginning-of-line) 1593 (beginning-of-line)