-;;; pcvs.el --- a front-end to CVS
+;;; pcvs.el --- a front-end to CVS -*- lexical-binding:t -*-
-;; Copyright (C) 1991-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1991-2016 Free Software Foundation, Inc.
;; Author: (The PCL-CVS Trust) pcl-cvs@cyclic.com
;; (Per Cederqvist) ceder@lysator.liu.se
;; - rework the displaying of error messages.
;; - 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.
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'ewoc) ;Ewoc was once cookie
(require 'pcvs-defs)
(require 'pcvs-util)
(require 'pcvs-parse)
(require 'pcvs-info)
+(require 'vc-cvs)
\f
;;;;
(autoload 'cvs-status-get-tags "cvs-status")
(defun cvs-tags-list ()
"Return a list of acceptable tags, ready for completions."
- (assert (cvs-buffer-p))
+ (cl-assert (cvs-buffer-p))
(let ((marked (cvs-get-marked)))
- (list* '("BASE") '("HEAD")
- (when marked
- (with-temp-buffer
- (process-file cvs-program
- nil ;no input
- t ;output to current-buffer
- nil ;don't update display while running
- "status"
- "-v"
- (cvs-fileinfo->full-name (car marked)))
- (goto-char (point-min))
- (let ((tags (cvs-status-get-tags)))
- (when (listp tags) tags)))))))
+ `(("BASE") ("HEAD")
+ ,@(when marked
+ (with-temp-buffer
+ (process-file cvs-program
+ nil ;no input
+ t ;output to current-buffer
+ nil ;don't update display while running
+ "status"
+ "-v"
+ (cvs-fileinfo->full-name (car marked)))
+ (goto-char (point-min))
+ (let ((tags (cvs-status-get-tags)))
+ (when (listp tags) tags)))))))
(defvar cvs-tag-history nil)
(defconst cvs-qtypedesc-tag
(defun cvs-temp-buffer (&optional cmd normal nosetup)
"Create a temporary buffer to run CMD in.
If CMD is a string, use it to lookup `cvs-buffer-name-alist' to find
-the buffer name to be used and its `major-mode'.
+the buffer name to be used and its major mode.
The selected window will not be changed. The new buffer will not maintain undo
information and will be read-only unless NORMAL is non-nil. It will be emptied
-\(unless NOSETUP is non-nil\) and its `default-directory' will be inherited
+\(unless NOSETUP is non-nil) and its `default-directory' will be inherited
from the current buffer."
(let* ((cvs-buf (current-buffer))
(info (cdr (assoc cmd cvs-buffer-name-alist)))
- (name (eval (nth 0 info)))
+ (name (eval (nth 0 info) `((cmd . ,cmd))))
(mode (nth 1 info))
(dir default-directory)
(buf (cond
(t
(set (make-local-variable 'cvs-temp-buffer)
(cvs-get-buffer-create
- (eval cvs-temp-buffer-name) 'noreuse))))))
+ (eval cvs-temp-buffer-name `((dir . ,dir)))
+ 'noreuse))))))
- ;; handle the potential pre-existing process
+ ;; Handle the potential pre-existing process.
(let ((proc (get-buffer-process buf)))
(when (and (not normal) (processp proc)
(memq (process-status proc) '(run stop)))
If non-nil, NEW means to create a new buffer no matter what."
;; the real cvs-buffer creation
(setq dir (cvs-expand-dir-name dir))
- (let* ((buffer-name (eval cvs-buffer-name))
+ (let* ((buffer-name (eval cvs-buffer-name `((dir . ,dir))))
(buffer
(or (and (not new)
(eq cvs-reuse-cvs-buffer 'current)
;; look for another cvs buffer visiting the same directory
(save-excursion
(unless new
- (dolist (buffer (cons (current-buffer) (buffer-list)))
+ (cl-dolist (buffer (cons (current-buffer) (buffer-list)))
(set-buffer buffer)
(and (cvs-buffer-p)
- (case cvs-reuse-cvs-buffer
- (always t)
- (subdir
+ (pcase cvs-reuse-cvs-buffer
+ (`always t)
+ (`subdir
(or (string-prefix-p default-directory dir)
(string-prefix-p dir default-directory)))
- (samedir (string= default-directory dir)))
- (return buffer)))))
+ (`samedir (string= default-directory dir)))
+ (cl-return buffer)))))
;; we really have to create a new buffer:
;; we temporarily bind cwd to "" to prevent
;; create-file-buffer from using directory info
;;(set-buffer buf)
buffer))))))
-(defun* cvs-cmd-do (cmd dir flags fis new
+(cl-defun cvs-cmd-do (cmd dir flags fis new
&key cvsargs noexist dont-change-disc noshow)
(let* ((dir (file-name-as-directory
(abbreviate-file-name (expand-file-name dir))))
;; cvsbuf))))
(defun cvs-run-process (args fis postprocess &optional single-dir)
- (assert (cvs-buffer-p cvs-buffer))
+ (cl-assert (cvs-buffer-p cvs-buffer))
(save-current-buffer
(let ((procbuf (current-buffer))
(cvsbuf cvs-buffer)
(let ((inhibit-read-only t))
(insert "pcl-cvs: descending directory " dir "\n"))
;; loop to find the same-dir-elems
- (do* ((files () (cons (cvs-fileinfo->file fi) files))
- (fis fis (cdr fis))
- (fi (car fis) (car fis)))
+ (cl-do* ((files () (cons (cvs-fileinfo->file fi) files))
+ (fis fis (cdr fis))
+ (fi (car fis) (car fis)))
((not (and fis (string= dir (cvs-fileinfo->dir fi))))
(list dir files fis))))))
(dir (nth 0 dir+files+rest))
process 'cvs-postprocess
(if (null rest)
;; this is the last invocation
- postprocess
+ postprocess
;; else, we have to register ourselves to be rerun on the rest
- `(cvs-run-process ',args ',rest ',postprocess ',single-dir)))
+ (lambda () (cvs-run-process args rest postprocess single-dir))))
(set-process-sentinel process 'cvs-sentinel)
(set-process-filter process 'cvs-update-filter)
(set-marker (process-mark process) (point-max))
done))))
-(defun cvs-sentinel (proc msg)
+(defun cvs-sentinel (proc _msg)
"Sentinel for the cvs update process.
This is responsible for parsing the output from the cvs update when
it is finished."
(error "cvs' process buffer was killed")
(with-current-buffer procbuf
;; Do the postprocessing like parsing and such.
- (save-excursion (eval cvs-postproc)))))))
+ (save-excursion
+ (funcall cvs-postproc)))))))
;; Check whether something is left.
(when (and procbuf (not (get-buffer-process procbuf)))
(with-current-buffer procbuf
ARGS and DOCSTRING are the normal argument list.
INTERACT is the interactive specification or nil for non-commands.
-STYLE can be either SIMPLE, NOARGS or DOUBLE. It's an error for it
+STYLE can be either `SIMPLE', `NOARGS' or `DOUBLE'. It's an error for it
to have any other value, unless other details of the function make it
clear what alternative to use.
-- SIMPLE will get all the interactive arguments from the original buffer.
-- NOARGS will get all the arguments from the *cvs* buffer and will
+- `SIMPLE' will get all the interactive arguments from the original buffer.
+- `NOARGS' will get all the arguments from the *cvs* buffer and will
always behave as if called interactively.
-- DOUBLE is the generic case."
- (declare (debug (&define sexp lambda-list stringp ("interactive" interactive) def-body))
+- `DOUBLE' is the generic case."
+ (declare (debug (&define sexp lambda-list stringp
+ ("interactive" interactive) def-body))
(doc-string 3))
(let ((style (cvs-cdr fun))
(fun (cvs-car fun)))
(while (and tin (cvs-fileinfo< fi (ewoc-data tin)))
(setq tin (ewoc-prev c tin)))
(if (null tin) (ewoc-enter-first c fi) ;empty collection
- (assert (not (cvs-fileinfo< fi (ewoc-data tin))))
+ (cl-assert (not (cvs-fileinfo< fi (ewoc-data tin))))
(let ((next-tin (ewoc-next c tin)))
(while (not (or (null next-tin)
(cvs-fileinfo< fi (ewoc-data next-tin))))
(defun cvs-cleanup-collection (c rm-handled rm-dirs rm-msgs)
"Remove undesired entries.
C is the collection
-RM-HANDLED if non-nil means remove handled entries.
+RM-HANDLED if non-nil means remove handled entries (if file is currently
+ visited, only remove if value is `all').
RM-DIRS behaves like `cvs-auto-remove-directories'.
RM-MSGS if non-nil means remove messages."
(let (last-fi first-dir (rerun t))
(let* ((type (cvs-fileinfo->type fi))
(subtype (cvs-fileinfo->subtype fi))
(keep
- (case type
- ;; remove temp messages and keep the others
- (MESSAGE (not (or rm-msgs (eq subtype 'TEMP))))
- ;; remove entries
- (DEAD nil)
- ;; handled also?
- (UP-TO-DATE (not rm-handled))
- ;; keep the rest
- (t (not (run-hook-with-args-until-success
+ (pcase type
+ ;; Remove temp messages and keep the others.
+ (`MESSAGE (not (or rm-msgs (eq subtype 'TEMP))))
+ ;; Remove dead entries.
+ (`DEAD nil)
+ ;; Handled also?
+ (`UP-TO-DATE
+ (not
+ (if (find-buffer-visiting (cvs-fileinfo->full-name fi))
+ (eq rm-handled 'all)
+ rm-handled)))
+ ;; Keep the rest.
+ (_ (not (run-hook-with-args-until-success
'cvs-cleanup-functions fi))))))
;; mark dirs for removal
(setq rerun t)))))
(defun cvs-get-cvsroot ()
- "Gets the CVSROOT for DIR."
+ "Get the CVSROOT for DIR."
(let ((cvs-cvsroot-file (expand-file-name "Root" "CVS")))
(or (cvs-file-to-string cvs-cvsroot-file t)
cvs-cvsroot
;;;###autoload
(defun cvs-checkout (modules dir flags &optional root)
- "Run a 'cvs checkout MODULES' in DIR.
+ "Run a `cvs checkout MODULES' in DIR.
Feed the output to a *cvs* buffer, display it in the current window,
and run `cvs-mode' on it.
:noexist t)))
(defun-cvs-mode (cvs-mode-checkout . NOARGS) (dir)
- "Run cvs checkout against the current branch.
+ "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)
- ""))))
+ (prompt (format-message "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 (split-string-and-unquote (cvs-get-module)))
(flags (cvs-add-branch-prefix
;;;;
(defun-cvs-mode (cvs-mode-revert-buffer . SIMPLE)
- (&optional ignore-auto noconfirm)
+ (&optional _ignore-auto _noconfirm)
"Rerun `cvs-examine' on the current directory with the default flags."
(interactive)
(cvs-examine default-directory t))
(read-directory-name prompt nil default-directory nil)))
;;;###autoload
-(defun cvs-quickdir (dir &optional flags noshow)
+(defun cvs-quickdir (dir &optional _flags noshow)
"Open a *cvs* buffer on DIR without running cvs.
With a prefix argument, prompt for a directory to use.
A prefix arg >8 (ex: \\[universal-argument] \\[universal-argument]),
:noshow noshow :dont-change-disc t))
(defun cvs-update-filter (proc string)
- "Filter function for pcl-cvs.
+ "Filter function for PCL-CVS.
This function gets the output that CVS sends to stdout. It inserts
the STRING into (process-buffer PROC) but it also checks if CVS is waiting
for a lock file. If so, it inserts a message cookie in the *cvs* buffer."
(defun-cvs-mode cvs-mode-mark (&optional arg)
"Mark the fileinfo on the current line.
If the fileinfo is a directory, all the contents of that directory are
-marked instead. A directory can never be marked."
+marked instead. A directory can never be marked."
(interactive)
(let* ((tin (ewoc-locate cvs-cookies))
(fi (ewoc-data tin)))
fis))))
(nreverse fis)))
-(defun* cvs-mode-marked (filter &optional cmd
- &key read-only one file noquery)
+(cl-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.
(set (make-local-variable 'cvs-minor-wrap-function) 'cvs-commit-minor-wrap)
(run-hooks 'cvs-mode-commit-hook)))
-(defun cvs-commit-minor-wrap (buf f)
+(defun cvs-commit-minor-wrap (_buf f)
(let ((cvs-ignore-marks-modif (cvs-mode-mark-get-modif "commit")))
(funcall f)))
(let ((msg (buffer-substring-no-properties (point-min) (point-max))))
(cvs-mode!)
;;(pop-to-buffer cvs-buffer)
- (cvs-mode-do "commit" (list* "-m" msg flags) 'commit)))
+ (cvs-mode-do "commit" `("-m" ,msg ,@flags) 'commit)))
;;;; Editing existing commit log messages.
(interactive (list (cvs-flags-query 'cvs-add-flags "cvs add flags")))
(let ((fis (cvs-mode-marked 'add))
(needdesc nil) (dirs nil))
- ;; find directories and look for fis needing a description
+ ;; Find directories and look for fis needing a description.
(dolist (fi fis)
(cond
((file-directory-p (cvs-fileinfo->full-name fi)) (push fi dirs))
((eq (cvs-fileinfo->type fi) 'UNKNOWN) (setq needdesc t))))
- ;; prompt for description if necessary
+ ;; Prompt for description if necessary.
(let* ((msg (if (and needdesc
(or current-prefix-arg (not cvs-add-default-message)))
(read-from-minibuffer "Enter description: ")
(or cvs-add-default-message "")))
- (flags (list* "-m" msg flags))
+ (flags `("-m" ,msg ,@flags))
(postproc
- ;; setup postprocessing for the directory entries
+ ;; Setup postprocessing for the directory entries.
(when dirs
- `((cvs-run-process (list "-n" "update")
- ',dirs
- '(cvs-parse-process t))
- (cvs-mark-fis-dead ',dirs)))))
+ (lambda ()
+ (cvs-run-process (list "-n" "update")
+ dirs
+ (lambda () (cvs-parse-process t)))
+ (cvs-mark-fis-dead dirs)))))
(cvs-mode-run "add" flags fis :postproc postproc))))
(defun-cvs-mode (cvs-mode-diff . DOUBLE) (flags)
"Diff the selected files against the repository.
This command compares the files in your working area against the
-revision which they are based upon."
+revision which they are based upon.
+See also `cvs-diff-ignore-marks'."
(interactive
(list (cvs-add-branch-prefix
(cvs-add-secondary-branch-prefix
(defun-cvs-mode (cvs-mode-diff-head . SIMPLE) (flags)
"Diff the selected files against the head of the current branch.
-See ``cvs-mode-diff'' for more info."
+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."
+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."
+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."
+See `cvs-mode-diff' for more info."
(interactive (list (cvs-flags-query 'cvs-diff-flags "cvs diff flags")))
(cvs-mode-diff-1 (cons (concat "-r" cvs-vendor-branch) flags)))
(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* ((dir (cvs-fileinfo->dir (car fis)))
- (file (cvs-fileinfo->file (car fis))))
- (set-buffer (cvs-temp-buffer "diff")))
+ (set-buffer (cvs-temp-buffer "diff"))
(message "cvs diff backup...")
(cvs-execute-single-file-list fis 'cvs-diff-backup-extractor
cvs-diff-program flags))
(set-buffer-modified-p nil)
(let ((buffer-file-name (expand-file-name file)))
(after-find-file))
- (toggle-read-only 1)
+ (setq buffer-read-only t)
(message "Retrieving revision %s... Done" rev)
(current-buffer))))))
(setq ret t)))
ret)))
-(defun* cvs-mode-run (cmd flags fis
- &key (buf (cvs-temp-buffer))
- dont-change-disc cvsargs postproc)
+(cl-defun cvs-mode-run (cmd flags fis
+ &key (buf (cvs-temp-buffer))
+ dont-change-disc cvsargs postproc)
"Generic cvs-mode-<foo> function.
Executes `cvs CVSARGS CMD FLAGS FIS'.
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' if necessary."
+POSTPROC is a function of no argument to be evaluated at the very end (after
+ parsing if applicable)."
+ (unless postproc (setq postproc #'ignore))
(let ((def-dir default-directory))
;; Save the relevant buffers
(save-some-buffers nil (lambda () (cvs-is-within-p fis def-dir))))
(cvs-cleanup-collection cvs-cookies ;cleanup remaining messages
(eq cvs-auto-remove-handled 'delayed) nil t)
(when (fboundp after-mode)
- (setq postproc (append postproc `((,after-mode)))))
+ (setq postproc (let ((pp postproc))
+ (lambda () (funcall pp) (funcall after-mode)))))
(when parse
(let ((old-fis
(when (member cmd '("status" "update")) ;FIXME: Yuck!!
;; 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)))
- (setq postproc (if (cdr postproc) (cons 'progn postproc) (car postproc)))
+ (or fis (list (cvs-create-fileinfo 'DIRCHANGE "" "." "")))))
+ (pp postproc))
+ (setq postproc (lambda ()
+ (cvs-parse-process dont-change-disc nil old-fis)
+ (funcall pp)))))
(with-current-buffer 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 cvsargs postproc)
+(cl-defun cvs-mode-do (cmd flags filter
+ &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
files for which it makes sense.
SHOW indicates that CMD should be not be run in the default temp buffer and
- should be shown to the user. The buffer and mode to be used is determined
+ should be shown to the user. The buffer and mode to be used are determined
by `cvs-buffer-name-alist'.
DONT-CHANGE-DISC non-nil indicates that the command will not change the
contents of files. This is only used by the parser."
(interactive (list (cvs-flags-query 'cvs-status-flags "cvs status flags")))
(cvs-mode-do "status" flags nil :dont-change-disc t :show t
:postproc (when (eq cvs-auto-remove-handled 'status)
- `((with-current-buffer ,(current-buffer)
- (cvs-mode-remove-handled))))))
+ (let ((buf (current-buffer)))
+ (lambda () (with-current-buffer buf
+ (cvs-mode-remove-handled)))))))
+
+(autoload 'cvs-status-cvstrees "cvs-status")
(defun-cvs-mode (cvs-mode-tree . SIMPLE) (flags)
"Call cvstree using the file under the point as a keyfile."
(cvs-mode-run "status" (cons "-v" flags) (cvs-mode-marked nil "status")
:buf (cvs-temp-buffer "tree")
:dont-change-disc t
- :postproc '((cvs-status-cvstrees))))
+ :postproc #'cvs-status-cvstrees))
;; cvs log
(cvs-mode-do "update" flags nil :cvsargs '("-n") :dont-change-disc t))
-(defun-cvs-mode cvs-mode-ignore (&optional pattern)
+(defun-cvs-mode cvs-mode-ignore ()
"Arrange so that CVS ignores the selected files.
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)
+ (vc-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))
-(declare-function vc-editable-p "vc" (file))
-(declare-function vc-checkout "vc" (file &optional writable rev))
-
-(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-checkout buffer-file-name t))
- (goto-char (point-max))
- (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)))
+(define-obsolete-function-alias 'cvs-append-to-ignore 'vc-cvs-append-to-ignore
+ "24.4")
(defun cvs-mode-find-file-other-window (e)
(defun cvs-mode-view-file-other-window (e)
- "View the file."
+ "View the file in another window."
(interactive (list last-input-event))
(cvs-mode-find-file e t t))
(cvs-mode-run "update" flags fis-other
:postproc
(when fis-removed
- `((with-current-buffer ,(current-buffer)
- (cvs-mode-run "add" nil ',fis-removed)))))))))
+ (let ((buf (current-buffer)))
+ (lambda ()
+ (with-current-buffer buf
+ (cvs-mode-run "add" nil fis-removed))))))))))
(defun-cvs-mode (cvs-mode-revert-to-rev . NOARGS) (rev)
(cvs-flags-query 'cvs-idiff-version)))))
(let* ((fis (cvs-mode-marked 'revert "revert" :file t))
(tag (concat "tmp_pcl_tag_" (make-temp-name "")))
- (untag `((with-current-buffer ,(current-buffer)
- (cvs-mode-run "tag" (list "-d" ',tag) ',fis))))
- (update `((with-current-buffer ,(current-buffer)
- (cvs-mode-run "update" (list "-j" ',tag "-j" ',rev) ',fis
- :postproc ',untag)))))
+ (buf (current-buffer))
+ (untag (lambda ()
+ (with-current-buffer buf
+ (cvs-mode-run "tag" (list "-d" tag) fis))))
+ (update (lambda ()
+ (with-current-buffer buf
+ (cvs-mode-run "update" (list "-j" tag "-j" rev) fis
+ :postproc untag)))))
(cvs-mode-run "tag" (list tag) fis :postproc update)))
Empty directories are removed."
(interactive)
(cvs-cleanup-collection cvs-cookies
- t (or cvs-auto-remove-directories 'handled) t))
+ 'all (or cvs-auto-remove-directories 'handled) t))
(defun-cvs-mode cvs-mode-acknowledge ()
With prefix argument, prompt for cvs flags."
(interactive
(list (setq cvs-tag-name
- (cvs-query-read cvs-tag-name "Tag to delete: " cvs-qtypedesc-tag))
+ (cvs-query-read cvs-tag-name "Tag to delete: "
+ cvs-qtypedesc-tag))
(cvs-flags-query 'cvs-tag-flags "tag flags")))
(cvs-mode-do "tag" (append '("-d") flags (list tag))
(when cvs-force-dir-tag 'tag)))
;; Byte compile files.
(defun-cvs-mode cvs-mode-byte-compile-files ()
- "Run byte-compile-file on all selected files that end in '.el'."
+ "Run byte-compile-file on all selected files with `.el' extension."
(interactive)
(let ((marked (cvs-get-marked (cvs-ignore-marks-p "byte-compile"))))
(dolist (fi marked)
(byte-compile-file filename))))))
;; ChangeLog support.
+(defvar add-log-buffer-file-name-function)
(defun-cvs-mode cvs-mode-add-change-log-entry-other-window ()
"Add a ChangeLog entry in the ChangeLog of the current directory."
(revert-buffer 'ignore-auto 'dont-ask 'preserve-modes)
;; `preserve-modes' avoids changing the (minor) modes. But we
;; do want to reset the mode for VC, so we do it explicitly.
- (vc-find-file-hook)
+ (vc-refresh-state)
(when (eq (cvs-fileinfo->type fileinfo) 'CONFLICT)
(smerge-start-session))))))))
\f
(defun cvs-change-cvsroot (newroot)
- "Change the cvsroot."
+ "Change the CVSROOT."
(interactive "DNew repository: ")
(if (or (file-directory-p (expand-file-name "CVSROOT" newroot))
(y-or-n-p (concat "Warning: no CVSROOT found inside repository."
(defcustom cvs-dired-use-hook '(4)
"Whether or not opening a CVS directory should run PCL-CVS.
A value of nil means never do it.
-ALWAYS means to always do it unless a prefix argument is given to the
+`always' means to always do it unless a prefix argument is given to the
command that prompted the opening of the directory.
Anything else means to do it only if the prefix arg is equal to this value."
:group 'pcl-cvs
(goto-char (point-min))
(looking-at ".*to add this file permanently\n\\'"))
(dolist (file (if (listp files) files (list files)))
- (insert "cvs add: scheduling file `"
- (file-name-nondirectory file)
- "' for addition\n")))
+ (insert (format-message
+ "cvs add: scheduling file `%s' for addition\n"
+ (file-name-nondirectory file)))))
;; VC never (?) does `cvs -n update' so dcd=nil
;; should probably always be the right choice.
(cvs-parse-process nil subdir))))))))
(add-hook 'after-save-hook 'cvs-mark-buffer-changed)
+(defun cvs-insert-visited-file ()
+ (let* ((file (expand-file-name buffer-file-name))
+ (version (and (fboundp 'vc-backend)
+ (eq (vc-backend file) 'CVS)
+ (vc-working-revision file))))
+ (when version
+ (save-current-buffer
+ (dolist (cvs-buf (buffer-list))
+ (set-buffer cvs-buf)
+ ;; look for a corresponding pcl-cvs buffer
+ (when (and (eq major-mode 'cvs-mode)
+ (string-prefix-p default-directory file))
+ (cvs-insert-file file)))))))
+
+(add-hook 'find-file-hook 'cvs-insert-visited-file 'append)
\f
(provide 'pcvs)