-;;; ethio-util.el --- utilities for Ethiopic
+;;; ethio-util.el --- utilities for Ethiopic -*- coding: iso-2022-7bit; -*-
-;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+;; Copyright (C) 1997, 2001 Electrotechnical Laboratory, JAPAN.
;; Licensed to the Free Software Foundation.
;; Keywords: mule, multilingual, Ethiopic
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;; Author: TAKAHASHI Naoto <ntakahas@etl.go.jp>
+;; Author: TAKAHASHI Naoto <ntakahas@m17n.org>
+
+;;; Commentary:
;;; Code:
+;; Information for exiting Ethiopic environment.
+(defvar exit-ethiopic-environment-data nil)
+
;;;###autoload
-(defun setup-ethiopic-environment ()
- "Setup multilingual environment for Ethiopic."
- (interactive)
- (setup-english-environment)
- (setq primary-language "Ethiopic")
-
- (setq default-input-method '("Ethiopic" . "ethiopic"))
-
- ;;
- ;; key bindings
- ;;
- (define-key global-map [f4] 'sera-to-fidel-buffer)
- (define-key global-map [S-f4] 'sera-to-fidel-region)
- (define-key global-map [C-f4] 'sera-to-fidel-marker)
- (define-key global-map [f5] 'fidel-to-sera-buffer)
- (define-key global-map [S-f5] 'fidel-to-sera-region)
- (define-key global-map [C-f5] 'fidel-to-sera-marker)
- (define-key global-map [f6] 'ethio-modify-vowel)
- (define-key global-map [f7] 'ethio-replace-space)
- (define-key global-map [f8] 'ethio-input-special-character)
- (define-key global-map [S-f2] 'ethio-replace-space) ; as requested
-
- (add-hook
- 'rmail-mode-hook
- '(lambda ()
- (define-key rmail-mode-map [C-f4] 'sera-to-fidel-mail)
- (define-key rmail-mode-map [C-f5] 'fidel-to-sera-mail)))
-
- (add-hook
- 'mail-mode-hook
- '(lambda ()
- (define-key mail-mode-map [C-f4] 'sera-to-fidel-mail)
- (define-key mail-mode-map [C-f5] 'fidel-to-sera-mail)))
- )
+(defun setup-ethiopic-environment-internal ()
+ (let ((key-bindings '((" " . ethio-insert-space)
+ ([?\S- ] . ethio-insert-ethio-space)
+ ([?\C-'] . ethio-gemination)
+
+ ;; these old bindings conflict
+ ;; with Emacs' binding policy
+
+ ;; ([f2] . ethio-toggle-space)
+ ;; ([S-f2] . ethio-replace-space) ; as requested
+ ;; ([f3] . ethio-toggle-punctuation)
+ ;; ([f4] . ethio-sera-to-fidel-buffer)
+ ;; ([S-f4] . ethio-sera-to-fidel-region)
+ ;; ([C-f4] . ethio-sera-to-fidel-mail-or-marker)
+ ;; ([f5] . ethio-fidel-to-sera-buffer)
+ ;; ([S-f5] . ethio-fidel-to-sera-region)
+ ;; ([C-f5] . ethio-fidel-to-sera-mail-or-marker)
+ ;; ([f6] . ethio-modify-vowel)
+ ;; ([f7] . ethio-replace-space)
+ ;; ([f8] . ethio-input-special-character)
+
+ ;; this is the rewritten bindings
+
+ ([f3] . ethio-fidel-to-sera-buffer)
+ ([S-f3] . ethio-fidel-to-sera-region)
+ ([C-f3] . ethio-fidel-to-sera-mail-or-marker)
+ ([f4] . ethio-sera-to-fidel-buffer)
+ ([S-f4] . ethio-sera-to-fidel-region)
+ ([C-f4] . ethio-sera-to-fidel-mail-or-marker)
+ ([S-f5] . ethio-toggle-punctuation)
+ ([S-f6] . ethio-modify-vowel)
+ ([S-f7] . ethio-replace-space)
+ ([S-f8] . ethio-input-special-character)
+ ([C-f9] . ethio-toggle-space)
+ ([S-f9] . ethio-replace-space) ; as requested
+ ))
+ kb)
+ (while key-bindings
+ (setq kb (car (car key-bindings)))
+ (setq exit-ethiopic-environment-data
+ (cons (cons kb (global-key-binding kb))
+ exit-ethiopic-environment-data))
+ (global-set-key kb (cdr (car key-bindings)))
+ (setq key-bindings (cdr key-bindings))))
+
+ (add-hook 'quail-activate-hook 'ethio-select-a-translation)
+ (add-hook 'find-file-hook 'ethio-find-file)
+ (add-hook 'write-file-functions 'ethio-write-file)
+ (add-hook 'after-save-hook 'ethio-find-file))
+
+(defun exit-ethiopic-environment ()
+ "Exit Ethiopic language environment."
+ (while exit-ethiopic-environment-data
+ (global-set-key (car (car exit-ethiopic-environment-data))
+ (cdr (car exit-ethiopic-environment-data)))
+ (setq exit-ethiopic-environment-data
+ (cdr exit-ethiopic-environment-data)))
+
+ (remove-hook 'quail-activate-hook 'ethio-select-a-translation)
+ (remove-hook 'find-file-hook 'ethio-find-file)
+ (remove-hook 'write-file-functions 'ethio-write-file)
+ (remove-hook 'after-save-hook 'ethio-find-file))
;;
;; ETHIOPIC UTILITY FUNCTIONS
;; but file I/O is done in SERA.
;;
;; If the filename ends in ".java", editing is done in fidel
-;; but file I/O is done in the \uXXXX style, where XXXX is
+;; but file I/O is done in the \uXXXX style, where XXXX is
;; the Unicode codepoint for the Ethiopic character.
;;
;; If the filename ends in ".tex", editing is done in fidel
;;
;; SERA to FIDEL
;;
-
+
(defconst ethio-sera-to-fidel-table
[
nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
;;; I
("\e$(3"h\e(B" (?2 "\e$(3#:\e(B"))
;;; J
- ("\e$(3#j\e(B" (?e "\e$(3#e\e(B") (?u "\e$(3#f\e(B") (?i "\e$(3#g\e(B") (?a "\e$(3#h\e(B") (?E "\e$(3#i\e(B") (?o "\e$(3#k\e(B")
+ ("\e$(3#j\e(B" (?e "\e$(3#e\e(B") (?u "\e$(3#f\e(B") (?i "\e$(3#g\e(B") (?a "\e$(3#h\e(B") (?E "\e$(3#i\e(B") (?o "\e$(3#k\e(B")
(?W "\e$(3#l\e(B" (?a "\e$(3#l\e(B")
(?e "\e$(3#j%n\e(B") (?u "\e$(3#j%r\e(B") (?i "\e$(3#j%o\e(B") (?E "\e$(3#j%q\e(B")))
;;; K
(?! "\e$(3%t\e(B")
(?e "\e$(3#5\e(B") (?u "\e$(3#6\e(B") (?U "\e$(3#6\e(B") (?i "\e$(3#7\e(B") (?a "\e$(3#8\e(B") (?A "\e$(3#8\e(B")
(?E "\e$(3#9\e(B") (?I "\e$(3#:\e(B") (?o "\e$(3#;\e(B") (?O "\e$(3#;\e(B")
- (?g "\e$(3%^\e(B"
+ (?g "\e$(3%^\e(B"
(?e "\e$(3%Y\e(B") (?u "\e$(3%Z\e(B") (?i "\e$(3%[\e(B") (?a "\e$(3%\\e(B") (?E "\e$(3%]\e(B") (?o "\e$(3%_\e(B"))
(?h "\e$(3"H\e(B"
(?e "\e$(3"C\e(B") (?u "\e$(3"D\e(B") (?i "\e$(3"E\e(B") (?a "\e$(3"F\e(B") (?E "\e$(3"G\e(B") (?o "\e$(3"I\e(B")
(?W "\e$(3"P\e(B" (?e "\e$(3"K\e(B") (?u "\e$(3"P\e(B") (?i "\e$(3"M\e(B") (?a "\e$(3"N\e(B") (?E "\e$(3"O\e(B")))
- (?k "\e$(3%>\e(B"
+ (?k "\e$(3%>\e(B"
(?e "\e$(3%9\e(B") (?u "\e$(3%:\e(B") (?i "\e$(3%;\e(B") (?a "\e$(3%<\e(B") (?E "\e$(3%=\e(B") (?o "\e$(3%?\e(B"))
- (?s "\e$(3!F\e(B"
+ (?s "\e$(3!F\e(B"
(?e "\e$(3!A\e(B") (?u "\e$(3!B\e(B") (?i "\e$(3!C\e(B") (?a "\e$(3!D\e(B") (?E "\e$(3!E\e(B") (?o "\e$(3!G\e(B")
(?W "\e$(3!H\e(B" (?a "\e$(3!H\e(B")
(?e "\e$(3!F%n\e(B") (?u "\e$(3!F%r\e(B") (?i "\e$(3!F%o\e(B") (?E "\e$(3!F%q\e(B")))
- (?S "\e$(3$L\e(B"
+ (?S "\e$(3$L\e(B"
(?e "\e$(3$G\e(B") (?u "\e$(3$H\e(B") (?i "\e$(3$I\e(B") (?a "\e$(3$J\e(B") (?E "\e$(3$K\e(B") (?o "\e$(3$M\e(B")
(?W "\e$(3$F\e(B" (?a "\e$(3$F\e(B")
(?e "\e$(3$L%n\e(B") (?u "\e$(3$L%r\e(B") (?i "\e$(3$L%o\e(B") (?E "\e$(3$L%q\e(B")))
(?W "\e$(3%d\e(B" (?e "\e$(3%4\e(B") (?u "\e$(3%d\e(B") (?i "\e$(3%D\e(B") (?a "\e$(3$V\e(B") (?E "\e$(3%T\e(B"))
(?Y "\e$(3$a\e(B" (?a "\e$(3$a\e(B")))
;;; g
- ("\e$(3#r\e(B" (?e "\e$(3#m\e(B") (?u "\e$(3#n\e(B") (?i "\e$(3#o\e(B") (?a "\e$(3#p\e(B") (?E "\e$(3#q\e(B") (?o "\e$(3#s\e(B")
+ ("\e$(3#r\e(B" (?e "\e$(3#m\e(B") (?u "\e$(3#n\e(B") (?i "\e$(3#o\e(B") (?a "\e$(3#p\e(B") (?E "\e$(3#q\e(B") (?o "\e$(3#s\e(B")
(?W "\e$(3#z\e(B" (?e "\e$(3#u\e(B") (?u "\e$(3#z\e(B") (?i "\e$(3#w\e(B") (?a "\e$(3#x\e(B") (?E "\e$(3#y\e(B"))
(?2 "\e$(3%^\e(B" (?e "\e$(3%Y\e(B") (?u "\e$(3%Z\e(B") (?i "\e$(3%[\e(B") (?a "\e$(3%\\e(B") (?E "\e$(3%]\e(B") (?o "\e$(3%_\e(B")))
;;; h
;;; i
("\e$(3"e\e(B" (?2 "\e$(3#7\e(B"))
;;; j
- ("\e$(3#j\e(B" (?e "\e$(3#e\e(B") (?u "\e$(3#f\e(B") (?i "\e$(3#g\e(B") (?a "\e$(3#h\e(B") (?E "\e$(3#i\e(B") (?o "\e$(3#k\e(B")
+ ("\e$(3#j\e(B" (?e "\e$(3#e\e(B") (?u "\e$(3#f\e(B") (?i "\e$(3#g\e(B") (?a "\e$(3#h\e(B") (?E "\e$(3#i\e(B") (?o "\e$(3#k\e(B")
(?W "\e$(3#l\e(B" (?a "\e$(3#l\e(B")
(?e "\e$(3#j%n\e(B") (?u "\e$(3#j%r\e(B") (?i "\e$(3#j%o\e(B") (?E "\e$(3#j%q\e(B")))
;;; k
even if the buffer is read-only.
See also the descriptions of the variables
-`ethio-use-colen-for-colon' and
+`ethio-use-colon-for-colon' and
`ethio-use-three-dot-question'."
(interactive "r\nP")
buffer is read-only.
See also the descriptions of the variables
-`ethio-use-colen-for-colon' and
+`ethio-use-colon-for-colon' and
`ethio-use-three-dot-question'."
(interactive "P")
start table table2 ch)
(setcar (aref ethio-sera-to-fidel-table ?a)
- (if (eq lang 'tigrigna) "\e$(3"f\e(B" "\e$(3"c\e(B"))
+ (if (eq lang 'tigrigna) "\e$(3"f\e(B" "\e$(3"c\e(B"))
(while (and (not (eobp)) (null new-language))
(setq ch (following-char))
((or (string= flag "ti") (string= flag "tir")) 'tigrigna)
((or (string= flag "am") (string= flag "amh")) 'amharic)
(t nil)))
-
+
(defun ethio-convert-digit nil
"Convert Arabic digits to Ethiopic digits."
(let (ch z)
;; 10000
(insert-char ?\e$(3%%\e(B (/ z 4)))))
+;;;###autoload
+(defun ethio-sera-to-fidel-mail-or-marker (&optional arg)
+ "Execute ethio-sera-to-fidel-mail or ethio-sera-to-fidel-marker depending on the current major mode.
+If in rmail-mode or in mail-mode, execute the former; otherwise latter."
+
+ (interactive "P")
+ (if (or (eq major-mode 'rmail-mode)
+ (eq major-mode 'mail-mode))
+ (ethio-sera-to-fidel-mail (prefix-numeric-value arg))
+ (ethio-sera-to-fidel-marker arg)))
+
;;;###autoload
(defun ethio-sera-to-fidel-mail (&optional arg)
"Convert SERA to FIDEL to read/write mail and news.
border)
(save-excursion
- ;; look for the header-body separator
- (goto-char (point-min))
- (if (search-forward
- (if (eq major-mode 'rmail-mode)
- "\n\n" (concat "\n" mail-header-separator "\n"))
- nil t)
- (setq border (point))
- (error "header separator not found"))
+ ;; follow RFC822 rules instead of looking for a fixed separator
+ (rfc822-goto-eoh)
+ (forward-line 1)
+ (setq border (point))
;; note that the point is placed at the border
(if (or (re-search-forward "^<sera>$" nil t)
buffer is read-only.
See also the descriptions of the variables
-`ethio-use-colen-for-colon', `ethio-use-three-dot-question',
+`ethio-use-colon-for-colon', `ethio-use-three-dot-question',
`ethio-quote-vowel-always' and `ethio-numeric-reduction'."
(interactive "r\nP")
buffer is read-only.
See also the descriptions of the variables
-`ethio-use-colen-for-colon', `ethio-use-three-dot-question',
+`ethio-use-colon-for-colon', `ethio-use-three-dot-question',
`ethio-quote-vowel-always' and `ethio-numeric-reduction'."
(interactive "P")
fidel nil
digit t))
- ;; reduction = 2 and following 10s, 100s, 10000s
+ ;; reduction = 2 and following 10s, 100s, 10000s
((and (= ethio-numeric-reduction 2)
(memq ch '(370 379 380)))
(insert (substring (aref ethio-fidel-to-sera-map ch) 1))
;; `q `k X `g mW bW GW fW pW wW
(memq ethiocode '(389 405 421 437 440 441 442 443 444 457))))
+;;;###autoload
+(defun ethio-fidel-to-sera-mail-or-marker (&optional arg)
+ "Execute ethio-fidel-to-sera-mail or ethio-fidel-to-sera-marker depending on the current major mode.
+If in rmail-mode or in mail-mode, execute the former; otherwise latter."
+
+ (interactive "P")
+ (if (or (eq major-mode 'rmail-mode)
+ (eq major-mode 'mail-mode))
+ (ethio-fidel-to-sera-mail)
+ (ethio-fidel-to-sera-marker arg)))
+
;;;###autoload
(defun ethio-fidel-to-sera-mail nil
"Convert FIDEL to SERA to read/write mail and news.
border)
(save-excursion
- ;; look for the header-body separator
- (goto-char (point-min))
- (if (search-forward
- (if (eq major-mode 'rmail-mode)
- "\n\n" (concat "\n" mail-header-separator "\n"))
- nil t)
- (setq border (point))
- (error "header separator not found"))
-
+ ;; follow RFC822 rules instead of looking for a fixed separator
+ (rfc822-goto-eoh)
+ (forward-line 1)
+ (setq border (point))
+
;; process body first not to change the border
;; note that the point is already at the border
(if (re-search-forward "\\ce" nil t)
(cond
;; in case of gemination
((eq (char-charset ch) 'composition)
- (setq ch (string-to-char (decompose-composite-char ch))
+ (setq ch (string-to-char (char-to-string ch))
composite t))
;; neither gemination nor fidel
((not (eq (char-charset ch) 'ethiopic))
- (error "Not a valid character.")))
+ (error "Not a valid character")))
;; set frequently referred character features
(setq ch (ethio-char-to-ethiocode ch)
(if (or (and (>= ch 344) (<= ch 380)) ;; mYa - `10000
(and (>= ch 448) (<= ch 452)) ;; \~X - \~A
(>= ch 458)) ;; private punctuations
- (error "Not a valid character."))
+ (error "Not a valid character"))
(setq
newch
(insert (ethio-ethiocode-to-char (- ucode 64560))))
(t
nil)))
-
+
;; gemination
(goto-char (point-min))
(while (re-search-forward "\\ce\e$(3%s\e(B" nil 0)
(insert (if ethio-use-colon-for-colon "\\~-: " "\\~`: ")
(if ethio-use-three-dot-question "\\~`| " "\\~`? ")))
-(add-hook 'find-file-hooks 'ethio-find-file)
-(add-hook 'write-file-hooks 'ethio-write-file)
-(add-hook 'after-save-hook 'ethio-find-file)
+;;
+;; Ethiopic word separator vs. ASCII space
+;;
+
+(defvar ethio-prefer-ascii-space t)
+(make-variable-buffer-local 'ethio-prefer-ascii-space)
+
+(defun ethio-toggle-space nil
+ "Toggle ASCII space and Ethiopic separator for keyboard input."
+ (interactive)
+ (setq ethio-prefer-ascii-space
+ (not ethio-prefer-ascii-space))
+ (if (equal current-input-method "ethiopic")
+ (setq current-input-method-title (quail-title)))
+ (force-mode-line-update))
+
+(defun ethio-insert-space (arg)
+ "Insert ASCII spaces or Ethiopic word separators depending on context.
+
+If the current word separator (indicated in mode-line) is the ASCII space,
+insert an ASCII space. With ARG, insert that many ASCII spaces.
+
+If the current word separator is the colon-like Ethiopic word
+separator and the point is preceded by `an Ethiopic punctuation mark
+followed by zero or more ASCII spaces', then insert also an ASCII
+space. With ARG, insert that many ASCII spaces.
+
+Otherwise, insert a colon-like Ethiopic word separator. With ARG, insert that
+many Ethiopic word separators."
+
+ (interactive "*p")
+ (cond
+ (ethio-prefer-ascii-space
+ (insert-char 32 arg))
+ ((save-excursion
+ (skip-chars-backward " ")
+ (memq (preceding-char)
+ '(?\e$(3$h\e(B ?\e$(3$i\e(B ?\e$(3$j\e(B ?\e$(3$k\e(B ?\e$(3$l\e(B ?\e$(3$m\e(B ?\e$(3$n\e(B ?\e$(3$o\e(B ?\e$(3%t\e(B ?\e$(3%u\e(B ?\e$(3%v\e(B ?\e$(3%w\e(B ?\e$(3%x\e(B)))
+ (insert-char 32 arg))
+ (t
+ (insert-char ?\e$(3$h\e(B arg))))
+
+(defun ethio-insert-ethio-space (arg)
+ "Insert the Ethiopic word delimiter (the colon-like character).
+With ARG, insert that many delimiters."
+ (interactive "*p")
+ (insert-char ?\e$(3$h\e(B arg))
+
+;;
+;; Ethiopic punctuation vs. ASCII punctuation
+;;
+
+(defvar ethio-prefer-ascii-punctuation nil)
+(make-variable-buffer-local 'ethio-prefer-ascii-punctuation)
+
+(defun ethio-toggle-punctuation nil
+ "Toggle Ethiopic punctuations and ASCII punctuations for keyboard input."
+ (interactive)
+ (setq ethio-prefer-ascii-punctuation
+ (not ethio-prefer-ascii-punctuation))
+ (let* ((keys '("." ".." "..." "," ",," ";" ";;" ":" "::" ":::" "*" "**"))
+ (puncs
+ (if ethio-prefer-ascii-punctuation
+ '(?. [".."] ["..."] ?, [",,"] ?\; [";;"] ?: ["::"] [":::"] ?* ["**"])
+ '(?\e$(3$i\e(B ?\e$(3%u\e(B ?. ?\e$(3$j\e(B ?, ?\e$(3$k\e(B ?\; ?\e$(3$h\e(B ?\e$(3$i\e(B ?: ?* ?\e$(3$o\e(B))))
+ (while keys
+ (quail-defrule (car keys) (car puncs) "ethiopic")
+ (setq keys (cdr keys)
+ puncs (cdr puncs)))
+ (if (equal current-input-method "ethiopic")
+ (setq current-input-method-title (quail-title)))
+ (force-mode-line-update)))
+
+;;
+;; Gemination
+;;
+
+(defun ethio-gemination nil
+ "Compose the character before the point with the Ethiopic gemination mark.
+If the character is already composed, decompose it and remove the gemination
+mark."
+ (interactive "*")
+ (cond
+ ((eq (char-charset (preceding-char)) 'ethiopic)
+ (insert "\e$(3%s\e(B")
+ (compose-region
+ (save-excursion (backward-char 2) (point))
+ (point))
+ (forward-char 1))
+ ((eq (char-charset (preceding-char)) 'leading-code-composition)
+ (decompose-region
+ (save-excursion (backward-char 1) (point))
+ (point))
+ (delete-backward-char 1))
+ (t
+ (error ""))))
;;
(provide 'ethio-util)
+;;; arch-tag: c8feb3d6-39bf-4b0a-b6ef-26f03fbc8140
;;; ethio-util.el ends here
HCoop / bpt / emacs.git / blobdiff