]> code.delx.au - gnu-emacs/blobdiff - lisp/vc-hooks.el
(dired-mode-map): Fix menu text of image-dired-display-thumbs.
[gnu-emacs] / lisp / vc-hooks.el
index 7d2a4a946ac44d0937d87652dcb26317c8b1fa1c..2ccbdcc56715c8688dd53041d97d4eb190414da3 100644 (file)
@@ -8,10 +8,10 @@
 
 ;; 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
@@ -19,9 +19,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 <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -62,7 +60,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 +75,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}")
@@ -287,8 +286,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))
 \f
 (defsubst vc-parse-buffer (pattern i)
@@ -365,7 +364,7 @@ the root is the last directory for which WITNESS *is* found."
 ;; 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.)
 
@@ -440,26 +439,23 @@ If the file is not registered, or the master name is not known, return nil."
               (vc-call-backend (vc-backend file) '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 writeable, 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."
@@ -494,7 +490,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.
 
@@ -524,47 +520,37 @@ For registered files, the value returned is one of:
   '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-state listing with a flag
+  '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)
-      (when (and (> (length file) 0) (vc-backend file))
-       (vc-file-setprop file 'vc-state
-                        (vc-call state-heuristic file)))))
-
-(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)))
+      (when (> (length file) 0)
+        (let ((backend (vc-backend file)))
+          (when backend
+            (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))
@@ -587,26 +573,26 @@ 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)
   "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)
-      (when (vc-backend file)
-       (vc-file-setprop file 'vc-working-revision
-                        (vc-call working-revision file)))))
+      (let ((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
@@ -687,19 +673,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)
@@ -752,23 +736,25 @@ 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))
+  (let ((file buffer-file-name)
+        backend)
     (ignore-errors               ;Be careful not to prevent saving the file.
-      (and (vc-backend file)
+      (and (setq backend (vc-backend file))
            (vc-up-to-date-p file)
-           (eq (vc-checkout-model file) 'implicit)
-           (vc-call make-version-backups-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-dired-resynch-file "vc" (file))
+(declare-function vc-dir-resynch-file "vc-dir" (&optional fname))
 
 (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
@@ -777,13 +763,13 @@ Before doing that, check if there are any old backups and get rid of them."
                  (vc-file-setprop file 'vc-checkout-time nil))
             t)
          (vc-up-to-date-p file)
-         (eq (vc-checkout-model file) 'implicit)
+         (eq (vc-checkout-model backend (list file)) 'implicit)
          (vc-file-setprop file 'vc-state 'edited)
         (vc-mode-line file)
-        (when (featurep 'vc)
-          ;; If VC is not loaded, then there can't be
-          ;; any VC Dired buffer to synchronize.
-          (vc-dired-resynch-file 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)))))
 
 (defvar vc-menu-entry
   '(menu-item "Version Control" vc-menu-map
@@ -808,7 +794,7 @@ visiting FILE."
   (let ((backend (vc-backend file)))
     (if (not backend)
        (setq vc-mode nil)
-      (let* ((ml-string (vc-call mode-line-string file))
+      (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
@@ -833,9 +819,9 @@ visiting FILE."
       ;; 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)
+      ;; 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)))
@@ -857,7 +843,7 @@ This function assumes that the file is registered."
        (rev     (vc-working-revision file)))
     (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))
           ((stringp state)
@@ -878,7 +864,7 @@ This function assumes that the file is registered."
           (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
@@ -912,6 +898,7 @@ current, and kill the buffer that visits the link."
       (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.
@@ -994,15 +981,13 @@ Used in `find-file-not-found-functions'."
     (define-key map "i" 'vc-register)
     (define-key map "l" 'vc-print-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 "~" 'vc-revision-other-window)
-    ;; `vc-dir' is a not-quite-ready replacement for `vc-directory'
-    ;; (define-key map "?" 'vc-dir)
     map))
 (fset 'vc-prefix-map vc-prefix-map)
 (define-key global-map "\C-xv" 'vc-prefix-map)
@@ -1011,12 +996,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-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