Mercurial > emacs

comparison lisp/vc-rcs.el @ 35133:1b45907ef7a8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(vc-rcs-checkout, vc-rcs-cancel-version): Renamed arg WRITABLE to EDITABLE.
author André Spiegel <spiegel@gnu.org>
date Mon, 08 Jan 2001 16:25:43 +0000
parents 2c1708b98891
children ae1b8d0257a7
comparison
equal deleted inserted replaced
35132:78bce41f17c5 35133:1b45907ef7a8
3 ;; Copyright (C) 1992,93,94,95,96,97,98,99,2000 Free Software Foundation, Inc. 3 ;; Copyright (C) 1992,93,94,95,96,97,98,99,2000 Free Software Foundation, Inc.
4 4
5 ;; Author: FSF (see vc.el for full credits) 5 ;; Author: FSF (see vc.el for full credits)
6 ;; Maintainer: Andre Spiegel <spiegel@gnu.org> 6 ;; Maintainer: Andre Spiegel <spiegel@gnu.org>
7 7
8 ;; $Id: vc-rcs.el,v 1.13 2000/11/19 09:46:04 spiegel Exp $ 8 ;; $Id: vc-rcs.el,v 1.14 2000/11/20 14:14:25 spiegel Exp $
9 9
10 ;; This file is part of GNU Emacs. 10 ;; This file is part of GNU Emacs.
11 11
12 ;; GNU Emacs is free software; you can redistribute it and/or modify 12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by 13 ;; it under the terms of the GNU General Public License as published by
363 ;; exit status of 1 is also accepted. 363 ;; exit status of 1 is also accepted.
364 ;; It means that the lock was removed before. 364 ;; It means that the lock was removed before.
365 (vc-do-command nil 1 "rcs" (vc-name file) 365 (vc-do-command nil 1 "rcs" (vc-name file)
366 (concat "-u" old-version)))))))) 366 (concat "-u" old-version))))))))
367 367
368 (defun vc-rcs-checkout (file &optional writable rev workfile) 368 (defun vc-rcs-checkout (file &optional editable rev workfile)
369 "Retrieve a copy of a saved version of FILE into a workfile." 369 "Retrieve a copy of a saved version of FILE into a workfile."
370 (let ((filename (or workfile file)) 370 (let ((filename (or workfile file))
371 (file-buffer (get-file-buffer file)) 371 (file-buffer (get-file-buffer file))
372 switches) 372 switches)
373 (message "Checking out %s..." filename) 373 (message "Checking out %s..." filename)
387 (setq default-directory (file-name-directory filename)) 387 (setq default-directory (file-name-directory filename))
388 (if workfile ;; RCS 388 (if workfile ;; RCS
389 ;; RCS can't check out into arbitrary file names directly. 389 ;; RCS can't check out into arbitrary file names directly.
390 ;; Use `co -p' and make stdout point to the correct file. 390 ;; Use `co -p' and make stdout point to the correct file.
391 (let ((vc-modes (logior (file-modes (vc-name file)) 391 (let ((vc-modes (logior (file-modes (vc-name file))
392 (if writable 128 0))) 392 (if editable 128 0)))
393 (failed t)) 393 (failed t))
394 (unwind-protect 394 (unwind-protect
395 (progn 395 (progn
396 (let ((coding-system-for-read 'no-conversion) 396 (let ((coding-system-for-read 'no-conversion)
397 (coding-system-for-write 'no-conversion)) 397 (coding-system-for-write 'no-conversion))
398 (with-temp-file filename 398 (with-temp-file filename
399 (apply 'vc-do-command 399 (apply 'vc-do-command
400 (current-buffer) 0 "co" (vc-name file) 400 (current-buffer) 0 "co" (vc-name file)
401 "-q" ;; suppress diagnostic output 401 "-q" ;; suppress diagnostic output
402 (if writable "-l") 402 (if editable "-l")
403 (concat "-p" rev) 403 (concat "-p" rev)
404 switches))) 404 switches)))
405 (set-file-modes filename 405 (set-file-modes filename
406 (logior (file-modes (vc-name file)) 406 (logior (file-modes (vc-name file))
407 (if writable 128 0))) 407 (if editable 128 0)))
408 (setq failed nil)) 408 (setq failed nil))
409 (and failed (file-exists-p filename) 409 (and failed (file-exists-p filename)
410 (delete-file filename)))) 410 (delete-file filename))))
411 (let (new-version) 411 (let (new-version)
412 ;; if we should go to the head of the trunk, 412 ;; if we should go to the head of the trunk,
417 (apply 'vc-do-command 417 (apply 'vc-do-command
418 nil 0 "co" (vc-name file) 418 nil 0 "co" (vc-name file)
419 ;; If locking is not strict, force to overwrite 419 ;; If locking is not strict, force to overwrite
420 ;; the writable workfile. 420 ;; the writable workfile.
421 (if (eq (vc-checkout-model file) 'implicit) "-f") 421 (if (eq (vc-checkout-model file) 'implicit) "-f")
422 (if writable "-l") 422 (if editable "-l")
423 (if rev (concat "-r" rev) 423 (if rev (concat "-r" rev)
424 ;; if no explicit revision was specified, 424 ;; if no explicit revision was specified,
425 ;; check out that of the working file 425 ;; check out that of the working file
426 (let ((workrev (vc-workfile-version file))) 426 (let ((workrev (vc-workfile-version file)))
427 (if workrev (concat "-r" workrev) 427 (if workrev (concat "-r" workrev)
445 (defun vc-rcs-revert (file) 445 (defun vc-rcs-revert (file)
446 "Revert FILE to the version it was based on." 446 "Revert FILE to the version it was based on."
447 (vc-do-command nil 0 "co" (vc-name file) "-f" 447 (vc-do-command nil 0 "co" (vc-name file) "-f"
448 (concat "-u" (vc-workfile-version file)))) 448 (concat "-u" (vc-workfile-version file))))
449 449
450 (defun vc-rcs-cancel-version (file writable) 450 (defun vc-rcs-cancel-version (file editable)
451 "Undo the most recent checkin of FILE. 451 "Undo the most recent checkin of FILE.
452 WRITABLE non-nil means previous version should be locked." 452 EDITABLE non-nil means previous version should be locked."
453 (let* ((target (vc-workfile-version file)) 453 (let* ((target (vc-workfile-version file))
454 (previous (if (vc-trunk-p target) "" (vc-branch-part target))) 454 (previous (if (vc-trunk-p target) "" (vc-branch-part target)))
455 (config (current-window-configuration)) 455 (config (current-window-configuration))
456 (done nil)) 456 (done nil))
457 (vc-do-command nil 0 "rcs" (vc-name file) (concat "-o" target)) 457 (vc-do-command nil 0 "rcs" (vc-name file) (concat "-o" target))
460 ;; version where the branch started. 460 ;; version where the branch started.
461 (while (not done) 461 (while (not done)
462 (condition-case err 462 (condition-case err
463 (progn 463 (progn
464 (vc-do-command nil 0 "co" (vc-name file) "-f" 464 (vc-do-command nil 0 "co" (vc-name file) "-f"
465 (concat (if writable "-l" "-u") previous)) 465 (concat (if editable "-l" "-u") previous))
466 (setq done t)) 466 (setq done t))
467 (error (set-buffer "*vc*") 467 (error (set-buffer "*vc*")
468 (goto-char (point-min)) 468 (goto-char (point-min))
469 (if (search-forward "no side branches present for" nil t) 469 (if (search-forward "no side branches present for" nil t)
470 (progn (setq previous (vc-branch-part previous)) 470 (progn (setq previous (vc-branch-part previous))