;;; pcvs.el --- a front-end to CVS
;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
-;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 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
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(when (re-search-forward
(concat "^" cmd "\\(\\s-+\\(.*\\)\\)?$") nil t)
(let* ((sym (intern (concat "cvs-" cmd "-flags")))
- (val (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
(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 " "
- (strings->string
+ (combine-and-quote-strings
(append (cvs-flags-query 'cvs-cvs-flags nil 'noquery)
(if cvs-cvsroot (list "-d" cvs-cvsroot))
args
(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))
- 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)))
+ (declare (debug (&define sexp lambda-list stringp ("interactive" interactive) def-body))
+ (doc-string 3))
(let ((style (cvs-cdr fun))
(fun (cvs-car fun)))
(cond
(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)))
+ (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 (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)
;; 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
+ (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
(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))))
- (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)))
+ (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 (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)
(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))
HCoop / bpt / emacs.git / blobdiff