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