X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/1d2b9bbaf9f72541c4d3e3087c7d572980974391..31cf286fdb0a74fa05761163237ee002e1b511b8:/lisp/pcvs.el diff --git a/lisp/pcvs.el b/lisp/pcvs.el index a15ecc5ccb..b9d0452218 100644 --- a/lisp/pcvs.el +++ b/lisp/pcvs.el @@ -1,7 +1,7 @@ ;;; pcvs.el --- a front-end to CVS -;; Copyright (C) 1991,92,93,94,95,95,97,98,99,2000,02,2003 -;; Free Software Foundation, Inc. +;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +;; 2000, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: (The PCL-CVS Trust) pcl-cvs@cyclic.com ;; (Per Cederqvist) ceder@lysator.liu.se @@ -12,7 +12,7 @@ ;; (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 ;; This file is part of GNU Emacs. @@ -29,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: @@ -233,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))))))) @@ -358,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) @@ -369,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 @@ -454,7 +461,8 @@ If non-nil, NEW means to create a new buffer no matter what." (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) @@ -504,7 +512,7 @@ If non-nil, NEW means to create a new buffer no matter what." (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 @@ -520,39 +528,49 @@ If non-nil, NEW means to create a new buffer no matter what." (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 also happens + ;; It might be a glibc-specific problem (but it can also happens ;; under Mac OS X, it seems). - ;; Until the problem is cleared, we'll use a pty rather than - ;; a pipe. - ;; (process-connection-type nil) ; Use a pipe, not a pty. + ;; 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)) @@ -567,7 +585,7 @@ If non-nil, NEW means to create a new buffer no matter what." ;; 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) (args (mapcar (lambda (arg) (cond @@ -587,38 +605,40 @@ If non-nil, NEW means to create a new buffer no matter what." (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 " " + (cvs-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))) + (if (eq (length str) 1) (setq str "")) + ;; 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 + (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)) + (if (zerop (length str)) (setq str "\n")) + (setq done (concat "-- last cmd: " cmd " --")))) + ;; 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) @@ -626,34 +646,39 @@ If non-nil, NEW means to create a new buffer no matter what." 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 - ;; IIRC, we enable undo again once the process is finished - ;; for cases where the output was inserted in *vc-diff* or - ;; in a file-like buffer. -stef - (buffer-enable-undo) - (with-current-buffer cvs-buffer - (cvs-update-header nil nil) ;FIXME: might need to be inline - (message "CVS process has completed in %s" (buffer-name))))) - ;; This might not even be necessary - (set-buffer obuf))))) + (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. @@ -661,6 +686,14 @@ 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 @@ -742,18 +775,19 @@ 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))))) + (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))))) @@ -802,7 +836,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) @@ -889,24 +923,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-directory-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 (cvs-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 (cvs-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. @@ -1074,7 +1128,7 @@ Full documentation is in the Texinfo file." ("->" cvs-secondary-branch-prefix)))) " " cvs-mode-line-process)) (if buffer-file-name - (error "Use M-x cvs-quickdir to get a *cvs* buffer.")) + (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) @@ -1101,7 +1155,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) @@ -1122,7 +1176,7 @@ Full documentation is in the Texinfo file." (interactive) (if (eq last-command 'cvs-help) (describe-function 'cvs-mode) ; would need minor-mode for log-edit-mode - (message + (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 \ @@ -1178,11 +1232,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 () @@ -1248,7 +1303,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") @@ -1294,10 +1350,7 @@ 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)) @@ -1358,7 +1411,7 @@ 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))))) ;; @@ -1390,12 +1443,10 @@ The POSTPROC specified there (typically `log-edit') is then called, ;; displayed in the wrong minibuffer). (cvs-mode!) (let ((buf (cvs-temp-buffer "message" 'normal 'nosetup)) - (lbd list-buffers-directory) (setupfun (or (nth 2 (cdr (assoc "message" cvs-buffer-name-alist))) 'log-edit))) (funcall setupfun 'cvs-do-commit setup 'cvs-commit-filelist buf) (set (make-local-variable 'cvs-minor-wrap-function) 'cvs-commit-minor-wrap) - (set (make-local-variable 'list-buffers-directory) lbd) (run-hooks 'cvs-mode-commit-hook))) (defun cvs-commit-minor-wrap (buf f) @@ -1432,11 +1483,16 @@ The POSTPROC specified there (typically `log-edit') is then called, (point)))))) (defvar cvs-edit-log-revision) -(defun cvs-mode-edit-log (rev &optional text) +(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))) @@ -1446,30 +1502,40 @@ This is best called from a `log-view-mode' buffer." ;; displayed in the wrong minibuffer). (cvs-mode!) (let ((buf (cvs-temp-buffer "message" 'normal 'nosetup)) - (lbd list-buffers-directory) (setupfun (or (nth 2 (cdr (assoc "message" cvs-buffer-name-alist))) 'log-edit))) + (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) - (set (make-local-variable 'list-buffers-directory) lbd) + (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-ignore-marks-modif (cvs-mode-mark-get-modif "commit"))) + (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 () - (cvs-mode-files nil nil :read-only t :file t :noquery t)) + (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!) - (cvs-mode-do "admin" (list (concat "-m" rev ":" msg)) nil))) + (cvs-mode! + (lambda () + (cvs-mode-do "admin" (list (concat "-m" rev ":" msg)) nil))))) ;;;; @@ -1516,7 +1582,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 @@ -1550,6 +1616,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." @@ -1582,8 +1660,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->full-path fileinfo)))) + (error "%s has no backup file" (cvs-fileinfo->full-name fileinfo))) + (list backup-file (cvs-fileinfo->full-name fileinfo)))) ;; ;; Emerge support @@ -1637,15 +1715,14 @@ 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) ;; Discard stderr output to work around the CVS+SSH+libc ;; problem when stdout and stderr are the same. - ;; FIXME: this doesn't seem to make any difference :-( - (let ((res (apply 'call-process cvs-program nil '(t . nil) nil + (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 @@ -1662,8 +1739,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. @@ -1672,7 +1747,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))) @@ -1703,7 +1778,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 @@ -1721,13 +1796,13 @@ Signal an error if there is no backup file." (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))))) + (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))) @@ -1736,13 +1811,13 @@ Signal an error if there is no backup file." (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))) @@ -1756,7 +1831,7 @@ 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)))) @@ -1783,7 +1858,6 @@ POSTPROC is a list of expressions to be evaluated at the very end (after (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 (let ((inhibit-read-only t)) (erase-buffer)) (message "Running cvs %s ..." cmd) @@ -1898,6 +1972,18 @@ to hear about anymore." (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 @@ -1908,15 +1994,15 @@ to hear about anymore." 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)) ;; If the event moves point, check that it moves it to a valid location. - (when (and (/= (point) (progn (ignore-errors (mouse-set-point e)) (point))) + (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-face cvs-filename-face)))) + '(cvs-header cvs-filename)))) (error "Not a file name")) (cvs-mode! (lambda (&optional rev) @@ -1934,10 +2020,12 @@ With a prefix, opens the buffer in an OTHER window." (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))))) + (find-file-noselect (cvs-fileinfo->full-name fi))))) (funcall (cond ((eq other 'dont-select) 'display-buffer) - (other 'switch-to-buffer-other-window) - (t 'switch-to-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))) @@ -2023,24 +2111,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 (let ((inhibit-read-only t)) - (cvs-insert-strings (mapcar 'cvs-fileinfo->full-path fis)) + (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)))) @@ -2087,7 +2184,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)))))) @@ -2097,8 +2194,8 @@ With prefix argument, prompt for cvs flags." "Add a ChangeLog entry in the ChangeLog of the current directory." (interactive) (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)))) + (let* ((default-directory (cvs-expand-dir-name (cvs-fileinfo->dir fi))) + (buffer-file-name (expand-file-name (cvs-fileinfo->file fi)))) (kill-local-variable 'change-log-default-name) (save-excursion (add-change-log-entry-other-window))))) @@ -2158,7 +2255,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) @@ -2303,4 +2400,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