-;;; pcvs.el -- A Front-end to CVS.
+;;; pcvs.el --- a front-end to CVS
-;; Copyright (C) 1991-2000 Free Software Foundation, Inc.
+;; Copyright (C) 1991,92,93,94,95,95,97,98,99,2000,2002
+;; Free Software Foundation, Inc.
;; Author: (The PCL-CVS Trust) pcl-cvs@cyclic.com
;; (Per Cederqvist) ceder@lysator.liu.se
;; (Jim Blandy) jimb@cyclic.com
;; (Karl Fogel) kfogel@floss.red-bean.com
;; (Jim Kingdon) kingdon@cyclic.com
-;; (Stefan Monnier) monnier@cs.yale.edu
-;; (Greg Klanderman) greg@alphatech.com
-;; (Jari Aalto+mail.emacs) jari.aalto@poboxes.com
+;; (Stefan Monnier) monnier@cs.yale.edu
+;; (Greg Klanderman) greg@alphatech.com
+;; (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
-;; Version: $Name: $
-;; Revision: $Id: pcvs.el,v 1.2 2000/03/22 02:56:55 monnier Exp $
+;; Revision: $Id: pcvs.el,v 1.45 2002/11/18 20:53:24 rost Exp $
;; This file is part of GNU Emacs.
;; seamlessly (I also use VC).
;; To use PCL-CVS just use `M-x cvs-examine RET <dir> RET'.
-;; There used to be a TeXinfo manual, but it's now so out of date that
-;; it's not even worth looking at it.
+;; There is a TeXinfo manual, which can be helpful to get started.
+
+;;; Bugs:
+
+;; - 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:
;; ******** FIX THE DOCUMENTATION *********
;;
-;; - proper `g' that passes safe args and uses either cvs-status or cvs-examine
-;; - write cvs-fast-examine that parses CVS/Entries instead of running cvs
-;; we could even steal code from vc-cvs-hooks for that.
+;; - rework the displaying of error messages.
+;; - allow to flush messages only
+;; - allow to protect files like ChangeLog from flushing
+;; - automatically cvs-mode-insert files from find-file-hook
+;; (and don't flush them as long as they are visited)
+;; - query the user for cvs-get-marked (for some cmds or if nothing's selected)
+;; - don't return the first (resp last) FI if the cursor is before
+;; (resp after) it.
+;; - allow cvs-confirm-removals to force always confirmation.
+;; - cvs-checkout should ask for a revision (with completion).
+;; - removal confirmation should allow specifying another file name.
+;;
+;; - hide fileinfos without getting rid of them (will require ewok work).
;; - add toolbar entries
;; - marking
;; marking directories should jump to just after the dir.
;; allow (un)marking directories at a time with the mouse.
-;; marking with the mouse should not move point.
+;; allow cvs-cmd-do to either clear the marks or not.
+;; add a "marks active" notion, like transient-mark-mode does.
;; - liveness indicator
;; - indicate in docstring if the cmd understands the `b' prefix(es).
;; - call smerge-mode when opening CONFLICT files.
-;; - after-parse-hook (to eliminate *.elc from Emacs' CVS repository :-)
;; - have vc-checkin delegate to cvs-mode-commit when applicable
;; - higher-level CVS operations
;; cvs-mode-rename
;; - checks out module, or alternately does update join
;; - does "cvs -n tag LAST_VENDOR" to find old files into *cvs*
;; cvs-export
-;; (with completion on tag names and hooks to
-;; help generate full releases)
-;; - allow cvs-cmd-do to either clear the marks or not.
-;; - allow more concurrency: if the output buffer is busy, pick a new one.
+;; (with completion on tag names and hooks to help generate full releases)
;; - display stickiness information. And current CVS/Tag as well.
;; - write 'cvs-mode-admin' to do arbitrary 'cvs admin' commands
+;; Most interesting would be version removal and log message replacement.
+;; The last one would be neat when called from log-view-mode.
;; - cvs-mode-incorporate
-;; It would merge in the status from one ``*cvs*'' buffer into another.
+;; It would merge in the status from one *cvs* buffer into another.
;; This would be used to populate such a buffer that had been created with
;; a `cvs {update,status,checkout} -l'.
;; - cvs-mode-(i)diff-other-{file,buffer,cvs-buffer}
;; - maybe poll/check CVS/Entries files to react to external `cvs' commands ?
;; - some kind of `cvs annotate' support ?
;; but vc-annotate can be used instead.
-;; - dynamic `g' mapping
-;; Make 'g', and perhaps other commands, use either cvs-update or
-;; cvs-examine depending on the read-only status of the cvs buffer, for
-;; instance.
+;; - proper `g' that passes safe args and uses either cvs-status or cvs-examine
+;; maybe also use cvs-update depending on I-don't-know-what.
;; - add message-levels so that we can hide some levels of messages
;;; Code:
(defvar cvs-from-vc nil "Bound to t inside VC advice.")
-;;;;
+;;;;
;;;; flags variables
-;;;;
+;;;;
(defun cvs-defaults (&rest defs)
(let ((defs (cvs-first defs cvs-shared-start)))
(append defs
- (make-list (- cvs-shared-start (length defs)) (first defs))
+ (make-list (- cvs-shared-start (length defs)) (car defs))
cvs-shared-flags)))
;; For cvs flags, we need to add "-f" to override the cvsrc settings
(cvs-flags-define cvs-checkout-flags (cvs-defaults '("-P")))
(cvs-flags-define cvs-status-flags (cvs-defaults '("-v") nil))
(cvs-flags-define cvs-log-flags (cvs-defaults nil))
-(cvs-flags-define cvs-diff-flags (cvs-defaults '("-u" "-N") '("-c" "-N")))
+(cvs-flags-define cvs-diff-flags (cvs-defaults '("-u" "-N") '("-c" "-N") '("-u" "-b")))
(cvs-flags-define cvs-tag-flags (cvs-defaults nil))
(cvs-flags-define cvs-add-flags (cvs-defaults nil))
(cvs-flags-define cvs-commit-flags (cvs-defaults nil))
(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)
(defun cvs-menu (e)
"Popup the CVS menu."
(interactive "e")
- (mouse-set-point e)
- (x-popup-menu e cvs-menu-map))
+ (let ((cvs-minor-current-files
+ (list (ewoc-data (ewoc-locate
+ cvs-cookies (posn-point (event-end e)))))))
+ (popup-menu cvs-menu e)))
(defvar cvs-mode-line-process nil
"Mode-line control for displaying info on cvs process status.")
-;;;;
+;;;;
;;;; Query-Type-Descriptor for Tags
-;;;;
+;;;;
(autoload 'cvs-status-get-tags "cvs-status")
(defun cvs-tags-list ()
(defconst cvs-qtypedesc-tag
(cvs-qtypedesc-create 'identity 'identity 'cvs-tags-list 'cvs-tag-history))
-;;;;
+;;;;
(defun cvs-mode! (&optional -cvs-mode!-fun -cvs-mode!-noerror)
"Switch to the *cvs* buffer.
(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
;; the selected window has not been changed by FUN
(select-window cvs-mode!-owin)))))))
-;;;;
+;;;;
;;;; Prefixes
-;;;;
+;;;;
(defvar cvs-branches (list cvs-vendor-branch "HEAD" "HEAD"))
(cvs-prefix-define cvs-branch-prefix
(cvs-prefix-get 'cvs-secondary-branch-prefix))))
(if branch (cons (concat (or arg "-r") branch) flags) flags)))
-;;;;
+;;;;
-(define-minor-mode
- cvs-minor-mode
- "
-This mode is used for buffers related to a main *cvs* buffer.
+(define-minor-mode cvs-minor-mode
+ "This mode is used for buffers related to a main *cvs* buffer.
All the `cvs-mode' buffer operations are simply rebound under
-the \\[cvs-mode-map] prefix.
-"
- nil " CVS")
+the \\[cvs-mode-map] prefix."
+ nil " CVS"
+ :group 'pcl-cvs)
(put 'cvs-minor-mode 'permanent-local t)
from the current buffer."
(let* ((cvs-buf (current-buffer))
(info (cdr (assoc cmd cvs-buffer-name-alist)))
- (name (eval (first info)))
- (mode (second info))
+ (name (eval (nth 0 info)))
+ (mode (nth 1 info))
(dir default-directory)
(buf (cond
(name (cvs-get-buffer-create name))
(set (make-local-variable 'cvs-temp-buffer)
(cvs-get-buffer-create
(eval cvs-temp-buffer-name) 'noreuse))))))
-
+
;; handle the potential pre-existing process
(let ((proc (get-buffer-process buf)))
(when (and (not normal) (processp proc)
;;(set (make-local-variable 'cvs-temp-buffer) (cvs-temp-buffer))
(let ((cookies (ewoc-create 'cvs-fileinfo-pp "\n" "")))
(set (make-local-variable 'cvs-cookies) cookies)
- (make-local-hook 'kill-buffer-hook)
(add-hook 'kill-buffer-hook
(lambda ()
(ignore-errors (kill-buffer cvs-temp-buffer)))
(cvsbuf (cvs-make-cvs-buffer dir new)))
;; 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)))
- (error "%s does not contain CVS controlled files." dir))
+ (error "%s is not a directory" 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)
(cvs-mode-run cmd flags fis
;; 'pop-to-buffer 'switch-to-buffer)
;; cvsbuf))))
-;;----------
(defun cvs-run-process (args fis postprocess &optional single-dir)
(assert (cvs-buffer-p cvs-buffer))
(save-current-buffer
(let ((procbuf (current-buffer))
(cvsbuf cvs-buffer)
(single-dir (or single-dir (eq cvs-execute-single-dir t))))
-
+
(set-buffer procbuf)
(goto-char (point-max))
(unless (bolp) (let ((inhibit-read-only t)) (insert "\n")))
(fi (car fis) (car fis)))
((not (and fis (string= dir (cvs-fileinfo->dir fi))))
(list dir files fis))))))
- (dir (first dir+files+rest))
- (files (second dir+files+rest))
- (rest (third dir+files+rest)))
-
+ (dir (nth 0 dir+files+rest))
+ (files (nth 1 dir+files+rest))
+ (rest (nth 2 dir+files+rest)))
+
;; setup the (current) process buffer
(set (make-local-variable 'cvs-postprocess)
(if (null rest)
postprocess
;; else, we have to register ourselves to be rerun on the rest
`(cvs-run-process ',args ',rest ',postprocess ',single-dir)))
- (make-local-hook 'kill-buffer-hook)
(add-hook 'kill-buffer-hook
(lambda ()
(let ((proc (get-buffer-process (current-buffer))))
(if cvs-cvsroot (list "-d" cvs-cvsroot))
args
files))
- (process-connection-type nil) ; Use a pipe, not a pty.
+ ;; If process-connection-type is nil and the repository
+ ;; is accessed via SSH, a bad interaction between libc,
+ ;; CVS and SSH can lead to garbled output.
+ ;; It might be a glibc-specific problem.
+ ;; Until the problem is cleared, we'll use a pty rather than
+ ;; a pipe.
+ ;; (process-connection-type nil) ; Use a pipe, not a pty.
(process
;; the process will be run in the selected dir
(let ((default-directory (cvs-expand-dir-name dir)))
(set-process-filter process 'cvs-update-filter)
(set-marker (process-mark process) (point-max))
(ignore-errors (process-send-eof process)) ;close its stdin to avoid hangs
-
+
;; now finish setting up the cvs-buffer
(set-buffer cvsbuf)
(setq cvs-mode-line-process (symbol-name (process-status process)))
(defun cvs-update-header (args fis) ; inline
(let* ((lastarg nil)
- ;; filter out the largish commit message
(args (mapcar (lambda (arg)
(cond
+ ;; filter out the largish commit message
((and (eq lastarg nil) (string= arg "commit"))
(setq lastarg 'commit) arg)
((and (eq lastarg 'commit) (string= arg "-m"))
(setq lastarg '-m) arg)
((eq lastarg '-m)
(setq lastarg 'done) "<log message>")
+ ;; filter out the largish `admin -mrev:msg' message
+ ((and (eq lastarg nil) (string= arg "admin"))
+ (setq lastarg 'admin) arg)
+ ((and (eq lastarg 'admin)
+ (string-match "\\`-m[^:]*:" arg))
+ (setq lastarg 'done)
+ (concat (match-string 0 arg) "<log message>"))
+ ;; Keep the rest as is.
(t arg)))
args))
;; turn them into a string
(mapcar 'cvs-fileinfo->full-path fis))))
(str (if args (concat "-- Running " cvs-program " " arg " ...\n")
"\n")))
- (if nil (insert str) ;inline
+ (if nil (insert str) ;inline
;;(with-current-buffer cvs-buffer
- (let* ((prev-msg (car (ewoc-get-hf cvs-cookies)))
- (tin (ewoc-nth cvs-cookies 0)))
- ;; look for the first *real* fileinfo (to determine emptyness)
- (while
- (and tin
- (memq (cvs-fileinfo->type (ewoc-data tin))
- '(MESSAGE DIRCHANGE)))
- (setq tin (ewoc-next cvs-cookies tin)))
- ;; cleanup the prev-msg
- (when (string-match "Running \\(.*\\) ...\n" prev-msg)
- (setq prev-msg
- (concat
- "-- last cmd: "
- (match-string 1 prev-msg)
- " --")))
- ;; set the new header and footer
- (ewoc-set-hf cvs-cookies
- str (concat "\n--------------------- "
- (if tin "End" "Empty")
- " ---------------------\n"
- prev-msg))))))
-
-
-;;----------
+ (let* ((prev-msg (car (ewoc-get-hf cvs-cookies)))
+ (tin (ewoc-nth cvs-cookies 0)))
+ ;; look for the first *real* fileinfo (to determine emptyness)
+ (while
+ (and tin
+ (memq (cvs-fileinfo->type (ewoc-data tin))
+ '(MESSAGE DIRCHANGE)))
+ (setq tin (ewoc-next cvs-cookies tin)))
+ ;; cleanup the prev-msg
+ (when (string-match "Running \\(.*\\) ...\n" prev-msg)
+ (setq prev-msg
+ (concat
+ "-- last cmd: "
+ (match-string 1 prev-msg)
+ " --")))
+ ;; set the new header and footer
+ (ewoc-set-hf cvs-cookies
+ str (concat "\n--------------------- "
+ (if tin "End" "Empty")
+ " ---------------------\n"
+ prev-msg))))))
+
+
(defun cvs-sentinel (proc msg)
"Sentinel for the cvs update process.
This is responsible for parsing the output from the cvs update when
(save-excursion (eval cvs-postproc))
;; check whether something is left
(unless cvs-postprocess
+ ;; IIRC, we enable undo again once the process is finished
+ ;; for cases where the output was inserted in *vc-diff* or
+ ;; in a file-like buffer. -stef
(buffer-enable-undo)
(with-current-buffer cvs-buffer
(cvs-update-header nil nil) ;FIXME: might need to be inline
- (message "CVS process has completed"))))
+ (message "CVS process has completed in %s" (buffer-name)))))
;; This might not even be necessary
(set-buffer obuf)))))
-;;----------
-(defun cvs-parse-process (dcd &optional subdir)
- "FIXME: bad name, no doc"
- (let* ((from-buf (current-buffer))
- (fileinfos (cvs-parse-buffer 'cvs-parse-table dcd subdir))
- (_ (set-buffer cvs-buffer))
- last
- (from-pt (point)))
- ;; add the new fileinfos
- (dolist (fi fileinfos)
- (setq last (cvs-addto-collection cvs-cookies fi last)))
- (cvs-cleanup-collection cvs-cookies
- (eq cvs-auto-remove-handled t)
- cvs-auto-remove-directories
- nil)
- ;; update the display (might be unnecessary)
- (ewoc-refresh cvs-cookies)
- ;; revert buffers if necessary
- (when (and cvs-auto-revert (not dcd) (not cvs-from-vc))
- (cvs-revert-if-needed fileinfos))
- ;; get back to where we were. `save-excursion' doesn't seem to
- ;; work in this case, probably because the buffer is reconstructed
- ;; by the cookie code.
- (goto-char from-pt)
- (set-buffer from-buf)))
+(defun cvs-parse-process (dcd &optional subdir old-fis)
+ "Parse the output of a cvs process.
+DCD is the `dont-change-disc' flag to use when parsing that output.
+SUBDIR is the subdirectory (if any) where this command was run.
+OLD-FIS is the list of fileinfos on which the cvs command was applied and
+ which should be considered up-to-date if they are missing from the output."
+ (let* ((fileinfos (cvs-parse-buffer 'cvs-parse-table dcd subdir))
+ last)
+ (with-current-buffer cvs-buffer
+ ;; Expand OLD-FIS to actual files.
+ (let ((fis nil))
+ (dolist (fi old-fis)
+ (setq fis (if (eq (cvs-fileinfo->type fi) 'DIRCHANGE)
+ (nconc (ewoc-collect cvs-cookies 'cvs-dir-member-p
+ (cvs-fileinfo->dir fi))
+ fis)
+ (cons fi fis))))
+ (setq old-fis fis))
+ ;; Drop OLD-FIS which were already up-to-date.
+ (let ((fis nil))
+ (dolist (fi old-fis)
+ (unless (eq (cvs-fileinfo->type fi) 'UP-TO-DATE) (push fi fis)))
+ (setq old-fis fis))
+ ;; Add the new fileinfos to the ewoc.
+ (dolist (fi fileinfos)
+ (setq last (cvs-addto-collection cvs-cookies fi last))
+ ;; This FI was in the output, so remove it from OLD-FIS.
+ (setq old-fis (delq (ewoc-data last) old-fis)))
+ ;; Process the "silent output" (i.e. absence means up-to-date).
+ (dolist (fi old-fis)
+ (setf (cvs-fileinfo->type fi) 'UP-TO-DATE)
+ (setq last (cvs-addto-collection cvs-cookies fi last)))
+ (setq fileinfos (nconc old-fis fileinfos))
+ ;; Clean up the ewoc as requested by the user.
+ (cvs-cleanup-collection cvs-cookies
+ (eq cvs-auto-remove-handled t)
+ cvs-auto-remove-directories
+ nil)
+ ;; Revert buffers if necessary.
+ (when (and cvs-auto-revert (not dcd) (not cvs-from-vc))
+ (cvs-revert-if-needed fileinfos)))))
(defmacro defun-cvs-mode (fun args docstring interact &rest body)
"Define a function to be used in a *cvs* buffer.
- NOARGS will get all the arguments from the *cvs* buffer and will
always behave as if called interactively.
- DOUBLE is the generic case."
+ (declare (debug (&define sexp lambda-list stringp ("interactive" interactive) def-body)))
(let ((style (cvs-cdr fun))
(fun (cvs-car fun)))
(cond
;; a trivial interaction, no need to move it
((or (eq style 'SIMPLE)
- (null (second interact))
- (stringp (second interact)))
+ (null (nth 1 interact))
+ (stringp (nth 1 interact)))
`(defun ,fun ,args ,docstring ,interact
(cvs-mode! (lambda () ,@body))))
(cvs-mode! ',fun-1)))))
(t (error "unknown style %s in `defun-cvs-mode'" style)))))
-(def-edebug-spec defun-cvs-mode (&define sexp lambda-list stringp ("interactive" interactive) def-body))
(defun-cvs-mode cvs-mode-kill-process ()
"Kill the temporary buffer and associated process."
(let ((proc (get-buffer-process cvs-temp-buffer)))
(when proc (delete-process proc)))))
-;;;
-;;; Maintaining the collection in the face of updates
-;;;
+;;
+;; Maintaining the collection in the face of updates
+;;
(defun cvs-addto-collection (c fi &optional tin)
- "Add FI to C and return a tin.
+ "Add FI to C and return FI's corresponding tin.
FI is inserted in its proper place or maybe even merged with a preexisting
fileinfo if applicable.
TIN specifies an optional starting point."
(unless tin (setq tin (ewoc-nth c 0)))
(while (and tin (cvs-fileinfo< fi (ewoc-data tin)))
(setq tin (ewoc-prev c tin)))
- (if (null tin) (progn (ewoc-enter-first c fi) nil) ;empty collection
+ (if (null tin) (ewoc-enter-first c fi) ;empty collection
(assert (not (cvs-fileinfo< fi (ewoc-data tin))))
(let ((next-tin (ewoc-next c tin)))
(while (not (or (null next-tin)
(cvs-fileinfo< fi (ewoc-data next-tin))))
(setq tin next-tin next-tin (ewoc-next c next-tin)))
- (if (cvs-fileinfo< (ewoc-data tin) fi)
+ (if (or (cvs-fileinfo< (ewoc-data tin) fi)
+ (eq (cvs-fileinfo->type fi) 'MESSAGE))
;; tin < fi < next-tin
(ewoc-enter-after c tin fi)
;; fi == tin
(cvs-fileinfo-update (ewoc-data tin) fi)
- (ewoc-invalidate c tin))
- tin)))
+ (ewoc-invalidate c tin)
+ ;; Move cursor back to where it belongs.
+ (when (bolp) (cvs-move-to-goal-column))
+ tin))))
+
+(defcustom cvs-cleanup-functions nil
+ "Functions to tweak the cleanup process.
+The functions are called with a single argument (a FILEINFO) and should
+return a non-nil value if that fileinfo should be removed."
+ :group 'pcl-cvs
+ :type '(hook :options (cvs-cleanup-removed)))
+
+(defun cvs-cleanup-removed (fi)
+ "Non-nil if FI has been cvs-removed but still exists.
+This is intended for use on `cvs-cleanup-functions' when you have cvs-removed
+automatically generated files (which should hence not be under CVS control)
+but can't commit the removal because the repository's owner doesn't understand
+the problem."
+ (and (or (eq (cvs-fileinfo->type fi) 'REMOVED)
+ (and (eq (cvs-fileinfo->type fi) 'CONFLICT)
+ (eq (cvs-fileinfo->subtype fi) 'REMOVED)))
+ (file-exists-p (cvs-fileinfo->full-path fi))))
;; called at the following times:
;; - postparse ((eq cvs-auto-remove-handled t) cvs-auto-remove-directories nil)
;; handled also?
(UP-TO-DATE (not rm-handled))
;; keep the rest
- (t t))))
-
+ (t (not (run-hook-with-args-until-success
+ 'cvs-cleanup-functions fi))))))
+
;; mark dirs for removal
(when (and keep rm-dirs
(eq (cvs-fileinfo->type last-fi) 'DIRCHANGE)
With a prefix argument, prompt for cvs FLAGS to use."
(interactive
(list (cvs-string->strings (read-string "Module(s): " (cvs-get-module)))
- (read-file-name "CVS Checkout Directory: "
+ (read-directory-name "CVS Checkout Directory: "
nil default-directory nil)
(cvs-add-branch-prefix
(cvs-flags-query 'cvs-checkout-flags "cvs checkout flags"))))
:noexist t))
\f
-;;;;
+;;;;
;;;; The code for running a "cvs update" and friends in various ways.
-;;;;
+;;;;
(defun-cvs-mode (cvs-mode-revert-buffer . SIMPLE)
(&optional ignore-auto noconfirm)
- "Rerun cvs-examine on the current directory with the defauls flags."
+ "Rerun `cvs-examine' on the current directory with the default flags."
(interactive)
(cvs-examine default-directory t))
(not current-prefix-arg)
(not (eq last-command-char ?\r)))
default-directory
- (read-file-name msg nil default-directory nil)))
+ (read-directory-name msg nil default-directory nil)))
+;;;###autoload
+(defun cvs-quickdir (dir &optional flags noshow)
+ "Open a *cvs* buffer on DIR without running cvs.
+With a prefix argument, prompt for a directory to use.
+A prefix arg >8 (ex: \\[universal-argument] \\[universal-argument]),
+ prevents reuse of an existing *cvs* buffer.
+Optional argument NOSHOW if non-nil means not to display the buffer.
+FLAGS is ignored."
+ (interactive (list (cvs-query-directory "CVS quickdir (directory): ")))
+ ;; FIXME: code duplication with cvs-cmd-do and cvs-parse-process
+ (let* ((dir (file-name-as-directory
+ (abbreviate-file-name (expand-file-name dir))))
+ (new (> (prefix-numeric-value current-prefix-arg) 8))
+ (cvsbuf (cvs-make-cvs-buffer dir new))
+ last)
+ ;; Check that dir is under CVS control.
+ (unless (file-directory-p dir)
+ (error "%s is not a directory" dir))
+ (unless (file-directory-p (expand-file-name "CVS" dir))
+ (error "%s does not contain CVS controlled files" dir))
+ (set-buffer cvsbuf)
+ (dolist (fi (cvs-fileinfo-from-entries ""))
+ (setq last (cvs-addto-collection cvs-cookies fi last)))
+ (cvs-cleanup-collection cvs-cookies
+ (eq cvs-auto-remove-handled t)
+ cvs-auto-remove-directories
+ nil)
+ (if noshow cvsbuf
+ (let ((pop-up-windows nil)) (pop-to-buffer cvsbuf)))))
;;;###autoload
(defun cvs-examine (directory flags &optional noshow)
(defun cvs-update (directory flags)
"Run a `cvs update' in the current working DIRECTORY.
Feed the output to a *cvs* buffer and run `cvs-mode' on it.
-With a prefix argument, prompt for a directory and cvs FLAGS to use.
+With a \\[universal-argument] prefix argument, prompt for a directory to use.
A prefix arg >8 (ex: \\[universal-argument] \\[universal-argument]),
- prevents reuse of an existing *cvs* buffer."
+ prevents reuse of an existing *cvs* buffer.
+The prefix is also passed to `cvs-flags-query' to select the FLAGS
+ passed to cvs."
(interactive (list (cvs-query-directory "CVS Update (directory): ")
(cvs-flags-query 'cvs-update-flags "cvs update flags")))
(when (eq flags t)
(> (prefix-numeric-value current-prefix-arg) 8)
:noshow noshow :dont-change-disc t))
-;;----------
(defun cvs-update-filter (proc string)
"Filter function for pcl-cvs.
This function gets the output that CVS sends to stdout. It inserts
;; (tin-delete cookies
;; (tin-nth cookies 1)))
;; Check if CVS is waiting for a lock.
- (beginning-of-line 0) ;Move to beginning of last complete line.
+ (beginning-of-line 0) ;Move to beginning of last complete line.
(when (looking-at "^[ a-z]+: \\(.*waiting for .*lock in \\(.*\\)\\)$")
(let ((msg (match-string 1))
(lock (match-string 2)))
(cvs-create-fileinfo
'MESSAGE "" " "
(concat msg
- (substitute-command-keys
- "\n\t(type \\[cvs-mode-delete-lock] to delete it)"))
+ (when (file-exists-p lock)
+ (substitute-command-keys
+ "\n\t(type \\[cvs-mode-delete-lock] to delete it)")))
:subtype 'TEMP))
(pop-to-buffer (current-buffer))
(goto-char (point-max))
(interactive "P")
(cvs-prefix-set 'cvs-force-command arg))
-;;----------
(put 'cvs-mode 'mode-class 'special)
(define-derived-mode cvs-mode fundamental-mode "CVS"
"Mode used for PCL-CVS, a frontend to CVS.
("" cvs-branch-prefix (cvs-secondary-branch-prefix
("->" cvs-secondary-branch-prefix))))
" " cvs-mode-line-process))
- (buffer-disable-undo (current-buffer))
+ (buffer-disable-undo)
;;(set (make-local-variable 'goal-column) cvs-cursor-column)
(set (make-local-variable 'revert-buffer-function) 'cvs-mode-revert-buffer)
(setq truncate-lines t)
(error "Inconsistent %s in buffer %s" check (buffer-name buf)))))
-(defun-cvs-mode cvs-mode-quit ()
+(defun cvs-mode-quit ()
"Quit PCL-CVS, killing the *cvs* buffer."
(interactive)
(and (y-or-n-p "Quit pcl-cvs? ") (kill-buffer (current-buffer))))
"Display help for various PCL-CVS commands."
(interactive)
(if (eq last-command 'cvs-help)
- (describe-function 'cvs-mode) ; would need to use minor-mode for cvs-edit-mode
+ (describe-function 'cvs-mode) ; would need minor-mode for log-edit-mode
(message
(substitute-command-keys
"`\\[cvs-help]':help `\\[cvs-mode-add]':add `\\[cvs-mode-commit]':commit \
`\\[cvs-mode-remove]':remove `\\[cvs-mode-status]':status \
`\\[cvs-mode-undo]':undo"))))
-(defun cvs-mode-diff-help ()
- "Display help for various PCL-CVS diff commands."
- (interactive)
- (if (eq last-command 'cvs-mode-diff-help)
- (describe-function 'cvs-mode) ; no better docs for diff stuff?
- (message
- (substitute-command-keys
- "`\\[cvs-mode-diff]':diff `\\[cvs-mode-idiff]':idiff \
-`\\[cvs-mode-diff-head]':head `\\[cvs-mode-diff-vendor]':vendor \
-`\\[cvs-mode-diff-backup]':backup `\\[cvs-mode-idiff-other]':other \
-`\\[cvs-mode-imerge]':imerge"))))
-
;; Move around in the buffer
+(defun cvs-move-to-goal-column ()
+ (let* ((eol (line-end-position))
+ (fpos (next-single-property-change (point) 'cvs-goal-column nil eol)))
+ (when (< fpos eol)
+ (goto-char fpos))))
+
(defun-cvs-mode cvs-mode-previous-line (arg)
"Go to the previous line.
If a prefix argument is given, move by that many lines."
(interactive "p")
- (ewoc-goto-prev cvs-cookies (point) arg))
+ (ewoc-goto-prev cvs-cookies arg)
+ (cvs-move-to-goal-column))
(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 (point) arg))
+ (ewoc-goto-next cvs-cookies arg)
+ (cvs-move-to-goal-column))
-;;;;
+;;;;
;;;; Mark handling
-;;;;
+;;;;
(defun-cvs-mode cvs-mode-mark (&optional arg)
"Mark the fileinfo on the current line.
If the fileinfo is a directory, all the contents of that directory are
marked instead. A directory can never be marked."
(interactive)
- (let* ((tin (ewoc-locate cvs-cookies (point)))
+ (let* ((tin (ewoc-locate cvs-cookies))
(fi (ewoc-data tin)))
(if (eq (cvs-fileinfo->type fi) 'DIRCHANGE)
;; it's a directory: let's mark all files inside
(when (cvs-dir-member-p f dir)
(setf (cvs-fileinfo->marked f)
(not (if (eq arg 'toggle) (cvs-fileinfo->marked f) arg)))
- t)) ;Tell cookie to redisplay this cookie.
+ t)) ;Tell cookie to redisplay this cookie.
cvs-cookies
(cvs-fileinfo->dir fi))
;; not a directory: just do the obvious
(defun cvs-mouse-toggle-mark (e)
"Toggle the mark of the entry under the mouse."
(interactive "e")
- (mouse-set-point e)
- (cvs-mode-mark 'toggle))
+ (save-excursion
+ (mouse-set-point e)
+ (cvs-mode-mark 'toggle)))
(defun-cvs-mode cvs-mode-unmark ()
"Unmark the fileinfo on the current line."
"Mark all files."
(interactive)
(ewoc-map (lambda (cookie)
- (unless (eq (cvs-fileinfo->type cookie) 'DIRCHANGE)
- (setf (cvs-fileinfo->marked cookie) t)))
- cvs-cookies))
+ (unless (eq (cvs-fileinfo->type cookie) 'DIRCHANGE)
+ (setf (cvs-fileinfo->marked cookie) t)))
+ cvs-cookies))
+
+(defun-cvs-mode (cvs-mode-mark-on-state . SIMPLE) (state)
+ "Mark all files in state STATE."
+ (interactive
+ (list
+ (let ((default
+ (condition-case nil
+ (downcase
+ (symbol-name
+ (cvs-fileinfo->type
+ (cvs-mode-marked nil nil :read-only t :one t :noquery t))))
+ (error nil))))
+ (intern
+ (upcase
+ (completing-read
+ (concat
+ "Mark files in state" (if default (concat " [" default "]")) ": ")
+ (mapcar (lambda (x)
+ (list (downcase (symbol-name (car x)))))
+ cvs-states)
+ nil t nil nil default))))))
+ (ewoc-map (lambda (fi)
+ (when (eq (cvs-fileinfo->type fi) state)
+ (setf (cvs-fileinfo->marked fi) t)))
+ cvs-cookies))
(defun-cvs-mode cvs-mode-mark-matching-files (regex)
"Mark all files matching REGEX."
(interactive "sMark files matching: ")
(ewoc-map (lambda (cookie)
- (when (and (not (eq (cvs-fileinfo->type cookie) 'DIRCHANGE))
- (string-match regex (cvs-fileinfo->file cookie)))
- (setf (cvs-fileinfo->marked cookie) t)))
- cvs-cookies))
+ (when (and (not (eq (cvs-fileinfo->type cookie) 'DIRCHANGE))
+ (string-match regex (cvs-fileinfo->file cookie)))
+ (setf (cvs-fileinfo->marked cookie) t)))
+ cvs-cookies))
(defun-cvs-mode cvs-mode-unmark-all-files ()
"Unmark all files.
they should always be unmarked."
(interactive)
(ewoc-map (lambda (cookie)
- (setf (cvs-fileinfo->marked cookie) nil)
- t)
- cvs-cookies))
+ (setf (cvs-fileinfo->marked cookie) nil)
+ t)
+ cvs-cookies))
(defun-cvs-mode cvs-mode-unmark-up ()
"Unmark the file on the previous line."
(interactive)
- (let ((tin (ewoc-goto-prev cvs-cookies (point) 1)))
+ (let ((tin (ewoc-goto-prev cvs-cookies 1)))
(when tin
(setf (cvs-fileinfo->marked (ewoc-data tin)) nil)
(ewoc-invalidate cvs-cookies tin))))
(mapcar 'cdr cvs-ignore-marks-alternatives)
(cvs-qtypedesc-create
(lambda (str) (cdr (assoc str cvs-ignore-marks-alternatives)))
- (lambda (obj) (caar (member* obj cvs-ignore-marks-alternatives :key 'cdr)))
+ (lambda (obj) (car (rassoc obj cvs-ignore-marks-alternatives)))
(lambda () cvs-ignore-marks-alternatives)
nil t))
-
+
(defun-cvs-mode cvs-mode-toggle-marks (arg)
"Toggle whether the next CVS command uses marks.
See `cvs-prefix-set' for further description of the behavior.
\\[universal-argument] 3 selects `toggle-marks'."
(interactive "P")
(cvs-prefix-set 'cvs-ignore-marks-modif arg))
-
+
(defun cvs-ignore-marks-p (cmd &optional read-only)
(let ((default (if (member cmd cvs-invert-ignore-marks)
(not cvs-default-ignore-marks)
Args: &optional IGNORE-MARKS IGNORE-CONTENTS."
(let ((fis nil))
- (dolist (fi (if (boundp 'cvs-minor-current-files)
+ (dolist (fi (if (and (boundp 'cvs-minor-current-files)
+ (consp cvs-minor-current-files))
(mapcar
(lambda (f)
- (let ((f (file-relative-name f)))
- (if (file-directory-p f)
- (cvs-create-fileinfo
- 'DIRCHANGE (file-name-as-directory f) "." "")
- (let ((dir (file-name-directory f))
- (file (file-name-nondirectory f)))
- (cvs-create-fileinfo
- 'UNKNOWN (or dir "") file "")))))
+ (if (cvs-fileinfo-p f) f
+ (let ((f (file-relative-name f)))
+ (if (file-directory-p f)
+ (cvs-create-fileinfo
+ 'DIRCHANGE (file-name-as-directory f) "." "")
+ (let ((dir (file-name-directory f))
+ (file (file-name-nondirectory f)))
+ (cvs-create-fileinfo
+ 'UNKNOWN (or dir "") file ""))))))
cvs-minor-current-files)
(or (and (not ignore-marks)
- (ewoc-collect cvs-cookies
- 'cvs-fileinfo->marked))
- (list (ewoc-data (ewoc-locate cvs-cookies (point)))))))
-
+ (ewoc-collect cvs-cookies 'cvs-fileinfo->marked))
+ (list (ewoc-data (ewoc-locate cvs-cookies))))))
+
(if (or ignore-contents (not (eq (cvs-fileinfo->type fi) 'DIRCHANGE)))
(push fi fis)
;; If a directory is selected, return members, if any.
(setq fis
- (append (ewoc-collect cvs-cookies
- 'cvs-dir-member-p
- (cvs-fileinfo->dir fi))
+ (append (ewoc-collect
+ cvs-cookies 'cvs-dir-member-p (cvs-fileinfo->dir fi))
fis))))
(nreverse fis)))
-(defun* cvs-mode-marked (filter &optional (cmd (symbol-name filter))
- &key read-only one file)
+(defun* cvs-mode-marked (filter &optional cmd
+ &key read-only one file noquery)
"Get the list of marked FIS.
CMD is used to determine whether to use the marks or not.
Only files for which FILTER is applicable are returned.
If READ-ONLY is non-nil, the current toggling is left intact.
If ONE is non-nil, marks are ignored and a single FI is returned.
If FILE is non-nil, directory entries won't be selected."
+ (unless cmd (setq cmd (symbol-name filter)))
(let* ((fis (cvs-get-marked (or one (cvs-ignore-marks-p cmd read-only))
- (and (not file)
- (cvs-applicable-p 'DIRCHANGE filter))))
+ (and (not file)
+ (cvs-applicable-p 'DIRCHANGE filter))))
(force (cvs-prefix-get 'cvs-force-command))
(fis (car (cvs-partition
(lambda (fi) (cvs-applicable-p fi (and (not force) filter)))
fis))))
- (cond
- ((null fis)
- (error "`%s' is not applicable to any of the selected files." filter))
- ((and one (cdr fis))
- (error "`%s' is only applicable to a single file." cmd))
- (one (car fis))
- (t fis))))
+ (when (and (or (null fis) (and one (cdr fis))) (not noquery))
+ (message (if (null fis)
+ "`%s' is not applicable to any of the selected files."
+ "`%s' is only applicable to a single file.") cmd)
+ (sit-for 1)
+ (setq fis (list (cvs-insert-file
+ (read-file-name (format "File to %s: " cmd))))))
+ (if one (car fis) fis)))
(defun cvs-enabledp (filter)
"Determine whether FILTER applies to at least one of the selected files."
- (ignore-errors (cvs-mode-marked filter nil :read-only t)))
+ (ignore-errors (cvs-mode-marked filter nil :read-only t :noquery t)))
(defun cvs-mode-files (&rest -cvs-mode-files-args)
(cvs-mode!
(mapcar 'cvs-fileinfo->full-path
(apply 'cvs-mode-marked -cvs-mode-files-args)))))
-;;;
-;;; Interface between CVS-Edit and PCL-CVS
-;;;
+;;
+;; Interface between Log-Edit and PCL-CVS
+;;
(defun cvs-mode-commit-setup ()
"Run `cvs-mode-commit' with setup."
(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)
+ :group 'pcl-cvs)
+
(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.
The buffer's mode and name is determined by the \"message\" setting
of `cvs-buffer-name-alist'.
-The POSTPROC specified there (typically `cvs-edit') is then called,
+The POSTPROC specified there (typically `log-edit') is then called,
passing it the SETUP argument."
(interactive "P")
;; It seems that the save-excursion that happens if I use the better
;; form of `(cvs-mode! (lambda ...))' screws up a couple things which
- ;; end up being rather annoying (like cvs-edit-mode's message being
+ ;; end up being rather annoying (like log-edit-mode's message being
;; displayed in the wrong minibuffer).
(cvs-mode!)
- (pop-to-buffer (cvs-temp-buffer "message" 'normal 'nosetup))
- (set (make-local-variable 'cvs-minor-wrap-function) 'cvs-commit-minor-wrap)
- (let ((lbd list-buffers-directory)
- (setupfun (or (third (cdr (assoc "message" cvs-buffer-name-alist)))
- 'cvs-edit)))
- (funcall setupfun 'cvs-do-commit setup 'cvs-commit-filelist)
- (set (make-local-variable 'list-buffers-directory) lbd)))
+ (let ((buf (cvs-temp-buffer "message" 'normal 'nosetup))
+ (lbd list-buffers-directory)
+ (setupfun (or (nth 2 (cdr (assoc "message" cvs-buffer-name-alist)))
+ '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)
+ (run-hooks 'cvs-mode-commit-hook)))
(defun cvs-commit-minor-wrap (buf f)
(let ((cvs-ignore-marks-modif (cvs-mode-mark-get-modif "commit")))
(funcall f)))
-(defun cvs-commit-filelist () (cvs-mode-files 'commit nil :read-only t :file t))
+(defun cvs-commit-filelist ()
+ (cvs-mode-files 'commit nil :read-only t :file t :noquery t))
(defun cvs-do-commit (flags)
"Do the actual commit, using the current buffer as the log message."
(interactive (list (cvs-flags-query 'cvs-commit-flags "cvs commit flags")))
- (let ((msg (buffer-string)))
+ (let ((msg (buffer-substring-no-properties (point-min) (point-max))))
(cvs-mode!)
;;(pop-to-buffer cvs-buffer)
(cvs-mode-do "commit" (list* "-m" msg flags) 'commit)))
-;;;;
+;;;; Editing existing commit log messages.
+
+(defun cvs-edit-log-text-at-point ()
+ (save-excursion
+ (end-of-line)
+ (when (re-search-backward "^revision " nil t)
+ (forward-line 1)
+ (if (looking-at "date:") (forward-line 1))
+ (if (looking-at "branches:") (forward-line 1))
+ (buffer-substring
+ (point)
+ (if (re-search-forward
+ "^\\(-\\{28\\}\\|=\\{77\\}\\|revision [.0-9]+\\)$"
+ nil t)
+ (match-beginning 0)
+ (point))))))
+
+(defun cvs-mode-edit-log (rev &optional text)
+ "Edit the log message at point.
+This is best called from a `log-view-mode' buffer."
+ (interactive
+ (list
+ (or (cvs-mode! (lambda () (cvs-prefix-get 'cvs-branch-prefix)))
+ (read-string "Revision to edit: "))
+ (cvs-edit-log-text-at-point)))
+ ;; It seems that the save-excursion that happens if I use the better
+ ;; form of `(cvs-mode! (lambda ...))' screws up a couple things which
+ ;; end up being rather annoying (like log-edit-mode's message being
+ ;; displayed in the wrong minibuffer).
+ (cvs-mode!)
+ (let ((buf (cvs-temp-buffer "message" 'normal 'nosetup))
+ (lbd list-buffers-directory)
+ (setupfun (or (nth 2 (cdr (assoc "message" cvs-buffer-name-alist)))
+ 'log-edit)))
+ (funcall setupfun 'cvs-do-edit-log nil 'cvs-edit-log-filelist buf)
+ (when text (erase-buffer) (insert text))
+ (set (make-local-variable 'cvs-edit-log-revision) rev)
+ (set (make-local-variable 'cvs-minor-wrap-function) 'cvs-edit-log-minor-wrap)
+ (set (make-local-variable 'list-buffers-directory) lbd)
+ ;; (run-hooks 'cvs-mode-commit-hook)
+ ))
+
+(defun cvs-edit-log-minor-wrap (buf f)
+ (let ((cvs-ignore-marks-modif (cvs-mode-mark-get-modif "commit")))
+ (funcall f)))
+
+(defun cvs-edit-log-filelist ()
+ (cvs-mode-files nil nil :read-only t :file t :noquery t))
+
+(defun cvs-do-edit-log (rev)
+ "Do the actual commit, using the current buffer as the log message."
+ (interactive (list cvs-edit-log-revision))
+ (let ((msg (buffer-substring-no-properties (point-min) (point-max))))
+ (cvs-mode!)
+ (cvs-mode-do "admin" (list (concat "-m" rev ":" msg)) nil)))
+
+
+;;;;
;;;; CVS Mode commands
-;;;;
+;;;;
(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: " nil nil nil
- (ignore-errors
- (cvs-fileinfo->dir
- (car (cvs-mode-marked nil nil :read-only t)))))))
- (let ((file (file-relative-name (directory-file-name file))))
- (if (file-directory-p file)
- (let ((fi (cvs-create-fileinfo 'DIRCHANGE
- (file-name-as-directory file)
- "."
- "cvs-mode-insert")))
- (cvs-addto-collection cvs-cookies fi))
- (let ((fi (cvs-create-fileinfo 'UNKNOWN
- (or (file-name-directory file) "")
- (file-name-nondirectory file)
- "cvs-mode-insert")))
- (cvs-mode-run "status" (cvs-flags-query 'cvs-status-flags nil 'noquery)
- (list fi) :dont-change-disc t)))))
+ (list (read-file-name
+ "File to insert: "
+ ;; Can't use ignore-errors here because interactive
+ ;; specs aren't byte-compiled.
+ (condition-case nil
+ (file-name-as-directory
+ (expand-file-name
+ (cvs-fileinfo->dir
+ (cvs-mode-marked nil nil :read-only t :one t :noquery t))))
+ (error nil)))))
+ (cvs-insert-file file))
+
+(defun cvs-insert-file (file)
+ "Insert FILE (and its contents if it's a dir) and return its FI."
+ (let ((file (file-relative-name (directory-file-name file))) last)
+ (dolist (fi (cvs-fileinfo-from-entries file))
+ (setq last (cvs-addto-collection cvs-cookies fi last)))
+ ;; There should have been at least one entry.
+ (goto-char (ewoc-location last))
+ (ewoc-data last)))
+
+(defun cvs-mark-fis-dead (fis)
+ ;; Helper function, introduced because of the need for macro-expansion.
+ (dolist (fi fis)
+ (setf (cvs-fileinfo->type fi) 'DEAD)))
(defun-cvs-mode (cvs-mode-add . SIMPLE) (flags)
"Add marked files to the cvs repository.
`((cvs-run-process (list "-n" "update")
',dirs
'(cvs-parse-process t))
- (dolist (fi ',dirs) (setf (cvs-fileinfo->type fi) 'DEAD))))))
+ (cvs-mark-fis-dead ',dirs)))))
(cvs-mode-run "add" flags fis :postproc postproc))))
-;;----------
(defun-cvs-mode (cvs-mode-diff . DOUBLE) (flags)
"Diff the selected files against the repository.
This command compares the files in your working area against the
(cvs-mode-do "diff" flags 'diff
:show t)) ;; :ignore-exit t
-;;----------
(defun-cvs-mode (cvs-mode-diff-head . SIMPLE) (flags)
"Diff the selected files against the head of the current branch.
See ``cvs-mode-diff'' for more info."
(interactive (list (cvs-flags-query 'cvs-diff-flags "cvs diff flags")))
(cvs-mode-diff-1 (cons "-rHEAD" flags)))
-;;----------
(defun-cvs-mode (cvs-mode-diff-vendor . SIMPLE) (flags)
"Diff the selected files against the head of the vendor branch.
See ``cvs-mode-diff'' for more info."
(interactive (list (cvs-flags-query 'cvs-diff-flags "cvs diff flags")))
(cvs-mode-diff-1 (cons (concat "-r" cvs-vendor-branch) flags)))
-;;----------
;; sadly, this is not provided by cvs, so we have to roll our own
(defun-cvs-mode (cvs-mode-diff-backup . SIMPLE) (flags)
"Diff the files against the backup file.
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")))
;;(tins (cvs-filter-applicable filter marked))
- (fis (delete-if-not 'cvs-fileinfo->backup-file marked)))
+ (fis (car (cvs-partition 'cvs-fileinfo->backup-file marked))))
(unless (consp fis)
- (error "No files with a backup file selected!"))
+ (error "No files with a backup file selected!"))
;; let's extract some info into the environment for `buffer-name'
(let* ((dir (cvs-fileinfo->dir (car fis)))
(file (cvs-fileinfo->file (car fis))))
cvs-diff-program flags))
(message "cvs diff backup... Done."))
-;;----------
-;; (defun cvs-backup-diffable-p (fi)
-;; "Check if the TIN is backup-diffable.
-;; It must have a backup file to be diffable."
-;; (cvs-fileinfo->backup-file fi))
-
-;;----------
(defun cvs-diff-backup-extractor (fileinfo)
"Return the filename and the name of the backup file as a list.
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)))
- (list backup-file (cvs-fileinfo->file fileinfo))))
+ (error "%s has no backup file" (cvs-fileinfo->full-path fileinfo)))
+ (list backup-file (cvs-fileinfo->full-path fileinfo))))
;;
;; Emerge support
;;
;; Ediff support
-;;
+;;
(defvar ediff-after-quit-destination-buffer)
(defvar cvs-transient-buffers)
(dolist (tb tmp-bufs)
(when (and tb (buffer-live-p tb) (not (buffer-modified-p tb)))
(let ((win (get-buffer-window tb t)))
- (when win (delete-window win))
- (kill-buffer tb))))
+ (kill-buffer tb)
+ (when (window-live-p win) (ignore-errors (delete-window win))))))
;; switch back to the *cvs* buffer
(when (and cvs-buf (buffer-live-p cvs-buf)
(not (get-buffer-window cvs-buf t)))
(defun cvs-ediff-diff (b1 b2)
(let ((ediff-after-quit-destination-buffer (current-buffer))
(startup-hook '(cvs-ediff-startup-hook)))
- (ediff-buffers b1 b2 startup-hook 'ediff-revisions)))
+ (ediff-buffers b1 b2 startup-hook 'ediff-revision)))
(defun cvs-ediff-merge (b1 b2 base out)
(let ((ediff-after-quit-destination-buffer (current-buffer))
(defun cvs-retrieve-revision (fileinfo rev)
"Retrieve the given REVision of the file in FILEINFO into a new buffer."
- (save-excursion
- (let* ((file (cvs-fileinfo->full-path fileinfo))
- (buf (create-file-buffer (concat file "." rev))))
- (set-buffer buf)
- (message "Retrieving revision %s..." rev)
- (let ((res (call-process cvs-program nil t nil
- "-q" "update" "-p" "-r" rev file)))
- (when (and res (not (and (equal 0 res))))
- (error "Something went wrong retrieving revision %s: %s" rev res))
- (set-buffer-modified-p nil)
- (let ((buffer-file-name (expand-file-name file)))
- (after-find-file))
- (toggle-read-only 1)
- (message "Retrieving revision %s... Done" rev)
- buf))))
-
-(eval-and-compile (autoload 'vc-resolve-conflicts "vc"))
+ (let* ((file (cvs-fileinfo->full-path fileinfo))
+ (buffile (concat file "." rev)))
+ (or (find-buffer-visiting buffile)
+ (with-current-buffer (create-file-buffer buffile)
+ (message "Retrieving revision %s..." rev)
+ (let ((res (call-process cvs-program nil t nil
+ "-q" "update" "-p" "-r" rev file)))
+ (when (and res (not (and (equal 0 res))))
+ (error "Something went wrong retrieving revision %s: %s" rev res))
+ (set-buffer-modified-p nil)
+ (let ((buffer-file-name (expand-file-name file)))
+ (after-find-file))
+ (toggle-read-only 1)
+ (message "Retrieving revision %s... Done" rev)
+ (current-buffer))))))
+
+(eval-and-compile (autoload 'smerge-ediff "smerge-mode"))
+;; FIXME: The user should be able to specify ancestor/head/backup and we should
+;; provide sensible defaults when merge info is unavailable (rather than rely
+;; on smerge-ediff). Also provide sane defaults for need-merge files.
(defun-cvs-mode cvs-mode-imerge ()
"Merge interactively appropriate revisions of the selected file."
(interactive)
(if (not (and merge backup-file))
(let ((buf (find-file-noselect file)))
(message "Missing merge info or backup file, using VC.")
- (save-excursion
- (set-buffer buf)
- (vc-resolve-conflicts)))
+ (with-current-buffer buf
+ (smerge-ediff)))
(let* ((ancestor-buf (cvs-retrieve-revision fi (car merge)))
(head-buf (cvs-retrieve-revision fi (cdr merge)))
(backup-buf (let ((auto-mode-alist nil))
(rev2-buf (if rev2 (cvs-retrieve-revision fi rev2)))
;; this binding is used by cvs-ediff-startup-hook
(cvs-transient-buffers (list rev1-buf rev2-buf)))
- (funcall (car cvs-idiff-imerge-handlers)
- rev1-buf (or rev2-buf (find-file-noselect file))))))
+ (funcall (car cvs-idiff-imerge-handlers)
+ rev1-buf (or rev2-buf (find-file-noselect file))))))
(defun-cvs-mode (cvs-mode-idiff-other . NOARGS) ()
"Diff interactively current file to revisions."
(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."))
- (let* ((fi1 (first fis))
+ (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))))
rev2-buf)
(if (cdr fis)
- (let ((fi2 (second fis)))
+ (let ((fi2 (nth 1 fis)))
(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)
rev1-buf rev2-buf)))))
-(defun cvs-fileinfo-kill (c fi)
- "Mark a fileinfo xor its members (in case of a directory) as dead."
- (if (eq (cvs-fileinfo->type fi) 'DIRCHANGE)
- (dolist (fi (ewoc-collect c 'cvs-dir-member-p
- (cvs-fileinfo->dir fi)))
- (setf (cvs-fileinfo->type fi) 'DEAD))
- (setf (cvs-fileinfo->type fi) 'DEAD)))
-
(defun cvs-is-within-p (fis dir)
"Non-nil is buffer is inside one of FIS (in DIR)."
(when (stringp buffer-file-name)
;; Save the relevant buffers
(save-some-buffers nil (lambda () (cvs-is-within-p fis def-dir))))
(unless (listp flags) (error "flags should be a list of strings"))
+ ;; Some w32 versions of CVS don't like an explicit . too much.
+ (when (and (car fis) (null (cdr fis))
+ (eq (cvs-fileinfo->type (car fis)) 'DIRCHANGE)
+ ;; (equal (cvs-fileinfo->file (car fis)) ".")
+ (equal (cvs-fileinfo->dir (car fis)) ""))
+ (setq fis nil))
(let* ((cvs-buf (current-buffer))
(single-dir (or (not (listp cvs-execute-single-dir))
(member cmd cvs-execute-single-dir)))
(parse (member cmd cvs-parse-known-commands))
(args (append cvsargs (list cmd) flags))
- (after-mode (third (cdr (assoc cmd cvs-buffer-name-alist)))))
+ (after-mode (nth 2 (cdr (assoc cmd cvs-buffer-name-alist)))))
(cvs-cleanup-collection cvs-cookies ;cleanup remaining messages
(eq cvs-auto-remove-handled 'delayed) nil t)
(when (fboundp after-mode)
(setq postproc (append postproc `((,after-mode)))))
- (when parse (push `(cvs-parse-process ',dont-change-disc) postproc))
- (when (member cmd '("status" "update")) ;FIXME: Yuck!!
- ;; absence of `cvs update' output has a specific meaning.
- (push
- `(dolist (fi ',(or fis
- (list (cvs-create-fileinfo 'DIRCHANGE "" "." ""))))
- (cvs-fileinfo-kill ',cvs-cookies fi))
- postproc))
+ (when parse
+ (let ((old-fis
+ (when (member cmd '("status" "update")) ;FIXME: Yuck!!
+ ;; absence of `cvs update' output has a specific meaning.
+ (or fis (list (cvs-create-fileinfo 'DIRCHANGE "" "." ""))))))
+ (push `(cvs-parse-process ',dont-change-disc nil ',old-fis) postproc)))
(setq postproc (if (cdr postproc) (cons 'progn postproc) (car postproc)))
(cvs-update-header args fis)
(with-current-buffer buf
(cvs-mode-run "status" (cons "-v" flags) (cvs-mode-marked nil "status")
:buf (cvs-temp-buffer "tree")
:dont-change-disc t
- :postproc '((cvs-status-trees))))
+ :postproc '((cvs-status-cvstrees))))
;; cvs log
(when (ignore-errors
(and buffer-read-only
(eq 'CVS (vc-backend buffer-file-name))
- (not (if (fboundp 'vc-editable-p)
- (vc-editable-p buffer-file-name)
- (vc-locking-user buffer-file-name)))))
+ (not (vc-editable-p buffer-file-name))))
;; CVSREAD=on special case
(vc-toggle-read-only))
(goto-char (point-max))
(cvs-mode-find-file e t))
+(defun cvs-mode-display-file (e)
+ "Show a buffer containing the file in another window."
+ (interactive (list last-input-event))
+ (cvs-mode-find-file e 'dont-select))
+
+
(defun cvs-find-modif (fi)
(with-temp-buffer
(call-process cvs-program nil (current-buffer) nil
"Select a buffer containing the file.
With a prefix, opens the buffer in an OTHER window."
(interactive (list last-input-event current-prefix-arg))
- (ignore-errors (mouse-set-point e)) ;for invocation via the mouse
+ (when (ignore-errors (mouse-set-point e) t) ;for invocation via the mouse
+ (unless (memq (get-text-property (1- (line-end-position)) 'font-lock-face)
+ '(cvs-header-face cvs-filename-face))
+ (error "Not a file name")))
(cvs-mode!
(lambda (&optional rev)
(interactive (list (cvs-prefix-get 'cvs-branch-prefix)))
(let ((odir default-directory))
(setq default-directory
(cvs-expand-dir-name (cvs-fileinfo->dir fi)))
- (if other
- (dired-other-window default-directory)
- (dired default-directory))
+ (cond ((eq other 'dont-select)
+ (display-buffer (find-file-noselect default-directory)))
+ (other (dired-other-window default-directory))
+ (t (dired default-directory)))
(set-buffer cvs-buf)
(setq default-directory odir))
(let ((buf (if rev (cvs-retrieve-revision fi rev)
(find-file-noselect (cvs-fileinfo->full-path fi)))))
- (funcall (if other 'switch-to-buffer-other-window 'switch-to-buffer)
+ (funcall (cond ((eq other 'dont-select) 'display-buffer)
+ (other 'switch-to-buffer-other-window)
+ (t 'switch-to-buffer))
buf)
(when (and cvs-find-file-and-jump (cvs-applicable-p fi 'diff-base))
(goto-line (cvs-find-modif fi)))
(interactive (list nil));; (cvs-flags-query 'cvs-undo-flags "undo flags")
(if current-prefix-arg (call-interactively 'cvs-mode-revert-to-rev)
(let* ((fis (cvs-do-removal 'undo "update" 'all))
- (removedp (lambda (fi) (eq (cvs-fileinfo->type fi) 'REMOVED)))
+ (removedp (lambda (fi)
+ (or (eq (cvs-fileinfo->type fi) 'REMOVED)
+ (and (eq (cvs-fileinfo->type fi) 'CONFLICT)
+ (eq (cvs-fileinfo->subtype fi) 'REMOVED)))))
(fis-split (cvs-partition removedp fis))
(fis-removed (car fis-split))
(fis-other (cdr fis-split)))
(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))
(setf (cvs-fileinfo->type fi) 'DEAD))
(cvs-cleanup-collection cvs-cookies nil nil nil))
-;;----------
-(defun cvs-insert-full-path (tin)
- "Insert full path to the file described in TIN in the current buffer."
- (insert (format "%s\n" (cvs-full-path tin))))
-
(defun cvs-do-removal (filter &optional cmd all)
"Remove files.
Returns a list of FIS that should be `cvs remove'd."
(let* ((files (cvs-mode-marked filter cmd :file t :read-only t))
- (fis (delete-if (lambda (fi) (eq (cvs-fileinfo->type fi) 'UNKNOWN))
- (cvs-mode-marked filter cmd)))
+ (fis (cdr (cvs-partition (lambda (fi)
+ (eq (cvs-fileinfo->type fi) 'UNKNOWN))
+ (cvs-mode-marked filter cmd))))
(silent (or (not cvs-confirm-removals)
(cvs-every (lambda (fi)
(or (not (file-exists-p
(cvs-fileinfo->full-path fi)))
(cvs-applicable-p fi 'safe-rm)))
- files))))
+ files)))
+ (tmpbuf (cvs-temp-buffer)))
(when (and (not silent) (equal cvs-confirm-removals 'list))
- (save-excursion
- (pop-to-buffer (cvs-temp-buffer))
- (dolist (fi fis)
- (insert (cvs-fileinfo->full-path fi) "\n"))))
+ (with-current-buffer tmpbuf
+ (let ((inhibit-read-only t))
+ (cvs-insert-strings (mapcar 'cvs-fileinfo->full-path fis))
+ (cvs-pop-to-buffer-same-frame (current-buffer))
+ (shrink-window-if-larger-than-buffer))))
(if (not (or silent
- (yes-or-no-p (format "Delete %d files? " (length files)))))
+ (unwind-protect
+ (yes-or-no-p (format "Delete %d files? " (length files)))
+ (cvs-bury-buffer tmpbuf cvs-buffer))))
(progn (message "Aborting") nil)
(dolist (fi files)
(let* ((type (cvs-fileinfo->type fi))
(cvs-flags-query 'cvs-tag-flags "tag flags")))
(cvs-mode-do "tag" (append '("-d") flags (list tag))
(when cvs-force-dir-tag 'tag)))
-
+
;; Byte compile files.
;; ChangeLog support.
-;;----------
(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))))
- ;; This `save-excursion' is necessary because of interaction between
- ;; dynamic scoping and buffer-local variables:
- ;; the above binding of `buffer-file-name' has temporarily changed the
- ;; buffer-local variable (same thing for `default-directory'), so we
- ;; need to switch back to the original buffer before the unbinding
- ;; restores the old value.
- (save-excursion (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)))
;;;; Utilities for the *cvs* buffer
;;;;
-;;----------
-(defun cvs-full-path (tin)
- "Return the full path for the file that is described in TIN."
- (cvs-fileinfo->full-path (ewoc-data tin)))
-
-;;----------
(defun cvs-dir-member-p (fileinfo dir)
"Return true if FILEINFO represents a file in directory DIR."
(and (not (eq (cvs-fileinfo->type fileinfo) 'DIRCHANGE))
(defun cvs-execute-single-file (fi extractor program constant-args)
"Internal function for `cvs-execute-single-file-list'."
- (let* ((cur-dir (cvs-fileinfo->dir fi))
- (default-directory (cvs-expand-dir-name cur-dir))
- (inhibit-read-only t)
- (arg-list (funcall extractor fi)))
-
+ (let* ((arg-list (funcall extractor fi))
+ (inhibit-read-only t))
+
;; Execute the command unless extractor returned t.
(when (listp arg-list)
(let* ((args (append constant-args arg-list)))
-
- (insert (format "=== cd %s\n=== %s %s\n\n"
- cur-dir program (cvs-strings->string args)))
-
+
+ (insert (format "=== %s %s\n\n"
+ program (cvs-strings->string args)))
+
;; FIXME: return the exit status?
(apply 'call-process program nil t t args)
(goto-char (point-max))))))
;; FIXME: make this run in the background ala cvs-run-process...
(defun cvs-execute-single-file-list (fis extractor program constant-args)
"Run PROGRAM on all elements on FIS.
-The PROGRAM will be called with pwd set to the directory the files
-reside in. CONSTANT-ARGS is a list of strings to pass as arguments to
-PROGRAM. The arguments given to the program will be CONSTANT-ARGS
-followed by the list that EXTRACTOR returns.
+CONSTANT-ARGS is a list of strings to pass as arguments to PROGRAM.
+The arguments given to the program will be CONSTANT-ARGS followed by
+the list that EXTRACTOR returns.
EXTRACTOR will be called once for each file on FIS. It is given
one argument, the cvs-fileinfo. It can return t, which means ignore
;; read-write changes) which is not changed by `commit'.
(buffer-modified-p buffer))
(with-current-buffer buffer
- (let ((cvs-buf-was-ro buffer-read-only))
- (ignore-errors
- ;; Ideally, we'd like to prevent changing the (minor) modes.
- ;; But we do want to reset the mode for some cases, most notably
- ;; VC. Maybe it'd better to reset VC explicitely ?
- (revert-buffer 'ignore-auto 'dont-ask)) ; 'preserve-modes
- ;; protect the buffer-read-only setting
- (if cvs-buf-was-ro (toggle-read-only 1))))))))
-
+ (ignore-errors
+ (revert-buffer 'ignore-auto 'dont-ask 'preserve-modes)
+ ;; `preserve-modes' avoids changing the (minor) modes. But we
+ ;; do want to reset the mode for VC, so we do it explicitly.
+ (vc-find-file-hook)
+ (when (eq (cvs-fileinfo->type fileinfo) 'CONFLICT)
+ (smerge-mode 1))))))))
\f
(defun cvs-change-cvsroot (newroot)
;; Hook to allow calling PCL-CVS by visiting the /CVS subdirectory
;;
+;;;###autoload
+(defcustom cvs-dired-action 'cvs-quickdir
+ "The action to be performed when opening a CVS directory.
+Sensible values are `cvs-examine', `cvs-status' and `cvs-quickdir'."
+ :group 'pcl-cvs
+ :type '(choice (const cvs-examine) (const cvs-status) (const cvs-quickdir)))
+
;;;###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."
(not current-prefix-arg)
(equal current-prefix-arg cvs-dired-use-hook)))
(save-excursion
- (cvs-examine (file-name-directory dir) t t))))))
+ (funcall cvs-dired-action (file-name-directory dir) t t))))))
;;
;; hook into VC
;;
-(defadvice vc-simple-command (after pcl-cvs-vc activate)
- (cvs-vc-command-advice "*vc-info*" (ad-get-arg 1) (ad-get-arg 3)))
-
-(defadvice vc-do-command (after pcl-cvs-vc activate)
- (cvs-vc-command-advice (if (eq t (ad-get-arg 0)) (current-buffer)
- (or (ad-get-arg 0) "*vc*"))
- (ad-get-arg 2)
- (if (stringp (ad-get-arg 4))
- (ad-get-arg 4)
- (ad-get-arg 5))))
-
-(defun cvs-vc-command-advice (buffer command cvscmd)
- (when (and (setq buffer (get-buffer buffer))
- (equal command "cvs")
- ;; don't parse output we don't understand.
- (member cvscmd cvs-parse-known-commands))
- (save-excursion
- (let ((dir (with-current-buffer buffer default-directory))
+(add-hook 'vc-post-command-functions 'cvs-vc-command-advice)
+
+(defun cvs-vc-command-advice (command file flags)
+ (when (and (equal command "cvs")
+ (progn
+ (while (and (stringp (car flags))
+ (string-match "\\`-" (car flags)))
+ (pop flags))
+ ;; don't parse output we don't understand.
+ (member (car flags) cvs-parse-known-commands)))
+ (save-current-buffer
+ (let ((buffer (current-buffer))
+ (dir default-directory)
(cvs-from-vc t))
(dolist (cvs-buf (buffer-list))
(set-buffer cvs-buf)
(let ((subdir (substring dir (length default-directory))))
(set-buffer buffer)
(set (make-local-variable 'cvs-buffer) cvs-buf)
+ ;; `cvs -q add file' produces no useful output :-(
+ (when (and (equal (car flags) "add")
+ (goto-char (point-min))
+ (looking-at ".*to add this file permanently\n\\'"))
+ (insert "cvs add: scheduling file `"
+ (file-name-nondirectory file)
+ "' for addition\n"))
;; VC never (?) does `cvs -n update' so dcd=nil
;; should probably always be the right choice.
(cvs-parse-process nil subdir))))))))
(add-hook 'after-save-hook 'cvs-mark-buffer-changed)
-;;
-;; hook into uniquify
-;;
-
-(defadvice uniquify-buffer-file-name (after pcl-cvs-uniquify activate)
- (or ad-return-value
- (save-excursion
- (set-buffer (ad-get-arg 0))
- (when (eq major-mode 'cvs-mode)
- (setq ad-return-value list-buffers-directory)))))
-
\f
(provide 'pcvs)