;;; pcvs.el --- a front-end to CVS
-;; Copyright (C) 1991,92,93,94,95,95,97,98,99,2000,02,03,2004
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+;; 2000, 2002, 2003, 2004 Free Software Foundation, Inc.
;; Author: (The PCL-CVS Trust) pcl-cvs@cyclic.com
;; (Per Cederqvist) ceder@lysator.liu.se
;; 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-path 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)
;; 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)))))
(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.
(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."
;; absence of `cvs update' output has a specific meaning.
(or fis (list (cvs-create-fileinfo 'DIRCHANGE "" "." ""))))))
(push `(cvs-parse-process ',dont-change-disc nil ',old-fis) postproc)))
+ (let ((msg (cvs-header-msg args fis)))
+ (cvs-update-header msg 'add)
+ (push `(with-current-buffer cvs-buffer
+ (cvs-update-header ',msg nil))
+ 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))
(let ((buf (if rev (cvs-retrieve-revision fi rev)
(find-file-noselect (cvs-fileinfo->full-path 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)))
\f
(provide 'pcvs)
-;;; arch-tag: 8e3a7494-0453-4389-9ab3-a557ce9fab61
+;; arch-tag: 8e3a7494-0453-4389-9ab3-a557ce9fab61
;;; pcvs.el ends here