| 1 | ;;; vc-hooks.el --- resident support for version-control |
| 2 | |
| 3 | ;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2002, |
| 4 | ;; 2003, 2004, 2005, 2006 Free Software Foundation, Inc. |
| 5 | |
| 6 | ;; Author: FSF (see vc.el for full credits) |
| 7 | ;; Maintainer: Andre Spiegel <spiegel@gnu.org> |
| 8 | |
| 9 | ;; $Id$ |
| 10 | |
| 11 | ;; This file is part of GNU Emacs. |
| 12 | |
| 13 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 14 | ;; it under the terms of the GNU General Public License as published by |
| 15 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 16 | ;; any later version. |
| 17 | |
| 18 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 21 | ;; GNU General Public License for more details. |
| 22 | |
| 23 | ;; You should have received a copy of the GNU General Public License |
| 24 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 25 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
| 26 | ;; Boston, MA 02110-1301, USA. |
| 27 | |
| 28 | ;;; Commentary: |
| 29 | |
| 30 | ;; This is the always-loaded portion of VC. It takes care of |
| 31 | ;; VC-related activities that are done when you visit a file, so that |
| 32 | ;; vc.el itself is loaded only when you use a VC command. See the |
| 33 | ;; commentary of vc.el. |
| 34 | |
| 35 | ;;; Code: |
| 36 | |
| 37 | (eval-when-compile |
| 38 | (require 'cl)) |
| 39 | |
| 40 | ;; Customization Variables (the rest is in vc.el) |
| 41 | |
| 42 | (defvar vc-ignore-vc-files nil) |
| 43 | (make-obsolete-variable 'vc-ignore-vc-files |
| 44 | "set `vc-handled-backends' to nil to disable VC.") |
| 45 | |
| 46 | (defvar vc-master-templates ()) |
| 47 | (make-obsolete-variable 'vc-master-templates |
| 48 | "to define master templates for a given BACKEND, use |
| 49 | vc-BACKEND-master-templates. To enable or disable VC for a given |
| 50 | BACKEND, use `vc-handled-backends'.") |
| 51 | |
| 52 | (defvar vc-header-alist ()) |
| 53 | (make-obsolete-variable 'vc-header-alist 'vc-BACKEND-header) |
| 54 | |
| 55 | (defvar vc-ignore-dir-regexp "\\`\\([\\/][\\/]\\|/net/\\|/afs/\\)\\'" |
| 56 | "Regexp matching directory names that are not under VC's control. |
| 57 | The default regexp prevents fruitless and time-consuming attempts |
| 58 | to determine the VC status in directories in which filenames are |
| 59 | interpreted as hostnames.") |
| 60 | |
| 61 | (defcustom vc-handled-backends '(RCS CVS SVN SCCS Arch MCVS) |
| 62 | ;; Arch and MCVS come last because they are per-tree rather than per-dir. |
| 63 | "*List of version control backends for which VC will be used. |
| 64 | Entries in this list will be tried in order to determine whether a |
| 65 | file is under that sort of version control. |
| 66 | Removing an entry from the list prevents VC from being activated |
| 67 | when visiting a file managed by that backend. |
| 68 | An empty list disables VC altogether." |
| 69 | :type '(repeat symbol) |
| 70 | :version "21.1" |
| 71 | :group 'vc) |
| 72 | |
| 73 | (defcustom vc-path |
| 74 | (if (file-directory-p "/usr/sccs") |
| 75 | '("/usr/sccs") |
| 76 | nil) |
| 77 | "*List of extra directories to search for version control commands." |
| 78 | :type '(repeat directory) |
| 79 | :group 'vc) |
| 80 | |
| 81 | (defcustom vc-make-backup-files nil |
| 82 | "*If non-nil, backups of registered files are made as with other files. |
| 83 | If nil (the default), files covered by version control don't get backups." |
| 84 | :type 'boolean |
| 85 | :group 'vc |
| 86 | :group 'backup) |
| 87 | |
| 88 | (defcustom vc-follow-symlinks 'ask |
| 89 | "*What to do if visiting a symbolic link to a file under version control. |
| 90 | Editing such a file through the link bypasses the version control system, |
| 91 | which is dangerous and probably not what you want. |
| 92 | |
| 93 | If this variable is t, VC follows the link and visits the real file, |
| 94 | telling you about it in the echo area. If it is `ask', VC asks for |
| 95 | confirmation whether it should follow the link. If nil, the link is |
| 96 | visited and a warning displayed." |
| 97 | :type '(choice (const :tag "Ask for confirmation" ask) |
| 98 | (const :tag "Visit link and warn" nil) |
| 99 | (const :tag "Follow link" t)) |
| 100 | :group 'vc) |
| 101 | |
| 102 | (defcustom vc-display-status t |
| 103 | "*If non-nil, display revision number and lock status in modeline. |
| 104 | Otherwise, not displayed." |
| 105 | :type 'boolean |
| 106 | :group 'vc) |
| 107 | |
| 108 | |
| 109 | (defcustom vc-consult-headers t |
| 110 | "*If non-nil, identify work files by searching for version headers." |
| 111 | :type 'boolean |
| 112 | :group 'vc) |
| 113 | |
| 114 | (defcustom vc-keep-workfiles t |
| 115 | "*If non-nil, don't delete working files after registering changes. |
| 116 | If the back-end is CVS, workfiles are always kept, regardless of the |
| 117 | value of this flag." |
| 118 | :type 'boolean |
| 119 | :group 'vc) |
| 120 | |
| 121 | (defcustom vc-mistrust-permissions nil |
| 122 | "*If non-nil, don't assume permissions/ownership track version-control status. |
| 123 | If nil, do rely on the permissions. |
| 124 | See also variable `vc-consult-headers'." |
| 125 | :type 'boolean |
| 126 | :group 'vc) |
| 127 | |
| 128 | (defun vc-mistrust-permissions (file) |
| 129 | "Internal access function to variable `vc-mistrust-permissions' for FILE." |
| 130 | (or (eq vc-mistrust-permissions 't) |
| 131 | (and vc-mistrust-permissions |
| 132 | (funcall vc-mistrust-permissions |
| 133 | (vc-backend-subdirectory-name file))))) |
| 134 | |
| 135 | (defcustom vc-stay-local t |
| 136 | "*Non-nil means use local operations when possible for remote repositories. |
| 137 | This avoids slow queries over the network and instead uses heuristics |
| 138 | and past information to determine the current status of a file. |
| 139 | |
| 140 | The value can also be a regular expression or list of regular |
| 141 | expressions to match against the host name of a repository; then VC |
| 142 | only stays local for hosts that match it. Alternatively, the value |
| 143 | can be a list of regular expressions where the first element is the |
| 144 | symbol `except'; then VC always stays local except for hosts matched |
| 145 | by these regular expressions." |
| 146 | :type '(choice (const :tag "Always stay local" t) |
| 147 | (const :tag "Don't stay local" nil) |
| 148 | (list :format "\nExamine hostname and %v" :tag "Examine hostname ..." |
| 149 | (set :format "%v" :inline t (const :format "%t" :tag "don't" except)) |
| 150 | (regexp :format " stay local,\n%t: %v" :tag "if it matches") |
| 151 | (repeat :format "%v%i\n" :inline t (regexp :tag "or")))) |
| 152 | :version "22.1" |
| 153 | :group 'vc) |
| 154 | |
| 155 | (defun vc-stay-local-p (file) |
| 156 | "Return non-nil if VC should stay local when handling FILE. |
| 157 | This uses the `repository-hostname' backend operation." |
| 158 | (let* ((backend (vc-backend file)) |
| 159 | (sym (vc-make-backend-sym backend 'stay-local)) |
| 160 | (stay-local (if (boundp sym) (symbol-value sym) t))) |
| 161 | (if (eq stay-local t) (setq stay-local vc-stay-local)) |
| 162 | (if (symbolp stay-local) stay-local |
| 163 | (let ((dirname (if (file-directory-p file) |
| 164 | (directory-file-name file) |
| 165 | (file-name-directory file)))) |
| 166 | (eq 'yes |
| 167 | (or (vc-file-getprop dirname 'vc-stay-local-p) |
| 168 | (vc-file-setprop |
| 169 | dirname 'vc-stay-local-p |
| 170 | (let ((hostname (vc-call-backend |
| 171 | backend 'repository-hostname dirname))) |
| 172 | (if (not hostname) |
| 173 | 'no |
| 174 | (let ((default t)) |
| 175 | (if (eq (car-safe stay-local) 'except) |
| 176 | (setq default nil stay-local (cdr stay-local))) |
| 177 | (when (consp stay-local) |
| 178 | (setq stay-local |
| 179 | (mapconcat 'identity stay-local "\\|"))) |
| 180 | (if (if (string-match stay-local hostname) |
| 181 | default (not default)) |
| 182 | 'yes 'no))))))))))) |
| 183 | |
| 184 | ;;; This is handled specially now. |
| 185 | ;; Tell Emacs about this new kind of minor mode |
| 186 | ;; (add-to-list 'minor-mode-alist '(vc-mode vc-mode)) |
| 187 | |
| 188 | (make-variable-buffer-local 'vc-mode) |
| 189 | (put 'vc-mode 'permanent-local t) |
| 190 | |
| 191 | (defun vc-mode (&optional arg) |
| 192 | ;; Dummy function for C-h m |
| 193 | "Version Control minor mode. |
| 194 | This minor mode is automatically activated whenever you visit a file under |
| 195 | control of one of the revision control systems in `vc-handled-backends'. |
| 196 | VC commands are globally reachable under the prefix `\\[vc-prefix-map]': |
| 197 | \\{vc-prefix-map}") |
| 198 | |
| 199 | (defmacro vc-error-occurred (&rest body) |
| 200 | `(condition-case nil (progn ,@body nil) (error t))) |
| 201 | |
| 202 | ;; We need a notion of per-file properties because the version |
| 203 | ;; control state of a file is expensive to derive --- we compute |
| 204 | ;; them when the file is initially found, keep them up to date |
| 205 | ;; during any subsequent VC operations, and forget them when |
| 206 | ;; the buffer is killed. |
| 207 | |
| 208 | (defvar vc-file-prop-obarray (make-vector 17 0) |
| 209 | "Obarray for per-file properties.") |
| 210 | |
| 211 | (defvar vc-touched-properties nil) |
| 212 | |
| 213 | (defun vc-file-setprop (file property value) |
| 214 | "Set per-file VC PROPERTY for FILE to VALUE." |
| 215 | (if (and vc-touched-properties |
| 216 | (not (memq property vc-touched-properties))) |
| 217 | (setq vc-touched-properties (append (list property) |
| 218 | vc-touched-properties))) |
| 219 | (put (intern file vc-file-prop-obarray) property value)) |
| 220 | |
| 221 | (defun vc-file-getprop (file property) |
| 222 | "Get per-file VC PROPERTY for FILE." |
| 223 | (get (intern file vc-file-prop-obarray) property)) |
| 224 | |
| 225 | (defun vc-file-clearprops (file) |
| 226 | "Clear all VC properties of FILE." |
| 227 | (setplist (intern file vc-file-prop-obarray) nil)) |
| 228 | |
| 229 | \f |
| 230 | ;; We keep properties on each symbol naming a backend as follows: |
| 231 | ;; * `vc-functions': an alist mapping vc-FUNCTION to vc-BACKEND-FUNCTION. |
| 232 | |
| 233 | (defun vc-make-backend-sym (backend sym) |
| 234 | "Return BACKEND-specific version of VC symbol SYM." |
| 235 | (intern (concat "vc-" (downcase (symbol-name backend)) |
| 236 | "-" (symbol-name sym)))) |
| 237 | |
| 238 | (defun vc-find-backend-function (backend fun) |
| 239 | "Return BACKEND-specific implementation of FUN. |
| 240 | If there is no such implementation, return the default implementation; |
| 241 | if that doesn't exist either, return nil." |
| 242 | (let ((f (vc-make-backend-sym backend fun))) |
| 243 | (if (fboundp f) f |
| 244 | ;; Load vc-BACKEND.el if needed. |
| 245 | (require (intern (concat "vc-" (downcase (symbol-name backend))))) |
| 246 | (if (fboundp f) f |
| 247 | (let ((def (vc-make-backend-sym 'default fun))) |
| 248 | (if (fboundp def) (cons def backend) nil)))))) |
| 249 | |
| 250 | (defun vc-call-backend (backend function-name &rest args) |
| 251 | "Call for BACKEND the implementation of FUNCTION-NAME with the given ARGS. |
| 252 | Calls |
| 253 | |
| 254 | (apply 'vc-BACKEND-FUN ARGS) |
| 255 | |
| 256 | if vc-BACKEND-FUN exists (after trying to find it in vc-BACKEND.el) |
| 257 | and else calls |
| 258 | |
| 259 | (apply 'vc-default-FUN BACKEND ARGS) |
| 260 | |
| 261 | It is usually called via the `vc-call' macro." |
| 262 | (let ((f (assoc function-name (get backend 'vc-functions)))) |
| 263 | (if f (setq f (cdr f)) |
| 264 | (setq f (vc-find-backend-function backend function-name)) |
| 265 | (push (cons function-name f) (get backend 'vc-functions))) |
| 266 | (cond |
| 267 | ((null f) |
| 268 | (error "Sorry, %s is not implemented for %s" function-name backend)) |
| 269 | ((consp f) (apply (car f) (cdr f) args)) |
| 270 | (t (apply f args))))) |
| 271 | |
| 272 | (defmacro vc-call (fun file &rest args) |
| 273 | ;; BEWARE!! `file' is evaluated twice!! |
| 274 | `(vc-call-backend (vc-backend ,file) ',fun ,file ,@args)) |
| 275 | \f |
| 276 | (defsubst vc-parse-buffer (pattern i) |
| 277 | "Find PATTERN in the current buffer and return its Ith submatch." |
| 278 | (goto-char (point-min)) |
| 279 | (if (re-search-forward pattern nil t) |
| 280 | (match-string i))) |
| 281 | |
| 282 | (defun vc-insert-file (file &optional limit blocksize) |
| 283 | "Insert the contents of FILE into the current buffer. |
| 284 | |
| 285 | Optional argument LIMIT is a regexp. If present, the file is inserted |
| 286 | in chunks of size BLOCKSIZE (default 8 kByte), until the first |
| 287 | occurrence of LIMIT is found. Anything from the start of that occurrence |
| 288 | to the end of the buffer is then deleted. The function returns |
| 289 | non-nil if FILE exists and its contents were successfully inserted." |
| 290 | (erase-buffer) |
| 291 | (when (file-exists-p file) |
| 292 | (if (not limit) |
| 293 | (insert-file-contents file) |
| 294 | (if (not blocksize) (setq blocksize 8192)) |
| 295 | (let ((filepos 0)) |
| 296 | (while |
| 297 | (and (< 0 (cadr (insert-file-contents |
| 298 | file nil filepos (incf filepos blocksize)))) |
| 299 | (progn (beginning-of-line) |
| 300 | (let ((pos (re-search-forward limit nil 'move))) |
| 301 | (if pos (delete-region (match-beginning 0) |
| 302 | (point-max))) |
| 303 | (not pos))))))) |
| 304 | (set-buffer-modified-p nil) |
| 305 | t)) |
| 306 | |
| 307 | (defun vc-find-root (file witness) |
| 308 | "Find the root of a checked out project. |
| 309 | The function walks up the directory tree from FILE looking for WITNESS. |
| 310 | If WITNESS if not found, return nil, otherwise return the root." |
| 311 | (let ((root nil)) |
| 312 | (while (not (or root |
| 313 | (equal file (setq file (file-name-directory file))) |
| 314 | (null file) |
| 315 | (string-match vc-ignore-dir-regexp file))) |
| 316 | (if (file-exists-p (expand-file-name witness file)) |
| 317 | (setq root file) |
| 318 | (setq file (directory-file-name file)))) |
| 319 | root)) |
| 320 | |
| 321 | ;; Access functions to file properties |
| 322 | ;; (Properties should be _set_ using vc-file-setprop, but |
| 323 | ;; _retrieved_ only through these functions, which decide |
| 324 | ;; if the property is already known or not. A property should |
| 325 | ;; only be retrieved by vc-file-getprop if there is no |
| 326 | ;; access function.) |
| 327 | |
| 328 | ;; properties indicating the backend being used for FILE |
| 329 | |
| 330 | (defun vc-registered (file) |
| 331 | "Return non-nil if FILE is registered in a version control system. |
| 332 | |
| 333 | This function performs the check each time it is called. To rely |
| 334 | on the result of a previous call, use `vc-backend' instead. If the |
| 335 | file was previously registered under a certain backend, then that |
| 336 | backend is tried first." |
| 337 | (let (handler) |
| 338 | (cond |
| 339 | ((string-match vc-ignore-dir-regexp (file-name-directory file)) nil) |
| 340 | ((and (boundp 'file-name-handler-alist) |
| 341 | (setq handler (find-file-name-handler file 'vc-registered))) |
| 342 | ;; handler should set vc-backend and return t if registered |
| 343 | (funcall handler 'vc-registered file)) |
| 344 | (t |
| 345 | ;; There is no file name handler. |
| 346 | ;; Try vc-BACKEND-registered for each handled BACKEND. |
| 347 | (catch 'found |
| 348 | (let ((backend (vc-file-getprop file 'vc-backend))) |
| 349 | (mapcar |
| 350 | (lambda (b) |
| 351 | (and (vc-call-backend b 'registered file) |
| 352 | (vc-file-setprop file 'vc-backend b) |
| 353 | (throw 'found t))) |
| 354 | (if (or (not backend) (eq backend 'none)) |
| 355 | vc-handled-backends |
| 356 | (cons backend vc-handled-backends)))) |
| 357 | ;; File is not registered. |
| 358 | (vc-file-setprop file 'vc-backend 'none) |
| 359 | nil))))) |
| 360 | |
| 361 | (defun vc-backend (file) |
| 362 | "Return the version control type of FILE, nil if it is not registered." |
| 363 | ;; `file' can be nil in several places (typically due to the use of |
| 364 | ;; code like (vc-backend buffer-file-name)). |
| 365 | (when (stringp file) |
| 366 | (let ((property (vc-file-getprop file 'vc-backend))) |
| 367 | ;; Note that internally, Emacs remembers unregistered |
| 368 | ;; files by setting the property to `none'. |
| 369 | (cond ((eq property 'none) nil) |
| 370 | (property) |
| 371 | ;; vc-registered sets the vc-backend property |
| 372 | (t (if (vc-registered file) |
| 373 | (vc-file-getprop file 'vc-backend) |
| 374 | nil)))))) |
| 375 | |
| 376 | (defun vc-backend-subdirectory-name (file) |
| 377 | "Return where the master and lock FILEs for the current directory are kept." |
| 378 | (symbol-name (vc-backend file))) |
| 379 | |
| 380 | (defun vc-name (file) |
| 381 | "Return the master name of FILE. |
| 382 | If the file is not registered, or the master name is not known, return nil." |
| 383 | ;; TODO: This should ultimately become obsolete, at least up here |
| 384 | ;; in vc-hooks. |
| 385 | (or (vc-file-getprop file 'vc-name) |
| 386 | ;; force computation of the property by calling |
| 387 | ;; vc-BACKEND-registered explicitly |
| 388 | (if (and (vc-backend file) |
| 389 | (vc-call-backend (vc-backend file) 'registered file)) |
| 390 | (vc-file-getprop file 'vc-name)))) |
| 391 | |
| 392 | (defun vc-checkout-model (file) |
| 393 | "Indicate how FILE is checked out. |
| 394 | |
| 395 | If FILE is not registered, this function always returns nil. |
| 396 | For registered files, the possible values are: |
| 397 | |
| 398 | 'implicit FILE is always writeable, and checked out `implicitly' |
| 399 | when the user saves the first changes to the file. |
| 400 | |
| 401 | 'locking FILE is read-only if up-to-date; user must type |
| 402 | \\[vc-next-action] before editing. Strict locking |
| 403 | is assumed. |
| 404 | |
| 405 | 'announce FILE is read-only if up-to-date; user must type |
| 406 | \\[vc-next-action] before editing. But other users |
| 407 | may be editing at the same time." |
| 408 | (or (vc-file-getprop file 'vc-checkout-model) |
| 409 | (if (vc-backend file) |
| 410 | (vc-file-setprop file 'vc-checkout-model |
| 411 | (vc-call checkout-model file))))) |
| 412 | |
| 413 | (defun vc-user-login-name (file) |
| 414 | "Return the name under which the user accesses the given FILE." |
| 415 | (or (and (eq (string-match tramp-file-name-regexp file) 0) |
| 416 | ;; tramp case: execute "whoami" via tramp |
| 417 | (let ((default-directory (file-name-directory file))) |
| 418 | (with-temp-buffer |
| 419 | (if (not (zerop (process-file "whoami" nil t))) |
| 420 | ;; fall through if "whoami" didn't work |
| 421 | nil |
| 422 | ;; remove trailing newline |
| 423 | (delete-region (1- (point-max)) (point-max)) |
| 424 | (buffer-string))))) |
| 425 | ;; normal case |
| 426 | (user-login-name) |
| 427 | ;; if user-login-name is nil, return the UID as a string |
| 428 | (number-to-string (user-uid)))) |
| 429 | |
| 430 | (defun vc-state (file) |
| 431 | "Return the version control state of FILE. |
| 432 | |
| 433 | If FILE is not registered, this function always returns nil. |
| 434 | For registered files, the value returned is one of: |
| 435 | |
| 436 | 'up-to-date The working file is unmodified with respect to the |
| 437 | latest version on the current branch, and not locked. |
| 438 | |
| 439 | 'edited The working file has been edited by the user. If |
| 440 | locking is used for the file, this state means that |
| 441 | the current version is locked by the calling user. |
| 442 | |
| 443 | USER The current version of the working file is locked by |
| 444 | some other USER (a string). |
| 445 | |
| 446 | 'needs-patch The file has not been edited by the user, but there is |
| 447 | a more recent version on the current branch stored |
| 448 | in the master file. |
| 449 | |
| 450 | 'needs-merge The file has been edited by the user, and there is also |
| 451 | a more recent version on the current branch stored in |
| 452 | the master file. This state can only occur if locking |
| 453 | is not used for the file. |
| 454 | |
| 455 | 'unlocked-changes The current version of the working file is not locked, |
| 456 | but the working file has been changed with respect |
| 457 | to that version. This state can only occur for files |
| 458 | with locking; it represents an erroneous condition that |
| 459 | should be resolved by the user (vc-next-action will |
| 460 | prompt the user to do it)." |
| 461 | ;; FIXME: New (sub)states needed (?): |
| 462 | ;; - `added' (i.e. `edited' but with no base version yet, |
| 463 | ;; typically represented by vc-workfile-version = "0") |
| 464 | ;; - `conflict' (i.e. `edited' with conflict markers) |
| 465 | ;; - `removed' |
| 466 | ;; - `copied' and `moved' (might be handled by `removed' and `added') |
| 467 | (or (vc-file-getprop file 'vc-state) |
| 468 | (if (vc-backend file) |
| 469 | (vc-file-setprop file 'vc-state |
| 470 | (vc-call state-heuristic file))))) |
| 471 | |
| 472 | (defun vc-recompute-state (file) |
| 473 | "Recompute the version control state of FILE, and return it. |
| 474 | This calls the possibly expensive function vc-BACKEND-state, |
| 475 | rather than the heuristic." |
| 476 | (vc-file-setprop file 'vc-state (vc-call state file))) |
| 477 | |
| 478 | (defsubst vc-up-to-date-p (file) |
| 479 | "Convenience function that checks whether `vc-state' of FILE is `up-to-date'." |
| 480 | (eq (vc-state file) 'up-to-date)) |
| 481 | |
| 482 | (defun vc-default-state-heuristic (backend file) |
| 483 | "Default implementation of vc-state-heuristic. |
| 484 | It simply calls the real state computation function `vc-BACKEND-state' |
| 485 | and does not employ any heuristic at all." |
| 486 | (vc-call-backend backend 'state file)) |
| 487 | |
| 488 | (defun vc-workfile-unchanged-p (file) |
| 489 | "Return non-nil if FILE has not changed since the last checkout." |
| 490 | (let ((checkout-time (vc-file-getprop file 'vc-checkout-time)) |
| 491 | (lastmod (nth 5 (file-attributes file)))) |
| 492 | (if (and checkout-time |
| 493 | ;; Tramp and Ange-FTP return this when they don't know the time. |
| 494 | (not (equal lastmod '(0 0)))) |
| 495 | (equal checkout-time lastmod) |
| 496 | (let ((unchanged (vc-call workfile-unchanged-p file))) |
| 497 | (vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0)) |
| 498 | unchanged)))) |
| 499 | |
| 500 | (defun vc-default-workfile-unchanged-p (backend file) |
| 501 | "Check if FILE is unchanged by diffing against the master version. |
| 502 | Return non-nil if FILE is unchanged." |
| 503 | (zerop (condition-case err |
| 504 | ;; If the implementation supports it, let the output |
| 505 | ;; go to *vc*, not *vc-diff*, since this is an internal call. |
| 506 | (vc-call diff file nil nil "*vc*") |
| 507 | (wrong-number-of-arguments |
| 508 | ;; If this error came from the above call to vc-BACKEND-diff, |
| 509 | ;; try again without the optional buffer argument (for |
| 510 | ;; backward compatibility). Otherwise, resignal. |
| 511 | (if (or (not (eq (cadr err) |
| 512 | (indirect-function |
| 513 | (vc-find-backend-function (vc-backend file) |
| 514 | 'diff)))) |
| 515 | (not (eq (caddr err) 4))) |
| 516 | (signal (car err) (cdr err)) |
| 517 | (vc-call diff file)))))) |
| 518 | |
| 519 | (defun vc-workfile-version (file) |
| 520 | "Return the version level of the current workfile FILE. |
| 521 | If FILE is not registered, this function always returns nil." |
| 522 | (or (vc-file-getprop file 'vc-workfile-version) |
| 523 | (if (vc-backend file) |
| 524 | (vc-file-setprop file 'vc-workfile-version |
| 525 | (vc-call workfile-version file))))) |
| 526 | |
| 527 | (defun vc-default-registered (backend file) |
| 528 | "Check if FILE is registered in BACKEND using vc-BACKEND-master-templates." |
| 529 | (let ((sym (vc-make-backend-sym backend 'master-templates))) |
| 530 | (unless (get backend 'vc-templates-grabbed) |
| 531 | (put backend 'vc-templates-grabbed t) |
| 532 | (set sym (append (delq nil |
| 533 | (mapcar |
| 534 | (lambda (template) |
| 535 | (and (consp template) |
| 536 | (eq (cdr template) backend) |
| 537 | (car template))) |
| 538 | (with-no-warnings |
| 539 | vc-master-templates))) |
| 540 | (symbol-value sym)))) |
| 541 | (let ((result (vc-check-master-templates file (symbol-value sym)))) |
| 542 | (if (stringp result) |
| 543 | (vc-file-setprop file 'vc-name result) |
| 544 | nil)))) ; Not registered |
| 545 | |
| 546 | (defun vc-possible-master (s dirname basename) |
| 547 | (cond |
| 548 | ((stringp s) (format s dirname basename)) |
| 549 | ((functionp s) |
| 550 | ;; The template is a function to invoke. If the |
| 551 | ;; function returns non-nil, that means it has found a |
| 552 | ;; master. For backward compatibility, we also handle |
| 553 | ;; the case that the function throws a 'found atom |
| 554 | ;; and a pair (cons MASTER-FILE BACKEND). |
| 555 | (let ((result (catch 'found (funcall s dirname basename)))) |
| 556 | (if (consp result) (car result) result))))) |
| 557 | |
| 558 | (defun vc-check-master-templates (file templates) |
| 559 | "Return non-nil if there is a master corresponding to FILE. |
| 560 | |
| 561 | TEMPLATES is a list of strings or functions. If an element is a |
| 562 | string, it must be a control string as required by `format', with two |
| 563 | string placeholders, such as \"%sRCS/%s,v\". The directory part of |
| 564 | FILE is substituted for the first placeholder, the basename of FILE |
| 565 | for the second. If a file with the resulting name exists, it is taken |
| 566 | as the master of FILE, and returned. |
| 567 | |
| 568 | If an element of TEMPLATES is a function, it is called with the |
| 569 | directory part and the basename of FILE as arguments. It should |
| 570 | return non-nil if it finds a master; that value is then returned by |
| 571 | this function." |
| 572 | (let ((dirname (or (file-name-directory file) "")) |
| 573 | (basename (file-name-nondirectory file))) |
| 574 | (catch 'found |
| 575 | (mapcar |
| 576 | (lambda (s) |
| 577 | (let ((trial (vc-possible-master s dirname basename))) |
| 578 | (if (and trial (file-exists-p trial) |
| 579 | ;; Make sure the file we found with name |
| 580 | ;; TRIAL is not the source file itself. |
| 581 | ;; That can happen with RCS-style names if |
| 582 | ;; the file name is truncated (e.g. to 14 |
| 583 | ;; chars). See if either directory or |
| 584 | ;; attributes differ. |
| 585 | (or (not (string= dirname |
| 586 | (file-name-directory trial))) |
| 587 | (not (equal (file-attributes file) |
| 588 | (file-attributes trial))))) |
| 589 | (throw 'found trial)))) |
| 590 | templates)))) |
| 591 | |
| 592 | (defun vc-toggle-read-only (&optional verbose) |
| 593 | "Change read-only status of current buffer, perhaps via version control. |
| 594 | |
| 595 | If the buffer is visiting a file registered with version control, |
| 596 | then check the file in or out. Otherwise, just change the read-only flag |
| 597 | of the buffer. |
| 598 | With prefix argument, ask for version number to check in or check out. |
| 599 | Check-out of a specified version number does not lock the file; |
| 600 | to do that, use this command a second time with no argument. |
| 601 | |
| 602 | If you bind this function to \\[toggle-read-only], then Emacs checks files |
| 603 | in or out whenever you toggle the read-only flag." |
| 604 | (interactive "P") |
| 605 | (if (or (and (boundp 'vc-dired-mode) vc-dired-mode) |
| 606 | ;; use boundp because vc.el might not be loaded |
| 607 | (vc-backend buffer-file-name)) |
| 608 | (vc-next-action verbose) |
| 609 | (toggle-read-only))) |
| 610 | |
| 611 | (defun vc-default-make-version-backups-p (backend file) |
| 612 | "Return non-nil if unmodified versions should be backed up locally. |
| 613 | The default is to switch off this feature." |
| 614 | nil) |
| 615 | |
| 616 | (defun vc-version-backup-file-name (file &optional rev manual regexp) |
| 617 | "Return a backup file name for REV or the current version of FILE. |
| 618 | If MANUAL is non-nil it means that a name for backups created by |
| 619 | the user should be returned; if REGEXP is non-nil that means to return |
| 620 | a regexp for matching all such backup files, regardless of the version." |
| 621 | (if regexp |
| 622 | (concat (regexp-quote (file-name-nondirectory file)) |
| 623 | "\\.~[0-9.]+" (unless manual "\\.") "~") |
| 624 | (expand-file-name (concat (file-name-nondirectory file) |
| 625 | ".~" (or rev (vc-workfile-version file)) |
| 626 | (unless manual ".") "~") |
| 627 | (file-name-directory file)))) |
| 628 | |
| 629 | (defun vc-delete-automatic-version-backups (file) |
| 630 | "Delete all existing automatic version backups for FILE." |
| 631 | (condition-case nil |
| 632 | (mapcar |
| 633 | 'delete-file |
| 634 | (directory-files (or (file-name-directory file) default-directory) t |
| 635 | (vc-version-backup-file-name file nil nil t))) |
| 636 | ;; Don't fail when the directory doesn't exist. |
| 637 | (file-error nil))) |
| 638 | |
| 639 | (defun vc-make-version-backup (file) |
| 640 | "Make a backup copy of FILE, which is assumed in sync with the repository. |
| 641 | Before doing that, check if there are any old backups and get rid of them." |
| 642 | (unless (and (fboundp 'msdos-long-file-names) |
| 643 | (not (with-no-warnings (msdos-long-file-names)))) |
| 644 | (vc-delete-automatic-version-backups file) |
| 645 | (condition-case nil |
| 646 | (copy-file file (vc-version-backup-file-name file) |
| 647 | nil 'keep-date) |
| 648 | ;; It's ok if it doesn't work (e.g. directory not writable), |
| 649 | ;; since this is just for efficiency. |
| 650 | (file-error |
| 651 | (message |
| 652 | (concat "Warning: Cannot make version backup; " |
| 653 | "diff/revert therefore not local")))))) |
| 654 | |
| 655 | (defun vc-before-save () |
| 656 | "Function to be called by `basic-save-buffer' (in files.el)." |
| 657 | ;; If the file on disk is still in sync with the repository, |
| 658 | ;; and version backups should be made, copy the file to |
| 659 | ;; another name. This enables local diffs and local reverting. |
| 660 | (let ((file buffer-file-name)) |
| 661 | (and (vc-backend file) |
| 662 | (vc-up-to-date-p file) |
| 663 | (eq (vc-checkout-model file) 'implicit) |
| 664 | (vc-call make-version-backups-p file) |
| 665 | (vc-make-version-backup file)))) |
| 666 | |
| 667 | (defun vc-after-save () |
| 668 | "Function to be called by `basic-save-buffer' (in files.el)." |
| 669 | ;; If the file in the current buffer is under version control, |
| 670 | ;; up-to-date, and locking is not used for the file, set |
| 671 | ;; the state to 'edited and redisplay the mode line. |
| 672 | (let ((file buffer-file-name)) |
| 673 | (and (vc-backend file) |
| 674 | (or (and (equal (vc-file-getprop file 'vc-checkout-time) |
| 675 | (nth 5 (file-attributes file))) |
| 676 | ;; File has been saved in the same second in which |
| 677 | ;; it was checked out. Clear the checkout-time |
| 678 | ;; to avoid confusion. |
| 679 | (vc-file-setprop file 'vc-checkout-time nil)) |
| 680 | t) |
| 681 | (vc-up-to-date-p file) |
| 682 | (eq (vc-checkout-model file) 'implicit) |
| 683 | (vc-file-setprop file 'vc-state 'edited) |
| 684 | (vc-mode-line file) |
| 685 | (if (featurep 'vc) |
| 686 | ;; If VC is not loaded, then there can't be |
| 687 | ;; any VC Dired buffer to synchronize. |
| 688 | (vc-dired-resynch-file file))))) |
| 689 | |
| 690 | (defun vc-mode-line (file) |
| 691 | "Set `vc-mode' to display type of version control for FILE. |
| 692 | The value is set in the current buffer, which should be the buffer |
| 693 | visiting FILE." |
| 694 | (interactive (list buffer-file-name)) |
| 695 | (let ((backend (vc-backend file))) |
| 696 | (if (not backend) |
| 697 | (setq vc-mode nil) |
| 698 | (setq vc-mode (concat " " (if vc-display-status |
| 699 | (vc-call mode-line-string file) |
| 700 | (symbol-name backend)))) |
| 701 | ;; If the file is locked by some other user, make |
| 702 | ;; the buffer read-only. Like this, even root |
| 703 | ;; cannot modify a file that someone else has locked. |
| 704 | (and (equal file buffer-file-name) |
| 705 | (stringp (vc-state file)) |
| 706 | (setq buffer-read-only t)) |
| 707 | ;; If the user is root, and the file is not owner-writable, |
| 708 | ;; then pretend that we can't write it |
| 709 | ;; even though we can (because root can write anything). |
| 710 | ;; This way, even root cannot modify a file that isn't locked. |
| 711 | (and (equal file buffer-file-name) |
| 712 | (not buffer-read-only) |
| 713 | (zerop (user-real-uid)) |
| 714 | (zerop (logand (file-modes buffer-file-name) 128)) |
| 715 | (setq buffer-read-only t))) |
| 716 | (force-mode-line-update) |
| 717 | backend)) |
| 718 | |
| 719 | (defun vc-default-mode-line-string (backend file) |
| 720 | "Return string for placement in modeline by `vc-mode-line' for FILE. |
| 721 | Format: |
| 722 | |
| 723 | \"BACKEND-REV\" if the file is up-to-date |
| 724 | \"BACKEND:REV\" if the file is edited (or locked by the calling user) |
| 725 | \"BACKEND:LOCKER:REV\" if the file is locked by somebody else |
| 726 | |
| 727 | This function assumes that the file is registered." |
| 728 | (setq backend (symbol-name backend)) |
| 729 | (let ((state (vc-state file)) |
| 730 | (rev (vc-workfile-version file))) |
| 731 | (cond ((or (eq state 'up-to-date) |
| 732 | (eq state 'needs-patch)) |
| 733 | (concat backend "-" rev)) |
| 734 | ((stringp state) |
| 735 | (concat backend ":" state ":" rev)) |
| 736 | (t |
| 737 | ;; Not just for the 'edited state, but also a fallback |
| 738 | ;; for all other states. Think about different symbols |
| 739 | ;; for 'needs-patch and 'needs-merge. |
| 740 | (concat backend ":" rev))))) |
| 741 | |
| 742 | (defun vc-follow-link () |
| 743 | "If current buffer visits a symbolic link, visit the real file. |
| 744 | If the real file is already visited in another buffer, make that buffer |
| 745 | current, and kill the buffer that visits the link." |
| 746 | (let* ((truename (abbreviate-file-name (file-chase-links buffer-file-name))) |
| 747 | (true-buffer (find-buffer-visiting truename)) |
| 748 | (this-buffer (current-buffer))) |
| 749 | (if (eq true-buffer this-buffer) |
| 750 | (progn |
| 751 | (kill-buffer this-buffer) |
| 752 | ;; In principle, we could do something like set-visited-file-name. |
| 753 | ;; However, it can't be exactly the same as set-visited-file-name. |
| 754 | ;; I'm not going to work out the details right now. -- rms. |
| 755 | (set-buffer (find-file-noselect truename))) |
| 756 | (set-buffer true-buffer) |
| 757 | (kill-buffer this-buffer)))) |
| 758 | |
| 759 | (defun vc-default-find-file-hook (backend) |
| 760 | nil) |
| 761 | |
| 762 | (defun vc-find-file-hook () |
| 763 | "Function for `find-file-hook' activating VC mode if appropriate." |
| 764 | ;; Recompute whether file is version controlled, |
| 765 | ;; if user has killed the buffer and revisited. |
| 766 | (if vc-mode |
| 767 | (setq vc-mode nil)) |
| 768 | (when buffer-file-name |
| 769 | (vc-file-clearprops buffer-file-name) |
| 770 | (cond |
| 771 | ((vc-backend buffer-file-name) |
| 772 | ;; Compute the state and put it in the modeline. |
| 773 | (vc-mode-line buffer-file-name) |
| 774 | (unless vc-make-backup-files |
| 775 | ;; Use this variable, not make-backup-files, |
| 776 | ;; because this is for things that depend on the file name. |
| 777 | (set (make-local-variable 'backup-inhibited) t)) |
| 778 | ;; Let the backend setup any buffer-local things he needs. |
| 779 | (vc-call-backend (vc-backend buffer-file-name) 'find-file-hook)) |
| 780 | ((let ((link-type (and (file-symlink-p buffer-file-name) |
| 781 | (vc-backend (file-chase-links buffer-file-name))))) |
| 782 | (cond ((not link-type) nil) ;Nothing to do. |
| 783 | ((eq vc-follow-symlinks nil) |
| 784 | (message |
| 785 | "Warning: symbolic link to %s-controlled source file" link-type)) |
| 786 | ((or (not (eq vc-follow-symlinks 'ask)) |
| 787 | ;; If we already visited this file by following |
| 788 | ;; the link, don't ask again if we try to visit |
| 789 | ;; it again. GUD does that, and repeated questions |
| 790 | ;; are painful. |
| 791 | (get-file-buffer |
| 792 | (abbreviate-file-name |
| 793 | (file-chase-links buffer-file-name)))) |
| 794 | |
| 795 | (vc-follow-link) |
| 796 | (message "Followed link to %s" buffer-file-name) |
| 797 | (vc-find-file-hook)) |
| 798 | (t |
| 799 | (if (yes-or-no-p (format |
| 800 | "Symbolic link to %s-controlled source file; follow link? " link-type)) |
| 801 | (progn (vc-follow-link) |
| 802 | (message "Followed link to %s" buffer-file-name) |
| 803 | (vc-find-file-hook)) |
| 804 | (message |
| 805 | "Warning: editing through the link bypasses version control") |
| 806 | )))))))) |
| 807 | |
| 808 | (add-hook 'find-file-hook 'vc-find-file-hook) |
| 809 | |
| 810 | ;; more hooks, this time for file-not-found |
| 811 | (defun vc-file-not-found-hook () |
| 812 | "When file is not found, try to check it out from version control. |
| 813 | Returns t if checkout was successful, nil otherwise. |
| 814 | Used in `find-file-not-found-functions'." |
| 815 | ;; When a file does not exist, ignore cached info about it |
| 816 | ;; from a previous visit. |
| 817 | (vc-file-clearprops buffer-file-name) |
| 818 | (let ((backend (vc-backend buffer-file-name))) |
| 819 | (if backend (vc-call-backend backend 'find-file-not-found-hook)))) |
| 820 | |
| 821 | (defun vc-default-find-file-not-found-hook (backend) |
| 822 | (if (yes-or-no-p |
| 823 | (format "File %s was lost; check out from version control? " |
| 824 | (file-name-nondirectory buffer-file-name))) |
| 825 | (save-excursion |
| 826 | (require 'vc) |
| 827 | (setq default-directory (file-name-directory buffer-file-name)) |
| 828 | (not (vc-error-occurred (vc-checkout buffer-file-name)))))) |
| 829 | |
| 830 | (add-hook 'find-file-not-found-functions 'vc-file-not-found-hook) |
| 831 | |
| 832 | (defun vc-kill-buffer-hook () |
| 833 | "Discard VC info about a file when we kill its buffer." |
| 834 | (if buffer-file-name |
| 835 | (vc-file-clearprops buffer-file-name))) |
| 836 | |
| 837 | (add-hook 'kill-buffer-hook 'vc-kill-buffer-hook) |
| 838 | |
| 839 | ;; Now arrange for (autoloaded) bindings of the main package. |
| 840 | ;; Bindings for this have to go in the global map, as we'll often |
| 841 | ;; want to call them from random buffers. |
| 842 | |
| 843 | ;; Autoloading works fine, but it prevents shortcuts from appearing |
| 844 | ;; in the menu because they don't exist yet when the menu is built. |
| 845 | ;; (autoload 'vc-prefix-map "vc" nil nil 'keymap) |
| 846 | (defvar vc-prefix-map |
| 847 | (let ((map (make-sparse-keymap))) |
| 848 | (define-key map "a" 'vc-update-change-log) |
| 849 | (define-key map "b" 'vc-switch-backend) |
| 850 | (define-key map "c" 'vc-cancel-version) |
| 851 | (define-key map "d" 'vc-directory) |
| 852 | (define-key map "g" 'vc-annotate) |
| 853 | (define-key map "h" 'vc-insert-headers) |
| 854 | (define-key map "i" 'vc-register) |
| 855 | (define-key map "l" 'vc-print-log) |
| 856 | (define-key map "m" 'vc-merge) |
| 857 | (define-key map "r" 'vc-retrieve-snapshot) |
| 858 | (define-key map "s" 'vc-create-snapshot) |
| 859 | (define-key map "u" 'vc-revert-buffer) |
| 860 | (define-key map "v" 'vc-next-action) |
| 861 | (define-key map "=" 'vc-diff) |
| 862 | (define-key map "~" 'vc-version-other-window) |
| 863 | map)) |
| 864 | (fset 'vc-prefix-map vc-prefix-map) |
| 865 | (define-key global-map "\C-xv" 'vc-prefix-map) |
| 866 | |
| 867 | (if (not (boundp 'vc-menu-map)) |
| 868 | ;; Don't do the menu bindings if menu-bar.el wasn't loaded to defvar |
| 869 | ;; vc-menu-map. |
| 870 | () |
| 871 | ;;(define-key vc-menu-map [show-files] |
| 872 | ;; '("Show Files under VC" . (vc-directory t))) |
| 873 | (define-key vc-menu-map [vc-retrieve-snapshot] |
| 874 | '("Retrieve Snapshot" . vc-retrieve-snapshot)) |
| 875 | (define-key vc-menu-map [vc-create-snapshot] |
| 876 | '("Create Snapshot" . vc-create-snapshot)) |
| 877 | (define-key vc-menu-map [vc-directory] '("VC Directory Listing" . vc-directory)) |
| 878 | (define-key vc-menu-map [separator1] '("----")) |
| 879 | (define-key vc-menu-map [vc-annotate] '("Annotate" . vc-annotate)) |
| 880 | (define-key vc-menu-map [vc-rename-file] '("Rename File" . vc-rename-file)) |
| 881 | (define-key vc-menu-map [vc-version-other-window] |
| 882 | '("Show Other Version" . vc-version-other-window)) |
| 883 | (define-key vc-menu-map [vc-diff] '("Compare with Base Version" . vc-diff)) |
| 884 | (define-key vc-menu-map [vc-update-change-log] |
| 885 | '("Update ChangeLog" . vc-update-change-log)) |
| 886 | (define-key vc-menu-map [vc-print-log] '("Show History" . vc-print-log)) |
| 887 | (define-key vc-menu-map [separator2] '("----")) |
| 888 | (define-key vc-menu-map [vc-insert-header] |
| 889 | '("Insert Header" . vc-insert-headers)) |
| 890 | (define-key vc-menu-map [undo] '("Undo Last Check-In" . vc-cancel-version)) |
| 891 | (define-key vc-menu-map [vc-revert-buffer] |
| 892 | '("Revert to Base Version" . vc-revert-buffer)) |
| 893 | (define-key vc-menu-map [vc-update] |
| 894 | '("Update to Latest Version" . vc-update)) |
| 895 | (define-key vc-menu-map [vc-next-action] '("Check In/Out" . vc-next-action)) |
| 896 | (define-key vc-menu-map [vc-register] '("Register" . vc-register))) |
| 897 | |
| 898 | ;; These are not correct and it's not currently clear how doing it |
| 899 | ;; better (with more complicated expressions) might slow things down |
| 900 | ;; on older systems. |
| 901 | |
| 902 | ;;(put 'vc-rename-file 'menu-enable 'vc-mode) |
| 903 | ;;(put 'vc-annotate 'menu-enable '(eq (vc-buffer-backend) 'CVS)) |
| 904 | ;;(put 'vc-version-other-window 'menu-enable 'vc-mode) |
| 905 | ;;(put 'vc-diff 'menu-enable 'vc-mode) |
| 906 | ;;(put 'vc-update-change-log 'menu-enable |
| 907 | ;; '(member (vc-buffer-backend) '(RCS CVS))) |
| 908 | ;;(put 'vc-print-log 'menu-enable 'vc-mode) |
| 909 | ;;(put 'vc-cancel-version 'menu-enable 'vc-mode) |
| 910 | ;;(put 'vc-revert-buffer 'menu-enable 'vc-mode) |
| 911 | ;;(put 'vc-insert-headers 'menu-enable 'vc-mode) |
| 912 | ;;(put 'vc-next-action 'menu-enable 'vc-mode) |
| 913 | ;;(put 'vc-register 'menu-enable '(and buffer-file-name (not vc-mode))) |
| 914 | |
| 915 | (provide 'vc-hooks) |
| 916 | |
| 917 | ;; arch-tag: 2e5a6fa7-1d30-48e2-8bd0-e3d335f04f32 |
| 918 | ;;; vc-hooks.el ends here |