Mercurial > emacs

comparison lisp/vc-rcs.el @ 31476:18bf0c070870

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Doc fixes. (vc-rcs-register-switches, vc-rcs-checkin-switches) (vc-rcs-checkout-switches, vc-rcs-header) (vc-rcs-master-templates): Add or change :version.
author Dave Love <fx@gnu.org>
date Thu, 07 Sep 2000 20:02:38 +0000
parents f2ab9420390f
children f9d2d484e1e2
comparison
equal deleted inserted replaced
31475:b25e22223eb9 31476:18bf0c070870
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.1 2000/09/04 19:47:43 gerd Exp $ 8 ;; $Id: vc-rcs.el,v 1.2 2000/09/05 20:08:21 monnier 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
35 (string :tag "Specified") 35 (string :tag "Specified")
36 (const :tag "Unknown" unknown)) 36 (const :tag "Unknown" unknown))
37 :group 'vc) 37 :group 'vc)
38 38
39 (defcustom vc-rcs-register-switches nil 39 (defcustom vc-rcs-register-switches nil
40 "*A string or list of strings; extra switches for registering a file 40 "*Extra switches for registering a file in RCS.
41 in RCS. These are passed to the checkin program by 41 A string or list of strings. These are passed to the checkin program
42 \\[vc-rcs-register]." 42 by \\[vc-rcs-register]."
43 :type '(choice (const :tag "None" nil) 43 :type '(choice (const :tag "None" nil)
44 (string :tag "Argument String") 44 (string :tag "Argument String")
45 (repeat :tag "Argument List" 45 (repeat :tag "Argument List"
46 :value ("") 46 :value ("")
47 string)) 47 string))
48 :version "21.1"
48 :group 'vc) 49 :group 'vc)
49 50
50 (defcustom vc-rcs-checkin-switches nil 51 (defcustom vc-rcs-checkin-switches nil
51 "*A string or list of strings specifying extra switches for RCS checkin. 52 "*A string or list of strings specifying extra switches for RCS checkin.
52 These are passed to the checkin program by \\[vc-rcs-checkin]." 53 These are passed to the checkin program by \\[vc-rcs-checkin]."
53 :type '(choice (const :tag "None" nil) 54 :type '(choice (const :tag "None" nil)
54 (string :tag "Argument String") 55 (string :tag "Argument String")
55 (repeat :tag "Argument List" 56 (repeat :tag "Argument List"
56 :value ("") 57 :value ("")
57 string)) 58 string))
59 :version "21.1"
58 :group 'vc) 60 :group 'vc)
59 61
60 (defcustom vc-rcs-checkout-switches nil 62 (defcustom vc-rcs-checkout-switches nil
61 "*A string or list of strings specifying extra switches for RCS checkout. 63 "*A string or list of strings specifying extra switches for RCS checkout.
62 These are passed to the checkout program by \\[vc-rcs-checkout]." 64 These are passed to the checkout program by \\[vc-rcs-checkout]."
63 :type '(choice (const :tag "None" nil) 65 :type '(choice (const :tag "None" nil)
64 (string :tag "Argument String") 66 (string :tag "Argument String")
65 (repeat :tag "Argument List" 67 (repeat :tag "Argument List"
66 :value ("") 68 :value ("")
67 string)) 69 string))
70 :version "21.1"
68 :group 'vc) 71 :group 'vc)
69 72
70 (defcustom vc-rcs-header (or (cdr (assoc 'RCS vc-header-alist)) '("\$Id\$")) 73 (defcustom vc-rcs-header (or (cdr (assoc 'RCS vc-header-alist)) '("\$Id\$"))
71 "*Header keywords to be inserted by `vc-insert-headers'." 74 "*Header keywords to be inserted by `vc-insert-headers'."
72 :type 'string 75 :type 'string
76 :version "21.1"
73 :group 'vc) 77 :group 'vc)
74 78
75 (defcustom vc-rcsdiff-knows-brief nil 79 (defcustom vc-rcsdiff-knows-brief nil
76 "*Indicates whether rcsdiff understands the --brief option. 80 "*Indicates whether rcsdiff understands the --brief option.
77 The value is either `yes', `no', or nil. If it is nil, VC tries 81 The value is either `yes', `no', or nil. If it is nil, VC tries
87 :type '(choice (const :tag "Use standard RCS file names" 91 :type '(choice (const :tag "Use standard RCS file names"
88 '("%sRCS/%s,v" "%s%s,v" "%sRCS/%s")) 92 '("%sRCS/%s,v" "%s%s,v" "%sRCS/%s"))
89 (repeat :tag "User-specified" 93 (repeat :tag "User-specified"
90 (choice string 94 (choice string
91 function))) 95 function)))
92 :version "20.5" 96 :version "21.1"
93 :group 'vc) 97 :group 'vc)
94 98
95 ;;;###autoload 99 ;;;###autoload
96 (progn (defun vc-rcs-registered (f) (vc-default-registered 'RCS f))) 100 (progn (defun vc-rcs-registered (f) (vc-default-registered 'RCS f)))
97 101
102 (vc-rcs-consult-headers file))) 106 (vc-rcs-consult-headers file)))
103 (let ((state 107 (let ((state
104 ;; vc-workfile-version might not be known; in that case the 108 ;; vc-workfile-version might not be known; in that case the
105 ;; property is nil. vc-rcs-fetch-master-state knows how to 109 ;; property is nil. vc-rcs-fetch-master-state knows how to
106 ;; handle that. 110 ;; handle that.
107 (vc-rcs-fetch-master-state file 111 (vc-rcs-fetch-master-state file
108 (vc-file-getprop file 112 (vc-file-getprop file
109 'vc-workfile-version)))) 113 'vc-workfile-version))))
110 (if (eq state 'up-to-date) 114 (if (eq state 'up-to-date)
111 (if (vc-workfile-unchanged-p file) 115 (if (vc-workfile-unchanged-p file)
112 'up-to-date 116 'up-to-date
113 'unlocked-changes) 117 'unlocked-changes)
114 state))) 118 state)))
115 119
116 (defun vc-rcs-state-heuristic (file) 120 (defun vc-rcs-state-heuristic (file)
117 "State heuristic for RCS." 121 "State heuristic for RCS."
118 (let (vc-rcs-headers-result) 122 (let (vc-rcs-headers-result)
119 (if (and vc-consult-headers 123 (if (and vc-consult-headers
120 (setq vc-rcs-headers-result 124 (setq vc-rcs-headers-result
121 (vc-rcs-consult-headers file)) 125 (vc-rcs-consult-headers file))
122 (eq vc-rcs-headers-result 'rev-and-lock)) 126 (eq vc-rcs-headers-result 'rev-and-lock))
123 (let ((state (vc-file-getprop file 'vc-state))) 127 (let ((state (vc-file-getprop file 'vc-state)))
124 ;; If the headers say that the file is not locked, the 128 ;; If the headers say that the file is not locked, the
125 ;; permissions can tell us whether locking is used for 129 ;; permissions can tell us whether locking is used for
179 (setq latest-rev rev) 183 (setq latest-rev rev)
180 (setq value (match-string 1))))) 184 (setq value (match-string 1)))))
181 value)) 185 value))
182 186
183 (defun vc-rcs-fetch-master-state (file &optional workfile-version) 187 (defun vc-rcs-fetch-master-state (file &optional workfile-version)
184 "Compute the master file's idea of the state of FILE. If a 188 "Compute the master file's idea of the state of FILE.
185 WORKFILE-VERSION is given, compute the state of that version, 189 If a WORKFILE-VERSION is given, compute the state of that version,
186 otherwise determine the workfile version based on the master file. 190 otherwise determine the workfile version based on the master file.
187 This function sets the properties `vc-workfile-version' and 191 This function sets the properties `vc-workfile-version' and
188 `vc-checkout-model' to their correct values, based on the master 192 `vc-checkout-model' to their correct values, based on the master
189 file." 193 file."
190 (with-temp-buffer 194 (with-temp-buffer
225 "[^0-9.]") 229 "[^0-9.]")
226 1))) 230 1)))
227 (cond 231 (cond
228 ;; not locked 232 ;; not locked
229 ((not locking-user) 233 ((not locking-user)
230 (if (or workfile-is-latest 234 (if (or workfile-is-latest
231 (vc-rcs-latest-on-branch-p file workfile-version)) 235 (vc-rcs-latest-on-branch-p file workfile-version))
232 ;; workfile version is latest on branch 236 ;; workfile version is latest on branch
233 'up-to-date 237 'up-to-date
234 ;; workfile version is not latest on branch 238 ;; workfile version is not latest on branch
235 'needs-patch)) 239 'needs-patch))
514 (defun vc-rcs-rename-file (old new) 518 (defun vc-rcs-rename-file (old new)
515 ;; Just move the master file (using vc-rcs-master-templates). 519 ;; Just move the master file (using vc-rcs-master-templates).
516 (vc-rename-master (vc-name old) new vc-rcs-master-templates)) 520 (vc-rename-master (vc-name old) new vc-rcs-master-templates))
517 521
518 (defun vc-release-greater-or-equal (r1 r2) 522 (defun vc-release-greater-or-equal (r1 r2)
519 "Compare release numbers, represented as strings. Release 523 "Compare release numbers, represented as strings.
520 components are assumed cardinal numbers, not decimal fractions \(5.10 524 Release components are assumed cardinal numbers, not decimal fractions
521 is a higher release than 5.9\). Omitted fields are considered lower 525 \(5.10 is a higher release than 5.9\). Omitted fields are considered
522 \(5.6.7 is earlier than 5.6.7.1\). Comparison runs till the end of 526 lower \(5.6.7 is earlier than 5.6.7.1\). Comparison runs till the end
523 the string is found, or a non-numeric component shows up \(5.6.7 is 527 of the string is found, or a non-numeric component shows up \(5.6.7 is
524 earlier than \"5.6.7 beta\", which is probably not what you want in 528 earlier than \"5.6.7 beta\", which is probably not what you want in
525 some cases\). This code is suitable for existing RCS release numbers. 529 some cases\). This code is suitable for existing RCS release numbers.
526 CVS releases are handled reasonably, too \(1.3 < 1.4* < 1.5\)." 530 CVS releases are handled reasonably, too \(1.3 < 1.4* < 1.5\)."
527 (let (v1 v2 i1 i2) 531 (let (v1 v2 i1 i2)
528 (catch 'done 532 (catch 'done
542 (or (and (string-match "^\\.?\\([0-9]+\\)" r2) 546 (or (and (string-match "^\\.?\\([0-9]+\\)" r2)
543 (throw 'done nil)) 547 (throw 'done nil))
544 (throw 'done t))))) 548 (throw 'done t)))))
545 549
546 (defun vc-rcs-release-p (release) 550 (defun vc-rcs-release-p (release)
547 "Return t if we have RELEASE or better" 551 "Return t if we have RELEASE or better."
548 (let ((installation (vc-rcs-system-release))) 552 (let ((installation (vc-rcs-system-release)))
549 (if (and installation 553 (if (and installation
550 (not (eq installation 'unknown))) 554 (not (eq installation 'unknown)))
551 (vc-release-greater-or-equal installation release)))) 555 (vc-release-greater-or-equal installation release))))
552 556
666 ;; (will be stored into the vc-name property) 670 ;; (will be stored into the vc-name property)
667 (vc-rcs-registered file) 671 (vc-rcs-registered file)
668 (vc-file-setprop file 'vc-name 672 (vc-file-setprop file 'vc-name
669 (if (file-name-absolute-p name) 673 (if (file-name-absolute-p name)
670 name 674 name
671 (expand-file-name 675 (expand-file-name
672 name 676 name
673 (file-name-directory file)))))) 677 (file-name-directory file))))))
674 (vc-file-setprop file 'vc-workfile-version 678 (vc-file-setprop file 'vc-workfile-version
675 (if (re-search-forward 679 (if (re-search-forward
676 "^initial revision: \\([0-9.]+\\).*\n" 680 "^initial revision: \\([0-9.]+\\).*\n"
677 nil t) 681 nil t)
678 (match-string 1)))))) 682 (match-string 1))))))
679 683
680 (defun vc-rcs-checkout (file &optional writable rev workfile) 684 (defun vc-rcs-checkout (file &optional writable rev workfile)
712 (current-buffer) 0 "co" (vc-name file) 716 (current-buffer) 0 "co" (vc-name file)
713 "-q" ;; suppress diagnostic output 717 "-q" ;; suppress diagnostic output
714 (if writable "-l") 718 (if writable "-l")
715 (concat "-p" rev) 719 (concat "-p" rev)
716 switches))) 720 switches)))
717 (set-file-modes filename 721 (set-file-modes filename
718 (logior (file-modes (vc-name file)) 722 (logior (file-modes (vc-name file))
719 (if writable 128 0))) 723 (if writable 128 0)))
720 (setq failed nil)) 724 (setq failed nil))
721 (and failed (file-exists-p filename) 725 (and failed (file-exists-p filename)
722 (delete-file filename)))) 726 (delete-file filename))))
723 (let (new-version) 727 (let (new-version)
724 ;; if we should go to the head of the trunk, 728 ;; if we should go to the head of the trunk,
725 ;; clear the default branch first 729 ;; clear the default branch first
726 (and rev (string= rev "") 730 (and rev (string= rev "")