;;; vc-hooks.el --- resident support for version-control
;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
-;; 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+;; Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
(defcustom vc-ignore-dir-regexp
;; Stop SMB, automounter, AFS, and DFS host lookups.
- "\\`\\(?:[\\/][\\/]\\|/\\(?:net\\|afs\\|\\.\\\.\\.\\)/\\)\\'"
+ locate-dominating-stop-dir-regexp
"Regexp matching directory names that are not under VC's control.
The default regexp prevents fruitless and time-consuming attempts
to determine the VC status in directories in which filenames are
;; Note: we don't actually have a darcs back end yet.
;; Also, Meta-CVS (corresponsding to MCVS) is unsupported.
-(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS" "MCVS"
+(defcustom vc-directory-exclusion-list (purecopy '("SCCS" "RCS" "CVS" "MCVS"
".svn" ".git" ".hg" ".bzr"
- "_MTN" "_darcs" "{arch}")
+ "_MTN" "_darcs" "{arch}"))
"List of directory names to be ignored when walking directory trees."
:type '(repeat string)
:group 'vc)
(funcall vc-mistrust-permissions
(vc-backend-subdirectory-name file)))))
-(defcustom vc-stay-local t
+(defcustom vc-stay-local 'only-file
"Non-nil means use local operations when possible for remote repositories.
This avoids slow queries over the network and instead uses heuristics
and past information to determine the current status of a file.
+If value is the symbol `only-file' `vc-dir' will connect to the
+server, but heuristics will be used to determine the status for
+all other VC operations.
+
The value can also be a regular expression or list of regular
expressions to match against the host name of a repository; then VC
only stays local for hosts that match it. Alternatively, the value
can be a list of regular expressions where the first element is the
symbol `except'; then VC always stays local except for hosts matched
by these regular expressions."
- :type '(choice (const :tag "Always stay local" t)
+ :type '(choice
+ (const :tag "Always stay local" t)
+ (const :tag "Only for file operations" only-file)
(const :tag "Don't stay local" nil)
(list :format "\nExamine hostname and %v" :tag "Examine hostname ..."
(set :format "%v" :inline t (const :format "%t" :tag "don't" except))
(regexp :format " stay local,\n%t: %v" :tag "if it matches")
(repeat :format "%v%i\n" :inline t (regexp :tag "or"))))
- :version "22.1"
+ :version "23.1"
:group 'vc)
-(defun vc-stay-local-p (file)
+(defun vc-stay-local-p (file &optional backend)
"Return non-nil if VC should stay local when handling FILE.
This uses the `repository-hostname' backend operation.
If FILE is a list of files, return non-nil if any of them
individually should stay local."
(if (listp file)
- (delq nil (mapcar 'vc-stay-local-p file))
- (let* ((backend (vc-backend file))
- (sym (vc-make-backend-sym backend 'stay-local))
- (stay-local (if (boundp sym) (symbol-value sym) t)))
- (if (eq stay-local t) (setq stay-local vc-stay-local))
+ (delq nil (mapcar (lambda (arg) (vc-stay-local-p arg backend)) file))
+ (setq backend (or backend (vc-backend file)))
+ (let* ((sym (vc-make-backend-sym backend 'stay-local))
+ (stay-local (if (boundp sym) (symbol-value sym) vc-stay-local)))
(if (symbolp stay-local) stay-local
(let ((dirname (if (file-directory-p file)
(directory-file-name file)
;; Tell Emacs about this new kind of minor mode
;; (add-to-list 'minor-mode-alist '(vc-mode vc-mode))
+;;;###autoload
+(put 'vc-mode 'risky-local-variable t)
(make-variable-buffer-local 'vc-mode)
(put 'vc-mode 'permanent-local t)
(set-buffer-modified-p nil)
t))
-(defun vc-find-root (file witness &optional invert)
+(defun vc-find-root (file witness)
"Find the root of a checked out project.
The function walks up the directory tree from FILE looking for WITNESS.
-If WITNESS if not found, return nil, otherwise return the root.
-Optional arg INVERT non-nil reverses the sense of the check;
-the root is the last directory for which WITNESS *is* found."
- ;; Represent /home/luser/foo as ~/foo so that we don't try to look for
- ;; witnesses in /home or in /.
- (setq file (abbreviate-file-name file))
- (let ((root nil)
- (prev-file file)
- ;; `user' is not initialized outside the loop because
- ;; `file' may not exist, so we may have to walk up part of the
- ;; hierarchy before we find the "initial UID".
- (user nil)
- try)
- (while (not (or root
- (null file)
- ;; As a heuristic, we stop looking up the hierarchy of
- ;; directories as soon as we find a directory belonging
- ;; to another user. This should save us from looking in
- ;; things like /net and /afs. This assumes that all the
- ;; files inside a project belong to the same user.
- (let ((prev-user user))
- (setq user (nth 2 (file-attributes file)))
- (and prev-user (not (equal user prev-user))))
- (string-match vc-ignore-dir-regexp file)))
- (setq try (file-exists-p (expand-file-name witness file)))
- (cond ((and invert (not try)) (setq root prev-file))
- ((and (not invert) try) (setq root file))
- ((equal file (setq prev-file file
- file (file-name-directory
- (directory-file-name file))))
- (setq file nil))))
- ;; Handle the case where ~/WITNESS exists and the original FILE is "~".
- ;; (This occurs, for example, when placing dotfiles under RCS.)
- (when (and (not root) invert prev-file)
- (setq root prev-file))
- root))
+If WITNESS if not found, return nil, otherwise return the root."
+ (let ((locate-dominating-stop-dir-regexp
+ (or vc-ignore-dir-regexp locate-dominating-stop-dir-regexp)))
+ (locate-dominating-file file witness)))
;; Access functions to file properties
;; (Properties should be _set_ using vc-file-setprop, but
backend is tried first."
(let (handler)
(cond
- ((and (file-name-directory file) (string-match vc-ignore-dir-regexp (file-name-directory file)))
+ ((and (file-name-directory file)
+ (string-match vc-ignore-dir-regexp (file-name-directory file)))
nil)
((and (boundp 'file-name-handler-alist)
(setq handler (find-file-name-handler file 'vc-registered)))
(or (vc-file-getprop file 'vc-name)
;; force computation of the property by calling
;; vc-BACKEND-registered explicitly
- (if (and (vc-backend file)
- (vc-call-backend (vc-backend file) 'registered file))
- (vc-file-getprop file 'vc-name))))
+ (let ((backend (vc-backend file)))
+ (if (and backend
+ (vc-call-backend backend 'registered file))
+ (vc-file-getprop file 'vc-name)))))
(defun vc-checkout-model (backend files)
"Indicate how FILES are checked out.
If FILES are not registered, this function always returns nil.
For registered files, the possible values are:
- 'implicit FILES are always writeable, and checked out `implicitly'
+ 'implicit FILES are always writable, and checked out `implicitly'
when the user saves the first changes to the file.
'locking FILES are read-only if up-to-date; user must type
"Return the name under which the user accesses the given FILE."
(or (and (eq (string-match tramp-file-name-regexp file) 0)
;; tramp case: execute "whoami" via tramp
- (let ((default-directory (file-name-directory file)))
+ (let ((default-directory (file-name-directory file))
+ process-file-side-effects)
(with-temp-buffer
(if (not (zerop (process-file "whoami" nil t)))
;; fall through if "whoami" didn't work
;; if user-login-name is nil, return the UID as a string
(number-to-string (user-uid))))
-(defun vc-state (file)
+(defun vc-state (file &optional backend)
"Return the version control state of FILE.
If FILE is not registered, this function always returns nil.
;; FIXME: New (sub)states needed (?):
;; - `copied' and `moved' (might be handled by `removed' and `added')
(or (vc-file-getprop file 'vc-state)
- (when (> (length file) 0)
- (let ((backend (vc-backend file)))
- (when backend
- (vc-file-setprop
- file 'vc-state
- (vc-call-backend backend 'state-heuristic file)))))))
+ (when (> (length file) 0) ;Why?? --Stef
+ (setq backend (or backend (vc-backend file)))
+ (when backend
+ (vc-state-refresh file backend)))))
+
+(defun vc-state-refresh (file backend)
+ "Quickly recompute the `state' of FILE."
+ (vc-file-setprop
+ file 'vc-state
+ (vc-call-backend backend 'state-heuristic file)))
(defsubst vc-up-to-date-p (file)
"Convenience function that checks whether `vc-state' of FILE is `up-to-date'."
"Return non-nil if FILE has not changed since the last checkout."
(let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
(lastmod (nth 5 (file-attributes file))))
+ ;; This is a shortcut for determining when the workfile is
+ ;; unchanged. It can fail under some circumstances; see the
+ ;; discussion in bug#694.
(if (and checkout-time
- ;; Tramp and Ange-FTP return this when they don't know the time.
- (not (equal lastmod '(0 0))))
- (equal checkout-time lastmod)
+ ;; Tramp and Ange-FTP return this when they don't know the time.
+ (not (equal lastmod '(0 0))))
+ (equal checkout-time lastmod)
(let ((unchanged (vc-call workfile-unchanged-p file)))
- (vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0))
- unchanged))))
+ (vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0))
+ unchanged))))
(defun vc-default-workfile-unchanged-p (backend file)
"Check if FILE is unchanged by diffing against the master version.
(signal (car err) (cdr err))
(vc-call-backend backend 'diff (list file)))))))
-(defun vc-working-revision (file)
+(defun vc-working-revision (file &optional backend)
"Return the repository version from which FILE was checked out.
If FILE is not registered, this function always returns nil."
(or (vc-file-getprop file 'vc-working-revision)
- (let ((backend (vc-backend file)))
- (when backend
- (vc-file-setprop file 'vc-working-revision
- (vc-call-backend backend 'working-revision file))))))
+ (progn
+ (setq backend (or backend (vc-backend file)))
+ (when backend
+ (vc-file-setprop file 'vc-working-revision
+ (vc-call-backend backend 'working-revision file))))))
;; Backward compatibility.
(define-obsolete-function-alias
'vc-workfile-version 'vc-working-revision "23.1")
-(define-obsolete-function-alias
- 'vc-previous-version 'vc-previous-revision "23.1")
(defun vc-default-working-revision (backend file)
(message
"`working-revision' not found: using the old `workfile-version' instead")
on version-controlled buffer."
(interactive "P")
(if (vc-backend buffer-file-name)
- (error "Toggling the readability of a version controlled file is likely to wreak havoc.")
+ (error "Toggling the readability of a version controlled file is likely to wreak havoc")
(toggle-read-only)))
(defun vc-default-make-version-backups-p (backend file)
(vc-call-backend backend 'make-version-backups-p file)
(vc-make-version-backup file)))))
-(declare-function vc-dir-resynch-file "vc-dispatcher" (&optional fname))
+(declare-function vc-dir-resynch-file "vc-dir" (&optional fname))
+
+(defvar vc-dir-buffers nil "List of vc-dir buffers.")
(defun vc-after-save ()
"Function to be called by `basic-save-buffer' (in files.el)."
;; to avoid confusion.
(vc-file-setprop file 'vc-checkout-time nil))
t)
- (vc-up-to-date-p file)
(eq (vc-checkout-model backend (list file)) 'implicit)
- (vc-file-setprop file 'vc-state 'edited)
- (vc-mode-line file)
- ;; Try to avoid unnecessary work, a *vc-dir* buffer is only
- ;; present if this is true.
- (when (memq 'vc-dir-resynch-file after-save-hook)
- (vc-dir-resynch-file file)))))
+ (vc-state-refresh file backend)
+ (vc-mode-line file backend))
+ ;; Try to avoid unnecessary work, a *vc-dir* buffer is
+ ;; present if this is true.
+ (when vc-dir-buffers
+ (vc-dir-resynch-file file))))
(defvar vc-menu-entry
- '(menu-item "Version Control" vc-menu-map
+ `(menu-item ,(purecopy "Version Control") vc-menu-map
:filter vc-menu-map-filter))
(when (boundp 'menu-bar-tools-menu)
(define-key map [mode-line down-mouse-1] vc-menu-entry)
map))
-(defun vc-mode-line (file)
+(defun vc-mode-line (file &optional backend)
"Set `vc-mode' to display type of version control for FILE.
The value is set in the current buffer, which should be the buffer
-visiting FILE."
+visiting FILE.
+If BACKEND is passed use it as the VC backend when computing the result."
(interactive (list buffer-file-name))
- (let ((backend (vc-backend file)))
- (if (not backend)
- (setq vc-mode nil)
- (let* ((ml-string (vc-call-backend backend 'mode-line-string file))
- (ml-echo (get-text-property 0 'help-echo ml-string)))
- (setq vc-mode
- (concat
- " "
- (if (null vc-display-status)
- (symbol-name backend)
- (propertize
- ml-string
- 'mouse-face 'mode-line-highlight
- 'help-echo
- (concat (or ml-echo
- (format "File under the %s version control system"
- backend))
- "\nmouse-1: Version Control menu")
- 'local-map vc-mode-line-map)))))
- ;; If the file is locked by some other user, make
- ;; the buffer read-only. Like this, even root
- ;; cannot modify a file that someone else has locked.
- (and (equal file buffer-file-name)
- (stringp (vc-state file))
- (setq buffer-read-only t))
- ;; If the user is root, and the file is not owner-writable,
- ;; then pretend that we can't write it
- ;; even though we can (because root can write anything).
- ;; This way, even root cannot modify a file that isn't locked.
- (and (equal file buffer-file-name)
- (not buffer-read-only)
- (zerop (user-real-uid))
- (zerop (logand (file-modes buffer-file-name) 128))
- (setq buffer-read-only t)))
- (force-mode-line-update)
- backend))
+ (setq backend (or backend (vc-backend file)))
+ (if (not backend)
+ (setq vc-mode nil)
+ (let* ((ml-string (vc-call-backend backend 'mode-line-string file))
+ (ml-echo (get-text-property 0 'help-echo ml-string)))
+ (setq vc-mode
+ (concat
+ " "
+ (if (null vc-display-status)
+ (symbol-name backend)
+ (propertize
+ ml-string
+ 'mouse-face 'mode-line-highlight
+ 'help-echo
+ (concat (or ml-echo
+ (format "File under the %s version control system"
+ backend))
+ "\nmouse-1: Version Control menu")
+ 'local-map vc-mode-line-map)))))
+ ;; If the user is root, and the file is not owner-writable,
+ ;; then pretend that we can't write it
+ ;; even though we can (because root can write anything).
+ ;; This way, even root cannot modify a file that isn't locked.
+ (and (equal file buffer-file-name)
+ (not buffer-read-only)
+ (zerop (user-real-uid))
+ (zerop (logand (file-modes buffer-file-name) 128))
+ (setq buffer-read-only t)))
+ (force-mode-line-update)
+ backend)
(defun vc-default-mode-line-string (backend file)
"Return string for placement in modeline by `vc-mode-line' for FILE.
\"BACKEND:LOCKER:REV\" if the file is locked by somebody else
This function assumes that the file is registered."
- (setq backend (symbol-name backend))
- (let ((state (vc-state file))
- (state-echo nil)
- (rev (vc-working-revision file)))
+ (let* ((backend-name (symbol-name backend))
+ (state (vc-state file backend))
+ (state-echo nil)
+ (rev (vc-working-revision file backend)))
(propertize
(cond ((or (eq state 'up-to-date)
(eq state 'needs-update))
(setq state-echo "Up to date file")
- (concat backend "-" rev))
+ (concat backend-name "-" rev))
((stringp state)
(setq state-echo (concat "File locked by" state))
- (concat backend ":" state ":" rev))
+ (concat backend-name ":" state ":" rev))
((eq state 'added)
(setq state-echo "Locally added file")
- (concat backend "@" rev))
+ (concat backend-name "@" rev))
((eq state 'conflict)
(setq state-echo "File contains conflicts after the last merge")
- (concat backend "!" rev))
+ (concat backend-name "!" rev))
((eq state 'removed)
(setq state-echo "File removed from the VC system")
- (concat backend "!" rev))
+ (concat backend-name "!" rev))
((eq state 'missing)
(setq state-echo "File tracked by the VC system, but missing from the file system")
- (concat backend "?" rev))
+ (concat backend-name "?" rev))
(t
;; Not just for the 'edited state, but also a fallback
;; for all other states. Think about different symbols
;; for 'needs-update and 'needs-merge.
(setq state-echo "Locally modified file")
- (concat backend ":" rev)))
- 'help-echo (concat state-echo " under the " backend
+ (concat backend-name ":" rev)))
+ 'help-echo (concat state-echo " under the " backend-name
" version control system"))))
(defun vc-follow-link ()
"If current buffer visits a symbolic link, visit the real file.
If the real file is already visited in another buffer, make that buffer
current, and kill the buffer that visits the link."
- (let* ((truename (abbreviate-file-name (file-chase-links buffer-file-name)))
- (true-buffer (find-buffer-visiting truename))
+ (let* ((true-buffer (find-buffer-visiting buffer-file-truename))
(this-buffer (current-buffer)))
(if (eq true-buffer this-buffer)
- (progn
+ (let ((truename buffer-file-truename))
(kill-buffer this-buffer)
;; In principle, we could do something like set-visited-file-name.
;; However, it can't be exactly the same as set-visited-file-name.
"Function for `find-file-hook' activating VC mode if appropriate."
;; Recompute whether file is version controlled,
;; if user has killed the buffer and revisited.
- (if vc-mode
- (setq vc-mode nil))
+ (when vc-mode
+ (setq vc-mode nil))
(when buffer-file-name
(vc-file-clearprops buffer-file-name)
(add-hook 'mode-line-hook 'vc-mode-line nil t)
- (cond
- ((with-demoted-errors (vc-backend buffer-file-name))
- ;; Compute the state and put it in the modeline.
- (vc-mode-line buffer-file-name)
- (unless vc-make-backup-files
- ;; Use this variable, not make-backup-files,
- ;; because this is for things that depend on the file name.
- (set (make-local-variable 'backup-inhibited) t))
- ;; Let the backend setup any buffer-local things he needs.
- (vc-call-backend (vc-backend buffer-file-name) 'find-file-hook))
- ((let ((link-type (and (file-symlink-p buffer-file-name)
- (vc-backend (file-chase-links buffer-file-name)))))
- (cond ((not link-type) nil) ;Nothing to do.
- ((eq vc-follow-symlinks nil)
- (message
- "Warning: symbolic link to %s-controlled source file" link-type))
- ((or (not (eq vc-follow-symlinks 'ask))
- ;; If we already visited this file by following
- ;; the link, don't ask again if we try to visit
- ;; it again. GUD does that, and repeated questions
- ;; are painful.
- (get-file-buffer
- (abbreviate-file-name
- (file-chase-links buffer-file-name))))
-
- (vc-follow-link)
- (message "Followed link to %s" buffer-file-name)
- (vc-find-file-hook))
- (t
- (if (yes-or-no-p (format
- "Symbolic link to %s-controlled source file; follow link? " link-type))
- (progn (vc-follow-link)
- (message "Followed link to %s" buffer-file-name)
- (vc-find-file-hook))
+ (let (backend)
+ (cond
+ ((setq backend (with-demoted-errors (vc-backend buffer-file-name)))
+ ;; Compute the state and put it in the modeline.
+ (vc-mode-line buffer-file-name backend)
+ (unless vc-make-backup-files
+ ;; Use this variable, not make-backup-files,
+ ;; because this is for things that depend on the file name.
+ (set (make-local-variable 'backup-inhibited) t))
+ ;; Let the backend setup any buffer-local things he needs.
+ (vc-call-backend backend 'find-file-hook))
+ ((let ((link-type (and (not (equal buffer-file-name buffer-file-truename))
+ (vc-backend buffer-file-truename))))
+ (cond ((not link-type) nil) ;Nothing to do.
+ ((eq vc-follow-symlinks nil)
(message
- "Warning: editing through the link bypasses version control")
- ))))))))
+ "Warning: symbolic link to %s-controlled source file" link-type))
+ ((or (not (eq vc-follow-symlinks 'ask))
+ ;; If we already visited this file by following
+ ;; the link, don't ask again if we try to visit
+ ;; it again. GUD does that, and repeated questions
+ ;; are painful.
+ (get-file-buffer
+ (abbreviate-file-name
+ (file-chase-links buffer-file-name))))
+
+ (vc-follow-link)
+ (message "Followed link to %s" buffer-file-name)
+ (vc-find-file-hook))
+ (t
+ (if (yes-or-no-p (format
+ "Symbolic link to %s-controlled source file; follow link? " link-type))
+ (progn (vc-follow-link)
+ (message "Followed link to %s" buffer-file-name)
+ (vc-find-file-hook))
+ (message
+ "Warning: editing through the link bypasses version control")
+ )))))))))
(add-hook 'find-file-hook 'vc-find-file-hook)
-;; more hooks, this time for file-not-found
-(defun vc-file-not-found-hook ()
- "When file is not found, try to check it out from version control.
-Returns t if checkout was successful, nil otherwise.
-Used in `find-file-not-found-functions'."
- ;; When a file does not exist, ignore cached info about it
- ;; from a previous visit.
- (vc-file-clearprops buffer-file-name)
- (let ((backend (vc-backend buffer-file-name)))
- (when backend (vc-call-backend backend 'find-file-not-found-hook))))
-
-(defun vc-default-find-file-not-found-hook (backend)
- ;; This used to do what vc-rcs-find-file-not-found-hook does, but it only
- ;; really makes sense for RCS. For other backends, better not do anything.
- nil)
-
-(add-hook 'find-file-not-found-functions 'vc-file-not-found-hook)
-
(defun vc-kill-buffer-hook ()
"Discard VC info about a file when we kill its buffer."
(when buffer-file-name (vc-file-clearprops buffer-file-name)))
(define-key map "h" 'vc-insert-headers)
(define-key map "i" 'vc-register)
(define-key map "l" 'vc-print-log)
+ (define-key map "L" 'vc-print-root-log)
(define-key map "m" 'vc-merge)
(define-key map "r" 'vc-retrieve-tag)
(define-key map "s" 'vc-create-tag)
(define-key map "v" 'vc-next-action)
(define-key map "+" 'vc-update)
(define-key map "=" 'vc-diff)
+ (define-key map "D" 'vc-root-diff)
(define-key map "~" 'vc-revision-other-window)
map))
(fset 'vc-prefix-map vc-prefix-map)
;;(define-key map [show-files]
;; '("Show Files under VC" . (vc-directory t)))
(define-key map [vc-retrieve-tag]
- '(menu-item "Retrieve Tag" vc-retrieve-tag
- :help "Retrieve tagged version or branch"))
+ `(menu-item ,(purecopy "Retrieve Tag") vc-retrieve-tag
+ :help ,(purecopy "Retrieve tagged version or branch")))
(define-key map [vc-create-tag]
- '(menu-item "Create Tag" vc-create-tag
- :help "Create version tag"))
- (define-key map [separator1] '("----"))
+ `(menu-item ,(purecopy "Create Tag") vc-create-tag
+ :help ,(purecopy "Create version tag")))
+ (define-key map [separator1] menu-bar-separator)
(define-key map [vc-annotate]
- '(menu-item "Annotate" vc-annotate
- :help "Display the edit history of the current file using colors"))
+ `(menu-item ,(purecopy "Annotate") vc-annotate
+ :help ,(purecopy "Display the edit history of the current file using colors")))
(define-key map [vc-rename-file]
- '(menu-item "Rename File" vc-rename-file
- :help "Rename file"))
+ `(menu-item ,(purecopy "Rename File") vc-rename-file
+ :help ,(purecopy "Rename file")))
(define-key map [vc-revision-other-window]
- '(menu-item "Show Other Version" vc-revision-other-window
- :help "Visit another version of the current file in another window"))
+ `(menu-item ,(purecopy "Show Other Version") vc-revision-other-window
+ :help ,(purecopy "Visit another version of the current file in another window")))
(define-key map [vc-diff]
- '(menu-item "Compare with Base Version" vc-diff
- :help "Compare file set with the base version"))
+ `(menu-item ,(purecopy "Compare with Base Version") vc-diff
+ :help ,(purecopy "Compare file set with the base version")))
+ (define-key map [vc-root-diff]
+ `(menu-item ,(purecopy "Compare Tree with Base Version") vc-root-diff
+ :help ,(purecopy "Compare current tree with the base version")))
(define-key map [vc-update-change-log]
- '(menu-item "Update ChangeLog" vc-update-change-log
- :help "Find change log file and add entries from recent version control logs"))
+ `(menu-item ,(purecopy "Update ChangeLog") vc-update-change-log
+ :help ,(purecopy "Find change log file and add entries from recent version control logs")))
(define-key map [vc-print-log]
- '(menu-item "Show History" vc-print-log
- :help "List the change log of the current file set in a window"))
- (define-key map [separator2] '("----"))
+ `(menu-item ,(purecopy "Show History") vc-print-log
+ :help ,(purecopy "List the change log of the current file set in a window")))
+ (define-key map [vc-print-root-log]
+ `(menu-item ,(purecopy "Show Top of the Tree History ") vc-print-root-log
+ :help ,(purecopy "List the change log for the current tree in a window")))
+ (define-key map [separator2] menu-bar-separator)
(define-key map [vc-insert-header]
- '(menu-item "Insert Header" vc-insert-headers
- :help "Insert headers into a file for use with a version control system.
-"))
+ `(menu-item ,(purecopy "Insert Header") vc-insert-headers
+ :help ,(purecopy "Insert headers into a file for use with a version control system.
+")))
(define-key map [undo]
- '(menu-item "Undo Last Check-In" vc-rollback
- :help "Remove the most recent changeset committed to the repository"))
+ `(menu-item ,(purecopy "Undo Last Check-In") vc-rollback
+ :help ,(purecopy "Remove the most recent changeset committed to the repository")))
(define-key map [vc-revert]
- '(menu-item "Revert to Base Version" vc-revert
- :help "Revert working copies of the selected file set to their repository contents"))
+ `(menu-item ,(purecopy "Revert to Base Version") vc-revert
+ :help ,(purecopy "Revert working copies of the selected file set to their repository contents")))
(define-key map [vc-update]
- '(menu-item "Update to Latest Version" vc-update
- :help "Update the current fileset's files to their tip revisions"))
+ `(menu-item ,(purecopy "Update to Latest Version") vc-update
+ :help ,(purecopy "Update the current fileset's files to their tip revisions")))
(define-key map [vc-next-action]
- '(menu-item "Check In/Out" vc-next-action
- :help "Do the next logical version control operation on the current fileset"))
+ `(menu-item ,(purecopy "Check In/Out") vc-next-action
+ :help ,(purecopy "Do the next logical version control operation on the current fileset")))
(define-key map [vc-register]
- '(menu-item "Register" vc-register
- :help "Register file set into a version control system"))
+ `(menu-item ,(purecopy "Register") vc-register
+ :help ,(purecopy "Register file set into a version control system")))
(define-key map [vc-dir]
- '(menu-item "VC Dir" vc-dir
- :help "Show the VC status of files in a directory"))
+ `(menu-item ,(purecopy "VC Dir") vc-dir
+ :help ,(purecopy "Show the VC status of files in a directory")))
map))
(defalias 'vc-menu-map vc-menu-map)
-(declare-function vc-responsible-backend "vc" (file &optional register))
+(declare-function vc-responsible-backend "vc" (file))
(defun vc-menu-map-filter (orig-binding)
(if (and (symbolp orig-binding) (fboundp orig-binding))
(if (null ext-binding)
orig-binding
(append orig-binding
- '((ext-menu-separator "---"))
+ '((ext-menu-separator "--"))
ext-binding))))
(defun vc-default-extra-menu (backend)
nil)
-;; These are not correct and it's not currently clear how doing it
-;; better (with more complicated expressions) might slow things down
-;; on older systems.
-
-;;(put 'vc-rename-file 'menu-enable 'vc-mode)
-;;(put 'vc-annotate 'menu-enable '(eq (vc-buffer-backend) 'CVS))
-;;(put 'vc-revision-other-window 'menu-enable 'vc-mode)
-;;(put 'vc-diff 'menu-enable 'vc-mode)
-;;(put 'vc-update-change-log 'menu-enable
-;; '(member (vc-buffer-backend) '(RCS CVS)))
-;;(put 'vc-print-log 'menu-enable 'vc-mode)
-;;(put 'vc-rollback 'menu-enable 'vc-mode)
-;;(put 'vc-revert 'menu-enable 'vc-mode)
-;;(put 'vc-insert-headers 'menu-enable 'vc-mode)
-;;(put 'vc-next-action 'menu-enable 'vc-mode)
-;;(put 'vc-register 'menu-enable '(and buffer-file-name (not vc-mode)))
-
(provide 'vc-hooks)
;; arch-tag: 2e5a6fa7-1d30-48e2-8bd0-e3d335f04f32