;;; 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
;; (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.
;; 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:
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)
(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 " "
+ (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)
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 (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)))
\f
;;;;
;;;; The code for running a "cvs update" and friends in various ways.
("->" 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 ()
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
+ (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
(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)
(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
(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))))))
\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)
\f
(provide 'pcvs)
-;;; arch-tag: 8e3a7494-0453-4389-9ab3-a557ce9fab61
+;; arch-tag: 8e3a7494-0453-4389-9ab3-a557ce9fab61
;;; pcvs.el ends here