;; >>.WARNING.<<  This file contains (non-ascii) chars with the high-order
;; bit set.  Most mailers will choke on it.


;; file "hebrew.el" ver 0.8
;; last modified Jan. 2 1992

;; Hebrew support for Emacs. 
;; Copyright (c) 1990-92 by Joel M. Hoffman.
;;
;;  -->  This project is dedicated to Orna Okouneff, who, against my
;;       will, insisted on teaching me Emacs.



;; THIS IS A basic support package for editing Hebrew with Emacs.  It
;; assumes the keyboard layout of the VT* series for the purposes of
;; mapping English keystrokes to their Hebrew equivilents.  It also
;; assumes the output hardware is compatible with the VT* series used
;; in Israel, in that the high-order bit is assumed to indicate
;; Hebrew; I believe this is incompatible with the DOS standard for
;; hebrew.  The package does not use the right-to-left facilites of
;; the VT* terminals, so any terminal that converts characters >128
;; decimal to Hebrew is supported.  An EGA Hebrew font compatible with
;; this package is available for the IBM.

;; To work properly, the following files in Emacs 18.xx must be
;; modified:
;;
;;     xdisp.c
;;     indent.c

;; You can use this package with the unmodified files, but the Hebrew
;; letters will appear encoded as \xxx.  I understand that ver.  19.00
;; will have an option to support 8-bit-clean operation, and so will
;; support this package.  Demacs supports 8-bit-clean operation via
;; the toggle-pass8 command.

;; Currently, four major commands are supplied: C-Xh and C-Xe, which
;; switch back and forth between Hebrew and English keyboards, and M-h
;; and M-e, which switch back and forth between Hebrew and English
;; "modes," which are not modes in the Emacs sense of the word, but
;; rather determine if the margin is to be the left or right side of
;; the screen, among other direction-specific paramaters.

;; Emacs uses the eighth bit to indicate Hebrew letters.  Most text
;; formatters (TeX, *roff, etc.) use 7-bit character codes.
;; Additionally, these formatters usually require Hebrew to appear in
;; time-order.  A pre-processor must be run before the formatter to
;; effect these changes.



;; I don't really know lisp or Emacs, or what I'm doing; comments and
;; suggestions are welcome:
;;     joel@wam.umd.edu          <-- Internet
;;     72700,402                 <-- Compuserve
;;     72700.402@compuserve.com  <-- Compuserve from Internet

;; This package is not finished.  The bugs herein defy enumeration.

(defun hebrew-grab-keys ()
  "take control of the keyboard and auto-fill."
  (interactive)
  (define-key global-map " " 'let-space)
  (define-key global-map "a" 'let-a)
  (define-key global-map "b" 'let-b)
  (define-key global-map "c" 'let-c)
  (define-key global-map "d" 'let-d)
  (define-key global-map "e" 'let-e)
  (define-key global-map "f" 'let-f)
  (define-key global-map "g" 'let-g)
  (define-key global-map "h" 'let-h)
  (define-key global-map "i" 'let-i)
  (define-key global-map "j" 'let-j)
  (define-key global-map "k" 'let-k)
  (define-key global-map "l" 'let-l)
  (define-key global-map "m" 'let-m)
  (define-key global-map "n" 'let-n)
  (define-key global-map "o" 'let-o)
  (define-key global-map "p" 'let-p)
  (define-key global-map "q" 'let-q)
  (define-key global-map "r" 'let-r)
  (define-key global-map "s" 'let-s)
  (define-key global-map "t" 'let-t)
  (define-key global-map "u" 'let-u)
  (define-key global-map "v" 'let-v)
  (define-key global-map "w" 'let-w)
  (define-key global-map "x" 'let-x)
  (define-key global-map "y" 'let-y)
  (define-key global-map "z" 'let-z)
  (define-key global-map "," 'let-comma)
  (define-key global-map ";" 'let-semi)
  (define-key global-map ":" 'let-colon)
  (define-key global-map "." 'let-period)
  (define-key global-map "/" 'let-slash)
  (define-key global-map "'" 'let-aigu)
  (define-key global-map "`" 'let-grave)
  (define-key global-map "\\" 'let-bslash)
  (define-key global-map "-" 'let-hyphen)
  (define-key global-map "!" 'let-xmark)
  (define-key global-map "@" 'let-at)
  (define-key global-map "#" 'let-pound)
  (define-key global-map "$" 'let-dollar)
  (define-key global-map "%" 'let-percent)
  (define-key global-map "^" 'let-carrat)
  (define-key global-map "&" 'let-ampersand)
  (define-key global-map "*" 'let-asterisk)
  (define-key global-map "(" 'let-lparend)
  (define-key global-map ")" 'let-rparend)
  (define-key global-map "{" 'let-lcbrace)
  (define-key global-map "}" 'let-rcbrace)
  (define-key global-map "[" 'let-lbrace)
  (define-key global-map "]" 'let-rbrace)
  (define-key global-map ">" 'let-gt)
  (define-key global-map "~" 'let-tilde)
  (define-key global-map "+" 'let-plus)
  (define-key global-map "+" 'let-equal)
  (define-key global-map "<" 'let-lt)
  (define-key global-map "?" 'let-question))


(defun let-plus ()
  "comment"
  (interactive)
  (bilingual-insert-char "+" "+"))

(defun let-equal ()
  "comment"
  (interactive)
  (bilingual-insert-char "=" "="))


(defun let-tilde ()
  "comment"
  (interactive)
  (bilingual-insert-char "~" "~"))

(defun let-gt ()
  "comment"
  (interactive)
  (bilingual-insert-char ">" ">"))

(defun let-lt ()
  "comment"
  (interactive)
  (bilingual-insert-char "<" "<"))

(defun let-question ()
  "comment"
  (interactive)
  (bilingual-insert-char "?" "?"))

(defun let-hyphen ()
  "comment"
  (interactive)
  (bilingual-insert-char "-" "-"))

(defun let-xmark ()
  "comment"
  (interactive)
  (bilingual-insert-char "!" "!"))

(defun let-at ()
  "comment"
  (interactive)
  (bilingual-insert-char "@" "@"))

(defun let-pound ()
  "comment"
  (interactive)
  (bilingual-insert-char "#" "#"))

(defun let-dollar ()
  "comment"
  (interactive)
  (bilingual-insert-char "$" "$"))

(defun let-percent ()
  "comment"
  (interactive)
  (bilingual-insert-char "%" "%"))

(defun let-carrat ()
  "comment"
  (interactive)
  (bilingual-insert-char "^" "^"))

(defun let-ampersand ()
  "comment"
  (interactive)
  (bilingual-insert-char "&" "&"))

(defun let-asterisk ()
  "comment"
  (interactive)
  (bilingual-insert-char "*" "*"))

(defun let-lparend ()
  "comment"
  (interactive)
  (bilingual-insert-char "(" "("))

(defun let-rparend ()
  "comment"
  (interactive)
  (bilingual-insert-char ")" ")"))

(defun let-lcbrace ()
  "comment"
  (interactive)
  (bilingual-insert-char "{" "{"))

(defun let-rcbrace ()
  "comment"
  (interactive)
  (bilingual-insert-char "}" "}"))

(defun let-lbrace ()
  "comment"
  (interactive)
  (bilingual-insert-char "[" "["))

(defun let-rbrace ()
  "comment"
  (interactive)
  (bilingual-insert-char "]" "]"))

(defun let-colon ()
  "comment"
  (interactive)
  (bilingual-insert-char ":" ":"))


(defun let-a ()
  "comment"
  (interactive)
  (bilingual-insert-char"ש" "a"))
(defun let-b ()
  "comment"
  (interactive)
  (bilingual-insert-char "נ" "b"))
(defun let-c ()
  "comment"
  (interactive)
  (bilingual-insert-char "ב" "c"))
(defun let-d ()
  "comment"
  (interactive)
  (bilingual-insert-char "ג" "d"))
(defun let-e ()
  "comment"
  (interactive)
  (bilingual-insert-char "ק" "e"))
(defun let-f ()
  "comment"
  (interactive)
  (bilingual-insert-char "כ" "f"))
(defun let-g ()
  "comment"
  (interactive)
  (bilingual-insert-char "ע" "g"))
(defun let-h ()
  "comment"
  (interactive)
  (bilingual-insert-char "י" "h"))
(defun let-i ()
  "comment"
  (interactive)
  (bilingual-insert-char "ן" "i"))
(defun let-j ()
  "comment"
  (interactive)
  (bilingual-insert-char "ח" "j"))
(defun let-k ()
  "comment"
  (interactive)
  (bilingual-insert-char "ל" "k"))
(defun let-l ()
  "comment"
  (interactive)
  (bilingual-insert-char "ך" "l"))
(defun let-m ()
  "comment"
  (interactive)
  (bilingual-insert-char "צ" "m"))
(defun let-n ()
  "comment"
  (interactive)
  (bilingual-insert-char "מ" "n"))
(defun let-o ()
  "comment"
  (interactive)
  (bilingual-insert-char "ם" "o"))
(defun let-p ()
  "comment"
  (interactive)
  (bilingual-insert-char "פ" "p"))
(defun let-q ()
  "comment"
  (interactive)
  (bilingual-insert-char "\\" "q"))
(defun let-r ()
  "comment"
  (interactive)
  (bilingual-insert-char "ר" "r"))
(defun let-s ()
  "comment"
  (interactive)
  (bilingual-insert-char "ד" "s"))
(defun let-t ()
  "comment"
  (interactive)
  (bilingual-insert-char "א" "t"))
(defun let-u ()
  "comment"
  (interactive)
  (bilingual-insert-char "ו" "u"))
(defun let-v ()
  "comment"
  (interactive)
  (bilingual-insert-char "ה" "v"))
(defun let-w ()
  "comment"
  (interactive)
  (bilingual-insert-char "'" "w"))
(defun let-x ()
  "comment"
  (interactive)
  (bilingual-insert-char "ס" "x"))
(defun let-y ()
  "comment"
  (interactive)
  (bilingual-insert-char "ט" "y"))
(defun let-z ()
  "comment"
  (interactive)
  (bilingual-insert-char "ז" "z"))

(defun let-space ()
  "comment"
  (interactive)
  (bilingual-insert-char " " " "))   ;;English auto-fill will be
				     ;;automatic.  Hebrew auto-fill is
				     ;;still a problem.
(defun let-comma ()
  "comment"
  (interactive)
  (bilingual-insert-char "ת" ","))

(defun let-semi ()
  "comment"
  (interactive)
  (bilingual-insert-char "ף" ";"))

(defun let-period ()
  "comment"
  (interactive)
  (bilingual-insert-char "ץ" "."))

(defun let-slash ()
  "comment"
  (interactive)
  (bilingual-insert-char "." "/"))

(defun let-aigu ()
  "comment"
  (interactive)
  (bilingual-insert-char "," "'"))

(defun let-grave ()
  "comment"
  (interactive)
  (bilingual-insert-char "/" "`"))

(defun let-bslash ()
  "comment"
  (interactive)
  (bilingual-insert-char ";" "\\"))


(defun hebrew-set-up ()
  "Comments will be here"
  (interactive)


;; Following are the ANSI-like codes to control the tty.  Currently,
;; they are unused.
;; Changes may be necessary.  Ideally, the code should consult a data-
;; base, but we don't live in an ideal world.

  (make-local-variable 'left-to-right-code)
  (setq left-to-right-code "[?34l")
  (make-local-variable 'right-to-left-code)
  (setq right-to-left-code "[?34h")
  (make-local-variable 'hebrew-keyboard-code)
  (setq hebrew-keyboard-code "[?35h")
  (make-local-variable 'english-keyboard-code)
  (setq english-keyboard-code "[?35l")
  (make-local-variable 'keyboard-off-code)
  (setq keyboard-off-code "")
  (make-local-variable 'keyboard-on-code)
  (setq keyboard-on-code "")
  (set-variable 'hebrew-keyboard ())
  (make-variable-buffer-local 'hebrew-keyboard)
  (set-variable 'hebrew-mode ())
  (make-variable-buffer-local 'hebrew-mode)
  (make-local-variable 'hebrew-mode)
  (hebrew-grab-keys)
;  (global-set-key "\C-r"     'search-backward)
;  (global-set-key "\C-s"     'search-forward)  ;;Good luck using this one!
;  (define-key esc-map "s"    'search-forward)

;; Here are some constants:
  (set-variable 'hebrew-right-margin 77) ;; Can't use 80, so we may as
                                         ;; well leave some extra room.

;;(Fine, so it was only ONE constant....)


;; Now we take control over some of the major editing keys.  The
;; backspace has to delete the correct char. in Hebrew mode; return has
;; know what to do with Hebrew, etc.  I've left the arrow keys, but ^B,
;; and ^F still mean "backward" and "forward."  With ^A/^E I've got a
;; problem, because ^A (to me) is "all the way left" but ^E is "end,"
;; both of which would move to the left in Hebrew mode.  Also
;; "end-of-line" in Hebrew-mode has to ignore the spaces used to
;; right-align the line.  It would be silly for ^A to do that, so ^A is
;; always "beginning-of-line," and ^E always "end-of-line."  I've also
;; left some of the more obscure commands/keys, ("obscure" being defined
;; as things I don't use), because I'm too lazy to change them.  ("Left
;; as an excercise to the reader....")

;  (define-key global-map "\C-h" 'bilingual-backspace)
  (define-key global-map "\177" 'bilingual-backspace)
                              ;; I'd like to use \177, but Emacs ignores
                              ;; me when I try.  (Don't know why.)
			      ;; But Real Emacs-Users don't need help
			      ;; (^h) anyway....
  
  (define-key global-map "\C-i" 'bilingual-tab)
  (define-key global-map "\C-k" 'bilingual-kill-line)
  (define-key global-map "\C-m" 'bilingual-return)
  (define-key esc-map "d" 'bilingual-kill-word)
  (define-key global-map "\C-a" 'bilingual-beginning-of-line)
  (define-key global-map "\C-e" 'bilingual-end-of-line)
  (define-key global-map "\C-f" 'bilingual-forward-char)
  (define-key global-map "\C-b" 'bilingual-backward-char)
  (define-key global-map "\C-d" 'bilingual-delete-char)


;; Be user friendly:
  (message 
"Use C-Xh for Hebrew, M-h for Hebrew mode.  .תירבע דומל M-h ,תירבעל C-Xh שקה")
  (setq hebrew-keyboard ()) ;;start with English keyboard
  (setq hebrew-mode ())     ;;and in English mode
  )


(defun bilingual-return ()
  "In English mode, just return.  In Hebrew mode, do the right thing."
  (interactive)
  (if (not hebrew-keyboard)
      (newline)
    (left-align-line)
    (let ((here (point)))
      (beginning-of-line)
      (copy-to-register 'a (point) here t)
      (if (eq hebrew-mode t)
	  (right-align-line)
	(left-align-line))
      (end-of-line)
      (newline)
      (insert-register 'a)
      (if (eq hebrew-mode t)
	  (right-align-line)
	(left-align-line))
      (end-of-line))))

(defun bilingual-beginning-of-line ()
  "Move to the beginning of the current line, remembering that ``beginning
of line'' is language-dependent"
  (interactive)
  (if (not hebrew-mode)
      (beginning-of-line)
    (end-of-line)
    (backward-char 1)))
      


(defun bilingual-end-of-line ()
  "Move to the end of the current line, remembering that ``end of
line'' is language-dependent"
  (interactive)
  (if (not hebrew-mode)
      (end-of-line)
    (beginning-of-line)
    (while (looking-at "[ \t]")
      (forward-char 1))
    (if (not (bolp))
	(backward-char 1))))


(defun bilingual-forward-char (arg)
  "forward-char that knows about Hebrew vs. English"
  (interactive "p")
  (if (not hebrew-keyboard)
      (forward-char arg)
    (backward-char arg)))

(defun bilingual-backward-char (arg)
  "backward-char that knows about Hebrew vs. English"
  (interactive "p")
  (if (not hebrew-keyboard)
      (backward-char arg)
    (forward-char arg)))

(defun bilingual-delete-char (arg)
  "delete-char that knows about Hebrew vs. English"
  (interactive "p")
  (if (not hebrew-keyboard)
      (delete-char arg)
    (delete-char 1)
    (backward-char 1)
    (if (eq hebrew-mode t)
	(right-align-line))))
    
  

(defun bilingual-kill-word (arg)
  "Kill the rest of the current word, remembering that ``the rest''
is language dependent"
  (interactive "p")
  (if (not hebrew-keyboard)
      (kill-word arg)
    (backward-kill-word arg))) ;;nothing to it! (but this doesn't work)

(defun bilingual-kill-line ()
  "Kill the rest of the line, remembering that ``the rest'' is language
dependant"
  (interactive)
  (if (not hebrew-mode)
      (kill-line)
;;We'd like to use "kill-line -1" here, but it doesn't work right.
    (if (not (eolp)) 
	(forward-char 1))
    (kill-region (point) ;; But let's copy as much of the code in
			 ;; simple.el as possible
	  (progn
	    (if (bobp)
		(signal 'beginning-of-buffer nil)
	      (beginning-of-line)
	      (if (looking-at "$")
		(progn
		  (forward-line -1)
		  (end-of-line))))
	    (point)))
    (right-align-line)))


(defun bilingual-tab ()
  "right-align-line"
  (interactive)
  (if (eq hebrew-keyboard t)
      (right-align-line)
    (left-align-line)))

(defun bilingual-backspace ()  ;;This is mapped to ^h
  "Backspace that knows that hebrew goes right-to-left."
  (interactive)
  (if (not hebrew-keyboard)
      (delete-backward-char 1)
    (if (not (eolp))
	(forward-char 1))
    (delete-backward-char -1)
    (if (not (bolp))
	(backward-char 1)))
  (if (eq hebrew-mode t)
      (right-align-line)))


(defun goto-rl-mode ()
  "Go to right-to-left mode (tty)"
  (interactive)
  (send-string-to-terminal right-to-left-code)
  (redraw-display))

(defun goto-lr-mode ()
  "Go to left-to-right mode (tty)"
  (interactive)
  (send-string-to-terminal left-to-right-code)
  (redraw-display))

(defun goto-tty-hebrew-mode ()
  "Go to Hebrew mode (tty)"
  (interactive)
  (send-string-to-terminal hebrew-keyboard-code))

(defun goto-tty-english-mode ()
  "Go to English mode (tty)"
  (interactive)
  (send-string-to-terminal english-keyboard-code))

(defun goto-hebrew-keyboard ()
  "Go to Hebrew keyboard (as far as Emacs is concerned)"
  (interactive)
  (setq hebrew-keyboard t)
  (message "תירבע תדלקמ (Hebrew keyboard) "))

(defun goto-english-keyboard ()
  "Go to English keyboard (as far as Emacs is concerned)"
  (interactive)
  (setq hebrew-keyboard ())
  (message "English keyboard (תילגנא תדלקמ)"))

(defun goto-hebrew-mode ()
  "Go to Hebrew mode (not a ``mode'' in the Emacs sense of the word, though)"
  (interactive)
  (setq hebrew-mode t)
  (setq hebrew-keyboard t)
  (message "תירבע דומ (Hebrew mode)"))

(defun goto-english-mode ()
  "Go to English mode (not a real ``mode'')"
  (interactive)
  (setq hebrew-mode ())
  (setq hebrew-keyboard ())
  (message "English mode (תילגנא דומ)"))
  


(defun hebrew ()
  "Basic definitions and key bindings"
  (interactive)
;  (global-set-key "\C-xx"    'call-last-kbd-macro)
  (global-set-key "\C-xz"    'goto-rl-mode)
  (global-set-key "\C-xq"    'goto-lr-mode)
  (global-set-key "\C-xh"    'goto-hebrew-keyboard)
  (global-set-key "\C-xe"    'goto-english-keyboard)
  (define-key esc-map "h"    'goto-hebrew-mode)
  (define-key esc-map "e"    'goto-english-mode)
  (global-set-key "\C-x\C-h" 'back-to-hebrew-keyboard)
  (global-set-key "\C-x\C-e" 'back-to-english-keyboard)
  (hebrew-set-up)) 

  

(defun bilingual-insert-char (heb eng)
  "Insert either the Hebrew or English code for the key pressed"
  (interactive "P")
  (if (not hebrew-keyboard)
    (progn
      (self-insert-command (prefix-numeric-value eng))
      (if (eq hebrew-mode t)
	  (right-align-line)))
    (if (eolp)
	(insert " ")
      (forward-char 1))
    (insert heb)
    (backward-char 2)
    (if (eq hebrew-mode t)
	(right-align-line))))

(defun right-align-line ()
  "Add spaces at the beginning of the current line so that the end is
aligned with the fill column."
  (interactive)
  (progn ;;save-excursion doesn't always work.  I wonder why not.
    (let ((col (current-column)))
      (end-of-line)
      (let ((ecol (current-column)) (ecol2 (current-column)))
	(beginning-of-line)
	(while (and (looking-at "[ \t]") (> ecol hebrew-right-margin))
	  (delete-char 1)
	  (setq ecol (- ecol 1)))
	(insert-char ?\  (- hebrew-right-margin ecol ))
;;if save-excursion worked above, we could omit this:
	(beginning-of-line) ;; 
	(forward-char (- hebrew-right-margin (- ecol2 col)))))))

(defun left-align-line ()
  "Delete leading white space so as to left-align the current line."
  (interactive)
  (let ((col (current-column)) (deleted 0))
    (beginning-of-line)
    (while (looking-at "[ \t]")
      (delete-char 1)
      (setq deleted (+ deleted 1)))
    (if (> (- col deleted) 0)
	(forward-char (- col deleted)))))


;; Now lets make some commands for skipping over newly inserted text
;; in the "other" language.  The idea is to make the inseration of Hebrew
;; words in an English document and vice versa as easy as possible.
;; I wonder what to do with punctuation here....

(defun back-to-english-keyboard ()
  "Go back to the English keyboard after inserting a Hebrew segment of text.
Skip over the Hebrew text."
  (interactive)
  (goto-english-keyboard) ;; that's the easy part.
  (if (looking-at " ")    ;; Assume the space was inserted when we..
      (delete-char 1))    ;; ..went into Hebrew mode.
  (if (not (eolp))        ;; Now move past the Hebrew
      (while (looking-at "[םןץךףתשרקצפעסנמלכיטחזוהדגבא]")
	(forward-char 1))))

(defun back-to-hebrew-keyboard ()
  "Go back to the Hebrew keyboard after inserting an English segment of
text.  Skip of the English text."
  (interactive)
  (goto-hebrew-keyboard)  ;; that's the easy part.
  (if (not (bolp))
      (backward-char 1))  ;; we're probably on a space or something.
  (if (not (bolp))        ;; Now move past the English
      (while (looking-at 
       "[abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ\$=<>\\()]")
	(backward-char 1)))) ;; I threw the dollar in --------^
                             ;; because (La)TeX uses it so often.

(defun fix-backspace ()
  "Make backspace key 'bilingual-backspace"
  (interactive)
  (global-set-key "\177" 'bilingual-backspace))


(global-set-key "\C-xz" 'fix-backspace)

;; This is the last line of "hebrew.el" לש הנורחאה הרושה תאז

;; to-do:
;; add quote-char
;; fix backspace over nl
;; fix delete at eolp