mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-03 11:33:37 +00:00
Code Issues Releases Activity

* vc.el (vc-trunk-p): Rename to vc-rcs-trunk-p and move to vc-rcs.el.

Browse Source 
(vc-minor-part): Rename to vc-rcs-minor-part and move to vc-rcs.el.
(vc-default-previous-revision): Rename to vc-rcs-previous-revision
and move to vc-rcs.el.
(vc-default-next-revision): Rename to vc-rcs-next-revision and
move to vc-rcs.el.
(vc-cvs-update-changelog): Move to vc-cvs.el, use vc-call-backend.
(vc-rcs-update-changelog): Remove.
(vc-update-changelog-rcs2log): Rename to vc-rcs-update-changelog
and move to vc-rcs.el.

* vc-rcs.el (vc-rcs-latest-on-branch-p, vc-rcs-checkin)
(vc-rcs-checkout, vc-rcs-rollback): Adjust for the vc-rcs-trunk-p
renaming.
(vc-rcs-trunk-p, vc-rcs-minor-part, vc-rcs-previous-revision)
(vc-rcs-next-revision, vc-rcs-update-changelog): Moved here from
vc.el, renamed to be RCS specific.

* vc-cvs.el (vc-cvs-previous-revision, vc-cvs-next-revision): New functions.
(vc-cvs-update-changelog): Moved here from vc.el.

* vc-sccs.el (vc-sccs-previous-revision, vc-sccs-next-revision):
New functions.
This commit is contained in:
Dan Nicolaescu 2009-08-26 17:54:05 +00:00
parent 636a36a070
commit 3b64d86b56
4 changed files with 126 additions and 101 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
lisp/ChangeLog
View File

@ -1,3 +1,29 @@
2009-08-26 Dan Nicolaescu <dann@ics.uci.edu>
* vc.el (vc-trunk-p): Rename to vc-rcs-trunk-p and move to vc-rcs.el.
(vc-minor-part): Rename to vc-rcs-minor-part and move to vc-rcs.el.
(vc-default-previous-revision): Rename to vc-rcs-previous-revision
and move to vc-rcs.el.
(vc-default-next-revision): Rename to vc-rcs-next-revision and
move to vc-rcs.el.
(vc-cvs-update-changelog): Move to vc-cvs.el, use vc-call-backend.
(vc-rcs-update-changelog): Remove.
(vc-update-changelog-rcs2log): Rename to vc-rcs-update-changelog
and move to vc-rcs.el.
* vc-rcs.el (vc-rcs-latest-on-branch-p, vc-rcs-checkin)
(vc-rcs-checkout, vc-rcs-rollback): Adjust for the vc-rcs-trunk-p
renaming.
(vc-rcs-trunk-p, vc-rcs-minor-part, vc-rcs-previous-revision)
(vc-rcs-next-revision, vc-rcs-update-changelog): Moved here from
vc.el, renamed to be RCS specific.
* vc-cvs.el (vc-cvs-previous-revision, vc-cvs-next-revision): New functions.
(vc-cvs-update-changelog): Moved here from vc.el.
* vc-sccs.el (vc-sccs-previous-revision, vc-sccs-next-revision):
New functions.
2009-08-26 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/bytecomp.el (byte-compile-lapcode): Fix up last change.

99
lisp/vc-rcs.el
View File

@ -220,7 +220,7 @@ When VERSION is given, perform check for that version."
(unless version (setq version (vc-working-revision file)))
(with-temp-buffer
(string= version
(if (vc-trunk-p version)
(if (vc-rcs-trunk-p version)
(progn
;; Compare VERSION to the head version number.
(vc-insert-file (vc-name file) "^[0-9]")
@ -378,7 +378,7 @@ whether to remove it."
(not (string= (vc-branch-part old-version)
(vc-branch-part new-version))))
(vc-rcs-set-default-branch file
(if (vc-trunk-p new-version) nil
(if (vc-rcs-trunk-p new-version) nil
(vc-branch-part new-version)))
;; If this is an old RCS release, we might have
;; to remove a remaining lock.
@ -438,7 +438,7 @@ attempt the checkout for all registered files beneath it."
;; use current workfile version
workrev
;; REV is t ...
(if (not (vc-trunk-p workrev))
(if (not (vc-rcs-trunk-p workrev))
;; ... go to head of current branch
(vc-branch-part workrev)
;; ... go to head of trunk
@ -456,7 +456,7 @@ attempt the checkout for all registered files beneath it."
(vc-rcs-set-default-branch
file
(if (vc-rcs-latest-on-branch-p file new-version)
(if (vc-trunk-p new-version) nil
(if (vc-rcs-trunk-p new-version) nil
(vc-branch-part new-version))
new-version)))))
(message "Checking out %s...done" file))))))
@ -468,7 +468,7 @@ expanded to all registered subfiles in them."
(error "RCS backend doesn't support directory-level rollback."))
(dolist (file (vc-expand-dirs files))
(let* ((discard (vc-working-revision file))
(previous (if (vc-trunk-p discard) "" (vc-branch-part discard)))
(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? "
@ -799,6 +799,95 @@ systime, or nil if there is none. Also, reposition point."
;;; Miscellaneous
;;;
(defun vc-rcs-trunk-p (rev)
"Return t if REV is a revision on the trunk."
(not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev))))
(defun vc-rcs-minor-part (rev)
"Return the minor revision number of a revision number REV."
(string-match "[0-9]+\\'" rev)
(substring rev (match-beginning 0) (match-end 0)))
(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
used by RCS and CVS."
(let ((branch (vc-branch-part rev))
(minor-num (string-to-number (vc-rcs-minor-part rev))))
(when branch
(if (> minor-num 1)
;; revision does probably not start a branch or release
(concat branch "." (number-to-string (1- minor-num)))
(if (vc-rcs-trunk-p rev)
;; we are at the beginning of the trunk --
;; don't know anything to return here
nil
;; we are at the beginning of a branch --
;; return revision of starting point
(vc-branch-part branch))))))
(defun vc-rcs-next-revision (file rev)
"Return the revision number immediately following REV for FILE,
or nil if there is no next revision. This default implementation
works for MAJOR.MINOR-style revision numbers as used by RCS
and CVS."
(when (not (string= rev (vc-working-revision file)))
(let ((branch (vc-branch-part rev))
(minor-num (string-to-number (vc-rcs-minor-part rev))))
(concat branch "." (number-to-string (1+ minor-num))))))
(defun vc-rcs-update-changelog (files)
"Default implementation of update-changelog.
Uses `rcs2log' which only works for RCS and CVS."
;; FIXME: We (c|sh)ould add support for cvs2cl
(let ((odefault default-directory)
(changelog (find-change-log))
;; Presumably not portable to non-Unixy systems, along with rcs2log:
(tempfile (make-temp-file
(expand-file-name "vc"
(or small-temporary-file-directory
temporary-file-directory))))
(login-name (or user-login-name
(format "uid%d" (number-to-string (user-uid)))))
(full-name (or add-log-full-name
(user-full-name)
(user-login-name)
(format "uid%d" (number-to-string (user-uid)))))
(mailing-address (or add-log-mailing-address
user-mail-address)))
(find-file-other-window changelog)
(barf-if-buffer-read-only)
(vc-buffer-sync)
(undo-boundary)
(goto-char (point-min))
(push-mark)
(message "Computing change log entries...")
(message "Computing change log entries... %s"
(unwind-protect
(progn
(setq default-directory odefault)
(if (eq 0 (apply 'call-process
(expand-file-name "rcs2log"
exec-directory)
nil (list t tempfile) nil
"-c" changelog
"-u" (concat login-name
"\t" full-name
"\t" mailing-address)
(mapcar
(lambda (f)
(file-relative-name
(expand-file-name f odefault)))
files)))
"done"
(pop-to-buffer (get-buffer-create "*vc*"))
(erase-buffer)
(insert-file-contents tempfile)
"failed"))
(setq default-directory (file-name-directory changelog))
(delete-file tempfile)))))
(defun vc-rcs-check-headers ()
"Check if the current file has any headers in it."
(save-excursion

6
lisp/vc-sccs.el
View File

@ -370,6 +370,12 @@ revert all subfiles."
;;; Miscellaneous
;;;
(defun vc-sccs-previous-revision (file rev)
(vc-call-backend 'RCS 'previous-revision file rev))
(defun vc-sccs-next-revision (file rev)
(vc-call-backend 'RCS 'next-revision file rev))
(defun vc-sccs-check-headers ()
"Check if the current file has any headers in it."
(save-excursion

96
lisp/vc.el
View File

@ -2243,11 +2243,6 @@ log entries should be gathered."
;; functions that operate on RCS revision numbers. This code should
;; also be moved into the backends. It stays for now, however, since
;; it is used in code below.
;;;###autoload
(defun vc-trunk-p (rev)
"Return t if REV is a revision on the trunk."
(not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev))))
(defun vc-branch-p (rev)
"Return t if REV is a branch revision."
(not (eq nil (string-match "\\`[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*\\'" rev))))
@ -2259,43 +2254,9 @@ log entries should be gathered."
(when index
(substring rev 0 index))))
(defun vc-minor-part (rev)
"Return the minor revision number of a revision number REV."
(string-match "[0-9]+\\'" rev)
(substring rev (match-beginning 0) (match-end 0)))
(define-obsolete-function-alias
'vc-default-previous-version 'vc-default-previous-revision "23.1")
(defun vc-default-previous-revision (backend 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
used by RCS and CVS."
(let ((branch (vc-branch-part rev))
(minor-num (string-to-number (vc-minor-part rev))))
(when branch
(if (> minor-num 1)
;; revision does probably not start a branch or release
(concat branch "." (number-to-string (1- minor-num)))
(if (vc-trunk-p rev)
;; we are at the beginning of the trunk --
;; don't know anything to return here
nil
;; we are at the beginning of a branch --
;; return revision of starting point
(vc-branch-part branch))))))
(defun vc-default-next-revision (backend file rev)
"Return the revision number immediately following REV for FILE,
or nil if there is no next revision. This default implementation
works for MAJOR.MINOR-style revision numbers as used by RCS
and CVS."
(when (not (string= rev (vc-working-revision file)))
(let ((branch (vc-branch-part rev))
(minor-num (string-to-number (vc-minor-part rev))))
(concat branch "." (number-to-string (1+ minor-num))))))
(defun vc-default-responsible-p (backend file)
"Indicate whether BACKEND is reponsible for FILE.
The default is to return nil always."
@ -2314,63 +2275,6 @@ editing non-current revisions is not supported by default."
(defun vc-default-init-revision (backend) vc-default-init-revision)
(defalias 'vc-cvs-update-changelog 'vc-update-changelog-rcs2log)
(defalias 'vc-rcs-update-changelog 'vc-update-changelog-rcs2log)
;; FIXME: This should probably be moved to vc-rcs.el and replaced in
;; vc-cvs.el by code using cvs2cl.
(defun vc-update-changelog-rcs2log (files)
"Default implementation of update-changelog.
Uses `rcs2log' which only works for RCS and CVS."
;; FIXME: We (c|sh)ould add support for cvs2cl
(let ((odefault default-directory)
(changelog (find-change-log))
;; Presumably not portable to non-Unixy systems, along with rcs2log:
(tempfile (make-temp-file
(expand-file-name "vc"
(or small-temporary-file-directory
temporary-file-directory))))
(login-name (or user-login-name
(format "uid%d" (number-to-string (user-uid)))))
(full-name (or add-log-full-name
(user-full-name)
(user-login-name)
(format "uid%d" (number-to-string (user-uid)))))
(mailing-address (or add-log-mailing-address
user-mail-address)))
(find-file-other-window changelog)
(barf-if-buffer-read-only)
(vc-buffer-sync)
(undo-boundary)
(goto-char (point-min))
(push-mark)
(message "Computing change log entries...")
(message "Computing change log entries... %s"
(unwind-protect
(progn
(setq default-directory odefault)
(if (eq 0 (apply 'call-process
(expand-file-name "rcs2log"
exec-directory)
nil (list t tempfile) nil
"-c" changelog
"-u" (concat login-name
"\t" full-name
"\t" mailing-address)
(mapcar
(lambda (f)
(file-relative-name
(expand-file-name f odefault)))
files)))
"done"
(pop-to-buffer (get-buffer-create "*vc*"))
(erase-buffer)
(insert-file-contents tempfile)
"failed"))
(setq default-directory (file-name-directory changelog))
(delete-file tempfile)))))
(defun vc-default-find-revision (backend file rev buffer)
"Provide the new `find-revision' op based on the old `checkout' op.
This is only for compatibility with old backends. They should be updated