code.delx.au - gnu-emacs/blob - lisp/cvs-status.el

   1 ;;; cvs-status.el --- major mode for browsing `cvs status' output -*- coding: utf-8 -*-
   2
   3 ;; Copyright (C) 1999, 2000, 03, 2004  Free Software Foundation, Inc.
   4
   5 ;; Author: Stefan Monnier <monnier@cs.yale.edu>
   6 ;; Keywords: pcl-cvs cvs status tree tools
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; Todo:
  28
  29 ;; - Somehow allow cvs-status-tree to work on-the-fly
  30
  31 ;;; Code:
  32
  33 (eval-when-compile (require 'cl))
  34 (eval-when-compile (require 'pcvs))
  35 (require 'pcvs-util)
  36
  37 ;;;
  38
  39 (defgroup cvs-status nil
  40   "Major mode for browsing `cvs status' output."
  41   :group 'pcl-cvs
  42   :prefix "cvs-status-")
  43
  44 (easy-mmode-defmap cvs-status-mode-map
  45   '(("n"        . next-line)
  46     ("p"        . previous-line)
  47     ("N"        . cvs-status-next)
  48     ("P"        . cvs-status-prev)
  49     ("\M-n"     . cvs-status-next)
  50     ("\M-p"     . cvs-status-prev)
  51     ("t"        . cvs-status-cvstrees)
  52     ("T"        . cvs-status-trees)
  53     (">"        . cvs-status-checkout))
  54   "CVS-Status' keymap."
  55   :group 'cvs-status
  56   :inherit 'cvs-mode-map)
  57
  58 ;;(easy-menu-define cvs-status-menu cvs-status-mode-map
  59 ;;  "Menu for `cvs-status-mode'."
  60 ;;  '("CVS-Status"
  61 ;;    ["Show Tag Trees" cvs-status-tree t]
  62 ;;    ))
  63
  64 (defvar cvs-status-mode-hook nil
  65   "Hook run at the end of `cvs-status-mode'.")
  66
  67 (defconst cvs-status-tags-leader-re "^   Existing Tags:$")
  68 (defconst cvs-status-entry-leader-re
  69   "^File:\\s-+\\(?:no file \\)?\\(.*\\S-\\)\\s-+Status: \\(.+\\)$")
  70 (defconst cvs-status-dir-re "^cvs[.ex]* [a-z]+: Examining \\(.+\\)$")
  71 (defconst cvs-status-rev-re "[0-9][.0-9]*\\.[.0-9]*[0-9]")
  72 (defconst cvs-status-tag-re "[ \t]\\([a-zA-Z][^ \t\n.]*\\)")
  73
  74 (defconst cvs-status-font-lock-keywords
  75   `((,cvs-status-entry-leader-re
  76      (1 'cvs-filename-face)
  77      (2 'cvs-need-action-face))
  78     (,cvs-status-tags-leader-re
  79      (,cvs-status-rev-re
  80       (save-excursion (re-search-forward "^\n" nil 'move) (point))
  81       (progn (re-search-backward cvs-status-tags-leader-re nil t)
  82              (forward-line 1))
  83       (0 font-lock-comment-face))
  84      (,cvs-status-tag-re
  85       (save-excursion (re-search-forward "^\n" nil 'move) (point))
  86       (progn (re-search-backward cvs-status-tags-leader-re nil t)
  87              (forward-line 1))
  88       (1 font-lock-function-name-face)))))
  89 (defconst cvs-status-font-lock-defaults
  90   '(cvs-status-font-lock-keywords t nil nil nil (font-lock-multiline . t)))
  91
  92
  93 (put 'cvs-status-mode 'mode-class 'special)
  94 ;;;###autoload
  95 (define-derived-mode cvs-status-mode fundamental-mode "CVS-Status"
  96   "Mode used for cvs status output."
  97   (set (make-local-variable 'font-lock-defaults) cvs-status-font-lock-defaults)
  98   (set (make-local-variable 'cvs-minor-wrap-function) 'cvs-status-minor-wrap))
  99
 100 ;; Define cvs-status-next and cvs-status-prev
 101 (easy-mmode-define-navigation cvs-status cvs-status-entry-leader-re "entry")
 102
 103 (defun cvs-status-current-file ()
 104   (save-excursion
 105     (forward-line 1)
 106     (or (re-search-backward cvs-status-entry-leader-re nil t)
 107         (re-search-forward cvs-status-entry-leader-re))
 108     (let* ((file (match-string 1))
 109            (cvsdir (and (re-search-backward cvs-status-dir-re nil t)
 110                         (match-string 1)))
 111            (pcldir (and (re-search-backward cvs-pcl-cvs-dirchange-re nil t)
 112                         (match-string 1)))
 113            (dir ""))
 114       (let ((default-directory ""))
 115         (when pcldir (setq dir (expand-file-name pcldir dir)))
 116         (when cvsdir (setq dir (expand-file-name cvsdir dir)))
 117         (expand-file-name file dir)))))
 118
 119 (defun cvs-status-current-tag ()
 120   (save-excursion
 121     (let ((pt (point))
 122           (col (current-column))
 123           (start (progn (re-search-backward cvs-status-tags-leader-re nil t) (point)))
 124           (end (progn (re-search-forward "^$" nil t) (point))))
 125       (when (and (< start pt) (> end pt))
 126         (goto-char pt)
 127         (end-of-line)
 128         (let ((tag nil) (dist pt) (end (point)))
 129           (beginning-of-line)
 130           (while (re-search-forward cvs-status-tag-re end t)
 131             (let* ((cole (current-column))
 132                    (colb (save-excursion
 133                            (goto-char (match-beginning 1)) (current-column)))
 134                    (ndist (min (abs (- cole col)) (abs (- colb col)))))
 135               (when (< ndist dist)
 136                 (setq dist ndist)
 137                 (setq tag (match-string 1)))))
 138           tag)))))
 139
 140 (defun cvs-status-minor-wrap (buf f)
 141   (let ((data (with-current-buffer buf
 142                 (cons
 143                  (cons (cvs-status-current-file)
 144                        (cvs-status-current-tag))
 145                  (when mark-active
 146                    (save-excursion
 147                      (goto-char (mark))
 148                      (cons (cvs-status-current-file)
 149                            (cvs-status-current-tag))))))))
 150     (let ((cvs-branch-prefix (cdar data))
 151           (cvs-secondary-branch-prefix (and (cdar data) (cddr data)))
 152           (cvs-minor-current-files
 153            (cons (caar data)
 154                  (when (and (cadr data) (not (equal (caar data) (cadr data))))
 155                    (list (cadr data)))))
 156           ;; FIXME:  I need to force because the fileinfos are UNKNOWN
 157           (cvs-force-command "/F"))
 158       (funcall f))))
 159
 160 ;;
 161 ;; Tagelt, tag element
 162 ;;
 163
 164 (defstruct (cvs-tag
 165             (:constructor nil)
 166             (:constructor cvs-tag-make
 167                           (vlist &optional name type))
 168             (:conc-name cvs-tag->))
 169   vlist
 170   name
 171   type)
 172
 173 (defsubst cvs-status-vl-to-str (vl) (mapconcat 'number-to-string vl "."))
 174
 175 (defun cvs-tag->string (tag)
 176   (if (stringp tag) tag
 177     (let ((name (cvs-tag->name tag))
 178            (vl (cvs-tag->vlist tag)))
 179       (if (null name) (cvs-status-vl-to-str vl)
 180         (let ((rev (if vl (concat " (" (cvs-status-vl-to-str vl) ")") "")))
 181           (if (consp name) (mapcar (lambda (name) (concat name rev)) name)
 182             (concat name rev)))))))
 183
 184 (defun cvs-tag-compare-1 (vl1 vl2)
 185   (cond
 186    ((and (null vl1) (null vl2)) 'equal)
 187    ((null vl1) 'more2)
 188    ((null vl2) 'more1)
 189    (t (let ((v1 (car vl1))
 190             (v2 (car vl2)))
 191         (cond
 192          ((> v1 v2) 'more1)
 193          ((< v1 v2) 'more2)
 194          (t (cvs-tag-compare-1 (cdr vl1) (cdr vl2))))))))
 195
 196 (defsubst cvs-tag-compare (tag1 tag2)
 197   (cvs-tag-compare-1 (cvs-tag->vlist tag1) (cvs-tag->vlist tag2)))
 198
 199 (defun cvs-tag-merge (tag1 tag2)
 200   "Merge TAG1 and TAG2 into one."
 201   (let ((type1 (cvs-tag->type tag1))
 202         (type2 (cvs-tag->type tag2))
 203         (name1 (cvs-tag->name tag1))
 204         (name2 (cvs-tag->name tag2)))
 205     (unless (equal (cvs-tag->vlist tag1) (cvs-tag->vlist tag2))
 206       (setf (cvs-tag->vlist tag1) nil))
 207     (if type1
 208         (unless (or (not type2) (equal type1 type2))
 209           (setf (cvs-tag->type tag1) nil))
 210       (setf (cvs-tag->type tag1) type2))
 211     (if name1
 212         (setf (cvs-tag->name tag1) (cvs-append name1 name2))
 213       (setf (cvs-tag->name tag1) name2))
 214     tag1))
 215
 216 (defun cvs-tree-print (tags printer column)
 217   "Print the tree of TAGS where each tag's string is given by PRINTER.
 218 PRINTER should accept both a tag (in which case it should return a string)
 219 or a string (in which case it should simply return its argument).
 220 A tag cannot be a CONS.  The return value can also be a list of strings,
 221 if several nodes where merged into one.
 222 The tree will be printed no closer than column COLUMN."
 223
 224   (let* ((eol (save-excursion (end-of-line) (current-column)))
 225          (column (max (+ eol 2) column)))
 226     (if (null tags) column
 227       ;;(move-to-column-force column)
 228       (let* ((rev (cvs-car tags))
 229              (name (funcall printer (cvs-car rev)))
 230              (rest (append (cvs-cdr name) (cvs-cdr tags)))
 231              (prefix
 232               (save-excursion
 233                 (or (= (forward-line 1) 0) (insert "\n"))
 234                 (cvs-tree-print rest printer column))))
 235         (assert (>= prefix column))
 236         (move-to-column prefix t)
 237         (assert (eolp))
 238         (insert (cvs-car name))
 239         (dolist (br (cvs-cdr rev))
 240           (let* ((column (current-column))
 241                  (brrev (funcall printer (cvs-car br)))
 242                  (brlength (length (cvs-car brrev)))
 243                  (brfill (concat (make-string (/ brlength 2) ? ) "|"))
 244                  (prefix
 245                   (save-excursion
 246                     (insert " -- ")
 247                     (cvs-tree-print (cvs-append brrev brfill (cvs-cdr br))
 248                                     printer (current-column)))))
 249             (delete-region (save-excursion (move-to-column prefix) (point))
 250                            (point))
 251             (insert " " (make-string (- prefix column 2) ?-) " ")
 252             (end-of-line)))
 253         prefix))))
 254
 255 (defun cvs-tree-merge (tree1 tree2)
 256   "Merge tags trees TREE1 and TREE2 into one.
 257 BEWARE:  because of stability issues, this is not a symetric operation."
 258   (assert (and (listp tree1) (listp tree2)))
 259   (cond
 260    ((null tree1) tree2)
 261    ((null tree2) tree1)
 262    (t
 263     (let* ((rev1 (car tree1))
 264            (tag1 (cvs-car rev1))
 265            (vl1 (cvs-tag->vlist tag1))
 266            (l1 (length vl1))
 267            (rev2 (car tree2))
 268            (tag2 (cvs-car rev2))
 269            (vl2 (cvs-tag->vlist tag2))
 270            (l2 (length vl2)))
 271     (cond
 272      ((= l1 l2)
 273       (case (cvs-tag-compare tag1 tag2)
 274         (more1 (list* rev2 (cvs-tree-merge tree1 (cdr tree2))))
 275         (more2 (list* rev1 (cvs-tree-merge (cdr tree1) tree2)))
 276         (equal
 277          (cons (cons (cvs-tag-merge tag1 tag2)
 278                      (cvs-tree-merge (cvs-cdr rev1) (cvs-cdr rev2)))
 279                (cvs-tree-merge (cdr tree1) (cdr tree2))))))
 280      ((> l1 l2)
 281       (cvs-tree-merge
 282        (list (cons (cvs-tag-make (butlast vl1)) tree1)) tree2))
 283      ((< l1 l2)
 284       (cvs-tree-merge
 285        tree1 (list (cons (cvs-tag-make (butlast vl2)) tree2)))))))))
 286
 287 (defun cvs-tag-make-tag (tag)
 288   (let ((vl (mapcar 'string-to-number (split-string (nth 2 tag) "\\."))))
 289     (cvs-tag-make vl (nth 0 tag) (intern (nth 1 tag)))))
 290
 291 (defun cvs-tags->tree (tags)
 292   "Make a tree out of a list of TAGS."
 293   (let ((tags
 294          (mapcar
 295           (lambda (tag)
 296             (let ((tag (cvs-tag-make-tag tag)))
 297               (list (if (not (eq (cvs-tag->type tag) 'branch)) tag
 298                       (list (cvs-tag-make (butlast (cvs-tag->vlist tag)))
 299                             tag)))))
 300           tags)))
 301     (while (cdr tags)
 302       (let (tl)
 303         (while tags
 304           (push (cvs-tree-merge (pop tags) (pop tags)) tl))
 305         (setq tags (nreverse tl))))
 306     (car tags)))
 307
 308 (defun cvs-status-get-tags ()
 309   "Look for a list of tags, read them in and delete them.
 310 Return nil if there was an empty list of tags and t if there wasn't
 311 even a list.  Else, return the list of tags where each element of
 312 the list is a three-string list TAG, KIND, REV."
 313   (let ((tags nil))
 314     (if (not (re-search-forward cvs-status-tags-leader-re nil t)) t
 315       (forward-char 1)
 316       (let ((pt (point))
 317             (lastrev nil)
 318             (case-fold-search t))
 319         (or
 320          (looking-at "\\s-+no\\s-+tags")
 321
 322          (progn                         ; normal listing
 323            (while (looking-at "^[ \t]+\\([^ \t\n]+\\)[ \t]+(\\([a-z]+\\): \\(.+\\))$")
 324              (push (list (match-string 1) (match-string 2) (match-string 3)) tags)
 325              (forward-line 1))
 326            (unless (looking-at "^$") (setq tags nil) (goto-char pt))
 327            tags)
 328
 329          (progn                         ; cvstree-style listing
 330            (while (or (looking-at "^   .+\\(.\\)  \\([0-9.]+\\): \\([^\n\t .0-9][^\n\t ]*\\)?$")
 331                       (and lastrev
 332                            (looking-at "^   .+\\(\\)  \\(8\\)?  \\([^\n\t .0-9][^\n\t ]*\\)$")))
 333              (setq lastrev (or (match-string 2) lastrev))
 334              (push (list (match-string 3)
 335                          (if (equal (match-string 1) " ") "branch" "revision")
 336                          lastrev) tags)
 337              (forward-line 1))
 338            (unless (looking-at "^$") (setq tags nil) (goto-char pt))
 339            (setq tags (nreverse tags)))
 340
 341          (progn                         ; new tree style listing
 342            (let* ((re-lead "[ \t]*\\(-+\\)?\\(|\n?[ \t]+\\)*")
 343                   (re3 (concat re-lead "\\(\\.\\)?\\(" cvs-status-rev-re "\\)"))
 344                   (re2 (concat re-lead cvs-status-tag-re "\\(\\)"))
 345                   (re1 (concat re-lead cvs-status-tag-re
 346                                " (\\(" cvs-status-rev-re "\\))")))
 347              (while (or (looking-at re1) (looking-at re2) (looking-at re3))
 348                (push (list (match-string 3)
 349                            (if (match-string 1) "branch" "revision")
 350                            (match-string 4)) tags)
 351                (goto-char (match-end 0))
 352                (when (eolp) (forward-char 1))))
 353            (unless (looking-at "^$") (setq tags nil) (goto-char pt))
 354            (setq tags (nreverse tags))))
 355
 356         (delete-region pt (point)))
 357       tags)))
 358
 359 (defvar font-lock-mode)
 360 (defun cvs-refontify (beg end)
 361   (when (and (boundp 'font-lock-mode)
 362              font-lock-mode
 363              (fboundp 'font-lock-fontify-region))
 364     (font-lock-fontify-region (1- beg) (1+ end))))
 365
 366 (defun cvs-status-trees ()
 367   "Look for a lists of tags, and replace them with trees."
 368   (interactive)
 369   (save-excursion
 370     (goto-char (point-min))
 371     (let ((inhibit-read-only t)
 372           (tags nil))
 373       (while (listp (setq tags (cvs-status-get-tags)))
 374         ;;(let ((pt (save-excursion (forward-line -1) (point))))
 375           (save-restriction
 376             (narrow-to-region (point) (point))
 377             ;;(newline)
 378             (combine-after-change-calls
 379               (cvs-tree-print (cvs-tags->tree tags) 'cvs-tag->string 3)))
 380           ;;(cvs-refontify pt (point))
 381           ;;(sit-for 0)
 382           ;;)
 383           ))))
 384
 385 ;;;;
 386 ;;;; CVSTree-style trees
 387 ;;;;
 388
 389 (defvar cvs-tree-use-jisx0208 nil)      ;Old compat var.
 390 (defvar cvs-tree-use-charset
 391   (cond
 392    (cvs-tree-use-jisx0208 'jisx0208)
 393    ((char-displayable-p ?━) 'unicode)
 394    ((char-displayable-p (make-char 'japanese-jisx0208 40 44)) 'jisx0208))
 395   "*Non-nil if we should use the graphical glyphs from `japanese-jisx0208'.
 396 Otherwise, default to ASCII chars like +, - and |.")
 397
 398 (defconst cvs-tree-char-space
 399   (case cvs-tree-use-charset
 400     (jisx0208 (make-char 'japanese-jisx0208 33 33))
 401     (unicode " ")
 402     (t "  ")))
 403 (defconst cvs-tree-char-hbar
 404   (case cvs-tree-use-charset
 405     (jisx0208 (make-char 'japanese-jisx0208 40 44))
 406     (unicode "━")
 407     (t "--")))
 408 (defconst cvs-tree-char-vbar
 409   (case cvs-tree-use-charset
 410     (jisx0208 (make-char 'japanese-jisx0208 40 45))
 411     (unicode "┃")
 412     (t "| ")))
 413 (defconst cvs-tree-char-branch
 414   (case cvs-tree-use-charset
 415     (jisx0208 (make-char 'japanese-jisx0208 40 50))
 416     (unicode "┣")
 417     (t "+-")))
 418 (defconst cvs-tree-char-eob             ;end of branch
 419   (case cvs-tree-use-charset
 420     (jisx0208 (make-char 'japanese-jisx0208 40 49))
 421     (unicode "┗")
 422     (t "`-")))
 423 (defconst cvs-tree-char-bob             ;beginning of branch
 424   (case cvs-tree-use-charset
 425     (jisx0208 (make-char 'japanese-jisx0208 40 51))
 426     (unicode "┳")
 427     (t "+-")))
 428
 429 (defun cvs-tag-lessp (tag1 tag2)
 430   (eq (cvs-tag-compare tag1 tag2) 'more2))
 431
 432 (defvar cvs-tree-nomerge nil)
 433
 434 (defun cvs-status-cvstrees (&optional arg)
 435   "Look for a list of tags, and replace it with a tree.
 436 Optional prefix ARG chooses between two representations."
 437   (interactive "P")
 438   (when (and cvs-tree-use-charset
 439              (not enable-multibyte-characters))
 440     ;; We need to convert the buffer from unibyte to multibyte
 441     ;; since we'll use multibyte chars for the tree.
 442     (let ((modified (buffer-modified-p))
 443           (inhibit-read-only t)
 444           (inhibit-modification-hooks t))
 445       (unwind-protect
 446           (progn
 447             (decode-coding-region (point-min) (point-max) 'undecided)
 448             (set-buffer-multibyte t))
 449         (restore-buffer-modified-p modified))))
 450   (save-excursion
 451     (goto-char (point-min))
 452     (let ((inhibit-read-only t)
 453           (tags nil)
 454           (cvs-tree-nomerge (if arg (not cvs-tree-nomerge) cvs-tree-nomerge)))
 455       (while (listp (setq tags (cvs-status-get-tags)))
 456         (let ((tags (mapcar 'cvs-tag-make-tag tags))
 457               ;;(pt (save-excursion (forward-line -1) (point)))
 458               )
 459           (setq tags (sort tags 'cvs-tag-lessp))
 460           (let* ((first (car tags))
 461                  (prev (if (cvs-tag-p first)
 462                            (list (car (cvs-tag->vlist first))) nil)))
 463             (combine-after-change-calls
 464               (cvs-tree-tags-insert tags prev))
 465             ;;(cvs-refontify pt (point))
 466             ;;(sit-for 0)
 467             ))))))
 468
 469 (defun-cvs-mode (cvs-status-checkout . NOARGS) (dir)
 470   "Run cvs-checkout against the tag under the point.
 471 The files are stored to DIR."
 472   (interactive
 473    (let* ((module (cvs-get-module))
 474           (branch (cvs-prefix-get 'cvs-branch-prefix))
 475           (prompt (format "CVS Checkout Directory for `%s%s': "
 476                          module
 477                          (if branch (format "(branch: %s)" branch)
 478                            ""))))
 479      (list
 480       (read-directory-name prompt
 481                            nil default-directory nil))))
 482   (let ((modules (cvs-string->strings (cvs-get-module)))
 483         (flags (cvs-add-branch-prefix
 484                 (cvs-flags-query 'cvs-checkout-flags "cvs checkout flags")))
 485         (cvs-cvsroot (cvs-get-cvsroot)))
 486     (cvs-checkout modules dir flags)))
 487
 488 (defun cvs-tree-tags-insert (tags prev)
 489   (when tags
 490     (let* ((tag (car tags))
 491            (vlist (cvs-tag->vlist tag))
 492            (nprev ;"next prev"
 493             (let* ((next (cvs-car (cadr tags)))
 494                    (nprev (if (and cvs-tree-nomerge next
 495                                    (equal vlist (cvs-tag->vlist next)))
 496                               prev vlist)))
 497               (cvs-map (lambda (v p) v) nprev prev)))
 498            (after (save-excursion
 499                    (newline)
 500                    (cvs-tree-tags-insert (cdr tags) nprev)))
 501            (pe t)                       ;"prev equal"
 502            (nas nil))                   ;"next afters" to be returned
 503       (insert "   ")
 504       (do* ((vs vlist (cdr vs))
 505             (ps prev (cdr ps))
 506             (as after (cdr as)))
 507           ((and (null as) (null vs) (null ps))
 508            (let ((revname (cvs-status-vl-to-str vlist)))
 509              (if (cvs-every 'identity (cvs-map 'equal prev vlist))
 510                  (insert (make-string (+ 4 (length revname)) ? )
 511                          (or (cvs-tag->name tag) ""))
 512                (insert "  " revname ": " (or (cvs-tag->name tag) "")))))
 513         (let* ((eq (and pe (equal (car ps) (car vs))))
 514                (next-eq (equal (cadr ps) (cadr vs))))
 515           (let* ((na+char
 516                   (if (car as)
 517                       (if eq
 518                           (if next-eq (cons t cvs-tree-char-vbar)
 519                             (cons t cvs-tree-char-branch))
 520                         (cons nil cvs-tree-char-bob))
 521                     (if eq
 522                         (if next-eq (cons nil cvs-tree-char-space)
 523                           (cons t cvs-tree-char-eob))
 524                       (cons nil (if (and (eq (cvs-tag->type tag) 'branch)
 525                                          (cvs-every 'null as))
 526                                     cvs-tree-char-space
 527                                   cvs-tree-char-hbar))))))
 528             (insert (cdr na+char))
 529             (push (car na+char) nas))
 530           (setq pe eq)))
 531       (nreverse nas))))
 532
 533 ;;;;
 534 ;;;; Merged trees from different files
 535 ;;;;
 536
 537 (defun cvs-tree-fuzzy-merge-1 (trees tree prev)
 538   )
 539
 540 (defun cvs-tree-fuzzy-merge (trees tree)
 541   "Do the impossible:  merge TREE into TREES."
 542   ())
 543
 544 (defun cvs-tree ()
 545   "Get tags from the status output and merge tham all into a big tree."
 546   (save-excursion
 547     (goto-char (point-min))
 548     (let ((inhibit-read-only t)
 549           (trees (make-vector 31 0)) tree)
 550       (while (listp (setq tree (cvs-tags->tree (cvs-status-get-tags))))
 551         (cvs-tree-fuzzy-merge trees tree))
 552       (erase-buffer)
 553       (let ((cvs-tag-print-rev nil))
 554         (cvs-tree-print tree 'cvs-tag->string 3)))))
 555
 556
 557 (provide 'cvs-status)
 558
 559 ;;; arch-tag: db8b5094-d02a-473e-a476-544e89ff5ad0
 560 ;;; cvs-status.el ends here