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

diff --git a/lisp/cvs-status.el b/lisp/cvs-status.el
index bed3b6185208f24ec67ab31c0a12b610c5baa47d..c13d1cb18f555775d1b57c7a36e567bcb8e1adaa 100644 (file)
--- a/lisp/cvs-status.el
+++ b/lisp/cvs-status.el
@@ -5,7 +5,7 @@
 ;; Author: Stefan Monnier <monnier@cs.yale.edu>
 ;; Keywords: pcl-cvs cvs status tree
 ;; Version: $Name:  $
-;; Revision: $Id: cvs-status.el,v 1.6 2000/08/16 20:46:32 monnier Exp $
+;; Revision: $Id: cvs-status.el,v 1.7 2000/09/29 02:19:10 monnier Exp $
 
 ;; This file is part of GNU Emacs.
 
@@ -28,7 +28,6 @@
 
 ;; Todo:
 
-;; - Rename to cvs-status-mode.el
 ;; - Somehow allow cvs-status-tree to work on-the-fly
 
 ;;; Code:
@@ -88,7 +87,7 @@
             (forward-line 1))
       (1 font-lock-function-name-face)))))
 (defconst cvs-status-font-lock-defaults
-  '(cvs-status-font-lock-keywords t nil nil nil))
+  '(cvs-status-font-lock-keywords t nil nil nil (font-lock-multiline . t)))
   
 
 (put 'cvs-status-mode 'mode-class 'special)
@@ -279,9 +278,11 @@ BEWARE:  because of stability issues, this is not a symetric operation."
                     (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 (butlast vl1)) tree1)) tree2))
+      (cvs-tree-merge
+       (list (cons (cvs-tag-make (cvs-butlast vl1)) tree1)) tree2))
      ((< l1 l2)
-      (cvs-tree-merge tree1 (list (cons (cvs-tag-make (butlast vl2)) tree2)))))))))
+      (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) "\\."))))
@@ -290,12 +291,13 @@ BEWARE:  because of stability issues, this is not a symetric operation."
 (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 (butlast (cvs-tag->vlist tag)))
-                                  tag)))))
-                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
@@ -337,7 +339,7 @@ the list is a three-string list TAG, KIND, REV."
           (setq tags (nreverse tags)))
 
         (progn                         ; new tree style listing
-          (let* ((re-lead "[ \t]*\\(-+\\)?\\(|\n?[ \t]+\\)?")
+          (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
@@ -373,39 +375,34 @@ the list is a three-string list TAG, KIND, REV."
          (save-restriction
            (narrow-to-region (point) (point))
            ;;(newline)
-           (cvs-tree-print (cvs-tags->tree tags) 'cvs-tag->string 3))
+           (combine-after-change-calls
+             (cvs-tree-print (cvs-tags->tree tags) 'cvs-tag->string 3)))
          ;;(cvs-refontify pt (point))
-         (sit-for 0)
+         ;;(sit-for 0)
          ;;)
          ))))
 
-;;;; 
+;;;;
 ;;;; CVSTree-style trees
-;;;; 
-
-;; chars sets.  Ripped from cvstree
-(defvar cvs-tree-dstr-2byte-ready
-  (when (featurep 'mule)
-      (if (boundp 'current-language-environment)
-         (string= current-language-environment "Japanese")
-       t))                             ; mule/emacs-19
-  "*Variable that specifies characters set used in cvstree tree graph.
-If non-nil, 2byte (Japanese?) characters set is used.
-If nil, 1byte characters set is used.
-2byte characters might be available with Mule or Emacs with Mule extension.")
-
-(defconst cvs-tree-dstr-char-space
-  (if cvs-tree-dstr-2byte-ready "\e$B!!\e(B" "  "))
-(defconst cvs-tree-dstr-char-hbar
-  (if cvs-tree-dstr-2byte-ready "\e$B(,\e(B" "--"))
-(defconst cvs-tree-dstr-char-vbar
-  (if cvs-tree-dstr-2byte-ready "\e$B(-\e(B" "| "))
-(defconst cvs-tree-dstr-char-branch
-  (if cvs-tree-dstr-2byte-ready "\e$B(2\e(B" "+-"))
-(defconst cvs-tree-dstr-char-eob               ;end of branch
-  (if cvs-tree-dstr-2byte-ready "\e$B(1\e(B" "`-"))
-(defconst cvs-tree-dstr-char-bob               ;beginning of branch
-  (if cvs-tree-dstr-2byte-ready "\e$B(3\e(B" "+-"))
+;;;;
+
+(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))
@@ -416,6 +413,18 @@ If nil, 1byte characters set is used.
   "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)
@@ -429,9 +438,11 @@ Optional prefix ARG chooses between two representations."
          (let* ((first (car tags))
                 (prev (if (cvs-tag-p first)
                           (list (car (cvs-tag->vlist first))) nil)))
-           (cvs-tree-tags-insert tags prev)
+           (combine-after-change-calls
+             (cvs-tree-tags-insert tags prev))
            ;;(cvs-refontify pt (point))
-           (sit-for 0)))))))
+           ;;(sit-for 0)
+           ))))))
 
 (defun cvs-tree-tags-insert (tags prev)
   (when tags
@@ -463,16 +474,16 @@ Optional prefix ARG chooses between two representations."
          (let* ((na+char
                  (if (car as)
                      (if eq
-                         (if next-eq (cons t cvs-tree-dstr-char-vbar)
-                           (cons t cvs-tree-dstr-char-branch))
-                       (cons nil cvs-tree-dstr-char-bob))
+                         (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-dstr-char-space)
-                         (cons t cvs-tree-dstr-char-eob))
+                       (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-dstr-char-space
-                                 cvs-tree-dstr-char-hbar))))))
+                                   cvs-tree-char-space
+                                 cvs-tree-char-hbar))))))
            (insert (cdr na+char))
            (push (car na+char) nas))
          (setq pe eq)))
@@ -506,6 +517,9 @@ Optional prefix ARG chooses between two representations."
 
 ;;; Change Log:
 ;; $Log: cvs-status.el,v $
+;; 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 ***
 ;;