;;; 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 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.
(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
(setq default-directory dir)
(setq buffer-read-only nil)
(erase-buffer)
- (insert "\
-Repository : " (directory-file-name (cvs-get-cvsroot)) "
-Module : " (cvs-get-module) "
-Working dir: " (abbreviate-file-name dir) "
-
-")
+ (insert "Repository : " (directory-file-name (cvs-get-cvsroot))
+ "\nModule : " (cvs-get-module)
+ "\nWorking dir: " (abbreviate-file-name dir)
+ (if (not (file-readable-p "CVS/Tag")) "\n"
+ (let ((tag (cvs-file-to-string "CVS/Tag")))
+ (cond
+ ((string-match "\\`T" tag)
+ (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)
;; 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)))))
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
(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."
(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-prefix-set 'cvs-force-command arg))
(put 'cvs-mode 'mode-class 'special)
-(define-derived-mode cvs-mode fundamental-mode "CVS"
+(define-derived-mode cvs-mode nil "CVS"
"Mode used for PCL-CVS, a frontend to CVS.
Full documentation is in the Texinfo file."
(setq mode-line-process
("" cvs-branch-prefix (cvs-secondary-branch-prefix
("->" cvs-secondary-branch-prefix))))
" " cvs-mode-line-process))
+ (if buffer-file-name
+ (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)
(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))
(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."
(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)
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))))
;; 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)
This command ignores files that are not flagged as `Unknown'."
(interactive)
(dolist (fi (cvs-mode-marked 'ignore))
- (cvs-append-to-ignore (cvs-fileinfo->dir fi) (cvs-fileinfo->file fi))
+ (cvs-append-to-ignore (cvs-fileinfo->dir fi) (cvs-fileinfo->file fi)
+ (eq (cvs-fileinfo->subtype fi) 'NEW-DIR))
(setf (cvs-fileinfo->type fi) 'DEAD))
(cvs-cleanup-collection cvs-cookies nil nil nil))
-(defun cvs-append-to-ignore (dir str)
- "Add STR to the .cvsignore file in DIR."
- (save-window-excursion
- (set-buffer (find-file-noselect (expand-file-name ".cvsignore" dir)))
+(defun cvs-append-to-ignore (dir str &optional old-dir)
+ "Add STR to the .cvsignore file in DIR.
+If OLD-DIR is non-nil, then this is a directory that we don't want
+to hear about anymore."
+ (with-current-buffer
+ (find-file-noselect (expand-file-name ".cvsignore" dir))
(when (ignore-errors
(and buffer-read-only
(eq 'CVS (vc-backend buffer-file-name))
(not (vc-editable-p buffer-file-name))))
;; CVSREAD=on special case
- (vc-toggle-read-only))
+ (vc-checkout buffer-file-name t))
(goto-char (point-max))
- (unless (zerop (current-column)) (insert "\n"))
- (insert str "\n")
+ (unless (bolp) (insert "\n"))
+ (insert str (if old-dir "/\n" "\n"))
(if cvs-sort-ignore-file (sort-lines nil (point-min) (point-max)))
(save-buffer)))
(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))))
(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)))
(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)
"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)))))
\f
(provide 'pcvs)
+;; arch-tag: 8e3a7494-0453-4389-9ab3-a557ce9fab61
;;; pcvs.el ends here