Mercurial > emacs
comparison lisp/progmodes/f90.el @ 68723:d7669e5fe59f
Revert previous inadvertent check-in of local changes.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Wed, 08 Feb 2006 08:05:13 +0000 |
parents | 8daf7d9a0771 |
children | c46f00343034 4b3d39451150 |
comparison
equal
deleted
inserted
replaced
68722:e2188be06b26 | 68723:d7669e5fe59f |
---|---|
988 (defsubst f90-looking-at-program-block-end () | 988 (defsubst f90-looking-at-program-block-end () |
989 "Return (KIND NAME) if a block with name NAME ends after point." | 989 "Return (KIND NAME) if a block with name NAME ends after point." |
990 (if (looking-at (concat "end[ \t]*" f90-blocks-re | 990 (if (looking-at (concat "end[ \t]*" f90-blocks-re |
991 "?\\([ \t]+\\(\\sw+\\)\\)?\\>")) | 991 "?\\([ \t]+\\(\\sw+\\)\\)?\\>")) |
992 (list (match-string 1) (match-string 3)))) | 992 (list (match-string 1) (match-string 3)))) |
993 | |
994 (defsubst f90-looking-at-else-like () | |
995 "Return KIND if an ELSE or CASE statement starts after point. | |
996 Returns \"selectcase\", \"elseif\", \"elsewhere\", \"else\", or nil." | |
997 (when (looking-at f90-else-like-re) | |
998 (cond ((looking-at "case[ \t]*\\(default\\|\(\\)") | |
999 "selectcase") | |
1000 ((or (looking-at "else[ \t]*\\(if\\)\\>") | |
1001 (looking-at "else\\(where\\)?\\>")) | |
1002 (concat "else" (match-string 1)))))) | |
1003 | 993 |
1004 (defsubst f90-comment-indent () | 994 (defsubst f90-comment-indent () |
1005 "Return the indentation to be used for a comment starting at point. | 995 "Return the indentation to be used for a comment starting at point. |
1006 Used for `comment-indent-function' by F90 mode. | 996 Used for `comment-indent-function' by F90 mode. |
1007 \"!!!\", `f90-directive-comment-re', variable `f90-comment-region' return 0. | 997 \"!!!\", `f90-directive-comment-re', variable `f90-comment-region' return 0. |
1438 (f90-indent-line-no) | 1428 (f90-indent-line-no) |
1439 (setq no-line-number t) | 1429 (setq no-line-number t) |
1440 (skip-chars-forward " \t")) | 1430 (skip-chars-forward " \t")) |
1441 (if (looking-at "!") | 1431 (if (looking-at "!") |
1442 (setq indent (f90-comment-indent)) | 1432 (setq indent (f90-comment-indent)) |
1443 (and f90-smart-end (looking-at (concat "end\\|" f90-else-like-re)) | 1433 (and f90-smart-end (looking-at "end") |
1444 (f90-match-end)) | 1434 (f90-match-end)) |
1445 (setq indent (f90-calculate-indent))) | 1435 (setq indent (f90-calculate-indent))) |
1446 (or (= indent (current-column)) | 1436 (or (= indent (current-column)) |
1447 (f90-indent-to indent no-line-number)) | 1437 (f90-indent-to indent no-line-number)) |
1448 ;; If initial point was within line's indentation, | 1438 ;; If initial point was within line's indentation, |
1727 (message "Deleting %s." end-name) | 1717 (message "Deleting %s." end-name) |
1728 (search-forward end-name) | 1718 (search-forward end-name) |
1729 (replace-match "")))) | 1719 (replace-match "")))) |
1730 (or (looking-at "[ \t]*!") (delete-horizontal-space)))) | 1720 (or (looking-at "[ \t]*!") (delete-horizontal-space)))) |
1731 | 1721 |
1732 (defun f90-else-like-match (beg-block else-block) | |
1733 "Match else-struct with beg-struct and complete else-struct if possible. | |
1734 BEG-BLOCK is the type of block as indicated at the start (e.g., if). | |
1735 ELSE-BLOCK is the type of block as indicated at the else (may be nil)." | |
1736 (if (not (member beg-block '("if" "where" "select"))) | |
1737 (if beg-block | |
1738 (message "%s block cannot have a %s." beg-block else-block) | |
1739 (message "No beginning for %s." else-block)) | |
1740 (let ((else-type (cond | |
1741 ((string-equal else-block "selectcase") "select") | |
1742 ((string-match "else\\(if\\|where\\)" else-block) | |
1743 (match-string 1 else-block))))) | |
1744 (unless (f90-equal-symbols beg-block else-type) | |
1745 (if (or else-type | |
1746 (f90-equal-symbols beg-block "select")) | |
1747 (progn | |
1748 (message "%s does not match %s." else-block beg-block) | |
1749 (end-of-line)) | |
1750 (cond ((string-equal beg-block "where") | |
1751 (message "Inserting %s." beg-block) | |
1752 (search-forward "else" (line-end-position)) | |
1753 (insert beg-block)))))))) | |
1754 | |
1755 (defun f90-match-end () | 1722 (defun f90-match-end () |
1756 "From an end block statement, find the corresponding block and name." | 1723 "From an end block statement, find the corresponding block and name." |
1757 (interactive) | 1724 (interactive) |
1758 (let ((count 1) | 1725 (let ((count 1) |
1759 (top-of-window (window-start)) | 1726 (top-of-window (window-start)) |
1760 (end-point (point)) | 1727 (end-point (point)) |
1761 (case-fold-search t) | 1728 (case-fold-search t) |
1762 matching-beg beg-name beg-block end-struct else-struct) | 1729 matching-beg beg-name end-name beg-block end-block end-struct) |
1763 (when (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") | 1730 (when (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") |
1764 (or (setq end-struct | 1731 (setq end-struct (f90-looking-at-program-block-end))) |
1765 (f90-looking-at-program-block-end)) | 1732 (setq end-block (car end-struct) |
1766 (setq else-struct (f90-looking-at-else-like)))) | 1733 end-name (car (cdr end-struct))) |
1767 (save-excursion | 1734 (save-excursion |
1768 (beginning-of-line) | 1735 (beginning-of-line) |
1769 (while (and (> count 0) | 1736 (while (and (> count 0) |
1770 (not (= (line-beginning-position) (point-min)))) | 1737 (not (= (line-beginning-position) (point-min)))) |
1771 (re-search-backward f90-blocks-re nil 'move) | 1738 (re-search-backward f90-blocks-re nil 'move) |
1804 (sit-for blink-matching-delay))) | 1771 (sit-for blink-matching-delay))) |
1805 (setq beg-block (car matching-beg) | 1772 (setq beg-block (car matching-beg) |
1806 beg-name (car (cdr matching-beg))) | 1773 beg-name (car (cdr matching-beg))) |
1807 (goto-char end-point) | 1774 (goto-char end-point) |
1808 (beginning-of-line) | 1775 (beginning-of-line) |
1809 (if else-struct | 1776 (f90-block-match beg-block beg-name end-block end-name)))))) |
1810 (f90-else-like-match beg-block else-struct) | |
1811 (f90-block-match beg-block beg-name | |
1812 (car end-struct) (cadr end-struct)))))))) | |
1813 | 1777 |
1814 (defun f90-insert-end () | 1778 (defun f90-insert-end () |
1815 "Insert a complete end statement matching beginning of present block." | 1779 "Insert a complete end statement matching beginning of present block." |
1816 (interactive "*") | 1780 (interactive "*") |
1817 (let ((f90-smart-end (or f90-smart-end 'blink))) | 1781 (let ((f90-smart-end (or f90-smart-end 'blink))) |