X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b0126eac41487b9bca5af5cbb2212ff5b2c58b80..cecedb3677ffdf4ebdb66aaf37c1914be721aa9c:/lisp/vc/pcvs.el diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el index 305e109b6d..79a1934f21 100644 --- a/lisp/vc/pcvs.el +++ b/lisp/vc/pcvs.el @@ -1,7 +1,6 @@ -;;; pcvs.el --- a front-end to CVS +;;; pcvs.el --- a front-end to CVS -*- lexical-binding:t -*- -;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1991-2013 Free Software Foundation, Inc. ;; Author: (The PCL-CVS Trust) pcl-cvs@cyclic.com ;; (Per Cederqvist) ceder@lysator.liu.se @@ -32,19 +31,19 @@ ;;; Commentary: -;; PCL-CVS is a front-end to the CVS version control system. For people -;; familiar with VC, it is somewhat like VC-dired: it presents the status of -;; all the files in your working area and allows you to commit/update several -;; of them at a time. Compared to VC-dired, it is considerably better and -;; faster (but only for CVS). +;; PCL-CVS is a front-end to the CVS version control system. +;; It presents the status of all the files in your working area and +;; allows you to commit/update several of them at a time. +;; Compare with the general Emacs utility vc-dir, which tries +;; to be VCS-agnostic. You may find PCL-CVS better/faster for CVS. ;; PCL-CVS was originally written by Per Cederqvist many years ago. This ;; version derives from the XEmacs-21 version, itself based on the 2.0b2 ;; version (last release from Per). It is a thorough rework. -;; Contrary to what you'd expect, PCL-CVS is not a replacement for VC but only -;; for VC-dired. As such, I've tried to make PCL-CVS and VC interoperate -;; seamlessly (I also use VC). +;; PCL-CVS is not a replacement for VC, but adds extra functionality. +;; As such, I've tried to make PCL-CVS and VC interoperate seamlessly +;; (I also use VC). ;; To use PCL-CVS just use `M-x cvs-examine RET RET'. ;; There is a TeXinfo manual, which can be helpful to get started. @@ -61,8 +60,6 @@ ;; - 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. @@ -119,12 +116,13 @@ ;;; 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) ;;;; @@ -220,21 +218,21 @@ (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 @@ -323,7 +321,7 @@ The argument is added (or not) to the list of FLAGS and is constructed by appending the branch to ARG which defaults to \"-r\". Since the `cvs-secondary-branch-prefix' is only active if the primary prefix is active, it is important to read the secondary prefix before -the primay since reading the primary can deactivate it." +the primary since reading the primary can deactivate it." (let ((branch (and (cvs-prefix-get 'cvs-branch-prefix 'read-only) (cvs-prefix-get 'cvs-secondary-branch-prefix)))) (if branch (cons (concat (or arg "-r") branch) flags) flags))) @@ -351,7 +349,7 @@ information and will be read-only unless NORMAL is non-nil. It will be emptied 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 @@ -361,9 +359,10 @@ from the current buffer." (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))) @@ -418,7 +417,7 @@ from the current buffer." 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) @@ -427,16 +426,16 @@ If non-nil, NEW means to create a new buffer no matter what." ;; 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 - (or (cvs-string-prefix-p default-directory dir) - (cvs-string-prefix-p dir default-directory))) - (samedir (string= default-directory dir))) - (return buffer))))) + (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))) + (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 @@ -479,7 +478,7 @@ If non-nil, NEW means to create a new buffer no matter what." ;;(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)))) @@ -502,7 +501,7 @@ If non-nil, NEW means to create a new buffer no matter what." ;; 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) @@ -522,9 +521,9 @@ If non-nil, NEW means to create a new buffer no matter what." (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)) @@ -571,9 +570,9 @@ If non-nil, NEW means to create a new buffer no matter what." 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)) @@ -621,7 +620,7 @@ If non-nil, NEW means to create a new buffer no matter what." (str (car hf)) (done "") (tin (ewoc-nth cvs-cookies 0))) - ;; look for the first *real* fileinfo (to determine emptyness) + ;; look for the first *real* fileinfo (to determine emptiness) (while (and tin (memq (cvs-fileinfo->type (ewoc-data tin)) @@ -650,7 +649,7 @@ If non-nil, NEW means to create a new buffer no matter what." 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." @@ -677,7 +676,8 @@ 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 @@ -757,7 +757,8 @@ clear what alternative to use. - 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)) + (declare (debug (&define sexp lambda-list stringp + ("interactive" interactive) def-body)) (doc-string 3)) (let ((style (cvs-cdr fun)) (fun (cvs-car fun))) @@ -814,7 +815,7 @@ TIN specifies an optional starting point." (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)))) @@ -859,7 +860,8 @@ the problem." (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)) @@ -872,15 +874,19 @@ RM-MSGS if non-nil means remove messages." (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 @@ -888,7 +894,7 @@ RM-MSGS if non-nil means remove messages." (eq (cvs-fileinfo->type last-fi) 'DIRCHANGE) (not (when first-dir (setq first-dir nil) t)) (or (eq rm-dirs 'all) - (not (cvs-string-prefix-p + (not (string-prefix-p (cvs-fileinfo->dir last-fi) (cvs-fileinfo->dir fi))) (and (eq type 'DIRCHANGE) (eq rm-dirs 'empty)) @@ -978,7 +984,7 @@ The files are stored to DIR." ;;;; (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)) @@ -992,7 +998,7 @@ If in a *cvs* buffer, don't prompt unless a prefix argument is given." (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]), @@ -1390,7 +1396,7 @@ an empty list if it doesn't point to a file at all." fis)))) (nreverse fis))) -(defun* cvs-mode-marked (filter &optional cmd +(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. @@ -1462,7 +1468,7 @@ The POSTPROC specified there (typically `log-edit') is then called, (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))) @@ -1475,7 +1481,7 @@ The POSTPROC specified there (typically `log-edit') is then called, (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. @@ -1595,30 +1601,32 @@ With prefix argument, prompt for cvs flags." (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 @@ -1662,10 +1670,7 @@ or \"Conflict\" in the *cvs* buffer." (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)) @@ -1759,7 +1764,7 @@ Signal an error if there is no backup file." (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)))))) @@ -1840,22 +1845,23 @@ Signal an error if there is no backup file." (setq buffer-file-name (expand-file-name buffer-file-name)) (let (ret) (dolist (fi (or fis (list (cvs-create-fileinfo 'DIRCHANGE "" "." "")))) - (when (cvs-string-prefix-p + (when (string-prefix-p (expand-file-name (cvs-fileinfo->full-name fi) dir) buffer-file-name) (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- 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)))) @@ -1874,22 +1880,25 @@ POSTPROC is a list of expressions to be evaluated at the very end (after (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- function. Executes `cvs CVSARGS CMD FLAGS' on the selected files. FILTER is passed to `cvs-applicable-p' to only apply the command to @@ -1911,8 +1920,11 @@ With prefix argument, prompt for cvs flags." (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." @@ -1920,7 +1932,7 @@ With prefix argument, prompt for cvs flags." (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 @@ -1954,12 +1966,12 @@ With a prefix argument, prompt for cvs flags." (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)) @@ -1967,25 +1979,6 @@ This command ignores files that are not flagged as `Unknown'." (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))) - - (defun cvs-mode-find-file-other-window (e) "Select a buffer containing the file in another window." (interactive (list last-input-event)) @@ -2080,8 +2073,10 @@ The file is removed and `cvs update FILE' is run." (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) @@ -2092,11 +2087,14 @@ The file is removed and `cvs update FILE' is run." (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))) @@ -2120,7 +2118,7 @@ if you are convinced that the process that created the lock is dead." 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 () @@ -2200,7 +2198,8 @@ to use it on individual files." 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))) @@ -2218,6 +2217,7 @@ With prefix argument, prompt for cvs flags." (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." @@ -2262,7 +2262,7 @@ With prefix argument, prompt for cvs flags." (defun cvs-dir-member-p (fileinfo dir) "Return true if FILEINFO represents a file in directory DIR." (and (not (eq (cvs-fileinfo->type fileinfo) 'DIRCHANGE)) - (cvs-string-prefix-p dir (cvs-fileinfo->dir fileinfo)))) + (string-prefix-p dir (cvs-fileinfo->dir fileinfo)))) (defun cvs-execute-single-file (fi extractor program constant-args) "Internal function for `cvs-execute-single-file-list'." @@ -2393,7 +2393,7 @@ The exact behavior is determined also by `cvs-dired-use-hook'." (set-buffer cvs-buf) ;; look for a corresponding pcl-cvs buffer (when (and (eq major-mode 'cvs-mode) - (cvs-string-prefix-p default-directory dir)) + (string-prefix-p default-directory dir)) (let ((subdir (substring dir (length default-directory)))) (set-buffer buffer) (set (make-local-variable 'cvs-buffer) cvs-buf) @@ -2424,7 +2424,7 @@ The exact behavior is determined also by `cvs-dired-use-hook'." (set-buffer cvs-buf) ;; look for a corresponding pcl-cvs buffer (when (and (eq major-mode 'cvs-mode) - (cvs-string-prefix-p default-directory file)) + (string-prefix-p default-directory file)) (let* ((file (substring file (length default-directory))) (fi (cvs-create-fileinfo (if (string= "0" version) @@ -2436,8 +2436,22 @@ The exact behavior is determined also by `cvs-dired-use-hook'." (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) (provide 'pcvs) -;; arch-tag: 8e3a7494-0453-4389-9ab3-a557ce9fab61 ;;; pcvs.el ends here