;;; 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)
(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.")
"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 a \"block\" of F90 code.
+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; IF must be
+;; accompanied by THEN.
+;; A big problem is that many of these statements can be broken over
+;; lines, even with embedded comments. We only try to handle this for
+;; IF ... THEN statements, assuming and hoping it will be less common
+;; for other constructs. We match up to one new-line, provided ")
+;; THEN" appears on one line. Matching on just ") THEN" is no good,
+;; since that includes ELSE branches.
+;; For a fully accurate solution, hideshow would probably have to be
+;; modified to allow functions as well as regexps to be used to
+;; specify block start and end positions.
+(defconst f90-start-block-re
+ (concat
+ "^[ \t0-9]*" ; statement number
+ "\\(\\("
+ "\\(\\sw+[ \t]*:[ \t]*\\)?" ; structure label
+ "\\(do\\|select[ \t]*case\\|if[ \t]*(.*\n?.*)[ \t]*then\\|"
+ ;; Distinguish WHERE block from isolated WHERE.
+ "\\(where\\|forall\\)[ \t]*(.*)[ \t]*\\(!\\|$\\)\\)\\)"
+ "\\|"
+ "program\\|interface\\|module\\|type\\|function\\|subroutine"
+ ;; ") THEN" at line end. Problem - also does ELSE.
+;;; "\\|.*)[ \t]*then[ \t]*\\($\\|!\\)"
+ "\\)"
+ "[ \t]*")
+ "Regexp matching the start of a \"block\" of F90 code.
+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
(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)
(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."
(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."
(let (icol cont (case-fold-search t) (pnt (point)))
(save-excursion
(if (not (f90-previous-statement))
- (setq icol 0)
+ ;; First statement in buffer.
+ (setq icol (if (save-excursion
+ (f90-next-statement)
+ (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)))
(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)))
+ (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
(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.
(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))
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)))))
(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