+(defgroup f90 nil
+ "Major mode for editing free format Fortran 90,95 code."
+ :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
+ :group 'languages)
+
+(defgroup f90-indent nil
+ "Indentation in free format Fortran."
+ :prefix "f90-"
+ :group 'f90)
+
+
+(defcustom f90-do-indent 3
+ "*Extra indentation applied to DO blocks."
+ :type 'integer
+ :group 'f90-indent)
+
+(defcustom f90-if-indent 3
+ "*Extra indentation applied to IF, SELECT CASE, WHERE and FORALL blocks."
+ :type 'integer
+ :group 'f90-indent)
+
+(defcustom f90-type-indent 3
+ "*Extra indentation applied to TYPE, INTERFACE and BLOCK DATA blocks."
+ :type 'integer
+ :group 'f90-indent)
+
+(defcustom f90-program-indent 2
+ "*Extra indentation applied to PROGRAM, MODULE, SUBROUTINE, FUNCTION blocks."
+ :type 'integer
+ :group 'f90-indent)
+
+(defcustom f90-continuation-indent 5
+ "*Extra indentation applied to continuation lines."
+ :type 'integer
+ :group 'f90-indent)
+
+(defcustom f90-comment-region "!!$"
+ "*String inserted by \\[f90-comment-region] at start of each line in region."
+ :type 'string
+ :group 'f90-indent)
+
+(defcustom f90-indented-comment-re "!"
+ "*Regexp matching comments to indent as code."
+ :type 'regexp
+ :group 'f90-indent)
+
+(defcustom f90-directive-comment-re "!hpf\\$"
+ "*Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented."
+ :type 'regexp
+ :group 'f90-indent)
+
+(defcustom f90-beginning-ampersand t
+ "*Non-nil gives automatic insertion of \& at start of continuation line."
+ :type 'boolean
+ :group 'f90)
+
+(defcustom f90-smart-end 'blink
+ "*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))
+ :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
+ :group 'f90)
+
+(defcustom f90-break-before-delimiters t
+ "*Non-nil causes `f90-do-auto-fill' to break lines before delimiters."
+ :type 'boolean
+ :group 'f90)
+
+(defcustom f90-auto-keyword-case nil
+ "*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))
+ :group 'f90)
+
+(defcustom f90-leave-line-no nil
+ "*If non-nil, line numbers are not left justified."
+ :type 'boolean
+ :group 'f90)
+
+(defcustom f90-mode-hook nil
+ "Hook run when entering F90 mode."
+ :type 'hook
+ :options '(f90-add-imenu-menu)
+ :group 'f90)
+
+;; User options end here.
+
+(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)
+ "Regexp used by the function `f90-change-keywords'.")
+
+(defconst f90-keywords-level-3-re
+ (regexp-opt
+ '("allocatable" "allocate" "assign" "assignment" "backspace"
+ "close" "deallocate" "dimension" "endfile" "entry" "equivalence"
+ "external" "inquire" "intent" "intrinsic" "nullify" "only" "open"
+ "operator" "optional" "parameter" "pause" "pointer" "print" "private"
+ "public" "read" "recursive" "result" "rewind" "save" "select"
+ "sequence" "target" "write"
+ ;; F95 keywords.
+ "elemental" "pure") 'words)
+ "Keyword-regexp for font-lock level >= 3.")
+
+(defconst f90-procedures-re
+ (concat "\\<"
+ (regexp-opt
+ '("abs" "achar" "acos" "adjustl" "adjustr" "aimag" "aint"
+ "all" "allocated" "anint" "any" "asin" "associated"
+ "atan" "atan2" "bit_size" "btest" "ceiling" "char" "cmplx"
+ "conjg" "cos" "cosh" "count" "cshift" "date_and_time" "dble"
+ "digits" "dim" "dot_product" "dprod" "eoshift" "epsilon"
+ "exp" "exponent" "floor" "fraction" "huge" "iachar" "iand"
+ "ibclr" "ibits" "ibset" "ichar" "ieor" "index" "int" "ior"
+ "ishft" "ishftc" "kind" "lbound" "len" "len_trim" "lge" "lgt"
+ "lle" "llt" "log" "log10" "logical" "matmul" "max"
+ "maxexponent" "maxloc" "maxval" "merge" "min" "minexponent"
+ "minloc" "minval" "mod" "modulo" "mvbits" "nearest" "nint"
+ "not" "pack" "precision" "present" "product" "radix"
+ ;; Real is taken out here to avoid highlighting declarations.
+ "random_number" "random_seed" "range" ;; "real"
+ "repeat" "reshape" "rrspacing" "scale" "scan"
+ "selected_int_kind" "selected_real_kind" "set_exponent"
+ "shape" "sign" "sin" "sinh" "size" "spacing" "spread" "sqrt"
+ "sum" "system_clock" "tan" "tanh" "tiny" "transfer"
+ "transpose" "trim" "ubound" "unpack" "verify"
+ ;; F95 intrinsic functions.
+ "null" "cpu_time") t)
+ ;; A left parenthesis to avoid highlighting non-procedures.
+ "[ \t]*(")
+ "Regexp whose first part matches F90 intrinsic procedures.")
+
+(defconst f90-operators-re
+ (concat "\\."
+ (regexp-opt '("and" "eq" "eqv" "false" "ge" "gt" "le" "lt" "ne"
+ "neqv" "not" "or" "true") t)
+ "\\.")
+ "Regexp matching intrinsic operators.")
+
+(defconst f90-hpf-keywords-re
+ (regexp-opt
+ ;; Intrinsic procedures.
+ '("all_prefix" "all_scatter" "all_suffix" "any_prefix"
+ "any_scatter" "any_suffix" "copy_prefix" "copy_scatter"
+ "copy_suffix" "count_prefix" "count_scatter" "count_suffix"
+ "grade_down" "grade_up"
+ "hpf_alignment" "hpf_distribution" "hpf_template" "iall" "iall_prefix"
+ "iall_scatter" "iall_suffix" "iany" "iany_prefix" "iany_scatter"
+ "iany_suffix" "ilen" "iparity" "iparity_prefix"
+ "iparity_scatter" "iparity_suffix" "leadz" "maxval_prefix"
+ "maxval_scatter" "maxval_suffix" "minval_prefix" "minval_scatter"
+ "minval_suffix" "number_of_processors" "parity"
+ "parity_prefix" "parity_scatter" "parity_suffix" "popcnt" "poppar"
+ "processors_shape" "product_prefix" "product_scatter"
+ "product_suffix" "sum_prefix" "sum_scatter" "sum_suffix"
+ ;; Directives.
+ "align" "distribute" "dynamic" "independent" "inherit" "processors"
+ "realign" "redistribute" "template"
+ ;; Keywords.
+ "block" "cyclic" "extrinsic" "new" "onto" "pure" "with") 'words)
+ "Regexp for all HPF keywords, procedures and directives.")
+
+;; Highlighting patterns.
+
+(defvar f90-font-lock-keywords-1
+ (list
+ ;; Special highlighting of "module procedure".
+ '("\\<\\(module[ \t]*procedure\\)\\>" (1 font-lock-keyword-face))
+ ;; 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+\\)?"
+ (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t))
+ "\\<\\(\\(end[ \t]*\\)?\\(interface\\|block[ \t]*data\\)\\|contains\\)\\>")
+ "This does fairly subdued highlighting of comments and function calls.")
+
+(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+)\\)\
+\\(.*::\\|[ \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\\)\\)\\>\
+\\([ \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\\)\\)\\>"
+ (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]*"
+ (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))
+ "\\<else\\([ \t]*if\\|where\\)?\\>"
+ '("\\(&\\)[ \t]*\\(!\\|$\\)" (1 font-lock-keyword-face))
+ "\\<\\(then\\|continue\\|format\\|include\\|stop\\|return\\)\\>"
+ '("\\<\\(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]+\\)"
+ (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))))
+ "Highlights declarations, do-loops and other constructs.")
+
+(defvar f90-font-lock-keywords-3
+ (append f90-font-lock-keywords-2
+ (list
+ f90-keywords-level-3-re
+ f90-operators-re
+ (list f90-procedures-re '(1 font-lock-keyword-face keep))
+ "\\<real\\>" ; avoid overwriting real defs
+ ))
+ "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.")
+
+(defvar f90-font-lock-keywords
+ f90-font-lock-keywords-2
+ "*Default expressions to highlight in F90 mode.
+Can be overridden by the value of `font-lock-maximum-decoration'.")
+
+
+(defvar f90-mode-syntax-table
+ (let ((table (make-syntax-table)))
+ (modify-syntax-entry ?\! "<" table) ; begin comment
+ (modify-syntax-entry ?\n ">" table) ; end comment
+ (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
+ (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 \
+ ;; unspecified, but that f2k will require it to be non-special.
+ ;; Use `f90-backslash-not-special' to change.
+ (modify-syntax-entry ?\\ "\\" table) ; escape chars
+ table)
+ "Syntax table used in F90 mode.")
+
+(defvar f90-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "`" 'f90-abbrev-start)
+ (define-key map "\C-c;" 'f90-comment-region)
+ (define-key map "\C-\M-a" 'f90-beginning-of-subprogram)
+ (define-key map "\C-\M-e" 'f90-end-of-subprogram)
+ (define-key map "\C-\M-h" 'f90-mark-subprogram)
+ (define-key map "\C-\M-n" 'f90-end-of-block)
+ (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 "\C-c\r" 'f90-break-line)
+;;; (define-key map [M-return] 'f90-break-line)
+ (define-key map "\C-c\C-a" 'f90-previous-block)
+ (define-key map "\C-c\C-e" 'f90-next-block)
+ (define-key map "\C-c\C-d" 'f90-join-lines)
+ (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\C-w" 'f90-insert-end)
+ (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)
+ (define-key map "*" 'f90-electric-insert)
+ (define-key map "/" 'f90-electric-insert)
+
+ (easy-menu-define f90-menu map "Menu for F90 mode."
+ `("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]
+ )
+ "--"
+ ["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]
+ "--"
+ ["(Un)Comment Region" f90-comment-region mark-active]
+ ["Indent Region" f90-indent-region mark-active]
+ ["Fill Region" f90-fill-region mark-active]
+ "--"
+ ["Break Line at Point" f90-break-line t]
+ ["Join with Previous Line" f90-join-lines t]
+ ["Insert Block End" f90-insert-end t]
+ "--"
+ ("Highlighting"
+ ["Toggle font-lock-mode" font-lock-mode :selected font-lock-mode
+ :style toggle]
+ "--"
+ ["Light highlighting (level 1)" f90-font-lock-1 t]
+ ["Moderate highlighting (level 2)" f90-font-lock-2 t]
+ ["Heavy highlighting (level 3)" f90-font-lock-3 t]
+ ["Maximum highlighting (level 4)" f90-font-lock-4 t]
+ )
+ ("Change Keyword Case"
+ ["Upcase Keywords (buffer)" f90-upcase-keywords t]
+ ["Capitalize Keywords (buffer)" f90-capitalize-keywords t]
+ ["Downcase Keywords (buffer)" f90-downcase-keywords t]
+ "--"
+ ["Upcase Keywords (region)" f90-upcase-region-keywords
+ mark-active]
+ ["Capitalize Keywords (region)" f90-capitalize-region-keywords
+ mark-active]
+ ["Downcase Keywords (region)" f90-downcase-region-keywords
+ 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
+ :active (not (lookup-key (current-local-map) [menu-bar index]))
+ :included (fboundp 'imenu-add-to-menubar)]))
+ map)
+ "Keymap used in F90 mode.")