diff options
| author | Kenichi Handa | 1997-09-10 13:15:42 +0000 |
|---|---|---|
| committer | Kenichi Handa | 1997-09-10 13:15:42 +0000 |
| commit | 170a94d275c00cc653d621f66601d063a3a74155 (patch) | |
| tree | 7c011cfb527e37df131ad7775f79090a9eb34041 | |
| parent | 1d6af2e59ed66ba3d097f676fef8ba28ed85e4e6 (diff) | |
| download | emacs-170a94d275c00cc653d621f66601d063a3a74155.tar.gz emacs-170a94d275c00cc653d621f66601d063a3a74155.zip | |
(setup-ethiopic-environment): Don't bind
keys in global-map, don't add a hook to rmail-mode-hook and
mail-mode-hook.
(ethio-mode): New buffer local variable.
(ethio-mode-map): New variable.
(ethio-mode): New function.
(ethio-sera-to-fidel-mail-or-marker): New function.
(ethio-fidel-to-sera-mail-or-marker): New function.
(ethio-find-file): Do nothing if not in ethio-mode.
(ethio-write-file): Likewise.
(ethio-prefer-ascii-space): Moved from leim/quail/ethiopic.el.
(ethio-toggle-space): Likewise.
(ethio-insert-space): Likewise.
(ethio-insert-ethio-space): Likewise.
(ethio-prefer-ascii-punctuation): Likewise.
(ethio-toggle-punctuation): Likewise.
(ethio-gemination): Likewise.
| -rw-r--r-- | lisp/language/ethio-util.el | 212 |
1 files changed, 180 insertions, 32 deletions
diff --git a/lisp/language/ethio-util.el b/lisp/language/ethio-util.el index 9b7deb09657..7566cc19f57 100644 --- a/lisp/language/ethio-util.el +++ b/lisp/language/ethio-util.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; ethio-util.el --- utilities for Ethiopic | 1 | ;;; ethio-util.el --- utilities for Ethiopic |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. | 3 | ;; Copyright (C) 1997 Electrotechnical Laboratory, JAPAN. |
| 4 | ;; Licensed to the Free Software Foundation. | 4 | ;; Licensed to the Free Software Foundation. |
| 5 | 5 | ||
| 6 | ;; Keywords: mule, multilingual, Ethiopic | 6 | ;; Keywords: mule, multilingual, Ethiopic |
| @@ -31,35 +31,66 @@ | |||
| 31 | "Setup multilingual environment for Ethiopic." | 31 | "Setup multilingual environment for Ethiopic." |
| 32 | (interactive) | 32 | (interactive) |
| 33 | (setup-english-environment) | 33 | (setup-english-environment) |
| 34 | (setq default-input-method "ethiopic")) | ||
| 34 | 35 | ||
| 35 | (setq default-input-method "ethiopic") | 36 | ;; |
| 36 | 37 | ;; Ethio minor mode | |
| 37 | ;; | 38 | ;; |
| 38 | ;; key bindings | 39 | |
| 39 | ;; | 40 | (defvar ethio-mode nil "Non-nil if in Ethio minor mode.") |
| 40 | (define-key global-map [f4] 'ethio-sera-to-fidel-buffer) | 41 | (make-variable-buffer-local 'ethio-mode) |
| 41 | (define-key global-map [S-f4] 'ethio-sera-to-fidel-region) | 42 | |
| 42 | (define-key global-map [C-f4] 'ethio-sera-to-fidel-marker) | 43 | (or (assq 'ethio-mode minor-mode-alist) |
| 43 | (define-key global-map [f5] 'ethio-fidel-to-sera-buffer) | 44 | (setq minor-mode-alist |
| 44 | (define-key global-map [S-f5] 'ethio-fidel-to-sera-region) | 45 | (cons '(ethio-mode " Ethio") minor-mode-alist))) |
| 45 | (define-key global-map [C-f5] 'ethio-fidel-to-sera-marker) | 46 | |
| 46 | (define-key global-map [f6] 'ethio-modify-vowel) | 47 | (defvar ethio-mode-map |
| 47 | (define-key global-map [f7] 'ethio-replace-space) | 48 | (let ((map (make-sparse-keymap))) |
| 48 | (define-key global-map [f8] 'ethio-input-special-character) | 49 | (define-key map " " 'ethio-insert-space) |
| 49 | (define-key global-map [S-f2] 'ethio-replace-space) ; as requested | 50 | (define-key map [?\S- ] 'ethio-insert-ethio-space) |
| 50 | 51 | (define-key map [?\C-'] 'ethio-gemination) | |
| 51 | (add-hook | 52 | (define-key map [f2] 'ethio-toggle-space) |
| 52 | 'rmail-mode-hook | 53 | (define-key map [S-f2] 'ethio-replace-space) ; as requested |
| 53 | '(lambda () | 54 | (define-key map [f3] 'ethio-toggle-punctuation) |
| 54 | (define-key rmail-mode-map [C-f4] 'ethio-sera-to-fidel-mail) | 55 | (define-key map [f4] 'ethio-sera-to-fidel-buffer) |
| 55 | (define-key rmail-mode-map [C-f5] 'ethio-fidel-to-sera-mail))) | 56 | (define-key map [S-f4] 'ethio-sera-to-fidel-region) |
| 56 | 57 | (define-key map [C-f4] 'ethio-sera-to-fidel-mail-or-marker) | |
| 57 | (add-hook | 58 | (define-key map [f5] 'ethio-fidel-to-sera-buffer) |
| 58 | 'mail-mode-hook | 59 | (define-key map [S-f5] 'ethio-fidel-to-sera-region) |
| 59 | '(lambda () | 60 | (define-key map [C-f5] 'ethio-fidel-to-sera-mail-or-marker) |
| 60 | (define-key mail-mode-map [C-f4] 'ethio-sera-to-fidel-mail) | 61 | (define-key map [f6] 'ethio-modify-vowel) |
| 61 | (define-key mail-mode-map [C-f5] 'ethio-fidel-to-sera-mail))) | 62 | (define-key map [f7] 'ethio-replace-space) |
| 62 | ) | 63 | (define-key map [f8] 'ethio-input-special-character) |
| 64 | map) | ||
| 65 | "Keymap for Ethio minor mode.") | ||
| 66 | |||
| 67 | (or (assq 'ethio-mode minor-mode-map-alist) | ||
| 68 | (setq minor-mode-map-alist | ||
| 69 | (cons (cons 'ethio-mode ethio-mode-map) minor-mode-map-alist))) | ||
| 70 | |||
| 71 | ;;;###autoload | ||
| 72 | (defun ethio-mode (&optional arg) | ||
| 73 | "Toggle Ethio minor mode. | ||
| 74 | With arg, turn Ethio mode on if and only if arg is positive. | ||
| 75 | |||
| 76 | Also, Ethio minor mode is automatically turned on | ||
| 77 | when you activate the Ethiopic quail package. | ||
| 78 | |||
| 79 | The keys that are defined in ethio-mode are: | ||
| 80 | \\{ethio-mode-map}" | ||
| 81 | |||
| 82 | (interactive) | ||
| 83 | (setq ethio-mode | ||
| 84 | (if (null arg) (not ethio-mode) | ||
| 85 | (> (prefix-numeric-value arg) 0))) | ||
| 86 | (if ethio-mode | ||
| 87 | (progn | ||
| 88 | (add-hook 'find-file-hooks 'ethio-find-file) | ||
| 89 | (add-hook 'write-file-hooks 'ethio-write-file) | ||
| 90 | (add-hook 'after-save-hook 'ethio-find-file)) | ||
| 91 | (remove-hook 'find-file-hooks 'ethio-find-file) | ||
| 92 | (remove-hook 'write-file-hooks 'ethio-write-file) | ||
| 93 | (remove-hook 'after-save-hook 'ethio-find-file))) | ||
| 63 | 94 | ||
| 64 | ;; | 95 | ;; |
| 65 | ;; ETHIOPIC UTILITY FUNCTIONS | 96 | ;; ETHIOPIC UTILITY FUNCTIONS |
| @@ -776,6 +807,17 @@ Delete the escape even it is not recognised." | |||
| 776 | (insert-char ?$(3%%(B (/ z 4))))) | 807 | (insert-char ?$(3%%(B (/ z 4))))) |
| 777 | 808 | ||
| 778 | ;;;###autoload | 809 | ;;;###autoload |
| 810 | (defun ethio-sera-to-fidel-mail-or-marker (&optional arg) | ||
| 811 | "Execute ethio-sera-to-fidel-mail or ethio-sera-to-fidel-marker depending on the current major mode. | ||
| 812 | If in rmail-mode or in mail-mode, execute the former; otherwise latter." | ||
| 813 | |||
| 814 | (interactive "P") | ||
| 815 | (if (or (eq major-mode 'rmail-mode) | ||
| 816 | (eq major-mode 'mail-mode)) | ||
| 817 | (ethio-sera-to-fidel-mail (prefix-numeric-value arg)) | ||
| 818 | (ethio-sera-to-fidel-marker arg))) | ||
| 819 | |||
| 820 | ;;;###autoload | ||
| 779 | (defun ethio-sera-to-fidel-mail (&optional arg) | 821 | (defun ethio-sera-to-fidel-mail (&optional arg) |
| 780 | "Convert SERA to FIDEL to read/write mail and news. | 822 | "Convert SERA to FIDEL to read/write mail and news. |
| 781 | 823 | ||
| @@ -1157,6 +1199,17 @@ See also the descriptions of the variables | |||
| 1157 | (memq ethiocode '(389 405 421 437 440 441 442 443 444 457)))) | 1199 | (memq ethiocode '(389 405 421 437 440 441 442 443 444 457)))) |
| 1158 | 1200 | ||
| 1159 | ;;;###autoload | 1201 | ;;;###autoload |
| 1202 | (defun ethio-fidel-to-sera-mail-or-marker (&optional arg) | ||
| 1203 | "Execute ethio-fidel-to-sera-mail or ethio-fidel-to-sera-marker depending on the current major mode. | ||
| 1204 | If in rmail-mode or in mail-mode, execute the former; otherwise latter." | ||
| 1205 | |||
| 1206 | (interactive "P") | ||
| 1207 | (if (or (eq major-mode 'rmail-mode) | ||
| 1208 | (eq major-mode 'mail-mode)) | ||
| 1209 | (ethio-fidel-to-sera-mail) | ||
| 1210 | (ethio-fidel-to-sera-marker arg))) | ||
| 1211 | |||
| 1212 | ;;;###autoload | ||
| 1160 | (defun ethio-fidel-to-sera-mail nil | 1213 | (defun ethio-fidel-to-sera-mail nil |
| 1161 | "Convert FIDEL to SERA to read/write mail and news. | 1214 | "Convert FIDEL to SERA to read/write mail and news. |
| 1162 | 1215 | ||
| @@ -1781,6 +1834,9 @@ Otherwise, [0-9A-F]." | |||
| 1781 | "Transcribe file content into Ethiopic dependig on filename suffix." | 1834 | "Transcribe file content into Ethiopic dependig on filename suffix." |
| 1782 | (cond | 1835 | (cond |
| 1783 | 1836 | ||
| 1837 | ((null ethio-mode) | ||
| 1838 | nil) | ||
| 1839 | |||
| 1784 | ((string-match "\\.sera$" (buffer-file-name)) | 1840 | ((string-match "\\.sera$" (buffer-file-name)) |
| 1785 | (save-excursion | 1841 | (save-excursion |
| 1786 | (ethio-sera-to-fidel-buffer nil 'force) | 1842 | (ethio-sera-to-fidel-buffer nil 'force) |
| @@ -1815,6 +1871,9 @@ Otherwise, [0-9A-F]." | |||
| 1815 | "Transcribe Ethiopic characters in ASCII depending on the file extension." | 1871 | "Transcribe Ethiopic characters in ASCII depending on the file extension." |
| 1816 | (cond | 1872 | (cond |
| 1817 | 1873 | ||
| 1874 | ((null ethio-mode) | ||
| 1875 | nil) | ||
| 1876 | |||
| 1818 | ((string-match "\\.sera$" (buffer-file-name)) | 1877 | ((string-match "\\.sera$" (buffer-file-name)) |
| 1819 | (save-excursion | 1878 | (save-excursion |
| 1820 | (ethio-fidel-to-sera-buffer nil 'force) | 1879 | (ethio-fidel-to-sera-buffer nil 'force) |
| @@ -1857,9 +1916,98 @@ Otherwise, [0-9A-F]." | |||
| 1857 | (insert (if ethio-use-colon-for-colon "\\~-: " "\\~`: ") | 1916 | (insert (if ethio-use-colon-for-colon "\\~-: " "\\~`: ") |
| 1858 | (if ethio-use-three-dot-question "\\~`| " "\\~`? "))) | 1917 | (if ethio-use-three-dot-question "\\~`| " "\\~`? "))) |
| 1859 | 1918 | ||
| 1860 | (add-hook 'find-file-hooks 'ethio-find-file) | 1919 | ;; |
| 1861 | (add-hook 'write-file-hooks 'ethio-write-file) | 1920 | ;; Ethiopic word separator vs. ASCII space |
| 1862 | (add-hook 'after-save-hook 'ethio-find-file) | 1921 | ;; |
| 1922 | |||
| 1923 | (defvar ethio-prefer-ascii-space t) | ||
| 1924 | (make-variable-buffer-local 'ethio-prefer-ascii-space) | ||
| 1925 | |||
| 1926 | (defun ethio-toggle-space nil | ||
| 1927 | "Toggle ASCII space and Ethiopic separator for keyboard input." | ||
| 1928 | (interactive) | ||
| 1929 | (setq ethio-prefer-ascii-space | ||
| 1930 | (not ethio-prefer-ascii-space)) | ||
| 1931 | (force-mode-line-update)) | ||
| 1932 | |||
| 1933 | (defun ethio-insert-space (arg) | ||
| 1934 | "Insert ASCII spaces or Ethiopic word separators depending on context. | ||
| 1935 | |||
| 1936 | If the current word separator (indicated in mode-line) is the ASCII space, | ||
| 1937 | insert an ASCII space. With ARG, insert that many ASCII spaces. | ||
| 1938 | |||
| 1939 | If the current word separator is the colon-like Ethiopic word | ||
| 1940 | separator and the point is preceded by `an Ethiopic punctuation mark | ||
| 1941 | followed by zero or more ASCII spaces', then insert also an ASCII | ||
| 1942 | space. With ARG, insert that many ASCII spaces. | ||
| 1943 | |||
| 1944 | Otherwise, insert a colon-like Ethiopic word separator. With ARG, insert that | ||
| 1945 | many Ethiopic word separators." | ||
| 1946 | |||
| 1947 | (interactive "*p") | ||
| 1948 | (cond | ||
| 1949 | (ethio-prefer-ascii-space | ||
| 1950 | (insert-char 32 arg)) | ||
| 1951 | ((save-excursion | ||
| 1952 | (skip-chars-backward " ") | ||
| 1953 | (memq (preceding-char) | ||
| 1954 | '(?$(3$h(B ?$(3$i(B ?$(3$j(B ?$(3$k(B ?$(3$l(B ?$(3$m(B ?$(3$n(B ?$(3$o(B ?$(3%t(B ?$(3%u(B ?$(3%v(B ?$(3%w(B ?$(3%x(B))) | ||
| 1955 | (insert-char 32 arg)) | ||
| 1956 | (t | ||
| 1957 | (insert-char ?$(3$h(B arg)))) | ||
| 1958 | |||
| 1959 | (defun ethio-insert-ethio-space (arg) | ||
| 1960 | "Insert the Ethiopic word delimiter (the colon-like character). | ||
| 1961 | With ARG, insert that many delimiters." | ||
| 1962 | (interactive "*p") | ||
| 1963 | (insert-char ?$(3$h(B arg)) | ||
| 1964 | |||
| 1965 | ;; | ||
| 1966 | ;; Ethiopic punctuation vs. ASCII punctuation | ||
| 1967 | ;; | ||
| 1968 | |||
| 1969 | (defvar ethio-prefer-ascii-punctuation nil) | ||
| 1970 | (make-variable-buffer-local 'ethio-prefer-ascii-punctuation) | ||
| 1971 | |||
| 1972 | (defun ethio-toggle-punctuation nil | ||
| 1973 | "Toggle Ethiopic punctuations and ASCII punctuations for keyboard input." | ||
| 1974 | (interactive) | ||
| 1975 | (setq ethio-prefer-ascii-punctuation | ||
| 1976 | (not ethio-prefer-ascii-punctuation)) | ||
| 1977 | (let* ((keys '("." ".." "..." "," ",," ";" ";;" ":" "::" ":::" "*" "**")) | ||
| 1978 | (puncs | ||
| 1979 | (if ethio-prefer-ascii-punctuation | ||
| 1980 | '(?. [".."] ["..."] ?, [",,"] ?\; [";;"] ?: ["::"] [":::"] ?* ["**"]) | ||
| 1981 | '(?$(3$i(B ?$(3%u(B ?. ?$(3$j(B ?, ?$(3$k(B ?\; ?$(3$h(B ?$(3$i(B ?: ?* ?$(3$o(B)))) | ||
| 1982 | (while keys | ||
| 1983 | (quail-defrule (car keys) (car puncs) "ethiopic") | ||
| 1984 | (setq keys (cdr keys) | ||
| 1985 | puncs (cdr puncs))) | ||
| 1986 | (force-mode-line-update))) | ||
| 1987 | |||
| 1988 | ;; | ||
| 1989 | ;; Gemination | ||
| 1990 | ;; | ||
| 1991 | |||
| 1992 | (defun ethio-gemination nil | ||
| 1993 | "Compose the character before the point with the Ethiopic gemination mark. | ||
| 1994 | If the characater is already composed, decompose it and remove the gemination | ||
| 1995 | mark." | ||
| 1996 | (interactive "*") | ||
| 1997 | (cond | ||
| 1998 | ((eq (char-charset (preceding-char)) 'ethiopic) | ||
| 1999 | (insert "$(3%s(B") | ||
| 2000 | (compose-region | ||
| 2001 | (save-excursion (backward-char 2) (point)) | ||
| 2002 | (point)) | ||
| 2003 | (forward-char 1)) | ||
| 2004 | ((eq (char-charset (preceding-char)) 'leading-code-composition) | ||
| 2005 | (decompose-region | ||
| 2006 | (save-excursion (backward-char 1) (point)) | ||
| 2007 | (point)) | ||
| 2008 | (delete-backward-char 1)) | ||
| 2009 | (t | ||
| 2010 | (error "")))) | ||
| 1863 | 2011 | ||
| 1864 | ;; | 2012 | ;; |
| 1865 | (provide 'ethio-util) | 2013 | (provide 'ethio-util) |