;;; pcvs.el -- A Front-end to CVS.
-;; Copyright (C) 1991-2000 Free Software Foundation, Inc.
+;; Copyright (C) 1991,92,93,94,95,95,97,98,99,2000 Free Software Foundation, Inc.
;; Author: (The PCL-CVS Trust) pcl-cvs@cyclic.com
;; (Per Cederqvist) ceder@lysator.liu.se
;; (Jari Aalto+mail.emacs) jari.aalto@poboxes.com
;; Maintainer: (Stefan Monnier) monnier+lists/cvs/pcl@flint.cs.yale.edu
;; Keywords: CVS, version control, release management
-;; Version: $Name: $
-;; Revision: $Id: pcvs.el,v 1.12 2000/10/08 19:11:34 monnier Exp $
+;; Revision: $Id: pcvs.el,v 1.25 2001/01/29 20:22:28 monnier Exp $
;; This file is part of GNU Emacs.
;; To use PCL-CVS just use `M-x cvs-examine RET <dir> RET'.
;; There is a TeXinfo manual, which can be helpful to get started.
+;;; Bugs:
+
+;; - can somehow ignore important messages like `co aborted' or
+;; or `co: output error: No space left on device'.
+
;;; Todo:
;; ******** FIX THE DOCUMENTATION *********
;;
+;; - rework the displaying of error messages.
;; - use UP-TO-DATE rather than DEAD when cleaning before `examine'.
+;; - allow to flush messages only
+;; - allow to protect files like ChangeLog from flushing
+;; - automatically cvs-mode-insert files from find-file-hook
+;; (and don't flush them as long as they are visited)
+;; - query the user for cvs-get-marked (for some cmds or if nothing's selected)
+;; - don't return the first (resp last) FI if the cursor is before
+;; (resp after) it.
+;; - allow cvs-confirm-removals to force always confirmation.
+;; - cvs-checkout should ask for a revision (with completion).
+;; - removal confirmation should allow specifying another file name.
;;
;; - hide fileinfos without getting rid of them (will require ewok work).
;; - add toolbar entries
(let ((cvs-minor-current-files
(list (ewoc-data (ewoc-locate
cvs-cookies (posn-point (event-end e)))))))
- (popup-menu cvs-menu-map e)))
+ (popup-menu cvs-menu e)))
(defvar cvs-mode-line-process nil
"Mode-line control for displaying info on cvs process status.")
;;;;
-(define-minor-mode
- cvs-minor-mode
- "
-This mode is used for buffers related to a main *cvs* buffer.
+(define-minor-mode cvs-minor-mode
+ "This mode is used for buffers related to a main *cvs* buffer.
All the `cvs-mode' buffer operations are simply rebound under
-the \\[cvs-mode-map] prefix.
-"
- nil " CVS")
+the \\[cvs-mode-map] prefix."
+ nil " CVS")
(put 'cvs-minor-mode 'permanent-local t)
(mapcar 'cvs-fileinfo->full-path fis))))
(str (if args (concat "-- Running " cvs-program " " arg " ...\n")
"\n")))
- (if nil (insert str) ;inline
+ (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))))))
+ (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))))))
(defun cvs-sentinel (proc msg)
(defun-cvs-mode (cvs-mode-revert-buffer . SIMPLE)
(&optional ignore-auto noconfirm)
- "Rerun `cvs-examine' on the current directory with the defauls flags."
+ "Rerun `cvs-examine' on the current directory with the default flags."
(interactive)
(cvs-examine default-directory t))
;; (tin-delete cookies
;; (tin-nth cookies 1)))
;; Check if CVS is waiting for a lock.
- (beginning-of-line 0) ;Move to beginning of last complete line.
+ (beginning-of-line 0) ;Move to beginning of last complete line.
(when (looking-at "^[ a-z]+: \\(.*waiting for .*lock in \\(.*\\)\\)$")
(let ((msg (match-string 1))
(lock (match-string 2)))
(error "Inconsistent %s in buffer %s" check (buffer-name buf)))))
-(defun-cvs-mode cvs-mode-quit ()
+(defun cvs-mode-quit ()
"Quit PCL-CVS, killing the *cvs* buffer."
(interactive)
(and (y-or-n-p "Quit pcl-cvs? ") (kill-buffer (current-buffer))))
"Display help for various PCL-CVS commands."
(interactive)
(if (eq last-command 'cvs-help)
- (describe-function 'cvs-mode) ; would need to use minor-mode for cvs-edit-mode
+ (describe-function 'cvs-mode) ; would need minor-mode for log-edit-mode
(message
(substitute-command-keys
"`\\[cvs-help]':help `\\[cvs-mode-add]':add `\\[cvs-mode-commit]':commit \
`\\[cvs-mode-remove]':remove `\\[cvs-mode-status]':status \
`\\[cvs-mode-undo]':undo"))))
-(defun cvs-mode-diff-help ()
- "Display help for various PCL-CVS diff commands."
- (interactive)
- (if (eq last-command 'cvs-mode-diff-help)
- (describe-function 'cvs-mode) ; no better docs for diff stuff?
- (message
- (substitute-command-keys
- "`\\[cvs-mode-diff]':diff `\\[cvs-mode-idiff]':idiff \
-`\\[cvs-mode-diff-head]':head `\\[cvs-mode-diff-vendor]':vendor \
-`\\[cvs-mode-diff-backup]':backup `\\[cvs-mode-idiff-other]':other \
-`\\[cvs-mode-imerge]':imerge"))))
-
;; Move around in the buffer
(defun-cvs-mode cvs-mode-previous-line (arg)
(when (cvs-dir-member-p f dir)
(setf (cvs-fileinfo->marked f)
(not (if (eq arg 'toggle) (cvs-fileinfo->marked f) arg)))
- t)) ;Tell cookie to redisplay this cookie.
+ t)) ;Tell cookie to redisplay this cookie.
cvs-cookies
(cvs-fileinfo->dir fi))
;; not a directory: just do the obvious
"Mark all files."
(interactive)
(ewoc-map (lambda (cookie)
- (unless (eq (cvs-fileinfo->type cookie) 'DIRCHANGE)
- (setf (cvs-fileinfo->marked cookie) t)))
- cvs-cookies))
+ (unless (eq (cvs-fileinfo->type cookie) 'DIRCHANGE)
+ (setf (cvs-fileinfo->marked cookie) t)))
+ cvs-cookies))
(defun-cvs-mode cvs-mode-mark-matching-files (regex)
"Mark all files matching REGEX."
(interactive "sMark files matching: ")
(ewoc-map (lambda (cookie)
- (when (and (not (eq (cvs-fileinfo->type cookie) 'DIRCHANGE))
- (string-match regex (cvs-fileinfo->file cookie)))
- (setf (cvs-fileinfo->marked cookie) t)))
- cvs-cookies))
+ (when (and (not (eq (cvs-fileinfo->type cookie) 'DIRCHANGE))
+ (string-match regex (cvs-fileinfo->file cookie)))
+ (setf (cvs-fileinfo->marked cookie) t)))
+ cvs-cookies))
(defun-cvs-mode cvs-mode-unmark-all-files ()
"Unmark all files.
they should always be unmarked."
(interactive)
(ewoc-map (lambda (cookie)
- (setf (cvs-fileinfo->marked cookie) nil)
- t)
- cvs-cookies))
+ (setf (cvs-fileinfo->marked cookie) nil)
+ t)
+ cvs-cookies))
(defun-cvs-mode cvs-mode-unmark-up ()
"Unmark the file on the previous line."
(mapcar 'cdr cvs-ignore-marks-alternatives)
(cvs-qtypedesc-create
(lambda (str) (cdr (assoc str cvs-ignore-marks-alternatives)))
- (lambda (obj) (caar (member* obj cvs-ignore-marks-alternatives :key 'cdr)))
+ (lambda (obj) (car (rassoc obj cvs-ignore-marks-alternatives)))
(lambda () cvs-ignore-marks-alternatives)
nil t))
'UNKNOWN (or dir "") file ""))))))
cvs-minor-current-files)
(or (and (not ignore-marks)
- (ewoc-collect cvs-cookies
- 'cvs-fileinfo->marked))
+ (ewoc-collect cvs-cookies 'cvs-fileinfo->marked))
(list (ewoc-data (ewoc-locate cvs-cookies))))))
(if (or ignore-contents (not (eq (cvs-fileinfo->type fi) 'DIRCHANGE)))
(push fi fis)
;; If a directory is selected, return members, if any.
(setq fis
- (append (ewoc-collect cvs-cookies
- 'cvs-dir-member-p
- (cvs-fileinfo->dir fi))
+ (append (ewoc-collect
+ cvs-cookies 'cvs-dir-member-p (cvs-fileinfo->dir fi))
fis))))
(nreverse fis)))
-(defun* cvs-mode-marked (filter &optional (cmd (symbol-name filter))
- &key read-only one file)
+(defun* cvs-mode-marked (filter &optional cmd
+ &key read-only one file noquery)
"Get the list of marked FIS.
CMD is used to determine whether to use the marks or not.
Only files for which FILTER is applicable are returned.
If READ-ONLY is non-nil, the current toggling is left intact.
If ONE is non-nil, marks are ignored and a single FI is returned.
If FILE is non-nil, directory entries won't be selected."
+ (unless cmd (setq cmd (symbol-name filter)))
(let* ((fis (cvs-get-marked (or one (cvs-ignore-marks-p cmd read-only))
- (and (not file)
- (cvs-applicable-p 'DIRCHANGE filter))))
+ (and (not file)
+ (cvs-applicable-p 'DIRCHANGE filter))))
(force (cvs-prefix-get 'cvs-force-command))
(fis (car (cvs-partition
(lambda (fi) (cvs-applicable-p fi (and (not force) filter)))
fis))))
- (cond
- ((null fis)
- (error "`%s' is not applicable to any of the selected files." filter))
- ((and one (cdr fis))
- (error "`%s' is only applicable to a single file." cmd))
- (one (car fis))
- (t fis))))
+ (when (and (or (null fis) (and one (cdr fis))) (not noquery))
+ (message (if (null fis)
+ "`%s' is not applicable to any of the selected files."
+ "`%s' is only applicable to a single file.") cmd)
+ (sit-for 1)
+ (setq fis (list (cvs-insert-file
+ (read-file-name (format "File to %s: " cmd))))))
+ (if one (car fis) fis)))
(defun cvs-enabledp (filter)
"Determine whether FILTER applies to at least one of the selected files."
- (ignore-errors (cvs-mode-marked filter nil :read-only t)))
+ (ignore-errors (cvs-mode-marked filter nil :read-only t :noquery t)))
(defun cvs-mode-files (&rest -cvs-mode-files-args)
(cvs-mode!
(apply 'cvs-mode-marked -cvs-mode-files-args)))))
;;;
-;;; Interface between CVS-Edit and PCL-CVS
+;;; Interface between Log-Edit and PCL-CVS
;;;
(defun cvs-mode-commit-setup ()
The user will be asked for a log message in a buffer.
The buffer's mode and name is determined by the \"message\" setting
of `cvs-buffer-name-alist'.
-The POSTPROC specified there (typically `cvs-edit') is then called,
+The POSTPROC specified there (typically `log-edit') is then called,
passing it the SETUP argument."
(interactive "P")
;; It seems that the save-excursion that happens if I use the better
;; form of `(cvs-mode! (lambda ...))' screws up a couple things which
- ;; end up being rather annoying (like cvs-edit-mode's message being
+ ;; end up being rather annoying (like log-edit-mode's message being
;; displayed in the wrong minibuffer).
(cvs-mode!)
- (pop-to-buffer (cvs-temp-buffer "message" 'normal 'nosetup))
- (set (make-local-variable 'cvs-minor-wrap-function) 'cvs-commit-minor-wrap)
- (let ((lbd list-buffers-directory)
+ (let ((buf (cvs-temp-buffer "message" 'normal 'nosetup))
+ (lbd list-buffers-directory)
(setupfun (or (nth 2 (cdr (assoc "message" cvs-buffer-name-alist)))
- 'cvs-edit)))
- (funcall setupfun 'cvs-do-commit setup 'cvs-commit-filelist)
+ '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)))
(defun cvs-commit-minor-wrap (buf f)
(let ((cvs-ignore-marks-modif (cvs-mode-mark-get-modif "commit")))
(funcall f)))
-(defun cvs-commit-filelist () (cvs-mode-files 'commit nil :read-only t :file t))
+(defun cvs-commit-filelist ()
+ (cvs-mode-files 'commit nil :read-only t :file t :noquery t))
(defun cvs-do-commit (flags)
"Do the actual commit, using the current buffer as the log message."
(defun-cvs-mode (cvs-mode-insert . NOARGS) (file)
"Insert an entry for a specific file."
(interactive
- (list (read-file-name "File to insert: " nil nil nil
+ (list (read-file-name "File to insert: "
;; Can't use ignore-errors here because interactive
;; specs aren't byte-compiled.
(condition-case nil
- (cvs-fileinfo->dir
- (car (cvs-mode-marked nil nil :read-only t)))
+ (file-name-as-directory
+ (expand-file-name
+ (cvs-fileinfo->dir
+ (car (cvs-mode-marked nil nil :read-only t)))))
(error nil)))))
+ (cvs-insert-file file))
+
+(defun cvs-insert-file (file)
+ "Insert FILE (and its contents if it's a dir) and return its FI."
(let ((file (file-relative-name (directory-file-name file))) last)
(dolist (fi (cvs-fileinfo-from-entries file))
(setq last (cvs-addto-collection cvs-cookies fi last)))
;; There should have been at least one entry.
- (goto-char (ewoc-location last))))
+ (goto-char (ewoc-location last))
+ (ewoc-data last)))
+
+(defun cvs-mark-fis-dead (fis)
+ ;; Helper function, introduced because of the need for macro-expansion.
+ (dolist (fi fis)
+ (setf (cvs-fileinfo->type fi) 'DEAD)))
(defun-cvs-mode (cvs-mode-add . SIMPLE) (flags)
"Add marked files to the cvs repository.
`((cvs-run-process (list "-n" "update")
',dirs
'(cvs-parse-process t))
- (dolist (fi ',dirs) (setf (cvs-fileinfo->type fi) 'DEAD))))))
+ (cvs-mark-fis-dead ',dirs)))))
(cvs-mode-run "add" flags fis :postproc postproc))))
(defun-cvs-mode (cvs-mode-diff . DOUBLE) (flags)
(let* ((filter 'diff)
(marked (cvs-get-marked (cvs-ignore-marks-p "diff")))
;;(tins (cvs-filter-applicable filter marked))
- (fis (delete-if-not 'cvs-fileinfo->backup-file marked)))
+ (fis (car (cvs-partition 'cvs-fileinfo->backup-file marked))))
(unless (consp fis)
- (error "No files with a backup file selected!"))
+ (error "No files with a backup file selected!"))
;; let's extract some info into the environment for `buffer-name'
(let* ((dir (cvs-fileinfo->dir (car fis)))
(file (cvs-fileinfo->file (car fis))))
(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->file fileinfo))))
+ (list backup-file (cvs-fileinfo->full-path fileinfo))))
;;
;; Emerge support
(rev2-buf (if rev2 (cvs-retrieve-revision fi rev2)))
;; this binding is used by cvs-ediff-startup-hook
(cvs-transient-buffers (list rev1-buf rev2-buf)))
- (funcall (car cvs-idiff-imerge-handlers)
- rev1-buf (or rev2-buf (find-file-noselect file))))))
+ (funcall (car cvs-idiff-imerge-handlers)
+ rev1-buf (or rev2-buf (find-file-noselect file))))))
(defun-cvs-mode (cvs-mode-idiff-other . NOARGS) ()
"Diff interactively current file to revisions."
"Mark a fileinfo xor its members (in case of a directory) as dead."
(if (eq (cvs-fileinfo->type fi) 'DIRCHANGE)
(dolist (fi (ewoc-collect c 'cvs-dir-member-p
- (cvs-fileinfo->dir fi)))
+ (cvs-fileinfo->dir fi)))
(setf (cvs-fileinfo->type fi) 'DEAD))
(setf (cvs-fileinfo->type fi) 'DEAD)))
(cvs-mode-run "status" (cons "-v" flags) (cvs-mode-marked nil "status")
:buf (cvs-temp-buffer "tree")
:dont-change-disc t
- :postproc '((cvs-status-trees))))
+ :postproc '((cvs-status-cvstrees))))
;; cvs log
"Remove files.
Returns a list of FIS that should be `cvs remove'd."
(let* ((files (cvs-mode-marked filter cmd :file t :read-only t))
- (fis (delete-if (lambda (fi) (eq (cvs-fileinfo->type fi) 'UNKNOWN))
- (cvs-mode-marked filter cmd)))
+ (fis (cdr (cvs-partition (lambda (fi)
+ (eq (cvs-fileinfo->type fi) 'UNKNOWN))
+ (cvs-mode-marked filter cmd))))
(silent (or (not cvs-confirm-removals)
(cvs-every (lambda (fi)
(or (not (file-exists-p
(cvs-fileinfo->full-path fi)))
(cvs-applicable-p fi 'safe-rm)))
- files))))
+ files)))
+ (tmpbuf (cvs-temp-buffer)))
(when (and (not silent) (equal cvs-confirm-removals 'list))
- (save-excursion
- (pop-to-buffer (cvs-temp-buffer))
- (dolist (fi fis)
- (insert (cvs-fileinfo->full-path fi) "\n"))))
+ (with-current-buffer tmpbuf
+ (cvs-insert-strings (mapcar 'cvs-fileinfo->full-path fis))
+ (cvs-pop-to-buffer-same-frame (current-buffer))
+ (shrink-window-if-larger-than-buffer)))
(if (not (or silent
- (yes-or-no-p (format "Delete %d files? " (length files)))))
+ (unwind-protect
+ (yes-or-no-p (format "Delete %d files? " (length files)))
+ (cvs-bury-buffer tmpbuf cvs-buffer))))
(progn (message "Aborting") nil)
(dolist (fi files)
(let* ((type (cvs-fileinfo->type fi))
(let* ((fi (cvs-mode-marked nil nil :one t))
(default-directory (cvs-expand-dir-name (cvs-fileinfo->dir fi)))
(buffer-file-name (expand-file-name (cvs-fileinfo->file fi))))
- ;; This `save-excursion' is necessary because of interaction between
- ;; dynamic scoping and buffer-local variables:
- ;; the above binding of `buffer-file-name' has temporarily changed the
- ;; buffer-local variable (same thing for `default-directory'), so we
- ;; need to switch back to the original buffer before the unbinding
- ;; restores the old value.
- (save-excursion (add-change-log-entry-other-window))))
+ (kill-local-variable 'change-log-default-name)
+ (add-change-log-entry-other-window)))
;; interactive commands to set optional flags
(defun cvs-execute-single-file (fi extractor program constant-args)
"Internal function for `cvs-execute-single-file-list'."
- (let* ((cur-dir (cvs-fileinfo->dir fi))
- (default-directory (cvs-expand-dir-name cur-dir))
- (inhibit-read-only t)
- (arg-list (funcall extractor fi)))
+ (let* ((arg-list (funcall extractor fi))
+ (inhibit-read-only t))
;; Execute the command unless extractor returned t.
(when (listp arg-list)
(let* ((args (append constant-args arg-list)))
- (insert (format "=== cd %s\n=== %s %s\n\n"
- cur-dir program (cvs-strings->string args)))
+ (insert (format "=== %s %s\n\n"
+ program (cvs-strings->string args)))
;; FIXME: return the exit status?
(apply 'call-process program nil t t args)
;; FIXME: make this run in the background ala cvs-run-process...
(defun cvs-execute-single-file-list (fis extractor program constant-args)
"Run PROGRAM on all elements on FIS.
-The PROGRAM will be called with pwd set to the directory the files
-reside in. CONSTANT-ARGS is a list of strings to pass as arguments to
-PROGRAM. The arguments given to the program will be CONSTANT-ARGS
-followed by the list that EXTRACTOR returns.
+CONSTANT-ARGS is a list of strings to pass as arguments to PROGRAM.
+The arguments given to the program will be CONSTANT-ARGS followed by
+the list that EXTRACTOR returns.
EXTRACTOR will be called once for each file on FIS. It is given
one argument, the cvs-fileinfo. It can return t, which means ignore
(add-hook 'after-save-hook 'cvs-mark-buffer-changed)
-;;
-;; hook into uniquify
-;;
-
-(defadvice uniquify-buffer-file-name (after pcl-cvs-uniquify activate)
- (or ad-return-value
- (save-excursion
- (set-buffer (ad-get-arg 0))
- (when (eq major-mode 'cvs-mode)
- (setq ad-return-value list-buffers-directory)))))
-
\f
(provide 'pcvs)
HCoop / bpt / emacs.git / blobdiff