1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-23 07:19:15 +00:00

(vc-header-strings) Name changed to vc-header-alist, to match the

docs.

(vc-finish-logentry, vc-next-comment, vc-previous-comment,
vc-comment-search-forward, vc-comment-search-backward) The VC comment
ring is now a separate buffer from *VC-log*; editing of old comments
is no longer destructive.
This commit is contained in:
Eric S. Raymond 1993-03-17 13:58:48 +00:00
parent a34902abb8
commit 7b4f934d8f

View File

@ -3,9 +3,9 @@
;; Copyright (C) 1992 Free Software Foundation, Inc. ;; Copyright (C) 1992 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com> ;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Version: 5.0 ;; Version: 5.2
;; $Id: vc.el,v 1.26.1.1 1993/03/16 20:54:53 eggert Exp $ ;; $Id: vc.el,v 1.27 1993/03/16 21:09:56 eggert Exp eric $
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
@ -90,7 +90,8 @@ The value is only computed when needed to avoid an expensive search.")
"\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n")) "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n"))
"*Associate static header string templates with file types. A \%s in the "*Associate static header string templates with file types. A \%s in the
template is replaced with the first string associated with the file's template is replaced with the first string associated with the file's
verson-control type in vc-header-strings.") verson-control type in vc-header-alist.")
(defvar vc-comment-alist (defvar vc-comment-alist
'((nroff-mode ".\\\"" "")) '((nroff-mode ".\\\"" ""))
"*Special comment delimiters to be used in generating vc headers only. "*Special comment delimiters to be used in generating vc headers only.
@ -220,7 +221,7 @@ the master name of FILE; this is appended to an optional list of FLAGS."
(- (point) (length context-string)))))))) (- (point) (length context-string))))))))
(defun vc-revert-buffer1 (&optional arg no-confirm) (defun vc-revert-buffer1 (&optional arg no-confirm)
;; This code was shamelessly lifted from Sebastian Kremer's rcs.el mode. ;; Most of this was shamelessly lifted from Sebastian Kremer's rcs.el mode.
;; Revert buffer, try to keep point and mark where user expects them in spite ;; Revert buffer, try to keep point and mark where user expects them in spite
;; of changes because of expanded version-control key words. ;; of changes because of expanded version-control key words.
;; This is quite important since otherwise typeahead won't work as expected. ;; This is quite important since otherwise typeahead won't work as expected.
@ -232,7 +233,11 @@ the master name of FILE; this is appended to an optional list of FLAGS."
(vc-position-context (mark-marker)))) (vc-position-context (mark-marker))))
;; Make the right thing happen in transient-mark-mode. ;; Make the right thing happen in transient-mark-mode.
(mark-active nil)) (mark-active nil))
;; the actual revisit
(revert-buffer arg no-confirm) (revert-buffer arg no-confirm)
;; Restore point and mark
(let ((new-point (vc-find-position-by-context point-context))) (let ((new-point (vc-find-position-by-context point-context)))
(if new-point (goto-char new-point))) (if new-point (goto-char new-point)))
(if mark-context (if mark-context
@ -344,7 +349,7 @@ the option to steal the lock."
(defun vc-checkout-writeable-buffer () (defun vc-checkout-writeable-buffer ()
"Retrieve a writeable copy of the latest version of the current buffer's file." "Retrieve a writeable copy of the latest version of the current buffer's file."
(vc-checkout buffer-file-name t) (vc-checkout (buffer-file-name) t)
) )
;;;###autoload ;;;###autoload
@ -461,28 +466,32 @@ popped up to accept a comment."
(interactive) (interactive)
(goto-char (point-max)) (goto-char (point-max))
(if (not (bolp)) (newline)) (if (not (bolp)) (newline))
;; delimit current page ;; Append the contents of the log buffer to the comment ring
(save-excursion (save-excursion
(widen) (set-buffer (get-buffer-create "*VC-comment-ring*"))
(goto-char (point-max)) (goto-char (point-max))
(set-mark (point))
(insert-buffer-substring "*VC-log*")
(if (and (not (bobp)) (not (= (char-after (1- (point))) ?\f))) (if (and (not (bobp)) (not (= (char-after (1- (point))) ?\f)))
(insert-char ?\f 1))) (insert-char ?\f 1))
(if (not (bobp)) (if (not (bobp))
(forward-char -1)) (forward-char -1))
(mark-page) (exchange-point-and-mark)
;; Check for errors ;; Check for errors
(vc-backend-logentry-check vc-log-file) (vc-backend-logentry-check vc-log-file)
)
;; OK, do it to it ;; OK, do it to it
(if vc-log-operation (if vc-log-operation
(funcall vc-log-operation (funcall vc-log-operation
vc-log-file vc-log-file
vc-log-version vc-log-version
(buffer-substring (region-beginning) (1- (region-end)))) (buffer-string))
(error "No log operation is pending.")) (error "No log operation is pending."))
;; Return to "parent" buffer of this checkin and remove checkin window ;; Return to "parent" buffer of this checkin and remove checkin window
(pop-to-buffer (get-file-buffer vc-log-file)) (pop-to-buffer (get-file-buffer vc-log-file))
(delete-window (get-buffer-window "*VC-log*")) (delete-window (get-buffer-window "*VC-log*"))
(bury-buffer "*VC-log*") (bury-buffer "*VC-log*")
(bury-buffer "*VC-comment-ring*")
;; Now make sure we see the expanded headers ;; Now make sure we see the expanded headers
(vc-resynch-window buffer-file-name vc-keep-workfiles t) (vc-resynch-window buffer-file-name vc-keep-workfiles t)
(run-hooks vc-log-after-operation-hook) (run-hooks vc-log-after-operation-hook)
@ -493,42 +502,54 @@ popped up to accept a comment."
(defun vc-next-comment () (defun vc-next-comment ()
"Fill the log buffer with the next message in the msg ring." "Fill the log buffer with the next message in the msg ring."
(interactive) (interactive)
(widen) (erase-buffer)
(forward-page) (save-excursion
(if (= (point) (point-max)) (set-buffer "*VC-comment-ring*")
(goto-char (point-min))) (forward-page)
(mark-page) (if (= (point) (point-max))
(narrow-to-page)) (goto-char (point-min)))
(mark-page)
(append-to-buffer "*VC-log*" (point) (1- (mark)))
))
(defun vc-previous-comment () (defun vc-previous-comment ()
"Fill the log buffer with the previous message in the msg ring." "Fill the log buffer with the previous message in the msg ring."
(interactive) (interactive)
(widen) (erase-buffer)
(if (= (point) (point-min)) (save-excursion
(goto-char (point-max))) (set-buffer "*VC-comment-ring*")
(backward-page) (if (= (point) (point-min))
(mark-page) (goto-char (point-max)))
(narrow-to-page)) (backward-page)
(mark-page)
(append-to-buffer "*VC-log*" (point) (1- (mark)))
))
(defun vc-comment-search-backward (regexp) (defun vc-comment-search-backward (regexp)
"Fill the log buffer with the last message in the msg ring matching REGEXP." "Fill the log buffer with the last message in the msg ring matching REGEXP."
(interactive "sSearch backward for: ") (interactive "sSearch backward for: ")
(widen) (erase-buffer)
(if (= (point) (point-min)) (save-excursion
(goto-char (point-max))) (set-buffer "*VC-comment-ring*")
(re-search-backward regexp nil t) (if (= (point) (point-min))
(mark-page) (goto-char (point-max)))
(narrow-to-page)) (re-search-backward regexp nil t)
(mark-page)
(append-to-buffer "*VC-log*" (point) (1- (mark)))
))
(defun vc-comment-search-forward (regexp) (defun vc-comment-search-forward (regexp)
"Fill the log buffer with the next message in the msg ring matching REGEXP." "Fill the log buffer with the next message in the msg ring matching REGEXP."
(interactive "sSearch forward for: ") (interactive "sSearch forward for: ")
(widen) (erase-buffer)
(if (= (point) (point-min)) (save-excursion
(goto-char (point-max))) (set-buffer "*VC-comment-ring*")
(re-search-forward regexp nil t) (if (= (point) (point-max))
(mark-page) (goto-char (point-min)))
(narrow-to-page)) (re-search-forward regexp nil t)
(mark-page)
(append-to-buffer "*VC-log*" (point) (1- (mark)))
))
;; Additional entry points for examining version histories ;; Additional entry points for examining version histories
@ -602,7 +623,7 @@ files in or below it."
(defun vc-insert-headers () (defun vc-insert-headers ()
"Insert headers in a file for use with your version-control system. "Insert headers in a file for use with your version-control system.
Headers desired are inserted at the start of the buffer, and are pulled from Headers desired are inserted at the start of the buffer, and are pulled from
the variable vc-header-strings" the variable vc-header-alist"
(interactive) (interactive)
(save-excursion (save-excursion
(save-restriction (save-restriction
@ -675,14 +696,17 @@ the variable vc-header-strings"
)) ))
(defun vc-lookup-triple (file name) (defun vc-lookup-triple (file name)
(or ;; Return the numeric version corresponding to a named snapshot of file
name ;; If name is nil or a version number string it's just passed through
(let ((firstchar (aref name 0))) (cond ((null name) "")
(and (>= firstchar ?0) (<= firstchar ?9) name)) ((let ((firstchar (aref name 0)))
(car (vc-master-info (and (>= firstchar ?0) (<= firstchar ?9)))
(concat (vc-backend-subdirectory-name file) "/" vc-name-assoc-file) name)
(list (concat name "\t:\t" file "\t\\(.+\\)")))) (t
)) (car (vc-master-info
(concat (vc-backend-subdirectory-name file) "/" vc-name-assoc-file)
(list (concat name "\t:\t" file "\t\\(.+\\)"))))
)))
;; Named-configuration entry points ;; Named-configuration entry points
@ -766,14 +790,18 @@ to that version."
(defun vc-cancel-version (norevert) (defun vc-cancel-version (norevert)
"Undo your latest checkin." "Undo your latest checkin."
(interactive "P") (interactive "P")
(let ((target (vc-your-latest-version (buffer-file-name)))) (let ((target (concat (vc-latest-version (buffer-file-name))))
(if (null target) (yours (concat (vc-your-latest-version)))
(error "You didn't check in the last change.")) (prompt (if (string-equal yours target)
(and (yes-or-no-p (format "Remove version %s from master? " target)) "Remove your version %s from master?"
(vc-backend-uncheck (buffer-file-name) target))) "Version %s was not your change. Remove it anyway?")))
(if norevert (if (null (yes-or-no-p (format prompt target)))
(vc-mode-line (buffer-file-name)) nil
(vc-checkout (buffer-file-name) nil)) (vc-backend-uncheck (buffer-file-name) target)
(if norevert
(vc-mode-line (buffer-file-name))
(vc-checkout (buffer-file-name) nil)))
)
) )
(defun vc-rename-file (old new) (defun vc-rename-file (old new)
@ -963,7 +991,8 @@ Return nil if there is no such person."
;; ;;
;; Everything eventually funnels through these functions. To implement ;; Everything eventually funnels through these functions. To implement
;; support for a new version-control system, add another branch to the ;; support for a new version-control system, add another branch to the
;; vc-backend-dispatch macro (in vc-hooks.el) and fill it in in each call. ;; vc-backend-dispatch macro and fill it in in each call. The variable
;; vc-master-templates in vc-hooks.el will also have to change.
(defmacro vc-backend-dispatch (f s r) (defmacro vc-backend-dispatch (f s r)
"Execute FORM1 or FORM2 depending on whether we're using SCCS or RCS." "Execute FORM1 or FORM2 depending on whether we're using SCCS or RCS."
@ -1091,7 +1120,6 @@ Return nil if there is no such person."
(vc-backend-dispatch file (vc-backend-dispatch file
(if (>= (- (region-end) (region-beginning)) 512) ;; SCCS (if (>= (- (region-end) (region-beginning)) 512) ;; SCCS
(progn (progn
(message "Reverting %s..." file)
(goto-char 512) (goto-char 512)
(error (error
"Log must be less than 512 characters. Point is now at char 512."))) "Log must be less than 512 characters. Point is now at char 512.")))
@ -1101,7 +1129,6 @@ Return nil if there is no such person."
(defun vc-backend-checkin (file &optional rev comment) (defun vc-backend-checkin (file &optional rev comment)
;; Register changes to FILE as level REV with explanatory COMMENT. ;; Register changes to FILE as level REV with explanatory COMMENT.
;; Automatically retrieves a read-only version of the file with ;; Automatically retrieves a read-only version of the file with
(message "Reverting %s...done" file)
;; keywords expanded if vc-keep-workfiles is non-nil, otherwise ;; keywords expanded if vc-keep-workfiles is non-nil, otherwise
;; it deletes the workfile. ;; it deletes the workfile.
(message "Checking in %s..." file) (message "Checking in %s..." file)
@ -1185,6 +1212,9 @@ Return nil if there is no such person."
(defun vc-backend-diff (file oldvers &optional newvers) (defun vc-backend-diff (file oldvers &optional newvers)
;; Get a difference report between two versions ;; Get a difference report between two versions
(if (eq (vc-backend-deduce file) 'SCCS)
(setq oldvers (vc-lookup-triple file oldvers))
(setq newvers (vc-lookup-triple file newvers)))
(apply 'vc-do-command 1 (apply 'vc-do-command 1
(or (vc-backend-dispatch file "vcdiff" "rcsdiff") (or (vc-backend-dispatch file "vcdiff" "rcsdiff")
(error "File %s is not under version control." file)) (error "File %s is not under version control." file))
@ -1252,7 +1282,7 @@ Global user options:
vc-diff-options A list consisting of the flags vc-diff-options A list consisting of the flags
to be used for generating context diffs. to be used for generating context diffs.
vc-header-strings Which keywords to insert when adding headers vc-header-alist Which keywords to insert when adding headers
with \\[vc-insert-headers]. Defaults to with \\[vc-insert-headers]. Defaults to
'(\"\%\W\%\") under SCCS, '(\"\$Id\$\") under RCS. '(\"\%\W\%\") under SCCS, '(\"\$Id\$\") under RCS.