;;; pcvs.el --- a front-end to CVS
;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
-;; 2000, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: (The PCL-CVS Trust) pcl-cvs@cyclic.com
;; (Per Cederqvist) ceder@lysator.liu.se
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
(when (re-search-forward
(concat "^" cmd "\\(\\s-+\\(.*\\)\\)?$") nil t)
(let* ((sym (intern (concat "cvs-" cmd "-flags")))
- (val (cvs-string->strings (or (match-string 2) ""))))
+ (val (split-string-and-unquote (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
(list* '("BASE") '("HEAD")
(when marked
(with-temp-buffer
- (call-process cvs-program
+ (process-file cvs-program
nil ;no input
t ;output to current-buffer
nil ;don't update display while running
(with-current-buffer buf
(setq buffer-read-only nil)
(setq default-directory dir)
- (unless nosetup (erase-buffer))
+ (unless nosetup
+ ;; Disable undo before calling erase-buffer since it may generate
+ ;; a very large and unwanted undo record.
+ (buffer-disable-undo)
+ (erase-buffer))
(set (make-local-variable 'cvs-buffer) cvs-buf)
;;(cvs-minor-mode 1)
(let ((lbd list-buffers-directory))
(when lbd (set (make-local-variable 'list-buffers-directory) lbd)))
(cvs-minor-mode 1)
;;(set (make-local-variable 'cvs-buffer) cvs-buf)
- (unless normal
+ (if normal
+ (buffer-enable-undo)
(setq buffer-read-only t)
(buffer-disable-undo))
buf)))
(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 ()
(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))))
+ (apply 'start-file-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))
(t arg)))
args)))
(concat cvs-program " "
- (cvs-strings->string
+ (combine-and-quote-strings
(append (cvs-flags-query 'cvs-cvs-flags nil 'noquery)
(if cvs-cvsroot (list "-d" cvs-cvsroot))
args
(str (car hf))
(done "")
(tin (ewoc-nth cvs-cookies 0)))
- (if (eq (length str) 1) (setq str ""))
;; look for the first *real* fileinfo (to determine emptyness)
(while
(and tin
'(MESSAGE DIRCHANGE)))
(setq tin (ewoc-next cvs-cookies tin)))
(if add
- (setq str (concat "-- Running " cmd " ...\n" str))
+ (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
+ ;; FIXME: If `cmd' is large, this will bump into the
+ ;; compiled-regexp size limit. We could drop the "^" anchor
+ ;; and use search-forward to circumvent the problem.
(concat "^-- Running " (regexp-quote cmd) " \\.\\.\\.\n") str))
(error "Internal PCL-CVS error while removing message")
(setq str (replace-match "" t t str))
- (if (zerop (length str)) (setq str "\n"))
- (setq done (concat "-- last cmd: " cmd " --"))))
+ ;; 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--------------------- "
(let ((root (cvs-get-cvsroot)))
(if (or (null root) current-prefix-arg)
(setq root (read-string "CVS Root: ")))
- (list (cvs-string->strings (read-string "Module(s): " (cvs-get-module)))
+ (list (split-string-and-unquote
+ (read-string "Module(s): " (cvs-get-module)))
(read-directory-name "CVS Checkout Directory: "
nil default-directory nil)
(cvs-add-branch-prefix
(if branch (format " (branch: %s)" branch)
""))))
(list (read-directory-name prompt nil default-directory nil))))
- (let ((modules (cvs-string->strings (cvs-get-module)))
+ (let ((modules (split-string-and-unquote (cvs-get-module)))
(flags (cvs-add-branch-prefix
(cvs-flags-query 'cvs-checkout-flags "cvs checkout flags")))
(cvs-cvsroot (cvs-get-cvsroot)))
(interactive)
(cvs-examine default-directory t))
-(defun cvs-query-directory (msg)
- ;; last-command-char = ?\r hints that the command was run via M-x
+(defun cvs-query-directory (prompt)
+ "Read directory name, prompting with PROMPT.
+If in a *cvs* buffer, don't prompt unless a prefix argument is given."
(if (and (cvs-buffer-p)
- (not current-prefix-arg)
- (not (eq last-command-char ?\r)))
+ (not current-prefix-arg))
default-directory
- (read-directory-name msg nil default-directory nil)))
+ (read-directory-name prompt nil default-directory nil)))
;;;###autoload
(defun cvs-quickdir (dir &optional flags noshow)
(let ((buf (cvs-temp-buffer "message" 'normal 'nosetup))
(setupfun (or (nth 2 (cdr (assoc "message" cvs-buffer-name-alist)))
'log-edit)))
- (funcall setupfun 'cvs-do-commit setup 'cvs-commit-filelist buf)
+ (funcall setupfun 'cvs-do-commit setup
+ '((log-edit-listfun . cvs-commit-filelist)
+ (log-edit-diff-function . cvs-mode-diff)) buf)
(set (make-local-variable 'cvs-minor-wrap-function) 'cvs-commit-minor-wrap)
(run-hooks 'cvs-mode-commit-hook)))
;; 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)
+ (funcall setupfun 'cvs-do-edit-log nil
+ '((log-edit-listfun . cvs-edit-log-filelist)
+ (log-edit-diff-function . cvs-mode-diff))
+ buf)
(when text (erase-buffer) (insert text))
(set (make-local-variable 'cvs-edit-log-revision) rev)
(set (make-local-variable 'cvs-minor-wrap-function)
(message "Retrieving revision %s..." rev)
;; Discard stderr output to work around the CVS+SSH+libc
;; problem when stdout and stderr are the same.
- (let ((res (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)))))
+ (let ((res
+ (let ((coding-system-for-read 'binary))
+ (apply 'process-file 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))
(interactive (list (cvs-flags-query 'cvs-status-flags "cvs status flags")))
(cvs-mode-do "status" flags nil :dont-change-disc t :show t
:postproc (when (eq cvs-auto-remove-handled 'status)
- '((with-current-buffer ,(current-buffer)
+ `((with-current-buffer ,(current-buffer)
(cvs-mode-remove-handled))))))
(defun-cvs-mode (cvs-mode-tree . SIMPLE) (flags)
(setf (cvs-fileinfo->type fi) 'DEAD))
(cvs-cleanup-collection cvs-cookies nil nil nil))
+(declare-function vc-editable-p "vc" (file))
+(declare-function vc-checkout "vc" (file &optional writable rev))
(defun cvs-append-to-ignore (dir str &optional old-dir)
"Add STR to the .cvsignore file in DIR.
(defun cvs-find-modif (fi)
(with-temp-buffer
- (call-process cvs-program nil (current-buffer) nil
+ (process-file cvs-program nil (current-buffer) nil
"-f" "diff" (cvs-fileinfo->file fi))
(goto-char (point-min))
(if (re-search-forward "^\\([0-9]+\\)" nil t)
(defun-cvs-mode cvs-mode-add-change-log-entry-other-window ()
"Add a ChangeLog entry in the ChangeLog of the current directory."
(interactive)
+ ;; Require `add-log' explicitly, because if it gets autoloaded when we call
+ ;; add-change-log-entry-other-window below, the
+ ;; add-log-buffer-file-name-function ends up unbound when we leave the `let'.
+ (require 'add-log)
(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))))
+ (add-log-buffer-file-name-function
+ (lambda ()
+ (let ((file (expand-file-name (cvs-fileinfo->file fi))))
+ (if (file-directory-p file)
+ ;; Be careful to use a directory name, otherwise add-log
+ ;; starts looking for a ChangeLog file in the
+ ;; parent dir.
+ (file-name-as-directory file)
+ file)))))
(kill-local-variable 'change-log-default-name)
(save-excursion (add-change-log-entry-other-window)))))
(let* ((args (append constant-args arg-list)))
(insert (format "=== %s %s\n\n"
- program (cvs-strings->string args)))
+ program (split-string-and-unquote args)))
;; FIXME: return the exit status?
- (apply 'call-process program nil t t args)
+ (apply 'process-file program nil t t args)
(goto-char (point-max))))))
;; FIXME: make this run in the background ala cvs-run-process...
(buffer (find-buffer-visiting file)))
;; For a revert to happen the user must be editing the file...
(unless (or (null buffer)
- (eq (cvs-fileinfo->type fileinfo) 'MESSAGE)
+ (memq (cvs-fileinfo->type fileinfo) '(MESSAGE UNKNOWN))
;; FIXME: check whether revert is really needed.
;; `(verify-visited-file-modtime buffer)' doesn't cut it
;; because it only looks at the time stamp (it ignores
;; 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))))))))
+ (smerge-start-session))))))))
\f
(defun cvs-change-cvsroot (newroot)
(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)))
;;;;
;;;###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."
(add-hook 'vc-post-command-functions 'cvs-vc-command-advice)
-(defun cvs-vc-command-advice (command file flags)
+(defun cvs-vc-command-advice (command files flags)
(when (and (equal command "cvs")
(progn
(while (and (stringp (car flags))
(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"))
+ (dolist (file (if (listp files) files (list files)))
+ (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))))))))
(let* ((file (expand-file-name buffer-file-name))
(version (and (fboundp 'vc-backend)
(eq (vc-backend file) 'CVS)
- (vc-workfile-version file))))
+ (vc-working-revision file))))
(when version
(save-excursion
(dolist (cvs-buf (buffer-list))