cvs-status.el 17.2 KB
Newer Older
1
;;; cvs-status.el --- major mode for browsing `cvs status' output -*- coding: utf-8 -*-
Stefan Monnier's avatar
Stefan Monnier committed
2

3
;; Copyright (C) 1999, 2000, 03, 2004  Free Software Foundation, Inc.
Stefan Monnier's avatar
Stefan Monnier committed
4 5

;; Author: Stefan Monnier <monnier@cs.yale.edu>
6
;; Keywords: pcl-cvs cvs status tree tools
Stefan Monnier's avatar
Stefan Monnier committed
7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Todo:

;; - Somehow allow cvs-status-tree to work on-the-fly

;;; Code:

(eval-when-compile (require 'cl))
(require 'pcvs-util)

;;;

(defgroup cvs-status nil
  "Major mode for browsing `cvs status' output."
  :group 'pcl-cvs
  :prefix "cvs-status-")

(easy-mmode-defmap cvs-status-mode-map
  '(("n"	. next-line)
    ("p"	. previous-line)
46 47 48 49
    ("N"	. cvs-status-next)
    ("P"	. cvs-status-prev)
    ("\M-n"	. cvs-status-next)
    ("\M-p"	. cvs-status-prev)
Stefan Monnier's avatar
Stefan Monnier committed
50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
    ("t"	. cvs-status-cvstrees)
    ("T"	. cvs-status-trees))
  "CVS-Status' keymap."
  :group 'cvs-status
  :inherit 'cvs-mode-map)

;;(easy-menu-define cvs-status-menu cvs-status-mode-map
;;  "Menu for `cvs-status-mode'."
;;  '("CVS-Status"
;;    ["Show Tag Trees"	cvs-status-tree	t]
;;    ))

(defvar cvs-status-mode-hook nil
  "Hook run at the end of `cvs-status-mode'.")

(defconst cvs-status-tags-leader-re "^   Existing Tags:$")
66 67
(defconst cvs-status-entry-leader-re
  "^File:\\s-+\\(?:no file \\)?\\(.*\\S-\\)\\s-+Status: \\(.+\\)$")
Stefan Monnier's avatar
Stefan Monnier committed
68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87
(defconst cvs-status-dir-re "^cvs[.ex]* [a-z]+: Examining \\(.+\\)$")
(defconst cvs-status-rev-re "[0-9][.0-9]*\\.[.0-9]*[0-9]")
(defconst cvs-status-tag-re "[ \t]\\([a-zA-Z][^ \t\n.]*\\)")

(defconst cvs-status-font-lock-keywords
  `((,cvs-status-entry-leader-re
     (1 'cvs-filename-face)
     (2 'cvs-need-action-face))
    (,cvs-status-tags-leader-re
     (,cvs-status-rev-re
      (save-excursion (re-search-forward "^\n" nil 'move) (point))
      (progn (re-search-backward cvs-status-tags-leader-re nil t)
	     (forward-line 1))
      (0 font-lock-comment-face))
     (,cvs-status-tag-re
      (save-excursion (re-search-forward "^\n" nil 'move) (point))
      (progn (re-search-backward cvs-status-tags-leader-re nil t)
	     (forward-line 1))
      (1 font-lock-function-name-face)))))
(defconst cvs-status-font-lock-defaults
88
  '(cvs-status-font-lock-keywords t nil nil nil (font-lock-multiline . t)))
89

Stefan Monnier's avatar
Stefan Monnier committed
90 91 92

(put 'cvs-status-mode 'mode-class 'special)
;;;###autoload
93
(define-derived-mode cvs-status-mode fundamental-mode "CVS-Status"
Stefan Monnier's avatar
Stefan Monnier committed
94 95 96 97
  "Mode used for cvs status output."
  (set (make-local-variable 'font-lock-defaults) cvs-status-font-lock-defaults)
  (set (make-local-variable 'cvs-minor-wrap-function) 'cvs-status-minor-wrap))

98 99
;; Define cvs-status-next and cvs-status-prev
(easy-mmode-define-navigation cvs-status cvs-status-entry-leader-re "entry")
Stefan Monnier's avatar
Stefan Monnier committed
100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142

(defun cvs-status-current-file ()
  (save-excursion
    (forward-line 1)
    (or (re-search-backward cvs-status-entry-leader-re nil t)
	(re-search-forward cvs-status-entry-leader-re))
    (let* ((file (match-string 1))
	   (cvsdir (and (re-search-backward cvs-status-dir-re nil t)
			(match-string 1)))
	   (pcldir (and (re-search-backward cvs-pcl-cvs-dirchange-re nil t)
			(match-string 1)))
	   (dir ""))
      (let ((default-directory ""))
	(when pcldir (setq dir (expand-file-name pcldir dir)))
	(when cvsdir (setq dir (expand-file-name cvsdir dir)))
	(expand-file-name file dir)))))

(defun cvs-status-current-tag ()
  (save-excursion
    (let ((pt (point))
	  (col (current-column))
	  (start (progn (re-search-backward cvs-status-tags-leader-re nil t) (point)))
	  (end (progn (re-search-forward "^$" nil t) (point))))
      (when (and (< start pt) (> end pt))
	(goto-char pt)
	(end-of-line)
	(let ((tag nil) (dist pt) (end (point)))
	  (beginning-of-line)
	  (while (re-search-forward cvs-status-tag-re end t)
	    (let* ((cole (current-column))
		   (colb (save-excursion
			   (goto-char (match-beginning 1)) (current-column)))
		   (ndist (min (abs (- cole col)) (abs (- colb col)))))
	      (when (< ndist dist)
		(setq dist ndist)
		(setq tag (match-string 1)))))
	  tag)))))

(defun cvs-status-minor-wrap (buf f)
  (let ((data (with-current-buffer buf
		(cons
		 (cons (cvs-status-current-file)
		       (cvs-status-current-tag))
143
		 (when mark-active
Stefan Monnier's avatar
Stefan Monnier committed
144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220
		   (save-excursion
		     (goto-char (mark))
		     (cons (cvs-status-current-file)
			   (cvs-status-current-tag))))))))
    (let ((cvs-branch-prefix (cdar data))
	  (cvs-secondary-branch-prefix (and (cdar data) (cddr data)))
	  (cvs-minor-current-files
	   (cons (caar data)
		 (when (and (cadr data) (not (equal (caar data) (cadr data))))
		   (list (cadr data)))))
	  ;; FIXME:  I need to force because the fileinfos are UNKNOWN
	  (cvs-force-command "/F"))
      (funcall f))))

;;
;; Tagelt, tag element
;;

(defstruct (cvs-tag
	    (:constructor nil)
	    (:constructor cvs-tag-make
			  (vlist &optional name type))
	    (:conc-name cvs-tag->))
  vlist
  name
  type)

(defsubst cvs-status-vl-to-str (vl) (mapconcat 'number-to-string vl "."))

(defun cvs-tag->string (tag)
  (if (stringp tag) tag
    (let ((name (cvs-tag->name tag))
	   (vl (cvs-tag->vlist tag)))
      (if (null name) (cvs-status-vl-to-str vl)
	(let ((rev (if vl (concat " (" (cvs-status-vl-to-str vl) ")") "")))
	  (if (consp name) (mapcar (lambda (name) (concat name rev)) name)
	    (concat name rev)))))))

(defun cvs-tag-compare-1 (vl1 vl2)
  (cond
   ((and (null vl1) (null vl2)) 'equal)
   ((null vl1) 'more2)
   ((null vl2) 'more1)
   (t (let ((v1 (car vl1))
	    (v2 (car vl2)))
	(cond
	 ((> v1 v2) 'more1)
	 ((< v1 v2) 'more2)
	 (t (cvs-tag-compare-1 (cdr vl1) (cdr vl2))))))))

(defsubst cvs-tag-compare (tag1 tag2)
  (cvs-tag-compare-1 (cvs-tag->vlist tag1) (cvs-tag->vlist tag2)))

(defun cvs-tag-merge (tag1 tag2)
  "Merge TAG1 and TAG2 into one."
  (let ((type1 (cvs-tag->type tag1))
	(type2 (cvs-tag->type tag2))
	(name1 (cvs-tag->name tag1))
	(name2 (cvs-tag->name tag2)))
    (unless (equal (cvs-tag->vlist tag1) (cvs-tag->vlist tag2))
      (setf (cvs-tag->vlist tag1) nil))
    (if type1
	(unless (or (not type2) (equal type1 type2))
	  (setf (cvs-tag->type tag1) nil))
      (setf (cvs-tag->type tag1) type2))
    (if name1
	(setf (cvs-tag->name tag1) (cvs-append name1 name2))
      (setf (cvs-tag->name tag1) name2))
    tag1))

(defun cvs-tree-print (tags printer column)
  "Print the tree of TAGS where each tag's string is given by PRINTER.
PRINTER should accept both a tag (in which case it should return a string)
or a string (in which case it should simply return its argument).
A tag cannot be a CONS.  The return value can also be a list of strings,
if several nodes where merged into one.
The tree will be printed no closer than column COLUMN."
221

Stefan Monnier's avatar
Stefan Monnier committed
222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278
  (let* ((eol (save-excursion (end-of-line) (current-column)))
	 (column (max (+ eol 2) column)))
    (if (null tags) column
      ;;(move-to-column-force column)
      (let* ((rev (cvs-car tags))
	     (name (funcall printer (cvs-car rev)))
	     (rest (append (cvs-cdr name) (cvs-cdr tags)))
	     (prefix
	      (save-excursion
		(or (= (forward-line 1) 0) (insert "\n"))
		(cvs-tree-print rest printer column))))
	(assert (>= prefix column))
	(move-to-column prefix t)
	(assert (eolp))
	(insert (cvs-car name))
	(dolist (br (cvs-cdr rev))
	  (let* ((column (current-column))
		 (brrev (funcall printer (cvs-car br)))
		 (brlength (length (cvs-car brrev)))
		 (brfill (concat (make-string (/ brlength 2) ? ) "|"))
		 (prefix
		  (save-excursion
		    (insert " -- ")
		    (cvs-tree-print (cvs-append brrev brfill (cvs-cdr br))
				    printer (current-column)))))
	    (delete-region (save-excursion (move-to-column prefix) (point))
			   (point))
	    (insert " " (make-string (- prefix column 2) ?-) " ")
	    (end-of-line)))
	prefix))))

(defun cvs-tree-merge (tree1 tree2)
  "Merge tags trees TREE1 and TREE2 into one.
BEWARE:  because of stability issues, this is not a symetric operation."
  (assert (and (listp tree1) (listp tree2)))
  (cond
   ((null tree1) tree2)
   ((null tree2) tree1)
   (t
    (let* ((rev1 (car tree1))
	   (tag1 (cvs-car rev1))
	   (vl1 (cvs-tag->vlist tag1))
	   (l1 (length vl1))
	   (rev2 (car tree2))
	   (tag2 (cvs-car rev2))
	   (vl2 (cvs-tag->vlist tag2))
	   (l2 (length vl2)))
    (cond
     ((= l1 l2)
      (case (cvs-tag-compare tag1 tag2)
	(more1 (list* rev2 (cvs-tree-merge tree1 (cdr tree2))))
	(more2 (list* rev1 (cvs-tree-merge (cdr tree1) tree2)))
	(equal
	 (cons (cons (cvs-tag-merge tag1 tag2)
		     (cvs-tree-merge (cvs-cdr rev1) (cvs-cdr rev2)))
	       (cvs-tree-merge (cdr tree1) (cdr tree2))))))
     ((> l1 l2)
279 280
      (cvs-tree-merge
       (list (cons (cvs-tag-make (cvs-butlast vl1)) tree1)) tree2))
Stefan Monnier's avatar
Stefan Monnier committed
281
     ((< l1 l2)
282 283
      (cvs-tree-merge
       tree1 (list (cons (cvs-tag-make (cvs-butlast vl2)) tree2)))))))))
Stefan Monnier's avatar
Stefan Monnier committed
284 285

(defun cvs-tag-make-tag (tag)
286 287
  (let ((vl (mapcar 'string-to-number (split-string (nth 2 tag) "\\."))))
    (cvs-tag-make vl (nth 0 tag) (intern (nth 1 tag)))))
Stefan Monnier's avatar
Stefan Monnier committed
288 289 290 291

(defun cvs-tags->tree (tags)
  "Make a tree out of a list of TAGS."
  (let ((tags
292 293 294 295 296 297 298
	 (mapcar
	  (lambda (tag)
	    (let ((tag (cvs-tag-make-tag tag)))
	      (list (if (not (eq (cvs-tag->type tag) 'branch)) tag
		      (list (cvs-tag-make (cvs-butlast (cvs-tag->vlist tag)))
			    tag)))))
	  tags)))
Stefan Monnier's avatar
Stefan Monnier committed
299 300 301 302 303 304 305 306 307
    (while (cdr tags)
      (let (tl)
	(while tags
	  (push (cvs-tree-merge (pop tags) (pop tags)) tl))
	(setq tags (nreverse tl))))
    (car tags)))

(defun cvs-status-get-tags ()
  "Look for a list of tags, read them in and delete them.
Pavel Janík's avatar
Pavel Janík committed
308
Return nil if there was an empty list of tags and t if there wasn't
Stefan Monnier's avatar
Stefan Monnier committed
309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339
even a list.  Else, return the list of tags where each element of
the list is a three-string list TAG, KIND, REV."
  (let ((tags nil))
    (if (not (re-search-forward cvs-status-tags-leader-re nil t)) t
      (forward-char 1)
      (let ((pt (point))
	    (lastrev nil)
	    (case-fold-search t))
	(or
	 (looking-at "\\s-+no\\s-+tags")

	 (progn				; normal listing
	   (while (looking-at "^[ \t]+\\([^ \t\n]+\\)[ \t]+(\\([a-z]+\\): \\(.+\\))$")
	     (push (list (match-string 1) (match-string 2) (match-string 3)) tags)
	     (forward-line 1))
	   (unless (looking-at "^$") (setq tags nil) (goto-char pt))
	   tags)

	 (progn				; cvstree-style listing
	   (while (or (looking-at "^   .+\\(.\\)  \\([0-9.]+\\): \\([^\n\t .0-9][^\n\t ]*\\)?$")
		      (and lastrev
			   (looking-at "^   .+\\(\\)  \\(8\\)?  \\([^\n\t .0-9][^\n\t ]*\\)$")))
	     (setq lastrev (or (match-string 2) lastrev))
	     (push (list (match-string 3)
			 (if (equal (match-string 1) " ") "branch" "revision")
			 lastrev) tags)
	     (forward-line 1))
	   (unless (looking-at "^$") (setq tags nil) (goto-char pt))
	   (setq tags (nreverse tags)))

	 (progn				; new tree style listing
340
	   (let* ((re-lead "[ \t]*\\(-+\\)?\\(|\n?[ \t]+\\)*")
Stefan Monnier's avatar
Stefan Monnier committed
341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375
		  (re3 (concat re-lead "\\(\\.\\)?\\(" cvs-status-rev-re "\\)"))
		  (re2 (concat re-lead cvs-status-tag-re "\\(\\)"))
		  (re1 (concat re-lead cvs-status-tag-re
			       " (\\(" cvs-status-rev-re "\\))")))
	     (while (or (looking-at re1) (looking-at re2) (looking-at re3))
	       (push (list (match-string 3)
			   (if (match-string 1) "branch" "revision")
			   (match-string 4)) tags)
	       (goto-char (match-end 0))
	       (when (eolp) (forward-char 1))))
	   (unless (looking-at "^$") (setq tags nil) (goto-char pt))
	   (setq tags (nreverse tags))))

	(delete-region pt (point)))
      tags)))

(defvar font-lock-mode)
(defun cvs-refontify (beg end)
  (when (and (boundp 'font-lock-mode)
	     font-lock-mode
	     (fboundp 'font-lock-fontify-region))
    (font-lock-fontify-region (1- beg) (1+ end))))

(defun cvs-status-trees ()
  "Look for a lists of tags, and replace them with trees."
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (let ((inhibit-read-only t)
	  (tags nil))
      (while (listp (setq tags (cvs-status-get-tags)))
	;;(let ((pt (save-excursion (forward-line -1) (point))))
	  (save-restriction
	    (narrow-to-region (point) (point))
	    ;;(newline)
376 377
	    (combine-after-change-calls
	      (cvs-tree-print (cvs-tags->tree tags) 'cvs-tag->string 3)))
Stefan Monnier's avatar
Stefan Monnier committed
378
	  ;;(cvs-refontify pt (point))
379
	  ;;(sit-for 0)
Stefan Monnier's avatar
Stefan Monnier committed
380 381 382
	  ;;)
	  ))))

383
;;;;
Stefan Monnier's avatar
Stefan Monnier committed
384
;;;; CVSTree-style trees
385 386
;;;;

387 388 389 390 391 392
(defvar cvs-tree-use-jisx0208 nil)	;Old compat var.
(defvar cvs-tree-use-charset
  (cond
   (cvs-tree-use-jisx0208 'jisx0208)
   ((char-displayable-p ?) 'unicode)
   ((char-displayable-p (make-char 'japanese-jisx0208 40 44)) 'jisx0208))
393 394 395 396
  "*Non-nil if we should use the graphical glyphs from `japanese-jisx0208'.
Otherwise, default to ASCII chars like +, - and |.")

(defconst cvs-tree-char-space
397 398 399 400
  (case cvs-tree-use-charset
    (jisx0208 (make-char 'japanese-jisx0208 33 33))
    (unicode " ")
    (t "  ")))
401
(defconst cvs-tree-char-hbar
402 403 404 405
  (case cvs-tree-use-charset
    (jisx0208 (make-char 'japanese-jisx0208 40 44))
    (unicode "━")
    (t "--")))
406
(defconst cvs-tree-char-vbar
407 408 409 410
  (case cvs-tree-use-charset
    (jisx0208 (make-char 'japanese-jisx0208 40 45))
    (unicode "┃")
    (t "| ")))
411
(defconst cvs-tree-char-branch
412 413 414 415
  (case cvs-tree-use-charset
    (jisx0208 (make-char 'japanese-jisx0208 40 50))
    (unicode "┣")
    (t "+-")))
416
(defconst cvs-tree-char-eob		;end of branch
417 418 419 420
  (case cvs-tree-use-charset
    (jisx0208 (make-char 'japanese-jisx0208 40 49))
    (unicode "┗")
    (t "`-")))
421
(defconst cvs-tree-char-bob		;beginning of branch
422 423 424 425
  (case cvs-tree-use-charset
    (jisx0208 (make-char 'japanese-jisx0208 40 51))
    (unicode "┳")
    (t "+-")))
Stefan Monnier's avatar
Stefan Monnier committed
426 427 428 429

(defun cvs-tag-lessp (tag1 tag2)
  (eq (cvs-tag-compare tag1 tag2) 'more2))

430
(defvar cvs-tree-nomerge nil)
Stefan Monnier's avatar
Stefan Monnier committed
431 432 433 434 435

(defun cvs-status-cvstrees (&optional arg)
  "Look for a list of tags, and replace it with a tree.
Optional prefix ARG chooses between two representations."
  (interactive "P")
436
  (when (and cvs-tree-use-charset
437 438 439 440 441 442 443 444 445 446 447
	     (not enable-multibyte-characters))
    ;; We need to convert the buffer from unibyte to multibyte
    ;; since we'll use multibyte chars for the tree.
    (let ((modified (buffer-modified-p))
	  (inhibit-read-only t)
	  (inhibit-modification-hooks t))
      (unwind-protect
	  (progn
	    (decode-coding-region (point-min) (point-max) 'undecided)
	    (set-buffer-multibyte t))
	(restore-buffer-modified-p modified))))
Stefan Monnier's avatar
Stefan Monnier committed
448 449 450 451 452 453 454 455 456 457
  (save-excursion
    (goto-char (point-min))
    (let ((inhibit-read-only t)
	  (tags nil)
	  (cvs-tree-nomerge (if arg (not cvs-tree-nomerge) cvs-tree-nomerge)))
      (while (listp (setq tags (cvs-status-get-tags)))
	(let ((tags (mapcar 'cvs-tag-make-tag tags))
	      ;;(pt (save-excursion (forward-line -1) (point)))
	      )
	  (setq tags (sort tags 'cvs-tag-lessp))
Stefan Monnier's avatar
Stefan Monnier committed
458
	  (let* ((first (car tags))
Stefan Monnier's avatar
Stefan Monnier committed
459
		 (prev (if (cvs-tag-p first)
Stefan Monnier's avatar
Stefan Monnier committed
460
			   (list (car (cvs-tag->vlist first))) nil)))
461 462
	    (combine-after-change-calls
	      (cvs-tree-tags-insert tags prev))
Stefan Monnier's avatar
Stefan Monnier committed
463
	    ;;(cvs-refontify pt (point))
464 465
	    ;;(sit-for 0)
	    ))))))
Stefan Monnier's avatar
Stefan Monnier committed
466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496

(defun cvs-tree-tags-insert (tags prev)
  (when tags
    (let* ((tag (car tags))
	   (vlist (cvs-tag->vlist tag))
	   (nprev ;"next prev"
	    (let* ((next (cvs-car (cadr tags)))
		   (nprev (if (and cvs-tree-nomerge next
				   (equal vlist (cvs-tag->vlist next)))
			      prev vlist)))
	      (cvs-map (lambda (v p) v) nprev prev)))
	   (after (save-excursion
		   (newline)
		   (cvs-tree-tags-insert (cdr tags) nprev)))
	   (pe t)			;"prev equal"
	   (nas nil))			;"next afters" to be returned
      (insert "   ")
      (do* ((vs vlist (cdr vs))
	    (ps prev (cdr ps))
	    (as after (cdr as)))
	  ((and (null as) (null vs) (null ps))
	   (let ((revname (cvs-status-vl-to-str vlist)))
	     (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) "")))))
	(let* ((eq (and pe (equal (car ps) (car vs))))
	       (next-eq (equal (cadr ps) (cadr vs))))
	  (let* ((na+char
		  (if (car as)
		      (if eq
497 498 499
			  (if next-eq (cons t cvs-tree-char-vbar)
			    (cons t cvs-tree-char-branch))
			(cons nil cvs-tree-char-bob))
Stefan Monnier's avatar
Stefan Monnier committed
500
		    (if eq
501 502
			(if next-eq (cons nil cvs-tree-char-space)
			  (cons t cvs-tree-char-eob))
Stefan Monnier's avatar
Stefan Monnier committed
503 504
		      (cons nil (if (and (eq (cvs-tag->type tag) 'branch)
					 (cvs-every 'null as))
505 506
				    cvs-tree-char-space
				  cvs-tree-char-hbar))))))
Stefan Monnier's avatar
Stefan Monnier committed
507 508 509 510 511
	    (insert (cdr na+char))
	    (push (car na+char) nas))
	  (setq pe eq)))
      (nreverse nas))))

512
;;;;
Stefan Monnier's avatar
Stefan Monnier committed
513
;;;; Merged trees from different files
514
;;;;
Stefan Monnier's avatar
Stefan Monnier committed
515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533

(defun cvs-tree-fuzzy-merge-1 (trees tree prev)
  )

(defun cvs-tree-fuzzy-merge (trees tree)
  "Do the impossible:  merge TREE into TREES."
  ())

(defun cvs-tree ()
  "Get tags from the status output and merge tham all into a big tree."
  (save-excursion
    (goto-char (point-min))
    (let ((inhibit-read-only t)
	  (trees (make-vector 31 0)) tree)
      (while (listp (setq tree (cvs-tags->tree (cvs-status-get-tags))))
	(cvs-tree-fuzzy-merge trees tree))
      (erase-buffer)
      (let ((cvs-tag-print-rev nil))
	(cvs-tree-print tree 'cvs-tag->string 3)))))
534

Stefan Monnier's avatar
Stefan Monnier committed
535 536 537

(provide 'cvs-status)

Miles Bader's avatar
Miles Bader committed
538
;;; arch-tag: db8b5094-d02a-473e-a476-544e89ff5ad0
Stefan Monnier's avatar
Stefan Monnier committed
539
;;; cvs-status.el ends here