;;; fr-8859-1.el --- keyboard input definitions for French and ISO 8859-1. ;; Copyright information: ;; ;; Copyright (c) 1994--1996 Philippe Deschamp ;; ;; Permission is granted to anyone to make or distribute verbatim ;; copies of this document as received, in any medium, provided ;; that the copyright notice and this permission notice are ;; preserved, thus giving the recipient permission to redistribute ;; in turn. ;; ;; Permission is granted to distribute modified versions of this ;; document, or of portions of it, under the above conditions, ;; provided also that they carry prominent notices stating who last ;; changed them. ;; Author: Philippe Deschamp -- Jeu 17 Fev 1994 ;; Special minor mode for inputing French in text-like modes using ISO 8859-1. ;;; ;; Credits to Marc Shapiro and ;; Bruno Marmol for some ideas and implementations. ;; Gilles Roussel wants his name in too, although this has nothing to do with ;; anything he did :-). ;;; Commentary: ;; Function `francais-8859-1-mode' activates a minor mode ;; (`francais-8859-1-minor-mode') in which some "accent keys" become ;; "active" to provide a simple means for inserting French accented ;; characters according to the ISO-8859-1 character set. ;; ;; In `francais-8859-1-minor-mode', pseudo accent keys are used to compose ;; accented keys. The pseudo-accent characters are: ;; ;; ' -> accent aigu ;; ` -> accent grave ;; ^ -> accent circonflexe ;; " -> tre'ma (a bug in hilit19 imposes a second " here...) ;; , -> ce'dille ;; ;; Some other chars also have special meanings, to recognize : ;; ;; << -> guillemet ouvrant ;; >> -> guillemet fermant ;; 1/4 -> quart ;; 1/2 -> moitie ;; 3/4 -> trois-quart ;; +/- -> plus ou moins ;; ;; ;; The action taken depends on the character that precedes the pseudo accent. ;; In general: ;; ;; appropriate letter + pseudo accent -> accented letter ;; other + pseudo accent -> other + pseudo accent ;; ;; ;; There is a third class of active characters defined by this minor mode, ;; namely the `french space-preceded punctuation signs', which are the ;; exclamation mark, the colon, the semicolon and the question mark. The ;; guillemets are similar, but treated on their own, as they are already ;; obtained as special characters. ;; ;; ;; See also the variable `fr-8859-1-known-iso-table'. (defvar francais-8859-1-minor-mode nil) (make-variable-buffer-local 'francais-8859-1-minor-mode) (defconst francais-8859-1-minor-mode-string " Fran\347ais" ;" Français" "The string displayed in the mode line when in French accents mode.") (defvar francais-8859-1-minor-mode-map nil "Keymap for Francais-8859-1 mode.") (or francais-8859-1-minor-mode-map (setq francais-8859-1-minor-mode-map (make-sparse-keymap))) (define-key francais-8859-1-minor-mode-map "'" 'fr-8859-1-aigu) (define-key francais-8859-1-minor-mode-map "`" 'fr-8859-1-grave) (define-key francais-8859-1-minor-mode-map "^" 'fr-8859-1-circonflexe) (define-key francais-8859-1-minor-mode-map "\"" 'fr-8859-1-trema) (define-key francais-8859-1-minor-mode-map "a" 'fr-8859-1-aou) (define-key francais-8859-1-minor-mode-map "o" 'fr-8859-1-aou) (define-key francais-8859-1-minor-mode-map "u" 'fr-8859-1-aou) (define-key francais-8859-1-minor-mode-map "A" 'fr-8859-1-aou) (define-key francais-8859-1-minor-mode-map "O" 'fr-8859-1-aou) (define-key francais-8859-1-minor-mode-map "U" 'fr-8859-1-aou) (define-key francais-8859-1-minor-mode-map "<" 'fr-8859-1-inf) (define-key francais-8859-1-minor-mode-map " " 'fr-8859-1-space) (define-key francais-8859-1-minor-mode-map ">" 'fr-8859-1-sup) (define-key francais-8859-1-minor-mode-map "2" 'fr-8859-1-fractions) (define-key francais-8859-1-minor-mode-map "4" 'fr-8859-1-fractions) (define-key francais-8859-1-minor-mode-map "-" 'fr-8859-1-fractions) (define-key francais-8859-1-minor-mode-map "!" 'fr-8859-1-punctuation) (define-key francais-8859-1-minor-mode-map ":" 'fr-8859-1-punctuation) (define-key francais-8859-1-minor-mode-map ";" 'fr-8859-1-punctuation) (define-key francais-8859-1-minor-mode-map "?" 'fr-8859-1-punctuation) (or (assq 'francais-8859-1-minor-mode minor-mode-alist) (setq minor-mode-alist (cons '(francais-8859-1-minor-mode francais-8859-1-minor-mode) minor-mode-alist))) (or (assq 'francais-8859-1-minor-mode minor-mode-map-alist) (setq minor-mode-map-alist (cons (cons 'francais-8859-1-minor-mode francais-8859-1-minor-mode-map) minor-mode-map-alist))) (defun francais-8859-1-mode (&optional arg) "Toggle French accents mode, in which accents may modify the preceding letter. This permits easy insertion of accented French characters according to ISO-8859-1. When this mode is enabled, accent character keys \(` ' ^ \" ,) do not always self-insert, they look at the preceding letter in order to decide what to do. The recognized combinations correspond to the regexp: a[`^]\\|e['`^\"]\\|i[\"^]\\|o^\\|u[`^\"]\\|c,[aou] This regexp is extended for some special characters in combinations: << >> 1/4 1/2 3/4 +/- give \253 \273 \274 \275 \276 \261 Furthermore, the space character normally preceding some punctuation characters \(! : ; ?) is replaced by a non-breakable space \( ). With a positive argument enables Francais-8859-1 mode, with a negative argument disables it. The variable `francais-8859-1-minor-mode-string' controls what is displayed in the mode line when in this mode." (interactive "P") (if (if arg ;; Negative arg means switch it off. (<= (prefix-numeric-value arg) 0) ;; No arg means toggle. francais-8859-1-minor-mode) (setq francais-8859-1-minor-mode nil) ;; Enable electric accents. (setq francais-8859-1-minor-mode (or (and (stringp arg) arg) francais-8859-1-minor-mode-string "")))) (defun francais-8859-1-mode-on () "Unconditionally turn on Francais-8859-1 mode." (francais-8859-1-mode 1)) (defun fr-8859-1-backup-char (&optional N) "Deletes backwards N characters for French accents mode." (or N (setq N 1)) (if isearch-mode (while (>= (setq N (1- N)) 0) (isearch-delete-char)) (delete-backward-char N))) (defun fr-8859-1-preceding-char (&optional N) "Returns the N'th character backwards for French accents mode." (or N (setq N 1)) (or (if isearch-mode ;; return nil if there is an intervening isearch-repeat (let ((letat isearch-cmds) setat) ;; find the (N-1)'th state under stack top (while (> (setq N (1- N)) 0) (setq letat (cdr letat))) ;; Latest two states must be the same. (setq setat (car (car letat))) (and (or (not (cdr letat)) (not (equal (car (car (cdr letat))) setat))) (> (length setat) 0) (aref setat (1- (length setat))))) (char-after (- (point) N))) 0)) (defun fr-8859-1-insert-char (&optional char) (let ((last-command-event (or char last-command-event))) (command-execute (let ((francais-8859-1-minor-mode nil)) (key-binding (vector last-command-event)))))) (defun fr-8859-1-insert-accent (assoc-list) "Replace preceding letter with accented letter from ASSOC-LIST." (let ((pair (assq (fr-8859-1-preceding-char) assoc-list))) (if pair (progn (fr-8859-1-backup-char) (fr-8859-1-insert-char (cdr pair))) (fr-8859-1-insert-char)))) (defun fr-8859-1-aigu (prefix-arg) "Aigu accent (e') or insert the character you type." (interactive "P") (fr-8859-1-insert-accent '( (?e . ?\351) ;(?e . ?é) (?E . ?\311) ;(?E . ?É) ))) (defun fr-8859-1-grave (prefix-arg) "Grave accent (a` or e` or u`) or insert the character you type." (interactive "P") (fr-8859-1-insert-accent '( (?a . ?\340)(?e . ?\350)(?u . ?\371) ;(?a . ?à)(?e . ?è)(?u . ?ù) (?A . ?\300)(?E . ?\310)(?U . ?\331) ;(?A . ?À)(?E . ?È)(?U . ?Ù) ))) (defun fr-8859-1-circonflexe (prefix-arg) "Circumflex accent (a^ or e^ or i^ or o^ or u^) or insert the character you type." (interactive "P") (fr-8859-1-insert-accent '( (?a . ?\342)(?e . ?\352)(?i . ?\356)(?o . ?\364)(?u . ?\373) ;(?a . ?â)(?e . ?ê)(?i . ?î)(?o . ?ô)(?u . ?û) (?A . ?\302)(?E . ?\312)(?I . ?\316)(?O . ?\324)(?U . ?\333) ;(?A . ?Â)(?E . ?Ê)(?I . ?Î)(?O . ?Ô)(?U . ?Û) ))) (defun fr-8859-1-trema (prefix-arg) "Trema accent (e\" or i\" or u\") or insert \"." (interactive "P") (fr-8859-1-insert-accent '( (?e . ?\353)(?i . ?\357)(?u . ?\374) ;(?e . ?ë)(?i . ?ï)(?u . ?ü) (?E . ?\313)(?I . ?\317)(?U . ?\334) ;(?E . ?Ë)(?I . ?Ï)(?U . ?Ü) ))) (defun fr-8859-1-aou (prefix-arg) "Insert the character you type, checking if preceding characters form c-cedille." (interactive "P") (if (= (fr-8859-1-preceding-char) ?,) (let ((pair (assoc (concat (list (fr-8859-1-preceding-char 2) last-command-event)) '( ("ca" . ?\347)("co" . ?\347)("cu" . ?\347) ;("ca" . ?ç)("co" . ?ç)("cu" . ?ç) ("Ca" . ?\307)("Co" . ?\307)("Cu" . ?\307) ;("Ca" . ?Ç)("Co" . ?Ç)("Cu" . ?Ç) ("CA" . ?\307)("CO" . ?\307)("CU" . ?\307) ;("CA" . ?Ç)("CO" . ?Ç)("CU" . ?Ç) )))) (if pair (progn (fr-8859-1-backup-char 2) (fr-8859-1-insert-char (cdr pair)))))) (fr-8859-1-insert-char)) (defun fr-8859-1-inf (prefix-arg) "Guillemet ouvrant (<<) or insert <." (interactive "P") (fr-8859-1-insert-accent '((?< . ?\253)))) ;(?< . ?«) (defun fr-8859-1-space (prefix-arg) "See variable fr-8859-1-electric-non-breakable-space ." (interactive "P") (if (and fr-8859-1-electric-non-breakable-space (= (fr-8859-1-preceding-char) ?\253)) ;« (fr-8859-1-insert-char ?\240) ;(yes, a " " is a " " with 8th bit set :-) (fr-8859-1-insert-char))) (defun fr-8859-1-sup (prefix-arg) "Guillemet fermant (>>) or insert >. See variable fr-8859-1-electric-non-breakable-space ." (interactive "P") (if (= (fr-8859-1-preceding-char) ?>) ;(?> . ?») (progn (fr-8859-1-backup-char) (fr-8859-1-maybe-electric-non-breakable-space) (fr-8859-1-insert-char ?\273)) (fr-8859-1-insert-char))) (defun fr-8859-1-fractions (prefix-arg) "Deals with fractions (1/2, 1/4, 3/4, +/-)." (interactive "P") (let (pair) (if (and (= (fr-8859-1-preceding-char) ?/) (setq pair (assoc (concat (list (fr-8859-1-preceding-char 2) last-command-event)) '(("14" . ?\274)("12" . ?\275)("34" . ?\276)("+-" . ?\261))))) ;("14" . ?¼)("12" . ?½)("34" . ?¾)("+-" . ?±) (progn (fr-8859-1-backup-char 2) (fr-8859-1-insert-char (cdr pair))) (fr-8859-1-insert-char)))) (defun fr-8859-1-punctuation (prefix-arg) "Deals with punctuation (! : ; ?). See variable fr-8859-1-electric-non-breakable-space ." (interactive "P") (fr-8859-1-maybe-electric-non-breakable-space) (fr-8859-1-insert-char)) (defvar fr-8859-1-electric-non-breakable-space t "*When this variable is non-nil, some spaces surrounding punctuation marks are turned into the character named non-breakable-space, displayed thus: \"\240\".") (defun fr-8859-1-maybe-electric-non-breakable-space () (and fr-8859-1-electric-non-breakable-space (= (fr-8859-1-preceding-char) ?\ ) (progn (fr-8859-1-backup-char) (fr-8859-1-insert-char ?\240)))) ;(yes, a " " is a " " with 8th bit set :-) ;;; Inverse functions :-) (defconst fr-8859-1-known-iso-table '( ; '( (?\351 . "e'") ; (?é . "e'") (?\311 . "E'") ; (?É . "E'") (?\340 . "a`") ; (?à . "a`") (?\350 . "e`") ; (?è . "e`") (?\371 . "u`") ; (?ù . "u`") (?\300 . "A`") ; (?À . "A`") (?\310 . "E`") ; (?È . "E`") (?\331 . "U`") ; (?Ù . "U`") (?\342 . "a^") ; (?â . "a^") (?\352 . "e^") ; (?ê . "e^") (?\356 . "i^") ; (?î . "i^") (?\364 . "o^") ; (?ô . "o^") (?\373 . "u^") ; (?û . "u^") (?\302 . "A^") ; (? . "A^") (?\312 . "E^") ; (?Ê . "E^") (?\316 . "I^") ; (?Î . "I^") (?\324 . "O^") ; (?Ô . "O^") (?\333 . "U^") ; (?Û . "U^") (?\353 . "e\"") ; (?ë . "e\"") (?\357 . "i\"") ; (?ï . "i\"") (?\374 . "u\"") ; (?ü . "u\"") (?\313 . "E\"") ; (?Ë . "E\"") (?\317 . "I\"") ; (?Ï . "I\"") (?\334 . "U\"") ; (?Ü . "U\"") (?\347 . "c,") ; (?ç . "c,") (?\307 . "C,") ; (?Ç . "C,") (?\253 . "<<") ; (?« . "<<") (?\273 . ">>") ; (?» . ">>") (?\274 . "1/4") ; (?¼ . "1/4") (?\275 . "1/2") ; (?½ . "1/2") (?\276 . "3/4") ; (?¾ . "3/4") (?\261 . "+/-") ; (?± . "+/-") (?\240 . " ") ; (?  . " ") ) ; ) "Association table for function fr-8859-1-replace-iso-by-keys .") (defun fr-8859-1-replace-iso-by-keys (begin end) "Replace french accented characters by their multiple keys equivalent." (interactive "r") (goto-char begin) (save-restriction (narrow-to-region begin end) (let (pair) (while (re-search-forward "[^\0-~]" nil t) (setq pair (assq (preceding-char) fr-8859-1-known-iso-table)) (if pair (progn (delete-char -1) (insert (cdr pair)))))))) (defun fr-8859-1-replace-iso-by-octal (begin end) "Change all occurrences of 8 bits characters to the standard \"\\xyz\" form." (interactive "r") (goto-char begin) (save-restriction (narrow-to-region begin end) (let (char) (while (re-search-forward "[^\0-~]" nil t) (setq char (preceding-char)) (delete-char -1) (insert (format "\\%03o" char)))))) (require 'case-table) (let ((standard-table (standard-case-table)) downcase) (if (listp standard-table) (setq downcase (concat (car standard-table))) ; "concat" to copy it (setq downcase (copy-case-table standard-table))) (set-case-syntax-pair ?\300 ?\340 downcase) ;(set-case-syntax-pair ?À ?à downcase) (set-case-syntax-pair ?\302 ?\342 downcase) ;(set-case-syntax-pair ? ?â downcase) (set-case-syntax-pair ?\306 ?\346 downcase) ;(set-case-syntax-pair ?Æ ?æ downcase) (set-case-syntax-pair ?\307 ?\347 downcase) ;(set-case-syntax-pair ?Ç ?ç downcase) (set-case-syntax-pair ?\310 ?\350 downcase) ;(set-case-syntax-pair ?È ?è downcase) (set-case-syntax-pair ?\311 ?\351 downcase) ;(set-case-syntax-pair ?É ?é downcase) (set-case-syntax-pair ?\312 ?\352 downcase) ;(set-case-syntax-pair ?Ê ?ê downcase) (set-case-syntax-pair ?\313 ?\353 downcase) ;(set-case-syntax-pair ?Ë ?ë downcase) (set-case-syntax-pair ?\316 ?\356 downcase) ;(set-case-syntax-pair ?Î ?î downcase) (set-case-syntax-pair ?\317 ?\357 downcase) ;(set-case-syntax-pair ?Ï ?ï downcase) (set-case-syntax-pair ?\324 ?\364 downcase) ;(set-case-syntax-pair ?Ô ?ô downcase) (set-case-syntax-pair ?\331 ?\371 downcase) ;(set-case-syntax-pair ?Ù ?ù downcase) (set-case-syntax-pair ?\333 ?\373 downcase) ;(set-case-syntax-pair ?Û ?û downcase) (set-case-syntax-pair ?\334 ?\374 downcase) ;(set-case-syntax-pair ?Ü ?ü downcase) (set-case-syntax-delims ?\253 ?\273 downcase) ;(set-case-syntax-delims ?« ?» downcase) (if (listp standard-table) (set-standard-case-table (list downcase nil nil nil)) (set-standard-case-table downcase))) (provide 'fr-8859-1)