;VisHeb Emacs - version 0.1 
;--------------------------

;15/9/96 - ז"נשת הנשה שאר

;Emacs hebrew patch - designed to make a 'visual hebrew' emacs 
;similar to pico, qtext, etc and to enable easier authoring of 
;hebrew html pages (In the visual, 'Snunit' "standard") on Unix machines.
;my small contribution to the Unix community in Israel 

;Version 0.1 - Main features:
;Two major modes - English and Hebrew. In each one it is possible to enter
;strings in the 'opposite' language in push reverse mode 
;(Currently ^p activates push reverse, and ^h switches between Hebrew
;and English Modes)

;Hebrew mode implemented only as an insertion mode (not over-write)
;Return and backspace implemented so that they will work correctly
;in Hebrew mode (not yet in the push reverse modes) 

;Pushing words in the end of line to the next line if line is becoming
;too long (In Hebrew mode) - implemented only partially 

;Pressing TAB in Hebrew Mode is equal to pressing 'Enter' and then 
;writing <br> 

;Installation
;------------
;
;Simply save this file somewhere and add to your .emacs file the lines:

;Load hebrew visual support file
;(load-file "PATH TO visheb.el file")
;Enable display of upper ASCII chars 
;(standard-display-8bit 32 255)

;To run:
;emacs -fn some-hebrew-font &
;(Suitable fonts can be downloaded from:
;ftp://ftp.cc.huji.ac.il/pub/fonts/unix/ 
;Either the sun fonts packages or the heb10x20.snf, heb8x13.snf fonts will do)

;Tested On
;---------

;Emacs 19.* running on Linux, Solaris and SunOS

;Based on...
;-----------
;hebrew - 4-8-94 Z.B 
;A small contirbution of Ah. team to the war effort ...

;Author and Copyright
;---------------------
;Ofer Margo, omargo@www1.huji.ac.il 
;Copyrighted under the terms of GNU's General Public License 


;--------------------------------------------------------------------

(defvar z-heb-line-length 73
  "Length of line in Hebrew files"
)

(defvar z-hebrew-mode-on 'f
  "is hebrew on")

(defvar z-english-pushrv-mode-on 'f
  "is English push reverse mode on"
)

(defvar z-hebrew-pushrv-mode-on 'f
  "is Hebrew push Reverse mode on"
)

(defvar z-amount-pushed 0
  "Amount of English chars pushed while in HebEngP mode" 
)

(defvar line-from-pervious-time -1
  "Line in which we were last time that we had to push a word into next line"
)

(setq global-mode-string '("English"))
(force-mode-line-update)

;---------------------------------------------------------------
(defun current-line ()
  "Return the current buffer line at point.  The first line is 0." 
  (save-excursion
    (beginning-of-line)
    (count-lines (point-min) (point))))

;------------------------------------------------------------------
(defun z-toggle-hebrew-mode (arg)
  "Toggles hebrew on\n If there are 2 prefix will always toggle to English"
   (interactive "p")
   (if (= arg 2)
       (progn
	 (setq z-hebrew-mode-on 'f)
	 (setq global-mode-string '("")))
       (progn
	 (if (equal z-hebrew-mode-on 't)
	     (progn
	       (setq z-hebrew-mode-on 'f)
	       (setq global-mode-string '("English")))
	   (setq z-hebrew-mode-on 't)
	   (setq global-mode-string '("Hebrew"))
	   (setq line-from-previous-time -1)
	 )
      )
   )

   ;Force mode-line updates
   (force-mode-line-update)

)
;-----------------------------------------------------------
(defun z-toggle-engpush-mode (arg)
  "Toggles English push reverse mode on/off while in Hebrew mode and vice versa"
  (interactive "p")
  (if (equal z-hebrew-mode-on 't)
      (if (equal z-english-pushrv-mode-on 'f)
	  (progn
	    (setq z-english-pushrv-mode-on 't)
	    (setq global-mode-string '("HebEngP"))
	    )
	(progn
	  (setq z-english-pushrv-mode-on 'f)
	  (setq global-mode-string '("Hebrew"))
	  (backward-char (1+ z-amount-pushed))
	  (setq z-amount-pushed 0)
	  )
      )
      (if (equal z-hebrew-pushrv-mode-on 'f)
	  (progn
	    (setq z-hebrew-pushrv-mode-on 't)
	    (setq global-mode-string '("EngHebP"))
	  )
	  (progn
	    (setq z-hebrew-pushrv-mode-on 'f)
	    (setq global-mode-string '("English"))
	    (forward-char z-amount-pushed)
	    (setq z-amount-pushed 0)
	  )
      )
   )
   ;Force mode-line updates
   (force-mode-line-update)

)
;--------------------------------------------------------

(defun z-insert-char (chr)
  "Inserts a char into the buffer, considers overwrite"
  (interactive)
  (self-insert-command 1)
)

;------------------------------------------------------------

(defun z-check-matching-open (inserted-char)
  "If the char inserted is a closing parenth. jumps for a second to the open"
;(if (char-equal inserted-char ?\) )
;(blink-matching-open)
;)

)

;------------------------------------------------------------------

(defun z-insert-hebrew-character (heb-chr)
  "Inserts Hebrew Char"
  (interactive "P")
  (if (not overwrite-mode) ;lets start with the easier case
      (let ((cur-col (current-column)) (cur-point (point)) )
	
	(save-excursion
	  (beginning-of-line)
	  (if (not(= (following-char) ? ))
	      (if (= cur-col 0)
		  (move-word-to-next-line 't cur-point)
		  (move-word-to-next-line 'f cur-point)
	      )
	      ()
	  )
	  (delete-char 1)
	)
	(forward-char 1)
	(insert-char heb-chr 1)
	(backward-char 2)
      )
    ;now overwrite mode - -currently doesnt work 25/8/96  omargo 
    (insert-char heb-chr 1)
    (z-check-matching-open heb-chr)
    (delete-char 1)
    (backward-char 2)
   )
)

;------------------------------------------------------------------

(defun z-insert-push-eng-char (char)
  (interactive)
  (save-excursion
    (beginning-of-line)
    (delete-char 1) ; Remove a space 
  )
  (insert-char char 1)
  (setq z-amount-pushed (1+ z-amount-pushed))
)

;--------------------------------------------------------------------
(defun z-insert-push-heb-char (char)
  (interactive)
  (insert-char char 1)
  (backward-char 1)
  (setq z-amount-pushed (1+ z-amount-pushed))
)
;--------------------------------------------------------------------

;טסקטל ודלקוהש םיותה תא סינכמ

;just for avoid hebrew, type ESC-^X after last parenthesis of that procedure
(defun z-handle-input-char ()
  "תירבעה בצמב תובשחתה ילב ,רפבל ות סינכמ"
  (interactive)
  (insert-char last-command-char 1)
)

;טסקטל םתוא סינכמו תירבעל םיות םגרתמ
(defun z-handle-input-char ()
  "רפבה לש תירבעה בצמב בשחתמ ,רפבל ות סינכמ"
  (interactive)
   (if (equal z-hebrew-mode-on 't)
       (if (equal z-english-pushrv-mode-on 't)
	 (z-insert-push-eng-char last-command-char)
         (z-insert-hebrew-character (z-translate-to-hebrew last-command-char))
       )
       (if (equal z-hebrew-pushrv-mode-on 't)
	   (z-insert-push-heb-char (z-translate-to-hebrew last-command-char))
	   (z-insert-char last-command-char); Regular Eng mode 
       )
   )
  
)

;-----------------------------------------------------------

(defun z-handle-backspace()
  "תילגנא וא תירבע - תבתכנה הפשל םאתהב BACKSPACE עצבמ"
  (interactive)
  (if (equal z-hebrew-mode-on 't)
    (if (not overwrite-mode)
	(progn
	  (forward-char 1)
	  (delete-char 1)
	  (save-excursion
	    (beginning-of-line)
	    (insert-char ?  1)
	  )
	  (backward-char 1)
	)
   )
   (backward-delete-char-untabify 1)
  )
)

;-------------------------------------------------------------

(defun z-return-hebrew()	
"וגרמ - תירבע בצמב רטנאב לפטל דעונ"	
  (interactive)
  (if (equal z-hebrew-mode-on 't)
    (progn  
      ;first check up to where the spaces go..
      (save-excursion
	(beginning-of-line)
	(setq done 'f)
	(while (equal done 'f)
	  (if (= (following-char) ? )
	      (forward-char 1)
	      (progn
		(setq done 't)
		(setq cur-spaces (current-column))
	      )
	  )
	)
      );of excursion 

      (setq cur_col (current-column))
      (if (>= cur-spaces cur_col)
	  (progn
	    (end-of-line)
	    (insert-char ?\n 1)
	   ;(insert-char ?# 1)
	    (insert-char ?  z-heb-line-length)
	    (backward-char 1)
	  )
         (progn
	   (setq begin-of-line (- (point) (current-column)))
	   (setq end-spaces (+ begin-of-line cur-spaces))
	   (setq amount-killed (- (point) end-spaces))
	   (kill-region end-spaces (point))
	   (beginning-of-line)
	   (insert-char ?  amount-killed)
	   (end-of-line)  
	   (insert-char ?\n 1)
	   ;(insert-char ?* 1)
	   (insert-char ?  (- z-heb-line-length amount-killed))
	   (yank)
	   (beginning-of-line)
	   (goto-char (+ (point) (- z-heb-line-length amount-killed)))
	   (backward-char 2)
	 )
      );if (>= ..)
;      (insert-char ?  z-heb-line-length)
;      (backward-char 1)
    )
    (newline)
  )
)


;---------------------------------------------------------------
;This one ins for the benefit of hebrew html writers 

(defun z-return-hebrew-br()
  (interactive)
  (if (equal z-hebrew-mode-on 'f)
      (z-handle-input-char)
    (z-return-hebrew)
    (z-insert-hebrew-character ?>)
    (z-insert-hebrew-character ?r)
    (z-insert-hebrew-character ?b)
    (z-insert-hebrew-character ?<))
)

;------------------------------------------------------------------

(defun move-word-to-next-line(in-end-of-line cur-point)
;Well, this still needs some improvment, and that's an understatement 
;one complication I hope I alreasdy dealt with - 
;if the current-column is closer to the end of the line 
;then the space delimitng the last word, then current-column should be 
;the breaking point 
;This is important because if you try to insert enough words you will
;always reach this situation 

  (interactive)
  (if (equal in-end-of-line 't)
  (progn 
    (beginning-of-line)
    (while (= (following-char) ? )
      (forward-char 1))
    (setq word-len 0)
    (setq word nil)
    (while (not (= (following-char) ? ))
     (progn 
       (setq word-len (1+ word-len))
       (setq word (cons (following-char) word))
       ;(forward-char 1)
       (delete-char 1)
       (insert-char ?  1)
     )
    )
    (if (not (equal (current-line) line-from-previous-time))
	(progn
	  (setq line-from-previous-time (current-line))
	  (z-return-hebrew)
	  (setq need-to-space 'f)
	)
        (progn 
	  (forward-line 1)
	  (end-of-line)
	  (backward-char 1)
	  (setq need-to-space 't)
	)
    )

    (while (not(= word-len 0)) ;How do you write (while (word!=null)
       (progn
           (z-insert-hebrew-character (car word))
	   (setq word (cdr word))
	   (setq word-len (1- word-len))
       )
     )
    (if (equal need-to-space 't)
	(z-insert-hebrew-character ? )
        ()
    )

  )

  (save-excursion ;else ...
    (beginning-of-line)
    (while (= (following-char) ? )
      (forward-char 1))
    (setq word-len 0)
    (setq word nil)
;    (if (equal cur-chr ? ) 
	(while (and (not (= (following-char) ? )) 
		    (not (= (point) (1+ cur-point) ))) 
	  (progn 
	    (setq word-len (1+ word-len))
	    (setq word (cons (following-char) word))
					;(forward-char 1)
	    (delete-char 1)
	    (insert-char ?  1)
	  )
	)
;      (while (not (= (following-char) ? )) 
;	  (progn 
;	    (setq word-len (1+ word-len))
;	    (setq word (cons (following-char) word))
;					;(forward-char 1)
;	    (delete-char 1)
;	    (insert-char ?  1)
;	  )
;       ))

    (if (not (equal (current-line) line-from-previous-time))
	(progn
	  (setq line-from-previous-time (current-line))
	  (z-return-hebrew)
	  (setq need-to-space 'f)
	)
        (progn 
	  (forward-line 1)
	  (end-of-line)
	  (backward-char 1)
	  (setq need-to-space 't)
	)
    )

    (while (not(= word-len 0)) ;How do you write (while (word!=null)
       (progn
           (z-insert-hebrew-character (car word))
	   (setq word (cdr word))
	   (setq word-len (1- word-len))
       )
     )
    (if (equal need-to-space 't)
	(z-insert-hebrew-character ? )
        ()
    )

  )
  ); if ..
)


;----------------------------------------------------------------

(defun z-translate-to-hebrew (char)
  "תירבעל תילגנא ות םגרתמ"
  (cond
    ((char-equal char ?t) ?א)
    ((char-equal char ?c) ?ב)
    ((char-equal char ?d) ?ג)
    ((char-equal char ?s) ?ד)
    ((char-equal char ?v) ?ה)
    ((char-equal char ?u) ?ו)
    ((char-equal char ?z) ?ז)
    ((char-equal char ?j) ?ח)
    ((char-equal char ?y) ?ט)
    ((char-equal char ?h) ?י)
    ((char-equal char ?f) ?כ)
    ((char-equal char ?l) ?ך)
    ((char-equal char ?k) ?ל)
    ((char-equal char ?n) ?מ)
    ((char-equal char ?o) ?ם)
    ((char-equal char ?b) ?נ)
    ((char-equal char ?i) ?ן)
    ((char-equal char ?x) ?ס)
    ((char-equal char ?g) ?ע)
    ((char-equal char ?p) ?פ)
    ((char-equal char ?;) ?ף)
    ((char-equal char ?m) ?צ)
    ((char-equal char ?.) ?ץ)
    ((char-equal char ?e) ?ק)
    ((char-equal char ?r) ?ר)
    ((char-equal char ?a) ?ש)
    ((char-equal char ?,) ?ת)
    ((char-equal char ?/) ?.)
    ((char-equal char ?') ?,)
    ((char-equal char ?`) ?/)
    ((char-equal char ?w) ?')
   ; ((char-equal char ? ) ? )
   ; ((char-equal char ?\) ?;)
   (t char)
  )
)

;-----------------------------------------------------------------------

(defun z-link-keyboard (func)
  "היצקנופל תדלקמה ישקמ רושיק"
  (global-set-key "a" func)
  (global-set-key "b" func)
  (global-set-key "c" func)
  (global-set-key "d" func)
  (global-set-key "e" func)
  (global-set-key "f" func)
  (global-set-key "g" func)
  (global-set-key "h" func)
  (global-set-key "i" func)
  (global-set-key "j" func)
  (global-set-key "k" func)
  (global-set-key "l" func)
  (global-set-key "m" func)
  (global-set-key "n" func)
  (global-set-key "o" func)
  (global-set-key "p" func)
  (global-set-key "q" func)
  (global-set-key "r" func)
  (global-set-key "s" func)
  (global-set-key "t" func)
  (global-set-key "u" func)
  (global-set-key "v" func)
  (global-set-key "w" func)
  (global-set-key "x" func)
  (global-set-key "y" func)
  (global-set-key "z" func)
  (global-set-key "," func)
  (global-set-key ";" func)
  (global-set-key "." func)
  (global-set-key "'" func)
  (global-set-key "/" func)
  (global-set-key "-" func)
  (global-set-key "\\" func)
  (global-set-key "_" func)
  (global-set-key ":" func)
  (global-set-key " " func)
  (global-set-key "\"" func)
  (global-set-key "(" func)
  (global-set-key ")" func)
  (global-set-key "<" func)
  (global-set-key ">" func)
  
)

;-----------------------------------------------------------------------
;Last but not least - the key-bindings, change those to what you like 
                                                         
(z-link-keyboard 'z-handle-input-char)
(global-set-key "\177" 'z-handle-backspace)
(define-key shared-lisp-mode-map "\177" 'z-handle-backspace)
(global-set-key "\^h" 'z-toggle-hebrew-mode)
(global-set-key "\C-m" 'z-return-hebrew)
(global-set-key "\^p" 'z-toggle-engpush-mode)
(global-set-key "\11" 'z-return-hebrew-br) ;176 is F-1, at least on NCD