;;; f90.el --- Fortran-90 mode (free format)
-;; Copyright (C) 1995, 1996, 1997, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005
+;; Free Software Foundation, Inc.
;; Author: Torbj\"orn Einarsson <Torbjorn.Einarsson@era.ericsson.se>
;; Maintainer: Glenn Morris <gmorris@ast.cam.ac.uk>
;; 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Code:
;; TODO
-;; Support for hideshow, align.
+;; Support for align.
;; OpenMP, preprocessor highlighting.
(defvar comment-auto-fill-only-comments)
:group 'f90)
(defcustom f90-smart-end 'blink
- "*From an END statement, check and fill the end using matching block start.
-Allowed values are 'blink, 'no-blink, and nil, which determine
-whether to blink the matching beginning."
+ "*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 holding list of delimiters at which lines may be broken."
+ "*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)
(list
;; Variable declarations (avoid the real function call).
'("^[ \t0-9]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\
-logical\\|type[ \t]*(\\sw+)\\)\\(.*::\\|[ \t]*(.*)\\)?\\([^!\n]*\\)"
- (1 font-lock-type-face t) (4 font-lock-variable-name-face))
+logical\\|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+\\)\\)?"
'("\\<\\(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))
(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.")
"Regexp matching the definition of a derived type.")
(defconst f90-no-break-re
- (regexp-opt '("**" "//" "=>") 'paren)
- "Regexp specifying where not to break lines when filling.")
+ (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.")
(defvar f90-cache-position nil
"Temporary position used to speed up region operations.")
(make-variable-buffer-local 'f90-cache-position)
\f
+;; Hideshow support.
+(defconst f90-end-block-re
+ (concat "^[ \t0-9]*\\<end[ \t]*"
+ (regexp-opt '("do" "if" "forall" "function" "interface"
+ "module" "program" "select" "subroutine"
+ "type" "where" ) t)
+ "[ \t]*\\sw*")
+ "Regexp matching the end of an F90 \"block\", from the line start.
+Used in the F90 entry in `hs-special-modes-alist'.")
+
+;; Ignore the fact that FUNCTION, SUBROUTINE, WHERE, FORALL have a
+;; following "(". DO, CASE, IF can have labels.
+(defconst f90-start-block-re
+ (concat
+ "^[ \t0-9]*" ; statement number
+ "\\(\\("
+ "\\(\\sw+[ \t]*:[ \t]*\\)?" ; structure label
+ "\\(do\\|select[ \t]*case\\|"
+ ;; See comments in fortran-start-block-re for the problems of IF.
+ "if[ \t]*(\\(.*\\|"
+ ".*\n\\([^if]*\\([^i].\\|.[^f]\\|.\\>\\)\\)\\)\\<then\\|"
+ ;; Distinguish WHERE block from isolated WHERE.
+ "\\(where\\|forall\\)[ \t]*(.*)[ \t]*\\(!\\|$\\)\\)\\)"
+ "\\|"
+ "program\\|interface\\|module\\|type\\|function\\|subroutine"
+ "\\)"
+ "[ \t]*")
+ "Regexp matching the start of an F90 \"block\", from the line start.
+A simple regexp cannot do this in fully correct fashion, so this
+tries to strike a compromise between complexity and flexibility.
+Used in the F90 entry in `hs-special-modes-alist'.")
+
+;; hs-special-modes-alist is autoloaded.
+(add-to-list 'hs-special-modes-alist
+ `(f90-mode ,f90-start-block-re ,f90-end-block-re
+ "!" f90-end-of-block nil))
+
+\f
;; Imenu support.
(defvar f90-imenu-generic-expression
(let ((good-char "[^!\"\&\n \t]") (not-e "[^e!\n\"\& \t]")
(use-local-map f90-mode-map)
(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) t)
+ (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)
(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-hooks 'f90-mode-hook))
+ (run-mode-hooks 'f90-mode-hook))
\f
;; Inline-functions.
;; GM this is not right, eg a continuation line starting with a number.
;; Need f90-code-start-position function.
;; And yet, things seems to work with this...
+;; cf f90-indent-line
+;; (beginning-of-line) ; digits after & \n are not line-nos
+;; (if (not (save-excursion (and (f90-previous-statement)
+;; (f90-line-continued))))
+;; (f90-indent-line-no)
(defsubst f90-current-indentation ()
"Return indentation of current line.
Line-numbers are considered whitespace characters."
(defsubst f90-get-present-comment-type ()
"If point lies within a comment, return the string starting the comment.
-For example, \"!\" or \"!!\"."
+For example, \"!\" or \"!!\", followed by the appropriate amount of
+whitespace, if any."
+ ;; Include the whitespace for consistent auto-filling of comment blocks.
(save-excursion
(when (f90-in-comment)
(beginning-of-line)
- (re-search-forward "!+" (line-end-position))
+ (re-search-forward "!+[ \t]*" (line-end-position))
(while (f90-in-string)
- (re-search-forward "!+" (line-end-position)))
- (match-string 0))))
+ (re-search-forward "!+[ \t]*" (line-end-position)))
+ (match-string-no-properties 0))))
(defsubst f90-equal-symbols (a b)
"Compare strings A and B neglecting case and allowing for nil value."
"Return (\"do\" NAME) if a do statement starts after point.
NAME is nil if the statement has no label."
(if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(do\\)\\>")
- (list (match-string 3) (match-string 2)))
+ (list (match-string 3) (match-string 2))))
(defsubst f90-looking-at-select-case ()
"Return (\"select\" NAME) if a select-case statement starts after point.
(defsubst f90-looking-at-program-block-start ()
"Return (KIND NAME) if a program block with name NAME starts after point."
+;;;NAME is nil for an un-named main PROGRAM block."
(cond
((looking-at "\\(program\\)[ \t]+\\(\\sw+\\)\\>")
(list (match-string 1) (match-string 2)))
(looking-at "[^!'\"\&\n]*\\(function\\|subroutine\\)[ \t]+\
\\(\\sw+\\)"))
(list (match-string 1) (match-string 2)))))
+;; Following will match an un-named main program block; however
+;; one needs to check if there is an actual PROGRAM statement after
+;; point (and before any END program). Adding this will require
+;; change to eg f90-calculate-indent.
+;;; ((save-excursion
+;;; (not (f90-previous-statement)))
+;;; '("program" nil))))
(defsubst f90-looking-at-program-block-end ()
"Return (KIND NAME) if a block with name NAME ends after point."
(f90-change-keywords f90-auto-keyword-case
(line-beginning-position) (line-end-position))))
\f
-(defun f90-electric-insert ()
+(defun f90-electric-insert (&optional arg)
"Change keyword case and auto-fill line as operators are inserted."
- (interactive)
- (self-insert-command 1)
+ (interactive "*p")
+ (self-insert-command arg)
(if auto-fill-function (f90-do-auto-fill) ; also updates line
(f90-update-line)))
(let (icol cont (case-fold-search t) (pnt (point)))
(save-excursion
(if (not (f90-previous-statement))
- (setq icol 0)
+ ;; 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
+ ;; f90-previous-statement has moved us over
+ ;; comment/blank lines, so we need to get
+ ;; back to the first code statement.
+ (when (looking-at "[ \t]*\\([!#]\\|$\\)")
+ (f90-next-statement))
+ (skip-chars-forward " \t0-9")
+ (f90-looking-at-program-block-start))
+ 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)))
\f
(defun f90-previous-statement ()
"Move point to beginning of the previous F90 statement.
-Return nil if no previous statement is found.
-A statement is a line which is neither blank nor a comment."
+If no previous statement is found (i.e. if called from the first
+statement in the buffer), move to the start of the buffer and
+return nil. A statement is a line which is neither blank nor a
+comment."
(interactive)
(let (not-first-statement)
(beginning-of-line)
(beginning-of-line)
(if (zerop count)
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.")
nil)))
"Move point to the end of the current subprogram.
Return (TYPE NAME), or nil if not found."
(interactive)
- (let ((count 1) (case-fold-search t) matching-end)
+ (let ((case-fold-search t)
+ (count 1)
+ matching-end)
(end-of-line)
(while (and (> count 0)
(re-search-forward f90-program-block-re nil 'move))
(defun f90-end-of-block (&optional num)
"Move point forward to the end of the current code block.
With optional argument NUM, go forward that many balanced blocks.
-If NUM is negative, go backward to the start of a block.
-Checks for consistency of block types and labels (if present),
-and completes outermost block if necessary."
+If NUM is negative, go backward to the start of a block. Checks
+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 (and num (< num 0)) (f90-beginning-of-block (- num)))
- (let ((f90-smart-end nil) ; for the final `f90-match-end'
+ (if (interactive-p) (push-mark (point) t)) ; can move some distance
+ (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)
(count (or num 1))
start-list start-this start-type start-label end-type end-label)
- (if (interactive-p) (push-mark (point) t))
(end-of-line) ; probably want this
(while (and (> count 0) (re-search-forward f90-blocks-re nil 'move))
(beginning-of-line)
(end-of-line))
(if (> count 0) (error "Missing block end"))
;; Check outermost block.
- (if (interactive-p)
- (save-excursion
- (beginning-of-line)
- (skip-chars-forward " \t0-9")
- (f90-match-end)))))
+ (when f90-smart-end
+ (save-excursion
+ (beginning-of-line)
+ (skip-chars-forward " \t0-9")
+ (f90-match-end)))))
(defun f90-beginning-of-block (&optional num)
"Move point backwards to the start of the current code block.
With optional argument NUM, go backward that many balanced blocks.
If NUM is negative, go forward to the end of a block.
Checks for consistency of block types and labels (if present).
-Does not check the outermost block, because it may be incomplete."
+Does not check the outermost block, because it may be incomplete.
+Interactively, pushes mark before moving point."
(interactive "p")
- (if (and num (< num 0)) (f90-end-of-block (- num)))
+ (if (interactive-p) (push-mark (point) t))
+ (and num (< num 0) (f90-end-of-block (- num)))
(let ((case-fold-search t)
(count (or num 1))
end-list end-this end-type end-label
start-this start-type start-label)
- (if (interactive-p) (push-mark (point) t))
(beginning-of-line) ; probably want this
(while (and (> count 0) (re-search-backward f90-blocks-re nil 'move))
(beginning-of-line)
(or (f90-equal-symbols start-label end-label)
(error "Start label `%s' does not match end label `%s'"
start-label end-label))))))
- (if (> count 0) (error "Missing block start"))))
+ ;; Includes an un-named main program block.
+ (if (> count 0) (error "Missing block start"))))
(defun f90-next-block (&optional num)
"Move point forward to the next end or start of a code block.
(and (< (point) pos)
(goto-char pos))
(if auto-fill-function
- (f90-do-auto-fill) ; also updates line
+ ;; GM NO-UPDATE not honoured, since this calls f90-update-line.
+ (f90-do-auto-fill)
(or no-update (f90-update-line)))
(set-marker pos nil)))
(interactive "*")
(if abbrev-mode (expand-abbrev))
(beginning-of-line) ; reindent where likely to be needed
- (f90-indent-line-no)
- (f90-indent-line 'no-update)
+ (f90-indent-line) ; calls indent-line-no, update-line
(end-of-line)
(delete-horizontal-space) ; destroy trailing whitespace
(let ((string (f90-in-string))
(cont (f90-line-continued)))
(and string (not cont) (insert "&"))
- (f90-update-line)
(newline)
(if (or string (and cont f90-beginning-ampersand)) (insert "&")))
- (f90-indent-line 'no-update))
+ (f90-indent-line 'no-update)) ; nothing to update
+;; TODO not add spaces to empty lines at the start.
+;; Why is second line getting extra indent over first?
(defun f90-indent-region (beg-region end-region)
"Indent every line in region by forward parsing."
(interactive "*r")
(cond ((f90-in-string)
(insert "&\n&"))
((f90-in-comment)
+ (delete-horizontal-space 'backwards) ; remove trailing whitespace
(insert "\n" (f90-get-present-comment-type)))
(t (insert "&")
(or no-update (f90-update-line))
(forward-char (if (looking-at f90-no-break-re) 2 1))
(backward-char)
(or (looking-at f90-no-break-re)
- (forward-char)))))
+ (forward-char))))
(defun f90-do-auto-fill ()
"Break line if non-white characters beyond `fill-column'.
END-BLOCK is the type of block as indicated at the end (may be nil).
END-NAME is the block end name (may be nil).
Leave point at the end of line."
+ ;; Hack to deal with the case when this is called from
+ ;; f90-indent-region on a program block without an explicit PROGRAM
+ ;; statement at the start. Should really be an error (?).
+ (or beg-block (setq beg-block "program"))
(search-forward "end" (line-end-position))
(catch 'no-match
- (if (f90-equal-symbols beg-block end-block)
+ (if (and end-block (f90-equal-symbols beg-block end-block))
(search-forward end-block)
(if end-block
(progn
end-name (car (cdr end-struct)))
(save-excursion
(beginning-of-line)
- (while (and (> count 0) (re-search-backward f90-blocks-re nil t))
+ (while (and (> count 0)
+ (not (= (line-beginning-position) (point-min))))
+ (re-search-backward f90-blocks-re nil 'move)
(beginning-of-line)
;; GM not a line number if continued line.
;;; (skip-chars-forward " \t")
(f90-looking-at-where-or-forall)
(f90-looking-at-select-case)
(f90-looking-at-type-like)
- (f90-looking-at-program-block-start)))
+ (f90-looking-at-program-block-start)
+ ;; Interpret a single END without a block
+ ;; start to be the END of a program block
+ ;; without an initial PROGRAM line.
+ (if (= (line-beginning-position) (point-min))
+ '("program" nil))))
(setq count (1- count)))
((looking-at (concat "end[ \t]*" f90-blocks-re))
(setq count (1+ count)))))
(defun f90-abbrev-start ()
"Typing `\\[help-command] or `? lists all the F90 abbrevs.
Any other key combination is executed normally."
- (interactive)
- (let (c)
- (insert last-command-char)
- (setq c (if (fboundp 'next-command-event) ; XEmacs
- (event-to-character (next-command-event))
- (read-event)))
+ (interactive "*")
+ (insert last-command-char)
+ (let (char event)
+ (if (fboundp 'next-command-event) ; XEmacs
+ (setq event (next-command-event)
+ char (and (fboundp 'event-to-character)
+ (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 c ??) (eq c help-char)))
+ (if (and abbrev-mode (or (eq char ??) (eq char help-char)))
(f90-abbrev-help)
- (setq unread-command-events (list c)))))
+ (setq unread-command-events (list event)))))
(defun f90-abbrev-help ()
"List the currently defined abbrevs in F90 mode."
(save-excursion
(nth 1 (f90-beginning-of-subprogram))))
+
+(defun f90-backslash-not-special (&optional all)
+ "Make the backslash character (\\) be non-special in the current buffer.
+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)
+ (error "This function should only be used in F90 buffers"))
+ (when (equal (char-syntax ?\\ ) ?\\ )
+ (or all (set-syntax-table (copy-syntax-table (syntax-table))))
+ (modify-syntax-entry ?\\ ".")))
+
+
(provide 'f90)
+;;; arch-tag: fceac97c-c147-44bd-aec0-172d4b560ef8
;;; f90.el ends here
HCoop / bpt / emacs.git / blobdiff