Mercurial > emacs
comparison lisp/vc.el @ 51064:f2383fb5260e
(vc-log-mode-map, vc-maximum-comment-ring-size)
(vc-comment-ring, vc-comment-ring-index, vc-last-comment-match):
Move vars to log-edit.el.
(vc-new-comment-index, vc-previous-comment, vc-next-comment)
(vc-comment-search-reverse, vc-comment-search-forward)
(vc-comment-to-change-log): Move funs to log-edit.el.
(vc-clear-context): Don't empty the comment-ring.
(vc-finish-logentry): Don't add the comment onto the comment-ring.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Sun, 18 May 2003 02:53:24 +0000 |
parents | dd6110a63907 |
children | f6920b201e1c |
comparison
equal
deleted
inserted
replaced
51063:66dd7f2dd70a | 51064:f2383fb5260e |
---|---|
1 ;;; vc.el --- drive a version-control system from within Emacs | 1 ;;; vc.el --- drive a version-control system from within Emacs |
2 | 2 |
3 ;; Copyright (C) 1992,93,94,95,96,97,98,2000,2001 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1992,93,94,95,96,97,98,2000,01,2003 |
4 ;; Free Software Foundation, Inc. | |
4 | 5 |
5 ;; Author: FSF (see below for full credits) | 6 ;; Author: FSF (see below for full credits) |
6 ;; Maintainer: Andre Spiegel <spiegel@gnu.org> | 7 ;; Maintainer: Andre Spiegel <spiegel@gnu.org> |
7 ;; Keywords: tools | 8 ;; Keywords: tools |
8 | 9 |
9 ;; $Id: vc.el,v 1.351 2003/05/08 17:41:16 monnier Exp $ | 10 ;; $Id: vc.el,v 1.352 2003/05/09 16:33:10 monnier Exp $ |
10 | 11 |
11 ;; This file is part of GNU Emacs. | 12 ;; This file is part of GNU Emacs. |
12 | 13 |
13 ;; GNU Emacs is free software; you can redistribute it and/or modify | 14 ;; GNU Emacs is free software; you can redistribute it and/or modify |
14 ;; it under the terms of the GNU General Public License as published by | 15 ;; it under the terms of the GNU General Public License as published by |
519 | 520 |
520 (defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS") | 521 (defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS") |
521 "*List of directory names to be ignored when walking directory trees." | 522 "*List of directory names to be ignored when walking directory trees." |
522 :type '(repeat string) | 523 :type '(repeat string) |
523 :group 'vc) | 524 :group 'vc) |
524 | |
525 (defconst vc-maximum-comment-ring-size 32 | |
526 "Maximum number of saved comments in the comment ring.") | |
527 | 525 |
528 (defcustom vc-diff-switches nil | 526 (defcustom vc-diff-switches nil |
529 "*A string or list of strings specifying switches for diff under VC. | 527 "*A string or list of strings specifying switches for diff under VC. |
530 When running diff under a given BACKEND, VC concatenates the values of | 528 When running diff under a given BACKEND, VC concatenates the values of |
531 `diff-switches', `vc-diff-switches', and `vc-BACKEND-diff-switches' to | 529 `diff-switches', `vc-diff-switches', and `vc-BACKEND-diff-switches' to |
668 (make-obsolete-variable 'vc-checkout-carefully | 666 (make-obsolete-variable 'vc-checkout-carefully |
669 "the corresponding checks are always done now." | 667 "the corresponding checks are always done now." |
670 "21.1") | 668 "21.1") |
671 | 669 |
672 | 670 |
673 ;; The main keymap | |
674 | |
675 ;; Initialization code, to be done just once at load-time | |
676 (defvar vc-log-mode-map | |
677 (let ((map (make-sparse-keymap))) | |
678 (set-keymap-parent map text-mode-map) | |
679 (define-key map "\M-n" 'vc-next-comment) | |
680 (define-key map "\M-p" 'vc-previous-comment) | |
681 (define-key map "\M-r" 'vc-comment-search-reverse) | |
682 (define-key map "\M-s" 'vc-comment-search-forward) | |
683 (define-key map "\C-c\C-c" 'vc-finish-logentry) | |
684 map)) | |
685 ;; Compatibility with old name. Should we bother ? | |
686 (defvar vc-log-entry-mode vc-log-mode-map) | |
687 | |
688 | |
689 ;; Variables the user doesn't need to know about. | 671 ;; Variables the user doesn't need to know about. |
690 (defvar vc-log-operation nil) | 672 (defvar vc-log-operation nil) |
691 (defvar vc-log-after-operation-hook nil) | 673 (defvar vc-log-after-operation-hook nil) |
692 (defvar vc-annotate-buffers nil | 674 (defvar vc-annotate-buffers nil |
693 "Alist of current \"Annotate\" buffers and their corresponding backends. | 675 "Alist of current \"Annotate\" buffers and their corresponding backends. |
703 (defvar vc-log-file) | 685 (defvar vc-log-file) |
704 (defvar vc-log-version) | 686 (defvar vc-log-version) |
705 | 687 |
706 (defvar vc-dired-mode nil) | 688 (defvar vc-dired-mode nil) |
707 (make-variable-buffer-local 'vc-dired-mode) | 689 (make-variable-buffer-local 'vc-dired-mode) |
708 | |
709 (defvar vc-comment-ring (make-ring vc-maximum-comment-ring-size)) | |
710 (defvar vc-comment-ring-index nil) | |
711 (defvar vc-last-comment-match "") | |
712 | 690 |
713 ;; functions that operate on RCS revision numbers. This code should | 691 ;; functions that operate on RCS revision numbers. This code should |
714 ;; also be moved into the backends. It stays for now, however, since | 692 ;; also be moved into the backends. It stays for now, however, since |
715 ;; it is used in code below. | 693 ;; it is used in code below. |
716 (defun vc-trunk-p (rev) | 694 (defun vc-trunk-p (rev) |
752 (vc-branch-part branch)))))) | 730 (vc-branch-part branch)))))) |
753 | 731 |
754 ;; File property caching | 732 ;; File property caching |
755 | 733 |
756 (defun vc-clear-context () | 734 (defun vc-clear-context () |
757 "Clear all cached file properties and the comment ring." | 735 "Clear all cached file properties." |
758 (interactive) | 736 (interactive) |
759 (fillarray vc-file-prop-obarray 0) | 737 (fillarray vc-file-prop-obarray 0)) |
760 ;; Note: there is potential for minor lossage here if there is an open | |
761 ;; log buffer with a nonzero local value of vc-comment-ring-index. | |
762 (setq vc-comment-ring (make-ring vc-maximum-comment-ring-size))) | |
763 | 738 |
764 (defmacro with-vc-properties (file form settings) | 739 (defmacro with-vc-properties (file form settings) |
765 "Execute FORM, then maybe set per-file properties for FILE. | 740 "Execute FORM, then maybe set per-file properties for FILE. |
766 SETTINGS is an association list of property/value pairs. After | 741 SETTINGS is an association list of property/value pairs. After |
767 executing FORM, set those properties from SETTINGS that have not yet | 742 executing FORM, set those properties from SETTINGS that have not yet |
1584 (vc-checkout-time . ,(nth 5 (file-attributes file))) | 1559 (vc-checkout-time . ,(nth 5 (file-attributes file))) |
1585 (vc-workfile-version . nil))) | 1560 (vc-workfile-version . nil))) |
1586 (message "Checking in %s...done" file)) | 1561 (message "Checking in %s...done" file)) |
1587 'vc-checkin-hook)) | 1562 'vc-checkin-hook)) |
1588 | 1563 |
1589 (defun vc-comment-to-change-log (&optional whoami file-name) | |
1590 "Enter last VC comment into the change log for the current file. | |
1591 WHOAMI (interactive prefix) non-nil means prompt for user name | |
1592 and site. FILE-NAME is the name of the change log; if nil, use | |
1593 `change-log-default-name'. | |
1594 | |
1595 This may be useful as a `vc-checkin-hook' to update change logs | |
1596 automatically." | |
1597 (interactive (if current-prefix-arg | |
1598 (list current-prefix-arg | |
1599 (prompt-for-change-log-name)))) | |
1600 ;; Make sure the defvar for add-log-current-defun-function has been executed | |
1601 ;; before binding it. | |
1602 (require 'add-log) | |
1603 (let (;; Extract the comment first so we get any error before doing anything. | |
1604 (comment (ring-ref vc-comment-ring 0)) | |
1605 ;; Don't let add-change-log-entry insert a defun name. | |
1606 (add-log-current-defun-function 'ignore) | |
1607 end) | |
1608 ;; Call add-log to do half the work. | |
1609 (add-change-log-entry whoami file-name t t) | |
1610 ;; Insert the VC comment, leaving point before it. | |
1611 (setq end (save-excursion (insert comment) (point-marker))) | |
1612 (if (looking-at "\\s *\\s(") | |
1613 ;; It starts with an open-paren, as in "(foo): Frobbed." | |
1614 ;; So remove the ": " add-log inserted. | |
1615 (delete-char -2)) | |
1616 ;; Canonicalize the white space between the file name and comment. | |
1617 (just-one-space) | |
1618 ;; Indent rest of the text the same way add-log indented the first line. | |
1619 (let ((indentation (current-indentation))) | |
1620 (save-excursion | |
1621 (while (< (point) end) | |
1622 (forward-line 1) | |
1623 (indent-to indentation)) | |
1624 (setq end (point)))) | |
1625 ;; Fill the inserted text, preserving open-parens at bol. | |
1626 (let ((paragraph-separate (concat paragraph-separate "\\|\\s *\\s(")) | |
1627 (paragraph-start (concat paragraph-start "\\|\\s *\\s("))) | |
1628 (beginning-of-line) | |
1629 (fill-region (point) end)) | |
1630 ;; Canonicalize the white space at the end of the entry so it is | |
1631 ;; separated from the next entry by a single blank line. | |
1632 (skip-syntax-forward " " end) | |
1633 (delete-char (- (skip-syntax-backward " "))) | |
1634 (or (eobp) (looking-at "\n\n") | |
1635 (insert "\n")))) | |
1636 | |
1637 (defun vc-finish-logentry (&optional nocomment) | 1564 (defun vc-finish-logentry (&optional nocomment) |
1638 "Complete the operation implied by the current log entry. | 1565 "Complete the operation implied by the current log entry. |
1639 Use the contents of the current buffer as a check-in or registration | 1566 Use the contents of the current buffer as a check-in or registration |
1640 comment. If the optional arg NOCOMMENT is non-nil, then don't check | 1567 comment. If the optional arg NOCOMMENT is non-nil, then don't check |
1641 the buffer contents as a comment, and don't add it to | 1568 the buffer contents as a comment." |
1642 `vc-comment-ring'." | |
1643 (interactive) | 1569 (interactive) |
1644 ;; Check and record the comment, if any. | 1570 ;; Check and record the comment, if any. |
1645 (unless nocomment | 1571 (unless nocomment |
1646 ;; Comment too long? | 1572 ;; Comment too long? |
1647 (vc-call-backend (or (and vc-log-file (vc-backend vc-log-file)) | 1573 (vc-call-backend (or (and vc-log-file (vc-backend vc-log-file)) |
1648 (vc-responsible-backend default-directory)) | 1574 (vc-responsible-backend default-directory)) |
1649 'logentry-check) | 1575 'logentry-check) |
1650 (run-hooks 'vc-logentry-check-hook) | 1576 (run-hooks 'vc-logentry-check-hook)) |
1651 ;; Record the comment in the comment ring | |
1652 (let ((comment (buffer-string))) | |
1653 (unless (and (ring-p vc-comment-ring) | |
1654 (not (ring-empty-p vc-comment-ring)) | |
1655 (equal comment (ring-ref vc-comment-ring 0))) | |
1656 (ring-insert vc-comment-ring comment)))) | |
1657 ;; Sync parent buffer in case the user modified it while editing the comment. | 1577 ;; Sync parent buffer in case the user modified it while editing the comment. |
1658 ;; But not if it is a vc-dired buffer. | 1578 ;; But not if it is a vc-dired buffer. |
1659 (with-current-buffer vc-parent-buffer | 1579 (with-current-buffer vc-parent-buffer |
1660 (or vc-dired-mode (vc-buffer-sync))) | 1580 (or vc-dired-mode (vc-buffer-sync))) |
1661 (if (not vc-log-operation) (error "No log operation is pending")) | 1581 (if (not vc-log-operation) (error "No log operation is pending")) |
1689 (if vc-dired-mode | 1609 (if vc-dired-mode |
1690 (dired-move-to-filename)) | 1610 (dired-move-to-filename)) |
1691 (run-hooks after-hook 'vc-finish-logentry-hook))) | 1611 (run-hooks after-hook 'vc-finish-logentry-hook))) |
1692 | 1612 |
1693 ;; Code for access to the comment ring | 1613 ;; Code for access to the comment ring |
1694 | |
1695 (defun vc-new-comment-index (stride len) | |
1696 "Return the comment index STRIDE elements from the current one. | |
1697 LEN is the length of `vc-comment-ring'." | |
1698 (mod (cond | |
1699 (vc-comment-ring-index (+ vc-comment-ring-index stride)) | |
1700 ;; Initialize the index on the first use of this command | |
1701 ;; so that the first M-p gets index 0, and the first M-n gets | |
1702 ;; index -1. | |
1703 ((> stride 0) (1- stride)) | |
1704 (t stride)) | |
1705 len)) | |
1706 | |
1707 (defun vc-previous-comment (arg) | |
1708 "Cycle backwards through comment history. | |
1709 With a numeric prefix ARG, go back ARG comments." | |
1710 (interactive "*p") | |
1711 (let ((len (ring-length vc-comment-ring))) | |
1712 (if (<= len 0) | |
1713 (progn (message "Empty comment ring") (ding)) | |
1714 (erase-buffer) | |
1715 (setq vc-comment-ring-index (vc-new-comment-index arg len)) | |
1716 (message "Comment %d" (1+ vc-comment-ring-index)) | |
1717 (insert (ring-ref vc-comment-ring vc-comment-ring-index))))) | |
1718 | |
1719 (defun vc-next-comment (arg) | |
1720 "Cycle forwards through comment history. | |
1721 With a numeric prefix ARG, go forward ARG comments." | |
1722 (interactive "*p") | |
1723 (vc-previous-comment (- arg))) | |
1724 | |
1725 (defun vc-comment-search-reverse (str &optional stride) | |
1726 "Search backwards through comment history for substring match of STR. | |
1727 If the optional argument STRIDE is present, that is a step-width to use | |
1728 when going through the comment ring." | |
1729 ;; Why substring rather than regexp ? -sm | |
1730 (interactive | |
1731 (list (read-string "Comment substring: " nil nil vc-last-comment-match))) | |
1732 (unless stride (setq stride 1)) | |
1733 (if (string= str "") | |
1734 (setq str vc-last-comment-match) | |
1735 (setq vc-last-comment-match str)) | |
1736 (let* ((str (regexp-quote str)) | |
1737 (len (ring-length vc-comment-ring)) | |
1738 (n (vc-new-comment-index stride len))) | |
1739 (while (progn (when (or (>= n len) (< n 0)) (error "Not found")) | |
1740 (not (string-match str (ring-ref vc-comment-ring n)))) | |
1741 (setq n (+ n stride))) | |
1742 (setq vc-comment-ring-index n) | |
1743 (vc-previous-comment 0))) | |
1744 | |
1745 (defun vc-comment-search-forward (str) | |
1746 "Search forwards through comment history for a substring match of STR." | |
1747 (interactive | |
1748 (list (read-string "Comment substring: " nil nil vc-last-comment-match))) | |
1749 (vc-comment-search-reverse str -1)) | |
1750 | 1614 |
1751 ;; Additional entry points for examining version histories | 1615 ;; Additional entry points for examining version histories |
1752 | 1616 |
1753 ;;;###autoload | 1617 ;;;###autoload |
1754 (defun vc-diff (historic &optional not-urgent) | 1618 (defun vc-diff (historic &optional not-urgent) |
2449 (if (string= name "") | 2313 (if (string= name "") |
2450 (progn | 2314 (progn |
2451 (vc-file-tree-walk | 2315 (vc-file-tree-walk |
2452 dir | 2316 dir |
2453 (lambda (f) (and | 2317 (lambda (f) (and |
2454 (vc-up-to-date-p f) | 2318 (vc-up-to-date-p f) |
2455 (vc-error-occurred | 2319 (vc-error-occurred |
2456 (vc-call checkout f nil "") | 2320 (vc-call checkout f nil "") |
2457 (if update (vc-resynch-buffer f t t))))))) | 2321 (if update (vc-resynch-buffer f t t))))))) |
2458 (let ((result (vc-snapshot-precondition dir))) | 2322 (let ((result (vc-snapshot-precondition dir))) |
2459 (if (stringp result) | 2323 (if (stringp result) |
2460 (error "File %s is locked" result) | 2324 (error "File %s is locked" result) |
2461 (setq update (and (eq result 'visited) update)) | 2325 (setq update (and (eq result 'visited) update)) |
2462 (vc-file-tree-walk | 2326 (vc-file-tree-walk |
2463 dir | 2327 dir |
2464 (lambda (f) (vc-error-occurred | 2328 (lambda (f) (vc-error-occurred |
2465 (vc-call checkout f nil name) | 2329 (vc-call checkout f nil name) |
2466 (if update (vc-resynch-buffer f t t))))))))) | 2330 (if update (vc-resynch-buffer f t t))))))))) |
2467 | 2331 |
2468 ;; Miscellaneous other entry points | 2332 ;; Miscellaneous other entry points |
2469 | 2333 |
2470 ;;;###autoload | 2334 ;;;###autoload |
2471 (defun vc-print-log () | 2335 (defun vc-print-log () |