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)))