;;; 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, 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
;; (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.
;; 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,
;; 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:
(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
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)))))))
(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)
(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 ()
(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
(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))
;; 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
(concat (match-string 0 arg) "<log message>"))
;; 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 " "
+ (combine-and-quote-strings
+ (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)
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.
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\b+" 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
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)))))
(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)
;;;;
;;;###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 (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
+ (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 (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)))
+ (cvs-checkout modules dir flags)))
\f
;;;;
;;;; The code for running a "cvs update" and friends in various ways.
(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)
("->" 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)
(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)
(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 \
(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 ()
(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")
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))
(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)))))
;;
;; 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)
(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)))
;; 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)))))
;;;;
;; 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
(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."
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
(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
- "-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 '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))
(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.
(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)))
(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
(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)))
(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)))
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))))
(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)
(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)
(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
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)
(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)))
(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
+ (yes-or-no-p
(let ((nfiles (length files))
(verb (if (eq filter 'undo) "Undo" "Delete")))
(if (= 1 nfiles)
- (format "%s file: \"%s\" ? "
+ (format "%s file: \"%s\" ? "
verb
(cvs-fileinfo->file (car files)))
- (format "%s %d 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))))
(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))))))
(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))))
+ (let* ((default-directory (cvs-expand-dir-name (cvs-fileinfo->dir 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)
\f
(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)
(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."
\f
(provide 'pcvs)
-;;; arch-tag: 8e3a7494-0453-4389-9ab3-a557ce9fab61
+;; arch-tag: 8e3a7494-0453-4389-9ab3-a557ce9fab61
;;; pcvs.el ends here