-;;; vc-rcs.el --- support for RCS version-control
+;;; vc-rcs.el --- support for RCS version-control -*- lexical-binding:t -*-
-;; Copyright (C) 1992-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2015 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
:type '(choice (const :tag "Work out" nil) (const yes) (const no))
:group 'vc-rcs)
+;; This needs to be autoloaded because vc-rcs-registered uses it (via
+;; vc-default-registered), and vc-hooks needs to be able to check
+;; for a registered backend without loading every backend.
;;;###autoload
(defcustom vc-rcs-master-templates
(purecopy '("%sRCS/%s,v" "%s%s,v" "%sRCS/%s"))
'vc-working-revision))))
(if (not (eq state 'up-to-date))
state
- (if (vc-workfile-unchanged-p file)
+ (if (vc-rcs-workfile-unchanged-p file)
'up-to-date
(if (eq (vc-rcs-checkout-model (list file)) 'locking)
'unlocked-changes
'edited))))))
-(defun vc-rcs-state-heuristic (file)
- "State heuristic for RCS."
- (let (vc-rcs-headers-result)
- (if (and vc-consult-headers
- (setq vc-rcs-headers-result
- (vc-rcs-consult-headers file))
- (eq vc-rcs-headers-result 'rev-and-lock))
- (let ((state (vc-file-getprop file 'vc-state)))
- ;; If the headers say that the file is not locked, the
- ;; permissions can tell us whether locking is used for
- ;; the file or not.
- (if (and (eq state 'up-to-date)
- (not (vc-mistrust-permissions file))
- (file-exists-p file))
- (cond
- ((string-match ".rw..-..-." (nth 8 (file-attributes file)))
- (vc-file-setprop file 'vc-checkout-model 'implicit)
- (setq state
- (if (vc-rcs-workfile-is-newer file)
- 'edited
- 'up-to-date)))
- ((string-match ".r-..-..-." (nth 8 (file-attributes file)))
- (vc-file-setprop file 'vc-checkout-model 'locking))))
- state)
- (if (not (vc-mistrust-permissions file))
- (let* ((attributes (file-attributes file 'string))
- (owner-name (nth 2 attributes))
- (permissions (nth 8 attributes)))
- (cond ((and permissions (string-match ".r-..-..-." permissions))
- (vc-file-setprop file 'vc-checkout-model 'locking)
- 'up-to-date)
- ((and permissions (string-match ".rw..-..-." permissions))
- (if (eq (vc-rcs-checkout-model file) 'locking)
- (if (file-ownership-preserved-p file)
- 'edited
- owner-name)
- (if (vc-rcs-workfile-is-newer file)
- 'edited
- 'up-to-date)))
- (t
- ;; Strange permissions. Fall through to
- ;; expensive state computation.
- (vc-rcs-state file))))
- (vc-rcs-state file)))))
-
-(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
- ;; `vc-expand-dirs' is not TRTD because it returns files from
- ;; multiple backends. It should also return 'unregistered files.
-
- ;; Doing individual vc-state calls is painful but there
- ;; is no better way in RCS-land.
- (let ((flist (vc-expand-dirs (list dir)))
- (result nil))
- (dolist (file flist)
+(autoload 'vc-expand-dirs "vc")
+
+(defun vc-rcs-dir-status-files (dir files update-function)
+ (if (not files) (setq files (vc-expand-dirs (list dir) 'RCS)))
+ (let ((result nil))
+ (dolist (file files)
(let ((state (vc-state file))
(frel (file-relative-name file)))
(when (and (eq (vc-backend file) 'RCS)
(vc-rcs-fetch-master-state file)
(vc-file-getprop file 'vc-working-revision))))
+(autoload 'vc-master-name "vc-filewise")
+
(defun vc-rcs-latest-on-branch-p (file &optional version)
"Return non-nil if workfile version of FILE is the latest on its branch.
When VERSION is given, perform check for that version."
(if (vc-rcs-trunk-p version)
(progn
;; Compare VERSION to the head version number.
- (vc-insert-file (vc-name file) "^[0-9]")
+ (vc-insert-file (vc-master-name file) "^[0-9]")
(vc-parse-buffer "^head[ \t\n]+\\([^;]+\\);" 1))
;; If we are not on the trunk, we need to examine the
;; whole current branch.
- (vc-insert-file (vc-name file) "^desc")
+ (vc-insert-file (vc-master-name file) "^desc")
(vc-rcs-find-most-recent-rev (vc-branch-part version))))))
(defun vc-rcs-workfile-unchanged-p (file)
- "RCS-specific implementation of `vc-workfile-unchanged-p'."
+ "Has FILE remained unchanged since last checkout?"
;; Try to use rcsdiff --brief. If rcsdiff does not understand that,
;; do a double take and remember the fact for the future
(let* ((version (concat "-r" (vc-working-revision file)))
;; RCS is totally file-oriented, so all we have to do is make the directory.
(make-directory "RCS"))
-(defun vc-rcs-register (files &optional rev comment)
+(autoload 'vc-switches "vc")
+
+(defun vc-rcs-register (files &optional comment)
"Register FILES into the RCS version-control system.
-REV is the optional revision number for the files. COMMENT can be used
-to provide an initial description for each FILES.
+Automatically retrieve a read-only version of the file with keywords expanded.
+COMMENT can be used to provide an initial description for each FILES.
Passes either `vc-rcs-register-switches' or `vc-register-switches'
-to the RCS command.
-
-Automatically retrieve a read-only version of the file with keywords
-expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
+to the RCS command."
(let (subdir name)
- ;; When REV is specified, we need to force using "-t-".
- (when rev (unless comment (setq comment "")))
(dolist (file files)
(and (not (file-exists-p
(setq subdir (expand-file-name "RCS"
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)
+ "-u"
(and comment (concat "-t-" comment))
(vc-switches 'RCS 'register))
;; parse output to find master file name and workfile version
(match-string 1))))
;; if we couldn't find the master name,
;; run vc-rcs-registered to get it
- ;; (will be stored into the vc-name property)
+ ;; (will be stored into the vc-master-name property)
(vc-rcs-registered file)
- (vc-file-setprop file 'vc-name
+ (vc-file-setprop file 'vc-master-name
(if (file-name-absolute-p name)
name
(expand-file-name
(defun vc-rcs-receive-file (file rev)
"Implementation of receive-file for RCS."
(let ((checkout-model (vc-rcs-checkout-model (list file))))
- (vc-rcs-register file rev "")
+ (vc-rcs-register file "")
(when (eq checkout-model 'implicit)
(vc-rcs-set-non-strict-locking file))
(vc-rcs-set-default-branch file (concat rev ".1"))))
"Unregister FILE from RCS.
If this leaves the RCS subdirectory empty, ask the user
whether to remove it."
- (let* ((master (vc-name file))
+ (let* ((master (vc-master-name file))
(dir (file-name-directory master))
(backup-info (find-backup-file-name master)))
(if (not backup-info)
(yes-or-no-p (format "Directory %s is empty; remove it? " dir))
(delete-directory dir))))
-(defun vc-rcs-checkin (files rev comment)
+;; It used to be possible to pass in a value for the variable rev, but
+;; nothing in the rest of VC used this capability. Removing it makes the
+;; backend interface simpler for all modes.
+;;
+(defun vc-rcs-checkin (files comment)
"RCS-specific version of `vc-backend-checkin'."
- (let ((switches (vc-switches 'RCS 'checkin)))
+ (let (rev (switches (vc-switches 'RCS 'checkin)))
;; Now operate on the files
- (dolist (file (vc-expand-dirs files))
+ (dolist (file (vc-expand-dirs files 'RCS))
(let ((old-version (vc-working-revision file)) new-version
(default-branch (vc-file-getprop file 'vc-rcs-default-branch)))
;; Force branch creation if an appropriate
;; default branch has been set.
- (and (not rev)
- default-branch
+ (and default-branch
(string-match (concat "^" (regexp-quote old-version) "\\.")
default-branch)
(setq rev default-branch)
(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)
+ (if old-version
+ (setq rev (vc-branch-part old-version))
+ (error "can't find current branch"))
+ (apply #'vc-do-command "*vc*" 0 "ci" (vc-master-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)
+ (concat "-u" rev)
(concat "-m" comment)
switches)
(vc-file-setprop file 'vc-working-revision nil)
(if (not (vc-rcs-release-p "5.6.2"))
;; exit status of 1 is also accepted.
;; It means that the lock was removed before.
- (vc-do-command "*vc*" 1 "rcs" (vc-name file)
+ (vc-do-command "*vc*" 1 "rcs" (vc-master-name file)
(concat "-u" old-version)))))))))
(defun vc-rcs-find-revision (file rev buffer)
- (apply 'vc-do-command
- (or buffer "*vc*") 0 "co" (vc-name file)
+ (apply #'vc-do-command
+ (or buffer "*vc*") 0 "co" (vc-master-name file)
"-q" ;; suppress diagnostic output
(concat "-p" rev)
(vc-switches 'RCS 'checkout)))
-(defun vc-rcs-checkout (file &optional editable rev)
+(defun vc-rcs-checkout (file &optional rev)
"Retrieve a copy of a saved version of FILE. If FILE is a directory,
attempt the checkout for all registered files beneath it."
(if (file-directory-p file)
- (mapc 'vc-rcs-checkout (vc-expand-dirs (list file)))
+ (mapc 'vc-rcs-checkout (vc-expand-dirs (list file) 'RCS))
(let ((file-buffer (get-file-buffer file))
switches)
(message "Checking out %s..." file)
(and rev (string= rev "")
(vc-rcs-set-default-branch file nil))
;; now do the checkout
- (apply 'vc-do-command
- "*vc*" 0 "co" (vc-name file)
+ (apply #'vc-do-command
+ "*vc*" 0 "co" (vc-master-name file)
;; If locking is not strict, force to overwrite
;; the writable workfile.
(if (eq (vc-rcs-checkout-model (list file)) 'implicit) "-f")
- (if editable "-l")
+ "-l"
(if (stringp rev)
;; a literal revision was specified
(concat "-r" rev)
new-version)))))
(message "Checking out %s...done" file))))))
-(defun vc-rcs-rollback (files)
- "Roll back, undoing the most recent checkins of FILES. Directories are
-expanded to all registered subfiles in them."
- (if (not files)
- (error "RCS backend doesn't support directory-level rollback"))
- (dolist (file (vc-expand-dirs files))
- (let* ((discard (vc-working-revision file))
- (previous (if (vc-rcs-trunk-p discard) "" (vc-branch-part discard)))
- (config (current-window-configuration))
- (done nil))
- (if (null (yes-or-no-p (format "Remove version %s from %s history? "
- discard file)))
- (error "Aborted"))
- (message "Removing revision %s from %s." discard file)
- (vc-do-command "*vc*" 0 "rcs" (vc-name file) (concat "-o" discard))
- ;; Check out the most recent remaining version. If it
- ;; fails, because the whole branch got deleted, do a
- ;; double-take and check out the version where the branch
- ;; started.
- (while (not done)
- (condition-case err
- (progn
- (vc-do-command "*vc*" 0 "co" (vc-name file) "-f"
- (concat "-u" previous))
- (setq done t))
- (error (set-buffer "*vc*")
- (goto-char (point-min))
- (if (search-forward "no side branches present for" nil t)
- (progn (setq previous (vc-branch-part previous))
- (vc-rcs-set-default-branch file previous)
- ;; vc-do-command popped up a window with
- ;; the error message. Get rid of it, by
- ;; restoring the old window configuration.
- (set-window-configuration config))
- ;; 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)
- (mapc 'vc-rcs-revert (vc-expand-dirs (list file)))
- (vc-do-command "*vc*" 0 "co" (vc-name file) "-f"
+ (mapc 'vc-rcs-revert (vc-expand-dirs (list file) 'RCS))
+ (vc-do-command "*vc*" 0 "co" (vc-master-name file) "-f"
(concat (if (eq (vc-state file) 'edited) "-u" "-r")
(vc-working-revision file)))))
+(defun vc-rcs-merge-file (file)
+ "Accept a file merge request, prompting for revisions."
+ (let* ((first-revision
+ (vc-read-revision
+ (concat "Merge " file " from branch or revision: ")
+ (list file)
+ 'RCS))
+ second-revision)
+ (cond
+ ((string= first-revision "")
+ (error "A starting RCS revision is required"))
+ (t
+ (if (not (vc-branch-p first-revision))
+ (setq second-revision
+ (vc-read-revision
+ "Second RCS revision: "
+ (list file) 'RCS nil
+ (concat (vc-branch-part first-revision) ".")))
+ ;; We want to merge an entire branch. Set revisions
+ ;; accordingly, so that vc-rcs-merge understands us.
+ (setq second-revision first-revision)
+ ;; first-revision must be the starting point of the branch
+ (setq first-revision (vc-branch-part first-revision)))))
+ (vc-rcs-merge file first-revision second-revision)))
+
(defun vc-rcs-merge (file first-version &optional second-version)
"Merge changes into current working copy of FILE.
The changes are between FIRST-VERSION and SECOND-VERSION."
- (vc-do-command "*vc*" 1 "rcsmerge" (vc-name file)
+ (vc-do-command "*vc*" 1 "rcsmerge" (vc-master-name file)
"-kk" ; ignore keyword conflicts
(concat "-r" first-version)
(if second-version (concat "-r" second-version))))
If FILE is a directory, steal the lock on all registered files beneath it.
Needs RCS 5.6.2 or later for -M."
(if (file-directory-p file)
- (mapc 'vc-rcs-steal-lock (vc-expand-dirs (list file)))
- (vc-do-command "*vc*" 0 "rcs" (vc-name file) "-M" (concat "-u" rev))
+ (mapc 'vc-rcs-steal-lock (vc-expand-dirs (list file) 'RCS))
+ (vc-do-command "*vc*" 0 "rcs" (vc-master-name file) "-M" (concat "-u" rev))
;; Do a real checkout after stealing the lock, so that we see
;; expanded headers.
- (vc-do-command "*vc*" 0 "co" (vc-name file) "-f" (concat "-l" rev))))
+ (vc-do-command "*vc*" 0 "co" (vc-master-name file) "-f" (concat "-l" rev))
+ ;; Must clear any headers here because they wouldn't
+ ;; show that the file is locked now.
+ (let* ((filename (or file buffer-file-name))
+ (visited (find-buffer-visiting filename)))
+ (if visited
+ (let ((context (vc-buffer-context)))
+ ;; save-excursion may be able to relocate point and mark
+ ;; properly. If it fails, vc-restore-buffer-context
+ ;; will give it a second try.
+ (save-excursion
+ (vc-rcs-clear-headers))
+ (vc-restore-buffer-context context))
+ (set-buffer (find-file-noselect filename))
+ (vc-rcs-clear-headers)
+ (kill-buffer filename)))))
(defun vc-rcs-modify-change-comment (files rev comment)
"Modify the change comments change on FILES on a specified REV. If FILE is a
directory the operation is applied to all registered files beneath it."
- (dolist (file (vc-expand-dirs files))
- (vc-do-command "*vc*" 0 "rcs" (vc-name file)
+ (dolist (file (vc-expand-dirs files 'RCS))
+ (vc-do-command "*vc*" 0 "rcs" (vc-master-name file)
(concat "-m" rev ":" comment))))
\f
(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-master-name (vc-expand-dirs files 'RCS)))
(with-current-buffer (or buffer "*vc*")
(vc-rcs-print-log-cleanup))
(when limit 'limit-unsupported))
-(defun vc-rcs-diff (files &optional oldvers newvers buffer)
+(defun vc-rcs-diff (files &optional oldvers newvers buffer async)
"Get a difference report using RCS between two sets of files."
- (apply 'vc-do-command (or buffer "*vc-diff*")
- 1 ;; Always go synchronous, the repo is local
- "rcsdiff" (vc-expand-dirs files)
+ (apply #'vc-do-command (or buffer "*vc-diff*")
+ (if async 'async 1)
+ "rcsdiff" (vc-expand-dirs files 'RCS)
(append (list "-q"
(and oldvers (concat "-r" oldvers))
(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*"
(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)
"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)))))
(defun vc-rcs-annotate-time ()
"Return the time of the next annotation (as fraction of days)
;;; 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"))
(vc-file-tree-walk
dir
(lambda (f)
- (vc-do-command "*vc*" 0 "rcs" (vc-name f) (concat "-n" name ":")))))))
+ (vc-do-command "*vc*" 0 "rcs" (vc-master-name f) (concat "-n" name ":")))))))
\f
;;;
(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
(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
(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."
(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
\\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t)))
(defun vc-rcs-clear-headers ()
- "Implementation of vc-clear-headers for RCS."
+ "Clear RCS header value parts."
(let ((case-fold-search nil))
(goto-char (point-min))
(while (re-search-forward
nil t)
(replace-match "$\\1$"))))
+(autoload 'vc-rename-master "vc-filewise")
+
(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))
+ (vc-rename-master (vc-master-name old) new vc-rcs-master-templates))
(defun vc-rcs-find-file-hook ()
;; If the file is locked by some other user, make
This likely means that FILE has been changed with respect
to its master version."
(let ((file-time (nth 5 (file-attributes file)))
- (master-time (nth 5 (file-attributes (vc-name file)))))
+ (master-time (nth 5 (file-attributes (vc-master-name file)))))
(or (> (nth 0 file-time) (nth 0 master-time))
(and (= (nth 0 file-time) (nth 0 master-time))
(> (nth 1 file-time) (nth 1 master-time))))))
`vc-checkout-model' to their correct values, based on the master
file."
(with-temp-buffer
- (if (or (not (vc-insert-file (vc-name file) "^[0-9]"))
+ (if (or (not (vc-insert-file (vc-master-name file) "^[0-9]"))
(progn (goto-char (point-min))
(not (looking-at "^head[ \t\n]+[^;]+;$"))))
- (error "File %s is not an RCS master file" (vc-name file)))
+ (error "File %s is not an RCS master file" (vc-master-name file)))
(let ((workfile-is-latest nil)
(default-branch (vc-parse-buffer "^branch[ \t\n]+\\([^;]*\\);" 1)))
(vc-file-setprop file 'vc-rcs-default-branch default-branch)
default-branch)
(setq working-revision default-branch))
;; else, search for the head of the default branch
- (t (vc-insert-file (vc-name file) "^desc")
+ (t (vc-insert-file (vc-master-name file) "^desc")
(setq working-revision
(vc-rcs-find-most-recent-rev default-branch))
(setq workfile-is-latest t)))
'rev-and-lock if revision and lock info was found"
(cond
((not (get-file-buffer file)) nil)
- ((let (status version locking-user)
+ ((let (status version)
(with-current-buffer (get-file-buffer file)
(save-excursion
(goto-char (point-min))
(cond
;; unlocked revision
((looking-at "\\$")
- (setq locking-user 'none)
+ ;;(setq locking-user 'none)
(setq status 'rev-and-lock))
;; revision is locked by some user
((looking-at "\\([^ ]+\\) \\$")
- (setq locking-user (match-string-no-properties 1))
+ ;;(setq locking-user (match-string-no-properties 1))
(setq status 'rev-and-lock))
;; everything else: false
(nil)))
(goto-char (point-min))
(if (re-search-forward (concat "\\$" "Locker:") nil t)
(cond ((looking-at " \\([^ ]+\\) \\$")
- (setq locking-user (match-string-no-properties 1))
+ ;;(setq locking-user (match-string-no-properties 1))
(setq status 'rev-and-lock))
((looking-at " *\\$")
- (setq locking-user 'none)
+ ;;(setq locking-user 'none)
(setq status 'rev-and-lock))
(t
- (setq locking-user 'none)
+ ;;(setq locking-user 'none)
(setq status 'rev-and-lock)))
(setq status 'rev)))
;; else: nothing found
;; -------------------
(t nil))))
(if status (vc-file-setprop file 'vc-working-revision version))
- (and (eq status 'rev-and-lock)
- (vc-file-setprop file 'vc-state
- (cond
- ((eq locking-user 'none) 'up-to-date)
- ((string= locking-user (vc-user-login-name file))
- 'edited)
- (t locking-user)))
- ;; If the file has headers, we don't want to query the
- ;; master file, because that would eliminate all the
- ;; performance gain the headers brought us. We therefore
- ;; use a heuristic now to find out whether locking is used
- ;; for this file. If we trust the file permissions, and the
- ;; file is not locked, then if the file is read-only we
- ;; assume that locking is used for the file, otherwise
- ;; locking is not used.
- (not (vc-mistrust-permissions file))
- (vc-up-to-date-p file)
- (if (string-match ".r-..-..-." (nth 8 (file-attributes file)))
- (vc-file-setprop file 'vc-checkout-model 'locking)
- (vc-file-setprop file 'vc-checkout-model 'implicit)))
status))))
(defun vc-release-greater-or-equal (r1 r2)
(set-file-modes file (logior (file-modes file) 128)))
(defun vc-rcs-set-default-branch (file branch)
- (vc-do-command "*vc*" 0 "rcs" (vc-name file) (concat "-b" branch))
+ (vc-do-command "*vc*" 0 "rcs" (vc-master-name file) (concat "-b" branch))
(vc-file-setprop file 'vc-rcs-default-branch branch))
(defun vc-rcs-parse (&optional buffer)
(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)))
(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
;; 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 ()
(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.
;; 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)
;; 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)