X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/c90f275771bd76325576ecd8c9cdcada1b54f2be..56388398e7a1251497f002072c061002ec9d9e81:/lisp/pcvs.el diff --git a/lisp/pcvs.el b/lisp/pcvs.el index 001053f742..462597a277 100644 --- a/lisp/pcvs.el +++ b/lisp/pcvs.el @@ -1,7 +1,7 @@ ;;; 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 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 @@ -19,7 +19,7 @@ ;; 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, @@ -182,7 +182,7 @@ (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 @@ -227,7 +227,7 @@ (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 @@ -392,7 +392,11 @@ from the current buffer." (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)) @@ -400,7 +404,8 @@ from the current buffer." (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))) @@ -559,7 +564,7 @@ If non-nil, NEW means to create a new buffer no matter what." (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)) @@ -607,7 +612,7 @@ If non-nil, NEW means to create a new buffer no matter what." (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 @@ -630,6 +635,9 @@ If non-nil, NEW means to create a new buffer no matter what." (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)) @@ -936,7 +944,8 @@ With a prefix argument, prompt for cvs FLAGS to use." (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 @@ -959,7 +968,7 @@ The files are stored to DIR." (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))) @@ -975,13 +984,13 @@ The files are stored to DIR." (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) @@ -1448,7 +1457,9 @@ The POSTPROC specified there (typically `log-edit') is then called, (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))) @@ -1511,7 +1522,10 @@ This is best called from a `log-view-mode' buffer." ;; 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) @@ -1727,7 +1741,7 @@ Signal an error if there is no backup file." ;; 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 @@ -1898,7 +1912,7 @@ With prefix argument, prompt for cvs flags." (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) @@ -1951,6 +1965,8 @@ This command ignores files that are not flagged as `Unknown'." (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. @@ -1997,7 +2013,7 @@ to hear about anymore." (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) @@ -2204,9 +2220,21 @@ 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) + ;; 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))))) @@ -2244,10 +2272,10 @@ With prefix argument, prompt for cvs flags." (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... @@ -2270,7 +2298,7 @@ this file, or a list of arguments to send to the program." (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 @@ -2283,7 +2311,7 @@ this file, or a list of arguments to send to the program." ;; 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)))))))) (defun cvs-change-cvsroot (newroot) @@ -2315,7 +2343,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." @@ -2345,7 +2373,7 @@ The exact behavior is determined also by `cvs-dired-use-hook'." (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)) @@ -2374,9 +2402,10 @@ The exact behavior is determined also by `cvs-dired-use-hook'." (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)))))))) @@ -2389,7 +2418,7 @@ The exact behavior is determined also by `cvs-dired-use-hook'." (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))