



(defun rcs-file-status (fname)
  (let ((stat (file-attributes fname)))
    (if stat
	(if (eq ?w (aref (nth 8 stat) 2))
	    (if (eq (user-real-uid) (nth 2 stat))
		'mine
	      'locked)
	  'unlocked)
      nil)))
  




(defun rcs-find-file-hook ()
  (let ((foo (rcs-file-status buffer-file-name)))
       (setq buffer-read-only 
	     (and foo (not (eq foo 'mine))))))
  
(defun rcs-lock ()
  (interactive)
  (or buffer-file-name
      (error "This buffer has no file!"))
  (rcs-find-file-hook)
  (let ((foo (rcs-file-status buffer-file-name))
	buf 
	proc
	file)
    (cond
     ((not foo)
      (error "This buffer isn't a file!"))
     ((eq foo 'mine)
      (error "You already have this file!"))
     ((eq foo 'locked)
      (error "Someone else already has this file!"))
     ((eq foo 'unlocked)
      (setq buffer-read-only nil)
      (message "locking file...")
      (setq buf (generate-new-buffer "*rcs*"))
      (setq file buffer-file-name)
      (setq proc (start-process "rcs-lock" buf "rcs" "-l" file))
      (set-process-sentinel proc 'rcs-lock-sentinel)
      (set-buffer buf)
      (make-variable-buffer-local 'rcs-file-name)
      (setq rcs-file-name file)))))
      
(defun rcs-lock-sentinel (proc state)
  (set-buffer (process-buffer proc))
  (goto-char (point-min))
  (if (re-search-forward "locked\ndone$")
      (let ((fname rcs-file-name))
	(set-file-modes fname (+ 384 32 4))
	(set-buffer (get-file-buffer fname))
	(set-buffer-modified-p t)
	(save-buffer)
	(message "File %s locked." fname)
	(kill-buffer (process-buffer proc)))
    (progn
      (pop-to-buffer (process-buffer proc))
      (message "Uh-oh... problems locking file..."))))



(defun rcs-check-in ()
  (interactive)
  (let ((foo (rcs-file-status buffer-file-name))
	buf 
	proc
	file)
    (cond
     ((not foo)
      (error "This buffer isn't a file!"))
     ((eq foo 'locked)
      (error "Someone else already has this file!"))
     ((eq foo 'unlocked)
      (error "Nobody has this file, not even you!"))
     ((eq foo 'mine)
      (if (buffer-modified-p)
	  (save-buffer))
      (setq buffer-read-only t)
      (setq buf (generate-new-buffer "*rcs*"))
      (setq file buffer-file-name)
      (setq proc (start-process "rcs-ci" buf "ci" "-f" "-u" file))
      (set-process-sentinel proc 'rcs-check-in-sentinel)
      (set-buffer buf)
      (make-variable-buffer-local 'rcs-file-name)
      (setq rcs-file-name file)
      (process-send-string proc (concat (read-string "RCS log comment: ") "\n"))
      (process-send-eof proc)
      (message "Checking in (and unlocking) file...")
      ))))
      
	  
(defun rcs-check-in-sentinel (proc stat)
  (set-buffer (process-buffer proc))
  (goto-char (point-min))
  (if (re-search-forward "^done$" nil t)
      (progn
	(message "Checked in (and unlocked).")
	(let ((buf (get-file-buffer rcs-file-name)))
	  (if buf
	      (progn
		(set-buffer buf)
		(clear-visited-file-modtime))))
	(kill-buffer (process-buffer proc)))
    (progn
      (pop-to-buffer (process-buffer proc))
      (message "Uh-oh... problems unlocking (and checking in) file..."))))


(defun rcs ()
  (interactive)
  (if (memq 'rcs-find-file-hook find-file-hooks)
      (progn
	(setq find-file-hooks
	      (delq 'rcs-find-file-hook find-file-hooks))
	(message "RCS mode off"))
    (setq find-file-hooks (cons 'rcs-find-file-hook find-file-hooks))
    (message "RCS mode on")))
