cgit.sxemacs.org Git - packages/blob - xemacs-packages/fortran-modes/fortran-misc.el

   1 ;;; fortran-misc.el --- Routines than can be used with fortran mode.
   2
   3 ;;; Copyright (c) 1992 Free Software Foundation, Inc.
   4
   5 ;; Author: Various authors.
   6 ;; Maintainer:
   7 ;; Version
   8 ;; Keywords: languages
   9
  10 ;; This file is not part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  24 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  25
  26 ;;; Commentary:
  27
  28 ;;; This file contains various routines that may be useful with GNU emacs
  29 ;;; fortran mode, but just don't seem to fit in.
  30
  31 (defun fortran-fill-statement ()
  32   "Fill a fortran statement up to `fill-column'."
  33   (interactive)
  34   (if (save-excursion
  35         (beginning-of-line)
  36         (or (looking-at "[ \t]*$")
  37             (looking-at comment-line-start-skip)
  38             (and comment-start-skip
  39                  (looking-at (concat "[ \t]*" comment-start-skip)))))
  40       (fortran-indent-line)
  41     (let ((opos (point)) (beg) (cfi))
  42       (save-excursion
  43         (fortran-next-statement)
  44         (fortran-previous-statement)
  45         (setq cfi (calculate-fortran-indent))
  46         (setq beg (point)))
  47       (save-excursion
  48         (goto-char beg)
  49         (save-excursion
  50           ;;(beginning-of-line)
  51           (if (or (not (= cfi (fortran-current-line-indentation)))
  52                   (and (re-search-forward "^[ \t]*[0-9]+" (+ (point) 4) t)
  53                        (not (fortran-line-number-indented-correctly-p))))
  54               (fortran-indent-to-column cfi)))
  55         (while (progn
  56                  (forward-line 1)
  57                  (or (looking-at "     [^ 0\n]")
  58                      (looking-at "\t[1-9]")))
  59           (delete-indentation)
  60           (delete-char 2)
  61           (delete-horizontal-space))
  62         (fortran-previous-statement)
  63         (if (> (save-excursion (end-of-line) (current-column)) fill-column)
  64             (fortran-do-auto-fill)))
  65       (if (< (point) opos) (goto-char opos))
  66       (let ((cfi (calculate-fortran-indent)))
  67         (if (< (current-column) cfi)
  68           (move-to-column cfi))))))
  69
  70 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  71 ;;; The upcase/downcase and beautifier code is originally from Ralph Finch
  72 ;;; (rfinch@water.ca.gov).
  73 ;;;
  74 (defun fortran-downcase-subprogram ()
  75   "Properly downcases the Fortran subprogram which contains point."
  76   (interactive)
  77   (save-excursion
  78     (mark-fortran-subprogram)
  79     (message "Downcasing subprogram...")
  80     (fortran-downcase-region (point) (mark)))
  81   (message "Downcasing subprogram...done."))
  82
  83 (defun fortran-downcase-region (start end)
  84   "Downcase region, excluding comment lines and anything
  85 between quote marks."
  86   (interactive "r")
  87   (fortran-case-region start end nil))
  88
  89 (defun fortran-upcase-region (start end)
  90   "Upcase region, excluding comment lines and anything
  91 between quote marks."
  92   (interactive "r")
  93   (fortran-case-region start end t))
  94
  95 (defun fortran-upcase-subprogram ()
  96   "Properly upcases the Fortran subprogram which contains point."
  97   (interactive)
  98   (save-excursion
  99     (mark-fortran-subprogram)
 100     (message "Upcasing subprogram...")
 101     (fortran-upcase-region (point) (mark)))
 102   (message "Upcasing subprogram...done."))
 103
 104 (defun fortran-case-region (start end up)
 105   "Upcase region if UP is t, downcase, if UP downcase region,
 106  excluding comment lines and anything between quote marks."
 107   (let* ((start-re-comment "^[cC*#]")
 108          (end-re-comment "$")
 109          (start-re-quote "'")
 110          (end-re-quote "\\('\\|$\\)")
 111          (start-re-dquote (char-to-string ?\"))
 112          (end-re-dquote (concat "\\(" start-re-dquote "\\|$\\)"))
 113          (strt) (fin))
 114     (save-excursion
 115       (save-restriction
 116         (narrow-to-region start end)
 117         (goto-char (point-min))
 118         (if (inside-re start-re-comment end-re-comment)
 119             (re-search-forward end-re-comment end 0))
 120         (if (inside-re start-re-quote end-re-quote)
 121             (re-search-forward end-re-quote end 0))
 122         (if (inside-re start-re-dquote end-re-dquote)
 123             (re-search-forward end-re-dquote end 0))
 124         (setq strt (point))
 125         (while (< (point) (point-max))
 126           (re-search-forward
 127            (concat "\\(" start-re-comment "\\|"
 128                    start-re-quote "\\|" start-re-dquote "\\)") end 0)
 129           (setq fin (point))
 130           (if up
 131               (upcase-region strt fin)
 132             (downcase-region strt fin))
 133           (if (inside-re start-re-comment end-re-comment)
 134               (re-search-forward end-re-comment end 0))
 135           (if (inside-re start-re-quote end-re-quote)
 136               (re-search-forward end-re-quote end 0))
 137           (if (inside-re start-re-dquote end-re-dquote)
 138               (re-search-forward end-re-dquote end 0))
 139           (setq strt (point)))))))
 140
 141 (defun inside-re (start-re end-re)
 142   "Returns t if inside a starting regexp and an ending regexp
 143 on the same line."
 144   (interactive "s")
 145   (let ((start-line) (end-line))
 146     (save-excursion
 147       (setq start-line (progn (beginning-of-line) (point)))
 148       (setq end-line (progn (end-of-line) (point))))
 149     (if (and (save-excursion
 150                (re-search-backward start-re start-line t))
 151              (save-excursion
 152                (re-search-forward end-re end-line t)))
 153         t
 154       nil)))
 155
 156 ;;; Note: Just as with some other routines, fortran-beautify-line
 157 ;;;       assumes trailing blanks are not significant. Code may need
 158 ;;;       to be adjusted to comply with this.
 159
 160
 161 (defun fortran-beautify-subprogram (&optional downit)
 162   "Beautify Fortran subprogram:
 163 1) Remove trailing blanks.
 164 2) Replace all continuation characters with fortran-continuation-char.
 165 3) Replace all empty comment lines with blank lines.
 166 4) Replace all multiple blank lines with one blank line.
 167 5) Indent.
 168 6) With prefix arg, downcase the subprogram, avoiding comments and
 169 quoted strings."
 170   (interactive "P")
 171   (save-excursion
 172     (mark-fortran-subprogram)
 173     (message "Beautifying subprogram...")
 174     (fortran-beautify-region (point) (mark) downit))
 175   (message "Beautify subprogram...done."))
 176
 177 (defun fortran-beautify-region (start end &optional downit)
 178   "Beautify region in a Fortran program:
 179 1) Remove trailing blanks.
 180 2) Replace all continuation characters with fortran-continuation-char.
 181 3) Replace all empty comment lines with blank lines.
 182 4) Replace all multiple blank lines with one blank line.
 183 5) Indent.
 184 6) With prefix arg, downcase the region, avoiding comments and
 185  quoted strings."
 186   (interactive "r\nP")
 187   (save-excursion
 188     (save-restriction
 189       (let ((m1 (make-marker))
 190             (m2 (make-marker)))
 191         (set-marker m1 start)
 192         (set-marker m2 end)
 193         (indent-region start end nil)
 194         (narrow-to-region m1 m2)
 195         (goto-char (point-min))         ; trailing blanks
 196         (perform-replace "[ \t]+$" "" nil t nil)
 197         (goto-char (point-min))         ; continuation characters
 198         (perform-replace (concat "^     [^ " fortran-continuation-string
 199                                  "]" )
 200                          (concat "     " fortran-continuation-string)
 201                          nil t nil)
 202         (goto-char (point-min))         ; empty comments
 203         (perform-replace "^[cC][ \t]*$" "" nil t nil)
 204         (goto-char (point-min))         ; multiple blank lines
 205         (perform-replace "\n\n\n+" "\n\n" nil t nil)
 206         (if downit
 207             (fortran-downcase-region (point-min) (point-max)))
 208         )))
 209
 210 )