]> code.delx.au - gnu-emacs/blobdiff - lisp/pcvs.el
Add a provide statement.
[gnu-emacs] / lisp / pcvs.el
index 300ed10c9cda65aefa65d4a0d4990d76dd280946..0c8fe92f2d6fe75976a3ddd4763b735e4d4e4c1f 100644 (file)
@@ -1,7 +1,7 @@
 ;;; 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
@@ -12,7 +12,7 @@
 ;;     (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.
@@ -669,6 +669,14 @@ DCD is the `dont-change-disc' flag to use when parsing that output.
 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
@@ -756,7 +764,7 @@ 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."
@@ -915,6 +923,21 @@ With a prefix argument, prompt for cvs FLAGS to use."
              (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.
@@ -1186,11 +1209,12 @@ marked instead. A directory can never be marked."
       (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 ()
@@ -1256,7 +1280,8 @@ they should always be unmarked."
   (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")
@@ -1302,10 +1327,7 @@ 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))
@@ -1558,6 +1580,18 @@ See ``cvs-mode-diff'' for more info."
   (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."
@@ -1744,7 +1778,7 @@ Signal an error if there is no backup file."
 
 
 (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)
@@ -1764,7 +1798,7 @@ BUF is the buffer to be used for cvs' output.
 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))))
@@ -1906,6 +1940,18 @@ to hear about anymore."
   (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
@@ -1916,12 +1962,12 @@ to hear about anymore."
       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))))
@@ -1944,8 +1990,10 @@ With a prefix, opens the buffer in an OTHER window."
         (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)))
@@ -2043,10 +2091,16 @@ Returns a list of FIS that should be `cvs remove'd."
          (shrink-window-if-larger-than-buffer))))
     (if (not (or silent
                 (unwind-protect
-                    (if (eq 1 (length files))
-                        (yes-or-no-p (format "Delete file: \"%s\" ? " 
-                                             (cvs-fileinfo->file (car files))))
-                      (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)
@@ -2108,8 +2162,8 @@ With prefix argument, prompt for cvs flags."
   "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)))))
 
@@ -2314,4 +2368,5 @@ The exact behavior is determined also by `cvs-dired-use-hook'."
 \f
 (provide 'pcvs)
 
+;; arch-tag: 8e3a7494-0453-4389-9ab3-a557ce9fab61
 ;;; pcvs.el ends here