;;; $Header: /local/repository/cvsroot/web-seiten/emacs/iso.el,v 1.2 2003/12/23 07:18:54 ni Exp $

;;; enter characters from the ISO 8859-1 (latin-1) table

(defconst iso-8859-1-mode-copyright
  "Copyright (C) 1993 by Juergen Nickelsen <nickel@cs.tu-berlin.de>

This 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 1, or (at your option) any later
version.

It 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, 675 Mass Ave, Cambridge, MA 02139, USA.
")

(defconst iso-8859-1-mode-AtFS-version
  "$Header: /local/repository/cvsroot/web-seiten/emacs/iso.el,v 1.2 2003/12/23 07:18:54 ni Exp $")

;;; Options

(defvar enable-iso-8859-1-mode-help-message t
  "*If non-nil, issue help message when iso-8859-1-mode is called.")

(defvar make-iso-8859-1-mode-global t
  "*If non-nil, make iso-8859-1-mode global to all buffers.")

(defvar enable-german-iso-shorthands nil
  "*If t, define shorthand keys for german characters.
These shorthands are available independent of iso-8859-1-mode.
The keys are: C-c<letter>, where letter is one of
a, o, u, A, O, U, s. The appropriate umlaut resp.
sharp s is inserted.")


;;; Variables: prefix key, compose alist

(defconst iso-key-prefix "\C-c"
  "Prefix string for key bindings in iso-8859-1-mode.
Changing this variable may lead to undesired results.")

(defconst iso-lucid-key-prefix 'multi_key
  "Prefix key for bindings in iso-8859-1-mode if running in Lucid Emacs.
On a Sun type 4 keyboard this is the \"Compose\" key.")

(defconst iso-lucid-emacs-p (string-match "Lucid" (emacs-version)))

(defconst iso-8859-1-compose-alist
  '((?\" (?\" . ?\250) (?A . ?\304) (?E . ?\313) (?I . ?\317) (?O . ?\326)
	 (?U . ?\334) (?a . ?\344) (?e . ?\353) (?i . ?\357) (?o . ?\366)
	 (?s . ?\337) (?u . ?\374) (?y . ?\377))
    (??  (?? . ?\277) (?S . ?\247) (?P . ?\266) (?A . ?\306) (?a . ?\346)
	 (?s . ?\337) (?o . ?\244) (?X . ?\327))
    (?>  (?> . ?\273))
    (?<  (?< . ?\253))
    (?0  (?c . ?\251) (?R . ?\256) (?0 . ?\260) (?A . ?\305) (?a . ?\345))
    (?.  (?. . ?\267))
    (?/  (?4 . ?\274) (?2 . ?\275) (?3 . ?\276) (?O . ?\330) (?o . ?\370))
    (?|  (?c . ?\242) (?| . ?\246) (?P . ?\336) (?p . ?\376) (?3 . ?\337))
    (?-  (?L . ?\243) (?Y . ?\245) (?a . ?\252) (?, . ?\254) (?- . ?\255)
	 (?^ . ?\257) (?+ . ?\261) (?o . ?\272) (?D . ?\320) (?d . ?\360)
	 (?: . ?\367))
    (?\  (?\  . ?\240))
    (?!  (?! . ?\241))
    (?^  (?2 . ?\262) (?3 . ?\263) (?1 . ?\271) (?A . ?\302) (?E . ?\312)
	 (?I . ?\316) (?O . ?\324) (?U . ?\333) (?a . ?\342) (?e . ?\352)
	 (?i . ?\356) (?o . ?\364) (?u . ?\373))
    (?'  (?' . ?\264) (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323)
	 (?U . ?\332) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363)
	 (?u . ?\372) (?y . ?\375))
    (?,  (?u . ?\265) (?, . ?\270) (?C . ?\307) (?c . ?\347))
    (?`  (?A . ?\300) (?E . ?\310) (?I . ?\314) (?O . ?\322) (?U . ?\331)
	 (?Y . ?\335) (?a . ?\340) (?e . ?\350) (?i . ?\354) (?o . ?\362)
	 (?u . ?\371))
    (?~  (?A . ?\303) (?N . ?\321) (?O . ?\325) (?a . ?\343) (?n . ?\361)
	 (?o . ?\365)))
  "Alist containing key definitions for insert-iso-char.
The car of each element is a prefix key for a set of characters.
The cdr of each element is an alist:
    The car of each element of these is the character that, if typed after
    its prefix key, inserts the cdr of each element.")

(defconst iso-chars-word-constituents
  '(?\Ë ?\ç ?\å ?\Ì ?\€ ?\� ?\® ?\‚ ?\é ?\ƒ ?\æ ?\è ?\í ?\ê ?\ë ?\ì ?\Ü ?\„
    ?\ñ ?\î ?\ï ?\Í ?\… ?\¯ ?\ô ?\ò ?\ó ?\† ?\  ?\Þ ?\§
    ?\ˆ ?\‡ ?\‰ ?\‹ ?\Š ?\Œ ?\¾ ?\� ?\� ?\Ž ?\� ?\‘ ?\“ ?\’ ?\” ?\• ?\Ý ?\–
    ?\˜ ?\— ?\™ ?\› ?\š ?\¿ ?\� ?\œ ?\ž ?\Ÿ ?\à ?\ß ?\Ø)
  "List of characters from the upper ISO-set that can belong to a word.")

(defvar iso-previous-local-map nil
  "Keymap local map prior to the call of iso-8859-1-mode.
Used to restore this map afterwards.")
(make-variable-buffer-local 'iso-previous-local-map)

(defvar iso-previous-global-map nil
  "Global keymap map prior to the call of iso-8859-1-mode.
Used to restore this map afterwards.")

(defvar iso-local-map nil
  "Keymap with ISO key bindings. Local to each buffer.")
(make-variable-buffer-local 'iso-local-map)

(defvar iso-global-map nil
  "Keymap with ISO key bindings.")


;;; install and uninstall bindings

(defun install-iso-bindings ()
  "Install key bindings of iso-8859-1-compose-alist.
iso-key-prefix is used as a prefix key."
  (let ((iso-list iso-8859-1-compose-alist))
    (if make-iso-8859-1-mode-global
	(progn
	  (setq iso-previous-global-map (current-global-map))
	  (let ((old-binding (lookup-key iso-previous-global-map
					 iso-key-prefix)))
	    (if (symbolp old-binding)
		(define-key iso-previous-global-map
		  iso-key-prefix (copy-keymap (symbol-function old-binding)))))
	  (setq iso-global-map (copy-keymap iso-previous-global-map))
	  (use-global-map iso-global-map)
	  (while iso-list
	    (if iso-lucid-emacs-p
		(global-set-key (vector iso-lucid-key-prefix
					(intern (char-to-string
						 (car (car iso-list)))))
				'insert-iso-char))
	    (global-set-key (concat iso-key-prefix
				    (char-to-string (car (car iso-list))))
			    'insert-iso-char)
	    (setq iso-list (cdr iso-list)))
	  (isoify-syntax-table (syntax-table))
	  (isoify-syntax-table (standard-syntax-table))
	  (isoify-syntax-table text-mode-syntax-table))
      (setq iso-previous-local-map (current-local-map))
      (setq iso-local-map (copy-keymap iso-previous-local-map))
      (use-local-map iso-local-map)
      (while iso-list
	(local-set-key (concat iso-key-prefix
			       (char-to-string (car (car iso-list))))
		       'insert-iso-char)
	(setq iso-list (cdr iso-list)))
      (isoify-syntax-table (syntax-table)))))

(defun isoify-syntax-table (syntax-table)
  "Modify entries in SYNTAX-TABLE such that chars in iso-chars-word-constituents
become word constituents."
  (let ((clist iso-chars-word-constituents))
    (while clist
      (modify-syntax-entry (car clist) "w" syntax-table)
      (setq clist (cdr clist)))))

(defun uninstall-iso-bindings ()
  "Restore key nindings prior to the call of iso-8859-1-mode."
  (if make-iso-8859-1-mode-global
      (use-global-map iso-previous-global-map)
    (use-local-map iso-previous-local-map)))


;;; the core of this mode: insert a character

(defun insert-iso-char (arg)
  "Insert a character of the above-ASCII ISO-8859-1 charset.
last-command-char and a character that is read in addition serve as keys
for a lookup in iso-8859-1-compose-alist for the character to insert.
Prefix arg is repeat count.
For a description of the key sequences see the documentation of
iso-8859-1-mode."
  (interactive "p")
  (let* ((1st-key-list (assq last-command-char
			     iso-8859-1-compose-alist)))
    (if 1st-key-list
	(let* ((2nd-key (read-char))
	       (entry (assq 2nd-key 1st-key-list)))
	  (if entry
	      (insert (make-string arg (cdr entry)))
	    (error "2nd key %c not used with 1st key %c"
		   2nd-key last-command-char)))
      ;; this error does not occur
      (error "invalid 1st key %c" last-command-char))))



;;; definition of the minor mode

(if (not (assq 'iso-8859-1-mode minor-mode-alist))
    (progn
      (setq minor-mode-alist (cons '(iso-8859-1-mode " ISO") 
				   minor-mode-alist))))

(defvar iso-8859-1-mode nil)
(if (not make-iso-8859-1-mode-global)
    (make-variable-buffer-local 'iso-8859-1-mode))
(setq-default iso-8859-1-mode nil)

;; this is a helper function for contructing the docstring of the
;; function iso-8859-1-mode.
(defun construct-iso-8859-1-mode-docstring ()
  "Construct a documentation string for iso-8859-1-mode
and put it in place. Pretty ugly hack."
  (let* ((prefix "Minor mode with bindings to type ISO-8859-1 characters.
Toggle iso-8859-1-mode, or turn it on iff optional ARG is positiv.

The key sequences look like the following: C-c <1st key> <2nd key>.
Shown below are the pairs of 1st and 2nd keys and the resulting char.

")
	 (alist iso-8859-1-compose-alist)
	 (docstring prefix)
	 (separator ", ")
	 (becomes " = ")
	 (slength (+ (length separator) (length becomes) 3)))
    (while alist
      (let ((1st-char (car (car alist)))
	    (2nd-list (cdr (car alist)))
	    (column 0))
	(while 2nd-list
	  (let ((2nd-char (car (car 2nd-list)))
		(iso-char (cdr (car 2nd-list))))
	    (if (> (+ column slength) (1- (screen-width)))
		(progn
		  (setq docstring
			(concat docstring
				(format "\n%s" (make-string slength ?\ ))))
		  (setq column slength)))
	    (setq docstring (concat docstring
				    (format "%c%c%s%c%s"
					    1st-char 2nd-char becomes
					    iso-char separator)))
	    (setq column (+ slength column))
	    (setq 2nd-list (cdr 2nd-list)))))
      (setq docstring (concat docstring "\n"))
      (setq alist (cdr alist)))
    (setq docstring (concat (substring docstring 0 -3) "."))
    (rplaca (cdr (cdr (symbol-function 'iso-8859-1-mode))) docstring)))


(defun iso-8859-1-mode (arg)
  "This documentation string is to be replaced by the one created by
construct-iso-8859-1-mode-docstring."
  (interactive "P")
  ;; 
  (if (or (and (null arg)
	       (not iso-8859-1-mode))
	  (and arg
	       (> (prefix-numeric-value arg) 0)))
      (progn
	;; switch on
	(install-iso-bindings)
	(setq iso-8859-1-mode t)
	(if enable-iso-8859-1-mode-help-message
	    (message (concat "Help is available with "
			     (substitute-command-keys "\\[describe-function]")
			     " iso-8859-1-mode"))))
    ;; switch off
    (uninstall-iso-bindings)
    (setq iso-8859-1-mode nil))
  (set-buffer-modified-p (buffer-modified-p)))

(construct-iso-8859-1-mode-docstring)

;; short-hands for german character, depend on variable
;; enable-german-iso-shorthands

(defconst german-iso-shorthand-alist
  '((?a . ?Š) (?o . ?š) (?u . ?Ÿ) (?A . ?€) (?O . ?…) (?U . ?†) (?s . ?§)))

(defun german-iso-shorthand (arg)
  "Insert umlaut resp. sharp s."
  (interactive "p")
  (setq last-command-char (cdr (assoc last-command-char
				      german-iso-shorthand-alist)))
  (self-insert-command arg))


(defun install-german-iso-shorthands ()
  ;; The following is only true when iso-key-prefix is C-c
  "Install shorthands for inserting german ISO characters.
These shorthands are globally available independent of iso-8859-1-mode.
The keys are: C-c<letter>, where letter is one of
a, o, u, A, O, U, s. The appropriate umlaut resp.
sharp s is inserted."
  (if (and iso-lucid-emacs-p
	   (lookup-key (current-global-map) 'multi_key))
      (global-unset-key 'multi_key))
  (let ((klist '("a" "o" "u" "A" "O" "U" "s")))
    (while klist
      (if iso-lucid-emacs-p
	  (global-set-key (vector iso-lucid-key-prefix (intern (car klist)))
			  'german-iso-shorthand))
      (global-set-key (concat iso-key-prefix (car klist))
		      'german-iso-shorthand)
      (setq klist (cdr klist)))))

(if enable-german-iso-shorthands
    (install-german-iso-shorthands))


;; isoify-umlauts. Not yet very mature.

(defconst tuml-iso-replacements
  '(("ae" . "Š")
    ("oe" . "š")
    ("ue" . "Ÿ")
    ("ss" . "§")
    ("Ae" . "€")
    ("Oe" . "…")
    ("Ue" . "†")))

(defvar iso-umlaut-init-file (expand-file-name "~/.iso-umlaut-init.el")
  "File containing a setq statement to initialize tuml-special-words.
texify-umlauts looks for this file in the current directory by default.")

(defun Isoify-umlauts (&optional buffer)
  "Replace umlauts with their iso equivalent in BUFFER.
Default is current buffer."
  (require 'texify)
  (interactive)
  (let ((tuml-replacements tuml-iso-replacements)
	(umlaut-init-file iso-umlaut-init-file))
    (texify-umlauts buffer)))



;;;; Definitions of iso-8859-1-compose-alist taken from this table:
;;;
;;; 240  SP   NO-BREAK SPACE (NBSP)                   (siehe oben)
;;; 241  !    INVERTED EXCLAMATION MARK               kopfstehendes !
;;; 242  "    CENT SIGN                               c+|
;;; 243  #    POUND SIGN                              brit. Pfund
;;; 244  $    CURRENCY SIGN                           x+o
;;; 245  %    YEN SIGN                                Y+-
;;; 246  &    BROKEN BAR                              | zweigeteilt
;;; 247  '    PARAGRAPH SIGN, SECTION SIGN            Paragraph
;;; 250  (    DIAERESIS                               " (Umlautpunkte)
;;; 251  )    COPYRIGHT SIGN                          (c)
;;; 252  *    FEMININE ORDINAL INDICATOR              hochgest. a+_
;;; 253  +    LEFT ANGLE QUOTATION MARK               <<
;;; 254  ,    NOT SIGN                                NOT Haken
;;; 255  -    SOFT HYPHEN (SHY)                       (siehe oben)
;;; 256  .    REGISTERED TRADE MARK SIGN              (R)
;;; 257  /    MACRON                                  hochgestelltes _
;;; 260  0    RING ABOVE, DEGREE SIGN                 hochgestelltes o
;;; 261  1    PLUS-MINUS SIGN                         + ueber -
;;; 262  2    SUPERSCRIPT TWO                         hochgestellte 2
;;; 263  3    SUPERSCRIPT THREE                       hochgestellte 3
;;; 264  4    ACUTE ACCENT                            hochgestelltes /
;;; 265  5    MICRO SIGN                              griech. kl. mue
;;; 266  6    PILCROW SIGN                            etwa grosses Pi
;;; 267  7    MIDDLE DOT                              zentraler Punkt
;;; 270  8    CEDILLA                                 ,
;;; 271  9    SUPERSCRIPT ONE                         hochgestellte 1
;;; 272  :    MASCULINE ORDINAL INDICATOR             hochgest. o+_
;;; 273  ;    RIGHT ANGLE QUOTATION MARK              >>
;;; 274  <    VULGAR FRACTION ONE QUATER              1/4
;;; 275  =    VULGAR FRACTION ONE HALF                1/2
;;; 276  >    VULGAR FRACTION THREE QUATERS           3/4
;;; 277  ?    INVERTED QUESTION MARK                  kopfstehendes ?
;;; 300  @    CAPITAL LETTER A WITH GRAVE ACCENT      A+\
;;; 301  A    CAPITAL LETTER A WITH ACUTE ACCENT      A+/
;;; 302  B    CAPITAL LETTER A WITH CIRCUMFLEX ACCENT A+^
;;; 303  C    CAPITAL LETTER A WITH TILDE             A+~
;;; 304  D    CAPITAL LETTER A WITH DIAERESIS         A+"
;;; 305  E    CAPITAL LETTER A WITH RING ABOVE        A+o
;;; 306  F    CAPITAL DIPHTONG A WITH E               AE
;;; 307  G    CAPITAL LETTER C WITH CEDILLA           C+,
;;; 310  H    CAPITAL LETTER E WITH GRAVE ACCENT      E+\
;;; 311  I    CAPITAL LETTER E WITH ACUTE ACCENT      E+/
;;; 312  J    CAPITAL LETTER E WITH CIRCUMFLEX ACCENT E+^
;;; 313  K    CAPITAL LETTER E WITH DIAERESIS         E+"
;;; 314  L    CAPITAL LETTER I WITH GRAVE ACCENT      I+\
;;; 315  M    CAPITAL LETTER I WITH ACUTE ACCENT      I+/
;;; 316  N    CAPITAL LETTER I WITH CIRCUMFLEX ACCENT I+^
;;; 317  O    CAPITAL LETTER I WITH DIAERESIS         I+"
;;; 320  P    CAPITAL ICELANDIC LETTER ETH            D+-
;;; 321  Q    CAPITAL LETTER N WITH TILDE             N+~
;;; 322  R    CAPITAL LETTER O WITH GRAVE ACCENT      O+\
;;; 323  S    CAPITAL LETTER O WITH ACUTE ACCENT      O+/
;;; 324  T    CAPITAL LETTER O WITH CIRCUMFLEX ACCENT O+^
;;; 325  U    CAPITAL LETTER O WITH TILDE             O+~
;;; 326  V    CAPITAL LETTER O WITH DIAERESIS         O+"
;;; 327  W    MULTIPLICATION SIGN                     x
;;; 330  X    CAPITAL LETTER O WITH OBLIQUE STROKE    O+/ durchg.
;;; 331  Y    CAPITAL LETTER U WITH GRAVE ACCENT      U+\
;;; 332  Z    CAPITAL LETTER U WITH ACUTE ACCENT      U+/
;;; 333  [    CAPITAL LETTER U WITH CIRCUMFLEX ACCENT U+^
;;; 334  \    CAPITAL LETTER U WITH DIAERESIS         U+"
;;; 335  ]    CAPITAL LETTER Y WITH ACUTE ACCENT      Y+/
;;; 336  ^    CAPITAL ICELANDIC LETTER THORN          etwa P+I
;;; 337  _    SMALL GERMAN LETTER SHARP s             scharfes s
;;; 340  `    SMALL LETTER a WITH GRAVE ACCENT        a+\
;;; 341  a    SMALL LETTER a WITH ACUTE ACCENT        a+/
;;; 342  b    SMALL LETTER a WITH CIRCUMFLEX ACCENT   a+^
;;; 343  c    SMALL LETTER a WITH TILDE               a+~
;;; 344  d    SMALL LETTER a WITH DIAERESIS           a+"
;;; 345  e    SMALL LETTER a WITH RING ABOVE          a+o
;;; 346  f    SMALL DIPHTONG a WITH e                 ae
;;; 347  g    SMALL LETTER c WITH CEDILLA             c+,
;;; 350  h    SMALL LETTER e WITH GRAVE ACCENT        e+\
;;; 351  i    SMALL LETTER e WITH ACUTE ACCENT        e+/
;;; 352  j    SMALL LETTER e WITH CIRCUMFLEX ACCENT   e+^
;;; 353  k    SMALL LETTER e WITH DIAERESIS           e+"
;;; 354  l    SMALL LETTER i WITH GRAVE ACCENT        i+\
;;; 355  m    SMALL LETTER i WITH ACUTE ACCENT        i+/
;;; 356  n    SMALL LETTER i WITH CIRCUMFLEX ACCENT   i+^
;;; 357  o    SMALL LETTER i WITH DIAERESIS           i+"
;;; 360  p    SMALL ICELANDIC LETTER ETH              etwa d+-
;;; 361  q    SMALL LETTER n WITH TILDE               n+~
;;; 362  r    SMALL LETTER o WITH GRAVE ACCENT        o+\
;;; 363  s    SMALL LETTER o WITH ACUTE ACCENT        o+/
;;; 364  t    SMALL LETTER o WITH CIRCUMFLEX ACCENT   o+^
;;; 365  u    SMALL LETTER o WITH TILDE               o+~
;;; 366  v    SMALL LETTER o WITH DIAERESIS           o+"
;;; 367  w    DIVISION SIGN                           :+-
;;; 370  x    SMALL LETTER o WITH OBLIQUE STROKE      o+/ durchg.
;;; 371  y    SMALL LETTER u WITH GRAVE ACCENT        u+\
;;; 372  z    SMALL LETTER u WITH ACUTE ACCENT        u+/
;;; 373  {    SMALL LETTER u WITH CIRCUMFLEX ACCENT   u+^
;;; 374  |    SMALL LETTER u WITH DIAERESIS           u+"
;;; 375  }    SMALL LETTER y WITH ACUTE ACCENT        y+/
;;; 376  ~    SMALL ICELANDIC LETTER THORN            etwa p+I
;;; 377  DEL  SMALL LETTER y WITH DIAERESIS           y+"