;;; frenchspacing-mode.el --- training myself to use french spacing

;; Author: Mark Triggs <mst@dishevelled.net>

;; This file 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 file 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 GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; This is a tiny piece of code to train myself to use french spacing in emacs.
;; I think this is easier to read in a monospaced font.

;;; Code:

(make-face 'fc-face)
(set-face-attribute 'fc-face nil :underline "blue")


(defvar frenchspacing-warning-regex "\\([^.][?!\.]\\)\\( \\)\\([^ ]\\)"
  "A regular expression matching non-frenchspaced text.")

(defvar frenchspacing-ignore-regex
  (concat "\\(\\(e\\.g\\.\\|i\\.e\.\\|Mr\\."
          "\\|[0-9]+\\.\\|etc\\.\\| et\\.\\)"
          "\\( \\)"
          "\\|[A-Z]\\. [A-Z]\\)")       ; for middle name initials...
  "A regular expression matching specific uses of punctuation
that should be ignored")

(defun frenchspacing-fontify (beg end)
  (save-excursion
    (frenchspacing-unfontify beg end)
    ;; Mark certain spaces that should be ignored.
    (goto-char beg)
    (let ((case-fold-search nil))
      (while (re-search-forward frenchspacing-ignore-regex end t)
        (when (and (match-beginning 3) (match-end 3))
          (let ((overlay (make-overlay (match-beginning 3) (match-end 3))))
            (overlay-put overlay 'type 'frenchspace-ignore)))))
    ;; Mark incorrect uses of spacing.
    (goto-char beg)
    (while (re-search-forward frenchspacing-warning-regex end t)
      (let ((o (car (overlays-at (match-beginning 2)))))
        (unless (and o (eq (overlay-get o 'type) 'frenchspace-ignore))
          (let ((overlay (make-overlay (match-beginning 2) (match-end 2))))
            (overlay-put overlay 'type 'frenchspace)
            (overlay-put overlay 'evaporate t)
            (overlay-put overlay 'face 'fc-face)))))
    ;; Remove the ignore marks.
    (mapc #'(lambda (o)
              (when (eq (overlay-get o 'type) 'frenchspace-ignore)
                (delete-overlay o)))
          (overlays-in beg end))))


(defun frenchspacing-unfontify (beg end)
  (mapc #'(lambda (o)
            (when (or (eq (overlay-get o 'type) 'frenchspace)
                      (eq (overlay-get o 'type) 'frenchspace-ignore))
              (delete-overlay o)))
            (overlays-in beg end)))


(defun frenchspacing-fixup ()
  (interactive)
  (destructuring-bind (beg end)
      (if mark-active
          (list (region-beginning) (region-end))
        (list (point-min) (point-max)))
    (query-replace-regexp frenchspacing-warning-regex
                          "\\1  \\3" nil beg end)))


(define-minor-mode frenchspacing-mode
  "Indicate where only a single space has been used."
  nil " fs" nil
  (cond ((not frenchspacing-mode)
         (jit-lock-unregister 'frenchspacing-fontify)
         (frenchspacing-unfontify (point-min) (point-max)))
        (t (frenchspacing-fontify (point-min) (point-max))
           (jit-lock-register 'frenchspacing-fontify))))

(provide 'frenchspacing-mode)
;;; frenchspacing-mode.el ends here