-;;; pcvs.el -- A Front-end to CVS.
+;;; pcvs.el --- a front-end to CVS
;; Copyright (C) 1991,92,93,94,95,95,97,98,99,2000 Free Software Foundation, Inc.
;; (Jari Aalto+mail.emacs) jari.aalto@poboxes.com
;; Maintainer: (Stefan Monnier) monnier+lists/cvs/pcl@flint.cs.yale.edu
;; Keywords: CVS, version control, release management
-;; Revision: $Id: pcvs.el,v 1.26 2001/03/07 00:20:30 monnier Exp $
+;; Revision: $Id: pcvs.el,v 1.34 2002/04/03 16:56:36 kai Exp $
;; This file is part of GNU Emacs.
;;; Bugs:
-;; - can somehow ignore important messages like `co aborted' or
-;; or `co: output error: No space left on device'.
+;; - Extracting an old version seems not to recognize encoding correctly.
+;; That's probably because it's done via a process rather than a file.
;;; Todo:
(defun cvs-reread-cvsrc ()
"Reset the default arguments to those in the `cvs-cvsrc-file'."
(interactive)
- (let ((cvsrc (cvs-file-to-string cvs-cvsrc-file)))
- (when (stringp cvsrc)
- ;; fetch the values
- (dolist (cmd '("cvs" "checkout" "status" "log" "diff" "tag"
- "add" "commit" "remove" "update"))
- (let* ((sym (intern (concat "cvs-" cmd "-flags")))
- (val (when (string-match (concat "^" cmd "\\s-\\(.*\\)$") cvsrc)
- (cvs-string->strings (match-string 1 cvsrc)))))
- (cvs-flags-set sym 0 val)))
- ;; ensure that cvs doesn't have -q or -Q
- (cvs-flags-set 'cvs-cvs-flags 0
- (cons "-f"
- (cdr (cvs-partition
- (lambda (x) (member x '("-q" "-Q")))
- (cvs-flags-query 'cvs-cvs-flags
- nil 'noquery))))))))
+ (condition-case nil
+ (with-temp-buffer
+ (insert-file-contents cvs-cvsrc-file)
+ ;; fetch the values
+ (dolist (cmd '("cvs" "checkout" "status" "log" "diff" "tag"
+ "add" "commit" "remove" "update"))
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat "^" cmd "\\(\\s-+\\(.*\\)\\)?$") nil t)
+ (let* ((sym (intern (concat "cvs-" cmd "-flags")))
+ (val (cvs-string->strings (or (match-string 2) ""))))
+ (cvs-flags-set sym 0 val))))
+ ;; ensure that cvs doesn't have -q or -Q
+ (cvs-flags-set 'cvs-cvs-flags 0
+ (cons "-f"
+ (cdr (cvs-partition
+ (lambda (x) (member x '("-q" "-Q" "-f")))
+ (cvs-flags-query 'cvs-cvs-flags
+ nil 'noquery))))))
+ (file-error nil)))
;; initialize to cvsrc's default values
(cvs-reread-cvsrc)
(cvsbuf (cond ((cvs-buffer-p) (current-buffer))
((and cvs-buffer (cvs-buffer-p cvs-buffer)) cvs-buffer)
(-cvs-mode!-noerror (current-buffer))
- (t (error "can't find the *cvs* buffer."))))
+ (t (error "can't find the *cvs* buffer"))))
(-cvs-mode!-wrapper cvs-minor-wrap-function)
(-cvs-mode!-cont (lambda ()
(save-current-buffer
;; Check that dir is under CVS control.
(unless (file-directory-p dir)
(error "%s is not a directory" dir))
- (unless (or noexist (file-directory-p (expand-file-name "CVS" dir)))
+ (unless (or noexist (file-directory-p (expand-file-name "CVS" dir))
+ (file-expand-wildcards (expand-file-name "*/CVS" dir)))
(error "%s does not contain CVS controlled files" dir))
(set-buffer cvsbuf)
"Go to the previous line.
If a prefix argument is given, move by that many lines."
(interactive "p")
- (ewoc-goto-prev cvs-cookies arg))
+ (ewoc-goto-prev cvs-cookies arg)
+ (let ((fpos (next-single-property-change
+ (point) 'cvs-goal-column
+ (current-buffer) (line-end-position)))
+ (eol (line-end-position)))
+ (when (< fpos eol)
+ (goto-char fpos))))
(defun-cvs-mode cvs-mode-next-line (arg)
"Go to the next line.
If a prefix argument is given, move by that many lines."
(interactive "p")
- (ewoc-goto-next cvs-cookies arg))
+ (ewoc-goto-next cvs-cookies arg)
+ (let ((fpos (next-single-property-change
+ (point) 'cvs-goal-column
+ (current-buffer) (line-end-position)))
+ (eol (line-end-position)))
+ (when (< fpos eol)
+ (goto-char fpos))))
;;;;
;;;; Mark handling
(interactive)
(cvs-mode-commit 'force))
+(defcustom cvs-mode-commit-hook nil
+ "Hook run after setting up the commit buffer."
+ :type 'hook
+ :options '(cvs-mode-diff))
+
(defun cvs-mode-commit (setup)
"Check in all marked files, or the current file.
The user will be asked for a log message in a buffer.
'log-edit)))
(funcall setupfun 'cvs-do-commit setup 'cvs-commit-filelist buf)
(set (make-local-variable 'cvs-minor-wrap-function) 'cvs-commit-minor-wrap)
- (set (make-local-variable 'list-buffers-directory) lbd)))
+ (set (make-local-variable 'list-buffers-directory) lbd)
+ (run-hooks 'cvs-mode-commit-hook)))
(defun cvs-commit-minor-wrap (buf f)
(let ((cvs-ignore-marks-modif (cvs-mode-mark-get-modif "commit")))
;;;;
(defun-cvs-mode (cvs-mode-insert . NOARGS) (file)
- "Insert an entry for a specific file."
+ "Insert an entry for a specific file into the current listing.
+This is typically used if the file is up-to-date (or has been added
+outside of PCL-CVS) and one wants to do some operation on it."
(interactive
(list (read-file-name
"File to insert: "
This command can be used on files that are marked with \"Merged\"
or \"Conflict\" in the *cvs* buffer."
(interactive (list (cvs-flags-query 'cvs-diff-flags "diff flags")))
- (unless (listp flags) (error "flags should be a list of strings."))
+ (unless (listp flags) (error "flags should be a list of strings"))
(save-some-buffers)
(let* ((filter 'diff)
(marked (cvs-get-marked (cvs-ignore-marks-p "diff")))
Signal an error if there is no backup file."
(let ((backup-file (cvs-fileinfo->backup-file fileinfo)))
(unless backup-file
- (error "%s has no backup file." (cvs-fileinfo->full-path fileinfo)))
+ (error "%s has no backup file" (cvs-fileinfo->full-path fileinfo)))
(list backup-file (cvs-fileinfo->full-path fileinfo))))
;;
(rev2 (and rev1 (cvs-prefix-get 'cvs-secondary-branch-prefix)))
(fis (cvs-mode-marked 'diff "idiff" :file t)))
(when (> (length fis) 2)
- (error "idiff-other cannot be applied to more than 2 files at a time."))
+ (error "idiff-other cannot be applied to more than 2 files at a time"))
(let* ((fi1 (car fis))
(rev1-buf (if rev1 (cvs-retrieve-revision fi1 rev1)
(find-file-noselect (cvs-fileinfo->full-path fi1))))
(setq rev2-buf
(if rev2 (cvs-retrieve-revision fi2 rev2)
(find-file-noselect (cvs-fileinfo->full-path fi2)))))
- (error "idiff-other doesn't know what other file/buffer to use."))
+ (error "idiff-other doesn't know what other file/buffer to use"))
(let* (;; this binding is used by cvs-ediff-startup-hook
(cvs-transient-buffers (list rev1-buf rev2-buf)))
(funcall (car cvs-idiff-imerge-handlers)
(let* ((default-directory (cvs-expand-dir-name cvs-lock-file))
(locks (directory-files default-directory nil cvs-lock-file-regexp)))
(cond
- ((not locks) (error "No lock files found."))
+ ((not locks) (error "No lock files found"))
((yes-or-no-p (concat "Really delete locks in " cvs-lock-file "? "))
(dolist (lock locks)
(cond ((file-directory-p lock) (delete-directory lock))
(defun-cvs-mode cvs-mode-add-change-log-entry-other-window ()
"Add a ChangeLog entry in the ChangeLog of the current directory."
(interactive)
- (let* ((fi (cvs-mode-marked nil nil :one t))
- (default-directory (cvs-expand-dir-name (cvs-fileinfo->dir fi)))
- (buffer-file-name (expand-file-name (cvs-fileinfo->file fi))))
- (kill-local-variable 'change-log-default-name)
- (add-change-log-entry-other-window)))
+ (dolist (fi (cvs-mode-marked nil nil))
+ (let ((default-directory (cvs-expand-dir-name (cvs-fileinfo->dir fi)))
+ (buffer-file-name (expand-file-name (cvs-fileinfo->file fi))))
+ (kill-local-variable 'change-log-default-name)
+ (save-excursion (add-change-log-entry-other-window)))))
;; interactive commands to set optional flags
(interactive
(list (completing-read
"Which flag: "
- (mapcar 'list '("cvs" "diff" "update" "status" "log" "tag" ;"rtag"
- "commit" "remove" "undo" "checkout"))
+ '("cvs" "diff" "update" "status" "log" "tag" ;"rtag"
+ "commit" "remove" "undo" "checkout")
nil t)))
(let* ((sym (intern (concat "cvs-" flag "-flags"))))
(let ((current-prefix-arg '(16)))
;;;###autoload
(defcustom cvs-dired-use-hook '(4)
"Whether or not opening a CVS directory should run PCL-CVS.
-NIL means never do it.
+nil means never do it.
ALWAYS means to always do it unless a prefix argument is given to the
command that prompted the opening of the directory.
Anything else means to do it only if the prefix arg is equal to this value."