/[emacs]/emacs/lisp/vc.el
ViewVC logotype

Diff of /emacs/lisp/vc.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.352 by monnier, Fri May 9 16:33:10 2003 UTC revision 1.353 by monnier, Sun May 18 02:53:24 2003 UTC
# Line 1  Line 1 
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>
# Line 522  These are passed to the checkin program Line 523  These are passed to the checkin program
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
# Line 670  and that its contents match what the mas Line 668  and that its contents match what the mas
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)
# Line 706  The keys are \(BUFFER . BACKEND\).  See Line 688  The keys are \(BUFFER . BACKEND\).  See
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.
# Line 754  as used by RCS and CVS." Line 732  as used by RCS and CVS."
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.
# Line 1586  Runs the normal hook `vc-checkin-hook'." Line 1561  Runs the normal hook `vc-checkin-hook'."
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
# Line 1647  the buffer contents as a comment, and do Line 1573  the buffer contents as a comment, and do
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
# Line 1692  the buffer contents as a comment, and do Line 1612  the buffer contents as a comment, and do
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
# Line 2451  allowed and simply skipped)." Line 2315  allowed and simply skipped)."
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)
# Line 2462  allowed and simply skipped)." Line 2326  allowed and simply skipped)."
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    

Legend:
Removed from v.1.352  
changed lines
  Added in v.1.353

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26