687 |
(unless f90-mode-abbrev-table |
(unless f90-mode-abbrev-table |
688 |
(let ((ac abbrevs-changed)) |
(let ((ac abbrevs-changed)) |
689 |
(define-abbrev-table 'f90-mode-abbrev-table ()) |
(define-abbrev-table 'f90-mode-abbrev-table ()) |
690 |
(define-abbrev f90-mode-abbrev-table "`al" "allocate" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`al" "allocate" nil 0 t) |
691 |
(define-abbrev f90-mode-abbrev-table "`ab" "allocatable" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`ab" "allocatable" nil 0 t) |
692 |
(define-abbrev f90-mode-abbrev-table "`as" "assignment" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`as" "assignment" nil 0 t) |
693 |
(define-abbrev f90-mode-abbrev-table "`ba" "backspace" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`ba" "backspace" nil 0 t) |
694 |
(define-abbrev f90-mode-abbrev-table "`bd" "block data" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`bd" "block data" nil 0 t) |
695 |
(define-abbrev f90-mode-abbrev-table "`c" "character" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`c" "character" nil 0 t) |
696 |
(define-abbrev f90-mode-abbrev-table "`cl" "close" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`cl" "close" nil 0 t) |
697 |
(define-abbrev f90-mode-abbrev-table "`cm" "common" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`cm" "common" nil 0 t) |
698 |
(define-abbrev f90-mode-abbrev-table "`cx" "complex" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`cx" "complex" nil 0 t) |
699 |
(define-abbrev f90-mode-abbrev-table "`cn" "contains" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`cn" "contains" nil 0 t) |
700 |
(define-abbrev f90-mode-abbrev-table "`cy" "cycle" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`cy" "cycle" nil 0 t) |
701 |
(define-abbrev f90-mode-abbrev-table "`de" "deallocate" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`de" "deallocate" nil 0 t) |
702 |
(define-abbrev f90-mode-abbrev-table "`df" "define" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`df" "define" nil 0 t) |
703 |
(define-abbrev f90-mode-abbrev-table "`di" "dimension" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`di" "dimension" nil 0 t) |
704 |
(define-abbrev f90-mode-abbrev-table "`dw" "do while" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`dw" "do while" nil 0 t) |
705 |
(define-abbrev f90-mode-abbrev-table "`el" "else" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`el" "else" nil 0 t) |
706 |
(define-abbrev f90-mode-abbrev-table "`eli" "else if" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`eli" "else if" nil 0 t) |
707 |
(define-abbrev f90-mode-abbrev-table "`elw" "elsewhere" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`elw" "elsewhere" nil 0 t) |
708 |
(define-abbrev f90-mode-abbrev-table "`eq" "equivalence" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`eq" "equivalence" nil 0 t) |
709 |
(define-abbrev f90-mode-abbrev-table "`ex" "external" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`ex" "external" nil 0 t) |
710 |
(define-abbrev f90-mode-abbrev-table "`ey" "entry" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`ey" "entry" nil 0 t) |
711 |
(define-abbrev f90-mode-abbrev-table "`fl" "forall" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`fl" "forall" nil 0 t) |
712 |
(define-abbrev f90-mode-abbrev-table "`fo" "format" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`fo" "format" nil 0 t) |
713 |
(define-abbrev f90-mode-abbrev-table "`fu" "function" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`fu" "function" nil 0 t) |
714 |
(define-abbrev f90-mode-abbrev-table "`fa" ".false." nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`fa" ".false." nil 0 t) |
715 |
(define-abbrev f90-mode-abbrev-table "`im" "implicit none" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`im" "implicit none" nil 0 t) |
716 |
(define-abbrev f90-mode-abbrev-table "`in " "include" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`in " "include" nil 0 t) |
717 |
(define-abbrev f90-mode-abbrev-table "`i" "integer" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`i" "integer" nil 0 t) |
718 |
(define-abbrev f90-mode-abbrev-table "`it" "intent" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`it" "intent" nil 0 t) |
719 |
(define-abbrev f90-mode-abbrev-table "`if" "interface" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`if" "interface" nil 0 t) |
720 |
(define-abbrev f90-mode-abbrev-table "`lo" "logical" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`lo" "logical" nil 0 t) |
721 |
(define-abbrev f90-mode-abbrev-table "`mo" "module" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`mo" "module" nil 0 t) |
722 |
(define-abbrev f90-mode-abbrev-table "`na" "namelist" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`na" "namelist" nil 0 t) |
723 |
(define-abbrev f90-mode-abbrev-table "`nu" "nullify" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`nu" "nullify" nil 0 t) |
724 |
(define-abbrev f90-mode-abbrev-table "`op" "optional" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`op" "optional" nil 0 t) |
725 |
(define-abbrev f90-mode-abbrev-table "`pa" "parameter" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`pa" "parameter" nil 0 t) |
726 |
(define-abbrev f90-mode-abbrev-table "`po" "pointer" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`po" "pointer" nil 0 t) |
727 |
(define-abbrev f90-mode-abbrev-table "`pr" "print" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`pr" "print" nil 0 t) |
728 |
(define-abbrev f90-mode-abbrev-table "`pi" "private" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`pi" "private" nil 0 t) |
729 |
(define-abbrev f90-mode-abbrev-table "`pm" "program" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`pm" "program" nil 0 t) |
730 |
(define-abbrev f90-mode-abbrev-table "`pu" "public" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`pu" "public" nil 0 t) |
731 |
(define-abbrev f90-mode-abbrev-table "`r" "real" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`r" "real" nil 0 t) |
732 |
(define-abbrev f90-mode-abbrev-table "`rc" "recursive" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`rc" "recursive" nil 0 t) |
733 |
(define-abbrev f90-mode-abbrev-table "`rt" "return" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`rt" "return" nil 0 t) |
734 |
(define-abbrev f90-mode-abbrev-table "`rw" "rewind" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`rw" "rewind" nil 0 t) |
735 |
(define-abbrev f90-mode-abbrev-table "`se" "select" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`se" "select" nil 0 t) |
736 |
(define-abbrev f90-mode-abbrev-table "`sq" "sequence" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`sq" "sequence" nil 0 t) |
737 |
(define-abbrev f90-mode-abbrev-table "`su" "subroutine" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`su" "subroutine" nil 0 t) |
738 |
(define-abbrev f90-mode-abbrev-table "`ta" "target" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`ta" "target" nil 0 t) |
739 |
(define-abbrev f90-mode-abbrev-table "`tr" ".true." nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`tr" ".true." nil 0 t) |
740 |
(define-abbrev f90-mode-abbrev-table "`t" "type" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`t" "type" nil 0 t) |
741 |
(define-abbrev f90-mode-abbrev-table "`wh" "where" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`wh" "where" nil 0 t) |
742 |
(define-abbrev f90-mode-abbrev-table "`wr" "write" nil 0 t) |
(define-abbrev f90-mode-abbrev-table "`wr" "write" nil 0 t) |
743 |
(setq abbrevs-changed ac))) |
(setq abbrevs-changed ac))) |
744 |
|
|
745 |
(defcustom f90-mode-hook nil |
(defcustom f90-mode-hook nil |
777 |
`f90-continuation-indent' |
`f90-continuation-indent' |
778 |
Extra indentation applied to continuation lines (default 5). |
Extra indentation applied to continuation lines (default 5). |
779 |
`f90-comment-region' |
`f90-comment-region' |
780 |
String inserted by \\[f90-comment-region] at start of each line in |
String inserted by function \\[f90-comment-region] at start of each |
781 |
region (default \"!!!$\"). |
line in region (default \"!!!$\"). |
782 |
`f90-indented-comment-re' |
`f90-indented-comment-re' |
783 |
Regexp determining the type of comment to be intended like code |
Regexp determining the type of comment to be intended like code |
784 |
(default \"!\"). |
(default \"!\"). |
809 |
with no args, if that value is non-nil." |
with no args, if that value is non-nil." |
810 |
(interactive) |
(interactive) |
811 |
(kill-all-local-variables) |
(kill-all-local-variables) |
812 |
(setq major-mode 'f90-mode) |
(setq major-mode 'f90-mode |
813 |
(setq mode-name "F90") |
mode-name "F90" |
814 |
(setq local-abbrev-table f90-mode-abbrev-table) |
local-abbrev-table f90-mode-abbrev-table) |
815 |
(set-syntax-table f90-mode-syntax-table) |
(set-syntax-table f90-mode-syntax-table) |
816 |
(use-local-map f90-mode-map) |
(use-local-map f90-mode-map) |
817 |
(make-local-variable 'indent-line-function) |
(set (make-local-variable 'indent-line-function) 'f90-indent-line) |
818 |
(setq indent-line-function 'f90-indent-line) |
(set (make-local-variable 'indent-region-function) 'f90-indent-region) |
819 |
(make-local-variable 'indent-region-function) |
(set (make-local-variable 'require-final-newline) t) |
820 |
(setq indent-region-function 'f90-indent-region) |
(set (make-local-variable 'comment-start) "!") |
821 |
(make-local-variable 'require-final-newline) |
(set (make-local-variable 'comment-start-skip) "!+ *") |
822 |
(setq require-final-newline t) |
(set (make-local-variable 'comment-indent-function) 'f90-comment-indent) |
823 |
(make-local-variable 'comment-start) |
(set (make-local-variable 'abbrev-all-caps) t) |
824 |
(setq comment-start "!") |
(set (make-local-variable 'normal-auto-fill-function) 'f90-do-auto-fill) |
|
(make-local-variable 'comment-start-skip) |
|
|
(setq comment-start-skip "!+ *") |
|
|
(make-local-variable 'comment-indent-function) |
|
|
(setq comment-indent-function 'f90-comment-indent) |
|
|
(make-local-variable 'abbrev-all-caps) |
|
|
(setq abbrev-all-caps t) |
|
|
(make-local-variable 'normal-auto-fill-function) |
|
|
(setq normal-auto-fill-function 'f90-do-auto-fill) |
|
825 |
(setq indent-tabs-mode nil) |
(setq indent-tabs-mode nil) |
826 |
;; Setting up things for font-lock. |
;; Setting up things for font-lock. |
827 |
(when f90-xemacs-flag |
(when f90-xemacs-flag |
832 |
(set-buffer-menubar (copy-sequence current-menubar)) |
(set-buffer-menubar (copy-sequence current-menubar)) |
833 |
(add-submenu nil f90-xemacs-menu))) |
(add-submenu nil f90-xemacs-menu))) |
834 |
;; XEmacs: Does not need a special case, since both emacsen work alike -sb. |
;; XEmacs: Does not need a special case, since both emacsen work alike -sb. |
835 |
(make-local-variable 'font-lock-defaults) |
(set (make-local-variable 'font-lock-defaults) |
836 |
(setq font-lock-defaults |
'((f90-font-lock-keywords f90-font-lock-keywords-1 |
837 |
'((f90-font-lock-keywords f90-font-lock-keywords-1 |
f90-font-lock-keywords-2 |
838 |
f90-font-lock-keywords-2 |
f90-font-lock-keywords-3 |
839 |
f90-font-lock-keywords-3 |
f90-font-lock-keywords-4) |
840 |
f90-font-lock-keywords-4) |
nil t)) |
|
nil t)) |
|
841 |
;; Tell imenu how to handle f90. |
;; Tell imenu how to handle f90. |
842 |
(set (make-local-variable 'imenu-case-fold-search) t) |
(set (make-local-variable 'imenu-case-fold-search) t) |
843 |
(make-local-variable 'imenu-generic-expression) |
(set (make-local-variable 'imenu-generic-expression) |
844 |
(setq imenu-generic-expression f90-imenu-generic-expression) |
f90-imenu-generic-expression) |
845 |
(set (make-local-variable 'add-log-current-defun-function) |
(set (make-local-variable 'add-log-current-defun-function) |
846 |
#'f90-current-defun) |
#'f90-current-defun) |
847 |
(run-hooks 'f90-mode-hook)) |
(run-hooks 'f90-mode-hook)) |
875 |
(save-excursion |
(save-excursion |
876 |
(beginning-of-line) |
(beginning-of-line) |
877 |
(while (and (looking-at "[ \t]*\\(!\\|$\\)") (zerop (forward-line -1)))) |
(while (and (looking-at "[ \t]*\\(!\\|$\\)") (zerop (forward-line -1)))) |
878 |
(let ((bol (line-beginning-position))) |
(end-of-line) |
879 |
(end-of-line) |
(while (f90-in-comment) |
880 |
(while (f90-in-comment) |
(search-backward "!" (line-beginning-position)) |
881 |
(search-backward "!" bol) |
(skip-chars-backward "!")) |
882 |
(skip-chars-backward "!")) |
(skip-chars-backward " \t") |
883 |
(skip-chars-backward " \t") |
(= (preceding-char) ?&))) |
|
(= (preceding-char) ?&)))) |
|
884 |
|
|
885 |
(defsubst f90-current-indentation () |
(defsubst f90-current-indentation () |
886 |
"Return indentation of current line. |
"Return indentation of current line. |
887 |
Line-numbers are considered whitespace characters." |
Line-numbers are considered whitespace characters." |
888 |
(save-excursion |
(save-excursion (beginning-of-line) (skip-chars-forward " \t0-9"))) |
|
(beginning-of-line) (skip-chars-forward " \t0-9"))) |
|
889 |
|
|
890 |
(defsubst f90-indent-to (col &optional no-line-number) |
(defsubst f90-indent-to (col &optional no-line-number) |
891 |
"Indent current line to column COL. |
"Indent current line to column COL. |
903 |
"If point lies within a comment, return the string starting the comment. |
"If point lies within a comment, return the string starting the comment. |
904 |
For example, \"!\" or \"!!\"." |
For example, \"!\" or \"!!\"." |
905 |
(save-excursion |
(save-excursion |
906 |
(let ((type nil) (eol (line-end-position))) |
(when (f90-in-comment) |
907 |
(when (f90-in-comment) |
(beginning-of-line) |
908 |
(beginning-of-line) |
(re-search-forward "[!]+" (line-end-position)) |
909 |
(re-search-forward "[!]+" eol) |
(while (f90-in-string) |
910 |
(while (f90-in-string) |
(re-search-forward "[!]+" (line-end-position)) |
911 |
(re-search-forward "[!]+" eol)) |
(match-string 0))))) |
|
(setq type (match-string 0))) |
|
|
type))) |
|
912 |
|
|
913 |
(defsubst f90-equal-symbols (a b) |
(defsubst f90-equal-symbols (a b) |
914 |
"Compare strings A and B neglecting case and allowing for nil value." |
"Compare strings A and B neglecting case and allowing for nil value." |
943 |
"Return (\"if\" NAME) if an if () then statement starts after point. |
"Return (\"if\" NAME) if an if () then statement starts after point. |
944 |
NAME is nil if the statement has no label." |
NAME is nil if the statement has no label." |
945 |
(save-excursion |
(save-excursion |
946 |
(let (struct (label nil)) |
(when (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(if\\)\\>") |
947 |
(when (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(if\\)\\>") |
(let (label |
948 |
(setq struct (match-string 3)) |
(struct (match-string 3))) |
949 |
(if (looking-at "\\(\\sw+\\)[ \t]*\:") |
(if (looking-at "\\(\\sw+\\)[ \t]*\:") |
950 |
(setq label (match-string 1))) |
(setq label (match-string 1))) |
951 |
(let ((pos (scan-lists (point) 1 0))) |
(let ((pos (scan-lists (point) 1 0))) |
1026 |
Comment lines embedded amongst continued lines return 'middle." |
Comment lines embedded amongst continued lines return 'middle." |
1027 |
(let (pcont cont) |
(let (pcont cont) |
1028 |
(save-excursion |
(save-excursion |
1029 |
(setq pcont (if (f90-previous-statement) (f90-line-continued) nil))) |
(setq pcont (if (f90-previous-statement) (f90-line-continued)))) |
1030 |
(setq cont (f90-line-continued)) |
(setq cont (f90-line-continued)) |
1031 |
(cond ((and (not pcont) (not cont)) 'single) |
(cond ((and (not pcont) (not cont)) 'single) |
1032 |
((and (not pcont) cont) 'begin) |
((and (not pcont) cont) 'begin) |
1033 |
((and pcont (not cont)) 'end) |
((and pcont (not cont)) 'end) |
1034 |
((and pcont cont) 'middle) |
((and pcont cont) 'middle) |
1035 |
(t (error))))) |
(t (error "The impossible occurred"))))) |
1036 |
|
|
1037 |
(defsubst f90-indent-line-no () |
(defsubst f90-indent-line-no () |
1038 |
"If `f90-leave-line-no' is nil, left-justify a line number. |
"If `f90-leave-line-no' is nil, left-justify a line number. |
1085 |
(beginning-of-line) |
(beginning-of-line) |
1086 |
(when (re-search-forward "\\(if\\|do\\|select\\|where\\|forall\\)" |
(when (re-search-forward "\\(if\\|do\\|select\\|where\\|forall\\)" |
1087 |
(line-end-position) t) |
(line-end-position) t) |
1088 |
(beginning-of-line) (skip-chars-forward " \t") |
(beginning-of-line) |
1089 |
|
(skip-chars-forward " \t") |
1090 |
(cond ((f90-looking-at-do) |
(cond ((f90-looking-at-do) |
1091 |
(setq icol (+ icol f90-do-indent))) |
(setq icol (+ icol f90-do-indent))) |
1092 |
((or (f90-looking-at-if-then) |
((or (f90-looking-at-if-then) |
1096 |
(end-of-line)) |
(end-of-line)) |
1097 |
(while (re-search-forward |
(while (re-search-forward |
1098 |
"\\(if\\|do\\|select\\|where\\|forall\\)" epnt t) |
"\\(if\\|do\\|select\\|where\\|forall\\)" epnt t) |
1099 |
(beginning-of-line) (skip-chars-forward " \t0-9") |
(beginning-of-line) |
1100 |
(cond ((f90-looking-at-do) |
(skip-chars-forward " \t0-9") |
1101 |
(setq icol (+ icol f90-do-indent))) |
(cond ((f90-looking-at-do) |
1102 |
((or (f90-looking-at-if-then) |
(setq icol (+ icol f90-do-indent))) |
1103 |
(f90-looking-at-where-or-forall) |
((or (f90-looking-at-if-then) |
1104 |
(f90-looking-at-select-case)) |
(f90-looking-at-where-or-forall) |
1105 |
(setq icol (+ icol f90-if-indent))) |
(f90-looking-at-select-case)) |
1106 |
((looking-at f90-end-if-re) |
(setq icol (+ icol f90-if-indent))) |
1107 |
(setq icol (- icol f90-if-indent))) |
((looking-at f90-end-if-re) |
1108 |
((looking-at "end[ \t]*do\\>") |
(setq icol (- icol f90-if-indent))) |
1109 |
(setq icol (- icol f90-do-indent)))) |
((looking-at "end[ \t]*do\\>") |
1110 |
|
(setq icol (- icol f90-do-indent)))) |
1111 |
(end-of-line)) |
(end-of-line)) |
1112 |
icol))) |
icol))) |
1113 |
|
|
1125 |
(cond ((eq cont 'begin) |
(cond ((eq cont 'begin) |
1126 |
(setq icol (+ (f90-current-indentation) |
(setq icol (+ (f90-current-indentation) |
1127 |
f90-continuation-indent))) |
f90-continuation-indent))) |
1128 |
((eq cont 'middle) (setq icol(current-indentation))) |
((eq cont 'middle) (setq icol (current-indentation))) |
1129 |
(t (setq icol (f90-current-indentation)) |
(t (setq icol (f90-current-indentation)) |
1130 |
(skip-chars-forward " \t") |
(skip-chars-forward " \t") |
1131 |
(if (looking-at "[0-9]") |
(if (looking-at "[0-9]") |
1190 |
Return (TYPE NAME), or nil if not found." |
Return (TYPE NAME), or nil if not found." |
1191 |
(interactive) |
(interactive) |
1192 |
(let ((count 1) (case-fold-search t) matching-beg) |
(let ((count 1) (case-fold-search t) matching-beg) |
1193 |
(beginning-of-line) (skip-chars-forward " \t0-9") |
(beginning-of-line) |
1194 |
|
(skip-chars-forward " \t0-9") |
1195 |
(if (setq matching-beg (f90-looking-at-program-block-start)) |
(if (setq matching-beg (f90-looking-at-program-block-start)) |
1196 |
(setq count (- count 1))) |
(setq count (1- count))) |
1197 |
(while (and (not (zerop count)) |
(while (and (not (zerop count)) |
1198 |
(re-search-backward f90-program-block-re nil 'move)) |
(re-search-backward f90-program-block-re nil 'move)) |
1199 |
(beginning-of-line) (skip-chars-forward " \t0-9") |
(beginning-of-line) |
1200 |
(cond |
(skip-chars-forward " \t0-9") |
1201 |
((setq matching-beg (f90-looking-at-program-block-start)) |
(cond ((setq matching-beg (f90-looking-at-program-block-start)) |
1202 |
(setq count (- count 1))) |
(setq count (1- count))) |
1203 |
((f90-looking-at-program-block-end) |
((f90-looking-at-program-block-end) |
1204 |
(setq count (+ count 1))))) |
(setq count (1+ count))))) |
1205 |
(beginning-of-line) |
(beginning-of-line) |
1206 |
(if (zerop count) |
(if (zerop count) |
1207 |
matching-beg |
matching-beg |
1213 |
Return (TYPE NAME), or nil if not found." |
Return (TYPE NAME), or nil if not found." |
1214 |
(interactive) |
(interactive) |
1215 |
(let ((count 1) (case-fold-search t) matching-end) |
(let ((count 1) (case-fold-search t) matching-end) |
1216 |
(beginning-of-line) (skip-chars-forward " \t0-9") |
(beginning-of-line) |
1217 |
|
(skip-chars-forward " \t0-9") |
1218 |
(if (setq matching-end (f90-looking-at-program-block-end)) |
(if (setq matching-end (f90-looking-at-program-block-end)) |
1219 |
(setq count (1- count))) |
(setq count (1- count))) |
1220 |
(end-of-line) |
(end-of-line) |
1221 |
(while (and (not (zerop count)) |
(while (and (not (zerop count)) |
1222 |
(re-search-forward f90-program-block-re nil 'move)) |
(re-search-forward f90-program-block-re nil 'move)) |
1223 |
(beginning-of-line) (skip-chars-forward " \t0-9") |
(beginning-of-line) |
1224 |
|
(skip-chars-forward " \t0-9") |
1225 |
(cond ((f90-looking-at-program-block-start) |
(cond ((f90-looking-at-program-block-start) |
1226 |
(setq count (+ count 1))) |
(setq count (1+ count))) |
1227 |
((setq matching-end (f90-looking-at-program-block-end)) |
((setq matching-end (f90-looking-at-program-block-end)) |
1228 |
(setq count (1- count )))) |
(setq count (1- count)))) |
1229 |
(end-of-line)) |
(end-of-line)) |
1230 |
(forward-line 1) |
(forward-line 1) |
1231 |
(if (zerop count) |
(if (zerop count) |
1273 |
(if (looking-at (regexp-quote f90-comment-region)) |
(if (looking-at (regexp-quote f90-comment-region)) |
1274 |
(delete-region (point) (match-end 0)) |
(delete-region (point) (match-end 0)) |
1275 |
(insert f90-comment-region)) |
(insert f90-comment-region)) |
1276 |
(while (and (zerop (forward-line 1)) |
(while (and (zerop (forward-line 1)) |
1277 |
(< (point) (marker-position end))) |
(< (point) (marker-position end))) |
1278 |
(if (looking-at (regexp-quote f90-comment-region)) |
(if (looking-at (regexp-quote f90-comment-region)) |
1279 |
(delete-region (point) (match-end 0)) |
(delete-region (point) (match-end 0)) |
1280 |
(insert f90-comment-region))) |
(insert f90-comment-region))) |
1285 |
Unless optional argument NO-UPDATE is non-nil, call `f90-update-line' |
Unless optional argument NO-UPDATE is non-nil, call `f90-update-line' |
1286 |
after indenting." |
after indenting." |
1287 |
(interactive) |
(interactive) |
1288 |
(let (indent (no-line-number nil) (pos (make-marker)) (case-fold-search t)) |
(let (indent no-line-number (pos (make-marker)) (case-fold-search t)) |
1289 |
(set-marker pos (point)) |
(set-marker pos (point)) |
1290 |
(beginning-of-line) ; digits after & \n are not line-nos |
(beginning-of-line) ; digits after & \n are not line-nos |
1291 |
(if (save-excursion (and (f90-previous-statement) (f90-line-continued))) |
(if (save-excursion (and (f90-previous-statement) (f90-line-continued))) |
1296 |
(if (and (looking-at "end") f90-smart-end) |
(if (and (looking-at "end") f90-smart-end) |
1297 |
(f90-match-end)) |
(f90-match-end)) |
1298 |
(setq indent (f90-calculate-indent))) |
(setq indent (f90-calculate-indent))) |
1299 |
(if (zerop (- indent (current-column))) |
(if (not (zerop (- indent (current-column)))) |
1300 |
nil |
(f90-indent-to indent no-line-number)) |
|
(f90-indent-to indent no-line-number)) |
|
1301 |
;; If initial point was within line's indentation, |
;; If initial point was within line's indentation, |
1302 |
;; position after the indentation. Else stay at same point in text. |
;; position after the indentation. Else stay at same point in text. |
1303 |
(if (< (point) (marker-position pos)) |
(if (< (point) (marker-position pos)) |
1319 |
(f90-indent-line 'no-update) |
(f90-indent-line 'no-update) |
1320 |
(end-of-line) |
(end-of-line) |
1321 |
(delete-horizontal-space) ; destroy trailing whitespace |
(delete-horizontal-space) ; destroy trailing whitespace |
1322 |
(setq string (f90-in-string)) |
(setq string (f90-in-string) |
1323 |
(setq cont (f90-line-continued)) |
cont (f90-line-continued)) |
1324 |
(if (and string (not cont)) (insert "&")) |
(if (and string (not cont)) (insert "&")) |
1325 |
(f90-update-line) |
(f90-update-line) |
1326 |
(newline) |
(newline) |
1331 |
(defun f90-indent-region (beg-region end-region) |
(defun f90-indent-region (beg-region end-region) |
1332 |
"Indent every line in region by forward parsing." |
"Indent every line in region by forward parsing." |
1333 |
(interactive "*r") |
(interactive "*r") |
1334 |
(let ((end-region-mark (make-marker)) (save-point (point-marker)) |
(let ((end-region-mark (make-marker)) |
1335 |
(block-list nil) ind-lev ind-curr ind-b cont |
(save-point (point-marker)) |
1336 |
|
block-list ind-lev ind-curr ind-b cont |
1337 |
struct beg-struct end-struct) |
struct beg-struct end-struct) |
1338 |
(set-marker end-region-mark end-region) |
(set-marker end-region-mark end-region) |
1339 |
(goto-char beg-region) |
(goto-char beg-region) |
1350 |
;; Process present line for beginning of block. |
;; Process present line for beginning of block. |
1351 |
(setq f90-cache-position (point)) |
(setq f90-cache-position (point)) |
1352 |
(f90-indent-line 'no-update) |
(f90-indent-line 'no-update) |
1353 |
(setq ind-lev (f90-current-indentation)) |
(setq ind-lev (f90-current-indentation) |
1354 |
(setq ind-curr ind-lev) |
ind-curr ind-lev) |
1355 |
(beginning-of-line) (skip-chars-forward " \t0-9") |
(beginning-of-line) |
1356 |
(setq struct nil) |
(skip-chars-forward " \t0-9") |
1357 |
(setq ind-b (cond ((setq struct (f90-looking-at-do)) f90-do-indent) |
(setq struct nil |
1358 |
|
ind-b (cond ((setq struct (f90-looking-at-do)) f90-do-indent) |
1359 |
((or (setq struct (f90-looking-at-if-then)) |
((or (setq struct (f90-looking-at-if-then)) |
1360 |
(setq struct (f90-looking-at-select-case)) |
(setq struct (f90-looking-at-select-case)) |
1361 |
(setq struct (f90-looking-at-where-or-forall)) |
(setq struct (f90-looking-at-where-or-forall)) |
1441 |
"Properly indent the subprogram containing point." |
"Properly indent the subprogram containing point." |
1442 |
(interactive) |
(interactive) |
1443 |
(save-excursion |
(save-excursion |
1444 |
(let (program) |
(let ((program (f90-mark-subprogram))) |
|
(setq program (f90-mark-subprogram)) |
|
1445 |
(if program |
(if program |
1446 |
(progn |
(progn |
1447 |
(message "Indenting %s %s..." |
(message "Indenting %s %s..." |
1494 |
(while (> (current-column) fill-column) |
(while (> (current-column) fill-column) |
1495 |
(let ((pos-mark (point-marker))) |
(let ((pos-mark (point-marker))) |
1496 |
(move-to-column fill-column) |
(move-to-column fill-column) |
1497 |
(if (not (f90-in-string)) |
(or (f90-in-string) (f90-find-breakpoint)) |
|
(f90-find-breakpoint)) |
|
1498 |
(f90-break-line) |
(f90-break-line) |
1499 |
(goto-char pos-mark) |
(goto-char pos-mark) |
1500 |
(set-marker pos-mark nil)))) |
(set-marker pos-mark nil)))) |
1506 |
(let (pos (oldpos (point))) |
(let (pos (oldpos (point))) |
1507 |
(end-of-line) |
(end-of-line) |
1508 |
(skip-chars-backward " \t") |
(skip-chars-backward " \t") |
1509 |
(cond ((= (preceding-char) ?&) |
(when (= (preceding-char) ?&) |
1510 |
(delete-char -1) |
(delete-char -1) |
1511 |
(setq pos (point)) |
(setq pos (point)) |
1512 |
(forward-line 1) |
(forward-line 1) |
1513 |
(skip-chars-forward " \t") |
(skip-chars-forward " \t") |
1514 |
(if (looking-at "\&") (delete-char 1)) |
(if (looking-at "\&") (delete-char 1)) |
1515 |
(delete-region pos (point)) |
(delete-region pos (point)) |
1516 |
(unless (f90-in-string) |
(unless (f90-in-string) |
1517 |
(delete-horizontal-space) |
(delete-horizontal-space) |
1518 |
(insert " ")) |
(insert " ")) |
1519 |
(if (and auto-fill-function |
(if (and auto-fill-function |
1520 |
(> (save-excursion (end-of-line) |
(> (line-end-position) fill-column)) |
1521 |
(current-column)) |
(f90-do-auto-fill)) |
1522 |
fill-column)) |
(goto-char oldpos) |
1523 |
(f90-do-auto-fill)) |
t))) ; return t if joined something |
|
(goto-char oldpos) |
|
|
t)))) |
|
1524 |
|
|
1525 |
(defun f90-fill-region (beg-region end-region) |
(defun f90-fill-region (beg-region end-region) |
1526 |
"Fill every line in region by forward parsing. Join lines if possible." |
"Fill every line in region by forward parsing. Join lines if possible." |
1527 |
(interactive "*r") |
(interactive "*r") |
1528 |
(let ((end-region-mark (make-marker)) |
(let ((end-region-mark (make-marker)) |
1529 |
(f90-smart-end nil) (f90-auto-keyword-case nil) (go-on t) |
(go-on t) |
1530 |
(auto-fill-function nil)) |
f90-smart-end f90-auto-keyword-case auto-fill-function) |
1531 |
(set-marker end-region-mark end-region) |
(set-marker end-region-mark end-region) |
1532 |
(goto-char beg-region) |
(goto-char beg-region) |
1533 |
(while go-on |
(while go-on |
1539 |
(move-to-column fill-column) |
(move-to-column fill-column) |
1540 |
(f90-find-breakpoint) |
(f90-find-breakpoint) |
1541 |
(f90-break-line 'no-update)) |
(f90-break-line 'no-update)) |
1542 |
(setq go-on (and (< (point) (marker-position end-region-mark)) |
(setq go-on (and (< (point) (marker-position end-region-mark)) |
1543 |
(zerop (forward-line 1)))) |
(zerop (forward-line 1))) |
1544 |
(setq f90-cache-position (point))) |
f90-cache-position (point))) |
1545 |
(setq f90-cache-position nil) |
(setq f90-cache-position nil) |
1546 |
(if f90-xemacs-flag |
(if f90-xemacs-flag |
1547 |
(zmacs-deactivate-region) |
(zmacs-deactivate-region) |
1583 |
(defun f90-match-end () |
(defun f90-match-end () |
1584 |
"From an end block statement, find the corresponding block and name." |
"From an end block statement, find the corresponding block and name." |
1585 |
(interactive) |
(interactive) |
1586 |
(let ((count 1) (top-of-window (window-start)) (matching-beg nil) |
(let ((count 1) (top-of-window (window-start)) |
1587 |
(end-point (point)) (case-fold-search t) |
(end-point (point)) (case-fold-search t) |
1588 |
beg-name end-name beg-block end-block end-struct) |
matching-beg beg-name end-name beg-block end-block end-struct) |
1589 |
(when (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") |
(when (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") |
1590 |
(setq end-struct (f90-looking-at-program-block-end))) |
(setq end-struct (f90-looking-at-program-block-end))) |
1591 |
(setq end-block (car end-struct)) |
(setq end-block (car end-struct) |
1592 |
(setq end-name (car (cdr end-struct))) |
end-name (car (cdr end-struct))) |
1593 |
(save-excursion |
(save-excursion |
1594 |
(beginning-of-line) |
(beginning-of-line) |
1595 |
(while |
(while |
1605 |
(not (or (f90-in-string) |
(not (or (f90-in-string) |
1606 |
(f90-in-comment)))))) |
(f90-in-comment)))))) |
1607 |
(not notexist))) |
(not notexist))) |
1608 |
(beginning-of-line) (skip-chars-forward " \t0-9") |
(beginning-of-line) |
1609 |
|
(skip-chars-forward " \t0-9") |
1610 |
(cond ((setq matching-beg |
(cond ((setq matching-beg |
1611 |
(cond |
(or |
1612 |
((f90-looking-at-do)) |
(f90-looking-at-do) |
1613 |
((f90-looking-at-if-then)) |
(f90-looking-at-if-then) |
1614 |
((f90-looking-at-where-or-forall)) |
(f90-looking-at-where-or-forall) |
1615 |
((f90-looking-at-select-case)) |
(f90-looking-at-select-case) |
1616 |
((f90-looking-at-type-like)) |
(f90-looking-at-type-like) |
1617 |
((f90-looking-at-program-block-start)))) |
(f90-looking-at-program-block-start))) |
1618 |
(setq count (- count 1))) |
(setq count (1- count))) |
1619 |
((looking-at (concat "end[ \t]*" f90-blocks-re "\\b")) |
((looking-at (concat "end[ \t]*" f90-blocks-re "\\b")) |
1620 |
(setq count (+ count 1))))) |
(setq count (1+ count))))) |
1621 |
(if (not (zerop count)) |
(if (not (zerop count)) |
1622 |
(message "No matching beginning.") |
(message "No matching beginning.") |
1623 |
(f90-update-line) |
(f90-update-line) |
1629 |
(line-beginning-position) |
(line-beginning-position) |
1630 |
(line-end-position))) |
(line-end-position))) |
1631 |
(sit-for 1))) |
(sit-for 1))) |
1632 |
(setq beg-block (car matching-beg)) |
(setq beg-block (car matching-beg) |
1633 |
(setq beg-name (car (cdr matching-beg))) |
beg-name (car (cdr matching-beg))) |
1634 |
(goto-char end-point) |
(goto-char end-point) |
1635 |
(beginning-of-line) |
(beginning-of-line) |
1636 |
(f90-block-match beg-block beg-name end-block end-name)))))) |
(f90-block-match beg-block beg-name end-block end-name)))))) |
1638 |
(defun f90-insert-end () |
(defun f90-insert-end () |
1639 |
"Insert a complete end statement matching beginning of present block." |
"Insert a complete end statement matching beginning of present block." |
1640 |
(interactive) |
(interactive) |
1641 |
(let ((f90-smart-end (if f90-smart-end f90-smart-end 'blink))) |
(let ((f90-smart-end (or f90-smart-end 'blink))) |
1642 |
(insert "end") |
(insert "end") |
1643 |
(f90-indent-new-line))) |
(f90-indent-new-line))) |
1644 |
|
|
1714 |
"Change the case of F90 keywords in the region (if specified) or buffer. |
"Change the case of F90 keywords in the region (if specified) or buffer. |
1715 |
CHANGE-WORD should be one of 'upcase-word, 'downcase-word, capitalize-word." |
CHANGE-WORD should be one of 'upcase-word, 'downcase-word, capitalize-word." |
1716 |
(save-excursion |
(save-excursion |
1717 |
(setq beg (if beg beg (point-min))) |
(setq beg (or beg (point-min)) |
1718 |
(setq end (if end end (point-max))) |
end (or end (point-max))) |
1719 |
(let ((keyword-re |
(let ((keyword-re |
1720 |
(concat "\\(" |
(concat "\\(" |
1721 |
f90-keywords-re "\\|" f90-procedures-re "\\|" |
f90-keywords-re "\\|" f90-procedures-re "\\|" |
1722 |
f90-hpf-keywords-re "\\|" f90-operators-re "\\)")) |
f90-hpf-keywords-re "\\|" f90-operators-re "\\)")) |
1723 |
(ref-point (point-min)) state |
(ref-point (point-min)) |
1724 |
(modified (buffer-modified-p)) saveword back-point) |
(modified (buffer-modified-p)) |
1725 |
|
state saveword back-point) |
1726 |
(goto-char beg) |
(goto-char beg) |
1727 |
(unwind-protect |
(unwind-protect |
1728 |
(while (re-search-forward keyword-re end t) |
(while (re-search-forward keyword-re end t) |
1734 |
(skip-chars-forward " \t0-9") |
(skip-chars-forward " \t0-9") |
1735 |
(looking-at "#")))) |
(looking-at "#")))) |
1736 |
(setq ref-point (point) |
(setq ref-point (point) |
1737 |
back-point (save-excursion (backward-word 1) (point))) |
back-point (save-excursion (backward-word 1) (point)) |
1738 |
(setq saveword (buffer-substring back-point ref-point)) |
saveword (buffer-substring back-point ref-point)) |
1739 |
(funcall change-word -1) |
(funcall change-word -1) |
1740 |
(or (string= saveword (buffer-substring back-point ref-point)) |
(or (string= saveword (buffer-substring back-point ref-point)) |
1741 |
(setq modified t)))) |
(setq modified t)))) |