770 |
f90-font-lock-keywords-3 |
f90-font-lock-keywords-3 |
771 |
f90-font-lock-keywords-4) |
f90-font-lock-keywords-4) |
772 |
nil t)) |
nil t)) |
|
;; Tell imenu how to handle f90. |
|
773 |
(set (make-local-variable 'imenu-case-fold-search) t) |
(set (make-local-variable 'imenu-case-fold-search) t) |
774 |
(set (make-local-variable 'imenu-generic-expression) |
(set (make-local-variable 'imenu-generic-expression) |
775 |
f90-imenu-generic-expression) |
f90-imenu-generic-expression) |
816 |
(skip-chars-backward " \t") |
(skip-chars-backward " \t") |
817 |
(= (preceding-char) ?&))) |
(= (preceding-char) ?&))) |
818 |
|
|
819 |
|
;; GM this is not right, eg a continuation line starting with a number. |
820 |
|
;; Need f90-code-start-position function. |
821 |
|
;; And yet, things seems to work with this... |
822 |
(defsubst f90-current-indentation () |
(defsubst f90-current-indentation () |
823 |
"Return indentation of current line. |
"Return indentation of current line. |
824 |
Line-numbers are considered whitespace characters." |
Line-numbers are considered whitespace characters." |
829 |
If optional argument NO-LINE-NUMBER is nil, jump over a possible |
If optional argument NO-LINE-NUMBER is nil, jump over a possible |
830 |
line-number before indenting." |
line-number before indenting." |
831 |
(beginning-of-line) |
(beginning-of-line) |
832 |
(if (not no-line-number) |
(or no-line-number |
833 |
(skip-chars-forward " \t0-9")) |
(skip-chars-forward " \t0-9")) |
834 |
(delete-horizontal-space) |
(delete-horizontal-space) |
835 |
(if (zerop (current-column)) |
;; Leave >= 1 space after line number. |
836 |
(indent-to col) |
(indent-to col (if (zerop (current-column)) 0 1))) |
|
(indent-to col 1))) ; leave >= 1 space after line number |
|
837 |
|
|
838 |
(defsubst f90-get-present-comment-type () |
(defsubst f90-get-present-comment-type () |
839 |
"If point lies within a comment, return the string starting the comment. |
"If point lies within a comment, return the string starting the comment. |
851 |
(equal (if a (downcase a) nil) |
(equal (if a (downcase a) nil) |
852 |
(if b (downcase b) nil))) |
(if b (downcase b) nil))) |
853 |
|
|
|
;; XEmacs 19.11 & 19.12 return a single char when matching an empty regexp. |
|
|
;; The next 2 functions are therefore longer than necessary. |
|
854 |
(defsubst f90-looking-at-do () |
(defsubst f90-looking-at-do () |
855 |
"Return (\"do\" NAME) if a do statement starts after point. |
"Return (\"do\" NAME) if a do statement starts after point. |
856 |
NAME is nil if the statement has no label." |
NAME is nil if the statement has no label." |
857 |
(if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(do\\)\\>") |
(if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(do\\)\\>") |
858 |
(list (match-string 3) |
(list (match-string 3) (match-string 2))) |
|
(if (looking-at "\\(\\sw+\\)[ \t]*:") (match-string 1))))) |
|
859 |
|
|
860 |
(defsubst f90-looking-at-select-case () |
(defsubst f90-looking-at-select-case () |
861 |
"Return (\"select\" NAME) if a select-case statement starts after point. |
"Return (\"select\" NAME) if a select-case statement starts after point. |
862 |
NAME is nil if the statement has no label." |
NAME is nil if the statement has no label." |
863 |
(if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\ |
(if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\ |
864 |
\\(select\\)[ \t]*case[ \t]*(") |
\\(select\\)[ \t]*case[ \t]*(") |
865 |
(list (match-string 3) |
(list (match-string 3) (match-string 2)))) |
|
(if (looking-at "\\(\\sw+\\)[ \t]*:") (match-string 1))))) |
|
866 |
|
|
867 |
(defsubst f90-looking-at-if-then () |
(defsubst f90-looking-at-if-then () |
868 |
"Return (\"if\" NAME) if an if () then statement starts after point. |
"Return (\"if\" NAME) if an if () then statement starts after point. |
870 |
(save-excursion |
(save-excursion |
871 |
(when (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(if\\)\\>") |
(when (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(if\\)\\>") |
872 |
(let ((struct (match-string 3)) |
(let ((struct (match-string 3)) |
873 |
(label (if (looking-at "\\(\\sw+\\)[ \t]*:") (match-string 1))) |
(label (match-string 2)) |
874 |
(pos (scan-lists (point) 1 0))) |
(pos (scan-lists (point) 1 0))) |
875 |
(and pos (goto-char pos)) |
(and pos (goto-char pos)) |
876 |
(skip-chars-forward " \t") |
(skip-chars-forward " \t") |
888 |
(when (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\ |
(when (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\ |
889 |
\\(where\\|forall\\)\\>") |
\\(where\\|forall\\)\\>") |
890 |
(let ((struct (match-string 3)) |
(let ((struct (match-string 3)) |
891 |
(label (if (looking-at "\\(\\sw+\\)[ \t]*:") (match-string 1))) |
(label (match-string 2)) |
892 |
(pos (scan-lists (point) 1 0))) |
(pos (scan-lists (point) 1 0))) |
893 |
(and pos (goto-char pos)) |
(and pos (goto-char pos)) |
894 |
(skip-chars-forward " \t") |
(skip-chars-forward " \t") |
912 |
(looking-at "\\(module\\)[ \t]+\\(\\sw+\\)\\>")) |
(looking-at "\\(module\\)[ \t]+\\(\\sw+\\)\\>")) |
913 |
(list (match-string 1) (match-string 2))) |
(list (match-string 1) (match-string 2))) |
914 |
((and (not (looking-at "end[ \t]*\\(function\\|subroutine\\)")) |
((and (not (looking-at "end[ \t]*\\(function\\|subroutine\\)")) |
915 |
(looking-at "[^!'\"\&\n]*\\(function\\|subroutine\\)\ |
(looking-at "[^!'\"\&\n]*\\(function\\|subroutine\\)[ \t]+\ |
916 |
[ \t]+\\(\\sw+\\)")) |
\\(\\sw+\\)")) |
917 |
(list (match-string 1) (match-string 2))))) |
(list (match-string 1) (match-string 2))))) |
918 |
|
|
919 |
(defsubst f90-looking-at-program-block-end () |
(defsubst f90-looking-at-program-block-end () |
963 |
"If `f90-leave-line-no' is nil, left-justify a line number. |
"If `f90-leave-line-no' is nil, left-justify a line number. |
964 |
Leaves point at the first non-blank character after the line number. |
Leaves point at the first non-blank character after the line number. |
965 |
Call from beginning of line." |
Call from beginning of line." |
966 |
(if (and (null f90-leave-line-no) (looking-at "[ \t]+[0-9]")) |
(and (null f90-leave-line-no) (looking-at "[ \t]+[0-9]") |
967 |
(delete-horizontal-space)) |
(delete-horizontal-space)) |
968 |
(skip-chars-forward " \t0-9")) |
(skip-chars-forward " \t0-9")) |
969 |
|
|
970 |
(defsubst f90-no-block-limit () |
(defsubst f90-no-block-limit () |
971 |
"Return nil if point is at the edge of a code block. |
"Return nil if point is at the edge of a code block. |
972 |
Searches line forward for \"function\" or \"subroutine\", |
Searches line forward for \"function\" or \"subroutine\", |
973 |
if all else fails." |
if all else fails." |
974 |
(let ((eol (line-end-position))) |
(save-excursion |
975 |
(save-excursion |
(not (or (looking-at "end") |
976 |
(not (or (looking-at "end") |
(looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\ |
|
(looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\ |
|
977 |
\\|select[ \t]*case\\|case\\|where\\|forall\\)\\>") |
\\|select[ \t]*case\\|case\\|where\\|forall\\)\\>") |
978 |
(looking-at "\\(program\\|module\\|interface\\|\ |
(looking-at "\\(program\\|module\\|interface\\|\ |
979 |
block[ \t]*data\\)\\>") |
block[ \t]*data\\)\\>") |
980 |
(looking-at "\\(contains\\|\\sw+[ \t]*:\\)") |
(looking-at "\\(contains\\|\\sw+[ \t]*:\\)") |
981 |
(looking-at f90-type-def-re) |
(looking-at f90-type-def-re) |
982 |
(re-search-forward "\\(function\\|subroutine\\)" eol t)))))) |
(re-search-forward "\\(function\\|subroutine\\)" |
983 |
|
(line-end-position) t))))) |
984 |
|
|
985 |
(defsubst f90-update-line () |
(defsubst f90-update-line () |
986 |
"Change case of current line as per `f90-auto-keyword-case'." |
"Change case of current line as per `f90-auto-keyword-case'." |
1193 |
start-list (cdr start-list) |
start-list (cdr start-list) |
1194 |
start-type (car start-this) |
start-type (car start-this) |
1195 |
start-label (cadr start-this)) |
start-label (cadr start-this)) |
1196 |
(if (not (f90-equal-symbols start-type end-type)) |
(or (f90-equal-symbols start-type end-type) |
1197 |
(error "End type `%s' does not match start type `%s'" |
(error "End type `%s' does not match start type `%s'" |
1198 |
end-type start-type)) |
end-type start-type)) |
1199 |
(if (not (f90-equal-symbols start-label end-label)) |
(or (f90-equal-symbols start-label end-label) |
1200 |
(error "End label `%s' does not match start label `%s'" |
(error "End label `%s' does not match start label `%s'" |
1201 |
end-label start-label))))) |
end-label start-label))))) |
1202 |
(end-of-line)) |
(end-of-line)) |
1218 |
(if (and num (< num 0)) (f90-end-of-block (- num))) |
(if (and num (< num 0)) (f90-end-of-block (- num))) |
1219 |
(let ((case-fold-search t) |
(let ((case-fold-search t) |
1220 |
(count (or num 1)) |
(count (or num 1)) |
1221 |
end-list end-this end-type end-label start-this start-type start-label) |
end-list end-this end-type end-label |
1222 |
|
start-this start-type start-label) |
1223 |
(if (interactive-p) (push-mark (point) t)) |
(if (interactive-p) (push-mark (point) t)) |
1224 |
(beginning-of-line) ; probably want this |
(beginning-of-line) ; probably want this |
1225 |
(while (and (> count 0) (re-search-backward f90-blocks-re nil 'move)) |
(while (and (> count 0) (re-search-backward f90-blocks-re nil 'move)) |
1248 |
end-list (cdr end-list) |
end-list (cdr end-list) |
1249 |
end-type (car end-this) |
end-type (car end-this) |
1250 |
end-label (cadr end-this)) |
end-label (cadr end-this)) |
1251 |
(if (not (f90-equal-symbols start-type end-type)) |
(or (f90-equal-symbols start-type end-type) |
1252 |
(error "Start type `%s' does not match end type `%s'" |
(error "Start type `%s' does not match end type `%s'" |
1253 |
start-type end-type)) |
start-type end-type)) |
1254 |
(if (not (f90-equal-symbols start-label end-label)) |
(or (f90-equal-symbols start-label end-label) |
1255 |
(error "Start label `%s' does not match end label `%s'" |
(error "Start label `%s' does not match end label `%s'" |
1256 |
start-label end-label)))))) |
start-label end-label)))))) |
1257 |
(if (> count 0) (error "Missing block start")))) |
(if (> count 0) (error "Missing block start")))) |
1311 |
Insert the variable `f90-comment-region' at the start of every line |
Insert the variable `f90-comment-region' at the start of every line |
1312 |
in the region, or, if already present, remove it." |
in the region, or, if already present, remove it." |
1313 |
(interactive "*r") |
(interactive "*r") |
1314 |
(let ((end (make-marker))) |
(let ((end (copy-marker end-region))) |
|
(set-marker end end-region) |
|
1315 |
(goto-char beg-region) |
(goto-char beg-region) |
1316 |
(beginning-of-line) |
(beginning-of-line) |
1317 |
(if (looking-at (regexp-quote f90-comment-region)) |
(if (looking-at (regexp-quote f90-comment-region)) |
1318 |
(delete-region (point) (match-end 0)) |
(delete-region (point) (match-end 0)) |
1319 |
(insert f90-comment-region)) |
(insert f90-comment-region)) |
1320 |
(while (and (zerop (forward-line 1)) |
(while (and (zerop (forward-line 1)) |
1321 |
(< (point) (marker-position end))) |
(< (point) end)) |
1322 |
(if (looking-at (regexp-quote f90-comment-region)) |
(if (looking-at (regexp-quote f90-comment-region)) |
1323 |
(delete-region (point) (match-end 0)) |
(delete-region (point) (match-end 0)) |
1324 |
(insert f90-comment-region))) |
(insert f90-comment-region))) |
1329 |
Unless optional argument NO-UPDATE is non-nil, call `f90-update-line' |
Unless optional argument NO-UPDATE is non-nil, call `f90-update-line' |
1330 |
after indenting." |
after indenting." |
1331 |
(interactive "*P") |
(interactive "*P") |
1332 |
(let (indent no-line-number (pos (make-marker)) (case-fold-search t)) |
(let ((case-fold-search t) |
1333 |
(set-marker pos (point)) |
(pos (point-marker)) |
1334 |
(beginning-of-line) ; digits after & \n are not line-nos |
indent no-line-number) |
1335 |
(if (save-excursion (and (f90-previous-statement) (f90-line-continued))) |
(beginning-of-line) ; digits after & \n are not line-nos |
1336 |
(progn (setq no-line-number t) (skip-chars-forward " \t")) |
(if (not (save-excursion (and (f90-previous-statement) |
1337 |
(f90-indent-line-no)) |
(f90-line-continued)))) |
1338 |
|
(f90-indent-line-no) |
1339 |
|
(setq no-line-number t) |
1340 |
|
(skip-chars-forward " \t")) |
1341 |
(if (looking-at "!") |
(if (looking-at "!") |
1342 |
(setq indent (f90-comment-indent)) |
(setq indent (f90-comment-indent)) |
1343 |
(if (and (looking-at "end") f90-smart-end) |
(and f90-smart-end (looking-at "end") |
1344 |
(f90-match-end)) |
(f90-match-end)) |
1345 |
(setq indent (f90-calculate-indent))) |
(setq indent (f90-calculate-indent))) |
1346 |
(if (not (zerop (- indent (current-column)))) |
(or (= indent (current-column)) |
1347 |
(f90-indent-to indent no-line-number)) |
(f90-indent-to indent no-line-number)) |
1348 |
;; If initial point was within line's indentation, |
;; If initial point was within line's indentation, |
1349 |
;; position after the indentation. Else stay at same point in text. |
;; position after the indentation. Else stay at same point in text. |
1350 |
(if (< (point) (marker-position pos)) |
(and (< (point) pos) |
1351 |
(goto-char (marker-position pos))) |
(goto-char pos)) |
1352 |
(if auto-fill-function |
(if auto-fill-function |
1353 |
(f90-do-auto-fill) ; also updates line |
(f90-do-auto-fill) ; also updates line |
1354 |
(if (not no-update) (f90-update-line))) |
(or no-update (f90-update-line))) |
1355 |
(set-marker pos nil))) |
(set-marker pos nil))) |
1356 |
|
|
1357 |
(defun f90-indent-new-line () |
(defun f90-indent-new-line () |
1359 |
An abbrev before point is expanded if the variable `abbrev-mode' is non-nil. |
An abbrev before point is expanded if the variable `abbrev-mode' is non-nil. |
1360 |
If run in the middle of a line, the line is not broken." |
If run in the middle of a line, the line is not broken." |
1361 |
(interactive "*") |
(interactive "*") |
1362 |
(let (string cont (case-fold-search t)) |
(if abbrev-mode (expand-abbrev)) |
1363 |
(if abbrev-mode (expand-abbrev)) |
(beginning-of-line) ; reindent where likely to be needed |
1364 |
(beginning-of-line) ; reindent where likely to be needed |
(f90-indent-line-no) |
1365 |
(f90-indent-line-no) |
(f90-indent-line 'no-update) |
1366 |
(f90-indent-line 'no-update) |
(end-of-line) |
1367 |
(end-of-line) |
(delete-horizontal-space) ; destroy trailing whitespace |
1368 |
(delete-horizontal-space) ; destroy trailing whitespace |
(let ((string (f90-in-string)) |
1369 |
(setq string (f90-in-string) |
(cont (f90-line-continued))) |
1370 |
cont (f90-line-continued)) |
(and string (not cont) (insert "&")) |
|
(if (and string (not cont)) (insert "&")) |
|
1371 |
(f90-update-line) |
(f90-update-line) |
1372 |
(newline) |
(newline) |
1373 |
(if (or string (and cont f90-beginning-ampersand)) (insert "&")) |
(if (or string (and cont f90-beginning-ampersand)) (insert "&"))) |
1374 |
(f90-indent-line 'no-update))) |
(f90-indent-line 'no-update)) |
1375 |
|
|
1376 |
|
|
1377 |
(defun f90-indent-region (beg-region end-region) |
(defun f90-indent-region (beg-region end-region) |
1378 |
"Indent every line in region by forward parsing." |
"Indent every line in region by forward parsing." |
1379 |
(interactive "*r") |
(interactive "*r") |
1380 |
(let ((end-region-mark (make-marker)) |
(let ((end-region-mark (copy-marker end-region)) |
1381 |
(save-point (point-marker)) |
(save-point (point-marker)) |
1382 |
block-list ind-lev ind-curr ind-b cont |
block-list ind-lev ind-curr ind-b cont struct beg-struct end-struct) |
|
struct beg-struct end-struct) |
|
|
(set-marker end-region-mark end-region) |
|
1383 |
(goto-char beg-region) |
(goto-char beg-region) |
1384 |
;; First find a line which is not a continuation line or comment. |
;; First find a line which is not a continuation line or comment. |
1385 |
(beginning-of-line) |
(beginning-of-line) |
1416 |
(< (point) end-region-mark)) |
(< (point) end-region-mark)) |
1417 |
(if (looking-at "[ \t]*!") |
(if (looking-at "[ \t]*!") |
1418 |
(f90-indent-to (f90-comment-indent)) |
(f90-indent-to (f90-comment-indent)) |
1419 |
(if (not (zerop (- (current-indentation) |
(or (= (current-indentation) |
1420 |
(+ ind-curr f90-continuation-indent)))) |
(+ ind-curr f90-continuation-indent)) |
1421 |
(f90-indent-to (+ ind-curr f90-continuation-indent) 'no-line-no)))) |
(f90-indent-to (+ ind-curr f90-continuation-indent) 'no-line-no)))) |
1422 |
;; Process all following lines. |
;; Process all following lines. |
1423 |
(while (and (zerop (forward-line 1)) (< (point) end-region-mark)) |
(while (and (zerop (forward-line 1)) (< (point) end-region-mark)) |
1462 |
(setq ind-curr ind-lev)) |
(setq ind-curr ind-lev)) |
1463 |
(t (setq ind-curr ind-lev))) |
(t (setq ind-curr ind-lev))) |
1464 |
;; Do the indentation if necessary. |
;; Do the indentation if necessary. |
1465 |
(if (not (zerop (- ind-curr (current-column)))) |
(or (= ind-curr (current-column)) |
1466 |
(f90-indent-to ind-curr)) |
(f90-indent-to ind-curr)) |
1467 |
(while (and (f90-line-continued) (zerop (forward-line 1)) |
(while (and (f90-line-continued) (zerop (forward-line 1)) |
1468 |
(< (point) end-region-mark)) |
(< (point) end-region-mark)) |
1469 |
(if (looking-at "[ \t]*!") |
(if (looking-at "[ \t]*!") |
1470 |
(f90-indent-to (f90-comment-indent)) |
(f90-indent-to (f90-comment-indent)) |
1471 |
(if (not (zerop (- (current-indentation) |
(or (= (current-indentation) |
1472 |
(+ ind-curr f90-continuation-indent)))) |
(+ ind-curr f90-continuation-indent)) |
1473 |
(f90-indent-to |
(f90-indent-to |
1474 |
(+ ind-curr f90-continuation-indent) 'no-line-no))))) |
(+ ind-curr f90-continuation-indent) 'no-line-no))))) |
1475 |
;; Restore point, etc. |
;; Restore point, etc. |
1514 |
|
|
1515 |
(defun f90-find-breakpoint () |
(defun f90-find-breakpoint () |
1516 |
"From `fill-column', search backward for break-delimiter." |
"From `fill-column', search backward for break-delimiter." |
1517 |
(let ((bol (line-beginning-position))) |
(re-search-backward f90-break-delimiters (line-beginning-position)) |
1518 |
(re-search-backward f90-break-delimiters bol) |
(if (not f90-break-before-delimiters) |
1519 |
(if (not f90-break-before-delimiters) |
(forward-char (if (looking-at f90-no-break-re) 2 1)) |
1520 |
(if (looking-at f90-no-break-re) |
(backward-char) |
1521 |
(forward-char 2) |
(or (looking-at f90-no-break-re) |
1522 |
(forward-char)) |
(forward-char))))) |
|
(backward-char) |
|
|
(if (not (looking-at f90-no-break-re)) |
|
|
(forward-char))))) |
|
1523 |
|
|
1524 |
(defun f90-do-auto-fill () |
(defun f90-do-auto-fill () |
1525 |
"Break line if non-white characters beyond `fill-column'. |
"Break line if non-white characters beyond `fill-column'. |
1564 |
(defun f90-fill-region (beg-region end-region) |
(defun f90-fill-region (beg-region end-region) |
1565 |
"Fill every line in region by forward parsing. Join lines if possible." |
"Fill every line in region by forward parsing. Join lines if possible." |
1566 |
(interactive "*r") |
(interactive "*r") |
1567 |
(let ((end-region-mark (make-marker)) |
(let ((end-region-mark (copy-marker end-region)) |
1568 |
(go-on t) |
(go-on t) |
1569 |
f90-smart-end f90-auto-keyword-case auto-fill-function) |
f90-smart-end f90-auto-keyword-case auto-fill-function) |
|
(set-marker end-region-mark end-region) |
|
1570 |
(goto-char beg-region) |
(goto-char beg-region) |
1571 |
(while go-on |
(while go-on |
1572 |
;; Join as much as possible. |
;; Join as much as possible. |
1581 |
(move-to-column fill-column) |
(move-to-column fill-column) |
1582 |
(f90-find-breakpoint) |
(f90-find-breakpoint) |
1583 |
(f90-break-line 'no-update)) |
(f90-break-line 'no-update)) |
1584 |
(setq go-on (and (< (point) (marker-position end-region-mark)) |
(setq go-on (and (< (point) end-region-mark) |
1585 |
(zerop (forward-line 1))) |
(zerop (forward-line 1))) |
1586 |
f90-cache-position (point))) |
f90-cache-position (point))) |
1587 |
(setq f90-cache-position nil) |
(setq f90-cache-position nil) |
1588 |
|
(set-marker end-region-mark nil) |
1589 |
(if (fboundp 'zmacs-deactivate-region) |
(if (fboundp 'zmacs-deactivate-region) |
1590 |
(zmacs-deactivate-region) |
(zmacs-deactivate-region) |
1591 |
(deactivate-mark)))) |
(deactivate-mark)))) |
1599 |
Leave point at the end of line." |
Leave point at the end of line." |
1600 |
(search-forward "end" (line-end-position)) |
(search-forward "end" (line-end-position)) |
1601 |
(catch 'no-match |
(catch 'no-match |
1602 |
(if (not (f90-equal-symbols beg-block end-block)) |
(if (f90-equal-symbols beg-block end-block) |
1603 |
(if end-block |
(search-forward end-block) |
1604 |
(progn |
(if end-block |
1605 |
(message "END %s does not match %s." end-block beg-block) |
(progn |
1606 |
(end-of-line) |
(message "END %s does not match %s." end-block beg-block) |
1607 |
(throw 'no-match nil)) |
(end-of-line) |
1608 |
(message "Inserting %s." beg-block) |
(throw 'no-match nil)) |
1609 |
(insert (concat " " beg-block))) |
(message "Inserting %s." beg-block) |
1610 |
(search-forward end-block)) |
(insert (concat " " beg-block)))) |
1611 |
(if (not (f90-equal-symbols beg-name end-name)) |
(if (f90-equal-symbols beg-name end-name) |
1612 |
(cond ((and beg-name (not end-name)) |
(and end-name (search-forward end-name)) |
1613 |
(message "Inserting %s." beg-name) |
(cond ((and beg-name (not end-name)) |
1614 |
(insert (concat " " beg-name))) |
(message "Inserting %s." beg-name) |
1615 |
((and beg-name end-name) |
(insert (concat " " beg-name))) |
1616 |
(message "Replacing %s with %s." end-name beg-name) |
((and beg-name end-name) |
1617 |
(search-forward end-name) |
(message "Replacing %s with %s." end-name beg-name) |
1618 |
(replace-match beg-name)) |
(search-forward end-name) |
1619 |
((and (not beg-name) end-name) |
(replace-match beg-name)) |
1620 |
(message "Deleting %s." end-name) |
((and (not beg-name) end-name) |
1621 |
(search-forward end-name) |
(message "Deleting %s." end-name) |
1622 |
(replace-match ""))) |
(search-forward end-name) |
1623 |
(if end-name (search-forward end-name))) |
(replace-match "")))) |
1624 |
(if (not (looking-at "[ \t]*!")) (delete-horizontal-space)))) |
(or (looking-at "[ \t]*!") (delete-horizontal-space)))) |
1625 |
|
|
1626 |
(defun f90-match-end () |
(defun f90-match-end () |
1627 |
"From an end block statement, find the corresponding block and name." |
"From an end block statement, find the corresponding block and name." |
1628 |
(interactive) |
(interactive) |
1629 |
(let ((count 1) (top-of-window (window-start)) |
(let ((count 1) |
1630 |
(end-point (point)) (case-fold-search t) |
(top-of-window (window-start)) |
1631 |
|
(end-point (point)) |
1632 |
|
(case-fold-search t) |
1633 |
matching-beg beg-name end-name beg-block end-block end-struct) |
matching-beg beg-name end-name beg-block end-block end-struct) |
1634 |
(when (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") |
(when (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") |
1635 |
(setq end-struct (f90-looking-at-program-block-end))) |
(setq end-struct (f90-looking-at-program-block-end))) |
1639 |
(beginning-of-line) |
(beginning-of-line) |
1640 |
(while (and (> count 0) (re-search-backward f90-blocks-re nil t)) |
(while (and (> count 0) (re-search-backward f90-blocks-re nil t)) |
1641 |
(beginning-of-line) |
(beginning-of-line) |
1642 |
|
;; GM not a line number if continued line. |
1643 |
|
;;; (skip-chars-forward " \t") |
1644 |
|
;;; (skip-chars-forward "0-9") |
1645 |
(skip-chars-forward " \t0-9") |
(skip-chars-forward " \t0-9") |
1646 |
(cond ((or (f90-in-string) (f90-in-comment))) |
(cond ((or (f90-in-string) (f90-in-comment))) |
1647 |
((setq matching-beg |
((setq matching-beg |
1763 |
(unless (progn |
(unless (progn |
1764 |
(setq state (parse-partial-sexp ref-point (point))) |
(setq state (parse-partial-sexp ref-point (point))) |
1765 |
(or (nth 3 state) (nth 4 state) |
(or (nth 3 state) (nth 4 state) |
1766 |
|
;; GM f90-directive-comment-re? |
1767 |
(save-excursion ; check for cpp directive |
(save-excursion ; check for cpp directive |
1768 |
(beginning-of-line) |
(beginning-of-line) |
1769 |
(skip-chars-forward " \t0-9") |
(skip-chars-forward " \t0-9") |