Mercurial > emacs
comparison lisp/vc.el @ 2750:6f340eabf13f
Improve doc strings and prompt strings.
(vc-cancel-version): Ask whether to revert buffer.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Wed, 12 May 1993 21:30:35 +0000 |
parents | adf91f018312 |
children | 1c7595e3089b |
comparison
equal
deleted
inserted
replaced
2749:305044e75269 | 2750:6f340eabf13f |
---|---|
47 ;; vc-directory command to work properly as documented, you need 19. | 47 ;; vc-directory command to work properly as documented, you need 19. |
48 ;; You also need Emacs 19's ring.el. | 48 ;; You also need Emacs 19's ring.el. |
49 ;; | 49 ;; |
50 ;; The vc code maintains some internal state in order to reduce expensive | 50 ;; The vc code maintains some internal state in order to reduce expensive |
51 ;; version-control operations to a minimum. Some names are only computed | 51 ;; version-control operations to a minimum. Some names are only computed |
52 ;; once. If you perform version control operations with RCS/SCCS/CVS while | 52 ;; once. If you perform version control operations with RCS/SCCS/CVS while |
53 ;; vc's back is turned, or move/rename master files while vc is running, | 53 ;; vc's back is turned, or move/rename master files while vc is running, |
54 ;; vc may get seriously confused. Don't do these things! | 54 ;; vc may get seriously confused. Don't do these things! |
55 ;; | 55 ;; |
56 ;; Developer's notes on some concurrency issues are included at the end of | 56 ;; Developer's notes on some concurrency issues are included at the end of |
57 ;; the file. | 57 ;; the file. |
73 | 73 |
74 (defvar vc-default-back-end nil | 74 (defvar vc-default-back-end nil |
75 "*Back-end actually used by this interface; may be SCCS or RCS. | 75 "*Back-end actually used by this interface; may be SCCS or RCS. |
76 The value is only computed when needed to avoid an expensive search.") | 76 The value is only computed when needed to avoid an expensive search.") |
77 (defvar vc-suppress-confirm nil | 77 (defvar vc-suppress-confirm nil |
78 "*If non-nil, reat user as expert; suppress yes-no prompts on some things.") | 78 "*If non-nil, treat user as expert; suppress yes-no prompts on some things.") |
79 (defvar vc-keep-workfiles t | 79 (defvar vc-keep-workfiles t |
80 "*If non-nil, don't delete working files after registering changes.") | 80 "*If non-nil, don't delete working files after registering changes.") |
81 (defvar vc-initial-comment nil | 81 (defvar vc-initial-comment nil |
82 "*Prompt for initial comment when a file is registered.") | 82 "*Prompt for initial comment when a file is registered.") |
83 (defvar vc-command-messages nil | 83 (defvar vc-command-messages nil |
94 (defvar diff-switches "-c" | 94 (defvar diff-switches "-c" |
95 "*A string or list of strings specifying switches to be be passed to diff.") | 95 "*A string or list of strings specifying switches to be be passed to diff.") |
96 | 96 |
97 ;;;###autoload | 97 ;;;###autoload |
98 (defvar vc-checkin-hook nil | 98 (defvar vc-checkin-hook nil |
99 "*List of functions called after a vc-checkin is done. See `run-hooks'.") | 99 "*List of functions called after a checkin is done. See `run-hooks'.") |
100 | 100 |
101 ;; Header-insertion hair | 101 ;; Header-insertion hair |
102 | 102 |
103 (defvar vc-header-alist | 103 (defvar vc-header-alist |
104 '((SCCS "\%W\%") (RCS "\$Id\$")) | 104 '((SCCS "\%W\%") (RCS "\$Id\$")) |
105 "*Header keywords to be inserted when vc-insert-header is executed.") | 105 "*Header keywords to be inserted when `vc-insert-header' is executed.") |
106 (defconst vc-static-header-alist | 106 (defconst vc-static-header-alist |
107 '(("\\.c$" . | 107 '(("\\.c$" . |
108 "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n")) | 108 "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n")) |
109 "*Associate static header string templates with file types. A \%s in the | 109 "*Associate static header string templates with file types. A \%s in the |
110 template is replaced with the first string associated with the file's | 110 template is replaced with the first string associated with the file's |
111 verson-control type in vc-header-alist.") | 111 version-control type in `vc-header-alist'.") |
112 | 112 |
113 (defvar vc-comment-alist | 113 (defvar vc-comment-alist |
114 '((nroff-mode ".\\\"" "")) | 114 '((nroff-mode ".\\\"" "")) |
115 "*Special comment delimiters to be used in generating vc headers only. | 115 "*Special comment delimiters to be used in generating vc headers only. |
116 Add an entry in this list if you need to override the normal comment-start | 116 Add an entry in this list if you need to override the normal comment-start |
119 | 119 |
120 ;; Variables the user doesn't need to know about. | 120 ;; Variables the user doesn't need to know about. |
121 (defvar vc-log-entry-mode nil) | 121 (defvar vc-log-entry-mode nil) |
122 (defvar vc-log-operation nil) | 122 (defvar vc-log-operation nil) |
123 (defvar vc-log-after-operation-hook nil) | 123 (defvar vc-log-after-operation-hook nil) |
124 (defvar vc-checkout-writeable-buffer-hook 'vc-checkout-writeable-buffer) | 124 (defvar vc-checkout-writable-buffer-hook 'vc-checkout-writable-buffer) |
125 (defvar vc-parent-buffer nil) | 125 (defvar vc-parent-buffer nil) |
126 (defvar vc-parent-buffer-name nil) | 126 (defvar vc-parent-buffer-name nil) |
127 | 127 |
128 (defvar vc-log-file) | 128 (defvar vc-log-file) |
129 (defvar vc-log-version) | 129 (defvar vc-log-version) |
152 (setq vc-comment-ring nil)) | 152 (setq vc-comment-ring nil)) |
153 | 153 |
154 ;; Random helper functions | 154 ;; Random helper functions |
155 | 155 |
156 (defun vc-name (file) | 156 (defun vc-name (file) |
157 "Return the master name of a file, nil if it is not registered" | 157 "Return the master name of a file, nil if it is not registered." |
158 (or (vc-file-getprop file 'vc-name) | 158 (or (vc-file-getprop file 'vc-name) |
159 (vc-file-setprop file 'vc-name | 159 (vc-file-setprop file 'vc-name |
160 (let ((name-and-type (vc-registered file))) | 160 (let ((name-and-type (vc-registered file))) |
161 (and name-and-type (car name-and-type)))))) | 161 (and name-and-type (car name-and-type)))))) |
162 | 162 |
363 ;; if there is no master file corresponding, create one | 363 ;; if there is no master file corresponding, create one |
364 ((not vc-file) | 364 ((not vc-file) |
365 (vc-register verbose comment) | 365 (vc-register verbose comment) |
366 (if vc-initial-comment | 366 (if vc-initial-comment |
367 (setq vc-log-after-operation-hook | 367 (setq vc-log-after-operation-hook |
368 'vc-checkout-writeable-buffer-hook) | 368 'vc-checkout-writable-buffer-hook) |
369 (vc-checkout-writeable-buffer file))) | 369 (vc-checkout-writable-buffer file))) |
370 | 370 |
371 ;; if there is no lock on the file, assert one and get it | 371 ;; if there is no lock on the file, assert one and get it |
372 ((not (setq owner (vc-locking-user file))) | 372 ((not (setq owner (vc-locking-user file))) |
373 (vc-checkout-writeable-buffer file)) | 373 (vc-checkout-writable-buffer file)) |
374 | 374 |
375 ;; a checked-out version exists, but the user may not own the lock | 375 ;; a checked-out version exists, but the user may not own the lock |
376 ((not (string-equal owner (user-login-name))) | 376 ((not (string-equal owner (user-login-name))) |
377 (if comment | 377 (if comment |
378 (error "Sorry, you can't steal the lock on %s this way." file)) | 378 (error "Sorry, you can't steal the lock on %s this way." file)) |
425 | 425 |
426 ;;;###autoload | 426 ;;;###autoload |
427 (defun vc-next-action (verbose) | 427 (defun vc-next-action (verbose) |
428 "Do the next logical checkin or checkout operation on the current file. | 428 "Do the next logical checkin or checkout operation on the current file. |
429 If the file is not already registered, this registers it for version | 429 If the file is not already registered, this registers it for version |
430 control and then retrieves a writeable, locked copy for editing. | 430 control and then retrieves a writable, locked copy for editing. |
431 If the file is registered and not locked by anyone, this checks out | 431 If the file is registered and not locked by anyone, this checks out |
432 a writeable and locked file ready for editing. | 432 a writable and locked file ready for editing. |
433 If the file is checked out and locked by the calling user, this | 433 If the file is checked out and locked by the calling user, this |
434 first checks to see if the file has changed since checkout. If not, | 434 first checks to see if the file has changed since checkout. If not, |
435 it performs a revert. | 435 it performs a revert. |
436 If the file has been changed, this pops up a buffer for entry | 436 If the file has been changed, this pops up a buffer for entry |
437 of a log message; when the message has been entered, it checks in the | 437 of a log message; when the message has been entered, it checks in the |
438 resulting changes along with the log message as change commentary. If | 438 resulting changes along with the log message as change commentary. If |
439 the variable vc-keep-workfiles is non-nil (which is its default), a | 439 the variable `vc-keep-workfiles' is non-nil (which is its default), a |
440 read-only copy of the changed file is left in place afterwards. | 440 read-only copy of the changed file is left in place afterwards. |
441 If the file is registered and locked by someone else, you are given | 441 If the file is registered and locked by someone else, you are given |
442 the option to steal the lock. | 442 the option to steal the lock. |
443 If you call this from within a VC dired buffer with no files marked, | 443 If you call this from within a VC dired buffer with no files marked, |
444 it will operate on the file in the current line. | 444 it will operate on the file in the current line. |
463 (vc-next-action-on-file buffer-file-name verbose) | 463 (vc-next-action-on-file buffer-file-name verbose) |
464 (vc-registration-error nil)))) | 464 (vc-registration-error nil)))) |
465 | 465 |
466 ;;; These functions help the vc-next-action entry point | 466 ;;; These functions help the vc-next-action entry point |
467 | 467 |
468 (defun vc-checkout-writeable-buffer (&optional file) | 468 (defun vc-checkout-writable-buffer (&optional file) |
469 "Retrieve a writeable copy of the latest version of the current buffer's file." | 469 "Retrieve a writable copy of the latest version of the current buffer's file." |
470 (vc-checkout (or file (buffer-file-name)) t) | 470 (vc-checkout (or file (buffer-file-name)) t) |
471 ) | 471 ) |
472 | 472 |
473 ;;;###autoload | 473 ;;;###autoload |
474 (defun vc-register (&optional override comment) | 474 (defun vc-register (&optional override comment) |
538 level to check it in under. COMMENT, if specified, is the checkin comment." | 538 level to check it in under. COMMENT, if specified, is the checkin comment." |
539 (vc-start-entry file rev | 539 (vc-start-entry file rev |
540 (or comment (not vc-initial-comment)) | 540 (or comment (not vc-initial-comment)) |
541 "Enter initial comment." 'vc-backend-admin)) | 541 "Enter initial comment." 'vc-backend-admin)) |
542 | 542 |
543 (defun vc-checkout (file &optional writeable) | 543 (defun vc-checkout (file &optional writable) |
544 "Retrieve a copy of the latest version of the given file." | 544 "Retrieve a copy of the latest version of the given file." |
545 ;; If ftp is on this system and the name matches the ange-ftp format | 545 ;; If ftp is on this system and the name matches the ange-ftp format |
546 ;; for a remote file, the user is trying something that won't work. | 546 ;; for a remote file, the user is trying something that won't work. |
547 (if (and (string-match "^/[^/:]+:" file) (vc-find-binary "ftp")) | 547 (if (and (string-match "^/[^/:]+:" file) (vc-find-binary "ftp")) |
548 (error "Sorry, you can't check out files over FTP")) | 548 (error "Sorry, you can't check out files over FTP")) |
549 (vc-backend-checkout file writeable) | 549 (vc-backend-checkout file writable) |
550 (if (string-equal file buffer-file-name) | 550 (if (string-equal file buffer-file-name) |
551 (vc-resynch-window file t t)) | 551 (vc-resynch-window file t t)) |
552 ) | 552 ) |
553 | 553 |
554 (defun vc-steal-lock (file rev &optional owner) | 554 (defun vc-steal-lock (file rev &optional owner) |
579 | 579 |
580 (defun vc-checkin (file &optional rev comment) | 580 (defun vc-checkin (file &optional rev comment) |
581 "Check in the file specified by FILE. | 581 "Check in the file specified by FILE. |
582 The optional argument REV may be a string specifying the new version level | 582 The optional argument REV may be a string specifying the new version level |
583 \(if nil increment the current level). The file is either retained with write | 583 \(if nil increment the current level). The file is either retained with write |
584 permissions zeroed, or deleted (according to the value of vc-keep-workfiles). | 584 permissions zeroed, or deleted (according to the value of `vc-keep-workfiles'). |
585 COMMENT is a comment string; if omitted, a buffer is | 585 COMMENT is a comment string; if omitted, a buffer is |
586 popped up to accept a comment." | 586 popped up to accept a comment." |
587 (setq vc-log-after-operation-hook 'vc-checkin-hook) | 587 (setq vc-log-after-operation-hook 'vc-checkin-hook) |
588 (vc-start-entry file rev comment "Enter a change comment." 'vc-backend-checkin)) | 588 (vc-start-entry file rev comment "Enter a change comment." 'vc-backend-checkin)) |
589 | 589 |
791 | 791 |
792 ;;;###autoload | 792 ;;;###autoload |
793 (defun vc-insert-headers () | 793 (defun vc-insert-headers () |
794 "Insert headers in a file for use with your version-control system. | 794 "Insert headers in a file for use with your version-control system. |
795 Headers desired are inserted at the start of the buffer, and are pulled from | 795 Headers desired are inserted at the start of the buffer, and are pulled from |
796 the variable vc-header-alist" | 796 the variable `vc-header-alist'." |
797 (interactive) | 797 (interactive) |
798 (if vc-dired-mode | 798 (if vc-dired-mode |
799 (find-file-other-window (dired-get-filename))) | 799 (find-file-other-window (dired-get-filename))) |
800 (while vc-parent-buffer | 800 (while vc-parent-buffer |
801 (pop-to-buffer vc-parent-buffer)) | 801 (pop-to-buffer vc-parent-buffer)) |
842 (setq vc-dired-mode t) | 842 (setq vc-dired-mode t) |
843 (setq vc-mode " under VC")) | 843 (setq vc-mode " under VC")) |
844 | 844 |
845 (defun vc-dired-reformat-line (x) | 845 (defun vc-dired-reformat-line (x) |
846 ;; Hack a directory-listing line, plugging in locking-user info in | 846 ;; Hack a directory-listing line, plugging in locking-user info in |
847 ;; place of the user and group info. Should have the beneficial | 847 ;; place of the user and group info. Should have the beneficial |
848 ;; side-effect of shortening the listing line. Each call starts with | 848 ;; side-effect of shortening the listing line. Each call starts with |
849 ;; point immediately following the dired mark area on the line to be | 849 ;; point immediately following the dired mark area on the line to be |
850 ;; hacked. | 850 ;; hacked. |
851 ;; | 851 ;; |
852 ;; Simplest possible one: | 852 ;; Simplest possible one: |
853 ;; (insert (concat x "\t"))) | 853 ;; (insert (concat x "\t"))) |
877 (let ((user (vc-locking-user f))) | 877 (let ((user (vc-locking-user f))) |
878 (and (or verbose user) | 878 (and (or verbose user) |
879 (setq filelist (cons (substring f dl) filelist)) | 879 (setq filelist (cons (substring f dl) filelist)) |
880 (setq userlist (cons user userlist)))))))) | 880 (setq userlist (cons user userlist)))))))) |
881 (save-excursion | 881 (save-excursion |
882 ;; This uses a semi-documented featre of dired; giving a switch | 882 ;; This uses a semi-documented feature of dired; giving a switch |
883 ;; argument forces the buffer to refresh each time. | 883 ;; argument forces the buffer to refresh each time. |
884 (dired | 884 (dired |
885 (cons default-directory (nreverse filelist)) | 885 (cons default-directory (nreverse filelist)) |
886 dired-listing-switches) | 886 dired-listing-switches) |
887 (setq dired-buf (current-buffer)) | 887 (setq dired-buf (current-buffer)) |
1061 ) | 1061 ) |
1062 ) | 1062 ) |
1063 | 1063 |
1064 ;;;###autoload | 1064 ;;;###autoload |
1065 (defun vc-cancel-version (norevert) | 1065 (defun vc-cancel-version (norevert) |
1066 "Get rid of the version most recently checked in by anyone." | 1066 "Get rid of most recently checked in version of this file. |
1067 A prefix argument means do not revert the buffer afterwards." | |
1067 (interactive "P") | 1068 (interactive "P") |
1068 (if vc-dired-mode | 1069 (if vc-dired-mode |
1069 (find-file-other-window (dired-get-filename))) | 1070 (find-file-other-window (dired-get-filename))) |
1070 (while vc-parent-buffer | 1071 (while vc-parent-buffer |
1071 (pop-to-buffer vc-parent-buffer)) | 1072 (pop-to-buffer vc-parent-buffer)) |
1075 "Remove your version %s from master?" | 1076 "Remove your version %s from master?" |
1076 "Version %s was not your change. Remove it anyway?"))) | 1077 "Version %s was not your change. Remove it anyway?"))) |
1077 (if (null (yes-or-no-p (format prompt target))) | 1078 (if (null (yes-or-no-p (format prompt target))) |
1078 nil | 1079 nil |
1079 (vc-backend-uncheck (buffer-file-name) target) | 1080 (vc-backend-uncheck (buffer-file-name) target) |
1080 (if norevert | 1081 (if (or norevert |
1082 (not (yes-or-no-p "Revert buffer to most recent remaining version? "))) | |
1081 (vc-mode-line (buffer-file-name)) | 1083 (vc-mode-line (buffer-file-name)) |
1082 (vc-checkout (buffer-file-name) nil))) | 1084 (vc-checkout (buffer-file-name) nil))) |
1083 )) | 1085 )) |
1084 | 1086 |
1085 (defun vc-rename-file (old new) | 1087 (defun vc-rename-file (old new) |
1086 "Rename a file, taking its master files with it." | 1088 "Rename file OLD to NEW, and rename its master file likewise." |
1087 (interactive "fOld name: \nFNew name: ") | 1089 (interactive "fVC rename file: \nFRename to: ") |
1088 (let ((oldbuf (get-file-buffer old))) | 1090 (let ((oldbuf (get-file-buffer old))) |
1089 (if (buffer-modified-p oldbuf) | 1091 (if (buffer-modified-p oldbuf) |
1090 (error "Please save files before moving them.")) | 1092 (error "Please save files before moving them.")) |
1091 (if (get-file-buffer new) | 1093 (if (get-file-buffer new) |
1092 (error "Already editing new file name.")) | 1094 (error "Already editing new file name.")) |
1377 file) | 1379 file) |
1378 ))) | 1380 ))) |
1379 (message "Registering %s...done" file) | 1381 (message "Registering %s...done" file) |
1380 ) | 1382 ) |
1381 | 1383 |
1382 (defun vc-backend-checkout (file &optional writeable rev) | 1384 (defun vc-backend-checkout (file &optional writable rev) |
1383 ;; Retrieve a copy of a saved version into a workfile | 1385 ;; Retrieve a copy of a saved version into a workfile |
1384 (message "Checking out %s..." file) | 1386 (message "Checking out %s..." file) |
1385 (vc-backend-dispatch file | 1387 (vc-backend-dispatch file |
1386 (progn | 1388 (progn |
1387 (vc-do-command 0 "get" file ;; SCCS | 1389 (vc-do-command 0 "get" file ;; SCCS |
1388 (if writeable "-e") | 1390 (if writable "-e") |
1389 (and rev (concat "-r" (vc-lookup-triple file rev)))) | 1391 (and rev (concat "-r" (vc-lookup-triple file rev)))) |
1390 ) | 1392 ) |
1391 (vc-do-command 0 "co" file ;; RCS | 1393 (vc-do-command 0 "co" file ;; RCS |
1392 (if writeable "-l") | 1394 (if writable "-l") |
1393 (and rev (concat "-r" rev))) | 1395 (and rev (concat "-r" rev))) |
1394 ) | 1396 ) |
1395 (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file))) | 1397 (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file))) |
1396 (message "Checking out %s...done" file) | 1398 (message "Checking out %s...done" file) |
1397 ) | 1399 ) |
1603 ) | 1605 ) |
1604 | 1606 |
1605 ;;; These things should probably be generally available | 1607 ;;; These things should probably be generally available |
1606 | 1608 |
1607 (defun vc-shrink-to-fit () | 1609 (defun vc-shrink-to-fit () |
1608 "Shrink a window vertically until it's just large enough to contain its text" | 1610 "Shrink window vertically until it's just large enough to contain its text." |
1609 (let ((minsize (1+ (count-lines (point-min) (point-max))))) | 1611 (let ((minsize (1+ (count-lines (point-min) (point-max))))) |
1610 (if (< minsize (window-height)) | 1612 (if (< minsize (window-height)) |
1611 (let ((window-min-height 2)) | 1613 (let ((window-min-height 2)) |
1612 (shrink-window (- (window-height) minsize)))))) | 1614 (shrink-window (- (window-height) minsize)))))) |
1613 | 1615 |
1614 (defun vc-file-tree-walk (func &rest args) | 1616 (defun vc-file-tree-walk (func &rest args) |
1615 "Walk recursively through default directory, | 1617 "Walk recursively through default directory. |
1616 invoking FUNC f ARGS on all non-directory files f underneath it." | 1618 Invoke FUNC f ARGS on each non-directory file f underneath it." |
1617 (vc-file-tree-walk-internal default-directory func args) | 1619 (vc-file-tree-walk-internal default-directory func args) |
1618 (message "Traversing directory %s...done" default-directory)) | 1620 (message "Traversing directory %s...done" default-directory)) |
1619 | 1621 |
1620 (defun vc-file-tree-walk-internal (file func args) | 1622 (defun vc-file-tree-walk-internal (file func args) |
1621 (if (not (file-directory-p file)) | 1623 (if (not (file-directory-p file)) |
1740 ;;; D). This window may never be closed if the user fails to complete the | 1742 ;;; D). This window may never be closed if the user fails to complete the |
1741 ;;; checkin message. Includes window R. | 1743 ;;; checkin message. Includes window R. |
1742 ;;; | 1744 ;;; |
1743 ;;; Window W: | 1745 ;;; Window W: |
1744 ;;; Between vc-locking-user and the following steal-lock (apparent | 1746 ;;; Between vc-locking-user and the following steal-lock (apparent |
1745 ;;; state E). This window may never cloce if the user fails to complete | 1747 ;;; state E). This window may never close if the user fails to complete |
1746 ;;; the steal-lock message. Includes window X. | 1748 ;;; the steal-lock message. Includes window X. |
1747 ;;; | 1749 ;;; |
1748 ;;; Window X: | 1750 ;;; Window X: |
1749 ;;; Between the unlock and the immediately following re-lock during a | 1751 ;;; Between the unlock and the immediately following re-lock during a |
1750 ;;; steal-lock operation (apparent state E). This window may never cloce | 1752 ;;; steal-lock operation (apparent state E). This window may never cloce |