X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b03f96dc5a6651d1dc84b81b2a15cad6908b9809..2b34df4ebc935a834a77b930b35c4a42f7236440:/lisp/vc-hooks.el diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el index b177061d50..125b57e3da 100644 --- a/lisp/vc-hooks.el +++ b/lisp/vc-hooks.el @@ -1,19 +1,18 @@ ;;; 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 +;; Free Software Foundation, Inc. ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel -;; $Id$ - ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -21,9 +20,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -41,20 +38,22 @@ (defvar vc-ignore-vc-files nil) (make-obsolete-variable 'vc-ignore-vc-files - "set `vc-handled-backends' to nil to disable VC.") + "set `vc-handled-backends' to nil to disable VC." + "21.1") (defvar vc-master-templates ()) (make-obsolete-variable 'vc-master-templates "to define master templates for a given BACKEND, use vc-BACKEND-master-templates. To enable or disable VC for a given -BACKEND, use `vc-handled-backends'.") +BACKEND, use `vc-handled-backends'." + "21.1") (defvar vc-header-alist ()) -(make-obsolete-variable 'vc-header-alist 'vc-BACKEND-header) +(make-obsolete-variable 'vc-header-alist 'vc-BACKEND-header "21.1") (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 @@ -62,7 +61,7 @@ interpreted as hostnames." :type 'regexp :group 'vc) -(defcustom vc-handled-backends '(RCS CVS SVN SCCS Bzr Git Hg Mtn Arch MCVS) +(defcustom vc-handled-backends '(RCS CVS SVN SCCS Bzr Git Hg Mtn Arch) ;; RCS, CVS, SVN and SCCS come first because they are per-dir ;; rather than per-tree. RCS comes first because of the multibackend ;; support intended to use RCS for local commits (with a remote CVS server). @@ -77,6 +76,7 @@ An empty list disables VC altogether." :group 'vc) ;; 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" ".svn" ".git" ".hg" ".bzr" "_MTN" "_darcs" "{arch}") @@ -84,10 +84,7 @@ An empty list disables VC altogether." :type '(repeat string) :group 'vc) -(defcustom vc-path - (if (file-directory-p "/usr/sccs") - '("/usr/sccs") - nil) +(defcustom vc-path nil "List of extra directories to search for version control commands." :type '(repeat directory) :group 'vc) @@ -146,37 +143,42 @@ See also variable `vc-consult-headers'." (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) @@ -203,6 +205,8 @@ individually should stay local." ;; Tell Emacs about this new kind of minor mode ;; (add-to-list 'minor-mode-alist '(vc-mode vc-mode)) +;; Autoload if this file no longer dumped. +(put 'vc-mode 'risky-local-variable t) (make-variable-buffer-local 'vc-mode) (put 'vc-mode 'permanent-local t) @@ -290,8 +294,8 @@ It is usually called via the `vc-call' macro." (defmacro vc-call (fun file &rest args) "A convenience macro for calling VC backend functions. Functions called by this macro must accept FILE as the first argument. -ARGS specifies any additional arguments. FUN should be unquoted. -BEWARE!! `file' is evaluated twice!!" +ARGS specifies any additional arguments. FUN should be unquoted. +BEWARE!! FILE is evaluated twice!!" `(vc-call-backend (vc-backend ,file) ',fun ,file ,@args)) (defsubst vc-parse-buffer (pattern i) @@ -312,63 +316,31 @@ non-nil if FILE exists and its contents were successfully inserted." (when (file-exists-p file) (if (not limit) (insert-file-contents file) - (if (not blocksize) (setq blocksize 8192)) + (unless blocksize (setq blocksize 8192)) (let ((filepos 0)) (while (and (< 0 (cadr (insert-file-contents file nil filepos (incf filepos blocksize)))) (progn (beginning-of-line) (let ((pos (re-search-forward limit nil 'move))) - (if pos (delete-region (match-beginning 0) - (point-max))) + (when pos (delete-region (match-beginning 0) + (point-max))) (not pos))))))) (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 ;; _retrieved_ only through these functions, which decide -;; if the property is already known or not. A property should +;; if the property is already known or not. A property should ;; only be retrieved by vc-file-getprop if there is no ;; access function.) @@ -383,7 +355,8 @@ file was previously registered under a certain backend, then that 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))) @@ -439,36 +412,35 @@ If the file is not registered, or the master name is not known, return nil." (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 (file) - "Indicate how FILE is checked out. +(defun vc-checkout-model (backend files) + "Indicate how FILES are checked out. -If FILE is not registered, this function always returns nil. +If FILES are not registered, this function always returns nil. For registered files, the possible values are: - 'implicit FILE is 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 FILE is read-only if up-to-date; user must type + 'locking FILES are read-only if up-to-date; user must type \\[vc-next-action] before editing. Strict locking is assumed. - 'announce FILE is read-only if up-to-date; user must type + 'announce FILES are read-only if up-to-date; user must type \\[vc-next-action] before editing. But other users may be editing at the same time." - (or (vc-file-getprop file 'vc-checkout-model) - (if (vc-backend file) - (vc-file-setprop file 'vc-checkout-model - (vc-call checkout-model file))))) + (vc-call-backend backend 'checkout-model files)) (defun vc-user-login-name (file) "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 @@ -481,7 +453,7 @@ For registered files, the possible values are: ;; 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. @@ -497,7 +469,7 @@ For registered files, the value returned is one of: USER The current version of the working file is locked by some other USER (a string). - 'needs-patch The file has not been edited by the user, but there is + 'needs-update The file has not been edited by the user, but there is a more recent version on the current branch stored in the master file. @@ -519,47 +491,49 @@ For registered files, the value returned is one of: 'removed Scheduled to be deleted from the repository on next commit. - 'ignored The file showed up in a dir-state listing with a flag + 'conflict The file contains conflicts as the result of a merge. + For now the conflicts are text conflicts. In the + future this might be extended to deal with metadata + conflicts too. + + 'missing The file is not present in the file system, but the VC + system still tracks it. + + 'ignored The file showed up in a dir-status listing with a flag indicating the version-control system is ignoring it, Note: This property is not set reliably (some VCSes don't have useful directory-status commands) so assume that any file with vc-state nil might be ignorable without VC knowing it. - 'unregistered The file showed up in a dir-state listing with a flag - indicating that it is not under version control. - Note: This property is not set reliably (some VCSes - don't have useful directory-status commands) so assume - that any file with vc-state nil might be unregistered - without VC knowing it. + 'unregistered The file is not under version control. A return of nil from this function means we have no information on the -status of this file. -" - ;; Note: in Emacs 22 and older, return of nil meant the file was unregistered. - ;; This is potentially a source of backward-compatibility bugs. +status of this file." + ;; Note: in Emacs 22 and older, return of nil meant the file was + ;; unregistered. This is potentially a source of + ;; backward-compatibility bugs. ;; FIXME: New (sub)states needed (?): - ;; - `conflict' (i.e. `edited' with conflict markers) - ;; - `removed' ;; - `copied' and `moved' (might be handled by `removed' and `added') (or (vc-file-getprop file 'vc-state) - (if (and (> (length file) 0) (vc-backend file)) - (vc-file-setprop file 'vc-state - (vc-call 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-recompute-state (file) - "Recompute the version control state of FILE, and return it. -This calls the possibly expensive function vc-BACKEND-state, -rather than the heuristic." - (vc-file-setprop file 'vc-state (vc-call state file))) +(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'." (eq (vc-state file) 'up-to-date)) (defun vc-default-state-heuristic (backend file) - "Default implementation of vc-state-heuristic. + "Default implementation of vc-BACKEND-state-heuristic. It simply calls the real state computation function `vc-BACKEND-state' and does not employ any heuristic at all." (vc-call-backend backend 'state file)) @@ -568,13 +542,16 @@ and does not employ any heuristic at all." "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. @@ -582,26 +559,28 @@ Return non-nil if FILE is unchanged." (zerop (condition-case err ;; If the implementation supports it, let the output ;; go to *vc*, not *vc-diff*, since this is an internal call. - (vc-call diff (list file) nil nil "*vc*") + (vc-call-backend backend 'diff (list file) nil nil "*vc*") (wrong-number-of-arguments ;; If this error came from the above call to vc-BACKEND-diff, ;; try again without the optional buffer argument (for ;; backward compatibility). Otherwise, resignal. (if (or (not (eq (cadr err) (indirect-function - (vc-find-backend-function (vc-backend file) - 'diff)))) + (vc-find-backend-function backend 'diff)))) (not (eq (caddr err) 4))) (signal (car err) (cdr err)) - (vc-call diff (list file))))))) + (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) - (if (vc-backend file) - (vc-file-setprop file 'vc-working-revision - (vc-call 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") @@ -661,17 +640,17 @@ this function." (mapcar (lambda (s) (let ((trial (vc-possible-master s dirname basename))) - (if (and trial (file-exists-p trial) - ;; Make sure the file we found with name - ;; TRIAL is not the source file itself. - ;; That can happen with RCS-style names if - ;; the file name is truncated (e.g. to 14 - ;; chars). See if either directory or - ;; attributes differ. - (or (not (string= dirname - (file-name-directory trial))) - (not (equal (file-attributes file) - (file-attributes trial))))) + (when (and trial (file-exists-p trial) + ;; Make sure the file we found with name + ;; TRIAL is not the source file itself. + ;; That can happen with RCS-style names if + ;; the file name is truncated (e.g. to 14 + ;; chars). See if either directory or + ;; attributes differ. + (or (not (string= dirname + (file-name-directory trial))) + (not (equal (file-attributes file) + (file-attributes trial))))) (throw 'found trial)))) templates)))) @@ -679,19 +658,17 @@ this function." "Change read-only status of current buffer, perhaps via version control. If the buffer is visiting a file registered with version control, -then check the file in or out. Otherwise, just change the read-only flag -of the buffer. -With prefix argument, ask for version number to check in or check out. -Check-out of a specified version number does not lock the file; -to do that, use this command a second time with no argument. - -If you bind this function to \\[toggle-read-only], then Emacs checks files -in or out whenever you toggle the read-only flag." +throw an error, because this is not a safe or really meaningful operation +on any version-control system newer than RCS. + +Otherwise, just change the read-only flag of the buffer. + +If you bind this function to \\[toggle-read-only], then Emacs +will properly intercept all attempts to toggle the read-only flag +on version-controlled buffer." (interactive "P") - (if (or (and (boundp 'vc-dired-mode) vc-dired-mode) - ;; use boundp because vc.el might not be loaded - (vc-backend buffer-file-name)) - (vc-next-action verbose) + (if (vc-backend buffer-file-name) + (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) @@ -744,22 +721,27 @@ Before doing that, check if there are any old backups and get rid of them." ;; If the file on disk is still in sync with the repository, ;; and version backups should be made, copy the file to ;; another name. This enables local diffs and local reverting. - (let ((file buffer-file-name)) - (and (vc-backend file) - (vc-up-to-date-p file) - (eq (vc-checkout-model file) 'implicit) - (vc-call make-version-backups-p file) - (vc-make-version-backup file)))) + (let ((file buffer-file-name) + backend) + (ignore-errors ;Be careful not to prevent saving the file. + (and (setq backend (vc-backend file)) + (vc-up-to-date-p file) + (eq (vc-checkout-model backend (list file)) 'implicit) + (vc-call-backend backend 'make-version-backups-p file) + (vc-make-version-backup file))))) + +(declare-function vc-dir-resynch-file "vc-dir" (&optional fname)) -(declare-function vc-dired-resynch-file "vc" (file)) +(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)." ;; If the file in the current buffer is under version control, ;; up-to-date, and locking is not used for the file, set ;; the state to 'edited and redisplay the mode line. - (let ((file buffer-file-name)) - (and (vc-backend file) + (let* ((file buffer-file-name) + (backend (vc-backend file))) + (and backend (or (and (equal (vc-file-getprop file 'vc-checkout-time) (nth 5 (file-attributes file))) ;; File has been saved in the same second in which @@ -767,14 +749,13 @@ Before doing that, check if there are any old backups and get rid of them." ;; to avoid confusion. (vc-file-setprop file 'vc-checkout-time nil)) t) - (vc-up-to-date-p file) - (eq (vc-checkout-model file) 'implicit) - (vc-file-setprop file 'vc-state 'edited) - (vc-mode-line file) - (if (featurep 'vc) - ;; If VC is not loaded, then there can't be - ;; any VC Dired buffer to synchronize. - (vc-dired-resynch-file file))))) + (eq (vc-checkout-model backend (list file)) 'implicit) + (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 @@ -791,47 +772,42 @@ Before doing that, check if there are any old backups and get rid of them." (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 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). + (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)) + (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. @@ -842,36 +818,47 @@ Format: \"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-patch)) + (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-name "@" rev)) + ((eq state 'conflict) + (setq state-echo "File contains conflicts after the last merge") + (concat backend-name "!" rev)) + ((eq state 'removed) + (setq state-echo "File removed from the VC system") + (concat backend-name "!" rev)) + ((eq state 'missing) + (setq state-echo "File tracked by the VC system, but missing from the file system") + (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-patch and 'needs-merge. + ;; 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. @@ -887,72 +874,55 @@ current, and kill the buffer that visits the link." "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) - (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)) + (add-hook 'mode-line-hook 'vc-mode-line nil t) + (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))) - (if 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." - (if buffer-file-name - (vc-file-clearprops buffer-file-name))) + (when buffer-file-name (vc-file-clearprops buffer-file-name))) (add-hook 'kill-buffer-hook 'vc-kill-buffer-hook) @@ -968,21 +938,21 @@ Used in `find-file-not-found-functions'." (define-key map "a" 'vc-update-change-log) (define-key map "b" 'vc-switch-backend) (define-key map "c" 'vc-rollback) - (define-key map "d" 'vc-directory) + (define-key map "d" 'vc-dir) (define-key map "g" 'vc-annotate) (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-snapshot) - (define-key map "s" 'vc-create-snapshot) + (define-key map "r" 'vc-retrieve-tag) + (define-key map "s" 'vc-create-tag) (define-key map "u" 'vc-revert) (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) - ;; `vc-status' is a not-quite-ready replacement for `vc-directory' - ;; (define-key map "?" 'vc-status) map)) (fset 'vc-prefix-map vc-prefix-map) (define-key global-map "\C-xv" 'vc-prefix-map) @@ -991,17 +961,12 @@ Used in `find-file-not-found-functions'." (let ((map (make-sparse-keymap "Version Control"))) ;;(define-key map [show-files] ;; '("Show Files under VC" . (vc-directory t))) - (define-key map [vc-retrieve-snapshot] - '(menu-item "Retrieve Snapshot" vc-retrieve-snapshot - :help "Retrieve snapshot")) - (define-key map [vc-create-snapshot] - '(menu-item "Create Snapshot" vc-create-snapshot - :help "Create Snapshot")) - (define-key map [vc-directory] - '(menu-item "VC Directory Listing" vc-directory - :help "Show the VC status of files in a directory")) - ;; `vc-status' is a not-quite-ready replacement for `vc-directory' - ;; (define-key map [vc-status] '("VC Status" . vc-status)) + (define-key map [vc-retrieve-tag] + '(menu-item "Retrieve Tag" vc-retrieve-tag + :help "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] '("----")) (define-key map [vc-annotate] '(menu-item "Annotate" vc-annotate @@ -1015,12 +980,18 @@ Used in `find-file-not-found-functions'." (define-key map [vc-diff] '(menu-item "Compare with Base Version" vc-diff :help "Compare file set with the base version")) + (define-key map [vc-root-diff] + '(menu-item "Compare Tree with Base Version" vc-root-diff + :help "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")) (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 [vc-print-root-log] + '(menu-item "Show Top of the Tree History " vc-print-root-log + :help "List the change log for the current tree in a window")) (define-key map [separator2] '("----")) (define-key map [vc-insert-header] '(menu-item "Insert Header" vc-insert-headers @@ -1041,16 +1012,25 @@ Used in `find-file-not-found-functions'." (define-key map [vc-register] '(menu-item "Register" vc-register :help "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")) map)) (defalias 'vc-menu-map vc-menu-map) +(declare-function vc-responsible-backend "vc" (file &optional register)) + (defun vc-menu-map-filter (orig-binding) (if (and (symbolp orig-binding) (fboundp orig-binding)) (setq orig-binding (indirect-function orig-binding))) (let ((ext-binding - (if vc-mode (vc-call-backend (vc-backend buffer-file-name) - 'extra-menu)))) + (when vc-mode + (vc-call-backend + (if buffer-file-name + (vc-backend buffer-file-name) + (vc-responsible-backend default-directory)) + 'extra-menu)))) ;; Give the VC backend a chance to add menu entries ;; specific for that backend. (if (null ext-binding) @@ -1062,23 +1042,6 @@ Used in `find-file-not-found-functions'." (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