Mercurial > emacs

comparison lisp/progmodes/f90.el @ 45076:fc0061967899

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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