[xyzzy:04477] cvs.l

[nobu.nokada@xxxxxxxxxxxx]

なかだです。

  服部さんの rcs.l とか参考に(見る影ないですが ^^;)ちょっと
cvs.l とか作ってみてるんですが、いささか質問があります。

* keymap を他の keymap に付与したり取り除いたりする方法は?
* lisp からバックアップをコントロールする方法は?

  ちょっと長めですが添付しときます。


; cvs.l
;

(defvar cvs-buffer "*CVS*")
(defvar-local cvs-mode nil)
(defvar-local cvs-file-buffer nil)
(defvar-local cvs-commit-revision nil)
(defvar cvs-log-buffer "*CVS-log*")
(defvar cvs-commit-command "ci")
(defvar cvs-mode-indicator-mapping '(("conflict" . "!")
				     ("needs" . "?")
				     ("modified" . "*")
				     ("added" . "+")
				     ("removed" . "-")))

(defvar cvs-log-mode-map (make-sparse-keymap))
(define-key cvs-log-mode-map '(#\C-c #\C-c) 'cvs-log-checkin)

(defun cvs-map-status (s)
  (catch 'status
    (mapcar (function (lambda (m) (if (string-match (car m) s) (throw 'status (cdr m)))))
	    cvs-mode-indicator-mapping)
    ""))

(defun cvs-update-modeline ()
  (interactive)
  (multiple-value-bind (status revision)
      (cvs-check-status nil)
    (setq cvs-status (cvs-map-status status))
    (setq cvs-revision revision))
  (setq cvs-mode-line (concat cvs-status cvs-revision)))

(defun cvs-execute (cmd &optional file &key input)
  (or file (setq file (get-buffer-file-name)))
  (let ((code (execute-shell-command
	       (concat "cvs " cmd " " (file-namestring file)) input cvs-buffer
	       nil (directory-namestring file))))
    (or (= 0 code) (error "CVS ~s failure:~s:~d" cmd file code)))
  cvs-buffer)

(defun cvs-check-status (buffer)
  (let* ((filename (get-buffer-file-name buffer))
	 status)
    (save-window-excursion
      (set-buffer (cvs-execute "status" filename)
      (goto-char (point-min))
      (if (scan-buffer "^File:\\s +.*\\s +Status:\\s +\\(.+\\)" :regexp t)
	  (setq status (string-downcase (match-string 1))))
      (if (string-equal status "unknown") (setq status nil))
      (if (and status (scan-buffer "^\\s +Working revision:\\s +\\([0-9.]+\\)" :regexp t))
	  (values status (match-string 1))
	status))))

(defun cvs-log-checkin (rev)
  (interactive
      (if *prefix-args* (list (read-string "Revision: "))
	  (list cvs-commit-revision)))
  (let ((command "commit") (log (selected-buffer)))
    (if rev (setq command (concat command " -r" rev)))
    (cvs-execute command cvs-file-buffer :input log)
    (switch-to-buffer cvs-file-buffer)
    (revert-buffer)
    (if cvs-mode
	(cvs-update-modeline)
      (cvs-mode))
    (delete-buffer log)))

(defun cvs-checkin (&optional rev)
  (interactive
      (if *prefix-args* (list (read-string "Revision: "))))
  (let ((buf (selected-buffer))
	(log (create-new-buffer cvs-log-buffer)))
    (use-keymap cvs-log-mode-map log)
    (set-buffer log)
    (setq cvs-file-buffer buf)
    (setq cvs-commit-revision rev)
    (run-hooks 'cvs-log-mode-hook)
    (switch-to-buffer log)))

(defun cvs-log ()
  (interactive)
  (cvs-execute "log"))

(defun cvs-diff ()
  (interactive)
  (cvs-execute "diff"))

(defun cvs-mode (&optional (arg nil sv))
  (interactive "p")
  (ed::toggle-mode 'cvs-mode arg sv)
  (make-local-variable 'mode-line-format)
  (make-local-variable 'cvs-status)
  (make-local-variable 'cvs-revision)
  (make-local-variable 'cvs-mode-line)
  (update-mode-line t)
  (if cvs-mode (cvs-update-modeline)))

(global-set-key '(#\C-c #\v #\i) 'cvs-checkin)
(global-set-key '(#\C-c #\v #\o) 'cvs-checkout)
(global-set-key '(#\C-c #\v #\l) 'cvs-log)
(global-set-key '(#\C-c #\v #\d) 'cvs-diff)
(global-set-key '(#\C-x #\v #\i) 'cvs-checkin)
(global-set-key '(#\C-x #\v #\o) 'cvs-checkout)
(global-set-key '(#\C-x #\v #\l) 'cvs-log)
(global-set-key '(#\C-x #\v #\=) 'cvs-diff)

(pushnew '(cvs-mode . cvs-mode-line) *minor-mode-alist* :key #'car)