1;;; ftnchek.el --- ftnchek support for fortran mode. 2;; 3;; Author: Judah Milgram <milgram@cgpp.com> 4 5(defvar ftnchek-mode-version "0.9") 6(defvar ftnchek-mode-date "12/16/2002") 7 8;; Keywords: fortran syntax semantic 9;; Current version at: http://www.glue.umd.edu/~milgram/ftnchekel.html 10;; 11;; Copyright 1998-2002 Judah Milgram 12;; 13;; This program is free software; you can redistribute it and/or modify 14;; it under the terms of the GNU General Public License as published by 15;; the Free Software Foundation; either version 2, or (at your option) 16;; any later version. 17;; 18;; This program is distributed in the hope that it will be useful, 19;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21;; GNU General Public License for more details. 22;; 23;; You should have received a copy of the GNU General Public License 24;; along with this program; if not, write to the Free Software 25;; Foundation, Inc., 59 Temple Place - Suite 330, 26;; Boston, MA 02111-1307, USA. 27;; 28;; ================================================================== 29;; 30;;; FTNCHEK: Ftnchek is a fortran 77 syntax and semantics checker 31;; by Dr. Robert Moniot, <moniot@fordham.edu>. Get it at 32;; http://www.dsm.fordham.edu/~ftnchek/ 33;; 34;;====================================================================== 35;; 36;; INSTALLATION: 37;; 38;; Install ftnchek.el somewhere in your lisp load path. Maybe add 39;; lines in your ~/.emacs along the lines of: 40;; 41;; (setq my-path (concat (getenv "HOME") "/local/share/emacs/site-lisp" 42;; (setq load-path (cons my-path load-path)) 43;; (add-hook 'fortran-mode-hook (require 'ftnchek-mode "ftnchek")) 44;; 45;; Byte-compile ftnchek.el, if you want. 46;; 47;; To Do: 48;; 49;; How do we handle case were comments precede first subroutine in 50;; library file? ftnchek-mode thinks it's an unnamed main. 51;; Soup up regexps to tolerate embedded blanks. 52;; Documentation! Info file, etc. (for ftnchek too!) 53;; Splash-blurb if ftnchek not found; message where to get 54;; Make ftnchek-flags easier for user to customize (one for buffer, 55;; one for subprogram) 56;; 57;; ==================================================================== 58;; 59;; Acknowledgements: 60;; Bruce Ravel, Jinwei Shen, Richard Stallman, and many others for advice, 61;; suggestions and testing. 62;; Also: Michael D. Prange and Dave Love for fortran mode 63;; And especially: Bob Moniot for ftnchek! 64;; 65;; ==================================================================== 66;; History: 67;; v 0.9 12/16/02 update Bob Moniot contact info 68;; update acks 69;; fix message bug in ftnchek-check-subprogram 70;; clean up some comments 71;; improved ftnchek-error-first-line 72;; many setq's changed to defvar 73;; simplified ftnchek-current-subprogram 74;; consolidated dangling parentheses :) 75;; miscellaneous cleanup to permit byte-compile w/o warnings 76;; v 0.8 12/10/02 oops, regexp-opt causes problems, switch to regexp-or 77;; v 0.7 12/4/02 Tested with emacs 21 78;; Menu-bar renamed "Ftnchek" and simplified 79;; much internal cleanup and re-write 80;; "next-error" in compile mode works much better now 81;; removed some functions that are now in Fortran-mode 82;; re-did menu with "easy-menu" 83;; pipe ftnchek through sed to make file name look right 84;; v 0.6 6/17/98 placed completion-ignore-case in a let 85;; defvar ftnchek-mode 86;; defun ftnchek-mode 87;; V 0.5 6/14/98 implemented "ftnchek-next-error" 88;; played with ftnchek-flags (array=2) 89;; V 0.4 6/12/98 added require to "compile" 90;; got "fortran-goto-subprogram" working 91;; V 0.3 6/11/98 first public release 92 93(require 'fortran) 94(require 'compile) 95 96(defvar ftnchek-maintainer "<milgram@cgpp.com>") 97(defvar ftnchek-flags nil) 98(defvar ftnchek-startup-message) ; maybe do this with "let"? 99 100(defvar ftnchek-mode nil 101 "Mode variable for ftnchek minor mode") 102(make-variable-buffer-local 'ftnchek-mode) 103 104(defcustom ftnchek-buffer-flags 105 "-arguments -noextern -declare -library -noarray -portability -usage=no-com-var-uninitialized -include=." 106 "Ftnchek options to use when checking an entire buffer") 107(defcustom ftnchek-subprogram-flags 108 "-arguments -noextern -declare -library -noarray -portability -usage=no-com-var-uninitialized -include=." 109 "Ftnchek options to use when checking an individual subprogram") 110(defcustom ftnchek-f77-flags 111 nil 112 "F77 strictness flags that get toggled in pull-down menu") 113 114(defun ftnchek-mode(&optional arg) 115 "Ftnchek minor mode." 116 (interactive "P") 117 (setq ftnchek-mode 118 (if (null arg) 119 (not ftnchek-mode) 120 (> (prefix-numeric-value arg) 0)))) 121; (if ftnchek-mode ... etc. 122 123(defun ftnchek-temp-file(s) 124 "Generate a temp file with .f suffix" 125 (concat 126 (make-temp-name 127 (expand-file-name s temporary-file-directory)) 128 ".f")) 129 130(defun ftnchek-delete-lines-forward() 131 "Delete all lines starting with current line" 132 (save-excursion 133 (let ((begin (point)) 134 (end (point-max))) 135 (delete-region begin end)))) 136 137(defun ftnchek-mask-lines-before-here() 138 "Replace all lines preceding point with blank lines" 139 (save-excursion 140 (while (= (forward-line -1) 0) 141 (beginning-of-line) 142 (let ((beg (point))) 143 (end-of-line) 144 (delete-region beg (point)))))) 145 146(defvar 147 ftnchek-error-regexp-alist 148 (list 149;; line 1 col 2 file foo.f 150 (list ".*line \\([0-9]+\\)\\( col \\([0-9]+\\)\\)? file \\([^ ;$|:\n\t]+\\)" 4 1 3) 151;; "foo.f", line 14 col 19: 152 (list "\"\\([^\"]+\\)\", \\(near \\)?line \\([0-9]+\\)\\( col \\([0-9]+\\)\\)?" 1 3 5))) 153 154 155(defun ftnchek-region(ftnchek-flags) 156 "Run ftnchek on a region using compile()" 157 ;; first, last are character positions. Convert to line positions. 158 (let ((temp-file (ftnchek-temp-file "ftnchek" )) 159 (first (point)) 160 (last (mark)) ) 161 (copy-region-as-kill (point-min) (point-max)) 162 (with-temp-file temp-file 163 (yank) 164 (goto-char last) 165 (ftnchek-delete-lines-forward) 166 (goto-char first) 167 (ftnchek-mask-lines-before-here) 168 ) 169 (compile-internal (ftnchek-command temp-file ftnchek-flags (buffer-name)) "No more errors" nil nil ftnchek-error-regexp-alist nil nil nil nil ))) 170 171(defun ftnchek-command(file-name &optional flags real-name) 172 "Form the command to run ftnchek" 173 ;; begin and end are line numbers, not char numbers. 174 ;; Start by sending file-name to stdout, possibly 175 (let ((rval "ftnchek ")) 176 (if (not (eq flags nil)) 177 (setq rval (concat rval flags " ")) 178 ) 179 (if (not (eq ftnchek-f77-flags nil)) 180 (setq rval (concat rval ftnchek-f77-flags " ")) 181 ) 182 (setq rval (concat rval "-quiet " file-name)) 183 (if (not (eq real-name nil)) 184 ;; a bit dangerous - 185 ;; we assume this means file-name is a temp file 186 ;; maybe not always the case ! 187 (setq rval (concat rval " | sed 's|" file-name 188 "|" real-name "|g' && rm -f " file-name))) 189 rval)) 190 191(defun ftnchek-buffer() 192 "Run ftnchek on current buffer." 193 (interactive) 194 (save-excursion 195 (mark-whole-buffer) 196 (ftnchek-region ftnchek-buffer-flags) 197 (message "Checking entire buffer %s" (buffer-name)))) 198 199(defun ftnchek-subprogram() 200 "Run ftnchek on suprogram the cursor is in. You can run 201 fortran-what-subprogram to find out what subprogram that is." 202 (interactive) 203 (save-excursion 204;; Use this for older versions of fortran-mode: 205;; (mark-fortran-subprogram) 206;; As of fortran mode v 21.2 or maybe even earlier: 207 (mark-defun) 208 (ftnchek-region ftnchek-subprogram-flags)) 209 (message "Checking %s" (ftnchek-current-subprogram))) 210 211 212(defun ftnchek-strict-f77() 213 "Toggle on strict Fortran 77 compliance checking" 214 (interactive) 215 (if (equal ftnchek-f77-flags "-f77") 216 (setq ftnchek-f77-flags nil) 217 (setq ftnchek-f77-flags "-f77"))) 218 219; I'm not sure I like these but nobody's complaining. 220(define-key fortran-mode-map "\C-x`" 'ftnchek-next-error) 221(define-key fortran-mode-map "\M-s" 'ftnchek-subprogram) 222(define-key fortran-mode-map "\M-b" 'ftnchek-buffer) 223(define-key fortran-mode-map "\M-p" 'ftnchek-previous-subprogram) 224(define-key fortran-mode-map "\M-n" 'ftnchek-next-subprogram) 225(define-key fortran-mode-map "\M-f" 'ftnchek-first-executable) 226(define-key fortran-mode-map "\M-h" 'ftnchek-what-subprogram) 227 228 229 230;; Menu 231;; Fortran-mode does this, but is it important for us too? 232;;(unless (boundp 'ftnchek-mode-menu) 233 (easy-menu-define 234 ftnchek-mode-menu fortran-mode-map "Ftnchek menu" 235 '("Ftnchek" 236 ["Check buffer " ftnchek-buffer t] 237 ["Check subprogram " ftnchek-subprogram t] 238 ["Next error " ftnchek-next-error t] 239 ["Ftnchek version " ftnchek-version-display t] 240 ["Strict F77 " ftnchek-strict-f77 :style toggle 241 :selected (equal ftnchek-f77-flags "-f77") ] 242 "----" 243 ;;; These items really belong in the fortran mode menu: 244 ["What subprogram? " ftnchek-what-subprogram t] 245 ["First executable " ftnchek-first-executable t] 246 ["Prev subprogram " ftnchek-previous-subprogram t] 247 ["Next subprogram " ftnchek-next-subprogram t] 248 )) 249 ;; ) 250 251 252; Startup message. Possibly useless. 253(setq ftnchek-startup-message 254 (concat "ftnchek.el " 255 " Version " 256 ftnchek-mode-version 257 " " 258 ftnchek-mode-date 259 " bugs to " 260 ftnchek-maintainer)) 261(message ftnchek-startup-message) 262(sleep-for 0.5) 263 264(defun ftnchek-version-display() 265"Print the ftnchek version and patch level." 266(interactive) 267(message (concat (ftnchek-version) "; ftnchek.el v. " ftnchek-mode-version))) 268 269;; This should probably be done with a pipe and sed. 270(defun ftnchek-version() 271 "Return ftnchek version as a string." 272 (let (first last outbuf) 273 (setq outbuf (get-buffer-create "*Ftnchek*")) 274 (set-buffer outbuf) 275 (goto-char (point-min)) 276 (setq first (point)) 277 (goto-char (point-max)) 278 (setq last (point)) 279 (if (> last first) (kill-region first last)) 280 (call-process "ftnchek" nil outbuf nil "-help") 281 (set-buffer outbuf) 282 (goto-char (point-min)) 283 (if (null (search-forward "FTNCHEK")) nil 284 (beginning-of-line) 285 (setq first (point)) 286 (end-of-line) 287 (setq last (point)) 288 (buffer-substring first last)))) 289 290(defun ftnchek-error-first-line() 291 "set first line of multiline ftnchek error message to top of window" 292 (let (( here (point))) 293 (beginning-of-line) 294 (if (not (looking-at "^.*\\(Warning\\|Error\\)")) 295 (re-search-backward "^.*\\(Warning\\|Error\\)" nil t) 296 (forward-line -1) 297 (if (not (looking-at "^ *\\^")) 298 (goto-char here) 299 (forward-line -1) 300 (if (not (looking-at "^ *[0-9]+")) 301 (forward-line 2)) 302 ))) 303 (recenter 0)) 304 305(defun ftnchek-next-error() 306"ftnchek mode wrapper for next-error" 307(interactive) 308(next-error) 309(other-window 1) 310(ftnchek-error-first-line) 311(other-window -1)) 312 313 314;; I hope this is a good idea 315(setq compilation-error-regexp-alist 316 (append ftnchek-error-regexp-alist 317 compilation-error-regexp-alist)) 318 319 320 321(provide 'ftnchek-mode) 322 323 324;;; *********************************************************************** 325; 326; Extra navigation stuff - maybe this functionality will be added to 327; Fortran mode, in which case we can drop it from here. 328; 329; Note ftnchek-mode's idea of where a program unit begins or ends may 330; not agree with fortran-mode. 331 332;; some useful regexps: 333 334(defun identity(x) x) 335(defun regexp-or(s &optional parens) 336 "OR together a bunch of regexp's. Optional argument if t adds outer parens" 337 (let ((rval (mapconcat 'identity s "\\|"))) 338 (if (eq parens nil) 339 rval 340 (concat "\\(" rval "\\)")))) 341 342;; What about embedded spaces? 343 344(defvar ftnchek-first-six-regexp "^[0-9 ][0-9 ][0-9 ][0-9 ][0-9 ] +") 345(defvar ftnchek-blank-line-regexp "^[ \t]*$") 346(defvar ftnchek-continuation-line-regexp "^[0-9 ][0-9 ][0-9 ][0-9 ][0-9 ][^ ] *") 347(defvar ftnchek-comment-regexp "^[Cc]" ) 348(defvar ftnchek-symbolic-name-regexp "\\([a-zA-Z][a-zA-Z0-9]*\\)") 349 350(defvar ftnchek-type-regexp-list (list 351 "integer" 352 "real" 353 "double *precision" 354 "complex" 355 "double *complex" ; not standard 356 "logical" 357 "\\(character\\( *\\* *[0-9]+\\)?\\)" )) 358 359(defvar ftnchek-type-regexp (regexp-or ftnchek-type-regexp-list t)) 360 361(defvar ftnchek-subprogram-end-regexp (concat ftnchek-first-six-regexp "end *$")) 362 363(defvar ftnchek-program-unit-begin-regexp 364 (concat ftnchek-first-six-regexp 365 (regexp-or (list 366 (concat ftnchek-type-regexp "? *function") 367 "subroutine" 368 "program" 369 "block *data") t) 370 " *" ftnchek-symbolic-name-regexp "?" )) 371 372;; See F77 standard, section 7. Note this regexp can't pick up 373;; statement functions, which F77 also classes as non-executable. 374 375; The items commented out are covered in ftnchek-type-regexp 376(defvar ftnchek-non-executable-keyword-regexp-list 377 (list 378 "block *data" 379 "character" 380 "common" 381 "complex" 382 "data" 383 "dimension" 384 "function" 385 "double *complex" ; not strict f77 386 "double *precision" 387 "entry" 388 "equivalence" 389 "external" 390 "format" 391 "implicit" 392 "include" ; not strict f77 393 "integer" 394 "intrinsic" 395 "logical" 396 "parameter" 397 "program" 398 "real" 399 "save" 400 "subroutine")) 401 402(defvar ftnchek-non-executable-statement-regexp 403 (concat ftnchek-first-six-regexp 404 (regexp-or ftnchek-non-executable-keyword-regexp-list t))) 405 406 407(defun ftnchek-program-unit-title() 408 "Return descriptive string for program unit, or nil" 409 (interactive) 410 (save-excursion 411 (beginning-of-line) 412 (if (not (looking-at ftnchek-program-unit-begin-regexp)) 413 nil 414 ;; Guess how I got those match-field numbers. 415 (let (( title (match-string 1) ) 416 ( name (match-string 5) )) 417 (if (not (eq name nil)) 418 (concat title " " name) 419 name))))) 420 421 422(defun ftnchek-end-of-subprogram() 423 "Move point to first character of end statement (or EOF)." 424 (let (( here (point) )) 425 (if (re-search-forward ftnchek-subprogram-end-regexp nil 1 ) 426 (beginning-of-line) 427 (if (re-search-backward ftnchek-subprogram-end-regexp nil t) 428 (beginning-of-line) 429 (message "No end statement found beyond this point."))) 430 (goto-char here))) 431 432(defun ftnchek-find-program-unit-statement( N ) 433 "Move point either forwards or backwards to program unit start statement, 434and return the title, or nil. N is either 1 (forward) or -1 (backward)" 435 (interactive "p") 436 (beginning-of-line) 437 (let ((name nil)) 438 (while (and (not (setq name (ftnchek-program-unit-title))) 439 (eq (forward-line N) 0))) 440 (if (and (eq name nil) 441 (eq N -1)) 442 (setq name "unnamed main program") 443 ) 444 name )) 445 446(defun ftnchek-beginning-of-subprogram() 447 "Move point to start of a program unit. Could be beginning of file. 448 Returns title of program unit." 449 (interactive) 450 (beginning-of-line) 451 ;; interstitial comments belong to following subprogram 452 (ftnchek-end-of-subprogram) 453 (ftnchek-find-program-unit-statement -1) 454 ) 455 456(defun ftnchek-current-subprogram() 457 "Return name of current subprogram without actually moving point" 458 (save-excursion 459 (ftnchek-beginning-of-subprogram))) 460 461(defun ftnchek-what-subprogram() 462 "Display the title of current Fortran subprogram" 463 (interactive) 464 (message (ftnchek-current-subprogram))) 465 466(defun ftnchek-next-subprogram() 467 "Move point to next subprogram" 468 (interactive) 469 (let (( here (point)) ) 470 (forward-line 1) 471 (if (ftnchek-find-program-unit-statement 1) 472 (message (ftnchek-current-subprogram)) 473 (message "Don't seem to be any more" ) 474 (goto-char here)))) 475 476(defun ftnchek-previous-subprogram() 477 "Move point to previous subprogram" 478 (interactive) 479 ;; moving backwards, we always get a program unit name even if "unnamed main" 480 (if (not (re-search-backward ftnchek-subprogram-end-regexp nil t)) 481 (message "Already seem to be in first one") 482 (ftnchek-beginning-of-subprogram) 483 (message (ftnchek-current-subprogram)))) 484 485 486 487(defun ftnchek-nonexecutable-statement() 488 "t if current line is nonexecutable" 489;; let's give it an optional arg so we can look at strings 490 (or (looking-at ftnchek-non-executable-statement-regexp) 491 (looking-at ftnchek-comment-regexp) 492 (looking-at ftnchek-continuation-line-regexp) 493 (looking-at ftnchek-blank-line-regexp))) 494 495(defun ftnchek-next-executable-statement() 496 "Skip to next executable statement" 497 (while (ftnchek-nonexecutable-statement) (forward-line))) 498 499(defun ftnchek-first-executable() 500 "Move cursor to first executable statement in current subprogram" 501 (interactive) 502 (ftnchek-beginning-of-subprogram) 503 (ftnchek-next-executable-statement) 504 (message "First executable statement in %s" (ftnchek-current-subprogram))) 505