;;;; po.el -- Provide po-specific interface to ispell- functions
;; Copyright (C) 2005 Sergey Poznyakoff

;; 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 3, 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; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
;; MA 02110-1301, USA.

(defconst po-ispell-input-methods
  '((polish . polish-slash)
    (ukrainian . ukrainian-computer)
    (russian . cyrillic-jcuken)
    (spanish . latin-1-prefix)
    (catalan . latin-1-prefix))
    "Input methods I use for various languages")

(defun po-local-setup ()
  "Set up local defaults for a PO buffer:

  * File coding system      is set up based on the value of Content-Type header
  * Local ispell dictionary is set up based on the value of Language-Team
                            header
  * Input method            is retrieved from po-ispell-input-methods"
  (save-excursion
    (goto-char (point-min))
    (when (search-forward-regexp "^msgstr\\s *\"" nil t)
      (let ((bound (save-excursion
		     (search-forward-regexp "^msgid\\s *\"" nil t))))
	(when (save-excursion
		(search-forward-regexp
		 "^\"Content-Type: .*;\\s *charset=\\([a-zA-Z0-9_-]+\\).*\""
		 bound t))
	  (let ((cs (intern (downcase (buffer-substring-no-properties
			               (match-beginning 1)
			               (match-end 1))))))
	    (setq buffer-file-coding-system cs)))

	(make-variable-buffer-local 'default-input-method)
	(make-variable-buffer-local 'ispell-local-dictionary)
	
	(when (save-excursion
		(search-forward-regexp
		 "^\"Language-Team:\\s *\\(\\w+\\).*"  bound t))
	  (let ((language (downcase (buffer-substring-no-properties
				     (match-beginning 1)
				     (match-end 1))))
		(ld (assoc 'ispell-local-dictionary
			   (buffer-local-variables (current-buffer)))))
	    (when (and (or (not ld)
			   (not (string-equal (cdr ld) language)))
		       (assoc language ispell-dictionary-alist))
	      (ispell-change-dictionary language))

	    (let ((imethod (assoc (intern language) po-ispell-input-methods)))
	      (when imethod
		(set-input-method (symbol-name (cdr imethod)))))))))))

(defun process-flag ()
  (setq po-is-format (looking-at ".*-format.*"))
  (forward-line))

(defun process-format ()
  (when (and po-is-format
	     (looking-at "[#0 +'I-]?\\([0-9][0-9]*\\|\\(\\([0-9][0-9]*\\$\\)?\\*\\)\\)?\\(\\.\\([0-9][0-9]*\\|\\(\\([0-9][0-9]*\\$\\)?\\*\\)\\)?\\)?[hl]?[hlLqjzt]?[diouxXeEfFgGaAcsCSpn%]"))
    (goto-char (match-end 0))))

(defun po-ispell-run (fun &rest args)
  "Run spell-check function FUN with ARGS on a PO buffer or a region thereof."
  (if (eq major-mode 'po-mode)
      (if (po-check-all-pending-edits)
	  (let ((po-is-format nil)
		(local-dictionary ispell-local-dictionary)
		(ispell-skip-region-alist (append
					   '(("#," process-flag)
					     ("#.*")
					     ("msgid" . "msgstr")
					     ("msgstr\\[[0-9][0-9]*\\]" . "\"")
					     ("%" process-format))
					   ispell-skip-region-alist))
		(ispell-extra-args (append ispell-extra-args
					   (list (concat
						  "--encoding="
						  (symbol-name
						   buffer-file-coding-system))))))
	    (save-excursion
	      (setq buffer-read-only po-read-only)
	      (unwind-protect
		  (progn
		    (fundamental-mode)
		    (let ((ispell-local-dictionary local-dictionary))
		      (apply fun args)))
		(normal-mode)
		(po-local-setup)))))))

(defun po-ispell-buffer ()
  "Check current PO file for spelling errors in translation strings."
  (interactive)
  (po-ispell-run 'ispell-buffer))
  
(defun po-ispell-region (reg-start reg-end)
  "Check a region of the current PO file for spelling errors in
translation strings."
  (interactive "r")  
  (po-ispell-run 'ispell-region reg-start reg-end))

(defun gray-po-mode-hook ()
  (po-local-setup)
  (define-key po-mode-map "i" 'po-ispell-buffer)
  (define-key po-mode-map "\M-i" 'po-ispell-region))

(defun gray-po-subedit-mode-hook ()
  "Enable the input method in subedit buffer"
  (let ((method (assoc 'default-input-method (buffer-local-variables buffer)))
	(local-dictionary (assoc 'ispell-local-dictionary
				 (buffer-local-variables buffer))))
    (when local-dictionary
      (make-variable-buffer-local 'ispell-local-dictionary)
      (setq ispell-local-dictionary (cdr local-dictionary)))
      
    (when method
	(set-input-method (cdr method)))))

(defun gray-po-subedit-exit-hook ()
  (let ((po-is-format t) ;; FIXME
	(ispell-skip-region-alist '(("%" process-format)))
	(ispell-extra-args (append ispell-extra-args
				   (list (concat
					  "--encoding="
					  (symbol-name
					   buffer-file-coding-system))))))
    (ispell-buffer)))

;;;; End of po.el