X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/dedffa6a6bdfbfe6bb1257579734bc4467ebc7bc..4332cf50f7706567329dda631f9c6ff986f4edf5:/lisp/cvs-status.el diff --git a/lisp/cvs-status.el b/lisp/cvs-status.el index 4f46fb8c4f..477914293a 100644 --- a/lisp/cvs-status.el +++ b/lisp/cvs-status.el @@ -1,11 +1,10 @@ -;;; cvs-status.el --- Major mode for browsing `cvs status' output +;;; cvs-status.el --- major mode for browsing `cvs status' output -*- coding: utf-8 -*- -;; Copyright (C) 1999-2000 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2002, 2003, 2004, +;; 2005, 2006 Free Software Foundation, Inc. -;; Author: Stefan Monnier -;; Keywords: pcl-cvs cvs status tree -;; Version: $Name: $ -;; Revision: $Id: cvs-status.el,v 1.4 2000/05/10 22:08:28 monnier Exp $ +;; Author: Stefan Monnier +;; Keywords: pcl-cvs cvs status tree tools ;; This file is part of GNU Emacs. @@ -21,20 +20,20 @@ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; Todo: -;; - Rename to cvs-status-mode.el ;; - Somehow allow cvs-status-tree to work on-the-fly ;;; Code: (eval-when-compile (require 'cl)) (require 'pcvs-util) +(eval-when-compile (require 'pcvs)) ;;; @@ -51,7 +50,8 @@ ("\M-n" . cvs-status-next) ("\M-p" . cvs-status-prev) ("t" . cvs-status-cvstrees) - ("T" . cvs-status-trees)) + ("T" . cvs-status-trees) + (">" . cvs-mode-checkout)) "CVS-Status' keymap." :group 'cvs-status :inherit 'cvs-mode-map) @@ -66,15 +66,16 @@ "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-+\\)\\s-+Status: \\(.+\\)$") +(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)) + (1 'cvs-filename) + (2 'cvs-need-action)) (,cvs-status-tags-leader-re (,cvs-status-rev-re (save-excursion (re-search-forward "^\n" nil 'move) (point)) @@ -87,9 +88,9 @@ (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))) +(defvar cvs-minor-wrap-function) (put 'cvs-status-mode 'mode-class 'special) ;;;###autoload (define-derived-mode cvs-status-mode fundamental-mode "CVS-Status" @@ -108,7 +109,8 @@ (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) + (pcldir (and (if (boundp 'cvs-pcl-cvs-dirchange-re) + (re-search-backward cvs-pcl-cvs-dirchange-re nil t)) (match-string 1))) (dir "")) (let ((default-directory "")) @@ -220,7 +222,7 @@ 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 @@ -278,9 +280,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 (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 (butlast vl2)) tree2))))))))) (defun cvs-tag-make-tag (tag) (let ((vl (mapcar 'string-to-number (split-string (nth 2 tag) "\\.")))) @@ -289,12 +293,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 (butlast (cvs-tag->vlist tag))) + tag))))) + tags))) (while (cdr tags) (let (tl) (while tags @@ -304,7 +309,7 @@ BEWARE: because of stability issues, this is not a symetric operation." (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 +Return 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)) @@ -336,7 +341,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 @@ -372,39 +377,56 @@ 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 "$B!!(B" " ")) -(defconst cvs-tree-dstr-char-hbar - (if cvs-tree-dstr-2byte-ready "$B(,(B" "--")) -(defconst cvs-tree-dstr-char-vbar - (if cvs-tree-dstr-2byte-ready "$B(-(B" "| ")) -(defconst cvs-tree-dstr-char-branch - (if cvs-tree-dstr-2byte-ready "$B(2(B" "+-")) -(defconst cvs-tree-dstr-char-eob ;end of branch - (if cvs-tree-dstr-2byte-ready "$B(1(B" "`-")) -(defconst cvs-tree-dstr-char-bob ;beginning of branch - (if cvs-tree-dstr-2byte-ready "$B(3(B" "+-")) +;;;; + +(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)) + "*Non-nil if we should use the graphical glyphs from `japanese-jisx0208'. +Otherwise, default to ASCII chars like +, - and |.") + +(defconst cvs-tree-char-space + (case cvs-tree-use-charset + (jisx0208 (make-char 'japanese-jisx0208 33 33)) + (unicode " ") + (t " "))) +(defconst cvs-tree-char-hbar + (case cvs-tree-use-charset + (jisx0208 (make-char 'japanese-jisx0208 40 44)) + (unicode "━") + (t "--"))) +(defconst cvs-tree-char-vbar + (case cvs-tree-use-charset + (jisx0208 (make-char 'japanese-jisx0208 40 45)) + (unicode "┃") + (t "| "))) +(defconst cvs-tree-char-branch + (case cvs-tree-use-charset + (jisx0208 (make-char 'japanese-jisx0208 40 50)) + (unicode "┣") + (t "+-"))) +(defconst cvs-tree-char-eob ;end of branch + (case cvs-tree-use-charset + (jisx0208 (make-char 'japanese-jisx0208 40 49)) + (unicode "┗") + (t "`-"))) +(defconst cvs-tree-char-bob ;beginning of branch + (case cvs-tree-use-charset + (jisx0208 (make-char 'japanese-jisx0208 40 51)) + (unicode "┳") + (t "+-"))) (defun cvs-tag-lessp (tag1 tag2) (eq (cvs-tag-compare tag1 tag2) 'more2)) @@ -415,6 +437,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-charset + (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) @@ -425,12 +459,14 @@ Optional prefix ARG chooses between two representations." ;;(pt (save-excursion (forward-line -1) (point))) ) (setq tags (sort tags 'cvs-tag-lessp)) - (let* ((first (nth 0 tags)) + (let* ((first (car tags)) (prev (if (cvs-tag-p first) - (list (nth 0 (cvs-tag->vlist first))) nil))) - (cvs-tree-tags-insert tags prev) + (list (car (cvs-tag->vlist first))) nil))) + (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 @@ -462,24 +498,24 @@ 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))) (nreverse nas)))) -;;;; +;;;; ;;;; Merged trees from different files -;;;; +;;;; (defun cvs-tree-fuzzy-merge-1 (trees tree prev) ) @@ -499,23 +535,9 @@ Optional prefix ARG chooses between two representations." (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.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). -;; +(provide 'cvs-status) +;; arch-tag: db8b5094-d02a-473e-a476-544e89ff5ad0 ;;; cvs-status.el ends here