;;; esatan.el r0.0.2 --- Esatan/Thermica mode for GNU Emacs ;; - '#'-sign equals start of comment line ;; - 'D' sign does not start debugging comment line ;; Copyright (c) 1986, 1993, 1994, 1995, 1997, 1998 Free Software Foundation, Inc. ;; Author: Albert Thuswaldner ;; Original Author: Michael D. Prange ;; Keywords: ESATAN, Thermica, mode ;; This file is part of GNU Emacs. ;; 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 2, 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 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; 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., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: ;; This is only a first draft of a GNU Emacs mode designed with the hope ;; that it will become useful someday. ;; It is based on the original Fortran mode and does not, as for now, ;; differ much from it. The major changes made are: ;; ;; * Changed all command and function names containing the word 'Fortran' ;; to 'esatan'. ;; * Removed the electric-line intent feature, it is only irritating for. ;; * Added esatan and Thermica keywords to be highlighted. ;; * Changed the identifier for comment-line highlighting. ;; ;; Esatan code is very much based on Fortran syntax, Fortran-like syntax ;; (mortran) can also be a added directly in the model files, that is why ;; it felt convenient to base this mode on the Fortran mode. ;; ;; The esatan mode in the current shape can be helpful, ;; when editing esatan model files (with file extensions '.d') ;; and Thermica sysbas model files (with file extensions '.sysbas') ;; ;; Add the following lines to your .esatan files (for file associations) ;; ;; Set up ESATAN major mode ;; (autoload 'esatan-mode "esatan" "Enter esatan mode" t) ;; (setq auto-mode-alist ;; (append auto-mode-alist ;; '(("\\.\\(d\\|in\\|tc\\|sysbas\\|tan\\|ske\\)$" . esatan-mode)))) ;; ;; ;; Credits for this mode should go to those people how developed ;; the Fortran mode. My effort was merely the one of a copy-cat. /Albert ;;; History: ;;; Code: ;; Todo: ;; * Remove unnessary functions. ;; ;; * Add usefull features. (require 'easymenu) (defgroup esatan-indent nil "Indentation variables in esatan mode" :prefix "esatan-" :group 'fortran) (defgroup esatan-comment nil "Comment-handling variables in esatan mode" :prefix "esatan-" :group 'fortran) ;;;###autoload (defcustom esatan-tab-mode-default nil "*Default tabbing/carriage control style for empty files in esatan mode. A value of t specifies tab-digit style of continuation control. A value of nil specifies that continuation lines are marked with a character in column 6." :type 'boolean :group 'esatan-indent) ;; Buffer local, used to display mode line. (defcustom esatan-tab-mode-string nil "String to appear in mode line when TAB format mode is on." :type '(choice (const nil) string) :group 'esatan-indent) (make-variable-buffer-local 'esatan-tab-mode-string) (defcustom esatan-do-indent 3 "*Extra indentation applied to DO blocks." :type 'integer :group 'esatan-indent) (defcustom esatan-if-indent 3 "*Extra indentation applied to IF blocks." :type 'integer :group 'esatan-indent) (defcustom esatan-structure-indent 3 "*Extra indentation applied to STRUCTURE, UNION, MAP and INTERFACE blocks." :type 'integer :group 'esatan-indent) (defcustom esatan-continuation-indent 5 "*Extra indentation applied to esatan continuation lines." :type 'integer :group 'esatan-indent) (defcustom esatan-comment-indent-style 'fixed "*How to indent comments. nil forces comment lines not to be touched, 'fixed makes fixed comment indentation to `esatan-comment-line-extra-indent' columns beyond `esatan-minimum-statement-indent-fixed' (for `indent-tabs-mode' of nil) or `esatan-minimum-statement-indent-tab' (for `indent-tabs-mode' of t), and 'relative indents to current esatan indentation plus `esatan-comment-line-extra-indent'." :type '(radio (const :tag "Untouched" nil) (const fixed) (const relative)) :group 'esatan-indent) (defcustom esatan-comment-line-extra-indent 0 "*Amount of extra indentation for text within full-line comments." :type 'integer :group 'esatan-indent :group 'esatan-comment) (defcustom comment-line-start nil "*Delimiter inserted to start new full-line comment." :type '(choice string (const nil)) :group 'esatan-comment) (defcustom comment-line-start-skip nil "*Regexp to match the start of a full-line comment." :type '(choice string (const nil)) :group 'esatan-comment) (defcustom esatan-minimum-statement-indent-fixed 6 "*Minimum statement indentation for fixed format continuation style." :type 'integer :group 'esatan-indent) (defcustom esatan-minimum-statement-indent-tab (max tab-width 6) "*Minimum statement indentation for TAB format continuation style." :type 'integer :group 'esatan-indent) ;; Note that this is documented in the v18 manuals as being a string ;; of length one rather than a single character. ;; The code in this file accepts either format for compatibility. (defcustom esatan-comment-indent-char " " "*Single-character string inserted for esatan comment indentation. Normally a space." :type 'string :group 'esatan-comment) (defcustom esatan-line-number-indent 1 "*Maximum indentation for esatan line numbers. 5 means right-justify them within their five-column field." :type 'integer :group 'esatan-indent) (defcustom esatan-check-all-num-for-matching-do nil "*Non-nil causes all numbered lines to be treated as possible DO loop ends." :type 'boolean :group 'fortran) (defcustom esatan-blink-matching-if nil "*Non-nil causes \\[esatan-indent-line] on ENDIF statement to blink on matching IF. Also, from an ENDDO statement blink on matching DO [WHILE] statement." :type 'boolean :group 'fortran) (defcustom esatan-continuation-string "$" "*Single-character string used for esatan continuation lines. In fixed format continuation style, this character is inserted in column 6 by \\[esatan-split-line] to begin a continuation line. Also, if \\[esatan-indent-line] finds this at the beginning of a line, it will convert the line into a continuation line of the appropriate style. Normally $." :type 'string :group 'fortran) (defcustom esatan-comment-region "#" "*String inserted by \\[esatan-comment-region] at start of each \ line in region." :type 'string :group 'esatan-comment) (defvar esatan-column-ruler-fixed "0 4 6 10 20 30 40 5\ 0 60 70\n\ \[ ]|{ | | | | | | | | \ \| | | | |}\n" "String displayed above current line by \\[esatan-column-ruler]. This variable used in fixed format mode.") (defvar esatan-column-ruler-tab "0 810 20 30 40 5\ 0 60 70\n\ \[ ]| { | | | | | | | | \ \| | | | |}\n" "String displayed above current line by \\[esatan-column-ruler]. This variable used in TAB format mode.") (defvar esatan-mode-syntax-table nil "Syntax table in use in esatan mode buffers.") (defvar esatan-analyze-depth 100 "Number of lines to scan to determine whether to use fixed or TAB \ format style.") (defcustom esatan-break-before-delimiters t "*Non-nil causes filling to break lines before delimiters." :type 'boolean :group 'esatan) (if esatan-mode-syntax-table () (setq esatan-mode-syntax-table (make-syntax-table)) ;; We might like `;' to be punctuation (g77 multi-statement lines), ;; but that screws abbrevs. (modify-syntax-entry ?\; "w" esatan-mode-syntax-table) (modify-syntax-entry ?\r " " esatan-mode-syntax-table) (modify-syntax-entry ?+ "." esatan-mode-syntax-table) (modify-syntax-entry ?- "." esatan-mode-syntax-table) (modify-syntax-entry ?= "." esatan-mode-syntax-table) (modify-syntax-entry ?* "." esatan-mode-syntax-table) (modify-syntax-entry ?/ "." esatan-mode-syntax-table) (modify-syntax-entry ?\' "\"" esatan-mode-syntax-table) (modify-syntax-entry ?\" "\"" esatan-mode-syntax-table) (modify-syntax-entry ?\\ "/" esatan-mode-syntax-table) ;; This might be better as punctuation, as for C, but this way you ;; can treat floating-point numbers as symbols. (modify-syntax-entry ?. "_" esatan-mode-syntax-table) ; e.g. `a.ne.b' (modify-syntax-entry ?_ "_" esatan-mode-syntax-table) (modify-syntax-entry ?$ "_" esatan-mode-syntax-table) ; esp. VMSisms (modify-syntax-entry ?\! "<" esatan-mode-syntax-table) (modify-syntax-entry ?\n ">" esatan-mode-syntax-table)) ;; Comments are real pain in esatan because there is no way to represent the ;; standard comment syntax in an Emacs syntax table (we can for VAX-style). ;; Therefore an unmatched quote in a standard comment will throw fontification ;; off on the wrong track. So we do syntactic fontification with regexps. ;; Regexps done by simon@gnu with help from Ulrik Dickow and ;; probably others Si's forgotten about (sorry). (defconst esatan-font-lock-keywords-1 nil "Subdued level highlighting for esatan mode.") (defconst esatan-font-lock-keywords-2 nil "Medium level highlighting for esatan mode.") (defconst esatan-font-lock-keywords-3 nil "Gaudy level highlighting for esatan mode.") (defun esatan-fontify-string (limit) (let ((match (match-string 1))) (cond ((string= "'" match) (re-search-forward "\\([^'\n]*'?\\)" limit)) ((string= "\"" match) (re-search-forward "\\([^\"\n]*\"?\\)" limit))))) (let ((comment-chars "c!*#") (esatan-type-types (eval-when-compile (let ((re (regexp-opt (let ((simple-types '("character" "byte" "integer" "logical" "none" "real" "complex" "double precision" "double complex")) (structured-types '("structure" "union" "map")) (other-types '("record" "dimension" "parameter" "common" "save" "external" "intrinsic" "data" "equivalence"))) (append (mapcar (lambda (x) (concat "implicit " x)) simple-types) simple-types (mapcar (lambda (x) (concat "end " x)) structured-types) structured-types other-types))))) ;; In the optimized regexp above, replace spaces by regexp ;; for optional whitespace, which regexp-opt would have ;; escaped. (mapconcat #'identity (split-string re) "[ \t]*")))) (esatan-keywords (eval-when-compile (regexp-opt '("continue" "format" "end" "for" "to" "do" "enddo" "if" "then" "else" "endif" "elseif" "while" "inquire" "stop" "return" "include" "open" "close" "read" "write" "format" "print" "select" "case" "cycle" "exit")))) (esatan-additional-keywords (eval-when-compile (regexp-opt '("$MODEL" "$LOCALS" "$NODES" "$CONDUCTORS" "$CONSTANTS" "$INTEGER" "$CHARACTER" "$CONTROL" "$ARRAYS" "$REAL" "$SUBROUTINES" "$INITIAL" "$VARIABLES1" "$VARIABLES2" "$EXECUTION" "$OUTPUTS" "$ENDMODEL" "$INFO" "$AXIS" "$THERMAL" "$TSHAPE" "$TEXT" "$DATA" "$MIRROR" "$COPY" "$D_PROPERTY" "$C_PROPERTY" "$END")))) (esatan-logicals (eval-when-compile (regexp-opt '("and" "or" "not" "lt" "le" "eq" "ge" "gt" "ne" "true" "false"))))) (setq esatan-font-lock-keywords-1 (list ;; ;; Fontify syntactically (assuming strings cannot be quoted ;; or span lines). (cons (concat "^[" comment-chars "].*") 'font-lock-comment-face) '(esatan-match-!-comment . font-lock-comment-face) (list (concat "^[^" comment-chars "\t\n]" (make-string 71 ?.) "\\(.*\\)") '(1 font-lock-comment-face)) '("\\(\\s\"\\)" ; single- or double-quoted string (1 font-lock-string-face) (esatan-fontify-string nil nil (1 font-lock-string-face))) ;; ;; Program, subroutine and function declarations, plus calls. (list (concat "\\<\\(block[ \t]*data\\|call\\|entry\\|function\\|" "program\\|subroutine\\)\\>[ \t]*\\(\\sw+\\)?") '(1 font-lock-keyword-face) '(2 font-lock-function-name-face nil t)))) (setq esatan-font-lock-keywords-2 (append esatan-font-lock-keywords-1 (list ;; ;; Fontify all type specifiers (must be first; see below). (cons (concat "\\<\\(" esatan-type-types "\\)\\>") 'font-lock-type-face) ;; ;; Fontify all builtin keywords (except logical, do ;; and goto; see below). (concat "\\<\\(" esatan-keywords "\\)\\>") ;; Fontify all ESATAN keywords (concat "\\<\\(" esatan-additional-keywords "\\)\\>") ;; ;; Fontify all builtin operators. (concat "\\.\\(" esatan-logicals "\\)\\.") ;; ;; Fontify do/goto keywords and targets, and goto tags. (list "\\<\\(do\\|go *to\\)\\>[ \t]*\\([0-9]+\\)?" '(1 font-lock-keyword-face) '(2 font-lock-constant-face nil t)) (cons "^ *\\([0-9]+\\)" 'font-lock-constant-face)))) (setq esatan-font-lock-keywords-3 (append ;; ;; The list `esatan-font-lock-keywords-1'. esatan-font-lock-keywords-1 ;; ;; Fontify all type specifiers plus their declared items. (list (list (concat "\\<\\(" esatan-type-types "\\)\\>[ \t(/]*\\(*\\)?") ;; Fontify the type specifier. '(1 font-lock-type-face) ;; Fontify each declaration item (or just the /.../ block name). `(font-lock-match-c-style-declaration-item-and-skip-to-next ;; Start after any *(...) expression. (condition-case nil (and (and (match-beginning ,(+ 2 (regexp-opt-depth esatan-type-types))) (forward-sexp)) (forward-sexp)) (error nil)) ;; No need to clean up. nil ;; Fontify as a variable name, functions are ;; fontified elsewhere. (1 font-lock-variable-name-face nil t)))) ;; ;; Things extra to `esatan-font-lock-keywords-3' ;; (must be done first). (list ;; ;; Fontify goto-like `err=label'/`end=label' in read/write ;; statements. '(", *\\(e\\(nd\\|rr\\)\\)\\> *\\(= *\\([0-9]+\\)\\)?" (1 font-lock-keyword-face) (4 font-lock-constant-face nil t)) ;; ;; Highlight standard continuation character and in a ;; TAB-formatted line. '("^ \\([^ 0]\\)" 1 font-lock-string-face) '("^\t\\([1-9]\\)" 1 font-lock-string-face)) ;; ;; The list `esatan-font-lock-keywords-2' less that for types ;; (see above). (cdr (nthcdr (length esatan-font-lock-keywords-1) esatan-font-lock-keywords-2))))) (defvar esatan-font-lock-keywords esatan-font-lock-keywords-1 "Default expressions to highlight in esatan mode.") (defvar esatan-imenu-generic-expression ;; These patterns could be confused by sequence nos. in cols 72+ and ;; don't allow continuations everywhere. (list (list nil ;; Lines below are: 1. leading whitespace; 2. function ;; declaration with optional type, e.g. `real', `real*4', ;; character(*), `double precision' and possible statement ;; continuation; 3. untyped declarations; 4. the variable to ;; index. [This will be fooled by `end function' allowed by G77. ;; Also, it assumes sensible whitespace is employed.] (concat "^\\s-+\\(\ \\(\\sw\\|\\s-\\|[*()+]\\)*\ \\ 0 arg) (setq arg (- arg)) (forward-line arg)) (while (not (zerop arg)) (beginning-of-line) (or (esatan-remove-continuation) (delete-indentation)) (setq arg (1- arg))) (esatan-indent-line))) (defun esatan-numerical-continuation-char () "Return a digit for tab-digit style of continuation lines. If, previous line is a tab-digit continuation line, returns that digit plus one. Otherwise return 1. Zero not allowed." (save-excursion (forward-line -1) (if (looking-at "\t[1-9]") (+ ?1 (% (- (char-after (+ (point) 1)) ?0) 9)) ?1))) (defun delete-horizontal-regexp (chars) "Delete all characters in CHARS around point. CHARS is like the inside of a [...] in a regular expression except that ] is never special and \ quotes ^, - or \." (interactive "*s") (skip-chars-backward chars) (delete-region (point) (progn (skip-chars-forward chars) (point)))) (defvar esatan-end-prog-re1 "end\ \\([ \t]*\\(program\\|subroutine\\|function\\|block[ \t]*data\\)\\>\ \\([ \t]*\\(\\sw\\|\\s_\\)+\\)?\\)?") (defvar esatan-end-prog-re (concat "^[ \t0-9]*" esatan-end-prog-re1) "Regexp possibly marking subprogram end.") (defun esatan-check-end-prog-re () "Check a preliminary match against `esatan-end-prog-re'." ;; Having got a possible match for the subprogram end, we need a ;; match of whitespace, avoiding possible column 73+ stuff. (save-match-data (string-match "^\\s-*\\(\\'\\|\\s<\\)" (buffer-substring (match-end 0) (min (line-end-position) (+ 72 (line-beginning-position))))))) ;; Note that you can't just check backwards for `subroutine' &c in ;; case of un-marked main programs not at the start of the file. (defun beginning-of-esatan-subprogram () "Moves point to the beginning of the current esatan subprogram." (interactive) (let ((case-fold-search t)) (beginning-of-line -1) (if (catch 'ok (while (re-search-backward esatan-end-prog-re nil 'move) (if (esatan-check-end-prog-re) (throw 'ok t)))) (forward-line)))) (defun end-of-esatan-subprogram () "Moves point to the end of the current esatan subprogram." (interactive) (let ((case-fold-search t)) (if (save-excursion ; on END (beginning-of-line) (and (looking-at esatan-end-prog-re) (esatan-check-end-prog-re))) (forward-line) (beginning-of-line 2) (catch 'ok (while (re-search-forward esatan-end-prog-re nil 'move) (if (esatan-check-end-prog-re) (throw 'ok t)))) (goto-char (match-beginning 0)) (forward-line)))) (defun mark-esatan-subprogram () "Put mark at end of esatan subprogram, point at beginning. The marks are pushed." (interactive) (end-of-esatan-subprogram) (push-mark (point) nil t) (beginning-of-esatan-subprogram)) (defun esatan-previous-statement () "Moves point to beginning of the previous esatan statement. Returns `first-statement' if that statement is the first non-comment esatan statement in the file, and nil otherwise." (interactive) (let (not-first-statement continue-test) (beginning-of-line) (setq continue-test (and (not (looking-at comment-line-start-skip)) (or (looking-at (concat "[ \t]*" (regexp-quote esatan-continuation-string))) (or (looking-at " [^ 0\n]") (looking-at "\t[1-9]"))))) (while (and (setq not-first-statement (= (forward-line -1) 0)) (or (looking-at comment-line-start-skip) (looking-at "[ \t]*$") (looking-at " [^ 0\n]") (looking-at "\t[1-9]") (looking-at (concat "[ \t]*" comment-start-skip))))) (cond ((and continue-test (not not-first-statement)) (message "Incomplete continuation statement.")) (continue-test (esatan-previous-statement)) ((not not-first-statement) 'first-statement)))) (defun esatan-next-statement () "Moves point to beginning of the next esatan statement. Returns `last-statement' if that statement is the last non-comment esatan statement in the file, and nil otherwise." (interactive) (let (not-last-statement) (beginning-of-line) (while (and (setq not-last-statement (and (= (forward-line 1) 0) (not (eobp)))) (or (looking-at comment-line-start-skip) (looking-at "[ \t]*$") (looking-at " [^ 0\n]") (looking-at "\t[1-9]") (looking-at (concat "[ \t]*" comment-start-skip))))) (if (not not-last-statement) 'last-statement))) (defun esatan-narrow-to-subprogram () "Make text outside the current subprogram invisible. The subprogram visible is the one that contains or follows point." (interactive) (save-excursion (mark-esatan-subprogram) (narrow-to-region (point) (mark)))) (defmacro esatan-with-subprogram-narrowing (&rest forms) "Execute FORMS with buffer temporarily narrowed to current subprogram. Doesn't push a mark." `(save-restriction (save-excursion (narrow-to-region (progn (beginning-of-esatan-subprogram) (point)) (progn (end-of-esatan-subprogram) (point)))) ,@forms)) (defun esatan-blink-matching-if () "From an ENDIF statement, blink the matching IF statement." (let ((top-of-window (window-start)) (endif-point (point)) (case-fold-search t) matching-if message) (if (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") (looking-at "e\\(nd[ \t]*if\\|lse\\([ \t]*if\\)?\\)\\b")) (progn (if (not (setq matching-if (esatan-beginning-if))) (setq message "No matching if.") (if (< matching-if top-of-window) (save-excursion (goto-char matching-if) (beginning-of-line) (setq message (concat "Matches " (buffer-substring (point) (progn (end-of-line) (point)))))))) (if message (message "%s" message) (goto-char matching-if) (sit-for 1) (goto-char endif-point)))))) (defun esatan-blink-matching-do () "From an ENDDO statement, blink the matching DO or DO WHILE statement." ;; This is basically copied from esatan-blink-matching-if. (let ((top-of-window (window-start)) (enddo-point (point)) (case-fold-search t) matching-do message) (if (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") (looking-at "end[ \t]*do\\b")) (progn (if (not (setq matching-do (esatan-beginning-do))) (setq message "No matching do.") (if (< matching-do top-of-window) (save-excursion (goto-char matching-do) (beginning-of-line) (setq message (concat "Matches " (buffer-substring (point) (progn (end-of-line) (point)))))))) (if message (message "%s" message) (goto-char matching-do) (sit-for 1) (goto-char enddo-point)))))) (defun esatan-mark-do () "Put mark at end of esatan DO [WHILE]-ENDDO construct, point at beginning. The marks are pushed." (interactive) (let (enddo-point do-point) (if (setq enddo-point (esatan-end-do)) (if (not (setq do-point (esatan-beginning-do))) (message "No matching do.") ;; Set mark, move point. (goto-char enddo-point) (push-mark) (goto-char do-point))))) (defun esatan-end-do () "Search forward for first unmatched ENDDO. Return point or nil." (let ((case-fold-search t)) (if (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") (looking-at "end[ \t]*do\\b")) ;; Sitting on one. (match-beginning 0) ;; Search for one. (save-excursion (let ((count 1)) (while (and (not (= count 0)) (not (eq (esatan-next-statement) 'last-statement)) ;; Keep local to subprogram (not (and (looking-at esatan-end-prog-re) (esatan-check-end-prog-re)))) (skip-chars-forward " \t0-9") (cond ((looking-at "end[ \t]*do\\b") (setq count (1- count))) ((looking-at "\\(\\(\\sw\\|\\s_\\)+:[ \t]*\\)?do[ \t]+[^0-9]") (setq count (+ count 1))))) (and (= count 0) ;; All pairs accounted for. (point))))))) (defun esatan-beginning-do () "Search backwards for first unmatched DO [WHILE]. Return point or nil." (let ((case-fold-search t)) (if (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") (looking-at "\\(\\(\\sw\\|\\s_\\)+:[ \t]*\\)?do[ \t]+")) ;; Sitting on one. (match-beginning 0) ;; Search for one. (save-excursion (let ((count 1)) (while (and (not (= count 0)) (not (eq (esatan-previous-statement) 'first-statement)) ;; Keep local to subprogram (not (and (looking-at esatan-end-prog-re) (esatan-check-end-prog-re)))) (skip-chars-forward " \t0-9") (cond ((looking-at "\\(\\(\\sw\\|\\s_\\)+:[ \t]*\\)?do[ \t]+[^0-9]") (setq count (1- count))) ((looking-at "end[ \t]*do\\b") (setq count (1+ count))))) (and (= count 0) ;; All pairs accounted for. (point))))))) (defun esatan-mark-if () "Put mark at end of esatan IF-ENDIF construct, point at beginning. The marks are pushed." (interactive) (let (endif-point if-point) (if (setq endif-point (esatan-end-if)) (if (not (setq if-point (esatan-beginning-if))) (message "No matching if.") ;; Set mark, move point. (goto-char endif-point) (push-mark) (goto-char if-point))))) (defvar esatan-if-start-re "\\(\\(\\sw\\|\\s_\\)+:[ \t]*\\)?if[ \t]*(") (defun esatan-end-if () "Search forwards for first unmatched ENDIF. Return point or nil." (let ((case-fold-search t)) (if (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") (looking-at "end[ \t]*if\\b")) ;; Sitting on one. (match-beginning 0) ;; Search for one. The point has been already been moved to first ;; letter on line but this should not cause troubles. (save-excursion (let ((count 1)) (while (and (not (= count 0)) (not (eq (esatan-next-statement) 'last-statement)) ;; Keep local to subprogram. (not (and (looking-at esatan-end-prog-re) (esatan-check-end-prog-re)))) (skip-chars-forward " \t0-9") (cond ((looking-at "end[ \t]*if\\b") (setq count (- count 1))) ((looking-at esatan-if-start-re) (save-excursion (if (or (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]") (let (then-test) ; Multi-line if-then. (while (and (= (forward-line 1) 0) ;; Search forward for then. (or (looking-at " [^ 0\n]") (looking-at "\t[1-9]")) (not (setq then-test (looking-at ".*then\\b[ \t]*[^ \t(=a-z0-9]"))))) then-test)) (setq count (+ count 1))))))) (and (= count 0) ;; All pairs accounted for. (point))))))) (defun esatan-beginning-if () "Search backwards for first unmatched IF-THEN. Return point or nil." (let ((case-fold-search t)) (if (save-excursion ;; May be sitting on multi-line if-then statement, first move to ;; beginning of current statement. Note: `esatan-previous-statement' ;; moves to previous statement *unless* current statement is first ;; one. Only move forward if not first-statement. (if (not (eq (esatan-previous-statement) 'first-statement)) (esatan-next-statement)) (skip-chars-forward " \t0-9") (and (looking-at esatan-if-start-re) (save-match-data (or (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]") ;; Multi-line if-then. (let (then-test) (while (and (= (forward-line 1) 0) ;; Search forward for then. (or (looking-at " [^ 0\n]") (looking-at "\t[1-9]")) (not (setq then-test (looking-at ".*then\\b[ \t]*[^ \t(=a-z0-9]"))))) then-test))))) ;; Sitting on one. (match-beginning 0) ;; Search for one. (save-excursion (let ((count 1)) (while (and (not (= count 0)) (not (eq (esatan-previous-statement) 'first-statement)) ;; Keep local to subprogram. (not (and (looking-at esatan-end-prog-re) (esatan-check-end-prog-re)))) (skip-chars-forward " \t0-9") (cond ((looking-at esatan-if-start-re) (save-excursion (if (or (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]") (let (then-test) ; Multi-line if-then. (while (and (= (forward-line 1) 0) ;; Search forward for then. (or (looking-at " [^ 0\n]") (looking-at "\t[1-9]")) (not (setq then-test (looking-at ".*then\\b[ \t]*[^ \t(=a-z0-9]"))))) then-test)) (setq count (- count 1))))) ((looking-at "end[ \t]*if\\b") (setq count (+ count 1))))) (and (= count 0) ;; All pairs accounted for. (point))))))) (defun esatan-indent-line () "Indent current esatan line based on its contents and on previous lines." (interactive) (let ((cfi (esatan-calculate-indent))) (save-excursion (beginning-of-line) (if (or (not (= cfi (esatan-current-line-indentation))) (and (re-search-forward "^[ \t]*[0-9]+" (+ (point) 4) t) (not (esatan-line-number-indented-correctly-p)))) (esatan-indent-to-column cfi) (beginning-of-line) (if (and (not (looking-at comment-line-start-skip)) (esatan-find-comment-start-skip)) (esatan-indent-comment)))) ;; Never leave point in left margin. (if (< (current-column) cfi) (move-to-column cfi)) (if (and auto-fill-function (> (save-excursion (end-of-line) (current-column)) fill-column)) (save-excursion (end-of-line) (esatan-fill))) (if esatan-blink-matching-if (progn (esatan-blink-matching-if) (esatan-blink-matching-do))))) (defun esatan-indent-new-line () "Reindent the current esatan line, insert a newline and indent the newline. An abbrev before point is expanded if variable `abbrev-mode' is non-nil." (interactive) (if abbrev-mode (expand-abbrev)) (save-excursion (beginning-of-line) (skip-chars-forward " \t") (let ((case-fold-search t)) (if (or (looking-at "[0-9]") ;Reindent only where it is most (looking-at "end") ;likely to be necessary (looking-at "else") (looking-at (regexp-quote esatan-continuation-string))) (esatan-indent-line)))) (newline) (esatan-indent-line)) (defun esatan-indent-subprogram () "Properly indent the esatan subprogram which contains point." (interactive) (save-excursion (mark-esatan-subprogram) (message "Indenting subprogram...") (indent-region (point) (mark) nil)) (message "Indenting subprogram...done.")) (defun esatan-calculate-indent () "Calculates the esatan indent column based on previous lines." (let (icol first-statement (case-fold-search t) (esatan-minimum-statement-indent (if indent-tabs-mode esatan-minimum-statement-indent-tab esatan-minimum-statement-indent-fixed))) (save-excursion (setq first-statement (esatan-previous-statement)) (if first-statement (setq icol esatan-minimum-statement-indent) (progn (if (= (point) (point-min)) (setq icol esatan-minimum-statement-indent) (setq icol (esatan-current-line-indentation))) (skip-chars-forward " \t0-9") (cond ((looking-at "\\(\\(\\sw\\|\\s_\\)+:[ \t]*\\)?if[ \t]*(") (if (or (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t_$(=a-z0-9]") (let (then-test) ;multi-line if-then (while (and (= (forward-line 1) 0) ;;search forward for then (or (looking-at " [^ 0\n]") (looking-at "\t[1-9]")) (not (setq then-test (looking-at ".*then\\b[ \t]\ *[^ \t_$(=a-z0-9]"))))) then-test)) (setq icol (+ icol esatan-if-indent)))) ((looking-at "else\\(if\\)?\\b") (setq icol (+ icol esatan-if-indent))) ((looking-at "select[ \t]*case[ \t](.*)") (setq icol (+ icol esatan-if-indent))) ((looking-at "case[ \t]*(.*)") (setq icol (+ icol esatan-if-indent))) ((looking-at "case[ \t]*default\\b") (setq icol (+ icol esatan-if-indent))) ((looking-at "\\(otherwise\\|else[ \t]*where\\)\\b") (setq icol (+ icol esatan-if-indent))) ((looking-at "where[ \t]*(.*)[ \t]*\n") (setq icol (+ icol esatan-if-indent))) ((looking-at "do\\b") (setq icol (+ icol esatan-do-indent))) ((looking-at "\\(structure\\|union\\|map\\|interface\\)\\b[ \t]*[^ \t=(a-z]") (setq icol (+ icol esatan-structure-indent))) ((and (looking-at esatan-end-prog-re1) (esatan-check-end-prog-re)) ;; Previous END resets indent to minimum (setq icol esatan-minimum-statement-indent)))))) (save-excursion (beginning-of-line) (cond ((looking-at "[ \t]*$")) ((looking-at comment-line-start-skip) (cond ((eq esatan-comment-indent-style 'relative) (setq icol (+ icol esatan-comment-line-extra-indent))) ((eq esatan-comment-indent-style 'fixed) (setq icol (+ esatan-minimum-statement-indent esatan-comment-line-extra-indent)))) (setq esatan-minimum-statement-indent 0)) ((or (looking-at (concat "[ \t]*" (regexp-quote esatan-continuation-string))) (looking-at " [^ 0\n]") (looking-at "\t[1-9]")) (setq icol (+ icol esatan-continuation-indent))) ((looking-at "[ \t]*#") ; Check for cpp directive. (setq esatan-minimum-statement-indent 0 icol 0)) (first-statement) ((and esatan-check-all-num-for-matching-do (looking-at "[ \t]*[0-9]+") (esatan-check-for-matching-do)) (setq icol (- icol esatan-do-indent))) (t (skip-chars-forward " \t0-9") (cond ((looking-at "end[ \t]*\\(if\\|select\\|where\\)\\b") (setq icol (- icol esatan-if-indent))) ((looking-at "else\\(if\\)?\\b") (setq icol (- icol esatan-if-indent))) ((looking-at "case[ \t]*\\((.*)\\|default\\>\\)") (setq icol (- icol esatan-if-indent))) ((looking-at "\\(otherwise\\|else[ \t]*where\\)\\b") (setq icol (- icol esatan-if-indent))) ((and (looking-at "continue\\b") (esatan-check-for-matching-do)) (setq icol (- icol esatan-do-indent))) ((looking-at "end[ \t]*do\\b") (setq icol (- icol esatan-do-indent))) ((looking-at "end[ \t]*\ \\(structure\\|union\\|map\\|interface\\)\\b[ \t]*[^ \t=(a-z]") (setq icol (- icol esatan-structure-indent))) ((and (looking-at esatan-end-prog-re1) (esatan-check-end-prog-re) (not (= icol esatan-minimum-statement-indent))) (message "Warning: `end' not in column %d. Probably\ an unclosed block." esatan-minimum-statement-indent)))))) (max esatan-minimum-statement-indent icol))) (defun esatan-current-line-indentation () "Indentation of current line, ignoring esatan line number or continuation. This is the column position of the first non-whitespace character aside from the line number and/or column 5/8 line-continuation character. For comment lines, returns indentation of the first non-indentation text within the comment." (save-excursion (beginning-of-line) (cond ((looking-at comment-line-start-skip) (goto-char (match-end 0)) (skip-chars-forward (if (stringp esatan-comment-indent-char) esatan-comment-indent-char (char-to-string esatan-comment-indent-char)))) ((or (looking-at " [^ 0\n]") (looking-at "\t[1-9]")) (goto-char (match-end 0))) (t ;; Move past line number. (skip-chars-forward "[ \t0-9]");From Uli )) ;; Move past whitespace. (skip-chars-forward " \t") (current-column))) (defun esatan-indent-to-column (col) "Indent current line with spaces to column COL. notes: 1) A non-zero/non-blank character in column 5 indicates a continuation line, and this continuation character is retained on indentation; 2) If `esatan-continuation-string' is the first non-whitespace character, this is a continuation line; 3) A non-continuation line which has a number as the first non-whitespace character is a numbered line. 4) A TAB followed by a digit indicates a continuation line." (save-excursion (beginning-of-line) (if (looking-at comment-line-start-skip) (if esatan-comment-indent-style (let ((char (if (stringp esatan-comment-indent-char) (aref esatan-comment-indent-char 0) esatan-comment-indent-char))) (goto-char (match-end 0)) (delete-horizontal-regexp (concat " \t" (char-to-string char))) (insert-char char (- col (current-column))))) (if (looking-at "\t[1-9]") (if indent-tabs-mode (goto-char (match-end 0)) (delete-char 2) (insert " ") (insert esatan-continuation-string)) (if (looking-at " [^ 0\n]") (if indent-tabs-mode (progn (delete-char 6) (insert "\t") (insert-char (esatan-numerical-continuation-char) 1)) (forward-char 6)) (delete-horizontal-space) ;; Put line number in columns 0-4 ;; or put continuation character in column 5. (cond ((eobp)) ((looking-at (regexp-quote esatan-continuation-string)) (if indent-tabs-mode (progn (indent-to (if indent-tabs-mode esatan-minimum-statement-indent-tab esatan-minimum-statement-indent-fixed)) (delete-char 1) (insert-char (esatan-numerical-continuation-char) 1)) (indent-to 5) (forward-char 1))) ((looking-at "[0-9]+") (let ((extra-space (- 5 (- (match-end 0) (point))))) (if (< extra-space 0) (message "Warning: line number exceeds 5-digit limit.") (indent-to (min esatan-line-number-indent extra-space)))) (skip-chars-forward "0-9"))))) ;; Point is now after any continuation character or line number. ;; Put body of statement where specified. (delete-horizontal-space) (indent-to col) ;; Indent any comment following code on the same line. (if (and comment-start-skip (esatan-find-comment-start-skip)) (progn (goto-char (match-beginning 0)) (if (not (= (current-column) (esatan-comment-hook))) (progn (delete-horizontal-space) (indent-to (esatan-comment-hook))))))))) (defun esatan-line-number-indented-correctly-p () "Return t if current line's line number is correctly indented. Do not call if there is no line number." (save-excursion (beginning-of-line) (skip-chars-forward " \t") (and (<= (current-column) esatan-line-number-indent) (or (= (current-column) esatan-line-number-indent) (progn (skip-chars-forward "0-9") (= (current-column) 5)))))) (defun esatan-check-for-matching-do () "When called from a numbered statement, return t if matching DO is found. Otherwise return nil." (let (charnum (case-fold-search t)) (save-excursion (beginning-of-line) (if (looking-at "[ \t]*[0-9]+") (progn (skip-chars-forward " \t") (skip-chars-forward "0") ;skip past leading zeros (setq charnum (buffer-substring (point) (progn (skip-chars-forward "0-9") (point)))) (beginning-of-line) (esatan-with-subprogram-narrowing (and (re-search-backward (concat "\\(^[ \t0-9]*do[ \t]*0*" charnum "\\b\\)\\|" "\\(^[ \t]*0*" charnum "\\b\\)") nil t) (looking-at (concat "^[ \t0-9]*do[ \t]*0*" charnum))))))))) (defun esatan-find-comment-start-skip () "Move to past `comment-start-skip' found on current line. Return t if `comment-start-skip' found, nil if not." ;; In order to move point only if comment-start-skip is found, this ;; one uses a lot of save-excursions. Note that re-search-forward ;; moves point even if comment-start-skip is inside a string-constant. ;; Some code expects certain values for match-beginning and end (interactive) (if (save-excursion (re-search-forward comment-start-skip (save-excursion (end-of-line) (point)) t)) (let ((save-match-beginning (match-beginning 0)) (save-match-end (match-end 0))) (if (esatan-is-in-string-p (match-beginning 0)) (save-excursion (goto-char save-match-end) (esatan-find-comment-start-skip)) ; recurse for rest of line (goto-char save-match-beginning) (re-search-forward comment-start-skip (save-excursion (end-of-line) (point)) t) (goto-char (match-end 0)) t)) nil)) ;;From: simon@gnu (Simon Marshall) ;; Find the next ! not in a string. (defun esatan-match-!-comment (limit) (let (found) (while (and (setq found (search-forward "!" limit t)) (esatan-is-in-string-p (point)))) (if (not found) nil ;; Cheaper than `looking-at' "!.*". (set-match-data (list (1- (point)) (progn (end-of-line) (min (point) limit)))) t))) ;; The above function is about 10% faster than the below... ;;(defun esatan-match-!-comment (limit) ;; (let (found) ;; (while (and (setq found (re-search-forward "!.*" limit t)) ;; (esatan-is-in-string-p (match-beginning 0)))) ;; found)) ;;From: ralf@up3aud1.gwdg.de (Ralf Fassel) ;; Test if TAB format continuation lines work. (defun esatan-is-in-string-p (where) "Return non-nil iff WHERE (a buffer position) is inside a esatan string." (save-excursion (goto-char where) (cond ((bolp) nil) ; bol is never inside a string ((save-excursion ; comment lines too (beginning-of-line) (looking-at comment-line-start-skip)) nil) (t (let (;; ok, serious now. Init some local vars: (parse-state '(0 nil nil nil nil nil 0)) (quoted-comment-start (if comment-start (regexp-quote comment-start))) (not-done t) parse-limit end-of-line ) ;; move to start of current statement (esatan-next-statement) (esatan-previous-statement) ;; now parse up to WHERE (while not-done (if (or ;; skip to next line if: ;; - comment line? (looking-at comment-line-start-skip) ;; - at end of line? (eolp) ;; - not in a string and after comment-start? (and (not (nth 3 parse-state)) comment-start (equal comment-start (char-to-string (preceding-char))))) (if (> (forward-line) 0) (setq not-done nil)) ;; else: ;; if we are at beginning of code line, skip any ;; whitespace, labels and tab continuation markers. (if (bolp) (skip-chars-forward " \t0-9")) ;; if we are in column <= 5 now, check for continuation char (cond ((= 5 (current-column)) (forward-char 1)) ((and (< (current-column) 5) (equal esatan-continuation-string (char-to-string (following-char))) (forward-char 1)))) ;; find out parse-limit from here (setq end-of-line (save-excursion (end-of-line)(point))) (setq parse-limit (min where end-of-line)) ;; parse max up to comment-start, if non-nil and in current line (if comment-start (save-excursion (if (re-search-forward quoted-comment-start end-of-line t) (setq parse-limit (min (point) parse-limit))))) ;; now parse if still in limits (if (< (point) where) (setq parse-state (parse-partial-sexp (point) parse-limit nil nil parse-state)) (setq not-done nil)) )) ;; result is (nth 3 parse-state)))))) (defun esatan-auto-fill-mode (arg) "Toggle esatan-auto-fill mode. With ARG, turn `esatan-auto-fill' mode on iff ARG is positive. In `esatan-auto-fill' mode, inserting a space at a column beyond `fill-column' automatically breaks the line at a previous space." (interactive "P") (prog1 (setq auto-fill-function (if (if (null arg) (not auto-fill-function) (> (prefix-numeric-value arg) 0)) #'esatan-do-auto-fill nil)) (force-mode-line-update))) (defun esatan-do-auto-fill () (if (> (current-column) fill-column) (esatan-indent-line))) (defun esatan-fill () (interactive) (let* ((auto-fill-function #'esatan-do-auto-fill) (opoint (point)) (bol (save-excursion (beginning-of-line) (point))) (eol (save-excursion (end-of-line) (point))) (bos (min eol (+ bol (esatan-current-line-indentation)))) (quote (save-excursion (goto-char bol) (if (looking-at comment-line-start-skip) nil ; OK to break quotes on comment lines. (move-to-column fill-column) (if (esatan-is-in-string-p (point)) (save-excursion (re-search-backward "\\S\"\\s\"\\S\"" bol t) (if esatan-break-before-delimiters (point) (1+ (point)))))))) ;; decide where to split the line. If a position for a quoted ;; string was found above then use that, else break the line ;; before the last delimiter. ;; Delimiters are whitespace, commas, and operators. ;; Will break before a pair of *'s. (fill-point (or quote (save-excursion (move-to-column (1+ fill-column)) (skip-chars-backward "^ \t\n,'+-/*=)" ;;; (if esatan-break-before-delimiters ;;; "^ \t\n,'+-/*=" "^ \t\n,'+-/*=)") ) (if (<= (point) (1+ bos)) (progn (move-to-column (1+ fill-column)) ;;what is this doing??? (if (not (re-search-forward "[\t\n,'+-/*)=]" eol t)) (goto-char bol)))) (if (bolp) (re-search-forward "[ \t]" opoint t) (backward-char) (if (looking-at "\\s\"") (forward-char) (skip-chars-backward " \t\*"))) (if esatan-break-before-delimiters (point) (1+ (point))))))) ;; if we are in an in-line comment, don't break unless the ;; line of code is longer than it should be. Otherwise ;; break the line at the column computed above. ;; ;; Need to use esatan-find-comment-start-skip to make sure that quoted !'s ;; don't prevent a break. (if (not (or (save-excursion (if (and (re-search-backward comment-start-skip bol t) (not (esatan-is-in-string-p (point)))) (progn (skip-chars-backward " \t") (< (current-column) (1+ fill-column))))) (save-excursion (goto-char fill-point) (bolp)))) (if (> (save-excursion (goto-char fill-point) (current-column)) (1+ fill-column)) (progn (goto-char fill-point) (esatan-break-line)) (save-excursion (if (> (save-excursion (goto-char fill-point) (current-column)) (+ (esatan-calculate-indent) esatan-continuation-indent)) (progn (goto-char fill-point) (esatan-break-line)))))) )) (defun esatan-break-line () (let ((opoint (point)) (bol (save-excursion (beginning-of-line) (point))) (eol (save-excursion (end-of-line) (point))) (comment-string nil)) (save-excursion (if (and comment-start-skip (esatan-find-comment-start-skip)) (progn (re-search-backward comment-start-skip bol t) (setq comment-string (buffer-substring (point) eol)) (delete-region (point) eol)))) ;; Forward line 1 really needs to go to next non white line (if (save-excursion (forward-line) (or (looking-at " [^ 0\n]") (looking-at "\t[1-9]"))) (progn (end-of-line) (delete-region (point) (match-end 0)) (delete-horizontal-space) (esatan-fill)) (esatan-split-line)) (if comment-string (save-excursion (goto-char bol) (end-of-line) (delete-horizontal-space) (indent-to (esatan-comment-hook)) (insert comment-string))))) (defun esatan-analyze-file-format () "Return nil if fixed format is used, t if TAB formatting is used. Use `esatan-tab-mode-default' if no non-comment statements are found in the file before the end or the first `esatan-analyze-depth' lines." (let ((i 0)) (save-excursion (goto-char (point-min)) (setq i 0) (while (not (or (eobp) (looking-at "\t") (looking-at " ") (> i esatan-analyze-depth))) (forward-line) (setq i (1+ i))) (cond ((looking-at "\t") t) ((looking-at " ") nil) (esatan-tab-mode-default t) (t nil))))) (or (assq 'esatan-tab-mode-string minor-mode-alist) (setq minor-mode-alist (cons '(esatan-tab-mode-string (indent-tabs-mode esatan-tab-mode-string)) minor-mode-alist))) (defun esatan-fill-paragraph (&optional justify) "Fill surrounding comment block as paragraphs, else fill statement. Intended as the value of `fill-paragraph-function'." (interactive "P") (save-excursion (beginning-of-line) (if (not (looking-at "[Cc*]")) (esatan-fill-statement) ;; We're in a comment block. Find the start and end of a ;; paragraph, delimited either by non-comment lines or empty ;; comments. (Get positions as markers, since the ;; `indent-region' below can shift the block's end). (let* ((non-empty-comment (concat "\\(" comment-line-start-skip "\\)" "[^ \t\n]")) (start (save-excursion ;; Find (start of) first line. (while (and (zerop (forward-line -1)) (looking-at non-empty-comment))) (or (looking-at non-empty-comment) (forward-line)) ; overshot (point-marker))) (end (save-excursion ;; Find start of first line past region to fill. (while (progn (forward-line) (looking-at non-empty-comment))) (point-marker)))) ;; Indent the block, find the string comprising the effective ;; comment start skip and use that as a fill-prefix for ;; filling the region. (indent-region start end nil) (let ((paragraph-ignore-fill-prefix nil) (fill-prefix (progn (beginning-of-line) (looking-at comment-line-start-skip) (match-string 0)))) (let (fill-paragraph-function) (fill-region start end justify))) ; with normal `fill-paragraph' (set-marker start nil) (set-marker end nil)))) t) (defun esatan-fill-statement () "Fill a fortran statement up to `fill-column'." (interactive) (let ((auto-fill-function #'esatan-do-auto-fill)) (if (not (save-excursion (beginning-of-line) (or (looking-at "[ \t]*$") (looking-at comment-line-start-skip) (and comment-start-skip (looking-at (concat "[ \t]*" comment-start-skip)))))) (save-excursion ;; Find beginning of statement. (esatan-next-statement) (esatan-previous-statement) ;; Re-indent initially. (esatan-indent-line) ;; Replace newline plus continuation field plus indentation with ;; single space. (while (progn (forward-line) (esatan-remove-continuation))) (esatan-previous-statement))) (esatan-indent-line))) (provide 'esatan) ;;; esatan.el ends here