[bpt/emacs.git] / lisp / cvs-status.el

;;; cvs-status.el --- Major mode for browsing `cvs status' output

;; Copyright (C) 1999, 2000  Free Software Foundation, Inc.

;; Author: Stefan Monnier <monnier@cs.yale.edu>
;; Keywords: pcl-cvs cvs status tree
;; Revision: $Id: cvs-status.el,v 1.9 2000/12/06 19:50:12 fx Exp $

;; 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)
    ("N"	. cvs-status-next)
    ("P"	. cvs-status-prev)
    ("\M-n"	. cvs-status-next)
    ("\M-p"	. cvs-status-prev)
    ("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:$")
(defconst cvs-status-entry-leader-re
  "^File:\\s-+\\(?:no file \\)?\\(.*\\S-\\)\\s-+Status: \\(.+\\)$")
(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
  '(cvs-status-font-lock-keywords t nil nil nil (font-lock-multiline . t)))
  

(put 'cvs-status-mode 'mode-class 'special)
;;;###autoload
(define-derived-mode cvs-status-mode fundamental-mode "CVS-Status"
  "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))

;; Define cvs-status-next and cvs-status-prev
(easy-mmode-define-navigation cvs-status cvs-status-entry-leader-re "entry")

(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))
		 (when mark-active
		   (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."
  
  (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)
      (cvs-tree-merge
       (list (cons (cvs-tag-make (cvs-butlast vl1)) tree1)) tree2))
     ((< l1 l2)
      (cvs-tree-merge
       tree1 (list (cons (cvs-tag-make (cvs-butlast vl2)) tree2)))))))))

(defun cvs-tag-make-tag (tag)
  (let ((vl (mapcar 'string-to-number (split-string (nth 2 tag) "\\."))))
    (cvs-tag-make vl (nth 0 tag) (intern (nth 1 tag)))))

(defun cvs-tags->tree (tags)
  "Make a tree out of a list of TAGS."
  (let ((tags
	 (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)))
    (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.
Returns NIL if there was an empty list of tags and T if there wasn't
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
	   (let* ((re-lead "[ \t]*\\(-+\\)?\\(|\n?[ \t]+\\)*")
		  (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)
	    (combine-after-change-calls
	      (cvs-tree-print (cvs-tags->tree tags) 'cvs-tag->string 3)))
	  ;;(cvs-refontify pt (point))
	  ;;(sit-for 0)
	  ;;)
	  ))))

;;;;
;;;; CVSTree-style trees
;;;;

(defvar cvs-tree-use-jisx0208
  nil ;; (and (char-display-font 'japanese-jisx0208) t)
  "*Non-nil if we should use the graphical glyphs from `japanese-jisx0208'.
Otherwise, default to ASCII chars like +, - and |.")

(defconst cvs-tree-char-space
  (if cvs-tree-use-jisx0208 (make-char 'japanese-jisx0208 33 33) "  "))
(defconst cvs-tree-char-hbar
  (if cvs-tree-use-jisx0208 (make-char 'japanese-jisx0208 40 44) "--"))
(defconst cvs-tree-char-vbar
  (if cvs-tree-use-jisx0208 (make-char 'japanese-jisx0208 40 45) "| "))
(defconst cvs-tree-char-branch
  (if cvs-tree-use-jisx0208 (make-char 'japanese-jisx0208 40 50) "+-"))
(defconst cvs-tree-char-eob		;end of branch
  (if cvs-tree-use-jisx0208 (make-char 'japanese-jisx0208 40 49) "`-"))
(defconst cvs-tree-char-bob		;beginning of branch
  (if cvs-tree-use-jisx0208 (make-char 'japanese-jisx0208 40 51) "+-"))

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

(defvar cvs-tree-nomerge nil)

(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")
  (when (and cvs-tree-use-jisx0208
	     (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))))
  (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))
	  (let* ((first (car tags))
		 (prev (if (cvs-tag-p first)
			   (list (car (cvs-tag->vlist first))) nil)))
	    (combine-after-change-calls
	      (cvs-tree-tags-insert tags prev))
	    ;;(cvs-refontify pt (point))
	    ;;(sit-for 0)
	    ))))))

(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
			  (if next-eq (cons t cvs-tree-char-vbar)
			    (cons t cvs-tree-char-branch))
			(cons nil cvs-tree-char-bob))
		    (if eq
			(if next-eq (cons nil cvs-tree-char-space)
			  (cons t cvs-tree-char-eob))
		      (cons nil (if (and (eq (cvs-tag->type tag) 'branch)
					 (cvs-every 'null as))
				    cvs-tree-char-space
				  cvs-tree-char-hbar))))))
	    (insert (cdr na+char))
	    (push (car na+char) nas))
	  (setq pe eq)))
      (nreverse nas))))

;;;; 
;;;; Merged trees from different files
;;;; 

(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)))))
      

(provide 'cvs-status)

;;; Change Log:
;; $Log: cvs-status.el,v $
;; Revision 1.9  2000/12/06 19:50:12  fx
;; Fix copyright years.
;;
;; Revision 1.8  2000/11/06 07:01:10  monnier
;; (cvs-tree-merge): Use cvs-butlast (avoid CL).
;; (cvs-status-get-tags): Fix regexp.
;; (cvs-status-trees, cvs-status-cvstrees):
;; Combine after change hooks and don't sit-for.
;; (cvs-tree-use-jisx0208): Renamed from cvs-tree-dstr-2byte-ready.
;; (cvs-tree-char-*): Renamed from cvs-tree-dstr-char-*.
;; Use make-char rather than hard-coded cryptic data.
;; (cvs-status-cvstrees): Convert the buffer to multibyte if necessary.
;;
;; Revision 1.7  2000/09/29 02:19:10  monnier
;; (cvs-status-entry-leader-re): Minor fix.
;;
;; Revision 1.6  2000/08/16 20:46:32  monnier
;; *** empty log message ***
;;
;; Revision 1.5  2000/08/06 09:18:02  gerd
;; Use `nth' instead of `first', `second', and `third'.
;;
;; Revision 1.4  2000/05/10 22:08:28  monnier
;; (cvs-status-minor-wrap): Use mark-active.
;;
;; Revision 1.3  2000/03/22 01:08:08  monnier
;; (cvs-status-mode): Use define-derived-mode.
;;
;; Revision 1.2  2000/03/22 01:01:36  monnier
;; (cvs-status-(prev|next)): Rename from
;; cvs-status-(prev|next)-entry and use easy-mmode-define-navigation.
;; (cvs-tree-dstr-*): Rename from cvstree-dstr-* and use two ascii chars
;; to let the output "breathe" a little more (more readable).
;;

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