;;; 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.14 2000/11/03 22:34:26 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
;; - don't return the first (resp last) FI if the cursor is before
;; (resp after) it.
;; - allow cvs-confirm-removals to force always confirmation.
-;; also, use a fancier "temp buffer popup scheme".
;; - cvs-checkout should ask for a revision (with completion).
;; - removal confirmation should allow specifying another file name.
;;
(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.")
(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))
(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 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)
(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))
(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))
+(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.
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))))
(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 0.5)
+ (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."
- (cvs-mode-marked filter nil :read-only t :noquery 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."
;; Can't use ignore-errors here because interactive
;; specs aren't byte-compiled.
(condition-case nil
- (expand-file-name
- (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))
(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.
With prefix argument, prompt for cvs flags."
`((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!"))
;; let's extract some info into the environment for `buffer-name'
(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
"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))
(interactive)
(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)))
- change-log-default-name)
+ (buffer-file-name (expand-file-name (cvs-fileinfo->file fi))))
+ (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