home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / hebrew / hebrew.el < prev    next >
Encoding:
Text File  |  1992-08-22  |  7.0 KB  |  218 lines
  1. ;;;
  2. ;;; hebrew.el -- Hebrew editing mode.
  3. ;;; For more information, see documentation of `hebrew-mode'.
  4. ;;;
  5. ;;; $Id: hebrew.el,v 1.4 1992/08/22 22:29:57 yossi Exp $
  6. ;;; Copyright (c) Joseph Friedman, April 1990
  7. ;;; E-mail: yossi@DEShaw.COM
  8. ;;;
  9. ;;; LCD Archive Entry:
  10. ;;; hebrew|Joseph Friedman|yossi@DEShaw.COM|
  11. ;;; Support for editing Hebrew files in Emacs.|
  12. ;;; 92-08-22|$Revision: 1.4 $|~/misc/hebrew.tar.Z|
  13.  
  14.  
  15. (defvar running-epoch nil "*Non-nil means Epoch is running.")
  16.  
  17. (defvar hebrew-mode-hook () "*Called when entering hebrew-mode")
  18.  
  19. (defvar hebrew-mode nil "*Non nil when Hebrew mode is turned on.")
  20. (make-variable-buffer-local 'hebrew-mode)
  21.  
  22. (or (assoc 'hebrew-mode minor-mode-alist)
  23.     (setq minor-mode-alist
  24.       (cons '(hebrew-mode " Hebrew") minor-mode-alist)))
  25.  
  26. (defun hebrew-mode ()
  27. "\
  28. Toggles hebrew-mode on/off.  Hebrew-mode is a minor mode which allows
  29. reversing the editor display and changing the keyboard in order to
  30. enter and edit text in a semitic language, such as Hebrew.
  31.  
  32. By default, hebrew-mode stays in \"normal\" state.  The \"reversed\"
  33. state is activated with \"\\[hebrew-toggle-reversed]\".  (In Epoch, this
  34. is also bound to \"F3\".)  In the \"reversed\" state, hebrew-mode emulates
  35. a Hebrew keyboard both during direct insertion and during searches.
  36.  
  37. Hebrew-mode calls hebrew-mode-hook upon entering."
  38.  
  39.   (interactive)
  40.   (if (null hebrew-mode)
  41.       (let (char)
  42.  
  43.     ; signal hebrew minor mode in the mode-line
  44.     (setq hebrew-mode t)
  45.  
  46.     ; activate the hebrew insertion function
  47.     (setq char ? )
  48.     (local-set-key " " 'hebrew-insert-space) ; SPC is a special case,
  49.     (setq char (1+ char))              ;  see below.
  50.     (while (<= char ?~)
  51.       (let ((s (format "%c" char)))
  52.         (if (eq (key-binding s) 'self-insert-command)
  53.         (local-set-key s 'hebrew-insert)))
  54.       (setq char (1+ char)))
  55.     ; for showmatch:
  56.     (local-unset-key "{")
  57.     (local-unset-key "[")
  58.     (local-unset-key "(")
  59.     (local-unset-key ")")
  60.     (local-unset-key "]")
  61.     (local-unset-key "}")
  62.  
  63.     ; display-literal, display-reversed
  64.     (setq display-literal t)
  65.     (local-set-key "\C-cR" 'hebrew-toggle-reversed)
  66.     (local-set-key "\e[13~" 'hebrew-toggle-reversed) ; F3
  67.  
  68.     ; syntax table stuff
  69.     (setq char ?\340)    ; aleph
  70.     (while (<= char ?\372)    ; taf
  71.       (modify-syntax-entry char "w")
  72.       (setq char (1+ char)))
  73.  
  74.     ; search stuff
  75.     (local-set-key "\C-s" 'hebrew-ctrl-s)
  76.     (local-set-key "\C-r" 'hebrew-ctrl-r)
  77.  
  78.     ; hooks
  79.     (run-hooks 'hebrew-mode-hook))
  80.  
  81.     (let (char)
  82.  
  83.       ; turn off hebrew minor mode in the mode-line
  84.       (setq hebrew-mode nil)
  85.  
  86.       ; deactivate the hebrew insertion function
  87.       (setq char ? )
  88.       (while (<= char ?~)
  89.     (let ((s (format "%c" char)))
  90.       (if (eq (key-binding s) 'hebrew-insert)
  91.           (local-unset-key s)))
  92.     (setq char (1+ char)))
  93.  
  94.       ; deactivate display-literal and display-reversed
  95.       (setq display-literal nil)
  96.       (local-unset-key "\C-cR")
  97.       (local-unset-key "\e[13~") ; F3
  98.  
  99.       ; search stuff
  100.       (local-unset-key "\C-s")
  101.       (local-unset-key "\C-r")
  102.  
  103.       ; restore syntax-table
  104.       (setq char ?\340)        ; aleph
  105.       (while (<= char ?\372)    ; taf
  106.     (modify-syntax-entry char " ")
  107.     (setq char (1+ char))))))
  108.  
  109. (if running-epoch
  110.     (epoch::rebind-key "F3" 0 "\C-cR"))
  111. (defun hebrew-toggle-reversed ()
  112.   "Toggle whether or not the display is laterally reversed."
  113.   (interactive)
  114.   (setq display-reversed (null display-reversed))
  115.   (if running-epoch
  116.       (epoch::redisplay-screen)
  117.     (x-smart-redisplay)))
  118.  
  119. (defun hebrew-insert (&optional arg)
  120.   "\
  121. If display-reversed is nil, behaves like self-insert-command.
  122. If display-reversed is t, simulates a Hebrew typewriter keyboard."
  123.  
  124.   (interactive "p")
  125.   (or (numberp arg) (setq arg 1))
  126.   (let ((char (if display-reversed
  127.           (aref hebrew-keyboard last-command-char)
  128.         (format "%c" last-command-char))))
  129.     (while (> arg 0)
  130.       (insert char)
  131.       (setq arg (1- arg)))))
  132.  
  133. ; *** KLUDGE ALERT ***
  134. ; When last-command-char is SPC and display-reversed is t,
  135. ; self-insert-command does not update the display after insertion, and I
  136. ; couldn't figure out why this is so.  To get around this bug, I call
  137. ; self-insert-command from a user routine, and this takes care of updating
  138. ; the display.
  139. (defun hebrew-insert-space (&optional arg)
  140. "This is a kludge to get around an insertion bug.  Bind to SPC."
  141.   (interactive)
  142.   (cond
  143.    ((null arg) (self-insert-command 1))
  144.    ((numberp arg) (self-insert-command arg))
  145.    (t (ding))))
  146.  
  147. (defun hebrew-ctrl-s () "The Hebrew-mode version of \C-s"
  148.   (interactive)
  149.   (let ((old-read-char (symbol-function 'read-char))
  150.     (old-text-char-description (symbol-function 'text-char-description))
  151.     (search-exit-option nil)
  152.     (res nil)
  153.     ERR)
  154.     (fset 'read-char (symbol-function 'hebrew-read-char))
  155.     (fset 'text-char-description
  156.       (symbol-function 'hebrew-text-char-description))
  157.     (condition-case ERR
  158.       (setq res (funcall (global-key-binding "\C-s")))
  159.       (error  nil)
  160.       (quit nil))
  161.     (fset 'read-char old-read-char)
  162.     (fset 'text-char-description old-text-char-description)
  163.     res))
  164.  
  165. (defun hebrew-ctrl-r () "The Hebrew-mode version of \C-r"
  166.   (interactive)
  167.   (let ((old-read-char (symbol-function 'read-char))
  168.     (old-text-char-description (symbol-function 'text-char-description))
  169.     (search-exit-option nil)
  170.     (res nil)
  171.     ERR)
  172.     (fset 'read-char (symbol-function 'hebrew-read-char))
  173.     (fset 'text-char-description
  174.       (symbol-function 'hebrew-text-char-description))
  175.     (condition-case ERR
  176.       (setq res (funcall (global-key-binding "\C-r")))
  177.       (error nil)
  178.       (quit nil))
  179.     (fset 'read-char old-read-char)
  180.     (fset 'text-char-description old-text-char-description)
  181.     res))
  182.  
  183. (defun hebrew-read-char ()
  184.   "The hebrew-mode version of read-char."
  185.   (let ((char (funcall old-read-char)))
  186.     (if (and display-reversed (>= char ? ) (<= char ?~))
  187.     (string-to-char (aref hebrew-keyboard char))
  188.       char)))
  189.  
  190. (defun hebrew-text-char-description (char)
  191.   "The hebrew-mode version of text-char-description."
  192.   (if display-reversed
  193.       (char-to-string char)
  194.     (funcall old-text-char-description char)))
  195.  
  196. ; for the search function to work, we can't use a byte-compiled version of
  197. ; isearch.el, so load it back:
  198. (load-library "isearch.el")
  199.  
  200. (setq hebrew-keyboard
  201.       [
  202.        ""     ""     ""     ""     ""     ""     ""     ""
  203.        ""     ""     ""     ""     ""     ""     ""     ""
  204.        ""     ""     ""     ""     ""     ""     ""     ""
  205.        ""     ""     ""     ""     ""     ""     ""     ""
  206.        " "    "!"    "\""   "#"    "$"    "%"    "&"    "'"
  207.        "("    ")"    "*"    "+"    "\372" "-"    "\365" "."
  208.        "0"    "1"    "2"    "3"    "4"    "5"    "6"    "7"
  209.        "8"    "9"    ":"    "\363" "<"    "="    ">"    "?"
  210.        "@"    "A"    "B"    "C"    "D"    "E"    "F"    "G"
  211.        "H"    "I"    "J"    "K"    "L"    "M"    "N"    "O"
  212.        "P"    "Q"    "R"    "S"    "T"    "U"    "V"    "W"
  213.        "X"    "Y"    "Z"    "["    "\\"   "]"    "^"    "_"
  214.        ";"    "\371" "\360" "\341" "\342" "\367" "\353" "\362"
  215.        "\351" "\357" "\347" "\354" "\352" "\366" "\356" "\355"
  216.        "\364" "\\"   "\370" "\343" "\340" "\345" "\344" ","
  217.        "\361" "\350" "\346" "{"    "|"    "}"    "~"    ""])
  218.