;;; fcap-mode.el

;; Automatic capitalization in Fortran.  Never mess with caps lock
;; ever again!!!
;;
;; Version 0.3, Released June 14, 2005.
;; Written by Carl Banks.  Public domain.
;; Latest version at http://www.aerojockey.com/software/#fcap


;; Minor mode keymap: Binds all letters to fcap-electric-letter

(setq fcap-mode-map (make-keymap))
(let ((c ?a))
  (while (<= c ?z)
    (define-key fcap-mode-map (char-to-string c) 'fcap-electric-letter)
    (setq c (+ c 1))))
(let ((c ?A))
  (while (<= c ?Z)
    (define-key fcap-mode-map (char-to-string c) 'fcap-electric-letter)
    (setq c (+ c 1))))


;; Fcap minor mode flag

(defvar fcap-mode nil
  "*When non-nil, the Fortran capitalization minor mode is enabled.")


;; Define function to toggle/set/unset Fcap mode

(defun fcap-mode (&optional arg)
  "Minor Mode for automatic capitalization in Fortran.
Automatically capitalizes letters, without requiring the user to resort
to Caps Lock, in Fortran code, except in comments and strings.
For now, only works for Fortran 77."
  (interactive "P")
  (or (local-variable-p fcap-mode)
      (make-local-variable 'fcap-mode))
  (setq fcap-mode
	(if (null arg) (not fcap-mode)
	  (> (prefix-numeric-value arg) 0))))


;; Electric letter insert

(defun fcap-electric-letter (arg)
  "Type a capitalized letter, except in Fortran strings and comments."
  (interactive "P")
  (let ((count (if arg (prefix-numeric-value arg) 1))
	(cp (point)))
    (if (save-excursion
	  (beginning-of-line)
	  (and
	   (or (= (following-char) ?\ )
	       (= cp (point)))
	   (not (fcap-in-string (buffer-substring cp (point))))))
	(setq last-command-event (upcase last-command-event)))
    (self-insert-command count)))


;; Ugly utility function

(defun fcap-in-string (str)
  "Determine if str ends inside a (Fortran) string."
  (let ((instr nil)
	(incom nil)
	(delim))
    (mapc (lambda (c)
	    (unless incom
	      (if instr
		  (if (= c delim) (setq instr nil))
		(if (= c ?!)
		    (setq incom t)
		  (if (or (= c ?\") (= c ?'))
		      (progn (setq instr t) (setq delim c)))))))
	  str)
    (or instr incom)))


;; Add Fcap mode to minor-mode-alist, and minor-mode-map-alist
;; Add these to end rather than customary beginning because anyone
;; else wanting to rebind the letters probably ought to have precedence.

(or (assq 'fcap-mode minor-mode-alist)
    (setq minor-mode-alist 
	  (append minor-mode-alist '((fcap-mode " FCap")))))

(or (assq 'fcap-mode minor-mode-map-alist)
    (setq minor-mode-map-alist
	  (append minor-mode-map-alist `((fcap-mode . ,fcap-mode-map)))))