;;; ftnchek.el --- ftnchek support for fortran mode.
;;
;; Author: Judah Milgram <milgram@eng.umd.edu>
;; Version: 0.6 6/18/98
;; Keywords: fortran syntax semantic
;; Current version at: http://www.glue.umd.edu/~milgram/ftnchekel.html
;;
;; Copyright 1998 Judah Milgram
;;
;; This program 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.
;; 
;; This program 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 this program; if not, write to the Free Software
;; Foundation, Inc.,  59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;
;; ==================================================================
;;
;;; FTNCHEK: Ftnchek is a fortran 77 syntax and  semantics checker
;;  by Dr. Robert Moniot, <moniot@mary.fordham.edu>. Get it at
;;  ftp://netlib.org/fortran
;;
;;======================================================================
;;; About this package:
;;
;;  This is still fairly unstable. All development has been done on
;;  emacs 19, it may or may not work with emacs 20. May overlap some
;;  functionality of the v 20 fortran.el
;;   
;;  INSTALLATION:
;;
;;  Install ftnchek.el somewhere in your lisp load path. Maybe add
;;  lines in your ~/.emacs along the lines of:
;;
;;  (setq my-path (concat (getenv "HOME") "/local/share/emacs/site-lisp"
;;  (setq load-path (cons my-path load-path))
;;  (add-hook 'fortran-mode-hook (require 'ftnchek-mode "ftnchek"))
;;
;;  Byte-compile ftnchek.el, if you want.
;; 
;;  Defines functions:
;;
;;       fortran-what-subprogram()
;;       fortran-subprogram()
;;       next-fortran-subprogram()
;;       fortran-subprogram-list()
;;       fortran-goto-subprogram()
;;       ftnchek-region(first last temp-file)
;;       ftnchek-command(fortran-source)
;;       ftnchek-buffer()
;;       ftnchek-subprogram()
;;       fortran-first-executable()
;;       ftnchek-version-display()
;;       ftnchek-version()
;;       ftnchek-next-error()
;;       ftnchek-next-argument-data-type-mismatch()
;;
;;  Fortran-mode hooks:
;;
;;  key bindings
;;  menu maps: fortran-mode maps
;;             ftnchek-stuff.
;;
;; ====================================================================
;; Bugs:
;; ":" in fortran file name will cause confusion.
;; ====================================================================
;; To Do:
;;
;; ftnchek-next-arg-mismatch
;; ftnchek-other-place
;; Make default for "goto-subprogram" based on a nearby "call" statement
;; Maybe temp-files should revert to /tmp in case pwd non-writeable?
;; Make ftnchek-flags easier for user to customize (one for buffer,
;;         one for subprogram)<
;; Re-implement goto-subprogram based on imenu? 
;; Look at v 20 fortran.el, maybe  there's something we can  use.
;; normalize naming of functions
;; cleanup & speedup
;; ====================================================================
;; Acknowledgements:
;; Bruce Ravel, Richard Stallman for advice and suggestions.
;; ====================================================================
;;  History:
;;
;;  v 0.6 6/17/98 placed completion-ignore-case in a let
;;                defvar ftnchek-mode
;;                defun ftnchek-mode
;;  V 0.5 6/14/98 implemented "ftnchek-next-error"
;;                played with ftnchek-flags (array=2) 
;;  V 0.4 6/12/98 added require to "compile"
;;                got "fortran-goto-subprogram" working
;;  V 0.3 6/11/98 first public release

(require 'fortran)
(require 'compile)

(defvar ftnchek-mode-version "0.6")
(defvar ftnchek-maintainer "<milgram@eng.umd.edu>")
(defvar ftnchek-flags nil)
(defvar ftnchek-startup-message) ; maybe do this with "let"?

(defvar ftnchek-mode nil
  "Mode variable for ftnchek minor mode")
(make-variable-buffer-local 'ftnchek-mode)

(defun ftnchek-mode(&optional arg)
  "Ftnchek minor mode."
  (interactive "P")
  (setq ftnchek-mode
	(if (null arg)
	    (not ftnchek-mode)
	  (> (prefix-numeric-value arg)  0)))
;   (if ftnchek-mode  ... etc.
)

(defun fortran-what-subprogram()
  "Display the name of the FORTRAN subprogram the
   cursor is currently in."
  (interactive)
  (message "Currently in %s" (fortran-subprogram))
  )

;; N.B. I disagree  with fortran-mode's "end-of-fortran-subprogram".
;; If the cursor is on the "end"  statement, you're already there,
;; but fortran mode takes you to the end of the *next* subprogram.
;; Much of the kludgery surrounding fortran-subprogram results from
;; this sort of thing.

(defun fortran-subprogram()
  "Return the name of the FORTRAN subprogram cursor is
   currently in. Suffers from fortran-mode bug: if cursor
   on first col of subprogram statement, thinks you're in
   previous subprogram."
  (let (here there aline name)
    (save-excursion    
      (beginning-of-line)
      (setq here (point))
      (end-of-line)
      (setq there (point)
            aline (buffer-substring  here there))
      (if (string-match "^ *end *$" aline)
	(forward-line -1))
      (end-of-fortran-subprogram)
      (beginning-of-fortran-subprogram)    
      (re-search-forward "^  *[^ ]")
      (setq here (point)
            here (- here 1))
      (end-of-line)
      (setq there (point)
            name (buffer-substring here there)
            there (string-match " *\\((.*\\)*$" name))
      (if there
	  (setq name (substring name 0 there)))
      )
    name
    )
  )

(defun next-fortran-subprogram()
  "Move cursor to next subprogram"
  (interactive)
  (end-of-fortran-subprogram)      ; might put you on a comment.
  (fortran-next-statement))

(defun fortran-subprogram-list()
  "Make an alist of fortran subprograms"
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (fortran-next-statement)
    (let (subprogram-list foo i)
      (while
	  (progn
	    (setq foo (fortran-subprogram)
		  i (string-match "[^ ][^ ]*[ ]*$" foo)
		  foo (substring foo i)
		  i (point)
		  subprogram-list (cons (list foo i) subprogram-list))
	    (end-of-fortran-subprogram)
	    (not (eq (fortran-next-statement) 'last-statement))
	    )
	)
      subprogram-list
      )
    )
  )

(defun fortran-goto-subprogram()
  "Position cursor on beginning of a subprogram"
  (interactive)
  (let ((subprogram-list (fortran-subprogram-list))
	target
        target-char
        (completion-ignore-case t))
    (setq target (completing-read
		  "Go to subprogram (TAB for completion list): "
		  subprogram-list)
	  target-char (car (cdr (assoc target subprogram-list))))
    (goto-char target-char)
    )
  )

;; No point running this interactively.
(defun ftnchek-region(first last temp-file)
  "Run ftnchek on a region using compile.el"
  (if (file-exists-p temp-file)
      (if (file-writable-p temp-file)
	  (delete-file temp-file)
	(error "Cannot remove  %s" temp-file)
	)
    )
  (let ((blanks (get-buffer-create "*Ftnchek-temp*"))
	(i 1)
        blanklines)
    (save-excursion (set-buffer blanks) (erase-buffer))
    (copy-to-buffer  blanks (point-min) (point-max))
;    (save-excursion
    (set-buffer blanks)
    (goto-char first)
;;  There must be an easier way to get the line number!
    (setq blanklines (string-to-number (substring (what-line) 5)))
    (delete-region last (point-max))
    (delete-region (point-min) first)
    (goto-char (point-min))
    (setq i 1)
    (while (< i blanklines)
      (insert "\n")
      (setq i (+ i 1)))
; not write-buffer since don't want to visit the temp-file.
  (write-region (point-min) (point-max) temp-file) ;  
  (compile-internal (ftnchek-command temp-file) nil)
;    )
  )
  )

(defun ftnchek-command(fortran-source)
  "Form  the command to  run ftnchek"
  (concat "ftnchek " ftnchek-flags " -quiet " fortran-source))

(defun ftnchek-buffer()
  "Run ftnchek on current buffer."
  (interactive)
  (let (first last temp-file)
    (save-excursion
      (beginning-of-buffer)
      (setq first (point))
      (end-of-buffer)
      (setq last (point)
            ftnchek-flags "-noextern -declare -library -usage=303 -array=2"
            temp-file (concat "ftnchek:" (buffer-name)))
      (ftnchek-region first last temp-file)
      )
    )
  )

;; why not use fortran mode's mark-subprogram function?
;; hmmmm.
(defun ftnchek-subprogram()
  "Run ftnchek on suprogram the cursor is in. You can run
   ftnchek-what-subprogram  to find out what subprogram that is."
  (interactive)
  (save-excursion
    (let (here there temp-file)
      (setq temp-file (fortran-subprogram)
            here (string-match " [^ ]*$" temp-file)
            here (+ here 1)
            temp-file (substring temp-file here)
            temp-file (concat "ftnchek:" (buffer-name) ":" temp-file ".f"))
      (beginning-of-fortran-subprogram)
      (setq  here (point))
      (end-of-fortran-subprogram)
      (setq there (point)
; Isolated subprogram -  common block usage n/a
            ftnchek-flags "-noextern -library -usage=303 -declare")
      (ftnchek-region here there temp-file)
      )
    )
  )

(defun fortran-first-executable()
  "Move cursor to first executable statement in current subprogram"
  (interactive)
  (beginning-of-fortran-subprogram)
  (while (progn
	   (re-search-forward "^[ 0-9][ 0-9][ 0-9][ 0-9][ 0-9][ 0-9] *")
	   (re-search-forward "[a-z]+")
;	    (make-regexp '("equivalence" "program"
;			   "external" "include" "common" "save"
;			   "parameter" "character" "subroutine"
;			   "function" "data" "integer" "double"
;			   "real" "logical" "dimension"))
	   (string-match "c\\(haracter\\|ommon\\)\\|d\\(ata\\|imension\\|ouble\\)\\|e\\(quivalence\\|xternal\\)\\|function\\|in\\(clude\\|teger\\)\\|logical\\|p\\(arameter\\|rogram\\)\\|real\\|s\\(ave\\|ubroutine\\)"
 	    (match-string 0))))
  (beginning-of-line)
  (message "First executable statement in %s" (fortran-subprogram))
  )

;; Fortran pull-down menu:

(define-key fortran-mode-map [menu-bar fortran]
   (cons "Fortran 77" (make-sparse-keymap "Fortran")))

(define-key fortran-mode-map "\C-x`" 'ftnchek-next-error)

;; Fortran pull-down menu, ftnchek stuff:

(define-key fortran-mode-map [menu-bar fortran menu-ftnchek-next-error]
  '("Next error" . ftnchek-next-error))
(define-key fortran-mode-map [menu-bar fortran menu-ftnchek-next-argument-data-type-mismatch]
  '("Next data type mismatch" . ftnchek-next-argument-data-type-mismatch))
(define-key fortran-mode-map [menu-bar fortran menu-ftnchek-buffer]
  '("ftnchek buffer" . ftnchek-buffer))
(define-key fortran-mode-map [menu-bar fortran menu-ftnchek-subprogram]
  '("ftnchek subprogram" . ftnchek-subprogram))
(define-key fortran-mode-map [menu-bar fortran menu-ftnchek-version]
  '("ftnchek version" . ftnchek-version-display))

;; Fortran menu, fortran-mode stuff:

(define-key fortran-mode-map
  [menu-bar fortran menu-fortran-first-executable]
  '("First executable statement" . fortran-first-executable))
(define-key fortran-mode-map
  [menu-bar fortran menu-fortran-what-subprogram]
  '("What subprogram?" . fortran-what-subprogram))
(define-key fortran-mode-map
  [menu-bar fortran menu-fortran-goto-subprogram]
  '("Go to subprogram ..." . fortran-goto-subprogram))
(define-key fortran-mode-map
  [menu-bar fortran menu-fortran-comment-region]
  '("Comment region" . fortran-comment-region))
(define-key fortran-mode-map
  [menu-bar fortran menu-fortran-beginning-of-fortran-subprogram]
  '("Beginning of subprogram" . beginning-of-fortran-subprogram))
(define-key fortran-mode-map
  [menu-bar fortran menu-fortran-end-of-fortran-subprogram]
  '("End of subprogram" . end-of-fortran-subprogram))
(define-key fortran-mode-map
  [menu-bar fortran menu-fortran-next-fortran-subprogram]
  '("Next subprogram" . next-fortran-subprogram))
(define-key fortran-mode-map
  [menu-bar fortran  menu-fortran-fortran-column-ruler]
  '("Column ruler" . fortran-column-ruler))
(define-key fortran-mode-map
  [menu-bar fortran menu-fortran-fortran-split-line]
  '("Split line" . fortran-split-line))
(define-key fortran-mode-map
  [menu-bar fortran menu-fortran-fortran-indent-subprogram]
  '("Indent subprogram" . fortran-indent-subprogram))
(define-key fortran-mode-map
  [menu-bar fortran menu-fortran-mark-fortran-subprogram]
  '("Mark subprogram" . mark-fortran-subprogram))

; Startup message. Possibly useless.
(setq ftnchek-startup-message
      (concat "ftnchek.el "
	      " Version "
	      ftnchek-mode-version
	      " bugs to "
	      ftnchek-maintainer))
(message ftnchek-startup-message)
(sleep-for 0.5)

(defun ftnchek-version-display()
"Print the ftnchek version and patch level."
(interactive)
(message (ftnchek-version))
)

(defun ftnchek-version()
  "Return ftnchek version as a string."
  (let (first last outbuf)
    (setq outbuf (get-buffer-create "*Ftnchek*"))
    (set-buffer outbuf)
    (goto-char (point-min))
    (setq first (point))
    (goto-char (point-max))
    (setq last (point))
    (if (> last first) (kill-region first last))
    (call-process "ftnchek" nil outbuf nil "-help")
    (set-buffer outbuf)
    (goto-char (point-min))
    (if (null (search-forward "FTNCHEK")) nil
      (beginning-of-line)
      (setq first (point))
      (end-of-line)
      (setq last (point))
      (buffer-substring first last)      
      )
    )
  )

(defun ftnchek-next-error()
"Find the next error reported by ftnchek"
(interactive)
(next-error)
; A matter of  taste:
; (scroll-other-window-down 2)
)

;; Typical parse-able ftnchek error: (many are not)
;; Warning near line 70 col 12 file ftnchek:airfls.f
(setq
 compilation-error-regexp-alist
 ( cons
; maybe  want e.g. \\(Warning\\|Error\\|Possibly.*appearance\\)
; at beginning of this regexp.
; If you do that, adjust the index parameters accordingly.
   ( list " near line \\([0-9]+\\) col \\([0-9]+\\) file ftnchek:\\([^ :]+\\)\\(:[^  ]+\\)?" 3 1 2 )
   compilation-error-regexp-alist )
 )

(provide 'ftnchek-mode)