X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ca98cd37912088bd7c7fd02c8da265d13d71bb4f..4d8ae757b2662eca9e0d49c3fb27e69fb85cab85:/lisp/pcvs.el diff --git a/lisp/pcvs.el b/lisp/pcvs.el index f9d444aa2a..82cd661bd0 100644 --- a/lisp/pcvs.el +++ b/lisp/pcvs.el @@ -1,6 +1,6 @@ -;;; pcvs.el -- A Front-end to CVS. +;;; pcvs.el --- a front-end to CVS -;; Copyright (C) 1991, 92, 93, 94, 95, 95, 97, 98, 99, 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 @@ -13,8 +13,7 @@ ;; (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.20 2000/12/08 16:58:45 monnier Exp $ +;; Revision: $Id: pcvs.el,v 1.30 2001/10/30 04:41:28 monnier Exp $ ;; This file is part of GNU Emacs. @@ -54,8 +53,8 @@ ;;; Bugs: -;; - can somehow ignore important messages like `co aborted' or -;; or `co: output error: No space left on device'. +;; - Extracting an old version seems not to recognize encoding correctly. +;; That's probably because it's done via a process rather than a file. ;;; Todo: @@ -79,6 +78,8 @@ ;; - marking ;; marking directories should jump to just after the dir. ;; allow (un)marking directories at a time with the mouse. +;; allow cvs-cmd-do to either clear the marks or not. +;; add a "marks active" notion, like transient-mark-mode does. ;; - liveness indicator ;; - indicate in docstring if the cmd understands the `b' prefix(es). ;; - call smerge-mode when opening CONFLICT files. @@ -98,7 +99,6 @@ ;; - does "cvs -n tag LAST_VENDOR" to find old files into *cvs* ;; cvs-export ;; (with completion on tag names and hooks to help generate full releases) -;; - allow cvs-cmd-do to either clear the marks or not. ;; - display stickiness information. And current CVS/Tag as well. ;; - write 'cvs-mode-admin' to do arbitrary 'cvs admin' commands ;; Most interesting would be version removal and log message replacement. @@ -173,22 +173,26 @@ (defun cvs-reread-cvsrc () "Reset the default arguments to those in the `cvs-cvsrc-file'." (interactive) - (let ((cvsrc (cvs-file-to-string cvs-cvsrc-file))) - (when (stringp cvsrc) - ;; fetch the values - (dolist (cmd '("cvs" "checkout" "status" "log" "diff" "tag" - "add" "commit" "remove" "update")) - (let* ((sym (intern (concat "cvs-" cmd "-flags"))) - (val (when (string-match (concat "^" cmd "\\s-\\(.*\\)$") cvsrc) - (cvs-string->strings (match-string 1 cvsrc))))) - (cvs-flags-set sym 0 val))) - ;; ensure that cvs doesn't have -q or -Q - (cvs-flags-set 'cvs-cvs-flags 0 - (cons "-f" - (cdr (cvs-partition - (lambda (x) (member x '("-q" "-Q"))) - (cvs-flags-query 'cvs-cvs-flags - nil 'noquery)))))))) + (condition-case nil + (with-temp-buffer + (insert-file-contents cvs-cvsrc-file) + ;; fetch the values + (dolist (cmd '("cvs" "checkout" "status" "log" "diff" "tag" + "add" "commit" "remove" "update")) + (goto-char (point-min)) + (let* ((sym (intern (concat "cvs-" cmd "-flags"))) + (val (when (re-search-forward + (concat "^" cmd "\\s-+\\(.*\\)$") nil t) + (cvs-string->strings (match-string 1))))) + (cvs-flags-set sym 0 val))) + ;; ensure that cvs doesn't have -q or -Q + (cvs-flags-set 'cvs-cvs-flags 0 + (cons "-f" + (cdr (cvs-partition + (lambda (x) (member x '("-q" "-Q"))) + (cvs-flags-query 'cvs-cvs-flags + nil 'noquery)))))) + (file-error nil))) ;; initialize to cvsrc's default values (cvs-reread-cvsrc) @@ -250,7 +254,7 @@ If -CVS-MODE!-NOERROR is non-nil, then failure to find a *cvs* buffer does (cvsbuf (cond ((cvs-buffer-p) (current-buffer)) ((and cvs-buffer (cvs-buffer-p cvs-buffer)) cvs-buffer) (-cvs-mode!-noerror (current-buffer)) - (t (error "can't find the *cvs* buffer.")))) + (t (error "can't find the *cvs* buffer")))) (-cvs-mode!-wrapper cvs-minor-wrap-function) (-cvs-mode!-cont (lambda () (save-current-buffer @@ -629,7 +633,7 @@ it is finished." (set-buffer obuf))))) (defun cvs-parse-process (dcd &optional subdir) - "FIXME: bad name, no doc" + "FIXME: bad name, no doc." (let* ((from-buf (current-buffer)) (fileinfos (cvs-parse-buffer 'cvs-parse-table dcd subdir)) (_ (set-buffer cvs-buffer)) @@ -714,9 +718,9 @@ before calling the real function `" (symbol-name fun-1) "'.\n") (let ((proc (get-buffer-process cvs-temp-buffer))) (when proc (delete-process proc))))) -;;; -;;; Maintaining the collection in the face of updates -;;; +;; +;; Maintaining the collection in the face of updates +;; (defun cvs-addto-collection (c fi &optional tin) "Add FI to C and return FI's corresponding tin. @@ -732,7 +736,8 @@ TIN specifies an optional starting point." (while (not (or (null next-tin) (cvs-fileinfo< fi (ewoc-data next-tin)))) (setq tin next-tin next-tin (ewoc-next c next-tin))) - (if (cvs-fileinfo< (ewoc-data tin) fi) + (if (or (cvs-fileinfo< (ewoc-data tin) fi) + (eq (cvs-fileinfo->type fi) 'MESSAGE)) ;; tin < fi < next-tin (ewoc-enter-after c tin fi) ;; fi == tin @@ -868,7 +873,7 @@ With a prefix argument, prompt for cvs FLAGS to use." (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)) @@ -991,8 +996,9 @@ for a lock file. If so, it inserts a message cookie in the *cvs* buffer." (cvs-create-fileinfo 'MESSAGE "" " " (concat msg - (substitute-command-keys - "\n\t(type \\[cvs-mode-delete-lock] to delete it)")) + (when (file-exists-p lock) + (substitute-command-keys + "\n\t(type \\[cvs-mode-delete-lock] to delete it)"))) :subtype 'TEMP)) (pop-to-buffer (current-buffer)) (goto-char (point-max)) @@ -1138,6 +1144,31 @@ marked instead. A directory can never be marked." (setf (cvs-fileinfo->marked cookie) t))) cvs-cookies)) +(defun-cvs-mode (cvs-mode-mark-on-state . SIMPLE) (state) + "Mark all files in state STATE." + (interactive + (list + (let ((default + (condition-case nil + (downcase + (symbol-name + (cvs-fileinfo->type + (cvs-mode-marked nil nil :read-only t :one t :noquery t)))) + (error nil)))) + (intern + (upcase + (completing-read + (concat + "Mark files in state" (if default (concat " [" default "]")) ": ") + (mapcar (lambda (x) + (list (downcase (symbol-name (car x))))) + cvs-states) + nil t nil nil default)))))) + (ewoc-map (lambda (fi) + (when (eq (cvs-fileinfo->type fi) state) + (setf (cvs-fileinfo->marked fi) t))) + cvs-cookies)) + (defun-cvs-mode cvs-mode-mark-matching-files (regex) "Mark all files matching REGEX." (interactive "sMark files matching: ") @@ -1176,7 +1207,7 @@ they should always be unmarked." (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)) @@ -1237,13 +1268,12 @@ Args: &optional IGNORE-MARKS IGNORE-CONTENTS." (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. @@ -1251,6 +1281,7 @@ 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)))) @@ -1262,7 +1293,7 @@ If FILE is non-nil, directory entries won't be selected." (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))) @@ -1277,15 +1308,20 @@ If FILE is non-nil, directory entries won't be selected." (mapcar 'cvs-fileinfo->full-path (apply 'cvs-mode-marked -cvs-mode-files-args))))) -;;; -;;; Interface between Log-Edit and PCL-CVS -;;; +;; +;; Interface between Log-Edit and PCL-CVS +;; (defun cvs-mode-commit-setup () "Run `cvs-mode-commit' with setup." (interactive) (cvs-mode-commit 'force)) +(defcustom cvs-mode-commit-hook nil + "Hook run after setting up the commit buffer." + :type 'hook + :options '(cvs-mode-diff)) + (defun cvs-mode-commit (setup) "Check in all marked files, or the current file. The user will be asked for a log message in a buffer. @@ -1305,7 +1341,8 @@ The POSTPROC specified there (typically `log-edit') is then called, '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))) + (set (make-local-variable 'list-buffers-directory) lbd) + (run-hooks 'cvs-mode-commit-hook))) (defun cvs-commit-minor-wrap (buf f) (let ((cvs-ignore-marks-modif (cvs-mode-mark-get-modif "commit"))) @@ -1330,15 +1367,16 @@ The POSTPROC specified there (typically `log-edit') is then called, (defun-cvs-mode (cvs-mode-insert . NOARGS) (file) "Insert an entry for a specific file." (interactive - (list (read-file-name "File to insert: " - ;; Can't use ignore-errors here because interactive - ;; specs aren't byte-compiled. - (condition-case nil - (file-name-as-directory - (expand-file-name - (cvs-fileinfo->dir - (car (cvs-mode-marked nil nil :read-only t))))) - (error nil))))) + (list (read-file-name + "File to insert: " + ;; Can't use ignore-errors here because interactive + ;; specs aren't byte-compiled. + (condition-case nil + (file-name-as-directory + (expand-file-name + (cvs-fileinfo->dir + (cvs-mode-marked nil nil :read-only t :one t :noquery t)))) + (error nil))))) (cvs-insert-file file)) (defun cvs-insert-file (file) @@ -1350,6 +1388,11 @@ The POSTPROC specified there (typically `log-edit') is then called, (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." @@ -1373,7 +1416,7 @@ 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) @@ -1405,7 +1448,7 @@ See ``cvs-mode-diff'' for more info." This command can be used on files that are marked with \"Merged\" or \"Conflict\" in the *cvs* buffer." (interactive (list (cvs-flags-query 'cvs-diff-flags "diff flags"))) - (unless (listp flags) (error "flags should be a list of strings.")) + (unless (listp flags) (error "flags should be a list of strings")) (save-some-buffers) (let* ((filter 'diff) (marked (cvs-get-marked (cvs-ignore-marks-p "diff"))) @@ -1427,8 +1470,8 @@ or \"Conflict\" in the *cvs* buffer." Signal an error if there is no backup file." (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)))) + (error "%s has no backup file" (cvs-fileinfo->full-path fileinfo))) + (list backup-file (cvs-fileinfo->full-path fileinfo)))) ;; ;; Emerge support @@ -1553,7 +1596,7 @@ Signal an error if there is no backup file." (rev2 (and rev1 (cvs-prefix-get 'cvs-secondary-branch-prefix))) (fis (cvs-mode-marked 'diff "idiff" :file t))) (when (> (length fis) 2) - (error "idiff-other cannot be applied to more than 2 files at a time.")) + (error "idiff-other cannot be applied to more than 2 files at a time")) (let* ((fi1 (car fis)) (rev1-buf (if rev1 (cvs-retrieve-revision fi1 rev1) (find-file-noselect (cvs-fileinfo->full-path fi1)))) @@ -1563,7 +1606,7 @@ Signal an error if there is no backup file." (setq rev2-buf (if rev2 (cvs-retrieve-revision fi2 rev2) (find-file-noselect (cvs-fileinfo->full-path fi2))))) - (error "idiff-other doesn't know what other file/buffer to use.")) + (error "idiff-other doesn't know what other file/buffer to use")) (let* (;; this binding is used by cvs-ediff-startup-hook (cvs-transient-buffers (list rev1-buf rev2-buf))) (funcall (car cvs-idiff-imerge-handlers) @@ -1730,6 +1773,12 @@ This command ignores files that are not flagged as `Unknown'." (cvs-mode-find-file e t)) +(defun cvs-mode-display-file (e) + "Show a buffer containing the file in another window." + (interactive (list last-input-event)) + (cvs-mode-find-file e 'dont-select)) + + (defun cvs-find-modif (fi) (with-temp-buffer (call-process cvs-program nil (current-buffer) nil @@ -1746,7 +1795,7 @@ With a prefix, opens the buffer in an OTHER window." (interactive (list last-input-event current-prefix-arg)) (when (ignore-errors (mouse-set-point e) t) ;for invocation via the mouse (unless (memq (get-text-property (point) 'face) - '(cvs-dirname-face cvs-filename-face)) + '(cvs-header-face cvs-filename-face)) (error "Not a file name"))) (cvs-mode! (lambda (&optional rev) @@ -1757,14 +1806,17 @@ With a prefix, opens the buffer in an OTHER window." (let ((odir default-directory)) (setq default-directory (cvs-expand-dir-name (cvs-fileinfo->dir fi))) - (if other - (dired-other-window default-directory) - (dired default-directory)) + (cond ((eq other 'dont-select) + (display-buffer (find-file-noselect default-directory))) + (other (dired-other-window default-directory)) + (t (dired default-directory))) (set-buffer cvs-buf) (setq default-directory odir)) (let ((buf (if rev (cvs-retrieve-revision fi rev) (find-file-noselect (cvs-fileinfo->full-path fi))))) - (funcall (if other 'switch-to-buffer-other-window 'switch-to-buffer) + (funcall (cond ((eq other 'dont-select) 'display-buffer) + (other 'switch-to-buffer-other-window) + (t 'switch-to-buffer)) buf) (when (and cvs-find-file-and-jump (cvs-applicable-p fi 'diff-base)) (goto-line (cvs-find-modif fi))) @@ -1815,7 +1867,7 @@ if you are convinced that the process that created the lock is dead." (let* ((default-directory (cvs-expand-dir-name cvs-lock-file)) (locks (directory-files default-directory nil cvs-lock-file-regexp))) (cond - ((not locks) (error "No lock files found.")) + ((not locks) (error "No lock files found")) ((yes-or-no-p (concat "Really delete locks in " cvs-lock-file "? ")) (dolist (lock locks) (cond ((file-directory-p lock) (delete-directory lock)) @@ -1918,8 +1970,8 @@ With prefix argument, prompt for cvs flags." (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 @@ -1948,17 +2000,15 @@ With prefix argument, prompt for cvs 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) @@ -1967,10 +2017,9 @@ With prefix argument, prompt for cvs flags." ;; 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