|
0
|
1 ;;; vc-hooks.el --- resident support for version-control
|
|
|
2
|
|
|
3 ;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
|
|
|
4 ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
|
|
|
5
|
|
|
6 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
|
|
|
7 ;; Maintainer: ttn@netcom.com
|
|
|
8 ;; Version: 5.3 + CVS hacks by ceder@lysator.liu.se made in Jan-Feb 1994.
|
|
|
9 ;;
|
|
|
10 ;; XEmacs fixes, CVS fixes, and general improvements
|
|
|
11 ;; by Jonathan Stigelman <Stig@hackvan.com>
|
|
|
12
|
|
|
13 ;; This file is part of XEmacs.
|
|
|
14
|
|
|
15 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
16 ;; under the terms of the GNU General Public License as published by
|
|
|
17 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
18 ;; any later version.
|
|
|
19
|
|
|
20 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
21 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
23 ;; General Public License for more details.
|
|
|
24
|
|
|
25 ;; You should have received a copy of the GNU General Public License
|
|
16
|
26 ;; along with XEmacs; see the file COPYING. If not, write to the
|
|
|
27 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
28 ;; Boston, MA 02111-1307, USA.
|
|
0
|
29
|
|
|
30 ;;; Synched up with: FSF 19.28.
|
|
|
31
|
|
|
32 ;;; Commentary:
|
|
|
33
|
|
|
34 ;; See the commentary of vc.el.
|
|
|
35
|
|
|
36 ;;; Code:
|
|
|
37
|
|
|
38 (defvar vc-master-templates
|
|
|
39 '(("%sRCS/%s,v" . RCS) ("%s%s,v" . RCS) ("%sRCS/%s" . RCS)
|
|
|
40 ("%sSCCS/s.%s" . SCCS) ("%ss.%s". SCCS)
|
|
|
41 ("%s%s@@" . CC)
|
|
|
42 vc-find-cvs-master)
|
|
|
43 "*Where to look for version-control master files.
|
|
|
44 The first pair corresponding to a given back end is used as a template
|
|
|
45 when creating new masters.")
|
|
|
46
|
|
|
47 (defvar vc-make-backup-files nil
|
|
|
48 "*If non-nil, backups of registered files are made as with other files.
|
|
|
49 If nil (the default), files covered by version control don't get backups.")
|
|
|
50
|
|
|
51 (defvar vc-display-status t
|
|
|
52 "*If non-nil, display revision number and lock status in modeline.
|
|
|
53 Otherwise, not displayed.")
|
|
|
54
|
|
|
55 ;; Tell Emacs about this new kind of minor mode
|
|
|
56 ;(if (not (assoc 'vc-mode minor-mode-alist))
|
|
|
57 ; (setq minor-mode-alist (cons '(vc-mode vc-mode)
|
|
|
58 ; minor-mode-alist)))
|
|
|
59 ;; NO! Do it right.
|
|
|
60 (add-minor-mode 'vc-mode 'vc-mode)
|
|
|
61
|
|
|
62 (defvar vc-mode nil) ; used for modeline flag
|
|
|
63 (make-variable-buffer-local 'vc-mode)
|
|
|
64 (put 'vc-mode 'permanent-local t)
|
|
|
65
|
|
|
66 ;; We need a notion of per-file properties because the version
|
|
|
67 ;; control state of a file is expensive to derive --- we don't
|
|
|
68 ;; want to recompute it even on every find.
|
|
|
69
|
|
|
70 (defmacro vc-error-occurred (&rest body)
|
|
|
71 (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t)))
|
|
|
72
|
|
|
73 (defvar vc-file-prop-obarray (make-vector 17 0)
|
|
|
74 "Obarray for per-file properties.")
|
|
|
75
|
|
|
76 (defun vc-file-setprop (file property value)
|
|
|
77 ;; set per-file property
|
|
|
78 (put (intern file vc-file-prop-obarray) property value))
|
|
|
79
|
|
|
80 (defun vc-file-getprop (file property)
|
|
|
81 ;; get per-file property
|
|
|
82 (get (intern file vc-file-prop-obarray) property))
|
|
|
83
|
|
|
84 ;;; actual version-control code starts here
|
|
|
85
|
|
|
86 (defun vc-registered (file)
|
|
|
87 (let (handler)
|
|
|
88 (if (boundp 'file-name-handler-alist)
|
|
|
89 (setq handler (find-file-name-handler file 'vc-registered)))
|
|
|
90 (if handler
|
|
|
91 (funcall handler 'vc-registered file)
|
|
|
92 ;; Search for a master corresponding to the given file
|
|
|
93 (let ((dirname (or (file-name-directory file) ""))
|
|
|
94 (basename (file-name-nondirectory file)))
|
|
|
95 (catch 'found
|
|
|
96 (mapcar
|
|
|
97 (function (lambda (s)
|
|
|
98 (if (atom s)
|
|
|
99 (funcall s dirname basename)
|
|
|
100 (let ((trial (format (car s) dirname basename)))
|
|
|
101 (if (and (file-exists-p trial)
|
|
|
102 ;; Make sure the file we found with name
|
|
|
103 ;; TRIAL is not the source file itself.
|
|
|
104 ;; That can happen with RCS-style names
|
|
|
105 ;; if the file name is truncated
|
|
|
106 ;; (e.g. to 14 chars). See if either
|
|
|
107 ;; directory or attributes differ.
|
|
|
108 (or (not (string= dirname
|
|
|
109 (file-name-directory trial)))
|
|
|
110 (not (equal
|
|
|
111 (file-attributes file)
|
|
|
112 (file-attributes trial)))))
|
|
|
113 (throw 'found (cons trial (cdr s))))))))
|
|
|
114 vc-master-templates)
|
|
|
115 nil)))))
|
|
|
116
|
|
|
117 (defun vc-find-cvs-master (dirname basename)
|
|
|
118 ;; Check if DIRNAME/BASENAME is handled by CVS.
|
|
|
119 ;; If it is, do a (throw 'found (cons MASTER 'CVS)).
|
|
|
120 ;; Note: If the file is ``cvs add''ed but not yet ``cvs commit''ed
|
|
|
121 ;; the MASTER will not actually exist yet. The other parts of VC
|
|
|
122 ;; checks for this condition. This function returns something random if
|
|
|
123 ;; DIRNAME/BASENAME is not handled by CVS.
|
|
|
124 (and (string= "" dirname) (setq dirname default-directory))
|
|
|
125 (if (and (file-directory-p (concat dirname "CVS/"))
|
|
|
126 (file-readable-p (concat dirname "CVS/Entries")))
|
|
|
127 (let ((fname (concat dirname basename))
|
|
|
128 sbuf rev)
|
|
|
129 (unwind-protect
|
|
|
130 (save-excursion
|
|
|
131 (set-buffer (generate-new-buffer " vc-scratch"))
|
|
|
132 (setq sbuf (current-buffer))
|
|
|
133 (insert-file-contents (concat dirname "CVS/Entries"))
|
|
|
134 (cond
|
|
|
135 ((re-search-forward
|
|
|
136 (concat "^/" (regexp-quote basename) "/\\([0-9.]*\\)/.*/\\(T\\([^/\n]+\\)\\)?$")
|
|
|
137 nil t)
|
|
|
138 ;; We found it. Store version number, and branch tag
|
|
|
139 (setq rev (buffer-substring (match-beginning 1)
|
|
|
140 (match-end 1)))
|
|
|
141 (vc-file-setprop fname 'vc-your-latest-version rev)
|
|
|
142 ;; XEmacs - we put something useful in the modeline
|
|
|
143 (vc-file-setprop fname 'sticky-tag
|
|
|
144 (cond ((string= "0" rev) "newfile")
|
|
|
145 ((match-beginning 3)
|
|
|
146 (buffer-substring (match-beginning 3)
|
|
|
147 (match-end 3)))
|
|
|
148 (t "main")))
|
|
|
149 (erase-buffer)
|
|
|
150 (insert-file-contents (concat dirname "CVS/Repository"))
|
|
|
151 (let ((master
|
|
|
152 (concat (file-name-as-directory
|
|
|
153 (buffer-substring (point-min)
|
|
|
154 (1- (point-max))))
|
|
|
155 basename
|
|
|
156 ",v")))
|
|
|
157 (throw 'found (cons master 'CVS))))))
|
|
|
158 (kill-buffer sbuf)))))
|
|
|
159
|
|
|
160 (defun vc-name (file)
|
|
|
161 "Return the master name of a file, nil if it is not registered."
|
|
|
162 (or (vc-file-getprop file 'vc-name)
|
|
|
163 (let ((name-and-type (vc-registered file)))
|
|
|
164 (if name-and-type
|
|
|
165 (progn
|
|
|
166 (vc-file-setprop file 'vc-backend (cdr name-and-type))
|
|
|
167 (vc-file-setprop file 'vc-name (car name-and-type)))))))
|
|
|
168
|
|
|
169 (defun vc-backend-deduce (file)
|
|
|
170 "Return the version-control type of a file, nil if it is not registered."
|
|
|
171 (and file
|
|
|
172 (or (vc-file-getprop file 'vc-backend)
|
|
|
173 (let ((name-and-type (vc-registered file)))
|
|
|
174 (if name-and-type
|
|
|
175 (progn
|
|
|
176 (vc-file-setprop file 'vc-name (car name-and-type))
|
|
|
177 (vc-file-setprop file 'vc-backend (cdr name-and-type))))))))
|
|
|
178
|
|
|
179 (defun vc-toggle-read-only (&optional verbose)
|
|
|
180 "Change read-only status of current buffer, perhaps via version control.
|
|
|
181 If the buffer is visiting a file registered with a form of version control
|
|
|
182 that locks files by making them read-only (i.e.: not CVS), then check the
|
|
|
183 file in or out. Otherwise, just change the read-only flag of the buffer.
|
|
|
184
|
|
|
185 If you provide a prefix argument, we pass it on to `vc-next-action'."
|
|
|
186 (interactive "P")
|
|
|
187 (let ((vc-type (vc-backend-deduce (buffer-file-name))))
|
|
|
188 (cond ((and vc-type
|
|
|
189 buffer-read-only
|
|
|
190 (file-writable-p buffer-file-name)
|
|
|
191 (/= 0 (user-uid)))
|
|
|
192 ;; XEmacs - The buffer isn't read-only because it's locked, so
|
|
|
193 ;; keep vc out of this...
|
|
|
194 (toggle-read-only))
|
|
|
195 ((and vc-type (not (eq 'CVS vc-type)))
|
|
|
196 (vc-next-action verbose))
|
|
|
197 (t
|
|
|
198 (toggle-read-only)))
|
|
|
199 ))
|
|
|
200
|
|
|
201 (define-key global-map "\C-x\C-q" 'vc-toggle-read-only)
|
|
|
202
|
|
|
203 (defun vc-file-owner (file)
|
|
|
204 ;; XEmacs - vc-locking-user is just WAY too slow.
|
|
|
205 (let* ((fa (file-attributes file)))
|
|
|
206 (cond ((eq ?w (aref (nth 8 fa) 2)) ; -rw-r--r--
|
|
|
207 ;; #### - if it's writable, we trust unix...dumb move?
|
|
|
208 (user-login-name (nth 2 fa)))
|
|
|
209 (t
|
|
|
210 ;; big slowness here...
|
|
|
211 (require 'vc)
|
|
|
212 (vc-locking-user file)
|
|
|
213 ))))
|
|
|
214
|
|
|
215 (defun vc-mode-line (file &optional label)
|
|
|
216 "Set `vc-mode' to display type of version control for FILE.
|
|
|
217 The value is set in the current buffer, which should be the buffer
|
|
|
218 visiting FILE. Second optional arg LABEL is put in place of version
|
|
|
219 control system name."
|
|
|
220 (interactive (list buffer-file-name nil))
|
|
|
221 (if file
|
|
|
222 (let ((vc-type (vc-backend-deduce file)))
|
|
|
223 (setq vc-mode
|
|
|
224 (if vc-type
|
|
|
225 (concat " " (or label (symbol-name vc-type))
|
|
|
226 (if vc-display-status
|
|
|
227 (vc-status file vc-type)))))
|
|
|
228 ;; Even root shouldn't modify a registered file without
|
|
|
229 ;; locking it first.
|
|
|
230 (and vc-type
|
|
|
231 (not (string= (user-login-name) (vc-file-owner file)))
|
|
|
232 (setq buffer-read-only t))
|
|
|
233 (and (null vc-type)
|
|
|
234 (file-symlink-p file)
|
|
|
235 (let ((link-type (vc-backend-deduce (file-symlink-p file))))
|
|
|
236 (if link-type
|
|
|
237 (message
|
|
|
238 "Warning: symbolic link to %s-controlled source file"
|
|
|
239 link-type))))
|
|
|
240 (redraw-modeline)
|
|
|
241 ;;(set-buffer-modified-p (buffer-modified-p)) ;;use this if Emacs 18
|
|
|
242 vc-type)))
|
|
|
243
|
|
|
244 (defun vc-status (file vc-type)
|
|
|
245 ;; Return string for placement in modeline by `vc-mode-line'.
|
|
|
246 ;; If FILE is not registered, return nil.
|
|
|
247 ;; If FILE is registered but not locked, return " REV" if there is a head
|
|
|
248 ;; revision and " @@" otherwise.
|
|
|
249 ;; If FILE is locked then return all locks in a string of the
|
|
|
250 ;; form " LOCKER1:REV1 LOCKER2:REV2 ...", where "LOCKERi:" is empty if you
|
|
|
251 ;; are the locker, and otherwise is the name of the locker followed by ":".
|
|
|
252
|
|
|
253 ;; Algorithm:
|
|
|
254
|
|
|
255 ;; Check for master file corresponding to FILE being visited.
|
|
|
256 ;;
|
|
|
257 ;; RCS: Insert the first few characters of the master file into a
|
|
|
258 ;; work buffer. Search work buffer for "locks...;" phrase; if not
|
|
|
259 ;; found, then keep inserting more characters until the phrase is
|
|
|
260 ;; found. Extract the locks, and remove control characters
|
|
|
261 ;; separating them, like newlines; the string " user1:revision1
|
|
|
262 ;; user2:revision2 ..." is returned.
|
|
|
263 ;;
|
|
|
264 ;; SCCS: Check if the p-file exists. If it does, read it and
|
|
|
265 ;; extract the locks, giving them the right format. Else use prs to
|
|
|
266 ;; find the revision number.
|
|
|
267 ;;
|
|
|
268 ;; CVS: vc-find-cvs-master has already stored the current revision
|
|
|
269 ;; number and sticky-tag for the file. XEmacs displays the sticky-tag.
|
|
|
270
|
|
|
271 ;; Limitations:
|
|
|
272
|
|
|
273 ;; The output doesn't show which version you are actually looking at.
|
|
|
274 ;; The modeline can get quite cluttered when there are multiple locks.
|
|
|
275 ;; The head revision is probably not what you want if you've used `rcs -b'.
|
|
|
276
|
|
|
277 (let ((master (vc-name file))
|
|
|
278 found
|
|
|
279 status)
|
|
|
280
|
|
|
281 ;; If master file exists, then parse its contents, otherwise we
|
|
|
282 ;; return the nil value of this if form.
|
|
|
283 (if (and master vc-type)
|
|
|
284 (save-excursion
|
|
|
285
|
|
|
286 ;; Create work buffer.
|
|
|
287 (set-buffer (get-buffer-create " *vc-status*"))
|
|
|
288 (setq buffer-read-only nil
|
|
|
289 default-directory (file-name-directory master))
|
|
|
290 (erase-buffer)
|
|
|
291
|
|
|
292 ;; Set the `status' var to the return value.
|
|
|
293 (cond
|
|
|
294
|
|
|
295 ;; RCS code.
|
|
|
296 ((eq vc-type 'RCS)
|
|
|
297 ;; Check if we have enough of the header.
|
|
|
298 ;; If not, then keep including more.
|
|
|
299 (while
|
|
|
300 (not (or found
|
|
|
301 (let ((s (buffer-size)))
|
|
|
302 (goto-char (1+ s))
|
|
|
303 (zerop (car (cdr (insert-file-contents
|
|
|
304 master nil s (+ s 8192))))))))
|
|
|
305 (beginning-of-line)
|
|
|
306 (setq found (re-search-forward "^locks\\([^;]*\\);" nil t)))
|
|
|
307
|
|
|
308 (if found
|
|
|
309 ;; Clean control characters and self-locks from text.
|
|
|
310 (let* ((lock-pattern
|
|
|
311 (concat "[ \b\t\n\v\f\r]+\\("
|
|
|
312 (regexp-quote (user-login-name))
|
|
|
313 ":\\)?"))
|
|
|
314 (locks
|
|
|
315 (save-restriction
|
|
|
316 (narrow-to-region (match-beginning 1) (match-end 1))
|
|
|
317 (goto-char (point-min))
|
|
|
318 (while (re-search-forward lock-pattern nil t)
|
|
|
319 (replace-match (if (eobp) "" ":") t t))
|
|
|
320 (buffer-string))))
|
|
|
321 (setq status
|
|
|
322 (if (not (string-equal locks ""))
|
|
|
323 locks
|
|
|
324 (goto-char (point-min))
|
|
|
325 (if (looking-at "head[ \b\t\n\v\f\r]+\\([.0-9]+\\)")
|
|
|
326 (concat "-"
|
|
|
327 (buffer-substring (match-beginning 1)
|
|
|
328 (match-end 1)))
|
|
|
329 " @@"))))))
|
|
|
330
|
|
|
331 ;; SCCS code.
|
|
|
332 ((eq vc-type 'SCCS)
|
|
|
333 ;; Build the name of the p-file and put it in the work buffer.
|
|
|
334 (insert master)
|
|
|
335 (search-backward "/s.")
|
|
|
336 (delete-char 2)
|
|
|
337 (insert "/p")
|
|
|
338 (if (not (file-exists-p (buffer-string)))
|
|
|
339 ;; No lock.
|
|
|
340 (let ((exec-path (if (boundp 'vc-path) (append exec-path vc-path)
|
|
|
341 exec-path)))
|
|
|
342 (erase-buffer)
|
|
|
343 (insert "-")
|
|
|
344 (if (zerop (call-process "prs" nil t nil "-d:I:" master))
|
|
|
345 (setq status (buffer-substring 1 (1- (point-max))))))
|
|
|
346 ;; Locks exist.
|
|
|
347 (insert-file-contents (buffer-string) nil nil nil t)
|
|
|
348 (while (looking-at "[^ ]+ \\([^ ]+\\) \\([^ ]+\\).*\n")
|
|
|
349 (replace-match " \\2:\\1"))
|
|
|
350 (setq status (buffer-string))
|
|
|
351 (aset status 0 ?:)))
|
|
|
352 ;; CVS code.
|
|
|
353 ((eq vc-type 'CVS)
|
|
|
354 ;; sticky-tag is initialized by vc-backend-deduce
|
|
|
355 (setq status (concat ":" (vc-file-getprop file 'sticky-tag) "-"
|
|
|
356 (vc-file-getprop file 'vc-your-latest-version)
|
|
|
357 ))
|
|
|
358 )
|
|
|
359 ;; ClearCase code.
|
|
|
360 ((eq vc-type 'CC)
|
|
|
361 (require 'vc)
|
|
|
362 (setq status (concat ":" (vc-latest-version file)))
|
|
|
363 ))
|
|
|
364
|
|
|
365 ;; Clean work buffer.
|
|
|
366 (erase-buffer)
|
|
|
367 (set-buffer-modified-p nil)
|
|
|
368 status))))
|
|
|
369
|
|
|
370 ;;; install a call to the above as a find-file hook
|
|
|
371 (defun vc-find-file-hook ()
|
|
|
372 ;; Recompute whether file is version controlled,
|
|
|
373 ;; if user has killed the buffer and revisited.
|
|
|
374 (if buffer-file-name
|
|
|
375 (vc-file-setprop buffer-file-name 'vc-backend nil))
|
|
|
376 (if (and (vc-mode-line buffer-file-name) (not vc-make-backup-files))
|
|
|
377 (progn
|
|
|
378 ;; Use this variable, not make-backup-files,
|
|
|
379 ;; because this is for things that depend on the file name.
|
|
|
380 (set (make-local-variable 'backup-inhibited) t))))
|
|
|
381
|
|
|
382 (add-hook 'find-file-hooks 'vc-find-file-hook)
|
|
|
383
|
|
|
384 ;;; more hooks, this time for file-not-found
|
|
|
385 (defun vc-file-not-found-hook ()
|
|
|
386 "When file is not found, try to check it out from RCS or SCCS.
|
|
|
387 Returns t if checkout was successful, nil otherwise."
|
|
|
388 (if (vc-backend-deduce buffer-file-name)
|
|
|
389 (save-excursion
|
|
|
390 (require 'vc)
|
|
|
391 (not (vc-error-occurred (vc-checkout buffer-file-name))))))
|
|
|
392
|
|
|
393 (add-hook 'find-file-not-found-hooks 'vc-file-not-found-hook)
|
|
|
394
|
|
|
395 ;;; Now arrange for bindings and autoloading of the main package.
|
|
|
396 ;;; Bindings for this have to go in the global map, as we'll often
|
|
|
397 ;;; want to call them from random buffers.
|
|
|
398
|
|
|
399 ; XEmacs - this is preloaded. let's not be obtuse!
|
|
|
400 (defconst vc-prefix-map
|
|
|
401 (let ((map (make-sparse-keymap)))
|
|
|
402 (set-keymap-name map 'vc-prefix-map)
|
|
|
403 (define-key map "a" 'vc-update-change-log)
|
|
|
404 (define-key map "c" 'vc-cancel-version)
|
|
|
405 (define-key map "d" 'vc-directory)
|
|
|
406 (define-key map "h" 'vc-insert-headers)
|
|
|
407 (define-key map "i" 'vc-register)
|
|
|
408 (define-key map "l" 'vc-print-log)
|
|
|
409 (define-key map "r" 'vc-retrieve-snapshot)
|
|
|
410 (define-key map "s" 'vc-create-snapshot)
|
|
|
411 (define-key map "u" 'vc-revert-buffer)
|
|
|
412 (define-key map "v" 'vc-next-action)
|
|
|
413 (define-key map "=" 'vc-diff)
|
|
|
414 (define-key map "?" 'vc-file-status) ; XEmacs - this doesn't fit elsewhere
|
|
|
415 (define-key map "~" 'vc-version-other-window)
|
|
|
416 (global-set-key "\C-xv" map)
|
|
|
417 map
|
|
|
418 ))
|
|
|
419
|
|
|
420 ;; FSF menus...
|
|
|
421 ;; (if (not (boundp 'vc-menu-map))
|
|
|
422 ;; ;; Don't do the menu bindings if menu-bar.el wasn't loaded to defvar
|
|
|
423 ;; ;; vc-menu-map.
|
|
|
424 ;; ()
|
|
|
425 ;; ;;(define-key vc-menu-map [show-files]
|
|
|
426 ;; ;; '("Show Files under VC" . (vc-directory t)))
|
|
|
427 ;; (define-key vc-menu-map [vc-directory] '("Show Locked Files" . vc-directory))
|
|
|
428 ;; (define-key vc-menu-map [separator1] '("----"))
|
|
|
429 ;; (define-key vc-menu-map [vc-rename-file] '("Rename File" . vc-rename-file))
|
|
|
430 ;; (define-key vc-menu-map [vc-version-other-window]
|
|
|
431 ;; '("Show Other Version" . vc-version-other-window))
|
|
|
432 ;; (define-key vc-menu-map [vc-diff] '("Compare with Last Version" . vc-diff))
|
|
|
433 ;; (define-key vc-menu-map [vc-update-change-log]
|
|
|
434 ;; '("Update ChangeLog" . vc-update-change-log))
|
|
|
435 ;; (define-key vc-menu-map [vc-print-log] '("Show History" . vc-print-log))
|
|
|
436 ;; (define-key vc-menu-map [separator2] '("----"))
|
|
|
437 ;; (define-key vc-menu-map [undo] '("Undo Last Check-In" . vc-cancel-version))
|
|
|
438 ;; (define-key vc-menu-map [vc-revert-buffer]
|
|
|
439 ;; '("Revert to Last Version" . vc-revert-buffer))
|
|
|
440 ;; (define-key vc-menu-map [vc-insert-header]
|
|
|
441 ;; '("Insert Header" . vc-insert-headers))
|
|
|
442 ;; (define-key vc-menu-map [vc-menu-check-in] '("Check In" . vc-next-action))
|
|
|
443 ;; (define-key vc-menu-map [vc-check-out] '("Check Out" . vc-toggle-read-only))
|
|
|
444 ;; (define-key vc-menu-map [vc-register] '("Register" . vc-register))
|
|
|
445 ;; (put 'vc-rename-file 'menu-enable 'vc-mode)
|
|
|
446 ;; (put 'vc-version-other-window 'menu-enable 'vc-mode)
|
|
|
447 ;; (put 'vc-diff 'menu-enable 'vc-mode)
|
|
|
448 ;; (put 'vc-update-change-log 'menu-enable
|
|
|
449 ;; '(eq (vc-backend-deduce (buffer-file-name)) 'RCS))
|
|
|
450 ;; (put 'vc-print-log 'menu-enable 'vc-mode)
|
|
|
451 ;; (put 'vc-cancel-version 'menu-enable 'vc-mode)
|
|
|
452 ;; (put 'vc-revert-buffer 'menu-enable 'vc-mode)
|
|
|
453 ;; (put 'vc-insert-headers 'menu-enable 'vc-mode)
|
|
|
454 ;; (put 'vc-next-action 'menu-enable '(and vc-mode (not buffer-read-only)))
|
|
|
455 ;; (put 'vc-toggle-read-only 'menu-enable '(and vc-mode buffer-read-only))
|
|
|
456 ;; (put 'vc-register 'menu-enable '(not vc-mode))
|
|
|
457 ;; )
|
|
|
458
|
|
|
459 ;; #### - sync with fsf menus
|
|
|
460 (defconst vc-menu
|
|
|
461 '("VC"
|
|
|
462 :filter vc-menu-filter
|
|
|
463 ["" vc-next-action buffer-file-name nil]
|
|
|
464 ;; ^^^ this gets changed to checkin, checkout, register, or steal
|
|
|
465 ["Show status of" vc-file-status nil nil]
|
|
|
466 ;;["Show Locked Files" vc-directory t] ;; needs new dired
|
|
|
467 "----"
|
|
|
468 ["Revert to Last Revision" vc-revert-buffer vc-mode nil]
|
|
|
469 ["Cancel Last Checkin" vc-cancel-version vc-mode]
|
|
|
470 ["Rename File" vc-rename-this-file vc-mode nil]
|
|
|
471 "----"
|
|
|
472 ["Diff Against Last Version" vc-diff vc-mode]
|
|
|
473 ["Diff Between Revisions..." vc-version-diff vc-mode]
|
|
|
474 ;;["Ediff Between Revisions..." ediff-revision vc-mode]
|
|
|
475 ["Visit Other Version..." vc-version-other-window vc-mode]
|
|
|
476 ["Show Edit History" vc-print-log vc-mode]
|
|
|
477 "----"
|
|
|
478 ;; The two commented out List functions simply don't work at the
|
|
|
479 ;; moment.
|
|
|
480 ;;["List Locked Files" (vc-directory '(16)) t]
|
|
|
481 ["List Locked Files Any User" vc-directory t]
|
|
|
482 ;;["List Registered Files" (vc-directory '(4)) t]
|
|
|
483 "----"
|
|
|
484 ["Create Snapshot" vc-create-snapshot t]
|
|
|
485 ["Retrieve Snapshot" vc-retrieve-snapshot t]
|
|
|
486 "----"
|
|
|
487 ["CVS Update Directory" cvs-update t] ; pcl-cvs
|
|
|
488 ;;["Show File Status" vc-cvs-file-status vc-mode]
|
|
|
489 )
|
|
|
490 "Menubar entry for using the revision control system.")
|
|
|
491
|
|
|
492 (defun vc-menu-filter (menu-items)
|
|
|
493 (let* ((result menu-items) ; modify in-place
|
|
|
494 (case-fold-search t)
|
|
|
495 (type (vc-backend-deduce buffer-file-name))
|
|
|
496 (file (if buffer-file-name
|
|
|
497 (file-name-nondirectory buffer-file-name)
|
|
|
498 (buffer-name)))
|
|
|
499 op owner item status)
|
|
|
500 (setq op (cond ((null type)
|
|
|
501 "Register File")
|
|
|
502 ((eq type 'CVS)
|
|
|
503 (setq status
|
|
|
504 (vc-file-getprop buffer-file-name 'cvs-status))
|
|
|
505 (if status
|
|
|
506 (cdr (assoc status
|
|
|
507 '(("Locally Modified" . "Commit")
|
|
|
508 ("Needs Merge" . "Merge with repository")
|
|
|
509 ("Up-to-date" . "Do nothing to")
|
|
|
510 ("Needs Checkout" . "Update"))))
|
|
|
511 ;; #### - we're not gonna call cvs status just to
|
|
|
512 ;; post a lousy menu...that's insane!
|
|
|
513 "Next action on"
|
|
|
514 ))
|
|
|
515 ;; these are all for RCS and SCCS
|
|
|
516 ((not (setq owner (vc-file-owner file)))
|
|
|
517 ;; #### - ugh! this is broken.
|
|
|
518 ;; vc-file-owner is not a suitable
|
|
|
519 ;; substitute for vc-locking-user.
|
|
|
520 "Check out File")
|
|
|
521 ((not (string-equal owner (user-login-name)))
|
|
|
522 "Steal File Lock")
|
|
|
523 (t "Check in File")))
|
|
|
524 (while (setq item (pop menu-items))
|
|
|
525 (and (vectorp item)
|
|
|
526 (cond ((eq 'vc-next-action (aref item 1))
|
|
|
527 (aset item 0 op)
|
|
|
528 (aset item 3 file))
|
|
|
529 ((eq 'vc-file-status (aref item 1))
|
|
|
530 (aset item 2 (eq 'CVS type))
|
|
|
531 (aset item 3 file))
|
|
|
532 ((> (length item) 3)
|
|
|
533 (aset item 3 file)))))
|
|
|
534 result))
|
|
|
535
|
|
|
536 (add-hook 'before-init-hook
|
|
|
537 #'(lambda () (and (featurep 'menubar)
|
|
|
538 current-menubar
|
|
|
539 (car (find-menu-item current-menubar '("Tools")))
|
|
|
540 (add-submenu '("Tools") vc-menu "Compare")
|
|
|
541 (add-menu-item '("Tools") "---" nil nil "Compare"))
|
|
|
542 ))
|
|
|
543
|
|
|
544 ;; #### called by files.el. Define it like this until we're merged.
|
|
|
545 (defun vc-after-save ())
|
|
|
546
|
|
|
547 (provide 'vc-hooks)
|
|
|
548
|
|
|
549 ;;; vc-hooks.el ends here
|
