;;; translation.el --- translation minor mode

;; Copyright (C) 2000 Christophe Deleuze

;; Author: Christophe Deleuze <eviok@free.fr>
;; Created: Nov 1999
;; Version: 0.5 / 26 Jan 2000

;; Last version available as http://christophe.deleuze.free.fr/P/translation.el

;; This file is NOT part of GNU Emacs.

;; This file is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by the
;; Free Software Foundation; either version 2, or (at your option) any later
;; version.

;; This file is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
;; more details.

;; You should have received a copy of the GNU General Public License along
;; with this program; if not, write to the Free Software Foundation, Inc.,
;; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.


;;; Commentary:

;; This is a minor mode for easing the management of a structured document
;; in two languages.  It can deal with simple texts as well.
;;
;; I've been using it for papers in LaTeX, web pages in HTML, and Linux
;; HOWTO documents in SGML.

;; For details, please see the documentation string of the
;; `translation-mode' function below.

;; Tested on emacs 19.34.1, emacs 20.3.2 and xemacs 20.4


;;; Code:

(defvar translation-mode nil
  "Translation minor mode")
(make-variable-buffer-local 'translation-mode)

(defvar tsl-f2-edit-flag nil
  "*Non-nil means you can edit the second file as well.
Otherwise it's open as read-only.")
(make-variable-buffer-local 'tsl-f2-edit-flag)

(defvar tsl-f2-name nil
  "Name of the second file.")
(make-variable-buffer-local 'tsl-f2-name)

(defvar tsl-use-frames-flag nil
  "Non-nil means use a frame for each file.
Else, use the same frame.")

(defvar tsl-buffer1 nil
  "Buffer of the first file.")
(defvar tsl-buffer2 nil
  "Buffer of the second file.")
(make-variable-buffer-local 'tsl-buffer1)
(make-variable-buffer-local 'tsl-buffer2)

(defvar tsl-rexp nil
  "Regexp matching section tags. If nil, use paragraphs.")
(make-variable-buffer-local 'tsl-rexp)

(defvar tsl-rexps-alist 
  (list
   (cons 'latex-mode   "section{.+}")
;;;   (cons 'latex-mode   "\\\(sub\)*section{.+}")
   (cons 'html-mode    "<h[1-5]>")
   (cons 'sgml-mode    "<sect.*>")
   (cons 'texinfo-mode "@node"))
  "Alist of major modes and associated regexp matching section tags.")

;; add translation mode to minor mode line format (if not present yet) 
(or (assq 'translation-mode minor-mode-alist)
    (nconc minor-mode-alist
	   (list '(translation-mode " Tsl"))))

(defvar translation-mode-map nil)
(if translation-mode-map
    nil
  (setq translation-mode-map (make-keymap))
  (define-key translation-mode-map "\C-c,"   'tsl-position-f2)
  (define-key translation-mode-map "\C-c!"   'tsl-position-f1)
  (define-key translation-mode-map "\M-g"    'tsl-goto-line-f1)
  (define-key translation-mode-map "\C-\M-g" 'tsl-goto-line-f2))

(or (assq 'translation-mode minor-mode-map-alist)
    (setq minor-mode-map-alist
	  (cons (cons 'translation-mode translation-mode-map)
		minor-mode-map-alist)))


(defun translation-mode (&optional arg)
  "Toggle Translation minor mode.
With arg, turn Translation mode on if and only if arg is positive.

When Translation mode is enabled, your file (file1) is connected with
another file, (file2) which is the original language file.  This other
file's name is taken from the `tsl-f2-name' local variable (which can be set
as a file variable in your edited file) or prompted if nil.  file2 is loaded
in its own buffer and set in either view-mode or translation-mode depending
on `tsl-f2-edit-flag'.  If it's non-nil, file2 can be edited and is put in
the translation mode as well. When you're editing it, same rules apply in
symmetry so that locally it's file1, and the other file is file2.

`tsl-position-f2' makes file2 visible if it wasn't, and shows text
matching the current position in file1.

`tsl-position-f1' sets position in file1 to match position in file2
(be it visible or not.)

`tsl-goto-line-f1' performs goto-line and positions file2 accordingly.

`tsl-goto-line-f2' performs goto-line on file2 (even if not visible) and
positions file1 accordingly.

Position is expressed as a pair (x y).  x is the number of section tags
between the position and the beginning of the document, y is the number of
lines between the position and the previous tag.  Tags are identified by a
regular expression depending on the major mode.  If no regexp is known for
the current mode, x is the number of paragraphs.  `tsl-rexps-alist' contains
a list of regular expressions for various kinds of structured documents.

If `tsl-use-frames-flag' is non-nil, files are displayed in separate frames.
In any case, the window or frame displaying file2 can be deleted.  It will
be re-created automatically when needed.

Key bindings:
\\{translation-mode-map}"

  (interactive)                    

  ;; toggle translation mode
  (setq translation-mode
	(if (null arg) (not translation-mode)
	  (> (prefix-numeric-value arg) 0)))
  
  ;; if off, terminate
  (if (not translation-mode)
      (force-mode-line-update t)

    ;; check major mode and set tsl-rexp
    (setq tsl-rexp (cdr (assq major-mode tsl-rexps-alist)))

    ;; ???
    (let ((file1-name buffer-file-name)
	  (rexp tsl-rexp)
	  (frames (if tsl-use-frames-flag "two frames" "one frame"))
	  (readonly (if tsl-f2-edit-flag "editable" "read only"))
	  (buffer1 (current-buffer))
	  (buffer2)
	  (new-config  nil))   ; will ask for saving config?
      
      ;; get file2 name and rw/ro status
      (if tsl-f2-name
	  ()
	(setq tsl-f2-name
	         (read-file-name "Original language file:" nil nil t)
	      tsl-f2-edit-flag  (y-or-n-p "Editable? ")
	      readonly    (if tsl-f2-edit-flag "editable" "read only")
	      new-config  t))
      

      ;; --- load file2 and set up buffer2 settings

      (if (not tsl-f2-edit-flag)

	  ;; open in view-mode or ...
	  (if tsl-use-frames-flag
	      (progn
		(find-file-other-frame tsl-f2-name)
		(view-mode))
	    (view-file-other-window tsl-f2-name))

	;; ... open in translation-mode
	(if tsl-use-frames-flag
	    (find-file-other-frame tsl-f2-name)
	  (find-file-other-window tsl-f2-name))
        ;; set up things in file2 buffer
	(setq translation-mode t)
	(force-mode-line-update t)
	(setq tsl-f2-name file1-name
	      tsl-buffer1 (current-buffer)
	      tsl-buffer2 buffer1))
      
      ;; set up things in file2 buffer
      (setq tsl-rexp rexp)
      (setq buffer2 (current-buffer))   ; will be use in buffer1 ...


      ;; --- back in file1's buffer

      (select-window (get-buffer-window buffer1 t))
      (setq tsl-buffer1 buffer1
	    tsl-buffer2 buffer2)        ; ... here

      ;; save config?
      (if new-config
	  (if (y-or-n-p "Save config as file variables now? ")
		(tsl-insert-config)))
      ;; okay, ready
      (message "Major mode: %s. Using %s. File2 is %s."
               (if (assq major-mode tsl-rexps-alist)
	           mode-name
                   "Unknown")
               frames
               readonly)
      (force-mode-line-update t))))
    

;;;; commands

;; tsl-buffer1 and tsl-buffer2 are local to buffer, so we sometimes use let
;; variables buffer1 and buffer2 to allow changing of buffer

(defun tsl-position-f2 ()
  "Position file2 according to position in file1.
Bring it up if it was not visible."
  (interactive)
  (let ((pos (tsl-get-position tsl-buffer1))
	(buffer1 tsl-buffer1))

    ;; bring up the window
    (if (get-buffer-window tsl-buffer2 t)
	(select-window (get-buffer-window tsl-buffer2 t))
      
      ;; or the frame
      (if tsl-use-frames-flag
	  (switch-to-buffer-other-frame tsl-buffer2)
	(pop-to-buffer tsl-buffer2)))
    
    ;; position
    (let 
	((res   (tsl-set-position pos))
	 (count (car pos))
	 (lines (car (cdr pos))))
      ;; back in first buffer
      (select-window (get-buffer-window buffer1 t))
      (if res 
	  (message "(%d + %d)  -> (%d - 1)" count lines (1+ count))
	(message "(%d + %d) -> (%d + %d)" count lines count lines)))))


(defun tsl-position-f1 ()
  "Position point according to position in file2 (be it visible or not.)"
  (interactive)
  (let ((buffer1 tsl-buffer1)
	(buffer2 tsl-buffer2))
    (set-buffer buffer2)
    (let ((pos (tsl-get-position buffer2)))
      (set-buffer buffer1)
      (let 
	  ((res   (tsl-set-position pos))
	   (count (car pos))
	   (lines (car (cdr pos))))
	(if res 
	    (message "(%d - 1) <- (%d + %d)" (1+ count) count lines)
	  (message "(%d + %d) <- (%d + %d)" count lines count lines))))))


(defun tsl-goto-line-f1 (line)
  "Goto line LINE. Update file2 position if visible."
  (interactive "nGoto line:")
  (goto-line line)
  (sit-for 0)                              ; redisplay
  (if (get-buffer-window tsl-buffer2 t) (tsl-position-f2)))


(defun tsl-goto-line-f2 (line)
  "Position file2 to line LINE and position file1 accordingly.
Do not bring file1 up if not visible."
  (interactive "nGoto line file2:")
  (let ((buffer1 tsl-buffer1)
	(buffer2 tsl-buffer2))

    (if (get-buffer-window buffer2 t)      ; if visible
	(progn
	  (select-window (get-buffer-window buffer2 t))
	  (goto-line line)
	  (select-window (get-buffer-window buffer1 t)))

      (set-buffer buffer2)                 ; if hidden
      (goto-line line)
      (set-buffer buffer1))

    (sit-for 0)                            ; redisplay   
    (tsl-position-f1)))


(defun tsl-insert-config () 
  "Insert name of file2 and read-only status as File Variables in file.
Subsequent calls to `translation-mode' will not prompt for these values,
but take them there."

  (interactive)
  (save-excursion
    (goto-char (point-min))
    (insert (format "%s -*- tsl-f2-name: \"%s\"; tsl-f2-edit-flag: %s -*- %s\n"
		    comment-start tsl-f2-name tsl-f2-edit-flag comment-end))))


;;;; sub-routines

(defun tsl-get-position (buffer)
  "Return position of buffer as (nb-rexp nb-lines)."
  (save-excursion
    (set-buffer buffer)
    ;; set point at top left corner of window if buffer is visible
    (let ((win (get-buffer-window buffer t)))
      (if win
	  (goto-char (window-start win))))
    ;; build position list
    (list (if tsl-rexp (tsl-count-rexps) (tsl-count-paragraphs))
	  (tsl-count-lines-backward))))


(defun tsl-set-position (pos)
  "Set position to POS=(nb-rexp nb-lines) in current buffer."
  (goto-char (point-min))
  (if tsl-rexp
      (re-search-forward tsl-rexp nil nil (car pos))
    (forward-paragraph (1- (car pos))))
  (let ((stopped (tsl-forward-line (car (cdr pos)))))
    (set-window-start () (point))
    ; return non-nil if was stopped
    stopped))


(defun tsl-count-paragraphs ()
  "Return number of paragraphs before point."
  (let ((count 0) old-point)
    (save-excursion
      (while (progn (setq old-point (point))
		    (backward-paragraph)
		    (and (not (= old-point (point)))
			 (not (= 1 (point)))))
	(setq count (1+ count)))
    (1+ count))))


(defun tsl-count-rexps ()
  "Return number of tsl-rexps before point."
  (let ((count 0) old-point)
    (save-excursion
      (while (progn (setq old-point (point))
		    (re-search-backward tsl-rexp nil t)
		    (and (not (= old-point (point)))
			 (not (= 1 (point)))))
	(setq count (1+ count)))
    count)))

(defun tsl-count-lines-backward ()
  "Return number of lines between position and previous tsl-rexp."
  (let ((count 0)
        (old-point (point)))
    (save-excursion
      (if tsl-rexp
	  (re-search-backward tsl-rexp nil 'pouet)
	(backward-paragraph))
      (count-lines old-point (point)))))

(defun tsl-count-lines-forward ()
  "Return number of lines between position and next tsl-rexp."
  (let ((count 0)
        (old-point (point)))
    (save-excursion
      (if tsl-rexp
	  (re-search-forward tsl-rexp nil 'pouet)
	(forward-paragraph))
      (count-lines old-point (point)))))

(defun tsl-forward-line (lines)
  "Go down LINES lines but not beyond next tsl-rexp.
Return: nil if actually went down LINES lines, 
actual number of lines if stopped at next tsl-rexp."
  (let ((next-rexp (- (tsl-count-lines-forward) 1)))
    (forward-line (min lines next-rexp))
    (if (> lines next-rexp) next-rexp nil)))


;;; translation.el ends here