;;; latin2.el -- Insert Croatian characters into Emacs buffers.

;; Copyright (C) 1996,1999 Hrvoje Niksic

;; Author: Hrvoje Niksic <hniksic@srce.hr>
;; Keywords: mule, multilingual
;; Version: 0.93

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

;;; Commentary:

;; Latin 2 minor mode can be used to insert Croatian characters into
;; XEmacs buffers.  When the mode is entered, the self-insert keys are
;; remapped according to the standard Croatian keyboard layout, except
;; for y/z swapping, which I abhor.

;; If you work on vt420 terminals, you can still display Latin 2
;; characters.  In that case, set `latin2-display' to vt420, and use
;; the utility functions latin2-translate-*.

;; #### Write more documentation!  Describe use of Gnus on vt420 or
;; ASCII displays.

;;; Code:

(require 'cl)

(defvar latin2-mode nil
  "A mode for inserting Croatian characters into Emacs buffers.")
(make-variable-buffer-local 'latin2-mode)

(defvar latin2-keyboard 'us
  "*Latin-2 keyboard mode.
Legal values are `us' (US keyboard) and `latin2' (native latin2 keyboard).")

(defvar latin2-display 'latin2
  "*Latin-2 display mode.
Legal values are `ascii', `vt420' (DEC vt420 terminal), and `latin2'
\(native Latin 2 display).")

(defconst latin2-xemacs-p (string-match "XEmacs" emacs-version))

(defconst latin2-isochars-alist
  '((ccaron . 232)
    (Ccaron . 200)
    (cacute . 230)
    (Cacute . 198)
    (zcaron . 190)
    (Zcaron . 174)
    (scaron . 185)
    (Scaron . 169)
    (dstroke . 240)
    (Dstroke . 208))
  "Alist mapping Latin 2 symbols to Latin 2 character codes.")

;; Alists mapping Latin 2 characters to supported replacements.  If
;; you want to add something new (e.g. windows-1250), add a new alist,
;; and write the appropriate code.  Good luck!

(defconst latin2-iso-to-dec-alist
  '((ccaron . 252)
    (Ccaron . 220)
    (cacute . 229)
    (Cacute . 197)
    (zcaron . 233)
    (Zcaron . 201)
    (scaron . 228)
    (Scaron . 196)
    (dstroke . 246)
    (Dstroke . 214))
  "Alist mapping Latin 2 symbols to DEC vt420 characters.")

(defconst latin2-iso-to-ascii-alist
  '((ccaron . ?c)
    (Ccaron . ?C)
    (cacute . ?c)
    (Cacute . ?C)
    (zcaron . ?z)
    (Zcaron . ?Z)
    (scaron . ?s)
    (Scaron . ?S)
    (dstroke . ?d)
    (Dstroke . ?D))
  "Alist mapping Latin 2 symbols to ASCII replacements.")

;; Currently unused.
;(defconst latin2-iso-to-cp1250-alist
;  '((ccaron . #xe8)
;    (Ccaron . #xc8)
;    (cacute . #xe6)
;    (Cacute . #xc6)
;    (zcaron . #x9e)
;    (Zcaron . #x8e)
;    (scaron . #x9a)
;    (Scaron . #x8a)
;    (dstroke . #xf0)
;    (Dstroke . #xd0))
;  "Alist mapping Latin 2 symbols to Latin 2 character codes.")

(defvar latin2-keyboard-translation-alist
  ;; Pretty much standard Croatian keyboard setup, except for y/z
  ;; swapping, which I abhor.  Also, no special provisions are made
  ;; for inserting @, \, |, [, ], {, and } characters, because it's
  ;; easy to press C-q <char>, or temporarily turn off latin2-mode.
  '((?@  . ?\")
    (?^  . ?&)
    (?&  . ?/)
    (?'  . cacute)
    (?*  . ?\()
    (?\( . ?\))
    (?\) . ?=)
    (?-  . ?')
    (?_  . ?\?)
    (?=  . ?+)
    (?+  . ?*)
    (?\{ . Scaron)
    (?\[ . scaron)
    (?\} . Dstroke)
    (?\] . dstroke)
    (?\; . ccaron)
    (?\" . Cacute)
    (?\\ . zcaron)
    (?\| . Zcaron)
    (?<  . ?\;)
    (?>  . ?:)
    (?/  . ?-)
    (?\? . ?_)
    (?:  . Ccaron))
  "Alist mapping ASCII keys to their (possibly Latin 2) replacements.
Keys are ASCII characters.  Their corresponding values are either
other ASCII characters, or symbols denoting Latin 2 characters.
For instance, `?[' maps to `scaron', while `?<' maps to `?;'.
If a key doesn't map at all, it is unchanged.")

(defvar latin2-mode-map
  (let ((map (make-sparse-keymap)))
    (dolist (pair latin2-keyboard-translation-alist)
      (define-key map (char-to-string (car pair)) 'latin2-insert))
    map)
  "Latin 2 minor mode keymap.")

(if (fboundp 'add-minor-mode)
    (add-minor-mode 'latin2-mode " Latin-2" latin2-mode-map)
  (or (assq 'latin2-mode minor-mode-alist)
      (setq minor-mode-alist
	    (cons '(latin2-mode (" Latin-2"))
		  minor-mode-alist)
	    minor-mode-map-alist
	    (cons `(latin2-mode . ,latin2-mode-map)
		  minor-mode-map-alist))))

(defun latin2-convert-key (key)
  "Convert KEY to a character that displays on the current display."
  (let ((conv (ecase latin2-keyboard
		(us (cdr (assq key latin2-keyboard-translation-alist)))
		(latin2 (car (rassq key latin2-isochars-alist))))))
    (cond ((null conv)
	   ;; No conversion -- pass the original key through.
	   key)
	  ((symbolp conv)
	   ;; Symbol denoting a Latin 2 character.  Convert it to an
	   ;; actual integer, according to required display.
	   (cdr (assq conv (ecase latin2-display
			     (latin2 latin2-isochars-alist)
			     (ascii  latin2-iso-to-ascii-alist)
			     (vt420  latin2-iso-to-dec-alist)))))
	  (t
	   ;; Another ASCII character.  Pass the converted key
	   ;; through.
	   conv))))

(or (featurep 'mule)
    (fboundp 'make-char)
    ;; Make make-char available if it isn't.
    (defun make-char (charset &optional arg1 arg2)
      (int-char (if (eq charset 'ascii) arg1 (logior arg1 128)))))

(defun latin2-make-char (number-or-char)
  "Convert NUMBER-OR-CHAR into a Latin 2 character.
This only makes a difference under Mule, as the rest of this file
freely exchanges characters and numbers in the [0, 256) range."
  (if (and (> number-or-char 128)
	   (featurep 'mule))
      (make-char 'latin-iso8859-2 (logand number-or-char 127))
    number-or-char))

(defun latin2-insert ()
  "Insert the appropriate character determined by last key-press.
The character is determined by converting last-input-char through
latin2-keyboard-translation-alist, and then if it's a Latin 2 char,
through latin2-isochars-alist, then through one of iso-to-X alists,
according to the current display.

See `latin2-convert-key' for more information."
  (interactive)
  (let ((char (latin2-make-char (latin2-convert-key last-input-char))))
    (if (fboundp 'self-insert-internal)
	(self-insert-internal char)
      (insert char))))

;; Make latin2-insert behave the same as self-insert wrt undo.  This
;; will work only on XEmacs 21.2 and above.
(put 'latin2-insert 'self-insert-defer-undo t)

(defvar latin2-original-syntax-table)
(make-variable-buffer-local 'latin2-original-syntax-table)

(defun latin2-setup-syntax ()
  (setq latin2-original-syntax-table (syntax-table))
  (let ((table (copy-syntax-table latin2-original-syntax-table)))
    (dolist (pair latin2-isochars-alist)
      (modify-syntax-entry (latin2-make-char (cdr pair))
			   "w" table))
    (set-syntax-table table)))

(defun latin2-restore-syntax ()
  (set-syntax-table latin2-original-syntax-table))

(defun latin2-redraw-modeline ()
  (if (fboundp 'redraw-modeline)
      (redraw-modeline)
    (force-mode-line-update)))

(defun latin2-mode (&optional arg)
  "Toggle Latin 2 minor mode.
In this mode the US keyboard is remapped so that Latin 2 characters
are available when normal keys are pressed.  The mode can be toggled
with `\\[latin2-mode]'."
  (interactive)
  (setq latin2-mode
	(cond ((eq arg t) t)
	      ((null arg) (not latin2-mode))
	      ((> (prefix-numeric-value arg) 0))))
  (unless (featurep 'mule)
    ;; Mule has its own provisions for syntax entries, and doesn't
    ;; need this kludge.
    (if latin2-mode
	(latin2-setup-syntax)
      (latin2-restore-syntax)))

  (latin2-redraw-modeline))

;;; Region translation junk.

(defvar latin2-use-char-table
  (condition-case nil
      (progn
	(with-temp-buffer (translate-region (point) (point) []))
	t)
    (wrong-type-argument nil)))

(defun latin2-build-translate-table (alist1 alist2)
  (cond
   (latin2-use-char-table
    (let ((table (make-char-table 'generic)))
      (dolist (pair alist1)
	(put-char-table (latin2-make-char (cdr pair))
			(latin2-make-char (cdr (assq (car pair) alist2)))
			table))
      table))
   (t
    ;; This garbage is supposed to allow FSFmacs and pre-21.2 XEmacs
    ;; to do something useful with translate-region, but I don't think
    ;; it stands a chance, really.
    (let* ((maxnum (1+ (apply 'max (mapcar
				     (lambda (pair)
				       (latin2-make-char (cdr pair)))
				     alist1))))
	   (string (make-string maxnum ?\0)))
      (dotimes (i maxnum)
	(aset string i (or (int-char i)
			   ?\0)))
      (dolist (pair alist1)
	(aset string
	      (latin2-make-char (cdr pair))
	      (latin2-make-char (cdr (assq (car pair) alist2)))))
      string))))

;(unless latin2-xemacs-p
;  (fset 'latin2-build-translate-table #'ignore))

(defvar latin2-dec-to-iso-table
  (latin2-build-translate-table latin2-iso-to-dec-alist
				latin2-isochars-alist))
(defvar latin2-iso-to-dec-table
  (latin2-build-translate-table latin2-isochars-alist
				latin2-iso-to-dec-alist))
(defvar latin2-iso-to-ascii-table
  (latin2-build-translate-table latin2-isochars-alist
				latin2-iso-to-ascii-alist))

(defun latin2-translate-region-or-buffer (direction &optional from to)
  "Convert the region or buffer between supported charsets.
The direction argument may be `iso2dec',`dec2iso', `iso2ascii', or `none'."
  (interactive "SDirection: ")
  (let ((table (ecase direction
		 (iso2dec latin2-iso-to-dec-table)
		 (dec2iso latin2-dec-to-iso-table)
		 (iso2ascii latin2-iso-to-ascii-table)
		 (none nil))))
    (if table
	(translate-region (or from (mark) (point-min))
			  (or to (mark) (point-max))
			  table))))

(defun latin2-translate (direction &optional from to)
  "Convert the region or buffer between supported character sets.
These include Latin 2, DEC vt420 and clean ASCII.
The translate-table will be chosen according to the direction
and variables latin2-keyboard and latin2-display.

If the direction is `receive', convert from Latin 2 to a set appropriate
to your display.  If the direction is `send', convert from the charset
of your display to latin2."
  (interactive)
  (latin2-translate-region-or-buffer
   (ecase direction
     (receive (ecase latin2-display
		(latin2 'none)
		(ascii 'iso2ascii)
		(vt420 'iso2dec)))
     (send (ecase latin2-display
	     (latin2 'none)
	     (ascii 'none)
	     (vt420 'dec2iso))))))

(defun latin2-translate-receive ()
  "Translates for receiving. See latin2-translate for more detail."
  (interactive)
  (latin2-translate 'receive))

(defun latin2-translate-send ()
  "Translates for sending. See latin2-translate for more detail."
  (interactive)
  (latin2-translate 'send))

;;; Helper functions for old Gnus.

;; Most of these should probably be eviscerated.

(defun latin2-add-headers ()
  "Add the Latin 2 MIME headers to an existing mail or news message."
  (interactive)
  (let ((pnt (point))
	(headers (concat "Content-type: text/plain; charset=iso-8859-2\n"
			 "Content-transfer-encoding: 8bit\n")))
    (goto-char (point-min))
    (insert headers)
    (goto-char (+ pnt (length headers)))))

(defun latin2-newsgroup (newsgroup)
  "Return non-nil if NEWSGROUP is suitable for Latin 2 encoding/decoding"
  (and newsgroup (string-match "^hr\." newsgroup)))

(unless latin2-use-char-table
  (defvar latin2-latin1-to-latin2-conversion-table nil))

(defvar latin2-latin1-to-latin2-conversion-table
  ;; We make a generic char-table, so that the default elements are
  ;; nil (meaning untranslated.)
  (let ((table (make-char-table 'generic))
	char)
    (dolist (pair latin2-isochars-alist)
      (setq char (cdr pair))
      ;; Kill off eigth bit.  Pre-21.2 XEmacs/Mule's make-char doesn't
      ;; accept eigth-bit values.
      (setq char (logand 127 char))
      (put-char-table (make-char 'latin-iso8859-1 char)
		      (make-char 'latin-iso8859-2 char)
		      table))
    table))

(defun latin2-convert-from-latin1 ()
  "Convert some Latin 1 characters to Latin 2.
This gorgeous hack is useful under Mule, when editing articles of
lusers whose software mistakenly flags their messages as Latin 1.
The function converts Latin 1 characters in the buffer that
correspond to Croatian characters to Latin 2."
  (interactive)
  (let (b e)
    (if (region-active-p)
	(setq b (region-beginning)
	      e (region-end))
      (setq b (point-min)
	    e (point-max)))
    (translate-region b e latin2-latin1-to-latin2-conversion-table)))

;; Provide feature
(provide 'latin2)