1 ;;; vc-src.el --- support for SRC version-control -*- lexical-binding:t -*-
3 ;; Copyright (C) 1992-2014 Free Software Foundation, Inc.
5 ;; Author: FSF (see vc.el for full credits)
6 ;; Maintainer: Eric S. Raymond <esr@thyrsus.com>
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;; See vc.el. SRC requires an underlying RCS version of 4.0 or greater.
28 ;; FUNCTION NAME STATUS
30 ;; * revision-granularity OK
31 ;; STATE-QUERYING FUNCTIONS
32 ;; * registered (file) OK
34 ;; - state-heuristic (file) NOT NEEDED
35 ;; * dir-status (dir update-function) OK
36 ;; - dir-status-files (dir files ds uf) ??
37 ;; - dir-extra-headers (dir) NOT NEEDED
38 ;; - dir-printer (fileinfo) ??
39 ;; * working-revision (file) OK
40 ;; - latest-on-branch-p (file) ??
41 ;; * checkout-model (files) OK
42 ;; * workfile-unchanged-p (file) OK
43 ;; - mode-line-string (file) NOT NEEDED
44 ;; STATE-CHANGING FUNCTIONS
45 ;; * register (files &optional rev comment) OK
46 ;; * create-repo () OK
47 ;; - init-revision () NOT NEEDED
48 ;; * responsible-p (file) OK
49 ;; * could-register (file) OK
50 ;; - receive-file (file rev) NOT NEEDED
51 ;; - unregister (file) NOT NEEDED
52 ;; * checkin (files comment) OK
53 ;; * find-revision (file rev buffer) OK
54 ;; * checkout (file &optional rev) OK
55 ;; * revert (file &optional contents-done) OK
56 ;; - rollback (files) NOT NEEDED
57 ;; - merge (file rev1 rev2) NOT NEEDED
58 ;; - merge-news (file) NOT NEEDED
59 ;; - steal-lock (file &optional revision) NOT NEEDED
61 ;; * print-log (files buffer &optional shortlog start-revision limit) OK
62 ;; - log-view-mode () ??
63 ;; - show-log-entry (revision) NOT NEEDED
64 ;; - comment-history (file) NOT NEEDED
65 ;; - update-changelog (files) NOT NEEDED
66 ;; * diff (files &optional rev1 rev2 buffer) OK
67 ;; - revision-completion-table (files) ??
68 ;; - annotate-command (file buf &optional rev) ??
69 ;; - annotate-time () ??
70 ;; - annotate-current-time () NOT NEEDED
71 ;; - annotate-extract-revision-at-line () ??
73 ;; - create-tag (dir name branchp) ??
74 ;; - retrieve-tag (dir name update) ??
76 ;; - make-version-backups-p (file) ??
77 ;; - repository-hostname (dirname) NOT NEEDED
78 ;; - previous-revision (file rev) ??
79 ;; - next-revision (file rev) ??
80 ;; - check-headers () ??
81 ;; - clear-headers () ??
82 ;; - delete-file (file) ??
83 ;; * rename-file (old new) OK
84 ;; - find-file-hook () NOT NEEDED
90 ;;; Customization options
102 (defcustom vc-src-release nil
103 "The release number of your SRC installation, as a string.
104 If nil, VC itself computes this value when it is first needed."
105 :type
'(choice (const :tag
"Auto" nil
)
106 (string :tag
"Specified")
107 (const :tag
"Unknown" unknown
))
110 (defcustom vc-src-program
"src"
111 "Name of the SRC executable (excluding any arguments)."
115 (defcustom vc-src-diff-switches nil
116 "String or list of strings specifying switches for SRC diff under VC.
117 If nil, use the value of `vc-diff-switches'. If t, use no switches."
118 :type
'(choice (const :tag
"Unspecified" nil
)
119 (const :tag
"None" t
)
120 (string :tag
"Argument String")
121 (repeat :tag
"Argument List" :value
("") string
))
124 ;; This needs to be autoloaded because vc-src-registered uses it (via
125 ;; vc-default-registered), and vc-hooks needs to be able to check
126 ;; for a registered backend without loading every backend.
128 (defcustom vc-src-master-templates
129 (purecopy '("%s.src/%s,v"))
130 "Where to look for SRC master files.
131 For a description of possible values, see `vc-check-master-templates'."
132 :type
'(choice (const :tag
"Use standard SRC file names"
134 (repeat :tag
"User-specified"
140 ;;; Properties of the backend
142 (defun vc-src-revision-granularity () 'file
)
143 (defun vc-src-checkout-model (_files) 'implicit
)
146 ;;; State-querying functions
149 ;; The autoload cookie below places vc-src-registered directly into
150 ;; loaddefs.el, so that vc-src.el does not need to be loaded for
151 ;; every file that is visited.
154 (defun vc-src-registered (f) (vc-default-registered 'src f
)))
156 (defun vc-src-state (file)
157 "SRC-specific version of `vc-state'."
160 (default-directory (file-name-directory file
))
162 (with-output-to-string
166 ;; Ignore all errors.
169 vc-src-program nil t nil
170 "status" "-a" (file-relative-name file
))
173 (when (null (string-match "does not exist or is unreadable" out
))
174 (let ((state (aref out
0)))
176 ;; FIXME: What to do about A and L codes?
177 ((eq state ?.
) 'up-to-date
)
178 ((eq state ?A
) 'added
)
179 ((eq state ?M
) 'edited
)
180 ((eq state ?I
) 'ignored
)
181 ((eq state ?R
) 'removed
)
182 ((eq state ?
!) 'missing
)
183 ((eq state ??
) 'unregistered
)
184 (t 'up-to-date
)))))))
186 (autoload 'vc-expand-dirs
"vc")
188 (defun vc-src-dir-status (dir update-function
)
189 ;; FIXME: this function should be rewritten or `vc-expand-dirs'
190 ;; should be changed to take a backend parameter. Using
191 ;; `vc-expand-dirs' is not TRTD because it returns files from
192 ;; multiple backends. It should also return 'unregistered files.
194 ;; FIXME: Use one src status -a call for this
195 (let ((flist (vc-expand-dirs (list dir
)))
198 (let ((state (vc-state file
))
199 (frel (file-relative-name file
)))
200 (when (and (eq (vc-backend file
) 'SRC
)
201 (not (eq state
'up-to-date
)))
202 (push (list frel state
) result
))))
203 (funcall update-function result
)))
205 (defun vc-src-command (buffer file-or-list
&rest flags
)
206 "A wrapper around `vc-do-command' for use in vc-src.el.
207 This function differs from vc-do-command in that it invokes `vc-src-program'."
208 (apply 'vc-do-command
(or buffer
"*vc*") 0 vc-src-program file-or-list flags
))
210 (defun vc-src-working-revision (file)
211 "SRC-specific version of `vc-working-revision'."
213 (with-output-to-string
214 (vc-src-command standard-output file
"list" "-f{1}" "@")))
217 (defun vc-src-workfile-unchanged-p (file)
218 (eq 'up-to-date
(vc-src-state file
)))
221 ;;; State-changing functions
224 (defun vc-src-create-repo ()
225 "Create a new SRC repository."
226 ;; SRC is totally file-oriented, so all we have to do is make the directory.
227 (make-directory ".src"))
229 (autoload 'vc-switches
"vc")
231 (defun vc-src-register (files &optional _rev _comment
)
232 "Register FILES under src.
235 (vc-src-command nil files
"add"))
237 (defun vc-src-responsible-p (file)
238 "Return non-nil if SRC thinks it would be responsible for registering FILE."
239 (file-directory-p (expand-file-name ".src"
240 (if (file-directory-p file
)
242 (file-name-directory file
)))))
244 (defalias 'vc-could-register
'vc-src-responsible-p
)
246 (defun vc-src-checkin (files comment
)
247 "SRC-specific version of `vc-backend-checkin'.
249 (vc-src-command nil files
"commit" "-m" comment
))
251 (defun vc-src-find-revision (file rev buffer
)
252 (let ((coding-system-for-read 'binary
)
253 (coding-system-for-write 'binary
))
255 (vc-src-command buffer file
"cat" rev
)
256 (vc-src-command buffer file
"cat"))))
258 (defun vc-src-checkout (file &optional rev
)
259 "Retrieve a revision of FILE.
260 REV is the revision to check out into WORKFILE."
262 (vc-src-command nil file
"co" rev
)
263 (vc-src-command nil file
"co")))
265 (defun vc-src-revert (file &optional _contents-done
)
266 "Revert FILE to the version it was based on. If FILE is a directory,
267 revert all registered files beneath it."
268 (if (file-directory-p file
)
269 (mapc 'vc-src-revert
(vc-expand-dirs (list file
)))
270 (vc-src-command nil file
"co")))
272 (defun vc-src-modify-change-comment (files rev comment
)
273 "Modify the change comments change on FILES on a specified REV. If FILE is a
274 directory the operation is applied to all registered files beneath it."
275 (dolist (file (vc-expand-dirs files
))
276 (vc-src-command nil file
"amend" "-m" comment rev
)))
280 (defcustom vc-src-log-switches nil
281 "String or list of strings specifying switches for src log under VC."
282 :type
'(choice (const :tag
"None" nil
)
283 (string :tag
"Argument String")
284 (repeat :tag
"Argument List" :value
("") string
))
287 (defun vc-src-print-log (files buffer
&optional shortlog start-revision limit
)
288 "Print commit log associated with FILES into specified BUFFER.
289 If SHORTLOG is non-nil, use the list method.
290 If START-REVISION is non-nil, it is the newest revision to show.
291 If LIMIT is non-nil, show no more than this many entries."
292 ;; FIXME: Implement the range restrictions.
293 ;; `vc-do-command' creates the buffer, but we need it before running
295 (vc-setup-buffer buffer
)
296 ;; If the buffer exists from a previous invocation it might be
298 (let ((inhibit-read-only t
))
301 (apply 'vc-src-command buffer files
(if shortlog
"list" "log")
303 ;;(when start-revision (list (format "%s-1" start-revision)))
304 (when limit
(list "-l" (format "%s" limit
)))
305 vc-src-log-switches
)))))
307 (defun vc-src-diff (files &optional oldvers newvers buffer
)
308 "Get a difference report using src between two revisions of FILES."
309 (let* ((firstfile (car files
))
310 (working (and firstfile
(vc-working-revision firstfile
))))
311 (when (and (equal oldvers working
) (not newvers
))
313 (when (and (not oldvers
) newvers
)
314 (setq oldvers working
))
315 (apply #'vc-src-command
(or buffer
"*vc-diff*") files
"diff"
318 (list (concat oldvers
"-" newvers
))
323 (defun vc-src-rename-file (old new
)
324 "Rename file from OLD to NEW using `src mv'."
325 (vc-src-command nil
0 new
"mv" old
))
329 ;;; vc-src.el ends here