1 |
;;; vc.el --- drive a version-control system from within Emacs |
;;; vc.el --- drive a version-control system from within Emacs |
2 |
|
|
3 |
;; Copyright (C) 1992,93,94,95,96,97,98,2000,2001 Free Software Foundation, Inc. |
;; Copyright (C) 1992,93,94,95,96,97,98,2000,01,2003 |
4 |
|
;; Free Software Foundation, Inc. |
5 |
|
|
6 |
;; Author: FSF (see below for full credits) |
;; Author: FSF (see below for full credits) |
7 |
;; Maintainer: Andre Spiegel <spiegel@gnu.org> |
;; Maintainer: Andre Spiegel <spiegel@gnu.org> |
523 |
:type '(repeat string) |
:type '(repeat string) |
524 |
:group 'vc) |
:group 'vc) |
525 |
|
|
|
(defconst vc-maximum-comment-ring-size 32 |
|
|
"Maximum number of saved comments in the comment ring.") |
|
|
|
|
526 |
(defcustom vc-diff-switches nil |
(defcustom vc-diff-switches nil |
527 |
"*A string or list of strings specifying switches for diff under VC. |
"*A string or list of strings specifying switches for diff under VC. |
528 |
When running diff under a given BACKEND, VC concatenates the values of |
When running diff under a given BACKEND, VC concatenates the values of |
668 |
"21.1") |
"21.1") |
669 |
|
|
670 |
|
|
|
;; The main keymap |
|
|
|
|
|
;; Initialization code, to be done just once at load-time |
|
|
(defvar vc-log-mode-map |
|
|
(let ((map (make-sparse-keymap))) |
|
|
(set-keymap-parent map text-mode-map) |
|
|
(define-key map "\M-n" 'vc-next-comment) |
|
|
(define-key map "\M-p" 'vc-previous-comment) |
|
|
(define-key map "\M-r" 'vc-comment-search-reverse) |
|
|
(define-key map "\M-s" 'vc-comment-search-forward) |
|
|
(define-key map "\C-c\C-c" 'vc-finish-logentry) |
|
|
map)) |
|
|
;; Compatibility with old name. Should we bother ? |
|
|
(defvar vc-log-entry-mode vc-log-mode-map) |
|
|
|
|
|
|
|
671 |
;; Variables the user doesn't need to know about. |
;; Variables the user doesn't need to know about. |
672 |
(defvar vc-log-operation nil) |
(defvar vc-log-operation nil) |
673 |
(defvar vc-log-after-operation-hook nil) |
(defvar vc-log-after-operation-hook nil) |
688 |
(defvar vc-dired-mode nil) |
(defvar vc-dired-mode nil) |
689 |
(make-variable-buffer-local 'vc-dired-mode) |
(make-variable-buffer-local 'vc-dired-mode) |
690 |
|
|
|
(defvar vc-comment-ring (make-ring vc-maximum-comment-ring-size)) |
|
|
(defvar vc-comment-ring-index nil) |
|
|
(defvar vc-last-comment-match "") |
|
|
|
|
691 |
;; functions that operate on RCS revision numbers. This code should |
;; functions that operate on RCS revision numbers. This code should |
692 |
;; also be moved into the backends. It stays for now, however, since |
;; also be moved into the backends. It stays for now, however, since |
693 |
;; it is used in code below. |
;; it is used in code below. |
732 |
;; File property caching |
;; File property caching |
733 |
|
|
734 |
(defun vc-clear-context () |
(defun vc-clear-context () |
735 |
"Clear all cached file properties and the comment ring." |
"Clear all cached file properties." |
736 |
(interactive) |
(interactive) |
737 |
(fillarray vc-file-prop-obarray 0) |
(fillarray vc-file-prop-obarray 0)) |
|
;; Note: there is potential for minor lossage here if there is an open |
|
|
;; log buffer with a nonzero local value of vc-comment-ring-index. |
|
|
(setq vc-comment-ring (make-ring vc-maximum-comment-ring-size))) |
|
738 |
|
|
739 |
(defmacro with-vc-properties (file form settings) |
(defmacro with-vc-properties (file form settings) |
740 |
"Execute FORM, then maybe set per-file properties for FILE. |
"Execute FORM, then maybe set per-file properties for FILE. |
1561 |
(message "Checking in %s...done" file)) |
(message "Checking in %s...done" file)) |
1562 |
'vc-checkin-hook)) |
'vc-checkin-hook)) |
1563 |
|
|
|
(defun vc-comment-to-change-log (&optional whoami file-name) |
|
|
"Enter last VC comment into the change log for the current file. |
|
|
WHOAMI (interactive prefix) non-nil means prompt for user name |
|
|
and site. FILE-NAME is the name of the change log; if nil, use |
|
|
`change-log-default-name'. |
|
|
|
|
|
This may be useful as a `vc-checkin-hook' to update change logs |
|
|
automatically." |
|
|
(interactive (if current-prefix-arg |
|
|
(list current-prefix-arg |
|
|
(prompt-for-change-log-name)))) |
|
|
;; Make sure the defvar for add-log-current-defun-function has been executed |
|
|
;; before binding it. |
|
|
(require 'add-log) |
|
|
(let (;; Extract the comment first so we get any error before doing anything. |
|
|
(comment (ring-ref vc-comment-ring 0)) |
|
|
;; Don't let add-change-log-entry insert a defun name. |
|
|
(add-log-current-defun-function 'ignore) |
|
|
end) |
|
|
;; Call add-log to do half the work. |
|
|
(add-change-log-entry whoami file-name t t) |
|
|
;; Insert the VC comment, leaving point before it. |
|
|
(setq end (save-excursion (insert comment) (point-marker))) |
|
|
(if (looking-at "\\s *\\s(") |
|
|
;; It starts with an open-paren, as in "(foo): Frobbed." |
|
|
;; So remove the ": " add-log inserted. |
|
|
(delete-char -2)) |
|
|
;; Canonicalize the white space between the file name and comment. |
|
|
(just-one-space) |
|
|
;; Indent rest of the text the same way add-log indented the first line. |
|
|
(let ((indentation (current-indentation))) |
|
|
(save-excursion |
|
|
(while (< (point) end) |
|
|
(forward-line 1) |
|
|
(indent-to indentation)) |
|
|
(setq end (point)))) |
|
|
;; Fill the inserted text, preserving open-parens at bol. |
|
|
(let ((paragraph-separate (concat paragraph-separate "\\|\\s *\\s(")) |
|
|
(paragraph-start (concat paragraph-start "\\|\\s *\\s("))) |
|
|
(beginning-of-line) |
|
|
(fill-region (point) end)) |
|
|
;; Canonicalize the white space at the end of the entry so it is |
|
|
;; separated from the next entry by a single blank line. |
|
|
(skip-syntax-forward " " end) |
|
|
(delete-char (- (skip-syntax-backward " "))) |
|
|
(or (eobp) (looking-at "\n\n") |
|
|
(insert "\n")))) |
|
|
|
|
1564 |
(defun vc-finish-logentry (&optional nocomment) |
(defun vc-finish-logentry (&optional nocomment) |
1565 |
"Complete the operation implied by the current log entry. |
"Complete the operation implied by the current log entry. |
1566 |
Use the contents of the current buffer as a check-in or registration |
Use the contents of the current buffer as a check-in or registration |
1567 |
comment. If the optional arg NOCOMMENT is non-nil, then don't check |
comment. If the optional arg NOCOMMENT is non-nil, then don't check |
1568 |
the buffer contents as a comment, and don't add it to |
the buffer contents as a comment." |
|
`vc-comment-ring'." |
|
1569 |
(interactive) |
(interactive) |
1570 |
;; Check and record the comment, if any. |
;; Check and record the comment, if any. |
1571 |
(unless nocomment |
(unless nocomment |
1573 |
(vc-call-backend (or (and vc-log-file (vc-backend vc-log-file)) |
(vc-call-backend (or (and vc-log-file (vc-backend vc-log-file)) |
1574 |
(vc-responsible-backend default-directory)) |
(vc-responsible-backend default-directory)) |
1575 |
'logentry-check) |
'logentry-check) |
1576 |
(run-hooks 'vc-logentry-check-hook) |
(run-hooks 'vc-logentry-check-hook)) |
|
;; Record the comment in the comment ring |
|
|
(let ((comment (buffer-string))) |
|
|
(unless (and (ring-p vc-comment-ring) |
|
|
(not (ring-empty-p vc-comment-ring)) |
|
|
(equal comment (ring-ref vc-comment-ring 0))) |
|
|
(ring-insert vc-comment-ring comment)))) |
|
1577 |
;; Sync parent buffer in case the user modified it while editing the comment. |
;; Sync parent buffer in case the user modified it while editing the comment. |
1578 |
;; But not if it is a vc-dired buffer. |
;; But not if it is a vc-dired buffer. |
1579 |
(with-current-buffer vc-parent-buffer |
(with-current-buffer vc-parent-buffer |
1612 |
|
|
1613 |
;; Code for access to the comment ring |
;; Code for access to the comment ring |
1614 |
|
|
|
(defun vc-new-comment-index (stride len) |
|
|
"Return the comment index STRIDE elements from the current one. |
|
|
LEN is the length of `vc-comment-ring'." |
|
|
(mod (cond |
|
|
(vc-comment-ring-index (+ vc-comment-ring-index stride)) |
|
|
;; Initialize the index on the first use of this command |
|
|
;; so that the first M-p gets index 0, and the first M-n gets |
|
|
;; index -1. |
|
|
((> stride 0) (1- stride)) |
|
|
(t stride)) |
|
|
len)) |
|
|
|
|
|
(defun vc-previous-comment (arg) |
|
|
"Cycle backwards through comment history. |
|
|
With a numeric prefix ARG, go back ARG comments." |
|
|
(interactive "*p") |
|
|
(let ((len (ring-length vc-comment-ring))) |
|
|
(if (<= len 0) |
|
|
(progn (message "Empty comment ring") (ding)) |
|
|
(erase-buffer) |
|
|
(setq vc-comment-ring-index (vc-new-comment-index arg len)) |
|
|
(message "Comment %d" (1+ vc-comment-ring-index)) |
|
|
(insert (ring-ref vc-comment-ring vc-comment-ring-index))))) |
|
|
|
|
|
(defun vc-next-comment (arg) |
|
|
"Cycle forwards through comment history. |
|
|
With a numeric prefix ARG, go forward ARG comments." |
|
|
(interactive "*p") |
|
|
(vc-previous-comment (- arg))) |
|
|
|
|
|
(defun vc-comment-search-reverse (str &optional stride) |
|
|
"Search backwards through comment history for substring match of STR. |
|
|
If the optional argument STRIDE is present, that is a step-width to use |
|
|
when going through the comment ring." |
|
|
;; Why substring rather than regexp ? -sm |
|
|
(interactive |
|
|
(list (read-string "Comment substring: " nil nil vc-last-comment-match))) |
|
|
(unless stride (setq stride 1)) |
|
|
(if (string= str "") |
|
|
(setq str vc-last-comment-match) |
|
|
(setq vc-last-comment-match str)) |
|
|
(let* ((str (regexp-quote str)) |
|
|
(len (ring-length vc-comment-ring)) |
|
|
(n (vc-new-comment-index stride len))) |
|
|
(while (progn (when (or (>= n len) (< n 0)) (error "Not found")) |
|
|
(not (string-match str (ring-ref vc-comment-ring n)))) |
|
|
(setq n (+ n stride))) |
|
|
(setq vc-comment-ring-index n) |
|
|
(vc-previous-comment 0))) |
|
|
|
|
|
(defun vc-comment-search-forward (str) |
|
|
"Search forwards through comment history for a substring match of STR." |
|
|
(interactive |
|
|
(list (read-string "Comment substring: " nil nil vc-last-comment-match))) |
|
|
(vc-comment-search-reverse str -1)) |
|
|
|
|
1615 |
;; Additional entry points for examining version histories |
;; Additional entry points for examining version histories |
1616 |
|
|
1617 |
;;;###autoload |
;;;###autoload |
2315 |
(vc-file-tree-walk |
(vc-file-tree-walk |
2316 |
dir |
dir |
2317 |
(lambda (f) (and |
(lambda (f) (and |
2318 |
(vc-up-to-date-p f) |
(vc-up-to-date-p f) |
2319 |
(vc-error-occurred |
(vc-error-occurred |
2320 |
(vc-call checkout f nil "") |
(vc-call checkout f nil "") |
2321 |
(if update (vc-resynch-buffer f t t))))))) |
(if update (vc-resynch-buffer f t t))))))) |
2322 |
(let ((result (vc-snapshot-precondition dir))) |
(let ((result (vc-snapshot-precondition dir))) |
2323 |
(if (stringp result) |
(if (stringp result) |
2324 |
(error "File %s is locked" result) |
(error "File %s is locked" result) |
2326 |
(vc-file-tree-walk |
(vc-file-tree-walk |
2327 |
dir |
dir |
2328 |
(lambda (f) (vc-error-occurred |
(lambda (f) (vc-error-occurred |
2329 |
(vc-call checkout f nil name) |
(vc-call checkout f nil name) |
2330 |
(if update (vc-resynch-buffer f t t))))))))) |
(if update (vc-resynch-buffer f t t))))))))) |
2331 |
|
|
2332 |
;; Miscellaneous other entry points |
;; Miscellaneous other entry points |
2333 |
|
|