Mercurial > emacs
comparison lisp/progmodes/f90.el @ 45076:fc0061967899
Again with the whitespace.
(f90-line-continued, f90-get-present-comment-type, f90-looking-at-if-then,
f90-indent-line, f90-indent-new-line, f90-indent-region,
f90-indent-subprogram, f90-do-auto-fill, f90-join-lines, f90-fill-region,
f90-match-end, f90-insert-end, f90-change-keywords): Minor code tidying.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Wed, 01 May 2002 23:34:58 +0000 |
parents | a770c1eeff8c |
children | bd2bdf90e286 |
comparison
equal
deleted
inserted
replaced
45075:2b5409461659 | 45076:fc0061967899 |
---|---|
685 ;; Abbrevs have generally two letters, except standard types `c, `i, `r, `t. | 685 ;; Abbrevs have generally two letters, except standard types `c, `i, `r, `t. |
686 (defvar f90-mode-abbrev-table nil) | 686 (defvar f90-mode-abbrev-table nil) |
687 (unless f90-mode-abbrev-table | 687 (unless f90-mode-abbrev-table |
688 (let ((ac abbrevs-changed)) | 688 (let ((ac abbrevs-changed)) |
689 (define-abbrev-table 'f90-mode-abbrev-table ()) | 689 (define-abbrev-table 'f90-mode-abbrev-table ()) |
690 (define-abbrev f90-mode-abbrev-table "`al" "allocate" nil 0 t) | 690 (define-abbrev f90-mode-abbrev-table "`al" "allocate" nil 0 t) |
691 (define-abbrev f90-mode-abbrev-table "`ab" "allocatable" nil 0 t) | 691 (define-abbrev f90-mode-abbrev-table "`ab" "allocatable" nil 0 t) |
692 (define-abbrev f90-mode-abbrev-table "`as" "assignment" nil 0 t) | 692 (define-abbrev f90-mode-abbrev-table "`as" "assignment" nil 0 t) |
693 (define-abbrev f90-mode-abbrev-table "`ba" "backspace" nil 0 t) | 693 (define-abbrev f90-mode-abbrev-table "`ba" "backspace" nil 0 t) |
694 (define-abbrev f90-mode-abbrev-table "`bd" "block data" nil 0 t) | 694 (define-abbrev f90-mode-abbrev-table "`bd" "block data" nil 0 t) |
695 (define-abbrev f90-mode-abbrev-table "`c" "character" nil 0 t) | 695 (define-abbrev f90-mode-abbrev-table "`c" "character" nil 0 t) |
696 (define-abbrev f90-mode-abbrev-table "`cl" "close" nil 0 t) | 696 (define-abbrev f90-mode-abbrev-table "`cl" "close" nil 0 t) |
697 (define-abbrev f90-mode-abbrev-table "`cm" "common" nil 0 t) | 697 (define-abbrev f90-mode-abbrev-table "`cm" "common" nil 0 t) |
698 (define-abbrev f90-mode-abbrev-table "`cx" "complex" nil 0 t) | 698 (define-abbrev f90-mode-abbrev-table "`cx" "complex" nil 0 t) |
699 (define-abbrev f90-mode-abbrev-table "`cn" "contains" nil 0 t) | 699 (define-abbrev f90-mode-abbrev-table "`cn" "contains" nil 0 t) |
700 (define-abbrev f90-mode-abbrev-table "`cy" "cycle" nil 0 t) | 700 (define-abbrev f90-mode-abbrev-table "`cy" "cycle" nil 0 t) |
701 (define-abbrev f90-mode-abbrev-table "`de" "deallocate" nil 0 t) | 701 (define-abbrev f90-mode-abbrev-table "`de" "deallocate" nil 0 t) |
702 (define-abbrev f90-mode-abbrev-table "`df" "define" nil 0 t) | 702 (define-abbrev f90-mode-abbrev-table "`df" "define" nil 0 t) |
703 (define-abbrev f90-mode-abbrev-table "`di" "dimension" nil 0 t) | 703 (define-abbrev f90-mode-abbrev-table "`di" "dimension" nil 0 t) |
704 (define-abbrev f90-mode-abbrev-table "`dw" "do while" nil 0 t) | 704 (define-abbrev f90-mode-abbrev-table "`dw" "do while" nil 0 t) |
705 (define-abbrev f90-mode-abbrev-table "`el" "else" nil 0 t) | 705 (define-abbrev f90-mode-abbrev-table "`el" "else" nil 0 t) |
706 (define-abbrev f90-mode-abbrev-table "`eli" "else if" nil 0 t) | 706 (define-abbrev f90-mode-abbrev-table "`eli" "else if" nil 0 t) |
707 (define-abbrev f90-mode-abbrev-table "`elw" "elsewhere" nil 0 t) | 707 (define-abbrev f90-mode-abbrev-table "`elw" "elsewhere" nil 0 t) |
708 (define-abbrev f90-mode-abbrev-table "`eq" "equivalence" nil 0 t) | 708 (define-abbrev f90-mode-abbrev-table "`eq" "equivalence" nil 0 t) |
709 (define-abbrev f90-mode-abbrev-table "`ex" "external" nil 0 t) | 709 (define-abbrev f90-mode-abbrev-table "`ex" "external" nil 0 t) |
710 (define-abbrev f90-mode-abbrev-table "`ey" "entry" nil 0 t) | 710 (define-abbrev f90-mode-abbrev-table "`ey" "entry" nil 0 t) |
711 (define-abbrev f90-mode-abbrev-table "`fl" "forall" nil 0 t) | 711 (define-abbrev f90-mode-abbrev-table "`fl" "forall" nil 0 t) |
712 (define-abbrev f90-mode-abbrev-table "`fo" "format" nil 0 t) | 712 (define-abbrev f90-mode-abbrev-table "`fo" "format" nil 0 t) |
713 (define-abbrev f90-mode-abbrev-table "`fu" "function" nil 0 t) | 713 (define-abbrev f90-mode-abbrev-table "`fu" "function" nil 0 t) |
714 (define-abbrev f90-mode-abbrev-table "`fa" ".false." nil 0 t) | 714 (define-abbrev f90-mode-abbrev-table "`fa" ".false." nil 0 t) |
715 (define-abbrev f90-mode-abbrev-table "`im" "implicit none" nil 0 t) | 715 (define-abbrev f90-mode-abbrev-table "`im" "implicit none" nil 0 t) |
716 (define-abbrev f90-mode-abbrev-table "`in " "include" nil 0 t) | 716 (define-abbrev f90-mode-abbrev-table "`in " "include" nil 0 t) |
717 (define-abbrev f90-mode-abbrev-table "`i" "integer" nil 0 t) | 717 (define-abbrev f90-mode-abbrev-table "`i" "integer" nil 0 t) |
718 (define-abbrev f90-mode-abbrev-table "`it" "intent" nil 0 t) | 718 (define-abbrev f90-mode-abbrev-table "`it" "intent" nil 0 t) |
719 (define-abbrev f90-mode-abbrev-table "`if" "interface" nil 0 t) | 719 (define-abbrev f90-mode-abbrev-table "`if" "interface" nil 0 t) |
720 (define-abbrev f90-mode-abbrev-table "`lo" "logical" nil 0 t) | 720 (define-abbrev f90-mode-abbrev-table "`lo" "logical" nil 0 t) |
721 (define-abbrev f90-mode-abbrev-table "`mo" "module" nil 0 t) | 721 (define-abbrev f90-mode-abbrev-table "`mo" "module" nil 0 t) |
722 (define-abbrev f90-mode-abbrev-table "`na" "namelist" nil 0 t) | 722 (define-abbrev f90-mode-abbrev-table "`na" "namelist" nil 0 t) |
723 (define-abbrev f90-mode-abbrev-table "`nu" "nullify" nil 0 t) | 723 (define-abbrev f90-mode-abbrev-table "`nu" "nullify" nil 0 t) |
724 (define-abbrev f90-mode-abbrev-table "`op" "optional" nil 0 t) | 724 (define-abbrev f90-mode-abbrev-table "`op" "optional" nil 0 t) |
725 (define-abbrev f90-mode-abbrev-table "`pa" "parameter" nil 0 t) | 725 (define-abbrev f90-mode-abbrev-table "`pa" "parameter" nil 0 t) |
726 (define-abbrev f90-mode-abbrev-table "`po" "pointer" nil 0 t) | 726 (define-abbrev f90-mode-abbrev-table "`po" "pointer" nil 0 t) |
727 (define-abbrev f90-mode-abbrev-table "`pr" "print" nil 0 t) | 727 (define-abbrev f90-mode-abbrev-table "`pr" "print" nil 0 t) |
728 (define-abbrev f90-mode-abbrev-table "`pi" "private" nil 0 t) | 728 (define-abbrev f90-mode-abbrev-table "`pi" "private" nil 0 t) |
729 (define-abbrev f90-mode-abbrev-table "`pm" "program" nil 0 t) | 729 (define-abbrev f90-mode-abbrev-table "`pm" "program" nil 0 t) |
730 (define-abbrev f90-mode-abbrev-table "`pu" "public" nil 0 t) | 730 (define-abbrev f90-mode-abbrev-table "`pu" "public" nil 0 t) |
731 (define-abbrev f90-mode-abbrev-table "`r" "real" nil 0 t) | 731 (define-abbrev f90-mode-abbrev-table "`r" "real" nil 0 t) |
732 (define-abbrev f90-mode-abbrev-table "`rc" "recursive" nil 0 t) | 732 (define-abbrev f90-mode-abbrev-table "`rc" "recursive" nil 0 t) |
733 (define-abbrev f90-mode-abbrev-table "`rt" "return" nil 0 t) | 733 (define-abbrev f90-mode-abbrev-table "`rt" "return" nil 0 t) |
734 (define-abbrev f90-mode-abbrev-table "`rw" "rewind" nil 0 t) | 734 (define-abbrev f90-mode-abbrev-table "`rw" "rewind" nil 0 t) |
735 (define-abbrev f90-mode-abbrev-table "`se" "select" nil 0 t) | 735 (define-abbrev f90-mode-abbrev-table "`se" "select" nil 0 t) |
736 (define-abbrev f90-mode-abbrev-table "`sq" "sequence" nil 0 t) | 736 (define-abbrev f90-mode-abbrev-table "`sq" "sequence" nil 0 t) |
737 (define-abbrev f90-mode-abbrev-table "`su" "subroutine" nil 0 t) | 737 (define-abbrev f90-mode-abbrev-table "`su" "subroutine" nil 0 t) |
738 (define-abbrev f90-mode-abbrev-table "`ta" "target" nil 0 t) | 738 (define-abbrev f90-mode-abbrev-table "`ta" "target" nil 0 t) |
739 (define-abbrev f90-mode-abbrev-table "`tr" ".true." nil 0 t) | 739 (define-abbrev f90-mode-abbrev-table "`tr" ".true." nil 0 t) |
740 (define-abbrev f90-mode-abbrev-table "`t" "type" nil 0 t) | 740 (define-abbrev f90-mode-abbrev-table "`t" "type" nil 0 t) |
741 (define-abbrev f90-mode-abbrev-table "`wh" "where" nil 0 t) | 741 (define-abbrev f90-mode-abbrev-table "`wh" "where" nil 0 t) |
742 (define-abbrev f90-mode-abbrev-table "`wr" "write" nil 0 t) | 742 (define-abbrev f90-mode-abbrev-table "`wr" "write" nil 0 t) |
743 (setq abbrevs-changed ac))) | 743 (setq abbrevs-changed ac))) |
744 | 744 |
745 (defcustom f90-mode-hook nil | 745 (defcustom f90-mode-hook nil |
746 "Hook run when entering F90 mode." | 746 "Hook run when entering F90 mode." |
747 :type 'hook | 747 :type 'hook |
775 Extra indentation within program/module/subroutine/function blocks | 775 Extra indentation within program/module/subroutine/function blocks |
776 (default 2). | 776 (default 2). |
777 `f90-continuation-indent' | 777 `f90-continuation-indent' |
778 Extra indentation applied to continuation lines (default 5). | 778 Extra indentation applied to continuation lines (default 5). |
779 `f90-comment-region' | 779 `f90-comment-region' |
780 String inserted by \\[f90-comment-region] at start of each line in | 780 String inserted by function \\[f90-comment-region] at start of each |
781 region (default \"!!!$\"). | 781 line in region (default \"!!!$\"). |
782 `f90-indented-comment-re' | 782 `f90-indented-comment-re' |
783 Regexp determining the type of comment to be intended like code | 783 Regexp determining the type of comment to be intended like code |
784 (default \"!\"). | 784 (default \"!\"). |
785 `f90-directive-comment-re' | 785 `f90-directive-comment-re' |
786 Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented | 786 Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented |
807 | 807 |
808 Turning on F90 mode calls the value of the variable `f90-mode-hook' | 808 Turning on F90 mode calls the value of the variable `f90-mode-hook' |
809 with no args, if that value is non-nil." | 809 with no args, if that value is non-nil." |
810 (interactive) | 810 (interactive) |
811 (kill-all-local-variables) | 811 (kill-all-local-variables) |
812 (setq major-mode 'f90-mode) | 812 (setq major-mode 'f90-mode |
813 (setq mode-name "F90") | 813 mode-name "F90" |
814 (setq local-abbrev-table f90-mode-abbrev-table) | 814 local-abbrev-table f90-mode-abbrev-table) |
815 (set-syntax-table f90-mode-syntax-table) | 815 (set-syntax-table f90-mode-syntax-table) |
816 (use-local-map f90-mode-map) | 816 (use-local-map f90-mode-map) |
817 (make-local-variable 'indent-line-function) | 817 (set (make-local-variable 'indent-line-function) 'f90-indent-line) |
818 (setq indent-line-function 'f90-indent-line) | 818 (set (make-local-variable 'indent-region-function) 'f90-indent-region) |
819 (make-local-variable 'indent-region-function) | 819 (set (make-local-variable 'require-final-newline) t) |
820 (setq indent-region-function 'f90-indent-region) | 820 (set (make-local-variable 'comment-start) "!") |
821 (make-local-variable 'require-final-newline) | 821 (set (make-local-variable 'comment-start-skip) "!+ *") |
822 (setq require-final-newline t) | 822 (set (make-local-variable 'comment-indent-function) 'f90-comment-indent) |
823 (make-local-variable 'comment-start) | 823 (set (make-local-variable 'abbrev-all-caps) t) |
824 (setq comment-start "!") | 824 (set (make-local-variable 'normal-auto-fill-function) 'f90-do-auto-fill) |
825 (make-local-variable 'comment-start-skip) | |
826 (setq comment-start-skip "!+ *") | |
827 (make-local-variable 'comment-indent-function) | |
828 (setq comment-indent-function 'f90-comment-indent) | |
829 (make-local-variable 'abbrev-all-caps) | |
830 (setq abbrev-all-caps t) | |
831 (make-local-variable 'normal-auto-fill-function) | |
832 (setq normal-auto-fill-function 'f90-do-auto-fill) | |
833 (setq indent-tabs-mode nil) | 825 (setq indent-tabs-mode nil) |
834 ;; Setting up things for font-lock. | 826 ;; Setting up things for font-lock. |
835 (when f90-xemacs-flag | 827 (when f90-xemacs-flag |
836 (put 'f90-mode 'font-lock-keywords-case-fold-search t) | 828 (put 'f90-mode 'font-lock-keywords-case-fold-search t) |
837 (when (and (featurep 'menubar) | 829 (when (and (featurep 'menubar) |
838 current-menubar | 830 current-menubar |
839 (not (assoc "F90" current-menubar))) | 831 (not (assoc "F90" current-menubar))) |
840 (set-buffer-menubar (copy-sequence current-menubar)) | 832 (set-buffer-menubar (copy-sequence current-menubar)) |
841 (add-submenu nil f90-xemacs-menu))) | 833 (add-submenu nil f90-xemacs-menu))) |
842 ;; XEmacs: Does not need a special case, since both emacsen work alike -sb. | 834 ;; XEmacs: Does not need a special case, since both emacsen work alike -sb. |
843 (make-local-variable 'font-lock-defaults) | 835 (set (make-local-variable 'font-lock-defaults) |
844 (setq font-lock-defaults | 836 '((f90-font-lock-keywords f90-font-lock-keywords-1 |
845 '((f90-font-lock-keywords f90-font-lock-keywords-1 | 837 f90-font-lock-keywords-2 |
846 f90-font-lock-keywords-2 | 838 f90-font-lock-keywords-3 |
847 f90-font-lock-keywords-3 | 839 f90-font-lock-keywords-4) |
848 f90-font-lock-keywords-4) | 840 nil t)) |
849 nil t)) | |
850 ;; Tell imenu how to handle f90. | 841 ;; Tell imenu how to handle f90. |
851 (set (make-local-variable 'imenu-case-fold-search) t) | 842 (set (make-local-variable 'imenu-case-fold-search) t) |
852 (make-local-variable 'imenu-generic-expression) | 843 (set (make-local-variable 'imenu-generic-expression) |
853 (setq imenu-generic-expression f90-imenu-generic-expression) | 844 f90-imenu-generic-expression) |
854 (set (make-local-variable 'add-log-current-defun-function) | 845 (set (make-local-variable 'add-log-current-defun-function) |
855 #'f90-current-defun) | 846 #'f90-current-defun) |
856 (run-hooks 'f90-mode-hook)) | 847 (run-hooks 'f90-mode-hook)) |
857 | 848 |
858 | 849 |
882 This includes comment lines embedded in continued lines, but | 873 This includes comment lines embedded in continued lines, but |
883 not the last line of a continued statement." | 874 not the last line of a continued statement." |
884 (save-excursion | 875 (save-excursion |
885 (beginning-of-line) | 876 (beginning-of-line) |
886 (while (and (looking-at "[ \t]*\\(!\\|$\\)") (zerop (forward-line -1)))) | 877 (while (and (looking-at "[ \t]*\\(!\\|$\\)") (zerop (forward-line -1)))) |
887 (let ((bol (line-beginning-position))) | 878 (end-of-line) |
888 (end-of-line) | 879 (while (f90-in-comment) |
889 (while (f90-in-comment) | 880 (search-backward "!" (line-beginning-position)) |
890 (search-backward "!" bol) | 881 (skip-chars-backward "!")) |
891 (skip-chars-backward "!")) | 882 (skip-chars-backward " \t") |
892 (skip-chars-backward " \t") | 883 (= (preceding-char) ?&))) |
893 (= (preceding-char) ?&)))) | |
894 | 884 |
895 (defsubst f90-current-indentation () | 885 (defsubst f90-current-indentation () |
896 "Return indentation of current line. | 886 "Return indentation of current line. |
897 Line-numbers are considered whitespace characters." | 887 Line-numbers are considered whitespace characters." |
898 (save-excursion | 888 (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9"))) |
899 (beginning-of-line) (skip-chars-forward " \t0-9"))) | |
900 | 889 |
901 (defsubst f90-indent-to (col &optional no-line-number) | 890 (defsubst f90-indent-to (col &optional no-line-number) |
902 "Indent current line to column COL. | 891 "Indent current line to column COL. |
903 If optional argument NO-LINE-NUMBER is nil, jump over a possible | 892 If optional argument NO-LINE-NUMBER is nil, jump over a possible |
904 line-number before indenting." | 893 line-number before indenting." |
912 | 901 |
913 (defsubst f90-get-present-comment-type () | 902 (defsubst f90-get-present-comment-type () |
914 "If point lies within a comment, return the string starting the comment. | 903 "If point lies within a comment, return the string starting the comment. |
915 For example, \"!\" or \"!!\"." | 904 For example, \"!\" or \"!!\"." |
916 (save-excursion | 905 (save-excursion |
917 (let ((type nil) (eol (line-end-position))) | 906 (when (f90-in-comment) |
918 (when (f90-in-comment) | 907 (beginning-of-line) |
919 (beginning-of-line) | 908 (re-search-forward "[!]+" (line-end-position)) |
920 (re-search-forward "[!]+" eol) | 909 (while (f90-in-string) |
921 (while (f90-in-string) | 910 (re-search-forward "[!]+" (line-end-position)) |
922 (re-search-forward "[!]+" eol)) | 911 (match-string 0))))) |
923 (setq type (match-string 0))) | |
924 type))) | |
925 | 912 |
926 (defsubst f90-equal-symbols (a b) | 913 (defsubst f90-equal-symbols (a b) |
927 "Compare strings A and B neglecting case and allowing for nil value." | 914 "Compare strings A and B neglecting case and allowing for nil value." |
928 (let ((a-local (if a (downcase a) nil)) | 915 (let ((a-local (if a (downcase a) nil)) |
929 (b-local (if b (downcase b) nil))) | 916 (b-local (if b (downcase b) nil))) |
954 | 941 |
955 (defsubst f90-looking-at-if-then () | 942 (defsubst f90-looking-at-if-then () |
956 "Return (\"if\" NAME) if an if () then statement starts after point. | 943 "Return (\"if\" NAME) if an if () then statement starts after point. |
957 NAME is nil if the statement has no label." | 944 NAME is nil if the statement has no label." |
958 (save-excursion | 945 (save-excursion |
959 (let (struct (label nil)) | 946 (when (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(if\\)\\>") |
960 (when (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(if\\)\\>") | 947 (let (label |
961 (setq struct (match-string 3)) | 948 (struct (match-string 3))) |
962 (if (looking-at "\\(\\sw+\\)[ \t]*\:") | 949 (if (looking-at "\\(\\sw+\\)[ \t]*\:") |
963 (setq label (match-string 1))) | 950 (setq label (match-string 1))) |
964 (let ((pos (scan-lists (point) 1 0))) | 951 (let ((pos (scan-lists (point) 1 0))) |
965 (and pos (goto-char pos))) | 952 (and pos (goto-char pos))) |
966 (skip-chars-forward " \t") | 953 (skip-chars-forward " \t") |
1037 end - current line is the last in a continued statement | 1024 end - current line is the last in a continued statement |
1038 middle - current line is neither first nor last in a continued statement. | 1025 middle - current line is neither first nor last in a continued statement. |
1039 Comment lines embedded amongst continued lines return 'middle." | 1026 Comment lines embedded amongst continued lines return 'middle." |
1040 (let (pcont cont) | 1027 (let (pcont cont) |
1041 (save-excursion | 1028 (save-excursion |
1042 (setq pcont (if (f90-previous-statement) (f90-line-continued) nil))) | 1029 (setq pcont (if (f90-previous-statement) (f90-line-continued)))) |
1043 (setq cont (f90-line-continued)) | 1030 (setq cont (f90-line-continued)) |
1044 (cond ((and (not pcont) (not cont)) 'single) | 1031 (cond ((and (not pcont) (not cont)) 'single) |
1045 ((and (not pcont) cont) 'begin) | 1032 ((and (not pcont) cont) 'begin) |
1046 ((and pcont (not cont)) 'end) | 1033 ((and pcont (not cont)) 'end) |
1047 ((and pcont cont) 'middle) | 1034 ((and pcont cont) 'middle) |
1048 (t (error))))) | 1035 (t (error "The impossible occurred"))))) |
1049 | 1036 |
1050 (defsubst f90-indent-line-no () | 1037 (defsubst f90-indent-line-no () |
1051 "If `f90-leave-line-no' is nil, left-justify a line number. | 1038 "If `f90-leave-line-no' is nil, left-justify a line number. |
1052 Leaves point at the first non-blank character after the line number. | 1039 Leaves point at the first non-blank character after the line number. |
1053 Call from beginning of line." | 1040 Call from beginning of line." |
1096 (looking-at "[ \t]*[0-9]")))) | 1083 (looking-at "[ \t]*[0-9]")))) |
1097 (setq icol (current-indentation)) | 1084 (setq icol (current-indentation)) |
1098 (beginning-of-line) | 1085 (beginning-of-line) |
1099 (when (re-search-forward "\\(if\\|do\\|select\\|where\\|forall\\)" | 1086 (when (re-search-forward "\\(if\\|do\\|select\\|where\\|forall\\)" |
1100 (line-end-position) t) | 1087 (line-end-position) t) |
1101 (beginning-of-line) (skip-chars-forward " \t") | 1088 (beginning-of-line) |
1089 (skip-chars-forward " \t") | |
1102 (cond ((f90-looking-at-do) | 1090 (cond ((f90-looking-at-do) |
1103 (setq icol (+ icol f90-do-indent))) | 1091 (setq icol (+ icol f90-do-indent))) |
1104 ((or (f90-looking-at-if-then) | 1092 ((or (f90-looking-at-if-then) |
1105 (f90-looking-at-where-or-forall) | 1093 (f90-looking-at-where-or-forall) |
1106 (f90-looking-at-select-case)) | 1094 (f90-looking-at-select-case)) |
1107 (setq icol (+ icol f90-if-indent)))) | 1095 (setq icol (+ icol f90-if-indent)))) |
1108 (end-of-line)) | 1096 (end-of-line)) |
1109 (while (re-search-forward | 1097 (while (re-search-forward |
1110 "\\(if\\|do\\|select\\|where\\|forall\\)" epnt t) | 1098 "\\(if\\|do\\|select\\|where\\|forall\\)" epnt t) |
1111 (beginning-of-line) (skip-chars-forward " \t0-9") | 1099 (beginning-of-line) |
1112 (cond ((f90-looking-at-do) | 1100 (skip-chars-forward " \t0-9") |
1113 (setq icol (+ icol f90-do-indent))) | 1101 (cond ((f90-looking-at-do) |
1114 ((or (f90-looking-at-if-then) | 1102 (setq icol (+ icol f90-do-indent))) |
1115 (f90-looking-at-where-or-forall) | 1103 ((or (f90-looking-at-if-then) |
1116 (f90-looking-at-select-case)) | 1104 (f90-looking-at-where-or-forall) |
1117 (setq icol (+ icol f90-if-indent))) | 1105 (f90-looking-at-select-case)) |
1118 ((looking-at f90-end-if-re) | 1106 (setq icol (+ icol f90-if-indent))) |
1119 (setq icol (- icol f90-if-indent))) | 1107 ((looking-at f90-end-if-re) |
1120 ((looking-at "end[ \t]*do\\>") | 1108 (setq icol (- icol f90-if-indent))) |
1121 (setq icol (- icol f90-do-indent)))) | 1109 ((looking-at "end[ \t]*do\\>") |
1110 (setq icol (- icol f90-do-indent)))) | |
1122 (end-of-line)) | 1111 (end-of-line)) |
1123 icol))) | 1112 icol))) |
1124 | 1113 |
1125 (defun f90-calculate-indent () | 1114 (defun f90-calculate-indent () |
1126 "Calculate the indent column based on previous statements." | 1115 "Calculate the indent column based on previous statements." |
1134 (while (not (eq 'begin (f90-present-statement-cont))) | 1123 (while (not (eq 'begin (f90-present-statement-cont))) |
1135 (f90-previous-statement))) | 1124 (f90-previous-statement))) |
1136 (cond ((eq cont 'begin) | 1125 (cond ((eq cont 'begin) |
1137 (setq icol (+ (f90-current-indentation) | 1126 (setq icol (+ (f90-current-indentation) |
1138 f90-continuation-indent))) | 1127 f90-continuation-indent))) |
1139 ((eq cont 'middle) (setq icol(current-indentation))) | 1128 ((eq cont 'middle) (setq icol (current-indentation))) |
1140 (t (setq icol (f90-current-indentation)) | 1129 (t (setq icol (f90-current-indentation)) |
1141 (skip-chars-forward " \t") | 1130 (skip-chars-forward " \t") |
1142 (if (looking-at "[0-9]") | 1131 (if (looking-at "[0-9]") |
1143 (setq icol (f90-get-correct-indent)) | 1132 (setq icol (f90-get-correct-indent)) |
1144 (cond ((or (f90-looking-at-if-then) | 1133 (cond ((or (f90-looking-at-if-then) |
1199 (defun f90-beginning-of-subprogram () | 1188 (defun f90-beginning-of-subprogram () |
1200 "Move point to the beginning of subprogram. | 1189 "Move point to the beginning of subprogram. |
1201 Return (TYPE NAME), or nil if not found." | 1190 Return (TYPE NAME), or nil if not found." |
1202 (interactive) | 1191 (interactive) |
1203 (let ((count 1) (case-fold-search t) matching-beg) | 1192 (let ((count 1) (case-fold-search t) matching-beg) |
1204 (beginning-of-line) (skip-chars-forward " \t0-9") | 1193 (beginning-of-line) |
1194 (skip-chars-forward " \t0-9") | |
1205 (if (setq matching-beg (f90-looking-at-program-block-start)) | 1195 (if (setq matching-beg (f90-looking-at-program-block-start)) |
1206 (setq count (- count 1))) | 1196 (setq count (1- count))) |
1207 (while (and (not (zerop count)) | 1197 (while (and (not (zerop count)) |
1208 (re-search-backward f90-program-block-re nil 'move)) | 1198 (re-search-backward f90-program-block-re nil 'move)) |
1209 (beginning-of-line) (skip-chars-forward " \t0-9") | 1199 (beginning-of-line) |
1210 (cond | 1200 (skip-chars-forward " \t0-9") |
1211 ((setq matching-beg (f90-looking-at-program-block-start)) | 1201 (cond ((setq matching-beg (f90-looking-at-program-block-start)) |
1212 (setq count (- count 1))) | 1202 (setq count (1- count))) |
1213 ((f90-looking-at-program-block-end) | 1203 ((f90-looking-at-program-block-end) |
1214 (setq count (+ count 1))))) | 1204 (setq count (1+ count))))) |
1215 (beginning-of-line) | 1205 (beginning-of-line) |
1216 (if (zerop count) | 1206 (if (zerop count) |
1217 matching-beg | 1207 matching-beg |
1218 (message "No beginning found.") | 1208 (message "No beginning found.") |
1219 nil))) | 1209 nil))) |
1221 (defun f90-end-of-subprogram () | 1211 (defun f90-end-of-subprogram () |
1222 "Move point to the end of subprogram. | 1212 "Move point to the end of subprogram. |
1223 Return (TYPE NAME), or nil if not found." | 1213 Return (TYPE NAME), or nil if not found." |
1224 (interactive) | 1214 (interactive) |
1225 (let ((count 1) (case-fold-search t) matching-end) | 1215 (let ((count 1) (case-fold-search t) matching-end) |
1226 (beginning-of-line) (skip-chars-forward " \t0-9") | 1216 (beginning-of-line) |
1217 (skip-chars-forward " \t0-9") | |
1227 (if (setq matching-end (f90-looking-at-program-block-end)) | 1218 (if (setq matching-end (f90-looking-at-program-block-end)) |
1228 (setq count (1- count))) | 1219 (setq count (1- count))) |
1229 (end-of-line) | 1220 (end-of-line) |
1230 (while (and (not (zerop count)) | 1221 (while (and (not (zerop count)) |
1231 (re-search-forward f90-program-block-re nil 'move)) | 1222 (re-search-forward f90-program-block-re nil 'move)) |
1232 (beginning-of-line) (skip-chars-forward " \t0-9") | 1223 (beginning-of-line) |
1224 (skip-chars-forward " \t0-9") | |
1233 (cond ((f90-looking-at-program-block-start) | 1225 (cond ((f90-looking-at-program-block-start) |
1234 (setq count (+ count 1))) | 1226 (setq count (1+ count))) |
1235 ((setq matching-end (f90-looking-at-program-block-end)) | 1227 ((setq matching-end (f90-looking-at-program-block-end)) |
1236 (setq count (1- count )))) | 1228 (setq count (1- count)))) |
1237 (end-of-line)) | 1229 (end-of-line)) |
1238 (forward-line 1) | 1230 (forward-line 1) |
1239 (if (zerop count) | 1231 (if (zerop count) |
1240 matching-end | 1232 matching-end |
1241 (message "No end found.") | 1233 (message "No end found.") |
1279 (goto-char beg-region) | 1271 (goto-char beg-region) |
1280 (beginning-of-line) | 1272 (beginning-of-line) |
1281 (if (looking-at (regexp-quote f90-comment-region)) | 1273 (if (looking-at (regexp-quote f90-comment-region)) |
1282 (delete-region (point) (match-end 0)) | 1274 (delete-region (point) (match-end 0)) |
1283 (insert f90-comment-region)) | 1275 (insert f90-comment-region)) |
1284 (while (and (zerop (forward-line 1)) | 1276 (while (and (zerop (forward-line 1)) |
1285 (< (point) (marker-position end))) | 1277 (< (point) (marker-position end))) |
1286 (if (looking-at (regexp-quote f90-comment-region)) | 1278 (if (looking-at (regexp-quote f90-comment-region)) |
1287 (delete-region (point) (match-end 0)) | 1279 (delete-region (point) (match-end 0)) |
1288 (insert f90-comment-region))) | 1280 (insert f90-comment-region))) |
1289 (set-marker end nil))) | 1281 (set-marker end nil))) |
1290 | 1282 |
1291 (defun f90-indent-line (&optional no-update) | 1283 (defun f90-indent-line (&optional no-update) |
1292 "Indent current line as F90 code. | 1284 "Indent current line as F90 code. |
1293 Unless optional argument NO-UPDATE is non-nil, call `f90-update-line' | 1285 Unless optional argument NO-UPDATE is non-nil, call `f90-update-line' |
1294 after indenting." | 1286 after indenting." |
1295 (interactive) | 1287 (interactive) |
1296 (let (indent (no-line-number nil) (pos (make-marker)) (case-fold-search t)) | 1288 (let (indent no-line-number (pos (make-marker)) (case-fold-search t)) |
1297 (set-marker pos (point)) | 1289 (set-marker pos (point)) |
1298 (beginning-of-line) ; digits after & \n are not line-nos | 1290 (beginning-of-line) ; digits after & \n are not line-nos |
1299 (if (save-excursion (and (f90-previous-statement) (f90-line-continued))) | 1291 (if (save-excursion (and (f90-previous-statement) (f90-line-continued))) |
1300 (progn (setq no-line-number t) (skip-chars-forward " \t")) | 1292 (progn (setq no-line-number t) (skip-chars-forward " \t")) |
1301 (f90-indent-line-no)) | 1293 (f90-indent-line-no)) |
1302 (if (looking-at "!") | 1294 (if (looking-at "!") |
1303 (setq indent (f90-comment-indent)) | 1295 (setq indent (f90-comment-indent)) |
1304 (if (and (looking-at "end") f90-smart-end) | 1296 (if (and (looking-at "end") f90-smart-end) |
1305 (f90-match-end)) | 1297 (f90-match-end)) |
1306 (setq indent (f90-calculate-indent))) | 1298 (setq indent (f90-calculate-indent))) |
1307 (if (zerop (- indent (current-column))) | 1299 (if (not (zerop (- indent (current-column)))) |
1308 nil | 1300 (f90-indent-to indent no-line-number)) |
1309 (f90-indent-to indent no-line-number)) | |
1310 ;; If initial point was within line's indentation, | 1301 ;; If initial point was within line's indentation, |
1311 ;; position after the indentation. Else stay at same point in text. | 1302 ;; position after the indentation. Else stay at same point in text. |
1312 (if (< (point) (marker-position pos)) | 1303 (if (< (point) (marker-position pos)) |
1313 (goto-char (marker-position pos))) | 1304 (goto-char (marker-position pos))) |
1314 (if auto-fill-function | 1305 (if auto-fill-function |
1326 (beginning-of-line) ; reindent where likely to be needed | 1317 (beginning-of-line) ; reindent where likely to be needed |
1327 (f90-indent-line-no) | 1318 (f90-indent-line-no) |
1328 (f90-indent-line 'no-update) | 1319 (f90-indent-line 'no-update) |
1329 (end-of-line) | 1320 (end-of-line) |
1330 (delete-horizontal-space) ; destroy trailing whitespace | 1321 (delete-horizontal-space) ; destroy trailing whitespace |
1331 (setq string (f90-in-string)) | 1322 (setq string (f90-in-string) |
1332 (setq cont (f90-line-continued)) | 1323 cont (f90-line-continued)) |
1333 (if (and string (not cont)) (insert "&")) | 1324 (if (and string (not cont)) (insert "&")) |
1334 (f90-update-line) | 1325 (f90-update-line) |
1335 (newline) | 1326 (newline) |
1336 (if (or string (and cont f90-beginning-ampersand)) (insert "&")) | 1327 (if (or string (and cont f90-beginning-ampersand)) (insert "&")) |
1337 (f90-indent-line 'no-update))) | 1328 (f90-indent-line 'no-update))) |
1338 | 1329 |
1339 | 1330 |
1340 (defun f90-indent-region (beg-region end-region) | 1331 (defun f90-indent-region (beg-region end-region) |
1341 "Indent every line in region by forward parsing." | 1332 "Indent every line in region by forward parsing." |
1342 (interactive "*r") | 1333 (interactive "*r") |
1343 (let ((end-region-mark (make-marker)) (save-point (point-marker)) | 1334 (let ((end-region-mark (make-marker)) |
1344 (block-list nil) ind-lev ind-curr ind-b cont | 1335 (save-point (point-marker)) |
1336 block-list ind-lev ind-curr ind-b cont | |
1345 struct beg-struct end-struct) | 1337 struct beg-struct end-struct) |
1346 (set-marker end-region-mark end-region) | 1338 (set-marker end-region-mark end-region) |
1347 (goto-char beg-region) | 1339 (goto-char beg-region) |
1348 ;; First find a line which is not a continuation line or comment. | 1340 ;; First find a line which is not a continuation line or comment. |
1349 (beginning-of-line) | 1341 (beginning-of-line) |
1356 (f90-previous-statement)) | 1348 (f90-previous-statement)) |
1357 (setq cont (f90-present-statement-cont))) | 1349 (setq cont (f90-present-statement-cont))) |
1358 ;; Process present line for beginning of block. | 1350 ;; Process present line for beginning of block. |
1359 (setq f90-cache-position (point)) | 1351 (setq f90-cache-position (point)) |
1360 (f90-indent-line 'no-update) | 1352 (f90-indent-line 'no-update) |
1361 (setq ind-lev (f90-current-indentation)) | 1353 (setq ind-lev (f90-current-indentation) |
1362 (setq ind-curr ind-lev) | 1354 ind-curr ind-lev) |
1363 (beginning-of-line) (skip-chars-forward " \t0-9") | 1355 (beginning-of-line) |
1364 (setq struct nil) | 1356 (skip-chars-forward " \t0-9") |
1365 (setq ind-b (cond ((setq struct (f90-looking-at-do)) f90-do-indent) | 1357 (setq struct nil |
1358 ind-b (cond ((setq struct (f90-looking-at-do)) f90-do-indent) | |
1366 ((or (setq struct (f90-looking-at-if-then)) | 1359 ((or (setq struct (f90-looking-at-if-then)) |
1367 (setq struct (f90-looking-at-select-case)) | 1360 (setq struct (f90-looking-at-select-case)) |
1368 (setq struct (f90-looking-at-where-or-forall)) | 1361 (setq struct (f90-looking-at-where-or-forall)) |
1369 (looking-at f90-else-like-re)) | 1362 (looking-at f90-else-like-re)) |
1370 f90-if-indent) | 1363 f90-if-indent) |
1446 | 1439 |
1447 (defun f90-indent-subprogram () | 1440 (defun f90-indent-subprogram () |
1448 "Properly indent the subprogram containing point." | 1441 "Properly indent the subprogram containing point." |
1449 (interactive) | 1442 (interactive) |
1450 (save-excursion | 1443 (save-excursion |
1451 (let (program) | 1444 (let ((program (f90-mark-subprogram))) |
1452 (setq program (f90-mark-subprogram)) | |
1453 (if program | 1445 (if program |
1454 (progn | 1446 (progn |
1455 (message "Indenting %s %s..." | 1447 (message "Indenting %s %s..." |
1456 (car program) (car (cdr program))) | 1448 (car program) (car (cdr program))) |
1457 (indent-region (point) (mark) nil) | 1449 (indent-region (point) (mark) nil) |
1500 ;; Will not break **, //, or => (as specified by f90-no-break-re). | 1492 ;; Will not break **, //, or => (as specified by f90-no-break-re). |
1501 (f90-update-line) | 1493 (f90-update-line) |
1502 (while (> (current-column) fill-column) | 1494 (while (> (current-column) fill-column) |
1503 (let ((pos-mark (point-marker))) | 1495 (let ((pos-mark (point-marker))) |
1504 (move-to-column fill-column) | 1496 (move-to-column fill-column) |
1505 (if (not (f90-in-string)) | 1497 (or (f90-in-string) (f90-find-breakpoint)) |
1506 (f90-find-breakpoint)) | |
1507 (f90-break-line) | 1498 (f90-break-line) |
1508 (goto-char pos-mark) | 1499 (goto-char pos-mark) |
1509 (set-marker pos-mark nil)))) | 1500 (set-marker pos-mark nil)))) |
1510 | 1501 |
1511 | 1502 |
1513 "Join present line with next line, if this line ends with \&." | 1504 "Join present line with next line, if this line ends with \&." |
1514 (interactive) | 1505 (interactive) |
1515 (let (pos (oldpos (point))) | 1506 (let (pos (oldpos (point))) |
1516 (end-of-line) | 1507 (end-of-line) |
1517 (skip-chars-backward " \t") | 1508 (skip-chars-backward " \t") |
1518 (cond ((= (preceding-char) ?&) | 1509 (when (= (preceding-char) ?&) |
1519 (delete-char -1) | 1510 (delete-char -1) |
1520 (setq pos (point)) | 1511 (setq pos (point)) |
1521 (forward-line 1) | 1512 (forward-line 1) |
1522 (skip-chars-forward " \t") | 1513 (skip-chars-forward " \t") |
1523 (if (looking-at "\&") (delete-char 1)) | 1514 (if (looking-at "\&") (delete-char 1)) |
1524 (delete-region pos (point)) | 1515 (delete-region pos (point)) |
1525 (unless (f90-in-string) | 1516 (unless (f90-in-string) |
1526 (delete-horizontal-space) | 1517 (delete-horizontal-space) |
1527 (insert " ")) | 1518 (insert " ")) |
1528 (if (and auto-fill-function | 1519 (if (and auto-fill-function |
1529 (> (save-excursion (end-of-line) | 1520 (> (line-end-position) fill-column)) |
1530 (current-column)) | 1521 (f90-do-auto-fill)) |
1531 fill-column)) | 1522 (goto-char oldpos) |
1532 (f90-do-auto-fill)) | 1523 t))) ; return t if joined something |
1533 (goto-char oldpos) | |
1534 t)))) | |
1535 | 1524 |
1536 (defun f90-fill-region (beg-region end-region) | 1525 (defun f90-fill-region (beg-region end-region) |
1537 "Fill every line in region by forward parsing. Join lines if possible." | 1526 "Fill every line in region by forward parsing. Join lines if possible." |
1538 (interactive "*r") | 1527 (interactive "*r") |
1539 (let ((end-region-mark (make-marker)) | 1528 (let ((end-region-mark (make-marker)) |
1540 (f90-smart-end nil) (f90-auto-keyword-case nil) (go-on t) | 1529 (go-on t) |
1541 (auto-fill-function nil)) | 1530 f90-smart-end f90-auto-keyword-case auto-fill-function) |
1542 (set-marker end-region-mark end-region) | 1531 (set-marker end-region-mark end-region) |
1543 (goto-char beg-region) | 1532 (goto-char beg-region) |
1544 (while go-on | 1533 (while go-on |
1545 ;; Join as much as possible. | 1534 ;; Join as much as possible. |
1546 (while (f90-join-lines)) | 1535 (while (f90-join-lines)) |
1548 (while (> (save-excursion (end-of-line) (current-column)) | 1537 (while (> (save-excursion (end-of-line) (current-column)) |
1549 fill-column) | 1538 fill-column) |
1550 (move-to-column fill-column) | 1539 (move-to-column fill-column) |
1551 (f90-find-breakpoint) | 1540 (f90-find-breakpoint) |
1552 (f90-break-line 'no-update)) | 1541 (f90-break-line 'no-update)) |
1553 (setq go-on (and (< (point) (marker-position end-region-mark)) | 1542 (setq go-on (and (< (point) (marker-position end-region-mark)) |
1554 (zerop (forward-line 1)))) | 1543 (zerop (forward-line 1))) |
1555 (setq f90-cache-position (point))) | 1544 f90-cache-position (point))) |
1556 (setq f90-cache-position nil) | 1545 (setq f90-cache-position nil) |
1557 (if f90-xemacs-flag | 1546 (if f90-xemacs-flag |
1558 (zmacs-deactivate-region) | 1547 (zmacs-deactivate-region) |
1559 (deactivate-mark)))) | 1548 (deactivate-mark)))) |
1560 | 1549 |
1592 (if (not (looking-at "[ \t]*!")) (delete-horizontal-space)))) | 1581 (if (not (looking-at "[ \t]*!")) (delete-horizontal-space)))) |
1593 | 1582 |
1594 (defun f90-match-end () | 1583 (defun f90-match-end () |
1595 "From an end block statement, find the corresponding block and name." | 1584 "From an end block statement, find the corresponding block and name." |
1596 (interactive) | 1585 (interactive) |
1597 (let ((count 1) (top-of-window (window-start)) (matching-beg nil) | 1586 (let ((count 1) (top-of-window (window-start)) |
1598 (end-point (point)) (case-fold-search t) | 1587 (end-point (point)) (case-fold-search t) |
1599 beg-name end-name beg-block end-block end-struct) | 1588 matching-beg beg-name end-name beg-block end-block end-struct) |
1600 (when (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") | 1589 (when (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") |
1601 (setq end-struct (f90-looking-at-program-block-end))) | 1590 (setq end-struct (f90-looking-at-program-block-end))) |
1602 (setq end-block (car end-struct)) | 1591 (setq end-block (car end-struct) |
1603 (setq end-name (car (cdr end-struct))) | 1592 end-name (car (cdr end-struct))) |
1604 (save-excursion | 1593 (save-excursion |
1605 (beginning-of-line) | 1594 (beginning-of-line) |
1606 (while | 1595 (while |
1607 (and (not (zerop count)) | 1596 (and (not (zerop count)) |
1608 (let ((stop nil) notexist) | 1597 (let ((stop nil) notexist) |
1614 (setq stop t) | 1603 (setq stop t) |
1615 (setq stop | 1604 (setq stop |
1616 (not (or (f90-in-string) | 1605 (not (or (f90-in-string) |
1617 (f90-in-comment)))))) | 1606 (f90-in-comment)))))) |
1618 (not notexist))) | 1607 (not notexist))) |
1619 (beginning-of-line) (skip-chars-forward " \t0-9") | 1608 (beginning-of-line) |
1609 (skip-chars-forward " \t0-9") | |
1620 (cond ((setq matching-beg | 1610 (cond ((setq matching-beg |
1621 (cond | 1611 (or |
1622 ((f90-looking-at-do)) | 1612 (f90-looking-at-do) |
1623 ((f90-looking-at-if-then)) | 1613 (f90-looking-at-if-then) |
1624 ((f90-looking-at-where-or-forall)) | 1614 (f90-looking-at-where-or-forall) |
1625 ((f90-looking-at-select-case)) | 1615 (f90-looking-at-select-case) |
1626 ((f90-looking-at-type-like)) | 1616 (f90-looking-at-type-like) |
1627 ((f90-looking-at-program-block-start)))) | 1617 (f90-looking-at-program-block-start))) |
1628 (setq count (- count 1))) | 1618 (setq count (1- count))) |
1629 ((looking-at (concat "end[ \t]*" f90-blocks-re "\\b")) | 1619 ((looking-at (concat "end[ \t]*" f90-blocks-re "\\b")) |
1630 (setq count (+ count 1))))) | 1620 (setq count (1+ count))))) |
1631 (if (not (zerop count)) | 1621 (if (not (zerop count)) |
1632 (message "No matching beginning.") | 1622 (message "No matching beginning.") |
1633 (f90-update-line) | 1623 (f90-update-line) |
1634 (if (eq f90-smart-end 'blink) | 1624 (if (eq f90-smart-end 'blink) |
1635 (if (< (point) top-of-window) | 1625 (if (< (point) top-of-window) |
1637 (what-line) | 1627 (what-line) |
1638 (buffer-substring | 1628 (buffer-substring |
1639 (line-beginning-position) | 1629 (line-beginning-position) |
1640 (line-end-position))) | 1630 (line-end-position))) |
1641 (sit-for 1))) | 1631 (sit-for 1))) |
1642 (setq beg-block (car matching-beg)) | 1632 (setq beg-block (car matching-beg) |
1643 (setq beg-name (car (cdr matching-beg))) | 1633 beg-name (car (cdr matching-beg))) |
1644 (goto-char end-point) | 1634 (goto-char end-point) |
1645 (beginning-of-line) | 1635 (beginning-of-line) |
1646 (f90-block-match beg-block beg-name end-block end-name)))))) | 1636 (f90-block-match beg-block beg-name end-block end-name)))))) |
1647 | 1637 |
1648 (defun f90-insert-end () | 1638 (defun f90-insert-end () |
1649 "Insert a complete end statement matching beginning of present block." | 1639 "Insert a complete end statement matching beginning of present block." |
1650 (interactive) | 1640 (interactive) |
1651 (let ((f90-smart-end (if f90-smart-end f90-smart-end 'blink))) | 1641 (let ((f90-smart-end (or f90-smart-end 'blink))) |
1652 (insert "end") | 1642 (insert "end") |
1653 (f90-indent-new-line))) | 1643 (f90-indent-new-line))) |
1654 | 1644 |
1655 ;; Abbrevs and keywords. | 1645 ;; Abbrevs and keywords. |
1656 | 1646 |
1722 ;; Change the keywords according to argument. | 1712 ;; Change the keywords according to argument. |
1723 (defun f90-change-keywords (change-word &optional beg end) | 1713 (defun f90-change-keywords (change-word &optional beg end) |
1724 "Change the case of F90 keywords in the region (if specified) or buffer. | 1714 "Change the case of F90 keywords in the region (if specified) or buffer. |
1725 CHANGE-WORD should be one of 'upcase-word, 'downcase-word, capitalize-word." | 1715 CHANGE-WORD should be one of 'upcase-word, 'downcase-word, capitalize-word." |
1726 (save-excursion | 1716 (save-excursion |
1727 (setq beg (if beg beg (point-min))) | 1717 (setq beg (or beg (point-min)) |
1728 (setq end (if end end (point-max))) | 1718 end (or end (point-max))) |
1729 (let ((keyword-re | 1719 (let ((keyword-re |
1730 (concat "\\(" | 1720 (concat "\\(" |
1731 f90-keywords-re "\\|" f90-procedures-re "\\|" | 1721 f90-keywords-re "\\|" f90-procedures-re "\\|" |
1732 f90-hpf-keywords-re "\\|" f90-operators-re "\\)")) | 1722 f90-hpf-keywords-re "\\|" f90-operators-re "\\)")) |
1733 (ref-point (point-min)) state | 1723 (ref-point (point-min)) |
1734 (modified (buffer-modified-p)) saveword back-point) | 1724 (modified (buffer-modified-p)) |
1725 state saveword back-point) | |
1735 (goto-char beg) | 1726 (goto-char beg) |
1736 (unwind-protect | 1727 (unwind-protect |
1737 (while (re-search-forward keyword-re end t) | 1728 (while (re-search-forward keyword-re end t) |
1738 (unless (progn | 1729 (unless (progn |
1739 (setq state (parse-partial-sexp ref-point (point))) | 1730 (setq state (parse-partial-sexp ref-point (point))) |
1741 (save-excursion ; check for cpp directive | 1732 (save-excursion ; check for cpp directive |
1742 (beginning-of-line) | 1733 (beginning-of-line) |
1743 (skip-chars-forward " \t0-9") | 1734 (skip-chars-forward " \t0-9") |
1744 (looking-at "#")))) | 1735 (looking-at "#")))) |
1745 (setq ref-point (point) | 1736 (setq ref-point (point) |
1746 back-point (save-excursion (backward-word 1) (point))) | 1737 back-point (save-excursion (backward-word 1) (point)) |
1747 (setq saveword (buffer-substring back-point ref-point)) | 1738 saveword (buffer-substring back-point ref-point)) |
1748 (funcall change-word -1) | 1739 (funcall change-word -1) |
1749 (or (string= saveword (buffer-substring back-point ref-point)) | 1740 (or (string= saveword (buffer-substring back-point ref-point)) |
1750 (setq modified t)))) | 1741 (setq modified t)))) |
1751 (or modified (set-buffer-modified-p nil)))))) | 1742 (or modified (set-buffer-modified-p nil)))))) |
1752 | 1743 |