-;;; cvs-status.el --- major mode for browsing `cvs status' output -*- coding: utf-8 -*-
+;;; cvs-status.el --- major mode for browsing `cvs status' output -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2016 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: pcl-cvs cvs status tree vc tools
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'pcvs-util)
;;;
'(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"
;; Tagelt, tag element
;;
-(defstruct (cvs-tag
+(cl-defstruct (cvs-tag
(:constructor nil)
(:constructor cvs-tag-make
(vlist &optional name type))
(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))
(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)
(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))))))
(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))
(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))
;;;; 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)