;;; czech-tex.el -- package for adding tildes to Czech TeX texts

;; Copyright (C) 1997 Milan Zamazal

;; Author:     Milan Zamazal <pdm@fi.muni.cz>
;; Maintainer: Milan Zamazal <pdm@fi.muni.cz>
;; Version:    $Id: czech-tex.el,v 3.8 1997/11/08 10:34:41 pdm Exp $
;; Keywords:   i18n, Czech, TeX
;; KnownCompatibility: 19.34, XEmacs 19.15

;; This file is *NOT* part of GNU Emacs.

;; COPYRIGHT NOTICE
;;
;; 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, version 2 of the License.
;;
;; 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 GNU Emacs and/or this package.  If you did not, write to the
;; Free Software Foundation, Inc., 675 Mass Ave., Cambridge, MA 02139, USA.

;;; Commentary:

;; The Czech ortography requires to avoid one letter prepositions at line
;; endings.  So they should be connected with following words by tilde.  Some
;; users forget to do this all the time.  Purpose of this program is to check
;; the text and suggest adding of missing tildes on some places.  It works in
;; similar manner like `query-replace-regexp'.
;;
;; The algorithm was inspired by Petr Ol¹įk's program `vlna'.  Abbilities of
;; `czech-tex.el' are a little limited; if you have improvement suggestions,
;; let me know.
;;
;; Remark: This code has no deal with AUCTeX.  Note that AUCTeX has its own
;; i18n support, see file `czech.el'.

;;; History:

;; So long, so very long...

;;; Code:

(require 'czech)			; defvar's

(defconst cz-tex-version "$Id: czech-tex.el,v 3.8 1997/11/08 10:34:41 pdm Exp $"
  "Latest modification time and version number.")


;;; *** Interactive functions ***

;;;###autoload
(defun cz-tex-tildes-region (beg end)
  "Add tildes in the given region.
The tildes are added according to the following rules:
- tildes are added after AIKOSUVZkosuvz
- comments, maths, and verbatims are ignored
- it is LaTeX oriented (sorry about it, but I do not know plain TeX)
- no contingent line adjusting"
  (interactive "*r")
  (let (a
	z
	(marker-end (copy-marker end))
	end-env
	finish
	(ask t)
	(case-fold-search nil)
	(regexp (cz-tex-build-regexp))
	aux)
    (save-excursion
      (save-restriction
	(widen)
	(goto-char (point-min))
	(while (not finish)
	  (setq a (point))
	  (setq end-env (cz-tex-find-env regexp))
	  (setq z (copy-marker (if end-env (1- (point)) (point-max))))
	  (if (>= (marker-position z) beg)
	      (progn
		(or (>= a beg) (setq a beg))
		(or (<= (marker-position z) (marker-position marker-end))
		    (setq z marker-end))
		(setq aux (cz-tex-tildify a (marker-position z) ask))
		(if (eq aux 'force)
		    (setq ask nil)
		  (if (eq aux nil)
		      (setq finish t)))))
	  (if (>= (marker-position z) (marker-position marker-end)) 
	      (setq finish t))
	  (or (>= (point) (marker-position z)) (goto-char (marker-position z)))
	  (if (not finish)
	      (if (re-search-forward end-env nil t)
		  (if (> (point) (marker-position marker-end))
		      (setq finish t))
		(message (format "End of enviroment not found: %s" end-env))
		(setq finish t)))))))
  (cz-message (if cz-xemacs 1 4) "Tildes checking done."))
	      
;;;###autoload
(defun cz-tex-tildes ()
  "Add tildes in the current buffer.
See `cz-tex-tildes-region for more info."
  (interactive  "*")
  (cz-tex-tildes-region (point-min) (point-max)))


;;; *** Auxiliary functions ***

(defun cz-tex-in-comment ()
  "Return t if current point is in TeX comment."
  (let ((point (point)))
    (save-excursion
      (beginning-of-line)
      (or (eq (following-char) ?%)
	  (re-search-forward "[^\\\\]%" point t)))))

(defun cz-tex-after-macro ()
  "Return non-nil if preposission candidate is postposition of macro."
  (save-excursion
    (goto-char (match-beginning (cdr cz-tex-tilde-regexp-pair)))
    (re-search-backward "\\\\[a-zA-Z]*[\\t ]+\\w+\\=" nil t)))

(defun cz-tex-build-regexp ()
  "Build proper regexp from `cz-tex-env-alist'."
  (let ((string (car (car cz-tex-env-alist)))
	(alist (cdr cz-tex-env-alist)))
    (while alist
      (setq string (concat string "\\|" (car (car alist))))
      (setq alist (cdr alist)))
    string))

(defun cz-tex-find-env (regexp)
  "Find environment using REGEXP.
Return regexp for the end of the environment or nil if no environment was
found."
  ;; Find environment
  (let (found)
    (while (and (setq found (re-search-forward regexp nil t))
		(cz-tex-in-comment)))
    (if found
	;; Build end-env regexp
	(let ((match (match-string 0))
	      (alist cz-tex-env-alist)
	      expression)
	  (save-match-data
	    (while (not (eq (string-match (car (car alist)) match) 0))
	      (setq alist (cdr alist))))
	  (if (stringp (setq expression (cdr (car alist))))
	      expression
	    (let ((result "")
		  aux)
	      (while expression
		(setq result (concat result
				     (if (stringp (setq aux (car expression)))
					 expression
				       (regexp-quote (match-string aux)))))
		(setq expression (cdr expression)))
	      result)))
      ;; Return nil if not found
      nil)))

(defun cz-tex-tildify (beg end ask)
  "Add tildes in the given region.
This function does not do any further checking except of for comments and
macros.
If ASK is nil, perform replace without asking user for confirmation.
Returns one of symbols: t (all right), nil (quit), force (replace without
further questions)."
  (save-excursion
    (goto-char beg)
    (let (answer
	  bad-answer
	  (regexp (car cz-tex-tilde-regexp-pair))
	  (match-number (cdr cz-tex-tilde-regexp-pair))
	  replace
	  quit)
      (while (and (not quit)
		  (re-search-forward regexp end t))
	(if (and (not (cz-tex-in-comment))
		 (not (cz-tex-after-macro)))
	    (if (or (not ask)
		    (progn
		      (goto-char (match-beginning match-number))
		      (setq bad-answer t)
		      (while bad-answer
			(setq bad-answer nil)
			(message "Replace? (yn!q) ")
			(setq answer
			      (if cz-xemacs
				  (event-key (next-command-event))
				(read-event)))
			(cond
			 ((or (eq answer ?y) (eq answer ? ) (eq answer 'space))
			  (setq replace t))
			 ((eq answer ?n)
			  (setq replace nil))
			 ((eq answer ?!)
			  (setq replace t
				ask nil))
			 ((eq answer ?q)
			  (setq replace nil
				quit t))
			 (t
			  (message "Press y, n, !, or q.")
			  (setq bad-answer t))))
		      replace))
		(if (not cz-xemacs)
		    (replace-match cz-tex-tilde-string t t nil match-number)
		  (save-excursion
		    (delete-region (match-beginning match-number)
				   (match-end match-number))
		    (insert cz-tex-tilde-string))))))
      (cond
       (quit nil)
       ((not ask) 'force)
       (t t)))))


;;; *** Announce ***

(provide 'czech-tex)


;;; czech-tex.el ends here

