X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/e7cff5504bbbbd5bab5482101c648f1ea7624ef8..483bdbb35b7760344f8889a2ddb72bd68b35b201:/lisp/pcvs.el
diff --git a/lisp/pcvs.el b/lisp/pcvs.el
index 97785a6362..50cad7e7c1 100644
--- a/lisp/pcvs.el
+++ b/lisp/pcvs.el
@@ -1,6 +1,7 @@
-;;; 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.
+;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: (The PCL-CVS Trust) pcl-cvs@cyclic.com
;; (Per Cederqvist) ceder@lysator.liu.se
@@ -11,10 +12,8 @@
;; (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
+;; Maintainer: (Stefan Monnier) monnier@gnu.org
;; Keywords: CVS, version control, release management
-;; Version: $Name: $
-;; Revision: $Id: pcvs.el,v 1.18 2000/11/21 20:47:49 monnier Exp $
;; This file is part of GNU Emacs.
@@ -30,8 +29,8 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
@@ -52,11 +51,16 @@
;; To use PCL-CVS just use `M-x cvs-examine RET
RET'.
;; 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 *********
-;;
-;; - use UP-TO-DATE rather than DEAD when cleaning before `examine'.
+;;
+;; - 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
@@ -67,12 +71,14 @@
;; - 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.
+;; 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.
@@ -92,7 +98,6 @@
;; - 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.
;; - 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.
@@ -167,22 +172,26 @@
(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 (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)
@@ -192,13 +201,15 @@
;;;; Mouse bindings and mode motion
;;;;
+(defvar cvs-minor-current-files)
+
(defun cvs-menu (e)
"Popup the CVS menu."
(interactive "e")
(let ((cvs-minor-current-files
(list (ewoc-data (ewoc-locate
cvs-cookies (posn-point (event-end e)))))))
- (popup-menu cvs-menu-map e)))
+ (popup-menu cvs-menu e)))
(defvar cvs-mode-line-process nil
"Mode-line control for displaying info on cvs process status.")
@@ -222,7 +233,7 @@
nil ;don't update display while running
"status"
"-v"
- (cvs-fileinfo->full-path (car marked)))
+ (cvs-fileinfo->full-name (car marked)))
(goto-char (point-min))
(let ((tags (cvs-status-get-tags)))
(when (listp tags) tags)))))))
@@ -233,18 +244,15 @@
;;;;
-(defun cvs-mode! (&optional -cvs-mode!-fun -cvs-mode!-noerror)
+(defun cvs-mode! (&optional -cvs-mode!-fun)
"Switch to the *cvs* buffer.
If -CVS-MODE!-FUN is provided, it is executed *cvs* being the current buffer
and with its window selected. Else, the *cvs* buffer is simply selected.
-If -CVS-MODE!-NOERROR is non-nil, then failure to find a *cvs* buffer does
- not generate an error and the current buffer is kept selected.
-CVS-MODE!-FUN is called interactively if applicable and else with no argument."
(let* ((-cvs-mode!-buf (current-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
@@ -328,7 +336,8 @@ the primay since reading the primary can deactivate it."
"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")
+ nil " CVS"
+ :group 'pcl-cvs)
(put 'cvs-minor-mode 'permanent-local t)
@@ -349,7 +358,7 @@ from the current buffer."
(dir default-directory)
(buf (cond
(name (cvs-get-buffer-create name))
- ((and (bufferp cvs-temp-buffer) (buffer-name cvs-temp-buffer))
+ ((and (bufferp cvs-temp-buffer) (buffer-live-p cvs-temp-buffer))
cvs-temp-buffer)
(t
(set (make-local-variable 'cvs-temp-buffer)
@@ -360,7 +369,14 @@ from the current buffer."
(let ((proc (get-buffer-process buf)))
(when (and (not normal) (processp proc)
(memq (process-status proc) '(run stop)))
- (error "Can not run two cvs processes simultaneously")))
+ (if cmd
+ ;; When CMD is specified, the buffer is normally shown to the
+ ;; user, so interrupting the process is not harmful.
+ ;; Use `delete-process' rather than `kill-process' otherwise
+ ;; the pending output of the process will still get inserted
+ ;; after we erase the buffer.
+ (delete-process proc)
+ (error "Can not run two cvs processes simultaneously"))))
(if (not name) (kill-local-variable 'other-window-scroll-buffer)
;; Strangely, if no window is created, `display-buffer' ends up
@@ -380,7 +396,9 @@ from the current buffer."
(set (make-local-variable 'cvs-buffer) cvs-buf)
;;(cvs-minor-mode 1)
(let ((lbd list-buffers-directory))
- (if (fboundp mode) (funcall mode) (fundamental-mode))
+ (if (fboundp mode) (funcall mode)
+ (fundamental-mode)
+ (buffer-disable-undo))
(when lbd (set (make-local-variable 'list-buffers-directory) lbd)))
(cvs-minor-mode 1)
;;(set (make-local-variable 'cvs-buffer) cvs-buf)
@@ -435,17 +453,23 @@ If non-nil, NEW means to create a new buffer no matter what."
(setq default-directory dir)
(setq buffer-read-only nil)
(erase-buffer)
- (insert "\
-Repository : " (directory-file-name (cvs-get-cvsroot)) "
-Module : " (cvs-get-module) "
-Working dir: " (abbreviate-file-name dir) "
-
-")
+ (insert "Repository : " (directory-file-name (cvs-get-cvsroot))
+ "\nModule : " (cvs-get-module)
+ "\nWorking dir: " (abbreviate-file-name dir)
+ (if (not (file-readable-p "CVS/Tag")) "\n"
+ (let ((tag (cvs-file-to-string "CVS/Tag")))
+ (cond
+ ((string-match "\\`T" tag)
+ (concat "\nTag : " (substring tag 1)))
+ ((string-match "\\`D" tag)
+ (concat "\nDate : " (substring tag 1)))
+ ("\n"))))
+ "\n")
(setq buffer-read-only t)
(cvs-mode)
(set (make-local-variable 'list-buffers-directory) buffer-name)
;;(set (make-local-variable 'cvs-temp-buffer) (cvs-temp-buffer))
- (let ((cookies (ewoc-create 'cvs-fileinfo-pp "\n" "")))
+ (let ((cookies (ewoc-create 'cvs-fileinfo-pp "\n\n" "\n" t)))
(set (make-local-variable 'cvs-cookies) cookies)
(add-hook 'kill-buffer-hook
(lambda ()
@@ -462,7 +486,8 @@ Working dir: " (abbreviate-file-name dir) "
;; 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)
@@ -489,7 +514,7 @@ Working dir: " (abbreviate-file-name dir) "
(let* ((dir+files+rest
(if (or (null fis) (not single-dir))
;; not single-dir mode: just process the whole thing
- (list "" (mapcar 'cvs-fileinfo->full-path fis) nil)
+ (list "" (mapcar 'cvs-fileinfo->full-name fis) nil)
;; single-dir mode: extract the same-dir-elements
(let ((dir (cvs-fileinfo->dir (car fis))))
;; output the concerned dir so the parser can translate paths
@@ -505,32 +530,49 @@ Working dir: " (abbreviate-file-name dir) "
(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)
- ;; this is the last invocation
- postprocess
- ;; else, we have to register ourselves to be rerun on the rest
- `(cvs-run-process ',args ',rest ',postprocess ',single-dir)))
(add-hook 'kill-buffer-hook
(lambda ()
(let ((proc (get-buffer-process (current-buffer))))
(when (processp proc)
(set-process-filter proc nil)
- (set-process-sentinel proc nil)
- (delete-process proc))))
+ ;; Abort postprocessing but leave the sentinel so it
+ ;; will update the list of running procs.
+ (process-put proc 'cvs-postprocess nil)
+ (interrupt-process proc))))
nil t)
;; create the new process and setup the procbuffer correspondingly
- (let* ((args (append (cvs-flags-query 'cvs-cvs-flags nil 'noquery)
+ (let* ((msg (cvs-header-msg args fis))
+ (args (append (cvs-flags-query 'cvs-cvs-flags nil 'noquery)
(if cvs-cvsroot (list "-d" cvs-cvsroot))
args
files))
+ ;; 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 (but it can also happens
+ ;; under Mac OS X, it seems).
+ ;; It seems that using a pty can help circumvent the problem,
+ ;; but at the cost of screwing up when the process thinks it
+ ;; can ask for user input (such as password or host-key
+ ;; confirmation). A better workaround is to set CVS_RSH to
+ ;; an appropriate script, or to use a later version of CVS.
(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)))
(apply 'start-process "cvs" procbuf cvs-program args))))
+ ;; setup the process.
+ (process-put process 'cvs-buffer cvs-buffer)
+ (with-current-buffer cvs-buffer (cvs-update-header msg 'add))
+ (process-put process 'cvs-header msg)
+ (process-put
+ process 'cvs-postprocess
+ (if (null rest)
+ ;; this is the last invocation
+ postprocess
+ ;; else, we have to register ourselves to be rerun on the rest
+ `(cvs-run-process ',args ',rest ',postprocess ',single-dir)))
(set-process-sentinel process 'cvs-sentinel)
(set-process-filter process 'cvs-update-filter)
(set-marker (process-mark process) (point-max))
@@ -545,50 +587,63 @@ Working dir: " (abbreviate-file-name dir) "
;; emacsen. It shouldn't be needed, but it does no harm.
(sit-for 0))
-(defun cvs-update-header (args fis) ; inline
+(defun cvs-header-msg (args fis)
(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) "")
+ ;; 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) ""))
+ ;; Keep the rest as is.
(t arg)))
- args))
- ;; turn them into a string
- (arg (cvs-strings->string
- (append (cvs-flags-query 'cvs-cvs-flags nil 'noquery)
- (if cvs-cvsroot (list "-d" cvs-cvsroot))
- args
- (mapcar 'cvs-fileinfo->full-path fis))))
- (str (if args (concat "-- Running " cvs-program " " arg " ...\n")
- "\n")))
- (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))))))
+ args)))
+ (concat cvs-program " "
+ (strings->string
+ (append (cvs-flags-query 'cvs-cvs-flags nil 'noquery)
+ (if cvs-cvsroot (list "-d" cvs-cvsroot))
+ args
+ (mapcar 'cvs-fileinfo->full-name fis))))))
+
+(defun cvs-update-header (cmd add)
+ (let* ((hf (ewoc-get-hf cvs-cookies))
+ (str (car hf))
+ (done "")
+ (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)))
+ (if add
+ (progn
+ ;; Remove the default empty line, if applicable.
+ (if (not (string-match "." str)) (setq str "\n"))
+ (setq str (concat "-- Running " cmd " ...\n" str)))
+ (if (not (string-match
+ (concat "^-- Running " (regexp-quote cmd) " \\.\\.\\.\n") str))
+ (error "Internal PCL-CVS error while removing message")
+ (setq str (replace-match "" t t str))
+ ;; Re-add the default empty line, if applicable.
+ (if (not (string-match "." str)) (setq str "\n\n"))
+ (setq done (concat "-- last cmd: " cmd " --\n"))))
+ ;; set the new header and footer
+ (ewoc-set-hf cvs-cookies
+ str (concat "\n--------------------- "
+ (if tin "End" "Empty")
+ " ---------------------\n"
+ done))))
(defun cvs-sentinel (proc msg)
@@ -596,56 +651,89 @@ Working dir: " (abbreviate-file-name dir) "
This is responsible for parsing the output from the cvs update when
it is finished."
(when (memq (process-status proc) '(signal exit))
- (if (null (buffer-name (process-buffer proc)))
- ;;(set-process-buffer proc nil)
- (error "cvs' process buffer was killed")
- (let* ((obuf (current-buffer))
- (procbuffer (process-buffer proc)))
- (set-buffer (with-current-buffer procbuffer cvs-buffer))
- (setq cvs-mode-line-process (symbol-name (process-status proc)))
- (force-mode-line-update)
- (set-buffer procbuffer)
- (let ((cvs-postproc cvs-postprocess))
- ;; Since the buffer and mode line will show that the
- ;; process is dead, we can delete it now. Otherwise it
- ;; will stay around until M-x list-processes.
- (delete-process proc)
- (setq cvs-postprocess nil)
- ;; do the postprocessing like parsing and such
- (save-excursion (eval cvs-postproc))
- ;; check whether something is left
- (unless cvs-postprocess
- (buffer-enable-undo)
- (with-current-buffer cvs-buffer
- (cvs-update-header nil nil) ;FIXME: might need to be inline
- (message "CVS process has completed"))))
- ;; 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)))
+ (let ((cvs-postproc (process-get proc 'cvs-postprocess))
+ (cvs-buf (process-get proc 'cvs-buffer))
+ (procbuf (process-buffer proc)))
+ (unless (buffer-live-p cvs-buf) (setq cvs-buf nil))
+ (unless (buffer-live-p procbuf) (setq procbuf nil))
+ ;; Since the buffer and mode line will show that the
+ ;; process is dead, we can delete it now. Otherwise it
+ ;; will stay around until M-x list-processes.
+ (process-put proc 'postprocess nil)
+ (delete-process proc)
+ ;; Don't do anything if the main buffer doesn't exist any more.
+ (when cvs-buf
+ (with-current-buffer cvs-buf
+ (cvs-update-header (process-get proc 'cvs-header) nil)
+ (setq cvs-mode-line-process (symbol-name (process-status proc)))
+ (force-mode-line-update)
+ (when cvs-postproc
+ (if (null procbuf)
+ ;;(set-process-buffer proc nil)
+ (error "cvs' process buffer was killed")
+ (with-current-buffer procbuf
+ ;; Do the postprocessing like parsing and such.
+ (save-excursion (eval cvs-postproc)))))))
+ ;; Check whether something is left.
+ (when (and procbuf (not (get-buffer-process procbuf)))
+ (with-current-buffer procbuf
+ ;; 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 (or cvs-buf (current-buffer))
+ (message "CVS process has completed in %s"
+ (buffer-name))))))))
+
+(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."
+ (when (eq system-type 'darwin)
+ ;; Fixup the ^D^H^H inserted at beginning of buffer sometimes on MacOSX
+ ;; because of the call to `process-send-eof'.
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "^\\^D+" nil t)
+ (let ((inhibit-read-only t))
+ (delete-region (match-beginning 0) (match-end 0))))))
+ (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.
@@ -665,6 +753,7 @@ clear what alternative to use.
- 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
@@ -684,7 +773,6 @@ clear what alternative to use.
((eq style 'DOUBLE)
(string-match ".*" docstring)
(let ((line1 (match-string 0 docstring))
- (restdoc (substring docstring (match-end 0)))
(fun-1 (intern (concat (symbol-name fun) "-1"))))
`(progn
(defun ,fun-1 ,args
@@ -692,25 +780,25 @@ clear what alternative to use.
For interactive use, use `" (symbol-name fun) "' instead.")
,interact
,@body)
+ (put ',fun-1 'definition-name ',fun)
(defun ,fun ()
,(concat line1 "\nWrapper function that switches to a *cvs* buffer
before calling the real function `" (symbol-name fun-1) "'.\n")
(interactive)
(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))
+ (t (error "Unknown style %s in `defun-cvs-mode'" style)))))
(defun-cvs-mode cvs-mode-kill-process ()
"Kill the temporary buffer and associated process."
(interactive)
- (when (and (bufferp cvs-temp-buffer) (buffer-name cvs-temp-buffer))
+ (when (and (bufferp cvs-temp-buffer) (buffer-live-p cvs-temp-buffer))
(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 FI's corresponding tin.
@@ -726,12 +814,15 @@ TIN specifies an optional starting point."
(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)
+ ;; Move cursor back to where it belongs.
+ (when (bolp) (cvs-move-to-goal-column))
tin))))
(defcustom cvs-cleanup-functions nil
@@ -750,7 +841,7 @@ 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))))
+ (file-exists-p (cvs-fileinfo->full-name fi))))
;; called at the following times:
;; - postparse ((eq cvs-auto-remove-handled t) cvs-auto-remove-directories nil)
@@ -837,24 +928,44 @@ This usually doesn't really work but is a handy initval in a prompt."
;;;;
;;;###autoload
-(defun cvs-checkout (modules dir flags)
+(defun cvs-checkout (modules dir flags &optional root)
"Run a 'cvs checkout MODULES' in DIR.
Feed the output to a *cvs* buffer, display it in the current window,
and run `cvs-mode' on it.
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: "
- nil default-directory nil)
- (cvs-add-branch-prefix
- (cvs-flags-query 'cvs-checkout-flags "cvs checkout flags"))))
+ (let ((root (cvs-get-cvsroot)))
+ (if (or (null root) current-prefix-arg)
+ (setq root (read-string "CVS Root: ")))
+ (list (string->strings (read-string "Module(s): " (cvs-get-module)))
+ (read-directory-name "CVS Checkout Directory: "
+ nil default-directory nil)
+ (cvs-add-branch-prefix
+ (cvs-flags-query 'cvs-checkout-flags "cvs checkout flags"))
+ root)))
(when (eq flags t)
(setf flags (cvs-flags-query 'cvs-checkout-flags nil 'noquery)))
- (cvs-cmd-do "checkout" (or dir default-directory)
- (append flags modules) nil 'new
- :noexist t))
-
+ (let ((cvs-cvsroot root))
+ (cvs-cmd-do "checkout" (or dir default-directory)
+ (append flags modules) nil 'new
+ :noexist t)))
+
+(defun-cvs-mode (cvs-mode-checkout . NOARGS) (dir)
+ "Run cvs checkout against the current branch.
+The files are stored to DIR."
+ (interactive
+ (let* ((branch (cvs-prefix-get 'cvs-branch-prefix))
+ (prompt (format "CVS Checkout Directory for `%s%s': "
+ (cvs-get-module)
+ (if branch (format " (branch: %s)" branch)
+ ""))))
+ (list (read-directory-name prompt nil default-directory nil))))
+ (let ((modules (string->strings (cvs-get-module)))
+ (flags (cvs-add-branch-prefix
+ (cvs-flags-query 'cvs-checkout-flags "cvs checkout flags")))
+ (cvs-cvsroot (cvs-get-cvsroot)))
+ (cvs-checkout modules dir flags)))
;;;;
;;;; The code for running a "cvs update" and friends in various ways.
@@ -862,7 +973,7 @@ With a prefix argument, prompt for cvs FLAGS to use."
(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))
@@ -872,7 +983,7 @@ With a prefix argument, prompt for cvs FLAGS to use."
(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)
@@ -917,6 +1028,7 @@ Optional argument NOSHOW if non-nil means not to display the buffer."
(cvs-flags-query 'cvs-update-flags "cvs -n update flags")))
(when (eq flags t)
(setf flags (cvs-flags-query 'cvs-update-flags nil 'noquery)))
+ (when find-file-visit-truename (setq directory (file-truename directory)))
(cvs-cmd-do "update" directory flags nil
(> (prefix-numeric-value current-prefix-arg) 8)
:cvsargs '("-n")
@@ -928,9 +1040,11 @@ Optional argument NOSHOW if non-nil means not to display the buffer."
(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)
@@ -985,8 +1099,9 @@ for a lock file. If so, it inserts a message cookie in the *cvs* buffer."
(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))
@@ -1008,7 +1123,7 @@ the override will persist until the next toggle."
(cvs-prefix-set 'cvs-force-command arg))
(put 'cvs-mode 'mode-class 'special)
-(define-derived-mode cvs-mode fundamental-mode "CVS"
+(define-derived-mode cvs-mode nil "CVS"
"Mode used for PCL-CVS, a frontend to CVS.
Full documentation is in the Texinfo file."
(setq mode-line-process
@@ -1017,7 +1132,9 @@ Full documentation is in the Texinfo file."
("" cvs-branch-prefix (cvs-secondary-branch-prefix
("->" cvs-secondary-branch-prefix))))
" " cvs-mode-line-process))
- (buffer-disable-undo (current-buffer))
+ (if buffer-file-name
+ (error "Use M-x cvs-quickdir to get a *cvs* 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)
@@ -1043,7 +1160,7 @@ Full documentation is in the Texinfo file."
(eq (ewoc-buffer cvs-cookies) buf)
(setq check 'cvs-temp-buffer)
(or (null cvs-temp-buffer)
- (null (buffer-name cvs-temp-buffer))
+ (null (buffer-live-p cvs-temp-buffer))
(and (eq (with-current-buffer cvs-temp-buffer cvs-buffer) buf)
(equal (with-current-buffer cvs-temp-buffer
default-directory)
@@ -1052,7 +1169,7 @@ Full documentation is in the Texinfo file."
(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))))
@@ -1063,39 +1180,35 @@ Full documentation is in the Texinfo file."
"Display help for various PCL-CVS commands."
(interactive)
(if (eq last-command 'cvs-help)
- (describe-function 'cvs-mode) ; would need minor-mode for cvs-edit-mode
- (message
+ (describe-function 'cvs-mode) ; would need minor-mode for log-edit-mode
+ (message "%s"
(substitute-command-keys
"`\\[cvs-help]':help `\\[cvs-mode-add]':add `\\[cvs-mode-commit]':commit \
`\\[cvs-mode-diff-map]':diff* `\\[cvs-mode-log]':log \
`\\[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 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 arg))
+ (ewoc-goto-next cvs-cookies arg)
+ (cvs-move-to-goal-column))
;;;;
;;;; Mark handling
@@ -1124,11 +1237,12 @@ marked instead. A directory can never be marked."
(ewoc-invalidate cvs-cookies tin)
(cvs-mode-next-line 1))))
-(defun cvs-mouse-toggle-mark (e)
- "Toggle the mark of the entry under the mouse."
- (interactive "e")
+(defalias 'cvs-mouse-toggle-mark 'cvs-mode-toggle-mark)
+(defun cvs-mode-toggle-mark (e)
+ "Toggle the mark of the entry at point."
+ (interactive (list last-input-event))
(save-excursion
- (mouse-set-point e)
+ (posn-set-point (event-end e))
(cvs-mode-mark 'toggle)))
(defun-cvs-mode cvs-mode-unmark ()
@@ -1144,6 +1258,31 @@ marked instead. A directory can never be marked."
(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: ")
@@ -1169,7 +1308,8 @@ they should always be unmarked."
(let ((tin (ewoc-goto-prev cvs-cookies 1)))
(when tin
(setf (cvs-fileinfo->marked (ewoc-data tin)) nil)
- (ewoc-invalidate cvs-cookies tin))))
+ (ewoc-invalidate cvs-cookies tin)))
+ (cvs-move-to-goal-column))
(defconst cvs-ignore-marks-alternatives
'(("toggle-marks" . "/TM")
@@ -1182,7 +1322,7 @@ they should always be unmarked."
(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))
@@ -1209,17 +1349,13 @@ See `cvs-prefix-set' for further description of the behavior.
(defun cvs-mode-mark-get-modif (cmd)
(if (cvs-ignore-marks-p cmd 'read-only) "/IM" "/FM"))
-(defvar cvs-minor-current-files)
(defun cvs-get-marked (&optional ignore-marks ignore-contents)
"Return a list of all selected fileinfos.
If there are any marked tins, and IGNORE-MARKS is nil, return them.
Otherwise, if the cursor selects a directory, and IGNORE-CONTENTS is
nil, return all files in it, else return just the directory.
Otherwise return (a list containing) the file the cursor points to, or
-an empty list if it doesn't point to a file at all.
-
-Args: &optional IGNORE-MARKS IGNORE-CONTENTS."
-
+an empty list if it doesn't point to a file at all."
(let ((fis nil))
(dolist (fi (if (and (boundp 'cvs-minor-current-files)
(consp cvs-minor-current-files))
@@ -1243,13 +1379,12 @@ Args: &optional IGNORE-MARKS IGNORE-CONTENTS."
(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))
+(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.
@@ -1257,6 +1392,7 @@ 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))))
@@ -1268,7 +1404,7 @@ If FILE is non-nil, directory entries won't be selected."
(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 0.5)
+ (sit-for 1)
(setq fis (list (cvs-insert-file
(read-file-name (format "File to %s: " cmd))))))
(if one (car fis) fis)))
@@ -1280,38 +1416,43 @@ If FILE is non-nil, directory entries won't be selected."
(defun cvs-mode-files (&rest -cvs-mode-files-args)
(cvs-mode!
(lambda ()
- (mapcar 'cvs-fileinfo->full-path
+ (mapcar 'cvs-fileinfo->full-name
(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)
+ (let ((buf (cvs-temp-buffer "message" 'normal 'nosetup))
(setupfun (or (nth 2 (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)))
+ 'log-edit)))
+ (funcall setupfun 'cvs-do-commit setup 'cvs-commit-filelist buf)
+ (set (make-local-variable 'cvs-minor-wrap-function) 'cvs-commit-minor-wrap)
+ (run-hooks 'cvs-mode-commit-hook)))
(defun cvs-commit-minor-wrap (buf f)
(let ((cvs-ignore-marks-modif (cvs-mode-mark-get-modif "commit")))
@@ -1329,22 +1470,98 @@ The POSTPROC specified there (typically `cvs-edit') is then called,
(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))))))
+
+(defvar cvs-edit-log-revision)
+(defvar cvs-edit-log-files) (put 'cvs-edit-log-files 'permanent-local t)
+(defun cvs-mode-edit-log (file 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 ()
+ (car (cvs-mode-files nil nil
+ :read-only t :file t :noquery t))))
+ (read-string "File name: "))
+ (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))
+ (setupfun (or (nth 2 (cdr (assoc "message" cvs-buffer-name-alist)))
+ 'log-edit)))
+ (with-current-buffer buf
+ ;; Set the filename before, so log-edit can correctly setup its
+ ;; log-edit-initial-files variable.
+ (set (make-local-variable 'cvs-edit-log-files) (list file)))
+ (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)
+ ;; (run-hooks 'cvs-mode-commit-hook)
+ ))
+
+(defun cvs-edit-log-minor-wrap (buf f)
+ (let ((cvs-branch-prefix (with-current-buffer buf cvs-edit-log-revision))
+ (cvs-minor-current-files
+ (with-current-buffer buf cvs-edit-log-files))
+ ;; FIXME: I need to force because the fileinfos are UNKNOWN
+ (cvs-force-command "/F"))
+ (funcall f)))
+
+(defun cvs-edit-log-filelist ()
+ (if cvs-minor-wrap-function
+ (cvs-mode-files nil nil :read-only t :file t :noquery t)
+ cvs-edit-log-files))
+
+(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!
+ (lambda ()
+ (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: "
- ;; 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
- (car (cvs-mode-marked nil nil :read-only t)))))
- (error nil)))))
+ (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)
@@ -1356,6 +1573,11 @@ The POSTPROC specified there (typically `cvs-edit') is then called,
(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.
With prefix argument, prompt for cvs flags."
@@ -1365,7 +1587,7 @@ With prefix argument, prompt for cvs flags."
;; find directories and look for fis needing a description
(dolist (fi fis)
(cond
- ((file-directory-p (cvs-fileinfo->full-path fi)) (push fi dirs))
+ ((file-directory-p (cvs-fileinfo->full-name fi)) (push fi dirs))
((eq (cvs-fileinfo->type fi) 'UNKNOWN) (setq needdesc t))))
;; prompt for description if necessary
(let* ((msg (if (and needdesc
@@ -1379,7 +1601,7 @@ With prefix argument, prompt for cvs flags."
`((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)
@@ -1399,6 +1621,18 @@ 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-repository . SIMPLE) (flags)
+ "Diff the files for changes in the repository since last co/update/commit.
+See ``cvs-mode-diff'' for more info."
+ (interactive (list (cvs-flags-query 'cvs-diff-flags "cvs diff flags")))
+ (cvs-mode-diff-1 (cons "-rBASE" (cons "-rHEAD" flags))))
+
+(defun-cvs-mode (cvs-mode-diff-yesterday . SIMPLE) (flags)
+ "Diff the selected files against yesterday's 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 "-Dyesterday" 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."
@@ -1411,11 +1645,9 @@ See ``cvs-mode-diff'' for more info."
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))
+ (let* ((marked (cvs-get-marked (cvs-ignore-marks-p "diff")))
(fis (car (cvs-partition 'cvs-fileinfo->backup-file marked))))
(unless (consp fis)
(error "No files with a backup file selected!"))
@@ -1433,8 +1665,8 @@ or \"Conflict\" in the *cvs* buffer."
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-name fileinfo)))
+ (list backup-file (cvs-fileinfo->full-name fileinfo))))
;;
;; Emerge support
@@ -1448,6 +1680,7 @@ Signal an error if there is no backup file."
;;
(defvar ediff-after-quit-destination-buffer)
+(defvar ediff-after-quit-hook-internal)
(defvar cvs-transient-buffers)
(defun cvs-ediff-startup-hook ()
(add-hook 'ediff-after-quit-hook-internal
@@ -1487,15 +1720,31 @@ Signal an error if there is no backup file."
(defun cvs-retrieve-revision (fileinfo rev)
"Retrieve the given REVision of the file in FILEINFO into a new buffer."
- (let* ((file (cvs-fileinfo->full-path fileinfo))
+ (let* ((file (cvs-fileinfo->full-name 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)))
+ ;; Discard stderr output to work around the CVS+SSH+libc
+ ;; problem when stdout and stderr are the same.
+ (let ((res
+ (let ((coding-system-for-read 'binary))
+ (apply 'call-process cvs-program nil '(t nil) nil
+ "-q" "update" "-p"
+ ;; If `rev' is HEAD, don't pass it at all:
+ ;; the default behavior is to get the head
+ ;; of the current branch whereas "-r HEAD"
+ ;; stupidly gives you the head of the trunk.
+ (append (unless (equal rev "HEAD") (list "-r" rev))
+ (list file))))))
(when (and res (not (and (equal 0 res))))
(error "Something went wrong retrieving revision %s: %s" rev res))
+ ;; Figure out the encoding used and decode the byte-sequence
+ ;; into a sequence of chars.
+ (decode-coding-inserted-region
+ (point-min) (point-max) file t nil nil t)
+ ;; Set buffer-file-coding-system.
+ (after-insert-file-set-coding (buffer-size) t)
(set-buffer-modified-p nil)
(let ((buffer-file-name (expand-file-name file)))
(after-find-file))
@@ -1503,8 +1752,6 @@ Signal an error if there is no backup file."
(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.
@@ -1513,7 +1760,7 @@ Signal an error if there is no backup file."
(interactive)
(let ((fi (cvs-mode-marked 'merge nil :one t :file t)))
(let ((merge (cvs-fileinfo->merge fi))
- (file (cvs-fileinfo->full-path fi))
+ (file (cvs-fileinfo->full-name fi))
(backup-file (cvs-fileinfo->backup-file fi)))
(if (not (and merge backup-file))
(let ((buf (find-file-noselect file)))
@@ -1544,7 +1791,7 @@ Signal an error if there is no backup file."
(list (or rev1 (cvs-flags-query 'cvs-idiff-version))
rev2)))
(let ((fi (cvs-mode-marked 'diff "idiff" :one t :file t)))
- (let* ((file (cvs-fileinfo->full-path fi))
+ (let* ((file (cvs-fileinfo->full-name fi))
(rev1-buf (cvs-retrieve-revision fi (or rev1 "BASE")))
(rev2-buf (if rev2 (cvs-retrieve-revision fi rev2)))
;; this binding is used by cvs-ediff-startup-hook
@@ -1559,39 +1806,31 @@ Signal an error if there is no backup file."
(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))))
+ (find-file-noselect (cvs-fileinfo->full-name fi1))))
rev2-buf)
(if (cdr 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."))
+ (find-file-noselect (cvs-fileinfo->full-name fi2)))))
+ (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)."
+ "Non-nil if buffer is inside one of FIS (in DIR)."
(when (stringp buffer-file-name)
(setq buffer-file-name (expand-file-name buffer-file-name))
(let (ret)
(dolist (fi (or fis (list (cvs-create-fileinfo 'DIRCHANGE "" "." ""))))
(when (cvs-string-prefix-p
- (expand-file-name (cvs-fileinfo->full-path fi) dir)
+ (expand-file-name (cvs-fileinfo->full-name fi) dir)
buffer-file-name)
(setq ret t)))
ret)))
@@ -1605,13 +1844,18 @@ BUF is the buffer to be used for cvs' output.
DONT-CHANGE-DISC non-nil indicates that the command will not change the
contents of files. This is only used by the parser.
POSTPROC is a list of expressions to be evaluated at the very end (after
- parsing if applicable). It will be prepended with `progn' is necessary."
+ parsing if applicable). It will be prepended with `progn' if necessary."
(let ((def-dir default-directory))
;; 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"))
- (let* ((cvs-buf (current-buffer))
- (single-dir (or (not (listp cvs-execute-single-dir))
+ ;; 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* ((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))
@@ -1620,25 +1864,21 @@ POSTPROC is a list of expressions to be evaluated at the very end (after
(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
- ;;(set (make-local-variable 'cvs-buffer) cvs-buf)
(let ((inhibit-read-only t)) (erase-buffer))
(message "Running cvs %s ..." cmd)
(cvs-run-process args fis postproc single-dir))))
(defun* cvs-mode-do (cmd flags filter
- &key show dont-change-disc parse cvsargs postproc)
+ &key show dont-change-disc cvsargs postproc)
"Generic cvs-mode- function.
Executes `cvs CVSARGS CMD FLAGS' on the selected files.
FILTER is passed to `cvs-applicable-p' to only apply the command to
@@ -1708,24 +1948,27 @@ With a prefix argument, prompt for cvs flags."
This command ignores files that are not flagged as `Unknown'."
(interactive)
(dolist (fi (cvs-mode-marked 'ignore))
- (cvs-append-to-ignore (cvs-fileinfo->dir fi) (cvs-fileinfo->file fi))
+ (cvs-append-to-ignore (cvs-fileinfo->dir fi) (cvs-fileinfo->file fi)
+ (eq (cvs-fileinfo->subtype fi) 'NEW-DIR))
(setf (cvs-fileinfo->type fi) 'DEAD))
(cvs-cleanup-collection cvs-cookies nil nil nil))
-(defun cvs-append-to-ignore (dir str)
- "Add STR to the .cvsignore file in DIR."
- (save-window-excursion
- (set-buffer (find-file-noselect (expand-file-name ".cvsignore" dir)))
+(defun cvs-append-to-ignore (dir str &optional old-dir)
+ "Add STR to the .cvsignore file in DIR.
+If OLD-DIR is non-nil, then this is a directory that we don't want
+to hear about anymore."
+ (with-current-buffer
+ (find-file-noselect (expand-file-name ".cvsignore" dir))
(when (ignore-errors
(and buffer-read-only
(eq 'CVS (vc-backend buffer-file-name))
(not (vc-editable-p buffer-file-name))))
;; CVSREAD=on special case
- (vc-toggle-read-only))
+ (vc-checkout buffer-file-name t))
(goto-char (point-max))
- (unless (zerop (current-column)) (insert "\n"))
- (insert str "\n")
+ (unless (bolp) (insert "\n"))
+ (insert str (if old-dir "/\n" "\n"))
(if cvs-sort-ignore-file (sort-lines nil (point-min) (point-max)))
(save-buffer)))
@@ -1736,6 +1979,24 @@ This command ignores files that are not flagged as `Unknown'."
(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-mode-view-file (e)
+ "View the file."
+ (interactive (list last-input-event))
+ (cvs-mode-find-file e nil t))
+
+
+(defun cvs-mode-view-file-other-window (e)
+ "View the file."
+ (interactive (list last-input-event))
+ (cvs-mode-find-file e t t))
+
+
(defun cvs-find-modif (fi)
(with-temp-buffer
(call-process cvs-program nil (current-buffer) nil
@@ -1746,14 +2007,16 @@ This command ignores files that are not flagged as `Unknown'."
1)))
-(defun cvs-mode-find-file (e &optional other)
+(defun cvs-mode-find-file (e &optional other view)
"Select a buffer containing the file.
With a prefix, opens the buffer in an OTHER window."
(interactive (list last-input-event current-prefix-arg))
- (when (ignore-errors (mouse-set-point e) t) ;for invocation via the mouse
- (unless (memq (get-text-property (point) 'face)
- '(cvs-dirname-face cvs-filename-face))
- (error "Not a file name")))
+ ;; If the event moves point, check that it moves it to a valid location.
+ (when (and (/= (point) (progn (posn-set-point (event-end e)) (point)))
+ (not (memq (get-text-property (1- (line-end-position))
+ 'font-lock-face)
+ '(cvs-header cvs-filename))))
+ (error "Not a file name"))
(cvs-mode!
(lambda (&optional rev)
(interactive (list (cvs-prefix-get 'cvs-branch-prefix)))
@@ -1763,14 +2026,19 @@ With a prefix, opens the buffer in an OTHER window."
(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)
+ (find-file-noselect (cvs-fileinfo->full-name fi)))))
+ (funcall (cond ((eq other 'dont-select) 'display-buffer)
+ (other
+ (if view 'view-buffer-other-window
+ 'switch-to-buffer-other-window))
+ (t (if view 'view-buffer 'switch-to-buffer)))
buf)
(when (and cvs-find-file-and-jump (cvs-applicable-p fi 'diff-base))
(goto-line (cvs-find-modif fi)))
@@ -1784,7 +2052,10 @@ The file is removed and `cvs update FILE' is run."
(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)))
@@ -1821,7 +2092,7 @@ if you are convinced that the process that created the lock is dead."
(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))
@@ -1853,23 +2124,33 @@ Returns a list of FIS that should be `cvs remove'd."
(silent (or (not cvs-confirm-removals)
(cvs-every (lambda (fi)
(or (not (file-exists-p
- (cvs-fileinfo->full-path fi)))
+ (cvs-fileinfo->full-name fi)))
(cvs-applicable-p fi 'safe-rm)))
files)))
(tmpbuf (cvs-temp-buffer)))
(when (and (not silent) (equal cvs-confirm-removals 'list))
(with-current-buffer tmpbuf
- (cvs-insert-strings (mapcar 'cvs-fileinfo->full-path fis))
- (cvs-pop-to-buffer-same-frame (current-buffer))
- (shrink-window-if-larger-than-buffer)))
+ (let ((inhibit-read-only t))
+ (cvs-insert-strings (mapcar 'cvs-fileinfo->full-name fis))
+ (cvs-pop-to-buffer-same-frame (current-buffer))
+ (shrink-window-if-larger-than-buffer))))
(if (not (or silent
(unwind-protect
- (yes-or-no-p (format "Delete %d files? " (length files)))
+ (yes-or-no-p
+ (let ((nfiles (length files))
+ (verb (if (eq filter 'undo) "Undo" "Delete")))
+ (if (= 1 nfiles)
+ (format "%s file: \"%s\" ? "
+ verb
+ (cvs-fileinfo->file (car files)))
+ (format "%s %d files? "
+ verb
+ nfiles))))
(cvs-bury-buffer tmpbuf cvs-buffer))))
(progn (message "Aborting") nil)
(dolist (fi files)
(let* ((type (cvs-fileinfo->type fi))
- (file (cvs-fileinfo->full-path fi)))
+ (file (cvs-fileinfo->full-name fi)))
(when (or all (eq type 'UNKNOWN))
(when (file-exists-p file) (delete-file file))
(unless all (setf (cvs-fileinfo->type fi) 'DEAD) t))))
@@ -1887,7 +2168,10 @@ With prefix argument, prompt for cvs flags."
(defvar cvs-tag-name "")
(defun-cvs-mode (cvs-mode-tag . SIMPLE) (tag &optional flags)
"Run `cvs tag TAG' on all selected files.
-With prefix argument, prompt for cvs flags."
+With prefix argument, prompt for cvs flags.
+By default this can only be used on directories.
+Use \\[cvs-mode-force-command] or change `cvs-force-dir-tag' if you need
+to use it on individual files."
(interactive
(list (setq cvs-tag-name
(cvs-query-read cvs-tag-name "Tag name: " cvs-qtypedesc-tag))
@@ -1913,7 +2197,7 @@ With prefix argument, prompt for cvs flags."
(interactive)
(let ((marked (cvs-get-marked (cvs-ignore-marks-p "byte-compile"))))
(dolist (fi marked)
- (let ((filename (cvs-fileinfo->full-path fi)))
+ (let ((filename (cvs-fileinfo->full-name fi)))
(when (string-match "\\.el\\'" filename)
(byte-compile-file filename))))))
@@ -1922,11 +2206,15 @@ With prefix argument, prompt for cvs flags."
(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)))
- 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))))
+ (if (file-directory-p buffer-file-name)
+ ;; Be careful to use a directory name, otherwise add-log starts
+ ;; looking for a ChangeLog file in the parent dir.
+ (setq buffer-file-name (file-name-as-directory buffer-file-name)))
+ (kill-local-variable 'change-log-default-name)
+ (save-excursion (add-change-log-entry-other-window)))))
;; interactive commands to set optional flags
@@ -1935,8 +2223,8 @@ With prefix argument, prompt for cvs 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)))
@@ -1954,17 +2242,15 @@ With prefix argument, prompt for cvs flags."
(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 (strings->string args)))
;; FIXME: return the exit status?
(apply 'call-process program nil t t args)
@@ -1973,10 +2259,9 @@ With prefix argument, prompt for cvs flags."
;; 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
@@ -1987,7 +2272,7 @@ this file, or a list of arguments to send to the program."
(defun cvs-revert-if-needed (fis)
(dolist (fileinfo fis)
- (let* ((file (cvs-fileinfo->full-path fileinfo))
+ (let* ((file (cvs-fileinfo->full-name fileinfo))
(buffer (find-buffer-visiting file)))
;; For a revert to happen the user must be editing the file...
(unless (or (null buffer)
@@ -2012,7 +2297,7 @@ this file, or a list of arguments to send to the program."
(interactive "DNew repository: ")
(if (or (file-directory-p (expand-file-name "CVSROOT" newroot))
(y-or-n-p (concat "Warning: no CVSROOT found inside repository."
- " Change cvs-cvsroot anyhow?")))
+ " Change cvs-cvsroot anyhow? ")))
(setq cvs-cvsroot newroot)))
;;;;
@@ -2036,7 +2321,7 @@ Sensible values are `cvs-examine', `cvs-status' and `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.
+A value of 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."
@@ -2068,9 +2353,18 @@ The exact behavior is determined also by `cvs-dired-use-hook'."
(defun cvs-vc-command-advice (command file flags)
(when (and (equal command "cvs")
- ;; don't parse output we don't understand.
- (member (car flags) cvs-parse-known-commands))
- (save-excursion
+ (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))
+ ;; Don't parse "update -p" output.
+ (not (and (member (car flags) '("update" "checkout"))
+ (let ((found-p nil))
+ (dolist (flag flags found-p)
+ (if (equal flag "-p") (setq found-p t)))))))
+ (save-current-buffer
(let ((buffer (current-buffer))
(dir default-directory)
(cvs-from-vc t))
@@ -2082,6 +2376,13 @@ The exact behavior is determined also by `cvs-dired-use-hook'."
(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))))))))
@@ -2116,4 +2417,5 @@ The exact behavior is determined also by `cvs-dired-use-hook'."
(provide 'pcvs)
+;; arch-tag: 8e3a7494-0453-4389-9ab3-a557ce9fab61
;;; pcvs.el ends here