;;; pcvs.el --- a front-end to CVS
-;; Copyright (C) 1991,92,93,94,95,95,97,98,99,2000,2002
-;; 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
-;; Revision: $Id: pcvs.el,v 1.48 2003/02/10 21:48:38 monnier Exp $
;; This file is part of GNU Emacs.
;;;; Mouse bindings and mode motion
;;;;
+(defvar cvs-minor-current-files)
+
(defun cvs-menu (e)
"Popup the CVS menu."
(interactive "e")
(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)
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
((eq style 'DOUBLE)
(string-match ".*" docstring)
(let ((line1 (match-string 0 docstring))
- (restdoc (substring docstring (match-end 0)))
(fun-1 (intern (concat (symbol-name fun) "-1"))))
`(progn
(defun ,fun-1 ,args
(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-flags-query 'cvs-update-flags "cvs -n update flags")))
(when (eq flags t)
(setf flags (cvs-flags-query 'cvs-update-flags nil 'noquery)))
+ (when find-file-visit-truename (setq directory (file-truename directory)))
(cvs-cmd-do "update" directory flags nil
(> (prefix-numeric-value current-prefix-arg) 8)
:cvsargs '("-n")
(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")
(defun cvs-mode-mark-get-modif (cmd)
(if (cvs-ignore-marks-p cmd 'read-only) "/IM" "/FM"))
-(defvar cvs-minor-current-files)
(defun cvs-get-marked (&optional ignore-marks ignore-contents)
"Return a list of all selected fileinfos.
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))
(match-beginning 0)
(point))))))
+(defvar cvs-edit-log-revision)
(defun cvs-mode-edit-log (rev &optional text)
"Edit the log message at point.
This is best called from a `log-view-mode' buffer."
(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."
(interactive (list (cvs-flags-query 'cvs-diff-flags "diff flags")))
(unless (listp flags) (error "flags should be a list of strings"))
(save-some-buffers)
- (let* ((filter 'diff)
- (marked (cvs-get-marked (cvs-ignore-marks-p "diff")))
- ;;(tins (cvs-filter-applicable filter marked))
+ (let* ((marked (cvs-get-marked (cvs-ignore-marks-p "diff")))
(fis (car (cvs-partition 'cvs-fileinfo->backup-file marked))))
(unless (consp fis)
(error "No files with a backup file selected!"))
;;
(defvar ediff-after-quit-destination-buffer)
+(defvar ediff-after-quit-hook-internal)
(defvar cvs-transient-buffers)
(defun cvs-ediff-startup-hook ()
(add-hook 'ediff-after-quit-hook-internal
;; 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 (call-process cvs-program nil '(t . nil) nil
- "-q" "update" "-p" "-r" rev file)))
+ (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)))))
(when (and res (not (and (equal 0 res))))
(error "Something went wrong retrieving revision %s: %s" rev res))
(set-buffer-modified-p nil)
(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))))
;; (equal (cvs-fileinfo->file (car fis)) ".")
(equal (cvs-fileinfo->dir (car fis)) ""))
(setq fis nil))
- (let* ((cvs-buf (current-buffer))
- (single-dir (or (not (listp cvs-execute-single-dir))
+ (let* ((single-dir (or (not (listp cvs-execute-single-dir))
(member cmd cvs-execute-single-dir)))
(parse (member cmd cvs-parse-known-commands))
(args (append cvsargs (list cmd) flags))
(setq postproc (if (cdr postproc) (cons 'progn postproc) (car postproc)))
(cvs-update-header args fis)
(with-current-buffer buf
- ;;(set (make-local-variable 'cvs-buffer) cvs-buf)
(let ((inhibit-read-only t)) (erase-buffer))
(message "Running cvs %s ..." cmd)
(cvs-run-process args fis postproc single-dir))))
(defun* cvs-mode-do (cmd flags filter
- &key show dont-change-disc parse cvsargs postproc)
+ &key show dont-change-disc cvsargs postproc)
"Generic cvs-mode-<foo> function.
Executes `cvs CVSARGS CMD FLAGS' on the selected files.
FILTER is passed to `cvs-applicable-p' to only apply the command to
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))
- (when (ignore-errors (mouse-set-point e) t) ;for invocation via the mouse
- (unless (memq (get-text-property (1- (line-end-position)) 'font-lock-face)
- '(cvs-header-face cvs-filename-face))
- (error "Not a file name")))
+ ;; If the event moves point, check that it moves it to a valid location.
+ (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))))
+ (error "Not a file name"))
(cvs-mode!
(lambda (&optional rev)
(interactive (list (cvs-prefix-get 'cvs-branch-prefix)))
(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)
(defvar cvs-tag-name "")
(defun-cvs-mode (cvs-mode-tag . SIMPLE) (tag &optional flags)
"Run `cvs tag TAG' on all selected files.
-With prefix argument, prompt for cvs flags."
+With prefix argument, prompt for cvs flags.
+By default this can only be used on directories.
+Use \\[cvs-mode-force-command] or change `cvs-force-dir-tag' if you need
+to use it on individual files."
(interactive
(list (setq cvs-tag-name
(cvs-query-read cvs-tag-name "Tag name: " cvs-qtypedesc-tag))
"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)))))
(string-match "\\`-" (car flags)))
(pop flags))
;; don't parse output we don't understand.
- (member (car flags) cvs-parse-known-commands)))
+ (member (car flags) cvs-parse-known-commands))
+ ;; Don't parse "update -p" output.
+ (not (and (member (car flags) '("update" "checkout"))
+ (let ((found-p nil))
+ (dolist (flag flags found-p)
+ (if (equal flag "-p") (setq found-p t)))))))
(save-current-buffer
(let ((buffer (current-buffer))
(dir default-directory)
\f
(provide 'pcvs)
+;; arch-tag: 8e3a7494-0453-4389-9ab3-a557ce9fab61
;;; pcvs.el ends here