Mercurial > hg > xemacs-beta

comparison lisp/modes/fortran-misc.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
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 )