;;; debwww.el -- 翻訳作業支援マクロ (www.debian.org 日本語翻訳プロジェクト)
;; Copyright (C) 1998-1999 Yoshizumi Endo
;; ABSOLUTELY NO WARRANTY, Ver 1.0
;;
;; This program may be distributed under the terms of the GPL license.

;;; Commentary:
;; 
;; このプログラムの動作はとりあえず確認していますが、ご使用に際しては
;; 一応ご注意下さい。当然*無保証*であることもご了解ください。なおこの
;; プログラムに関するバグ訂正、改良案等は、debian-www ML ではなく
;; y-endo@debian.or.jp にまでお願いします。
;;
;; 現在のところ以下の 5 つの関数が用意されています。
;;
;; debian-www-find-other-language-file
;;   対応する (英語|日本語) wml ファイルを開く。
;;
;; debian-www-insert-revision
;;   オリジナル英語 wml ファイルの cvs リビジョン番号を、コメントとし
;;   て日本語 wml ファイルに挿入する。
;;
;; debian-www-cvs-diff
;;   現在開いている日本語ファイルが基づくオリジナル英語ファイルと
;;   その最新版との diff を表示する。
;;   (日本語 wml ファイルを開き、そこで実行してください。)
;;
;; debian-www-checklist
;;   "check_newest.pl (c) 岡充さん" の出力からファイルメニューを作成する。
;;
;;     翻訳ファイルバージョン監視スクリプト check_newest.pl
;;     Copyright (C) 1998, Mitsuru Oka
;;     http://www.globe.to/~moka/debian/check_newest.pl
;;
;;   なお debian-www-checklist を使う場合は、check_newest.pl を用意し
;;   て debian-www-check-command を設定すること、さらに、cvs をチェック
;;   アウトしたローカルディレクトリを、debian-www-dir で指定する必要が
;;   あります。
;;
;;   この checklist 上では、以下の機能がキーバインドされています。
;;     f  日本語ファイルがあればそれを、なければオリジナル英語ファイルを開く
;;     j  日本語ファイルを開く
;;     e  オリジナル英語ファイルを開く
;;     m  印をつける
;;
;; debian-www-mode
;;   上記の 4 つの関数をキーバインドするマイナーモード
;;   (この関数を利用するには Emacs20 以降が必要です。)
;;
;;	C-c C-f  debian-www-find-other-language-file
;;	C-c C-i  debian-www-insert-revision
;;	C-c C-q  debian-www-cvs-diff
;;	C-c C-l  debian-www-checklist
;;
;;   このマイナーモードを使う場合、load-path の通ったディレクトリに、
;;   この debian-www.el を置き、以下の行を .emacs に入れると良いでしょ
;;   う。
;;
;;   (define-key global-map "\C-c\C-l" 'debian-www-checklist)
;;   (autoload 'debian-www-checklist "debwww" nil t)
;;   (autoload 'debian-www-mode "debwww" nil t)
;;   (setq auto-mode-alist
;;         (append '((".wml" .  html-mode)) auto-mode-alist))
;;   (setq html-mode-hook '(lambda () (debian-www-mode 1)))
;;

;;; Code:

(defvar debian-www-dir "~/debian/")
(defvar debian-www-check-command "~/bin/check_newest.pl | grep -v template")
(defvar debian-www-file-mark-file-name "~/.debian-www")
(defvar debian-www-cvs-opt "-u")

;; debian-www-mode

(if (>= emacs-major-version 20)
    (progn

      (require 'easy-mmode)
      (easy-mmode-define-minor-mode
       debian-www-mode
       "Minor mode for www.debian.org translation project.
\\[debian-www-checklist] -- debian-www-checklist
\\[debian-www-find-other-language-file] -- debian-www-find-other-language-file
\\[debian-www-cvs-diff] -- debian-www-cvs-diff
\\[debian-www-insert-revision] -- debian-www-insert-revision"
       nil
       " Debian"
       (easy-mmode-define-keymap
	'(("\C-c\C-l" . debian-www-checklist)
	  ("\C-c\C-f" . debian-www-find-other-language-file)
	  ("\C-c\C-q" . debian-www-cvs-diff)
	  ("\C-c\C-i" . debian-www-insert-revision))))
))

;; Save & load a mark-file

(if (file-exists-p debian-www-file-mark-file-name)
    (load-file debian-www-file-mark-file-name)
  (setq debian-www-checklist-file nil))

(add-hook
 'kill-emacs-hook
 (function
  (lambda()
    (save-excursion
      (set-buffer (get-buffer-create "*debian-www-tmp*"))
      (erase-buffer)
      (insert
       (format "(setq debian-www-checklist-file '%s)\n"
	       (prin1-to-string debian-www-checklist-file)))
      (set-visited-file-name debian-www-file-mark-file-name)
      (save-buffer)))))

;; debian-www-find-other-language-file

(defun debian-www-find-other-language-file ()
  "Find a corresponded other language wml file."
  (interactive)
  (let ((debian-www-file (buffer-file-name)))
    (cond ((string-match "webwml/japanese" debian-www-file)
	   (view-file
	    (replace-match "webwml/english" nil nil debian-www-file)))
	  ((string-match "webwml/english" debian-www-file)
	   (find-file
	    (replace-match "webwml/japanese" nil nil debian-www-file)))
	  (t (error "Can't find a corresponded wml file")))))

;; debian-www-cvs-diff

(defun debian-www-cvs-diff ()
  "Check cvs diff."
  (interactive)
  (let ((debian-www-file (buffer-file-name)))
   (save-excursion
     (if (string-match ".*webwml/japanese" debian-www-file)
	 (progn
	   (setq debian-www-file (replace-match " english"
					   nil nil debian-www-file))
	   (goto-line 1)
	   (if (re-search-forward "\#use wml::debian::translation-check translation=\"\\(.*\\)\"" nil t)
	       (setq debian-www-revision
		     (buffer-substring (match-beginning 1) (match-end 1)))
	     (error "Not found cvs reviion number"))
	   (cd (concat debian-www-dir "/webwml"))
	   (message "Checking cvs diff...")
	   (shell-command
	    (concat "cvs diff " debian-www-cvs-opt " -r "
		    debian-www-revision
		    debian-www-file))
	   (message "Checking cvs diff...done"))
       (error "Not japanese wml file")
       )
)))

;; debian-www-insert-revision

(defun debian-www-insert-revision ()
  "Insert the cvs reviion number of a original english wml file."
  (interactive)
  (save-excursion
    (goto-line 1)
    (search-forward-regexp "^$")
    (insert
     (concat
      "#use wml::debian::translation-check translation=\""
      (debian-www-search-revision)
      "\"\n"))
    (font-lock-fontify-buffer)))

(defun debian-www-search-revision ()
  "Return the cvs revision number of a original english wml file."
  (let ((debian-www-dir (file-name-directory (buffer-file-name)))
 	(debian-www-file (file-name-nondirectory (buffer-file-name)))
	(debian-www-revision))
    (if (string-match "webwml/japanese" debian-www-dir)
	(save-excursion
	  (find-file
	   (concat (replace-match "webwml/english" nil nil debian-www-dir)
		   "CVS/Entries"))
	  (goto-line 1)
	  (re-search-forward (concat debian-www-file "/\\(.*\\)/.*//") nil)
	  (setq debian-www-revision
		(buffer-substring (match-beginning 1) (match-end 1)))
	  (kill-this-buffer)
	  debian-www-revision)
      (error "Wrong path (Not contains `webwml/japanese')"))))

;; debian-www-checklist

(defun debian-www-checklist ()
  "Display a check list of webwml files with check_newest.pl."
  (interactive)
  (save-excursion
    (message "Executing check_newest.pl...")
    (switch-to-buffer (get-buffer-create "*Debian WWW Check List*"))
    (setq buffer-read-only nil)
    (setq standard-output (current-buffer))
    (erase-buffer)
    (cd debian-www-dir)
    (shell-command debian-www-check-command (current-buffer))
    (goto-line 5)
    (debian-www-checklist-mode)
    ))

(defun debian-www-checklist-mode ()
  "Major mode for a check list of webwml files.

f -- Find a japanese (english) file at point.
j -- Find a japanese file at point.
e -- Find a english file at point.
m -- Mark file at point.
q -- quit."
  (kill-all-local-variables)
  (setq buffer-read-only t)
  (setq major-mode 'debian-www-checklist-mode
	mode-name "Checklist Menu")
  (setq debian-www-checklist-mode-map (make-keymap))
  (suppress-keymap debian-www-checklist-mode-map t)
  (define-key debian-www-checklist-mode-map "q" 'kill-this-buffer)
  (define-key debian-www-checklist-mode-map "m" 'debian-www-checklist-mark)
  (define-key debian-www-checklist-mode-map " " 'scroll-up)
;  (define-key debian-www-checklist-mode-map "\DEL" 'scroll-down)
  (define-key debian-www-checklist-mode-map "f"
    'debian-www-checklist-find-file)
  (define-key debian-www-checklist-mode-map "j"
    'debian-www-checklist-find-file-jp)
  (define-key debian-www-checklist-mode-map "e"
    'debian-www-checklist-find-file-en)
  (use-local-map debian-www-checklist-mode-map)
  (debian-www-checklist-markup)
  (debian-www-checklist-fontify)
  (message "Commands: f, j, e, m; q to quit.")
  (run-hooks 'debian-www-checklist-mode-hook))

;; find-file on debian-www-checklist-mode

(defun debian-www-checklist-find-file ()
  "Find file at point on *Debian WWW Check List*."
  (interactive)
    (let ((debian-www-visit-file-solo-name nil))
      (save-excursion
	(beginning-of-line)
	(re-search-forward "webwml/japanese/\\(.*\\)$" nil nil)
	(setq debian-www-visit-file-solo-name
		      (buffer-substring (match-beginning 1) (match-end 1)))

	(if (file-readable-p (concat debian-www-dir "webwml/japanese/"
				     debian-www-visit-file-solo-name))
	    (find-file (concat debian-www-dir "webwml/japanese/"
			       debian-www-visit-file-solo-name))
	  (progn (find-file (concat debian-www-dir "webwml/english/"
			     debian-www-visit-file-solo-name))
		 (setq buffer-read-only t))))))

(defun debian-www-checklist-find-file-jp ()
  "Find japanese file at point on *Debian WWW Check List*."
  (interactive)
  (save-excursion
    (debian-www-checklist-visit-file "japanese/")))

(defun debian-www-checklist-find-file-en ()
  "Find english file at point on *Debian WWW Check List*."
  (interactive)
  (save-excursion
    (debian-www-checklist-visit-file "english/")))

(defun debian-www-checklist-visit-file (lang)
  "Find file at point of *Debian WWW CheckList*.
Argument LANG language."
  (let ((debian-www-visit-file nil))
    (save-excursion
      (beginning-of-line)
      (re-search-forward "webwml/japanese/\\(.*\\)$" nil nil)
      (setq debian-www-visit-file
	    (concat debian-www-dir "webwml/" lang
		    (buffer-substring (match-beginning 1) (match-end 1))))
      (find-file debian-www-visit-file)
      (if (string-equal lang "english/")
	  (setq buffer-read-only t)))))

;; mark

(defun debian-www-checklist-mark ()
  "Mark *Debian WWW Check List*."
  (interactive)
  (save-excursion
    (let ((buffer-read-only nil))
      (beginning-of-line)
      (re-search-forward "\\(.\\)\\(webwml/japanese/\\)\\(.*\\)$" nil nil)
      (if (string-equal " " (debian-www-buffer-substring 1))
	 (progn
	    (replace-match "#\\2\\3")
	    (setq debian-www-checklist-file
		  (cons (debian-www-buffer-substring 3)
			debian-www-checklist-file)))
	(progn
	  (replace-match " \\2\\3")
	  (setq debian-www-checklist-file
		(delete (debian-www-buffer-substring 3)
			debian-www-checklist-file)))))))

(defun debian-www-buffer-substring (num)
  "Buffer substring for `debian-www-checklist-mark'.
Argument NUM position of text matched"
  (buffer-substring-no-properties
   (match-beginning num) (match-end num)))

(defun debian-www-checklist-markup ()
  "Mark '#' on *Debian WWW Check List*."
  (save-excursion
    (let ((buffer-read-only nil) (list debian-www-checklist-file))
      (while list
	(goto-line 1)
	(if (re-search-forward
	     (concat "^\\(..\\) \\(webwml/japanese/" (car list) "\\)") nil t 1)
	    (replace-match "\\1#\\2"))
	(setq list (cdr list))))))

;; font-lock

(defun debian-www-checklist-fontify ()
  "Fontify on `debian-www-checklist-mode'."
  (if window-system
      (progn
	(font-lock-mode 1)
	(make-local-variable 'font-lock-keywords)
	(setq font-lock-keywords debian-www-checklist-font-lock-keywords)
	(font-lock-fontify-buffer)
	)))

(cond (window-system
       (make-face 'debwww-jp)
       (set-face-foreground 'debwww-jp "SkyBlue")

       (make-face 'debwww-jp-mark)
       (set-face-foreground 'debwww-jp-mark "SkyBlue")
       (set-face-bold-p 'debwww-jp-mark t)

       (make-face 'debwww-en)
       (set-face-foreground 'debwww-en "Khaki")

       (make-face 'debwww-en-mark)
       (set-face-foreground 'debwww-en-mark "Khaki")
       (set-face-bold-p 'debwww-en-mark t)

       (make-face 'debwww-t-jp)
       (set-face-foreground 'debwww-t-jp "SkyBlue")
       (set-face-italic-p 'debwww-t-jp t)

       (make-face 'debwww-t-jp-mark)
       (set-face-foreground 'debwww-t-jp-mark "SkyBlue")
       (set-face-italic-p 'debwww-t-jp-mark t)
       (set-face-bold-p 'debwww-t-jp-mark t)

       (make-face 'debwww-t-en)
       (set-face-foreground 'debwww-t-en "Khaki")
       (set-face-italic-p 'debwww-t-en t)

       (make-face 'debwww-t-en-mark)
       (set-face-foreground 'debwww-t-en-mark "Khaki")
       (set-face-italic-p 'debwww-t-en-mark t)
       (set-face-bold-p 'debwww-t-en-mark t)

       (defconst debian-www-checklist-font-lock-keywords
	 '(t ("^\\([|+状].*\\)" (1 'default))
	     ("^\\(N.#.*\\)" (1 'bold))

	     ("^\\(J[^T] .*\\)" (1 'debwww-jp))
	     ("^\\(J[^T]#.*\\)" (1 'debwww-jp-mark))
	     ("^\\(E[^T] .*\\)" (1 'debwww-en))
	     ("^\\(E[^T]#.*\\)" (1 'debwww-en-mark))

	     ("^\\(JT .*\\)" (1 'debwww-t-jp))
	     ("^\\(JT#.*\\)" (1 'debwww-t-jp-mark))
	     ("^\\(ET .*\\)" (1 'debwww-t-en))
	     ("^\\(ET#.*\\)" (1 'debwww-t-en-mark))
	     ))
       ))

(provide 'debwww)

;;; debwww.el ends here