-;;; 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")
- (setq-default default-input-method "ethiopic")
-
- ;;
- ;; key bindings
- ;;
- (define-key global-map [f4] 'ethio-sera-to-fidel-buffer)
- (define-key global-map [S-f4] 'ethio-sera-to-fidel-region)
- (define-key global-map [C-f4] 'ethio-sera-to-fidel-marker)
- (define-key global-map [f5] 'ethio-fidel-to-sera-buffer)
- (define-key global-map [S-f5] 'ethio-fidel-to-sera-region)
- (define-key global-map [C-f5] 'ethio-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] 'ethio-sera-to-fidel-mail)
- (define-key rmail-mode-map [C-f5] 'ethio-fidel-to-sera-mail)))
-
- (add-hook
- 'mail-mode-hook
- '(lambda ()
- (define-key mail-mode-map [C-f4] 'ethio-sera-to-fidel-mail)
- (define-key mail-mode-map [C-f5] 'ethio-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-hooks 'ethio-find-file)
+ (add-hook 'write-file-hooks '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-hooks 'ethio-find-file)
+ (remove-hook 'write-file-hooks 'ethio-write-file)
+ (remove-hook 'after-save-hook 'ethio-find-file))
;;
;; ETHIOPIC UTILITY FUNCTIONS
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")
;; 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")
;; `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)
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 (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 characater 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)
HCoop / bpt / emacs.git / blobdiff