* lisp/vc/vc-hg.el (vc-hg-working-revision): Use "hg parent" and
[bpt/emacs.git] / lisp / vc / vc-rcs.el
index 40d8acb..6b06426 100644 (file)
@@ -1,6 +1,6 @@
-;;; vc-rcs.el --- support for RCS version-control
+;;; vc-rcs.el --- support for RCS version-control  -*- lexical-binding:t -*-
 
-;; Copyright (C) 1992-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2014 Free Software Foundation, Inc.
 
 ;; Author:     FSF (see vc.el for full credits)
 ;; Maintainer: Andre Spiegel <spiegel@gnu.org>
@@ -200,6 +200,8 @@ For a description of possible values, see `vc-check-master-templates'."
                    (vc-rcs-state file))))
         (vc-rcs-state file)))))
 
+(autoload 'vc-expand-dirs "vc")
+
 (defun vc-rcs-dir-status (dir update-function)
   ;; FIXME: this function should be rewritten or `vc-expand-dirs'
   ;; should be changed to take a backend parameter.  Using
@@ -270,6 +272,8 @@ When VERSION is given, perform check for that version."
   ;; RCS is totally file-oriented, so all we have to do is make the directory.
   (make-directory "RCS"))
 
+(autoload 'vc-switches "vc")
+
 (defun vc-rcs-register (files &optional rev comment)
   "Register FILES into the RCS version-control system.
 REV is the optional revision number for the files.  COMMENT can be used
@@ -290,7 +294,7 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
                                 nil ".*,v$" t))
           (yes-or-no-p "Create RCS subdirectory? ")
           (make-directory subdir))
-      (apply 'vc-do-command "*vc*" 0 "ci" file
+      (apply #'vc-do-command "*vc*" 0 "ci" file
             ;; if available, use the secure registering option
             (and (vc-rcs-release-p "5.6.4") "-i")
             (concat (if vc-keep-workfiles "-u" "-r") rev)
@@ -371,7 +375,7 @@ whether to remove it."
             (setq switches (cons "-f" switches)))
        (if (and (not rev) old-version)
            (setq rev (vc-branch-part old-version)))
-       (apply 'vc-do-command "*vc*" 0 "ci" (vc-name file)
+       (apply #'vc-do-command "*vc*" 0 "ci" (vc-name file)
               ;; if available, use the secure check-in option
               (and (vc-rcs-release-p "5.6.4") "-j")
               (concat (if vc-keep-workfiles "-u" "-r") rev)
@@ -407,7 +411,7 @@ whether to remove it."
                             (concat "-u" old-version)))))))))
 
 (defun vc-rcs-find-revision (file rev buffer)
-  (apply 'vc-do-command
+  (apply #'vc-do-command
         (or buffer "*vc*") 0 "co" (vc-name file)
         "-q" ;; suppress diagnostic output
         (concat "-p" rev)
@@ -439,7 +443,7 @@ attempt the checkout for all registered files beneath it."
              (and rev (string= rev "")
                   (vc-rcs-set-default-branch file nil))
              ;; now do the checkout
-             (apply 'vc-do-command
+             (apply #'vc-do-command
                     "*vc*" 0 "co" (vc-name file)
                     ;; If locking is not strict, force to overwrite
                     ;; the writable workfile.
@@ -516,7 +520,7 @@ expanded to all registered subfiles in them."
                         ;; No, it was some other error: re-signal it.
                         (signal (car err) (cdr err)))))))))
 
-(defun vc-rcs-revert (file &optional contents-done)
+(defun vc-rcs-revert (file &optional _contents-done)
   "Revert FILE to the version it was based on.  If FILE is a directory,
 revert all registered files beneath it."
   (if (file-directory-p file)
@@ -567,17 +571,21 @@ directory the operation is applied to all registered files beneath it."
     (when (looking-at "[\b\t\n\v\f\r ]+")
       (delete-char (- (match-end 0) (match-beginning 0))))))
 
-(defun vc-rcs-print-log (files buffer &optional shortlog start-revision-ignored limit)
-  "Get change log associated with FILE.  If FILE is a
-directory the operation is applied to all registered files beneath it."
-  (vc-do-command (or buffer "*vc*") 0 "rlog" (mapcar 'vc-name (vc-expand-dirs files)))
+(defun vc-rcs-print-log (files buffer &optional _shortlog
+                               _start-revision-ignored limit)
+  "Print commit log associated with FILES into specified BUFFER.
+Remaining arguments are ignored.
+If FILE is a directory the operation is applied to all registered
+files beneath it."
+  (vc-do-command (or buffer "*vc*") 0 "rlog"
+                 (mapcar 'vc-name (vc-expand-dirs files)))
   (with-current-buffer (or buffer "*vc*")
     (vc-rcs-print-log-cleanup))
   (when limit 'limit-unsupported))
 
 (defun vc-rcs-diff (files &optional oldvers newvers buffer)
   "Get a difference report using RCS between two sets of files."
-  (apply 'vc-do-command (or buffer "*vc-diff*")
+  (apply #'vc-do-command (or buffer "*vc-diff*")
         1              ;; Always go synchronous, the repo is local
         "rcsdiff" (vc-expand-dirs files)
          (append (list "-q"
@@ -585,6 +593,10 @@ directory the operation is applied to all registered files beneath it."
                        (and newvers (concat "-r" newvers)))
                  (vc-switches 'RCS 'diff))))
 
+(defun vc-rcs-find-admin-dir (file)
+  "Return the administrative directory of FILE."
+  (vc-find-root file "RCS"))
+
 (defun vc-rcs-comment-history (file)
   "Return a string with all log entries stored in BACKEND for FILE."
   (with-current-buffer "*vc*"
@@ -775,7 +787,7 @@ Optional arg REVISION is a revision to annotate from."
       (cl-flet ((pad (w) (substring-no-properties padding w))
                 (render (rda &rest ls)
                         (propertize
-                         (apply 'concat
+                         (apply #'concat
                                 (format-time-string "%Y-%m-%d" (aref rda 1))
                                 "  "
                                 (aref rda 0)
@@ -799,7 +811,7 @@ Optional arg REVISION is a revision to annotate from."
   "Return the current time, based at midnight of the current day, and
 encoded as fractional days."
   (vc-annotate-convert-time
-   (apply 'encode-time 0 0 0 (nthcdr 3 (decode-time (current-time))))))
+   (apply #'encode-time 0 0 0 (nthcdr 3 (decode-time (current-time))))))
 
 (defun vc-rcs-annotate-time ()
   "Return the time of the next annotation (as fraction of days)
@@ -817,6 +829,9 @@ systime, or nil if there is none.  Also, reposition point."
 ;;; Tag system
 ;;;
 
+(autoload 'vc-tag-precondition "vc")
+(declare-function vc-file-tree-walk "vc" (dirname func &rest args))
+
 (defun vc-rcs-create-tag (dir name branchp)
   (when branchp
     (error "RCS backend does not support module branches"))
@@ -842,7 +857,7 @@ systime, or nil if there is none.  Also, reposition point."
   (string-match "[0-9]+\\'" rev)
   (substring rev (match-beginning 0) (match-end 0)))
 
-(defun vc-rcs-previous-revision (file rev)
+(defun vc-rcs-previous-revision (_file rev)
   "Return the revision number immediately preceding REV for FILE,
 or nil if there is no previous revision.  This default
 implementation works for MAJOR.MINOR-style revision numbers as
@@ -871,10 +886,9 @@ and CVS."
          (minor-num (string-to-number (vc-rcs-minor-part rev))))
       (concat branch "." (number-to-string (1+ minor-num))))))
 
-;; Note that most GNU/Linux distributions seem to supply rcs2log in a
-;; standard bin directory.  Eg both Red Hat and Debian include it in
-;; their cvs packages.  It's not obvious why Emacs still needs to
-;; provide it as well...
+;; You might think that this should be distributed with RCS, but
+;; apparently not.  CVS sometimes provides a version of it.
+;; http://lists.gnu.org/archive/html/emacs-devel/2014-05/msg00288.html
 (defvar vc-rcs-rcs2log-program
   (let (exe)
     (cond ((file-executable-p
@@ -888,6 +902,8 @@ and CVS."
           (t "rcs2log")))
   "Path to the `rcs2log' program (normally in `exec-directory').")
 
+(autoload 'vc-buffer-sync "vc-dispatcher")
+
 (defun vc-rcs-update-changelog (files)
   "Default implementation of update-changelog.
 Uses `rcs2log' which only works for RCS and CVS."
@@ -918,7 +934,7 @@ Uses `rcs2log' which only works for RCS and CVS."
             (unwind-protect
                 (progn
                   (setq default-directory odefault)
-                  (if (eq 0 (apply 'call-process vc-rcs-rcs2log-program
+                  (if (eq 0 (apply #'call-process vc-rcs-rcs2log-program
                                     nil (list t tempfile) nil
                                     "-c" changelog
                                     "-u" (concat login-name
@@ -954,6 +970,8 @@ Uses `rcs2log' which only works for RCS and CVS."
             nil t)
       (replace-match "$\\1$"))))
 
+(autoload 'vc-rename-master "vc")
+
 (defun vc-rcs-rename-file (old new)
   ;; Just move the master file (using vc-rcs-master-templates).
   (vc-rename-master (vc-name old) new vc-rcs-master-templates))
@@ -1321,11 +1339,10 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
          (to-one@ () (setq @-holes nil
                            b (progn (search-forward "@") (point))
                            e (progn (while (and (search-forward "@")
-                                                (= ?@ (char-after))
-                                                (progn
-                                                  (push (point) @-holes)
-                                                  (forward-char 1)
-                                                  (push (point) @-holes))))
+                                                (= ?@ (char-after)))
+                                      (push (point) @-holes)
+                                      (forward-char 1)
+                                      (push (point) @-holes))
                                     (1- (point)))))
          (tok+val (set-b+e name &optional proc)
                   (unless (eq name (setq tok (read buffer)))
@@ -1336,18 +1353,18 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
                                 (funcall proc)
                               (buffer-substring-no-properties b e))))
          (k-semi (name &optional proc) (tok+val #'to-semi name proc))
-         (gather () (let ((pairs `(,e ,@@-holes ,b))
-                          acc)
-                      (while pairs
-                        (push (buffer-substring-no-properties
-                               (cadr pairs) (car pairs))
-                              acc)
-                        (setq pairs (cddr pairs)))
-                      (apply 'concat acc)))
-         (k-one@ (name &optional later) (tok+val #'to-one@ name
-                                                 (if later
-                                                     (lambda () t)
-                                                   #'gather))))
+         (gather (b e @-holes)
+                 (let ((pairs `(,e ,@@-holes ,b))
+                       acc)
+                   (while pairs
+                     (push (buffer-substring-no-properties
+                            (cadr pairs) (car pairs))
+                           acc)
+                     (setq pairs (cddr pairs)))
+                   (apply #'concat acc)))
+         (gather1 () (gather b e @-holes))
+         (k-one@ (name &optional later)
+                 (tok+val #'to-one@ name (if later (lambda () t) #'gather1))))
       (save-excursion
         (goto-char (point-min))
         ;; headers
@@ -1394,7 +1411,7 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
                                ;; same algorithm used in RCS 5.7.
                                (when (< (car ls) 100)
                                  (setcar ls (+ 1900 (car ls))))
-                               (apply 'encode-time (nreverse ls)))))
+                               (apply #'encode-time (nreverse ls)))))
                   ,@(mapcar #'k-semi '(author state))
                   ,(k-semi 'branches
                            (lambda ()
@@ -1428,6 +1445,7 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
           (cl-flet ((incg (beg end)
                           (let ((b beg) (e end) @-holes)
                             (while (and asc (< (car asc) e))
+                              (push (pop asc) @-holes)
                               (push (pop asc) @-holes))
                             ;; Self-deprecate when work is done.
                             ;; Folding many dimensions into one.
@@ -1435,7 +1453,7 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
                             ;; O beauteous math! --the Unvexed Bum
                             (unless asc
                               (setq sub #'buffer-substring-no-properties))
-                            (gather))))
+                            (gather b e @-holes))))
             (while (and (sw)
                         (not (eobp))
                         (setq context (to-eol)
@@ -1451,7 +1469,7 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
               ;; other revisions, replace the `text' tag+value with `:insn'
               ;; plus value, always scanning in-place.
               (if (string= context (cdr (assq 'head headers)))
-                  (setcdr (cadr rev) (gather))
+                  (setcdr (cadr rev) (gather b e @-holes))
                 (if @-holes
                     (setq asc (nreverse @-holes)
                           sub #'incg)