X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/1af74d06e5bdafad9d629d2ed729c5d743cfaf0f..a3e44e793796153ff1534be9c74fcab50b45de30:/lisp/progmodes/f90.el diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index c7042fb1f6..111c12754e 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -1,7 +1,7 @@ ;;; f90.el --- Fortran-90 mode (free format) ;; Copyright (C) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007 Free Software Foundation, Inc. +;; 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. ;; Author: Torbj\"orn Einarsson ;; Maintainer: Glenn Morris @@ -9,10 +9,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -20,14 +20,13 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; Major mode for editing F90 programs in FREE FORMAT. ;; The minor language revision F95 is also supported (with font-locking). +;; Some/many (?) aspects of F2003 are supported. ;; Knows about continuation lines, named structured statements, and other ;; features in F90 including HPF (High Performance Fortran) structures. @@ -38,7 +37,6 @@ ;; To facilitate typing, a fairly complete list of abbreviations is provided. ;; All abbreviations begin with the backquote character "`" -;; (this requires modification of the syntax-table). ;; For example, `i expands to integer (if abbrev-mode is on). ;; There are two separate features for altering the appearance of code: @@ -105,7 +103,7 @@ ;; (f90-add-imenu-menu) ; extra menu with functions etc. ;; (if f90-auto-keyword-case ; change case of all keywords on startup ;; (f90-change-keywords f90-auto-keyword-case)) -;; )) +;; )) ;; ;; in your .emacs file. You can also customize the lists ;; f90-font-lock-keywords, etc. @@ -154,8 +152,14 @@ ;;; Code: ;; TODO -;; Support for align. -;; OpenMP, preprocessor highlighting. +;; 1. Any missing F2003 syntax? +;; 2. Have "f90-mode" just recognize F90 syntax, then derived modes +;; "f95-mode", "f2003-mode" for the language revisions. +;; 3. Support for align. +;; Font-locking: +;; 1. OpenMP, OpenMPI?, preprocessor highlighting. +;; 2. integer_name = 1 +;; 3. Labels for "else" statements (F2003)? (defvar comment-auto-fill-only-comments) (defvar font-lock-keywords) @@ -174,88 +178,113 @@ (defcustom f90-do-indent 3 - "*Extra indentation applied to DO blocks." + "Extra indentation applied to DO blocks." :type 'integer + :safe 'integerp :group 'f90-indent) (defcustom f90-if-indent 3 - "*Extra indentation applied to IF, SELECT CASE, WHERE and FORALL blocks." + "Extra indentation applied to IF, SELECT CASE, WHERE and FORALL blocks." :type 'integer + :safe 'integerp :group 'f90-indent) (defcustom f90-type-indent 3 - "*Extra indentation applied to TYPE, INTERFACE and BLOCK DATA blocks." + "Extra indentation applied to TYPE, ENUM, INTERFACE and BLOCK DATA blocks." :type 'integer + :safe 'integerp :group 'f90-indent) (defcustom f90-program-indent 2 - "*Extra indentation applied to PROGRAM, MODULE, SUBROUTINE, FUNCTION blocks." + "Extra indentation applied to PROGRAM, MODULE, SUBROUTINE, FUNCTION blocks." :type 'integer + :safe 'integerp :group 'f90-indent) +(defcustom f90-associate-indent 2 + "Extra indentation applied to ASSOCIATE blocks." + :type 'integer + :safe 'integerp + :group 'f90-indent + :version "23.1") + (defcustom f90-continuation-indent 5 - "*Extra indentation applied to continuation lines." + "Extra indentation applied to continuation lines." :type 'integer + :safe 'integerp :group 'f90-indent) (defcustom f90-comment-region "!!$" - "*String inserted by \\[f90-comment-region] at start of each line in region." + "String inserted by \\[f90-comment-region] at start of each line in region." :type 'string + :safe 'stringp :group 'f90-indent) (defcustom f90-indented-comment-re "!" - "*Regexp matching comments to indent as code." + "Regexp matching comments to indent as code." :type 'regexp + :safe 'stringp :group 'f90-indent) (defcustom f90-directive-comment-re "!hpf\\$" - "*Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented." + "Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented." :type 'regexp + :safe 'stringp :group 'f90-indent) (defcustom f90-beginning-ampersand t - "*Non-nil gives automatic insertion of \& at start of continuation line." + "Non-nil gives automatic insertion of \& at start of continuation line." :type 'boolean + :safe 'booleanp :group 'f90) (defcustom f90-smart-end 'blink - "*Qualification of END statements according to the matching block start. + "Qualification of END statements according to the matching block start. For example, the END that closes an IF block is changed to END IF. If the block has a label, this is added as well. Allowed values are 'blink, 'no-blink, and nil. If nil, nothing is done. The other two settings have the same effect, but 'blink additionally blinks the cursor to the start of the block." :type '(choice (const blink) (const no-blink) (const nil)) + :safe (lambda (value) (memq value '(blink no-blink nil))) :group 'f90) (defcustom f90-break-delimiters "[-+\\*/><=,% \t]" - "*Regexp matching delimiter characters at which lines may be broken. -There are certain tokens comprised entirely of characters -matching this regexp that should not be split, and these are -specified by the constant `f90-no-break-re'." - :type 'regexp + "Regexp matching delimiter characters at which lines may be broken. +There are some common two-character tokens where one or more of +the members matches this regexp. Although Fortran allows breaks +within lexical tokens (provided the next line has a beginning ampersand), +the constant `f90-no-break-re' ensures that such tokens are not split." + :type 'regexp + :safe 'stringp :group 'f90) (defcustom f90-break-before-delimiters t - "*Non-nil causes `f90-do-auto-fill' to break lines before delimiters." - :type 'boolean + "Non-nil causes `f90-do-auto-fill' to break lines before delimiters." + :type 'boolean + :safe 'booleanp :group 'f90) (defcustom f90-auto-keyword-case nil - "*Automatic case conversion of keywords. + "Automatic case conversion of keywords. The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil." :type '(choice (const downcase-word) (const upcase-word) (const capitalize-word) (const nil)) + :safe (lambda (value) (memq value '(downcase-word + capitalize-word upcase-word nil))) :group 'f90) (defcustom f90-leave-line-no nil - "*If non-nil, line numbers are not left justified." + "If non-nil, line numbers are not left justified." :type 'boolean + :safe 'booleanp :group 'f90) (defcustom f90-mode-hook nil "Hook run when entering F90 mode." :type 'hook + ;; Not the only safe options, but some common ones. + :safe (lambda (value) (member value '((f90-add-imenu-menu) nil))) :options '(f90-add-imenu-menu) :group 'f90) @@ -263,20 +292,26 @@ The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil." (defconst f90-keywords-re (regexp-opt '("allocatable" "allocate" "assign" "assignment" "backspace" - "block" "call" "case" "character" "close" "common" "complex" - "contains" "continue" "cycle" "data" "deallocate" - "dimension" "do" "double" "else" "elseif" "elsewhere" "end" - "enddo" "endfile" "endif" "entry" "equivalence" "exit" - "external" "forall" "format" "function" "goto" "if" - "implicit" "include" "inquire" "integer" "intent" - "interface" "intrinsic" "logical" "module" "namelist" "none" - "nullify" "only" "open" "operator" "optional" "parameter" - "pause" "pointer" "precision" "print" "private" "procedure" - "program" "public" "read" "real" "recursive" "result" "return" - "rewind" "save" "select" "sequence" "stop" "subroutine" - "target" "then" "type" "use" "where" "while" "write" - ;; F95 keywords. - "elemental" "pure") 'words) + "block" "call" "case" "character" "close" "common" "complex" + "contains" "continue" "cycle" "data" "deallocate" + "dimension" "do" "double" "else" "elseif" "elsewhere" "end" + "enddo" "endfile" "endif" "entry" "equivalence" "exit" + "external" "forall" "format" "function" "goto" "if" + "implicit" "include" "inquire" "integer" "intent" + "interface" "intrinsic" "logical" "module" "namelist" "none" + "nullify" "only" "open" "operator" "optional" "parameter" + "pause" "pointer" "precision" "print" "private" "procedure" + "program" "public" "read" "real" "recursive" "result" "return" + "rewind" "save" "select" "sequence" "stop" "subroutine" + "target" "then" "type" "use" "where" "while" "write" + ;; F95 keywords. + "elemental" "pure" + ;; F2003 + "abstract" "associate" "asynchronous" "bind" "class" + "deferred" "enum" "enumerator" "extends" "extends_type_of" + "final" "generic" "import" "non_intrinsic" "non_overridable" + "nopass" "pass" "protected" "same_type_as" "value" "volatile" + ) 'words) "Regexp used by the function `f90-change-keywords'.") (defconst f90-keywords-level-3-re @@ -284,11 +319,16 @@ The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil." '("allocatable" "allocate" "assign" "assignment" "backspace" "close" "deallocate" "dimension" "endfile" "entry" "equivalence" "external" "inquire" "intent" "intrinsic" "nullify" "only" "open" + ;; FIXME operator and assignment should be F2003 procedures? "operator" "optional" "parameter" "pause" "pointer" "print" "private" "public" "read" "recursive" "result" "rewind" "save" "select" "sequence" "target" "write" ;; F95 keywords. - "elemental" "pure") 'words) + "elemental" "pure" + ;; F2003. asynchronous separate. + "abstract" "deferred" "import" "final" "non_intrinsic" "non_overridable" + "nopass" "pass" "protected" "value" "volatile" + ) 'words) "Keyword-regexp for font-lock level >= 3.") (defconst f90-procedures-re @@ -314,7 +354,19 @@ The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil." "sum" "system_clock" "tan" "tanh" "tiny" "transfer" "transpose" "trim" "ubound" "unpack" "verify" ;; F95 intrinsic functions. - "null" "cpu_time") t) + "null" "cpu_time" + ;; F2003. + "move_alloc" "command_argument_count" "get_command" + "get_command_argument" "get_environment_variable" + "selected_char_kind" "wait" "flush" "new_line" + "extends" "extends_type_of" "same_type_as" "bind" + ;; F2003 ieee_arithmetic intrinsic module. + "ieee_support_underflow_control" "ieee_get_underflow_mode" + "ieee_set_underflow_mode" + ;; F2003 iso_c_binding intrinsic module. + "c_loc" "c_funloc" "c_associated" "c_f_pointer" + "c_f_procpointer" + ) t) ;; A left parenthesis to avoid highlighting non-procedures. "[ \t]*(") "Regexp whose first part matches F90 intrinsic procedures.") @@ -349,41 +401,174 @@ The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil." "block" "cyclic" "extrinsic" "new" "onto" "pure" "with") 'words) "Regexp for all HPF keywords, procedures and directives.") -;; Highlighting patterns. +(defconst f90-constants-re + (regexp-opt '( ;; F2003 iso_fortran_env constants. + "iso_fortran_env" + "input_unit" "output_unit" "error_unit" + "iostat_end" "iostat_eor" + "numeric_storage_size" "character_storage_size" + "file_storage_size" + ;; F2003 iso_c_binding constants. + "iso_c_binding" + "c_int" "c_short" "c_long" "c_long_long" "c_signed_char" + "c_size_t" + "c_int8_t" "c_int16_t" "c_int32_t" "c_int64_t" + "c_int_least8_t" "c_int_least16_t" "c_int_least32_t" + "c_int_least64_t" + "c_int_fast8_t" "c_int_fast16_t" "c_int_fast32_t" + "c_int_fast64_t" + "c_intmax_t" "c_intptr_t" + "c_float" "c_double" "c_long_double" + "c_float_complex" "c_double_complex" "c_long_double_complex" + "c_bool" "c_char" + "c_null_char" "c_alert" "c_backspace" "c_form_feed" + "c_new_line" "c_carriage_return" "c_horizontal_tab" + "c_vertical_tab" + "c_ptr" "c_funptr" "c_null_ptr" "c_null_funptr" + "ieee_exceptions" + "ieee_arithmetic" + "ieee_features" + ) 'words) + "Regexp for Fortran intrinsic constants.") + +;; cf f90-looking-at-type-like. +(defun f90-typedef-matcher (limit) + "Search for the start/end of the definition of a derived type, up to LIMIT. +Set the match data so that subexpression 1,2 are the TYPE, and +type-name parts, respectively." + (let (found l) + (while (and (re-search-forward "\\<\\(\\(?:end[ \t]*\\)?type\\)\\>[ \t]*" + limit t) + (not (setq found + (progn + (setq l (match-data)) + (unless (looking-at "\\(is\\>\\|(\\)") + (when (if (looking-at "\\(\\sw+\\)") + (goto-char (match-end 0)) + (re-search-forward + "[ \t]*::[ \t]*\\(\\sw+\\)" + (line-end-position) t)) + ;; 0 is wrong, but we don't use it. + (set-match-data + (append l (list (match-beginning 1) + (match-end 1)))) + t))))))) + found)) (defvar f90-font-lock-keywords-1 (list ;; Special highlighting of "module procedure". - '("\\<\\(module[ \t]*procedure\\)\\>" (1 font-lock-keyword-face)) + '("\\<\\(module[ \t]*procedure\\)\\>\\([^()\n]*::\\)?[ \t]*\\([^&!\n]*\\)" + (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t)) ;; Highlight definition of derived type. - '("\\<\\(\\(?:end[ \t]*\\)?type\\)\\>\\([^()\n]*::\\)?[ \t]*\\(\\sw+\\)" - (1 font-lock-keyword-face) (3 font-lock-function-name-face)) - ;; Other functions and declarations. - '("\\<\\(\\(?:end[ \t]*\\)?\\(program\\|module\\|function\\|\ -subroutine\\)\\|use\\|call\\)\\>[ \t]*\\(\\sw+\\)?" +;;; '("\\<\\(\\(?:end[ \t]*\\)?type\\)\\>\\([^()\n]*::\\)?[ \t]*\\(\\sw+\\)" +;;; (1 font-lock-keyword-face) (3 font-lock-function-name-face)) + '(f90-typedef-matcher + (1 font-lock-keyword-face) (2 font-lock-function-name-face)) + ;; F2003. Prevent operators being highlighted as functions. + '("\\<\\(\\(?:end[ \t]*\\)?interface[ \t]*\\(?:assignment\\|operator\\|\ +read\\|write\\)\\)[ \t]*(" (1 font-lock-keyword-face t)) + ;; Other functions and declarations. Named interfaces = F2003. + '("\\<\\(\\(?:end[ \t]*\\)?\\(program\\|module\\|function\\|associate\\|\ +subroutine\\|interface\\)\\|use\\|call\\)\\>[ \t]*\\(\\sw+\\)?" (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t)) - "\\<\\(\\(end[ \t]*\\)?\\(interface\\|block[ \t]*data\\)\\|contains\\)\\>") + ;; F2003. + '("\\<\\(use\\)[ \t]*,[ \t]*\\(\\(?:non_\\)?intrinsic\\)[ \t]*::[ \t]*\ +\\(\\sw+\\)" + (1 font-lock-keyword-face) (2 font-lock-keyword-face) + (3 font-lock-function-name-face)) + "\\<\\(\\(end[ \t]*\\)?block[ \t]*data\\|contains\\)\\>" + ;; "abstract interface" is F2003. + '("\\" (0 font-lock-keyword-face t))) "This does fairly subdued highlighting of comments and function calls.") +;; NB not explicitly handling this, yet it seems to work. +;; type(...) function foo() +(defun f90-typedec-matcher (limit) + "Search for the declaration of variables of derived type, up to LIMIT. +Set the match data so that subexpression 1,2 are the TYPE(...), +and variable-name parts, respectively." + ;; Matcher functions must return nil only when there are no more + ;; matches within the search range. + (let (found l) + (while (and (re-search-forward "\\<\\(type\\|class\\)[ \t]*(" limit t) + (not + (setq found + (condition-case nil + (progn + ;; Set l after this to just highlight + ;; the "type" part. + (backward-char 1) + ;; Needed for: type( foo(...) ) :: bar + (forward-sexp) + (setq l (list (match-beginning 0) (point))) + (skip-chars-forward " \t") + (when + (re-search-forward + ;; type (foo) bar, qux + (if (looking-at "\\sw+") + "\\([^&!\n]+\\)" + ;; type (foo), stuff :: bar, qux + "::[ \t]*\\([^&!\n]+\\)") + (line-end-position) t) + (set-match-data + (append (list (car l) (match-end 1)) + l (list (match-beginning 1) + (match-end 1)))) + t)) + (error nil)))))) + found)) + (defvar f90-font-lock-keywords-2 (append f90-font-lock-keywords-1 (list ;; Variable declarations (avoid the real function call). - '("^[ \t0-9]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\ -logical\\|double[ \t]*precision\\|*type[ \t]*(\\sw+)\\)\ + ;; NB by accident (?), this correctly fontifies the "integer" in: + ;; integer () function foo () + ;; because "() function foo ()" matches \\3. + ;; The "pure" part does not really belong here, but was added to + ;; exploit that hack. + ;; The "function foo" bit is correctly fontified by keywords-1. + ;; TODO ? actually check for balanced parens in that case. + '("^[ \t0-9]*\\(?:pure\\|elemental\\)?[ \t]*\ +\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\ +enumerator\\|generic\\|procedure\\|logical\\|double[ \t]*precision\\)\ \\(.*::\\|[ \t]*(.*)\\)?\\([^&!\n]*\\)" (1 font-lock-type-face t) (4 font-lock-variable-name-face t)) - ;; do, if, select, where, and forall constructs. - '("\\<\\(end[ \t]*\\(do\\|if\\|select\\|forall\\|where\\)\\)\\>\ + ;; Derived type/class variables. + ;; TODO ? If we just highlighted the "type" part, rather than + ;; "type(...)", this could be in the previous expression. And this + ;; would be consistent with integer( kind=8 ), etc. + '(f90-typedec-matcher + (1 font-lock-type-face) (2 font-lock-variable-name-face)) + ;; "real function foo (args)". Must override previous. Note hack + ;; to get "args" unhighlighted again. Might not always be right, + ;; but probably better than leaving them as variables. + ;; NB not explicitly handling this case: + ;; integer( kind=1 ) function foo() + ;; thanks to the happy accident described above. + ;; Not anchored, so don't need to worry about "pure" etc. + '("\\<\\(\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\ +logical\\|double[ \t]*precision\\|\ +\\(?:type\\|class\\)[ \t]*([ \t]*\\sw+[ \t]*)\\)[ \t]*\\)\ +\\(function\\)\\>[ \t]*\\(\\sw+\\)[ \t]*\\(([^&!\n]*)\\)" + (1 font-lock-type-face t) (4 font-lock-keyword-face t) + (5 font-lock-function-name-face t) (6 'default t)) + ;; enum (F2003; must be followed by ", bind(C)"). + '("\\<\\(enum\\)[ \t]*," (1 font-lock-keyword-face)) + ;; end do, enum (F2003), if, select, where, and forall constructs. + '("\\<\\(end[ \t]*\\(do\\|if\\|enum\\|select\\|forall\\|where\\)\\)\\>\ \\([ \t]+\\(\\sw+\\)\\)?" (1 font-lock-keyword-face) (3 font-lock-constant-face nil t)) '("^[ \t0-9]*\\(\\(\\sw+\\)[ \t]*:[ \t]*\\)?\\(\\(if\\|\ -do\\([ \t]*while\\)?\\|select[ \t]*case\\|where\\|forall\\)\\)\\>" +do\\([ \t]*while\\)?\\|select[ \t]*\\(?:case\\|type\\)\\|where\\|\ +forall\\)\\)\\>" (2 font-lock-constant-face nil t) (3 font-lock-keyword-face)) ;; Implicit declaration. '("\\<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\ -\\|logical\\|double[ \t]*precision\\|type[ \t]*(\\sw+)\\|none\\)[ \t]*" +\\|enumerator\\|procedure\\|\ +logical\\|double[ \t]*precision\\|type[ \t]*(\\sw+)\\|none\\)[ \t]*" (1 font-lock-keyword-face) (2 font-lock-type-face)) '("\\<\\(namelist\\|common\\)[ \t]*\/\\(\\sw+\\)?\/" (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) @@ -393,7 +578,11 @@ do\\([ \t]*while\\)?\\|select[ \t]*case\\|where\\|forall\\)\\)\\>" '("\\<\\(exit\\|cycle\\)[ \t]*\\(\\sw+\\)?\\>" (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) '("\\<\\(case\\)[ \t]*\\(default\\|(\\)" . 1) - '("\\<\\(do\\|go *to\\)\\>[ \t]*\\([0-9]+\\)" + ;; F2003 "class default". + '("\\<\\(class\\)[ \t]*default" . 1) + ;; F2003 "type is" in a "select type" block. + '("\\<\\(\\(type\\|class\\)[ \t]*is\\)[ \t]*(" (1 font-lock-keyword-face t)) + '("\\<\\(do\\|go[ \t]*to\\)\\>[ \t]*\\([0-9]+\\)" (1 font-lock-keyword-face) (2 font-lock-constant-face)) ;; Line numbers (lines whose first character after number is letter). '("^[ \t]*\\([0-9]+\\)[ \t]*[a-z]+" (1 font-lock-constant-face t)))) @@ -404,15 +593,19 @@ do\\([ \t]*while\\)?\\|select[ \t]*case\\|where\\|forall\\)\\)\\>" (list f90-keywords-level-3-re f90-operators-re + ;; FIXME why isn't this font-lock-builtin-face, which + ;; otherwise we hardly use, as in fortran.el? (list f90-procedures-re '(1 font-lock-keyword-face keep)) - "\\" ; avoid overwriting real defs - )) + "\\" ; avoid overwriting real defs + ;; As an attribute, but not as an optional argument. + '("\\<\\(asynchronous\\)[ \t]*[^=]" . 1))) "Highlights all F90 keywords and intrinsic procedures.") (defvar f90-font-lock-keywords-4 (append f90-font-lock-keywords-3 - (list f90-hpf-keywords-re)) - "Highlights all F90 and HPF keywords.") + (list (cons f90-constants-re 'font-lock-constant-face) + f90-hpf-keywords-re)) + "Highlights all F90 and HPF keywords and constants.") (defvar f90-font-lock-keywords f90-font-lock-keywords-2 @@ -424,17 +617,20 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") (let ((table (make-syntax-table))) (modify-syntax-entry ?\! "<" table) ; begin comment (modify-syntax-entry ?\n ">" table) ; end comment + ;; FIXME: This goes against the convention: it should be "_". (modify-syntax-entry ?_ "w" table) ; underscore in names (modify-syntax-entry ?\' "\"" table) ; string quote (modify-syntax-entry ?\" "\"" table) ; string quote - (modify-syntax-entry ?\` "w" table) ; for abbrevs + ;; FIXME: We used to set ` to word syntax for the benefit of abbrevs, but + ;; we do not need it any more. Not sure if it should be "_" or "." now. + (modify-syntax-entry ?\` "_" table) (modify-syntax-entry ?\r " " table) ; return is whitespace (modify-syntax-entry ?+ "." table) ; punctuation (modify-syntax-entry ?- "." table) (modify-syntax-entry ?= "." table) (modify-syntax-entry ?* "." table) (modify-syntax-entry ?/ "." table) - ;; I think that the f95 standard leaves the behaviour of \ + ;; I think that the f95 standard leaves the behavior of \ ;; unspecified, but that f2k will require it to be non-special. ;; Use `f90-backslash-not-special' to change. (modify-syntax-entry ?\\ "\\" table) ; escape chars @@ -452,7 +648,7 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") (define-key map "\C-\M-p" 'f90-beginning-of-block) (define-key map "\C-\M-q" 'f90-indent-subprogram) (define-key map "\C-j" 'f90-indent-new-line) ; LFD equals C-j - (define-key map "\r" 'newline) +;;; (define-key map "\r" 'newline) (define-key map "\C-c\r" 'f90-break-line) ;;; (define-key map [M-return] 'f90-break-line) (define-key map "\C-c\C-a" 'f90-previous-block) @@ -461,8 +657,10 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") (define-key map "\C-c\C-f" 'f90-fill-region) (define-key map "\C-c\C-p" 'f90-previous-statement) (define-key map "\C-c\C-n" 'f90-next-statement) + (define-key map "\C-c]" 'f90-insert-end) (define-key map "\C-c\C-w" 'f90-insert-end) - (define-key map "\t" 'f90-indent-line) + ;; Standard tab binding will call this, and also handle regions. +;;; (define-key map "\t" 'f90-indent-line) (define-key map "," 'f90-electric-insert) (define-key map "+" 'f90-electric-insert) (define-key map "-" 'f90-electric-insert) @@ -473,29 +671,44 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") `("F90" ("Customization" ,(custom-menu-create 'f90) - ["Set" Custom-set t] - ["Save" Custom-save t] - ["Reset to Current" Custom-reset-current t] - ["Reset to Saved" Custom-reset-saved t] - ["Reset to Standard Settings" Custom-reset-standard t] + ;; FIXME useless? + ["Set" Custom-set :active t + :help "Set current value of all edited settings in the buffer"] + ["Save" Custom-save :active t + :help "Set and save all edited settings"] + ["Reset to Current" Custom-reset-current :active t + :help "Reset all edited settings to current"] + ["Reset to Saved" Custom-reset-saved :active t + :help "Reset all edited or set settings to saved"] + ["Reset to Standard Settings" Custom-reset-standard :active t + :help "Erase all cusomizations in buffer"] ) "--" - ["Indent Subprogram" f90-indent-subprogram t] - ["Mark Subprogram" f90-mark-subprogram t] - ["Beginning of Subprogram" f90-beginning-of-subprogram t] - ["End of Subprogram" f90-end-of-subprogram t] + ["Indent Subprogram" f90-indent-subprogram t] + ["Mark Subprogram" f90-mark-subprogram :active t :help + "Mark the end of the current subprogram, move point to the start"] + ["Beginning of Subprogram" f90-beginning-of-subprogram :active t + :help "Move point to the start of the current subprogram"] + ["End of Subprogram" f90-end-of-subprogram :active t + :help "Move point to the end of the current subprogram"] "--" - ["(Un)Comment Region" f90-comment-region mark-active] - ["Indent Region" f90-indent-region mark-active] - ["Fill Region" f90-fill-region mark-active] + ["(Un)Comment Region" f90-comment-region :active mark-active + :help "Comment or uncomment the region"] + ["Indent Region" f90-indent-region :active mark-active] + ["Fill Region" f90-fill-region :active mark-active + :help "Fill long lines in the region"] "--" - ["Break Line at Point" f90-break-line t] - ["Join with Previous Line" f90-join-lines t] - ["Insert Block End" f90-insert-end t] + ["Break Line at Point" f90-break-line :active t + :help "Break the current line at point"] + ["Join with Previous Line" f90-join-lines :active t + :help "Join the current line to the previous one"] + ["Insert Block End" f90-insert-end :active t + :help "Insert an end statement for the current code block"] "--" ("Highlighting" + :help "Fontify this buffer to varying degrees" ["Toggle font-lock-mode" font-lock-mode :selected font-lock-mode - :style toggle] + :style toggle :help "Fontify text in this buffer"] "--" ["Light highlighting (level 1)" f90-font-lock-1 t] ["Moderate highlighting (level 2)" f90-font-lock-2 t] @@ -503,6 +716,7 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") ["Maximum highlighting (level 4)" f90-font-lock-4 t] ) ("Change Keyword Case" + :help "Change the case of keywords in the buffer or region" ["Upcase Keywords (buffer)" f90-upcase-keywords t] ["Capitalize Keywords (buffer)" f90-capitalize-keywords t] ["Downcase Keywords (buffer)" f90-downcase-keywords t] @@ -515,51 +729,54 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") mark-active] ) "--" - ["Toggle auto-fill" auto-fill-mode :selected auto-fill-function - :style toggle] - ["Toggle abbrev-mode" abbrev-mode :selected abbrev-mode - :style toggle] - ["Add imenu Menu" f90-add-imenu-menu + ["Toggle Auto Fill" auto-fill-mode :selected auto-fill-function + :style toggle + :help "Automatically fill text while typing in this buffer"] + ["Toggle Abbrev Mode" abbrev-mode :selected abbrev-mode + :style toggle :help "Expand abbreviations while typing in this buffer"] + ["Add Imenu Menu" f90-add-imenu-menu :active (not (lookup-key (current-local-map) [menu-bar index])) - :included (fboundp 'imenu-add-to-menubar)])) + :included (fboundp 'imenu-add-to-menubar) + :help "Add an index menu to the menu-bar" + ])) map) "Keymap used in F90 mode.") +(defun f90-font-lock-n (n) + "Set `font-lock-keywords' to F90 level N keywords." + (font-lock-mode 1) + (setq font-lock-keywords + (symbol-value (intern-soft (format "f90-font-lock-keywords-%d" n)))) + (font-lock-fontify-buffer)) + (defun f90-font-lock-1 () "Set `font-lock-keywords' to `f90-font-lock-keywords-1'." (interactive) - (font-lock-mode 1) - (setq font-lock-keywords f90-font-lock-keywords-1) - (font-lock-fontify-buffer)) + (f90-font-lock-n 1)) (defun f90-font-lock-2 () "Set `font-lock-keywords' to `f90-font-lock-keywords-2'." (interactive) - (font-lock-mode 1) - (setq font-lock-keywords f90-font-lock-keywords-2) - (font-lock-fontify-buffer)) + (f90-font-lock-n 2)) (defun f90-font-lock-3 () "Set `font-lock-keywords' to `f90-font-lock-keywords-3'." (interactive) - (font-lock-mode 1) - (setq font-lock-keywords f90-font-lock-keywords-3) - (font-lock-fontify-buffer)) + (f90-font-lock-n 3)) (defun f90-font-lock-4 () "Set `font-lock-keywords' to `f90-font-lock-keywords-4'." (interactive) - (font-lock-mode 1) - (setq font-lock-keywords f90-font-lock-keywords-4) - (font-lock-fontify-buffer)) - + (f90-font-lock-n 4)) ;; Regexps for finding program structures. (defconst f90-blocks-re (concat "\\(block[ \t]*data\\|" (regexp-opt '("do" "if" "interface" "function" "module" "program" - "select" "subroutine" "type" "where" "forall")) + "select" "subroutine" "type" "where" "forall" + ;; F2003. + "enum" "associate")) "\\)\\>") "Regexp potentially indicating a \"block\" of F90 code.") @@ -567,9 +784,11 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") (regexp-opt '("program" "module" "subroutine" "function") 'paren) "Regexp used to locate the start/end of a \"subprogram\".") +;; "class is" is F2003. (defconst f90-else-like-re - "\\(else\\([ \t]*if\\|where\\)?\\|case[ \t]*\\(default\\|(\\)\\)" - "Regexp matching an ELSE IF, ELSEWHERE, CASE statement.") + "\\(else\\([ \t]*if\\|where\\)?\\|case[ \t]*\\(default\\|(\\)\\|\ +\\(class\\|type\\)[ \t]*is[ \t]*(\\|class[ \t]*default\\)" + "Regexp matching an ELSE IF, ELSEWHERE, CASE, CLASS/TYPE IS statement.") (defconst f90-end-if-re (concat "end[ \t]*" @@ -578,20 +797,35 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") "Regexp matching the end of an IF, SELECT, WHERE, FORALL block.") (defconst f90-end-type-re - "end[ \t]*\\(type\\|interface\\|block[ \t]*data\\)\\>" - "Regexp matching the end of a TYPE, INTERFACE, BLOCK DATA section.") + "end[ \t]*\\(type\\|enum\\|interface\\|block[ \t]*data\\)\\>" + "Regexp matching the end of a TYPE, ENUM, INTERFACE, BLOCK DATA section.") +(defconst f90-end-associate-re + "end[ \t]*associate\\>" + "Regexp matching the end of an ASSOCIATE block.") + +;; This is for a TYPE block, not a variable of derived TYPE. +;; Hence no need to add CLASS for F2003. (defconst f90-type-def-re + ;; type word + ;; type :: word + ;; type, stuff :: word + ;; NOT "type (" "\\<\\(type\\)\\>\\(?:[^()\n]*::\\)?[ \t]*\\(\\sw+\\)" "Regexp matching the definition of a derived type.") +(defconst f90-typeis-re + "\\<\\(class\\|type\\)[ \t]*is[ \t]*(" + "Regexp matching a CLASS/TYPE IS statement.") + (defconst f90-no-break-re - (regexp-opt '("**" "//" "=>" ">=" "<=" "==" "/=") 'paren) - "Regexp specifying where not to break lines when filling. -This regexp matches certain tokens comprised entirely of -characters matching the regexp `f90-break-delimiters' that should -not be split by filling. Each element is assumed to be two -characters long.") + (regexp-opt '("**" "//" "=>" ">=" "<=" "==" "/=" "(/" "/)") 'paren) + "Regexp specifying two-character tokens not to split when breaking lines. +Each token has one or more of the characters from `f90-break-delimiters'. +Note that if only one of the characters is from that variable, +then the presence of the token here allows a line-break before or +after the other character, where a break would not normally be +allowed. This minor issue currently only affects \"(/\" and \"/)\".") (defvar f90-cache-position nil "Temporary position used to speed up region operations.") @@ -603,8 +837,8 @@ characters long.") (concat "^[ \t0-9]*\\") "Regexp matching the end of an F90 \"block\", from the line start. Used in the F90 entry in `hs-special-modes-alist'.") @@ -615,14 +849,24 @@ Used in the F90 entry in `hs-special-modes-alist'.") "^[ \t0-9]*" ; statement number "\\(\\(" "\\(\\sw+[ \t]*:[ \t]*\\)?" ; structure label - "\\(do\\|select[ \t]*case\\|" + "\\(do\\|select[ \t]*\\(case\\|type\\)\\|" ;; See comments in fortran-start-block-re for the problems of IF. "if[ \t]*(\\(.*\\|" ".*\n\\([^if]*\\([^i].\\|.[^f]\\|.\\>\\)\\)\\)\\\\|(\\)") + (or (looking-at "\\(\\sw+\\)") + (re-search-forward + "[ \t]*::[ \t]*\\(\\sw+\\)" + (line-end-position) t)))))))) + found)) + (defvar f90-imenu-generic-expression (let ((good-char "[^!\"\&\n \t]") (not-e "[^e!\n\"\& \t]") - (not-n "[^n!\n\"\& \t]") (not-d "[^d!\n\"\& \t]")) + (not-n "[^n!\n\"\& \t]") (not-d "[^d!\n\"\& \t]") + ;; (not-ib "[^i(!\n\"\& \t]") (not-s "[^s!\n\"\& \t]") + ) (list '(nil "^[ \t0-9]*program[ \t]+\\(\\sw+\\)" 1) '("Modules" "^[ \t0-9]*module[ \t]+\\(\\sw+\\)[ \t]*\\(!\\|$\\)" 1) - '("Types" "^[ \t0-9]*type[ \t]+\\(\\sw+\\)" 1) + (list "Types" 'f90-imenu-type-matcher 1) + ;; Does not handle: "type[, stuff] :: foo". +;;; (format "^[ \t0-9]*type[ \t]+\\(\\(%s\\|i%s\\|is\\sw\\)\\sw*\\)" +;;; not-ib not-s) +;;; 1) + ;; Can't get the subexpression numbers to match in the two branches. +;;; (format "^[ \t0-9]*type\\([ \t]*,.*\\(::\\)[ \t]*\\(\\sw+\\)\\|[ \t]+\\(\\(%s\\|i%s\\|is\\sw\\)\\sw*\\)\\)" not-ib not-s) +;;; 3) (list "Procedures" (concat @@ -673,81 +942,74 @@ Used in the F90 entry in `hs-special-modes-alist'.") ;; Abbrevs have generally two letters, except standard types `c, `i, `r, `t. -(defvar f90-mode-abbrev-table - (progn - (define-abbrev-table 'f90-mode-abbrev-table nil) - f90-mode-abbrev-table) - "Abbrev table for F90 mode.") - -(let (abbrevs-changed) - ;; Use the 6th arg (SYSTEM-FLAG) of define-abbrev if possible. - ;; A little baroque to quieten the byte-compiler. - (mapc - (function (lambda (element) - (condition-case nil - (apply 'define-abbrev f90-mode-abbrev-table - (append element '(nil 0 t))) - (wrong-number-of-arguments - (apply 'define-abbrev f90-mode-abbrev-table - (append element '(nil 0))))))) - '(("`al" "allocate" ) - ("`ab" "allocatable" ) - ("`as" "assignment" ) - ("`ba" "backspace" ) - ("`bd" "block data" ) - ("`c" "character" ) - ("`cl" "close" ) - ("`cm" "common" ) - ("`cx" "complex" ) - ("`cn" "contains" ) - ("`cy" "cycle" ) - ("`de" "deallocate" ) - ("`df" "define" ) - ("`di" "dimension" ) - ("`dp" "double precision") - ("`dw" "do while" ) - ("`el" "else" ) - ("`eli" "else if" ) - ("`elw" "elsewhere" ) - ("`eq" "equivalence" ) - ("`ex" "external" ) - ("`ey" "entry" ) - ("`fl" "forall" ) - ("`fo" "format" ) - ("`fu" "function" ) - ("`fa" ".false." ) - ("`im" "implicit none") - ("`in" "include" ) - ("`i" "integer" ) - ("`it" "intent" ) - ("`if" "interface" ) - ("`lo" "logical" ) - ("`mo" "module" ) - ("`na" "namelist" ) - ("`nu" "nullify" ) - ("`op" "optional" ) - ("`pa" "parameter" ) - ("`po" "pointer" ) - ("`pr" "print" ) - ("`pi" "private" ) - ("`pm" "program" ) - ("`pu" "public" ) - ("`r" "real" ) - ("`rc" "recursive" ) - ("`rt" "return" ) - ("`rw" "rewind" ) - ("`se" "select" ) - ("`sq" "sequence" ) - ("`su" "subroutine" ) - ("`ta" "target" ) - ("`tr" ".true." ) - ("`t" "type" ) - ("`wh" "where" ) - ("`wr" "write" )))) - +(define-abbrev-table 'f90-mode-abbrev-table + (mapcar (lambda (e) (list (car e) (cdr e) nil :system t)) + '(("`al" . "allocate" ) + ("`ab" . "allocatable" ) + ("`ai" . "abstract interface") + ("`as" . "assignment" ) + ("`asy" . "asynchronous" ) + ("`ba" . "backspace" ) + ("`bd" . "block data" ) + ("`c" . "character" ) + ("`cl" . "close" ) + ("`cm" . "common" ) + ("`cx" . "complex" ) + ("`cn" . "contains" ) + ("`cy" . "cycle" ) + ("`de" . "deallocate" ) + ("`df" . "define" ) + ("`di" . "dimension" ) + ("`dp" . "double precision") + ("`dw" . "do while" ) + ("`el" . "else" ) + ("`eli" . "else if" ) + ("`elw" . "elsewhere" ) + ("`em" . "elemental" ) + ("`e" . "enumerator" ) + ("`eq" . "equivalence" ) + ("`ex" . "external" ) + ("`ey" . "entry" ) + ("`fl" . "forall" ) + ("`fo" . "format" ) + ("`fu" . "function" ) + ("`fa" . ".false." ) + ("`im" . "implicit none") + ("`in" . "include" ) + ("`i" . "integer" ) + ("`it" . "intent" ) + ("`if" . "interface" ) + ("`lo" . "logical" ) + ("`mo" . "module" ) + ("`na" . "namelist" ) + ("`nu" . "nullify" ) + ("`op" . "optional" ) + ("`pa" . "parameter" ) + ("`po" . "pointer" ) + ("`pr" . "print" ) + ("`pi" . "private" ) + ("`pm" . "program" ) + ("`pr" . "protected" ) + ("`pu" . "public" ) + ("`r" . "real" ) + ("`rc" . "recursive" ) + ("`rt" . "return" ) + ("`rw" . "rewind" ) + ("`se" . "select" ) + ("`sq" . "sequence" ) + ("`su" . "subroutine" ) + ("`ta" . "target" ) + ("`tr" . ".true." ) + ("`t" . "type" ) + ("`vo" . "volatile" ) + ("`wh" . "where" ) + ("`wr" . "write" ))) + "Abbrev table for F90 mode." + ;; Accept ` as the first char of an abbrev. Also allow _ in abbrevs. + :regexp "\\(?:[^[:word:]_`]\\|^\\)\\(`?[[:word:]_]+\\)[^[:word:]_]*") ;;;###autoload -(defun f90-mode () +(define-derived-mode f90-mode prog-mode "F90" "Major mode for editing Fortran 90,95 code in free format. For fixed format code, use `fortran-mode'. @@ -767,9 +1029,9 @@ Variables controlling indentation style and extra features: `f90-do-indent' Extra indentation within do blocks (default 3). `f90-if-indent' - Extra indentation within if/select case/where/forall blocks (default 3). + Extra indentation within if/select/where/forall blocks (default 3). `f90-type-indent' - Extra indentation within type/interface/block-data blocks (default 3). + Extra indentation within type/enum/interface/block-data blocks (default 3). `f90-program-indent' Extra indentation within program/module/subroutine/function blocks (default 2). @@ -804,16 +1066,10 @@ Variables controlling indentation style and extra features: Turning on F90 mode calls the value of the variable `f90-mode-hook' with no args, if that value is non-nil." - (interactive) - (kill-all-local-variables) - (setq major-mode 'f90-mode - mode-name "F90" - local-abbrev-table f90-mode-abbrev-table) - (set-syntax-table f90-mode-syntax-table) - (use-local-map f90-mode-map) + :group 'f90 + :abbrev-table f90-mode-abbrev-table (set (make-local-variable 'indent-line-function) 'f90-indent-line) (set (make-local-variable 'indent-region-function) 'f90-indent-region) - (set (make-local-variable 'require-final-newline) mode-require-final-newline) (set (make-local-variable 'comment-start) "!") (set (make-local-variable 'comment-start-skip) "!+ *") (set (make-local-variable 'comment-indent-function) 'f90-comment-indent) @@ -833,8 +1089,7 @@ with no args, if that value is non-nil." 'f90-beginning-of-subprogram) (set (make-local-variable 'end-of-defun-function) 'f90-end-of-subprogram) (set (make-local-variable 'add-log-current-defun-function) - #'f90-current-defun) - (run-mode-hooks 'f90-mode-hook)) + #'f90-current-defun)) ;; Inline-functions. @@ -843,9 +1098,9 @@ with no args, if that value is non-nil." Checks from `point-min', or `f90-cache-position', if that is non-nil and lies before point." (let ((beg-pnt - (if (and f90-cache-position (> (point) f90-cache-position)) - f90-cache-position - (point-min)))) + (if (and f90-cache-position (> (point) f90-cache-position)) + f90-cache-position + (point-min)))) (nth 3 (parse-partial-sexp beg-pnt (point))))) (defsubst f90-in-comment () @@ -853,9 +1108,9 @@ and lies before point." Checks from `point-min', or `f90-cache-position', if that is non-nil and lies before point." (let ((beg-pnt - (if (and f90-cache-position (> (point) f90-cache-position)) - f90-cache-position - (point-min)))) + (if (and f90-cache-position (> (point) f90-cache-position)) + f90-cache-position + (point-min)))) (nth 4 (parse-partial-sexp beg-pnt (point))))) (defsubst f90-line-continued () @@ -921,10 +1176,10 @@ NAME is nil if the statement has no label." (list (match-string 3) (match-string 2)))) (defsubst f90-looking-at-select-case () - "Return (\"select\" NAME) if a select-case statement starts after point. + "Return (\"select\" NAME) if a select statement starts after point. NAME is nil if the statement has no label." (if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\ -\\(select\\)[ \t]*case[ \t]*(") +\\(select\\)[ \t]*\\(case\\|type\\)[ \t]*(") (list (match-string 3) (match-string 2)))) (defsubst f90-looking-at-if-then () @@ -944,6 +1199,12 @@ NAME is nil if the statement has no label." (looking-at "then\\>"))) (list struct label)))))) +;; FIXME label? +(defsubst f90-looking-at-associate () + "Return (\"associate\") if an associate block starts after point." + (if (looking-at "\\<\\(associate\\)[ \t]*(") + (list (match-string 1)))) + (defsubst f90-looking-at-where-or-forall () "Return (KIND NAME) if a where or forall block starts after point. NAME is nil if the statement has no label." @@ -958,12 +1219,31 @@ NAME is nil if the statement has no label." (if (looking-at "\\(!\\|$\\)") (list struct label)))))) (defsubst f90-looking-at-type-like () - "Return (KIND NAME) if a type/interface/block-data block starts after point. -NAME is non-nil only for type." + "Return (KIND NAME) if a type/enum/interface/block-data starts after point. +NAME is non-nil only for type and certain interfaces." (cond - ((looking-at f90-type-def-re) - (list (match-string 1) (match-string 2))) - ((looking-at "\\(interface\\|block[\t]*data\\)\\>") + ((save-excursion + (and (looking-at "\\[ \t]*") + (goto-char (match-end 0)) + (not (looking-at "\\(is\\>\\|(\\)")) + (or (looking-at "\\(\\sw+\\)") + (re-search-forward "[ \t]*::[ \t]*\\(\\sw+\\)" + (line-end-position) t)))) + (list "type" (match-string 1))) +;;; ((and (not (looking-at f90-typeis-re)) +;;; (looking-at f90-type-def-re)) +;;; (list (match-string 1) (match-string 2))) + ((looking-at "\\<\\(interface\\)\\>[ \t]*") + (list (match-string 1) + (save-excursion + (goto-char (match-end 0)) + (if (or (looking-at "\\(operator\\|assignment\\|read\\|\ +write\\)[ \t]*([^)\n]*)") + (looking-at "\\sw+")) + (match-string 0))))) + ((looking-at "\\(enum\\|block[ \t]*data\\)\\>") + (list (match-string 1) nil)) + ((looking-at "abstract[ \t]*\\(interface\\)\\>") (list (match-string 1) nil)))) (defsubst f90-looking-at-program-block-start () @@ -973,10 +1253,10 @@ NAME is non-nil only for type." ((looking-at "\\(program\\)[ \t]+\\(\\sw+\\)\\>") (list (match-string 1) (match-string 2))) ((and (not (looking-at "module[ \t]*procedure\\>")) - (looking-at "\\(module\\)[ \t]+\\(\\sw+\\)\\>")) + (looking-at "\\(module\\)[ \t]+\\(\\sw+\\)\\>")) (list (match-string 1) (match-string 2))) ((and (not (looking-at "end[ \t]*\\(function\\|subroutine\\)")) - (looking-at "[^!'\"\&\n]*\\(function\\|subroutine\\)[ \t]+\ + (looking-at "[^!'\"\&\n]*\\(function\\|subroutine\\)[ \t]+\ \\(\\sw+\\)")) (list (match-string 1) (match-string 2))))) ;; Following will match an un-named main program block; however @@ -989,9 +1269,12 @@ NAME is non-nil only for type." (defsubst f90-looking-at-program-block-end () "Return (KIND NAME) if a block with name NAME ends after point." - (if (looking-at (concat "end[ \t]*" f90-blocks-re - "?\\([ \t]+\\(\\sw+\\)\\)?\\>")) - (list (match-string 1) (match-string 3)))) + (cond ((looking-at "end[ \t]*\\(interface\\)[ \t]*\\(\ +\\(?:assignment\\|operator\\|read\\|write\\)[ \t]*([^)\n]*)\\)") + (list (match-string 1) (match-string 2))) + ((looking-at (concat "end[ \t]*" f90-blocks-re + "?\\([ \t]+\\(\\sw+\\)\\)?\\>")) + (list (match-string 1) (match-string 3))))) (defsubst f90-comment-indent () "Return the indentation to be used for a comment starting at point. @@ -1000,16 +1283,16 @@ Used for `comment-indent-function' by F90 mode. `f90-indented-comment-re' (if not trailing code) calls `f90-calculate-indent'. All others return `comment-column', leaving at least one space after code." (cond ((looking-at "!!!") 0) - ((and f90-directive-comment-re - (looking-at f90-directive-comment-re)) 0) - ((looking-at (regexp-quote f90-comment-region)) 0) - ((and (looking-at f90-indented-comment-re) - ;; Don't attempt to indent trailing comment as code. - (save-excursion - (skip-chars-backward " \t") - (bolp))) - (f90-calculate-indent)) - (t (save-excursion + ((and f90-directive-comment-re + (looking-at f90-directive-comment-re)) 0) + ((looking-at (regexp-quote f90-comment-region)) 0) + ((and (looking-at f90-indented-comment-re) + ;; Don't attempt to indent trailing comment as code. + (save-excursion + (skip-chars-backward " \t") + (bolp))) + (f90-calculate-indent)) + (t (save-excursion (skip-chars-backward " \t") (max (if (bolp) 0 (1+ (current-column))) comment-column))))) @@ -1026,10 +1309,10 @@ Comment lines embedded amongst continued lines return 'middle." (setq pcont (if (f90-previous-statement) (f90-line-continued)))) (setq cont (f90-line-continued)) (cond ((and (not pcont) (not cont)) 'single) - ((and (not pcont) cont) 'begin) - ((and pcont (not cont)) 'end) - ((and pcont cont) 'middle) - (t (error "The impossible occurred"))))) + ((and (not pcont) cont) 'begin) + ((and pcont (not cont)) 'end) + ((and pcont cont) 'middle) + (t (error "The impossible occurred"))))) (defsubst f90-indent-line-no () "If `f90-leave-line-no' is nil, left-justify a line number. @@ -1046,9 +1329,9 @@ if all else fails." (save-excursion (not (or (looking-at "end") (looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\ -\\|select[ \t]*case\\|case\\|where\\|forall\\)\\>") - (looking-at "\\(program\\|module\\|interface\\|\ -block[ \t]*data\\)\\>") +\\|select[ \t]*\\(case\\|type\\)\\|case\\|where\\|forall\\)\\>") + (looking-at "\\(program\\|module\\|\ +\\(?:abstract[ \t]*\\)?interface\\|block[ \t]*data\\)\\>") (looking-at "\\(contains\\|\\sw+[ \t]*:\\)") (looking-at f90-type-def-re) (re-search-forward "\\(function\\|subroutine\\)" @@ -1067,6 +1350,8 @@ block[ \t]*data\\)\\>") (if auto-fill-function (f90-do-auto-fill) ; also updates line (f90-update-line))) +;; Behave like self-insert-command for delete-selection-mode (bug#5593). +(put 'f90-electric-insert 'delete-selection t) (defun f90-get-correct-indent () "Get correct indent for a line starting with line number. @@ -1074,10 +1359,9 @@ Does not check type and subprogram indentation." (let ((epnt (line-end-position)) icol cont) (save-excursion (while (and (f90-previous-statement) - (or (progn - (setq cont (f90-present-statement-cont)) - (or (eq cont 'end) (eq cont 'middle))) - (looking-at "[ \t]*[0-9]")))) + (or (memq (setq cont (f90-present-statement-cont)) + '(middle end)) + (looking-at "[ \t]*[0-9]")))) (setq icol (current-indentation)) (beginning-of-line) (when (re-search-forward "\\(if\\|do\\|select\\|where\\|forall\\)" @@ -1089,23 +1373,29 @@ Does not check type and subprogram indentation." ((or (f90-looking-at-if-then) (f90-looking-at-where-or-forall) (f90-looking-at-select-case)) - (setq icol (+ icol f90-if-indent)))) + (setq icol (+ icol f90-if-indent))) + ((f90-looking-at-associate) + (setq icol (+ icol f90-associate-indent)))) (end-of-line)) (while (re-search-forward - "\\(if\\|do\\|select\\|where\\|forall\\)" epnt t) - (beginning-of-line) + "\\(if\\|do\\|select\\|where\\|forall\\)" epnt t) + (beginning-of-line) (skip-chars-forward " \t0-9") - (cond ((f90-looking-at-do) + (cond ((f90-looking-at-do) (setq icol (+ icol f90-do-indent))) ((or (f90-looking-at-if-then) (f90-looking-at-where-or-forall) (f90-looking-at-select-case)) (setq icol (+ icol f90-if-indent))) + ((f90-looking-at-associate) + (setq icol (+ icol f90-associate-indent))) ((looking-at f90-end-if-re) (setq icol (- icol f90-if-indent))) + ((looking-at f90-end-associate-re) + (setq icol (- icol f90-associate-indent))) ((looking-at "end[ \t]*do\\>") (setq icol (- icol f90-do-indent)))) - (end-of-line)) + (end-of-line)) icol))) (defun f90-calculate-indent () @@ -1116,7 +1406,7 @@ Does not check type and subprogram indentation." (if (not (f90-previous-statement)) ;; If f90-previous-statement returns nil, we must have been ;; called from on or before the first line of the first statement. - (setq icol (if (save-excursion + (setq icol (if (save-excursion ;; f90-previous-statement has moved us over ;; comment/blank lines, so we need to get ;; back to the first code statement. @@ -1127,48 +1417,51 @@ Does not check type and subprogram indentation." 0 ;; No explicit PROGRAM start statement. f90-program-indent)) - (setq cont (f90-present-statement-cont)) - (if (eq cont 'end) - (while (not (eq 'begin (f90-present-statement-cont))) - (f90-previous-statement))) - (cond ((eq cont 'begin) - (setq icol (+ (f90-current-indentation) - f90-continuation-indent))) - ((eq cont 'middle) (setq icol (current-indentation))) - (t (setq icol (f90-current-indentation)) - (skip-chars-forward " \t") - (if (looking-at "[0-9]") - (setq icol (f90-get-correct-indent)) - (cond ((or (f90-looking-at-if-then) - (f90-looking-at-where-or-forall) - (f90-looking-at-select-case) - (looking-at f90-else-like-re)) - (setq icol (+ icol f90-if-indent))) - ((f90-looking-at-do) - (setq icol (+ icol f90-do-indent))) - ((f90-looking-at-type-like) - (setq icol (+ icol f90-type-indent))) - ((or (f90-looking-at-program-block-start) - (looking-at "contains[ \t]*\\($\\|!\\)")) - (setq icol (+ icol f90-program-indent))))) - (goto-char pnt) - (beginning-of-line) - (cond ((looking-at "[ \t]*$")) - ((looking-at "[ \t]*#") ; check for cpp directive - (setq icol 0)) - (t - (skip-chars-forward " \t0-9") - (cond ((or (looking-at f90-else-like-re) - (looking-at f90-end-if-re)) - (setq icol (- icol f90-if-indent))) - ((looking-at "end[ \t]*do\\>") - (setq icol (- icol f90-do-indent))) - ((looking-at f90-end-type-re) - (setq icol (- icol f90-type-indent))) - ((or (looking-at "contains[ \t]*\\(!\\|$\\)") - (f90-looking-at-program-block-end)) - (setq icol (- icol f90-program-indent)))))) - )))) + (setq cont (f90-present-statement-cont)) + (if (eq cont 'end) + (while (not (eq 'begin (f90-present-statement-cont))) + (f90-previous-statement))) + (cond ((eq cont 'begin) + (setq icol (+ (f90-current-indentation) + f90-continuation-indent))) + ((eq cont 'middle) (setq icol (current-indentation))) + (t (setq icol (f90-current-indentation)) + (skip-chars-forward " \t") + (if (looking-at "[0-9]") + (setq icol (f90-get-correct-indent)) + (cond ((or (f90-looking-at-if-then) + (f90-looking-at-where-or-forall) + (f90-looking-at-select-case) + (looking-at f90-else-like-re)) + (setq icol (+ icol f90-if-indent))) + ((f90-looking-at-do) + (setq icol (+ icol f90-do-indent))) + ((f90-looking-at-type-like) + (setq icol (+ icol f90-type-indent))) + ((f90-looking-at-associate) + (setq icol (+ icol f90-associate-indent))) + ((or (f90-looking-at-program-block-start) + (looking-at "contains[ \t]*\\($\\|!\\)")) + (setq icol (+ icol f90-program-indent))))) + (goto-char pnt) + (beginning-of-line) + (cond ((looking-at "[ \t]*$")) + ((looking-at "[ \t]*#") ; check for cpp directive + (setq icol 0)) + (t + (skip-chars-forward " \t0-9") + (cond ((or (looking-at f90-else-like-re) + (looking-at f90-end-if-re)) + (setq icol (- icol f90-if-indent))) + ((looking-at "end[ \t]*do\\>") + (setq icol (- icol f90-do-indent))) + ((looking-at f90-end-type-re) + (setq icol (- icol f90-type-indent))) + ((looking-at f90-end-associate-re) + (setq icol (- icol f90-associate-indent))) + ((or (looking-at "contains[ \t]*\\(!\\|$\\)") + (f90-looking-at-program-block-end)) + (setq icol (- icol f90-program-indent)))))))))) icol)) (defun f90-previous-statement () @@ -1181,7 +1474,7 @@ comment." (let (not-first-statement) (beginning-of-line) (while (and (setq not-first-statement (zerop (forward-line -1))) - (looking-at "[ \t0-9]*\\(!\\|$\\|#\\)"))) + (looking-at "[ \t0-9]*\\(!\\|$\\|#\\)"))) not-first-statement)) (defun f90-next-statement () @@ -1191,9 +1484,9 @@ Return nil if no later statement is found." (let (not-last-statement) (beginning-of-line) (while (and (setq not-last-statement - (and (zerop (forward-line 1)) - (not (eobp)))) - (looking-at "[ \t0-9]*\\(!\\|$\\)"))) + (and (zerop (forward-line 1)) + (not (eobp)))) + (looking-at "[ \t0-9]*\\(!\\|$\\)"))) not-last-statement)) (defun f90-beginning-of-subprogram () @@ -1203,7 +1496,7 @@ Return (TYPE NAME), or nil if not found." (let ((count 1) (case-fold-search t) matching-beg) (beginning-of-line) (while (and (> count 0) - (re-search-backward f90-program-block-re nil 'move)) + (re-search-backward f90-program-block-re nil 'move)) (beginning-of-line) (skip-chars-forward " \t0-9") (cond ((setq matching-beg (f90-looking-at-program-block-start)) @@ -1212,10 +1505,11 @@ Return (TYPE NAME), or nil if not found." (setq count (1+ count))))) (beginning-of-line) (if (zerop count) - matching-beg + matching-beg ;; Note this includes the case of an un-named main program, ;; in which case we go to (point-min). - (message "No beginning found.") + (if (called-interactively-p 'interactive) + (message "No beginning found")) nil))) (defun f90-end-of-subprogram () @@ -1223,24 +1517,25 @@ Return (TYPE NAME), or nil if not found." Return (TYPE NAME), or nil if not found." (interactive) (let ((case-fold-search t) - (count 1) + (count 1) matching-end) (end-of-line) (while (and (> count 0) - (re-search-forward f90-program-block-re nil 'move)) + (re-search-forward f90-program-block-re nil 'move)) (beginning-of-line) (skip-chars-forward " \t0-9") (cond ((f90-looking-at-program-block-start) - (setq count (1+ count))) - ((setq matching-end (f90-looking-at-program-block-end)) - (setq count (1- count)))) + (setq count (1+ count))) + ((setq matching-end (f90-looking-at-program-block-end)) + (setq count (1- count)))) (end-of-line)) ;; This means f90-end-of-subprogram followed by f90-start-of-subprogram ;; has a net non-zero effect, which seems odd. ;;; (forward-line 1) (if (zerop count) - matching-end - (message "No end found.") + matching-end + (if (called-interactively-p 'interactive) + (message "No end found")) nil))) @@ -1252,7 +1547,8 @@ for consistency of block types and labels (if present), and completes outermost block if `f90-smart-end' is non-nil. Interactively, pushes mark before moving point." (interactive "p") - (if (interactive-p) (push-mark (point) t)) ; can move some distance + ;; Can move some distance. + (if (called-interactively-p 'any) (push-mark (point) t)) (and num (< num 0) (f90-beginning-of-block (- num))) (let ((f90-smart-end (if f90-smart-end 'no-blink)) ; for final match-end (case-fold-search t) @@ -1268,6 +1564,7 @@ Interactively, pushes mark before moving point." (f90-looking-at-do) (f90-looking-at-select-case) (f90-looking-at-type-like) + (f90-looking-at-associate) (f90-looking-at-program-block-start) (f90-looking-at-if-then) (f90-looking-at-where-or-forall))) @@ -1307,7 +1604,7 @@ Checks for consistency of block types and labels (if present). Does not check the outermost block, because it may be incomplete. Interactively, pushes mark before moving point." (interactive "p") - (if (interactive-p) (push-mark (point) t)) + (if (called-interactively-p 'any) (push-mark (point) t)) (and num (< num 0) (f90-end-of-block (- num))) (let ((case-fold-search t) (count (or num 1)) @@ -1328,6 +1625,7 @@ Interactively, pushes mark before moving point." (f90-looking-at-do) (f90-looking-at-select-case) (f90-looking-at-type-like) + (f90-looking-at-associate) (f90-looking-at-program-block-start) (f90-looking-at-if-then) (f90-looking-at-where-or-forall))) @@ -1368,6 +1666,7 @@ A block is a subroutine, if-endif, etc." (f90-looking-at-do) (f90-looking-at-select-case) (f90-looking-at-type-like) + (f90-looking-at-associate) (f90-looking-at-program-block-start) (f90-looking-at-if-then) (f90-looking-at-where-or-forall)) @@ -1393,7 +1692,7 @@ A block is a subroutine, if-endif, etc." (push-mark) (goto-char pos) (setq program (f90-beginning-of-subprogram)) - (if (fboundp 'zmacs-activate-region) + (if (featurep 'xemacs) (zmacs-activate-region) (setq mark-active t deactivate-mark nil)) @@ -1408,13 +1707,13 @@ in the region, or, if already present, remove it." (goto-char beg-region) (beginning-of-line) (if (looking-at (regexp-quote f90-comment-region)) - (delete-region (point) (match-end 0)) + (delete-region (point) (match-end 0)) (insert f90-comment-region)) (while (and (zerop (forward-line 1)) - (< (point) end)) + (< (point) end)) (if (looking-at (regexp-quote f90-comment-region)) - (delete-region (point) (match-end 0)) - (insert f90-comment-region))) + (delete-region (point) (match-end 0)) + (insert f90-comment-region))) (set-marker end nil))) (defun f90-indent-line (&optional no-update) @@ -1432,7 +1731,7 @@ after indenting." (setq no-line-number t) (skip-chars-forward " \t")) (if (looking-at "!") - (setq indent (f90-comment-indent)) + (setq indent (f90-comment-indent)) (and f90-smart-end (looking-at "end") (f90-match-end)) (setq indent (f90-calculate-indent))) @@ -1457,7 +1756,7 @@ If run in the middle of a line, the line is not broken." (beginning-of-line) ; reindent where likely to be needed (f90-indent-line) ; calls indent-line-no, update-line (end-of-line) - (delete-horizontal-space) ; destroy trailing whitespace + (delete-horizontal-space) ; destroy trailing whitespace (let ((string (f90-in-string)) (cont (f90-line-continued))) (and string (not cont) (insert "&")) @@ -1474,17 +1773,17 @@ If run in the middle of a line, the line is not broken." (let ((end-region-mark (copy-marker end-region)) (save-point (point-marker)) (case-fold-search t) - block-list ind-lev ind-curr ind-b cont struct beg-struct end-struct) + block-list ind-lev ind-curr ind-b cont struct beg-struct end-struct) (goto-char beg-region) ;; First find a line which is not a continuation line or comment. (beginning-of-line) (while (and (looking-at "[ \t]*[0-9]*\\(!\\|#\\|[ \t]*$\\)") - (progn (f90-indent-line 'no-update) - (zerop (forward-line 1))) - (< (point) end-region-mark))) + (progn (f90-indent-line 'no-update) + (zerop (forward-line 1))) + (< (point) end-region-mark))) (setq cont (f90-present-statement-cont)) - (while (and (or (eq cont 'middle) (eq cont 'end)) - (f90-previous-statement)) + (while (and (memq cont '(middle end)) + (f90-previous-statement)) (setq cont (f90-present-statement-cont))) ;; Process present line for beginning of block. (setq f90-cache-position (point)) @@ -1495,20 +1794,22 @@ If run in the middle of a line, the line is not broken." (skip-chars-forward " \t0-9") (setq struct nil ind-b (cond ((setq struct (f90-looking-at-do)) f90-do-indent) - ((or (setq struct (f90-looking-at-if-then)) - (setq struct (f90-looking-at-select-case)) - (setq struct (f90-looking-at-where-or-forall)) - (looking-at f90-else-like-re)) - f90-if-indent) - ((setq struct (f90-looking-at-type-like)) - f90-type-indent) - ((or (setq struct (f90-looking-at-program-block-start)) + ((or (setq struct (f90-looking-at-if-then)) + (setq struct (f90-looking-at-select-case)) + (setq struct (f90-looking-at-where-or-forall)) + (looking-at f90-else-like-re)) + f90-if-indent) + ((setq struct (f90-looking-at-type-like)) + f90-type-indent) + ((setq struct (f90-looking-at-associate)) + f90-associate-indent) + ((or (setq struct (f90-looking-at-program-block-start)) (looking-at "contains[ \t]*\\($\\|!\\)")) - f90-program-indent))) + f90-program-indent))) (if ind-b (setq ind-lev (+ ind-lev ind-b))) (if struct (setq block-list (cons struct block-list))) (while (and (f90-line-continued) (zerop (forward-line 1)) - (< (point) end-region-mark)) + (< (point) end-region-mark)) (if (looking-at "[ \t]*!") (f90-indent-to (f90-comment-indent)) (or (= (current-indentation) @@ -1520,47 +1821,51 @@ If run in the middle of a line, the line is not broken." (f90-indent-line-no) (setq f90-cache-position (point)) (cond ((looking-at "[ \t]*$") (setq ind-curr 0)) - ((looking-at "[ \t]*#") (setq ind-curr 0)) - ((looking-at "!") (setq ind-curr (f90-comment-indent))) - ((f90-no-block-limit) (setq ind-curr ind-lev)) - ((looking-at f90-else-like-re) (setq ind-curr - (- ind-lev f90-if-indent))) - ((looking-at "contains[ \t]*\\($\\|!\\)") - (setq ind-curr (- ind-lev f90-program-indent))) - ((setq ind-b - (cond ((setq struct (f90-looking-at-do)) f90-do-indent) - ((or (setq struct (f90-looking-at-if-then)) - (setq struct (f90-looking-at-select-case)) - (setq struct (f90-looking-at-where-or-forall))) - f90-if-indent) - ((setq struct (f90-looking-at-type-like)) - f90-type-indent) - ((setq struct (f90-looking-at-program-block-start)) - f90-program-indent))) - (setq ind-curr ind-lev) - (if ind-b (setq ind-lev (+ ind-lev ind-b))) - (setq block-list (cons struct block-list))) - ((setq end-struct (f90-looking-at-program-block-end)) - (setq beg-struct (car block-list) - block-list (cdr block-list)) - (if f90-smart-end - (save-excursion - (f90-block-match (car beg-struct) (car (cdr beg-struct)) - (car end-struct) (car (cdr end-struct))))) - (setq ind-b - (cond ((looking-at f90-end-if-re) f90-if-indent) - ((looking-at "end[ \t]*do\\>") f90-do-indent) - ((looking-at f90-end-type-re) f90-type-indent) - ((f90-looking-at-program-block-end) - f90-program-indent))) - (if ind-b (setq ind-lev (- ind-lev ind-b))) - (setq ind-curr ind-lev)) - (t (setq ind-curr ind-lev))) + ((looking-at "[ \t]*#") (setq ind-curr 0)) + ((looking-at "!") (setq ind-curr (f90-comment-indent))) + ((f90-no-block-limit) (setq ind-curr ind-lev)) + ((looking-at f90-else-like-re) (setq ind-curr + (- ind-lev f90-if-indent))) + ((looking-at "contains[ \t]*\\($\\|!\\)") + (setq ind-curr (- ind-lev f90-program-indent))) + ((setq ind-b + (cond ((setq struct (f90-looking-at-do)) f90-do-indent) + ((or (setq struct (f90-looking-at-if-then)) + (setq struct (f90-looking-at-select-case)) + (setq struct (f90-looking-at-where-or-forall))) + f90-if-indent) + ((setq struct (f90-looking-at-type-like)) + f90-type-indent) + ((setq struct (f90-looking-at-associate)) + f90-associate-indent) + ((setq struct (f90-looking-at-program-block-start)) + f90-program-indent))) + (setq ind-curr ind-lev) + (if ind-b (setq ind-lev (+ ind-lev ind-b))) + (setq block-list (cons struct block-list))) + ((setq end-struct (f90-looking-at-program-block-end)) + (setq beg-struct (car block-list) + block-list (cdr block-list)) + (if f90-smart-end + (save-excursion + (f90-block-match (car beg-struct) (cadr beg-struct) + (car end-struct) (cadr end-struct)))) + (setq ind-b + (cond ((looking-at f90-end-if-re) f90-if-indent) + ((looking-at "end[ \t]*do\\>") f90-do-indent) + ((looking-at f90-end-type-re) f90-type-indent) + ((looking-at f90-end-associate-re) + f90-associate-indent) + ((f90-looking-at-program-block-end) + f90-program-indent))) + (if ind-b (setq ind-lev (- ind-lev ind-b))) + (setq ind-curr ind-lev)) + (t (setq ind-curr ind-lev))) ;; Do the indentation if necessary. (or (= ind-curr (current-column)) - (f90-indent-to ind-curr)) + (f90-indent-to ind-curr)) (while (and (f90-line-continued) (zerop (forward-line 1)) - (< (point) end-region-mark)) + (< (point) end-region-mark)) (if (looking-at "[ \t]*!") (f90-indent-to (f90-comment-indent)) (or (= (current-indentation) @@ -1572,8 +1877,8 @@ If run in the middle of a line, the line is not broken." (goto-char save-point) (set-marker end-region-mark nil) (set-marker save-point nil) - (if (fboundp 'zmacs-deactivate-region) - (zmacs-deactivate-region) + (if (featurep 'xemacs) + (zmacs-deactivate-region) (deactivate-mark)))) (defun f90-indent-subprogram () @@ -1582,15 +1887,15 @@ If run in the middle of a line, the line is not broken." (save-excursion (let ((program (f90-mark-subprogram))) (if program - (progn - (message "Indenting %s %s..." - (car program) (car (cdr program))) - (indent-region (point) (mark) nil) - (message "Indenting %s %s...done" - (car program) (car (cdr program)))) - (message "Indenting the whole file...") - (indent-region (point) (mark) nil) - (message "Indenting the whole file...done"))))) + (progn + (message "Indenting %s %s..." + (car program) (cadr program)) + (indent-region (point) (mark) nil) + (message "Indenting %s %s...done" + (car program) (cadr program))) + (message "Indenting the whole file...") + (indent-region (point) (mark) nil) + (message "Indenting the whole file...done"))))) (defun f90-break-line (&optional no-update) "Break line at point, insert continuation marker(s) and indent. @@ -1605,6 +1910,8 @@ is non-nil, call `f90-update-line' after inserting the continuation marker." (t (insert "&") (or no-update (f90-update-line)) (newline 1) + ;; FIXME also need leading ampersand if split lexical token (eg ==). + ;; Or respect f90-no-break-re. (if f90-beginning-ampersand (insert "&")))) (indent-according-to-mode)) @@ -1662,7 +1969,7 @@ Like `join-line', but handles F90 syntax." (interactive "*r") (let ((end-region-mark (copy-marker end-region)) (go-on t) - f90-smart-end f90-auto-keyword-case auto-fill-function) + f90-smart-end f90-auto-keyword-case auto-fill-function) (goto-char beg-region) (while go-on ;; Join as much as possible. @@ -1673,17 +1980,17 @@ Like `join-line', but handles F90 syntax." (f90-join-lines 'forward)) ;; Chop the line if necessary. (while (> (save-excursion (end-of-line) (current-column)) - fill-column) - (move-to-column fill-column) - (f90-find-breakpoint) - (f90-break-line 'no-update)) + fill-column) + (move-to-column fill-column) + (f90-find-breakpoint) + (f90-break-line 'no-update)) (setq go-on (and (< (point) end-region-mark) (zerop (forward-line 1))) f90-cache-position (point))) (setq f90-cache-position nil) (set-marker end-region-mark nil) - (if (fboundp 'zmacs-deactivate-region) - (zmacs-deactivate-region) + (if (featurep 'xemacs) + (zmacs-deactivate-region) (deactivate-mark)))) (defun f90-block-match (beg-block beg-name end-block end-name) @@ -1728,13 +2035,13 @@ Leave point at the end of line." (interactive) (let ((count 1) (top-of-window (window-start)) - (end-point (point)) + (end-point (point)) (case-fold-search t) - matching-beg beg-name end-name beg-block end-block end-struct) + matching-beg beg-name end-name beg-block end-block end-struct) (when (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") (setq end-struct (f90-looking-at-program-block-end))) (setq end-block (car end-struct) - end-name (car (cdr end-struct))) + end-name (cadr end-struct)) (save-excursion (beginning-of-line) (while (and (> count 0) @@ -1753,6 +2060,7 @@ Leave point at the end of line." (f90-looking-at-where-or-forall) (f90-looking-at-select-case) (f90-looking-at-type-like) + (f90-looking-at-associate) (f90-looking-at-program-block-start) ;; Interpret a single END without a block ;; start to be the END of a program block @@ -1774,7 +2082,7 @@ Leave point at the end of line." (line-end-position))) (sit-for blink-matching-delay))) (setq beg-block (car matching-beg) - beg-name (car (cdr matching-beg))) + beg-name (cadr matching-beg)) (goto-char end-point) (beginning-of-line) (f90-block-match beg-block beg-name end-block end-name)))))) @@ -1792,17 +2100,17 @@ Leave point at the end of line." "Typing `\\[help-command] or `? lists all the F90 abbrevs. Any other key combination is executed normally." (interactive "*") - (insert last-command-char) + (insert last-command-event) (let (char event) (if (fboundp 'next-command-event) ; XEmacs (setq event (next-command-event) char (and (fboundp 'event-to-character) - (event-to-character event))) + (event-to-character event))) (setq event (read-event) char event)) ;; Insert char if not equal to `?', or if abbrev-mode is off. - (if (and abbrev-mode (or (eq char ??) (eq char help-char))) - (f90-abbrev-help) + (if (and abbrev-mode (memq char (list ?? help-char))) + (f90-abbrev-help) (setq unread-command-events (list event))))) (defun f90-abbrev-help () @@ -1814,8 +2122,7 @@ Any other key combination is executed normally." (defun f90-prepare-abbrev-list-buffer () "Create a buffer listing the F90 mode abbreviations." - (save-excursion - (set-buffer (get-buffer-create "*Abbrevs*")) + (with-current-buffer (get-buffer-create "*Abbrevs*") (erase-buffer) (insert-abbrev-table-description 'f90-mode-abbrev-table t) (goto-char (point-min)) @@ -1861,16 +2168,16 @@ CHANGE-WORD should be one of 'upcase-word, 'downcase-word, 'capitalize-word." (setq beg (or beg (point-min)) end (or end (point-max))) (let ((keyword-re - (concat "\\(" - f90-keywords-re "\\|" f90-procedures-re "\\|" - f90-hpf-keywords-re "\\|" f90-operators-re "\\)")) - (ref-point (point-min)) - (modified (buffer-modified-p)) + (concat "\\(" + f90-keywords-re "\\|" f90-procedures-re "\\|" + f90-hpf-keywords-re "\\|" f90-operators-re "\\)")) + (ref-point (point-min)) + (modified (buffer-modified-p)) state saveword back-point) (goto-char beg) (unwind-protect - (while (re-search-forward keyword-re end t) - (unless (progn + (while (re-search-forward keyword-re end t) + (unless (progn (setq state (parse-partial-sexp ref-point (point))) (or (nth 3 state) (nth 4 state) ;; GM f90-directive-comment-re? @@ -1878,13 +2185,13 @@ CHANGE-WORD should be one of 'upcase-word, 'downcase-word, 'capitalize-word." (beginning-of-line) (skip-chars-forward " \t0-9") (looking-at "#")))) - (setq ref-point (point) - back-point (save-excursion (backward-word 1) (point)) + (setq ref-point (point) + back-point (save-excursion (backward-word 1) (point)) saveword (buffer-substring back-point ref-point)) - (funcall change-word -1) - (or (string= saveword (buffer-substring back-point ref-point)) - (setq modified t)))) - (or modified (set-buffer-modified-p nil)))))) + (funcall change-word -1) + (or (string= saveword (buffer-substring back-point ref-point)) + (setq modified t)))) + (or modified (restore-buffer-modified-p nil)))))) (defun f90-current-defun () @@ -1898,7 +2205,7 @@ CHANGE-WORD should be one of 'upcase-word, 'downcase-word, 'capitalize-word." With optional argument ALL, change the default for all present and future F90 buffers. F90 mode normally treats backslash as an escape character." - (or (eq major-mode 'f90-mode) + (or (derived-mode-p 'f90-mode) (error "This function should only be used in F90 buffers")) (when (equal (char-syntax ?\\ ) ?\\ ) (or all (set-syntax-table (copy-syntax-table (syntax-table)))) @@ -1907,5 +2214,4 @@ escape character." (provide 'f90) -;;; arch-tag: fceac97c-c147-44bd-aec0-172d4b560ef8 ;;; f90.el ends here