X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/06d8ace51597cd41e110560a56a1abeb6cce23d6..7c6fc37fa9a78a7a02f3f0ccb46a95c20fe315b4:/lisp/vc/cvs-status.el diff --git a/lisp/vc/cvs-status.el b/lisp/vc/cvs-status.el index 11190f03ef..10cff7b040 100644 --- a/lisp/vc/cvs-status.el +++ b/lisp/vc/cvs-status.el @@ -1,7 +1,6 @@ -;;; cvs-status.el --- major mode for browsing `cvs status' output -*- coding: utf-8 -*- +;;; cvs-status.el --- major mode for browsing `cvs status' output -*- coding: utf-8; lexical-binding: t -*- -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1999-2014 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Keywords: pcl-cvs cvs status tree vc tools @@ -29,7 +28,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'pcvs-util) ;;; @@ -88,6 +87,12 @@ '(cvs-status-font-lock-keywords t nil nil nil (font-lock-multiline . t))) (defvar cvs-minor-wrap-function) +(defvar cvs-force-command) +(defvar cvs-minor-current-files) +(defvar cvs-secondary-branch-prefix) +(defvar cvs-branch-prefix) +(defvar cvs-tag-print-rev) + (put 'cvs-status-mode 'mode-class 'special) ;;;###autoload (define-derived-mode cvs-status-mode fundamental-mode "CVS-Status" @@ -160,7 +165,7 @@ ;; Tagelt, tag element ;; -(defstruct (cvs-tag +(cl-defstruct (cvs-tag (:constructor nil) (:constructor cvs-tag-make (vlist &optional name type)) @@ -230,9 +235,9 @@ The tree will be printed no closer than column COLUMN." (save-excursion (or (= (forward-line 1) 0) (insert "\n")) (cvs-tree-print rest printer column)))) - (assert (>= prefix column)) + (cl-assert (>= prefix column)) (move-to-column prefix t) - (assert (eolp)) + (cl-assert (eolp)) (insert (cvs-car name)) (dolist (br (cvs-cdr rev)) (let* ((column (current-column)) @@ -252,8 +257,8 @@ The tree will be printed no closer than column COLUMN." (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))) +BEWARE: because of stability issues, this is not a symmetric operation." + (cl-assert (and (listp tree1) (listp tree2))) (cond ((null tree1) tree2) ((null tree2) tree1) @@ -268,10 +273,10 @@ BEWARE: because of stability issues, this is not a symetric operation." (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 + (pcase (cvs-tag-compare tag1 tag2) + (`more1 (cons rev2 (cvs-tree-merge tree1 (cdr tree2)))) + (`more2 (cons 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)))))) @@ -390,39 +395,39 @@ the list is a three-string list TAG, KIND, REV." (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'. + "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 " "))) + (pcase cvs-tree-use-charset + (`jisx0208 (make-char 'japanese-jisx0208 33 33)) + (`unicode " ") + (_ " "))) (defconst cvs-tree-char-hbar - (case cvs-tree-use-charset - (jisx0208 (make-char 'japanese-jisx0208 40 44)) - (unicode "━") - (t "--"))) + (pcase cvs-tree-use-charset + (`jisx0208 (make-char 'japanese-jisx0208 40 44)) + (`unicode "━") + (_ "--"))) (defconst cvs-tree-char-vbar - (case cvs-tree-use-charset - (jisx0208 (make-char 'japanese-jisx0208 40 45)) - (unicode "┃") - (t "| "))) + (pcase cvs-tree-use-charset + (`jisx0208 (make-char 'japanese-jisx0208 40 45)) + (`unicode "┃") + (_ "| "))) (defconst cvs-tree-char-branch - (case cvs-tree-use-charset - (jisx0208 (make-char 'japanese-jisx0208 40 50)) - (unicode "┣") - (t "+-"))) + (pcase cvs-tree-use-charset + (`jisx0208 (make-char 'japanese-jisx0208 40 50)) + (`unicode "┣") + (_ "+-"))) (defconst cvs-tree-char-eob ;end of branch - (case cvs-tree-use-charset - (jisx0208 (make-char 'japanese-jisx0208 40 49)) - (unicode "┗") - (t "`-"))) + (pcase cvs-tree-use-charset + (`jisx0208 (make-char 'japanese-jisx0208 40 49)) + (`unicode "┗") + (_ "`-"))) (defconst cvs-tree-char-bob ;beginning of branch - (case cvs-tree-use-charset - (jisx0208 (make-char 'japanese-jisx0208 40 51)) - (unicode "┳") - (t "+-"))) + (pcase cvs-tree-use-charset + (`jisx0208 (make-char 'japanese-jisx0208 40 51)) + (`unicode "┳") + (_ "+-"))) (defun cvs-tag-lessp (tag1 tag2) (eq (cvs-tag-compare tag1 tag2) 'more2)) @@ -473,16 +478,16 @@ Optional prefix ARG chooses between two representations." (nprev (if (and cvs-tree-nomerge next (equal vlist (cvs-tag->vlist next))) prev vlist))) - (cvs-map (lambda (v p) v) nprev prev))) + (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))) + (cl-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)) @@ -513,24 +518,24 @@ Optional prefix ARG chooses between two representations." ;;;; 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))))) +;; (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 them 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)