;;; -*- Mode: Lisp; Package: EDITOR -*-
;;;
;;; This file is not part of xyzzy.
;;;
; $Id: rcs.l 1.15 2000-06-20 17:18:40+09 hattori Exp hattori $
;
; rcs.l
;
;     RCSのコマンドを呼び出すマイナーモード（のつもり）
;
; by Masashi Hattori <gyo@he.mirai.ne.jp>
;
; ;; .xyzzy
; (load-library "rcs")
; (add-hook 'ed::*perl-mode-hook* #'(lambda () (rcs-mode t)))
;
; [2000/06/18]	minor-mode-mapにした
;		editor packageにした

(provide "rcs")

(in-package "editor")

(export '(rcs-mode
	  rcs-checkin
	  rcs-checkout
	  rcs-log
	  rcs-diff
	  rcs-checkin-and-continue
	  rcs-checkin-revision
	  rcs-checkin-revision-and-continue
	  *rcs-mode-map*))

(defvar rcs-buffer "*RCS*")
(defvar-local rcs-mode nil)
(defvar *rcs-mode-map* nil)

(unless *rcs-mode-map*
  (setq *rcs-mode-map* (make-sparse-keymap))
  (define-key *rcs-mode-map* '(#\C-c #\v #\i) 'rcs-checkin)
  (define-key *rcs-mode-map* '(#\C-c #\v #\o) 'rcs-checkout)
  (define-key *rcs-mode-map* '(#\C-c #\v #\l) 'rcs-log)
  (define-key *rcs-mode-map* '(#\C-c #\v #\d) 'rcs-diff)
)

(defun rcs-checkin (&optional rev continue)
  (interactive)
  (let ((filename (get-buffer-file-name))
	file
	msg
	comment
	proc
	rcsdir
	dir
	code
	(command "ci -zLT"))
    (setq dir (directory-namestring filename))
    (setq file (file-namestring filename))
    (if continue
	(setq command (concat command " -l"))
      (setq command (concat command " -u")))
    (setq rcsdir (concat dir "RCS/"))
    (create-directory rcsdir :if-exists :skip)
    (if rev
	(setq command (concat command " -r" rev)))
    (setq command (concat command " " file))
    (while (not (equal "." msg))
      (setq msg (read-string "Change log[\".\" to finish]: "))
      (setq comment (concat comment msg "\n")))
    (save-excursion
      (switch-to-buffer rcs-buffer)
      (execute-subprocess command nil rcs-buffer)
      (setq proc (buffer-process rcs-buffer))
      (process-send-string proc comment)
      (while (eq (process-status proc) ':run)
	(sit-for 1)
	(process-send-string proc ".\n")))
    (setq code (process-exit-code proc))
    (if (= 0 code)
	(progn
	  (revert-buffer)
	  (setq buffer-read-only (not (file-writable-p filename)))
	  (if rcs-mode
	      (rcs-update-modeline)
	    (rcs-mode)))
      (progn
	(message-box (format nil "~D: エラーかも" code))
	(switch-to-buffer rcs-buffer)))))

(defun rcs-checkin-and-continue ()
  (interactive)
  (rcs-checkin nil t))

(defun rcs-checkin-revision (rev)
  (interactive "sRevision: ")
  (rcs-checkin rev))

(defun rcs-checkin-revision-and-continue (rev)
  (interacitive "sRevision: ")
  (rcs-checkin rev t))

(defun rcs-checkout ()
  (interactive)
  (let ((filename (get-buffer-file-name))
	file
	proc)
    (setq file (file-namestring filename))
    (save-excursion
      (switch-to-buffer rcs-buffer)
      (execute-subprocess
       (concat "co -zLT -l " file) nil rcs-buffer)
      (setq proc (buffer-process rcs-buffer))
      (while (eq (process-status proc) ':run)
	(sit-for 1)
	(process-send-string proc "\n")))
    (setq code (process-exit-code proc))
    (if (= 0 code)
	(progn
	  (revert-buffer)
	  (setq buffer-read-only (not (file-writable-p filename)))
	  (if rcs-mode
	      (rcs-update-modeline)
	    (rcs-mode)))
      (progn
	(message-box (format nil "~D: エラーかも" code))
	(switch-to-buffer rcs-buffer)))
  ))

(defun rcs-log ()
  (interactive)
  (let ((file (buffer-name (selected-buffer))))
    (execute-shell-command
     (concat "rlog " file) nil rcs-buffer)))

(defun rcs-diff ()
  (interactive)
  (let ((file (buffer-name (selected-buffer))))
    (execute-shell-command
     (concat "rcsdiff -c " file) nil rcs-buffer)))

(defun rcs-update-modeline ()
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (if (scan-buffer
	 "[\\$]Id:[ \t]+\\([^ \t]+\\)[ \t]+\\([^ \t]+\\)[ \t]+.*[ \t]+\\([^ \t]+\\)[ \t]+\\$"
	 :regexp t)
	(progn
;	  (setq rcs-filename (match-string 1))
	  (if (string= "Exp" (match-string 3))
	      (setq rcs-current-exp "-")
	    (setq rcs-current-exp ":"))
	  (setq rcs-version
		(concat "RCS" rcs-current-exp (match-string 2)))))
  ))

(defun rcs-mode (&optional (arg nil sv))
  (interactive "p")
  (ed::toggle-mode 'rcs-mode arg sv)
  (update-mode-line t)
;  (make-local-variable 'rcs-filename)
;  (setq rcs-filename "")
  (make-local-variable 'rcs-version)
  (setq rcs-version "RCS")
  (make-local-variable 'rcs-current-exp)
  (setq rcs-current-exp "")
  (make-local-variable 'mode-line-format)
  (if rcs-mode
      (progn
	(set-minor-mode-map *rcs-mode-map*)
	(rcs-update-modeline))
    (unset-minor-mode-map *rcs-mode-map*)))

(pushnew '(rcs-mode . rcs-version) *minor-mode-alist* :key #'car)