X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/6002d9b956710e58b1decdc098ea7ef8e9042d07..76e1e40b4eeb45f485f03069a0a9a43480779dfc:/lisp/vc.el diff --git a/lisp/vc.el b/lisp/vc.el index 64b1e943f8..1f3ea9ddca 100644 --- a/lisp/vc.el +++ b/lisp/vc.el @@ -1,7 +1,7 @@ ;;; vc.el --- drive a version-control system from within Emacs ;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000, -;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 +;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 ;; Free Software Foundation, Inc. ;; Author: FSF (see below for full credits) @@ -159,8 +159,8 @@ ;; and then do a (funcall UPDATE-FUNCTION RESULT nil) ;; when all the results have been computed. ;; To provide more backend specific functionality for `vc-dir' -;; the following functions might be needed: `status-extra-headers', -;; `status-printer', `extra-status-menu' and `dir-status-files'. +;; the following functions might be needed: `dir-extra-headers', +;; `dir-printer', `extra-dir-menu' and `dir-status-files'. ;; ;; - dir-status-files (dir files default-state update-function) ;; @@ -170,11 +170,11 @@ ;; files. If not provided, the default is to consider that the files ;; are in DEFAULT-STATE. ;; -;; - status-extra-headers (dir) +;; - dir-extra-headers (dir) ;; ;; Return a string that will be added to the *vc-dir* buffer header. ;; -;; - status-printer (fileinfo) +;; - dir-printer (fileinfo) ;; ;; Pretty print the `vc-dir-fileinfo' FILEINFO. ;; If a backend needs to show more information than the default FILE @@ -513,11 +513,6 @@ ;; Operation called in current buffer when opening a file. This can ;; be used by the backend to setup some local variables it might need. ;; -;; - find-file-not-found-hook () -;; -;; Operation called in current buffer when opening a non-existing file. -;; By default, this asks the user if she wants to check out the file. -;; ;; - extra-menu () ;; ;; Return a menu keymap, the items in the keymap will appear at the @@ -527,7 +522,7 @@ ;; to your backend and which does not map to any of the VC generic ;; concepts. ;; -;; - extra-status-menu () +;; - extra-dir-menu () ;; ;; Return a menu keymap, the items in the keymap will appear at the ;; end of the VC Status menu. The goal is to allow backends to @@ -697,21 +692,22 @@ These are passed to the checkin program by \\[vc-register]." (defcustom vc-diff-switches nil "A string or list of strings specifying switches for diff under VC. -When running diff under a given BACKEND, VC concatenates the values of -`diff-switches', `vc-diff-switches', and `vc-BACKEND-diff-switches' to -get the switches for that command. Thus, `vc-diff-switches' should -contain switches that are specific to version control, but not -specific to any particular backend." - :type '(choice (const :tag "None" nil) +When running diff under a given BACKEND, VC uses the first +non-nil value of `vc-BACKEND-diff-switches', `vc-diff-switches', +and `diff-switches', in that order. Since nil means to check the +next variable in the sequence, either of the first two may use +the value t to mean no switches at all. `vc-diff-switches' +should contain switches that are specific to version control, but +not specific to any particular backend." + :type '(choice (const :tag "Unspecified" nil) + (const :tag "None" t) (string :tag "Argument String") - (repeat :tag "Argument List" - :value ("") - string)) + (repeat :tag "Argument List" :value ("") string)) :group 'vc :version "21.1") (defcustom vc-diff-knows-L nil - "*Indicates whether diff understands the -L option. + "Indicates whether diff understands the -L option. The value is either `yes', `no', or nil. If it is nil, VC tries to use -L and sets this variable to remember whether it worked." :type '(choice (const :tag "Work out" nil) (const yes) (const no)) @@ -754,7 +750,7 @@ See `run-hooks'." (defcustom vc-static-header-alist '(("\\.c\\'" . "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n")) - "*Associate static header string templates with file types. + "Associate static header string templates with file types. A \%s in the template is replaced with the first string associated with the file's version control type in `vc-header-alist'." :type '(repeat (cons :format "%v" @@ -764,7 +760,7 @@ the file's version control type in `vc-header-alist'." (defcustom vc-comment-alist '((nroff-mode ".\\\"" "")) - "*Special comment delimiters for generating VC headers. + "Special comment delimiters for generating VC headers. Add an entry in this list if you need to override the normal `comment-start' and `comment-end' variables. This will only be necessary if the mode language is sensitive to blank lines." @@ -775,7 +771,7 @@ is sensitive to blank lines." :group 'vc) (defcustom vc-checkout-carefully (= (user-uid) 0) - "*Non-nil means be extra-careful in checkout. + "Non-nil means be extra-careful in checkout. Verify that the file really is not locked and that its contents match what the master file says." :type 'boolean @@ -928,7 +924,7 @@ current buffer." ;; FIXME: Why this test? --Stef (or (buffer-file-name vc-parent-buffer) (with-current-buffer vc-parent-buffer - (eq major-mode 'vc-dir-mode)))) + (derived-mode-p 'vc-dir-mode)))) (progn ;FIXME: Why not `with-current-buffer'? --Stef. (set-buffer vc-parent-buffer) (vc-deduce-fileset observer allow-unregistered state-model-only-files))) @@ -1040,9 +1036,12 @@ merge in the changes into your working copy." (verbose ;; go to a different revision (setq revision (read-string "Branch, revision, or backend to move to: ")) - (let ((vsym (intern-soft (upcase revision)))) - (if (member vsym vc-handled-backends) - (dolist (file files) (vc-transfer-file file vsym)) + (let ((revision-downcase (downcase revision))) + (if (member + revision-downcase + (mapcar (lambda (arg) (downcase (symbol-name arg))) vc-handled-backends)) + (let ((vsym (intern-soft revision-downcase))) + (dolist (file files) (vc-transfer-file file vsym))) (dolist (file files) (vc-checkout file (eq model 'implicit) revision))))) ((not (eq model 'implicit)) @@ -1084,13 +1083,16 @@ merge in the changes into your working copy." (if (not ready-for-commit) (message "No files remain to be committed") (if (not verbose) - (vc-checkin ready-for-commit) - (progn - (setq revision (read-string "New revision or backend: ")) - (let ((vsym (intern (upcase revision)))) - (if (member vsym vc-handled-backends) - (dolist (file files) (vc-transfer-file file vsym)) - (vc-checkin ready-for-commit revision)))))))) + (vc-checkin ready-for-commit backend) + (setq revision (read-string "New revision or backend: ")) + (let ((revision-downcase (downcase revision))) + (if (member + revision-downcase + (mapcar (lambda (arg) (downcase (symbol-name arg))) + vc-handled-backends)) + (let ((vsym (intern revision-downcase))) + (dolist (file files) (vc-transfer-file file vsym))) + (vc-checkin ready-for-commit backend revision))))))) ;; locked by somebody else (locking VCSes only) ((stringp state) ;; In the old days, we computed the revision once and used it on @@ -1160,7 +1162,7 @@ merge in the changes into your working copy." ;; show that the file is locked now. (vc-clear-headers file) (write-file buffer-file-name) - (vc-mode-line file)) + (vc-mode-line file backend)) (if (not (yes-or-no-p "Revert to checked-in revision, instead? ")) (error "Checkout aborted") @@ -1182,6 +1184,8 @@ merge in the changes into your working copy." nil t))))) (vc-call-backend backend 'create-repo)) +(declare-function vc-dir-move-to-goal-column "vc-dir" ()) + ;;;###autoload (defun vc-register (&optional set-revision vc-fileset comment) "Register into a version control system. @@ -1220,31 +1224,28 @@ first backend that could register the file is used." (not (file-exists-p buffer-file-name))) (set-buffer-modified-p t)) (vc-buffer-sync))))) - (lexical-let ((backend backend) - (files files)) - (vc-start-logentry - files - (if set-revision - (read-string (format "Initial revision level for %s: " files)) - (vc-call-backend backend 'init-revision)) - (or comment (not vc-initial-comment)) - nil - "Enter initial comment." - "*VC-log*" - (lambda (files rev comment) - (message "Registering %s... " files) - (mapc 'vc-file-clearprops files) - (vc-call-backend backend 'register files rev comment) - (dolist (file files) - (vc-file-setprop file 'vc-backend backend) - ;; FIXME: This is wrong: it should set `backup-inhibited' in all - ;; the buffers visiting files affected by this `vc-register', not - ;; in the current-buffer. - ;; (unless vc-make-backup-files - ;; (make-local-variable 'backup-inhibited) - ;; (setq backup-inhibited t)) - ) - (message "Registering %s... done" files)))))) + (message "Registering %s... " files) + (mapc 'vc-file-clearprops files) + (vc-call-backend backend 'register files + (if set-revision + (read-string (format "Initial revision level for %s: " files)) + (vc-call-backend backend 'init-revision)) + comment) + (mapc + (lambda (file) + (vc-file-setprop file 'vc-backend backend) + ;; FIXME: This is wrong: it should set `backup-inhibited' in all + ;; the buffers visiting files affected by this `vc-register', not + ;; in the current-buffer. + ;; (unless vc-make-backup-files + ;; (make-local-variable 'backup-inhibited) + ;; (setq backup-inhibited t)) + + (vc-resynch-buffer file vc-keep-workfiles t)) + files) + (when (derived-mode-p 'vc-dir-mode) + (vc-dir-move-to-goal-column)) + (message "Registering %s... done" files))) (defun vc-register-with (backend) "Register the current file with a specified back end." @@ -1326,7 +1327,7 @@ Type \\[vc-next-action] to check in changes.") ".\n") (message "Please explain why you stole the lock. Type C-c C-c when done."))) -(defun vc-checkin (files &optional rev comment initial-contents) +(defun vc-checkin (files backend &optional rev comment initial-contents) "Check in FILES. The optional argument REV may be a string specifying the new revision level (if nil increment the current level). COMMENT is a comment @@ -1340,28 +1341,30 @@ that the version control system supports this mode of operation. Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." (when vc-before-checkin-hook (run-hooks 'vc-before-checkin-hook)) - (vc-start-logentry - files rev comment initial-contents - "Enter a change comment." - "*VC-log*" - (lambda (files rev comment) - (message "Checking in %s..." (vc-delistify files)) - ;; "This log message intentionally left almost blank". - ;; RCS 5.7 gripes about white-space-only comments too. - (or (and comment (string-match "[^\t\n ]" comment)) - (setq comment "*** empty log message ***")) - (with-vc-properties - files - ;; We used to change buffers to get local value of vc-checkin-switches, - ;; but 'the' local buffer is not a well-defined concept for filesets. - (progn - (vc-call checkin files rev comment) - (mapc 'vc-delete-automatic-version-backups files)) - `((vc-state . up-to-date) - (vc-checkout-time . ,(nth 5 (file-attributes file))) - (vc-working-revision . nil))) - (message "Checking in %s...done" (vc-delistify files))) - 'vc-checkin-hook)) + (lexical-let + ((backend backend)) + (vc-start-logentry + files rev comment initial-contents + "Enter a change comment." + "*VC-log*" + (lambda (files rev comment) + (message "Checking in %s..." (vc-delistify files)) + ;; "This log message intentionally left almost blank". + ;; RCS 5.7 gripes about white-space-only comments too. + (or (and comment (string-match "[^\t\n ]" comment)) + (setq comment "*** empty log message ***")) + (with-vc-properties + files + ;; We used to change buffers to get local value of vc-checkin-switches, + ;; but 'the' local buffer is not a well-defined concept for filesets. + (progn + (vc-call-backend backend 'checkin files rev comment) + (mapc 'vc-delete-automatic-version-backups files)) + `((vc-state . up-to-date) + (vc-checkout-time . ,(nth 5 (file-attributes file))) + (vc-working-revision . nil))) + (message "Checking in %s...done" (vc-delistify files))) + 'vc-checkin-hook))) ;;; Additional entry points for examining version histories @@ -1398,6 +1401,18 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." 'undecided)) (defun vc-switches (backend op) + "Return a list of vc-BACKEND switches for operation OP. +BACKEND is a symbol such as `CVS', which will be downcased. +OP is a symbol such as `diff'. + +In decreasing order of preference, return the value of: +vc-BACKEND-OP-switches (e.g. `vc-cvs-diff-switches'); +vc-OP-switches (e.g. `vc-diff-switches'); or, in the case of +diff only, `diff-switches'. + +If the chosen value is not a string or a list, return nil. +This is so that you may set, e.g. `vc-svn-diff-switches' to t in order +to override the value of `vc-diff-switches' and `diff-switches'." (let ((switches (or (when backend (let ((sym (vc-make-backend-sym @@ -1587,7 +1602,7 @@ If `F.~REV~' already exists, use it instead of checking it out again." (save-current-buffer (vc-ensure-vc-buffer) (let ((completion-table - (vc-call revision-completion-table buffer-file-name)) + (vc-call revision-completion-table (list buffer-file-name))) (prompt "Revision to visit (default is working revision): ")) (list (if completion-table @@ -1802,6 +1817,35 @@ allowed and simply skipped)." ;; Miscellaneous other entry points +(defun vc-print-log-internal (backend files working-revision) + ;; Don't switch to the output buffer before running the command, + ;; so that any buffer-local settings in the vc-controlled + ;; buffer can be accessed by the command. + (vc-call-backend backend 'print-log files "*vc-change-log*") + (pop-to-buffer "*vc-change-log*") + (vc-exec-after + `(let ((inhibit-read-only t)) + (vc-call-backend ',backend 'log-view-mode) + (set (make-local-variable 'log-view-vc-backend) ',backend) + (set (make-local-variable 'log-view-vc-fileset) ',files) + + ;; FIXME: this seems to apply only to RCS/CVS, it doesn't quite + ;; belong here in the generic code. + (goto-char (point-max)) + (forward-line -1) + (while (looking-at "=*\n") + (delete-char (- (match-end 0) (match-beginning 0))) + (forward-line -1)) + (goto-char (point-min)) + (when (looking-at "[\b\t\n\v\f\r ]+") + (delete-char (- (match-end 0) (match-beginning 0)))) + + (shrink-window-if-larger-than-buffer) + ;; move point to the log entry for the working revision + (vc-call-backend ',backend 'show-log-entry ',working-revision) + (setq vc-sentinel-movepoint (point)) + (set-buffer-modified-p nil)))) + ;;;###autoload (defun vc-print-log (&optional working-revision) "List the change log of the current fileset in a window. @@ -1811,28 +1855,7 @@ If WORKING-REVISION is non-nil, leave the point at that revision." (backend (car vc-fileset)) (files (cadr vc-fileset)) (working-revision (or working-revision (vc-working-revision (car files))))) - ;; Don't switch to the output buffer before running the command, - ;; so that any buffer-local settings in the vc-controlled - ;; buffer can be accessed by the command. - (vc-call-backend backend 'print-log files "*vc-change-log*") - (pop-to-buffer "*vc-change-log*") - (vc-exec-after - `(let ((inhibit-read-only t)) - (vc-call-backend ',backend 'log-view-mode) - (set (make-local-variable 'log-view-vc-backend) ',backend) - (set (make-local-variable 'log-view-vc-fileset) ',files) - (goto-char (point-max)) (forward-line -1) - (while (looking-at "=*\n") - (delete-char (- (match-end 0) (match-beginning 0))) - (forward-line -1)) - (goto-char (point-min)) - (when (looking-at "[\b\t\n\v\f\r ]+") - (delete-char (- (match-end 0) (match-beginning 0)))) - (shrink-window-if-larger-than-buffer) - ;; move point to the log entry for the working revision - (vc-call-backend ',backend 'show-log-entry ',working-revision) - (setq vc-sentinel-movepoint (point)) - (set-buffer-modified-p nil))))) + (vc-print-log-internal backend files working-revision))) ;;;###autoload (defun vc-revert () @@ -1856,7 +1879,12 @@ to the working revision (except for keyword expansion)." (unless (yes-or-no-p (format "%s seems up-to-date. Revert anyway? " file)) (error "Revert canceled")))) (when (vc-diff-internal vc-allow-async-revert vc-fileset nil nil) - (unless (yes-or-no-p (format "Discard changes in %s? " (vc-delistify files))) + (unless (yes-or-no-p + (format "Discard changes in %s? " + (let ((str (vc-delistify files))) + (if (< (length str) 50) + str + (format "%d files" (length files)))))) (error "Revert canceled")) (delete-windows-on "*vc-diff*") (kill-buffer "*vc-diff*")) @@ -2077,8 +2105,8 @@ backend to NEW-BACKEND, and unregister FILE from the current backend. (vc-switch-backend file new-backend) (when (or move edited) (vc-file-setprop file 'vc-state 'edited) - (vc-mode-line file) - (vc-checkin file nil comment (stringp comment))))) + (vc-mode-line file new-backend) + (vc-checkin file new-backend nil comment (stringp comment))))) (defun vc-rename-master (oldmaster newfile templates) "Rename OLDMASTER to be the master file for NEWFILE based on TEMPLATES." @@ -2107,6 +2135,7 @@ backend to NEW-BACKEND, and unregister FILE from the current backend. (throw 'found f))) (error "New file lacks a version control directory"))))) +;;;###autoload (defun vc-delete-file (file) "Delete file and mark it as such in the version control system." (interactive "fVC delete file: ") @@ -2176,8 +2205,7 @@ backend to NEW-BACKEND, and unregister FILE from the current backend. (with-current-buffer oldbuf (let ((buffer-read-only buffer-read-only)) (set-visited-file-name new)) - (vc-backend new) - (vc-mode-line new) + (vc-mode-line new (vc-backend new)) (set-buffer-modified-p nil))))) ;;;###autoload @@ -2215,11 +2243,6 @@ log entries should be gathered." (vc-call-backend (vc-responsible-backend default-directory) 'update-changelog args)) -;;; The default back end. Assumes RCS-like revision numbering. - -(defun vc-default-revision-granularity () - (error "Your backend will not work with this version of VC mode.")) - ;; functions that operate on RCS revision numbers. This code should ;; also be moved into the backends. It stays for now, however, since ;; it is used in code below. @@ -2408,7 +2431,7 @@ to provide the `find-revision' operation instead." (defun vc-default-receive-file (backend file rev) "Let BACKEND receive FILE from another version control system." - (vc-call-backend backend 'register file rev "")) + (vc-call-backend backend 'register (list file) rev "")) (defun vc-default-retrieve-tag (backend dir name update) (if (string= name "")