emacs-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Checkout a branch in cvs-tree


From: Masatake YAMATO
Subject: Checkout a branch in cvs-tree
Date: Tue, 20 Apr 2004 17:12:30 +0900 (JST)

Hi,

I wrote a patch to check out a branch under the point in cvs-tree
buffer by hitting `>' to track the current emacs development:-P I
found this function is useful. However patch is not clean enough. So
I'd like to get your advice.

The question is how to set the cvs root for `cvs-checkout'
command. I'm using CVSROOT environment variable. It may 
be wrong way.

Regards,
Masatake YAMATO

Index: lisp/cvs-status.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/cvs-status.el,v
retrieving revision 1.16
diff -u -r1.16 cvs-status.el
--- lisp/cvs-status.el  26 Mar 2004 15:20:20 -0000      1.16
+++ lisp/cvs-status.el  20 Apr 2004 08:06:43 -0000
@@ -442,6 +442,22 @@
            ;;(sit-for 0)
            ))))))
 
+(easy-mmode-defmap cvs-status-tag-map
+  `((">" . cvs-tree-checkout))
+  "The keymap only used on a tag of cvs tree.")
+
+(defun cvs-tree-checkout (dir)
+  (interactive "DDirectory: ")
+  (let ((modules (list (cvs-get-module)))
+       (flags (cons "-r" (cons (get-text-property (point) 'tag-name)
+                               (cvs-flags-query 'cvs-checkout-flags))))
+       (env (getenv "CVSROOT")))
+    (unwind-protect
+       (progn
+         (setenv "CVSROOT" (cvs-get-cvsroot))
+         (cvs-checkout modules dir flags))
+      (setenv "CVSROOT" env))))
+
 (defun cvs-tree-tags-insert (tags prev)
   (when tags
     (let* ((tag (car tags))
@@ -462,11 +478,20 @@
            (ps prev (cdr ps))
            (as after (cdr as)))
          ((and (null as) (null vs) (null ps))
-          (let ((revname (cvs-status-vl-to-str vlist)))
+          (let ((revname (cvs-status-vl-to-str vlist))
+                (tname (cvs-tag->name tag)))
+            (setq tname (if tname 
+                            (propertize tname 
+                                        'help-echo (substitute-command-keys 
"\{cvs-status-tag-map}")
+                                        'mouse-face 'highlight
+                                        'keymap cvs-status-tag-map
+                                        'tag-name tname
+                                        )
+                          ""))
             (if (cvs-every 'identity (cvs-map 'equal prev vlist))
                 (insert (make-string (+ 4 (length revname)) ? )
-                        (or (cvs-tag->name tag) ""))
-              (insert "  " revname ": " (or (cvs-tag->name tag) "")))))
+                        tname)
+              (insert "  " revname ": " tname))))
        (let* ((eq (and pe (equal (car ps) (car vs))))
               (next-eq (equal (cadr ps) (cadr vs))))
          (let* ((na+char




reply via email to

[Prev in Thread] Current Thread [Next in Thread]