Mercurial > emacs

changeset 33231:c08a986392cd

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(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.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Mon, 06 Nov 2000 07:01:10 +0000
parents feebcbad81ae
children abfd948c10d4
files lisp/cvs-status.el
diffstat 1 files changed, 62 insertions(+), 48 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/cvs-status.el	Mon Nov 06 06:56:03 2000 +0000
+++ b/lisp/cvs-status.el	Mon Nov 06 07:01:10 2000 +0000
@@ -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 @@
 		     (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 @@
 (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 @@
 	   (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 @@
 	  (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
-;;;; 
+;;;;
+
+(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 |.")
 
-;; 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 "　" "  "))
-(defconst cvs-tree-dstr-char-hbar
-  (if cvs-tree-dstr-2byte-ready "━" "--"))
-(defconst cvs-tree-dstr-char-vbar
-  (if cvs-tree-dstr-2byte-ready "┃" "| "))
-(defconst cvs-tree-dstr-char-branch
-  (if cvs-tree-dstr-2byte-ready "┣" "+-"))
-(defconst cvs-tree-dstr-char-eob		;end of branch
-  (if cvs-tree-dstr-2byte-ready "┗" "`-"))
-(defconst cvs-tree-dstr-char-bob		;beginning of branch
-  (if cvs-tree-dstr-2byte-ready "┳" "+-"))
+(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 @@
   "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 @@
 	  (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 @@
 	  (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 @@
 
 ;;; 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 ***
 ;;