# HG changeset patch # User Stefan Monnier # Date 1031017229 0 # Node ID 3a7c7e0c12f7bb498ea89a2524913ccd8f4ab769 # Parent 47f646d9e15159b958bdf3c39f67822feef954b9 (cvs-run-process): Use a pty rather than a pipe to work around the cvs/ssh/libc bug. (cvs-update-header): Understand `cvs admin -m:' syntax. (defun-cvs-mode): Use the new `declare' thingy. (cvs-edit-log-text-at-point, cvs-mode-edit-log, cvs-do-edit-log) (cvs-edit-log-minor-wrap, cvs-edit-log-filelist): New funs. (cvs-mode-undo): Use `cvs add' for (CONFLICT. REMOVED). diff -r 47f646d9e151 -r 3a7c7e0c12f7 lisp/pcvs.el --- a/lisp/pcvs.el Tue Sep 03 01:23:15 2002 +0000 +++ b/lisp/pcvs.el Tue Sep 03 01:40:29 2002 +0000 @@ -14,7 +14,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 -;; Revision: $Id: pcvs.el,v 1.37 2002/06/24 22:49:38 monnier Exp $ +;; Revision: $Id: pcvs.el,v 1.38 2002/06/25 00:11:28 monnier Exp $ ;; This file is part of GNU Emacs. @@ -537,7 +537,13 @@ (if cvs-cvsroot (list "-d" cvs-cvsroot)) args files)) - (process-connection-type nil) ; Use a pipe, not a pty. + ;; If process-connection-type is nil and the repository + ;; is accessed via SSH, a bad interaction between libc, + ;; CVS and SSH can lead to garbled output. + ;; It might be a glibc-specific problem. + ;; Until the problem is cleared, we'll use a pty rather than + ;; a pipe. + ;; (process-connection-type nil) ; Use a pipe, not a pty. (process ;; the process will be run in the selected dir (let ((default-directory (cvs-expand-dir-name dir))) @@ -558,15 +564,23 @@ (defun cvs-update-header (args fis) ; inline (let* ((lastarg nil) - ;; filter out the largish commit message (args (mapcar (lambda (arg) (cond + ;; filter out the largish commit message ((and (eq lastarg nil) (string= arg "commit")) (setq lastarg 'commit) arg) ((and (eq lastarg 'commit) (string= arg "-m")) (setq lastarg '-m) arg) ((eq lastarg '-m) (setq lastarg 'done) "") + ;; filter out the largish `admin -mrev:msg' message + ((and (eq lastarg nil) (string= arg "admin")) + (setq lastarg 'admin) arg) + ((and (eq lastarg 'admin) + (string-match "\\`-m[^:]*:" arg)) + (setq lastarg 'done) + (concat (match-string 0 arg) "")) + ;; Keep the rest as is. (t arg))) args)) ;; turn them into a string @@ -626,6 +640,9 @@ (save-excursion (eval cvs-postproc)) ;; check whether something is left (unless cvs-postprocess + ;; IIRC, we enable undo again once the process is finished + ;; for cases where the output was inserted in *vc-diff* or + ;; in a file-like buffer. -stef (buffer-enable-undo) (with-current-buffer cvs-buffer (cvs-update-header nil nil) ;FIXME: might need to be inline @@ -693,6 +710,7 @@ - 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))) (let ((style (cvs-cdr fun)) (fun (cvs-car fun))) (cond @@ -727,7 +745,6 @@ (cvs-mode! ',fun-1))))) (t (error "unknown style %s in `defun-cvs-mode'" style))))) -(def-edebug-spec defun-cvs-mode (&define sexp lambda-list stringp ("interactive" interactive) def-body)) (defun-cvs-mode cvs-mode-kill-process () "Kill the temporary buffer and associated process." @@ -1049,7 +1066,7 @@ ("" cvs-branch-prefix (cvs-secondary-branch-prefix ("->" cvs-secondary-branch-prefix)))) " " cvs-mode-line-process)) - (buffer-disable-undo (current-buffer)) + (buffer-disable-undo) ;;(set (make-local-variable 'goal-column) cvs-cursor-column) (set (make-local-variable 'revert-buffer-function) 'cvs-mode-revert-buffer) (setq truncate-lines t) @@ -1388,6 +1405,63 @@ (cvs-mode-do "commit" (list* "-m" msg flags) 'commit))) +;;;; Editing existing commit log messages. + +(defun cvs-edit-log-text-at-point () + (save-excursion + (end-of-line) + (when (re-search-backward "^revision " nil t) + (forward-line 1) + (if (looking-at "date:") (forward-line 1)) + (if (looking-at "branches:") (forward-line 1)) + (buffer-substring + (point) + (if (re-search-forward + "^\\(-\\{28\\}\\|=\\{77\\}\\|revision [.0-9]+\\)$" + nil t) + (match-beginning 0) + (point)))))) + +(defun cvs-mode-edit-log (rev &optional text) + "Edit the log message at point. +This is best called from a `log-view-mode' buffer." + (interactive + (list + (or (cvs-mode! (lambda () (cvs-prefix-get 'cvs-branch-prefix))) + (read-string "Revision to edit: ")) + (cvs-edit-log-text-at-point))) + ;; 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 log-edit-mode's message being + ;; displayed in the wrong minibuffer). + (cvs-mode!) + (let ((buf (cvs-temp-buffer "message" 'normal 'nosetup)) + (lbd list-buffers-directory) + (setupfun (or (nth 2 (cdr (assoc "message" cvs-buffer-name-alist))) + 'log-edit))) + (funcall setupfun 'cvs-do-edit-log nil 'cvs-edit-log-filelist buf) + (when text (erase-buffer) (insert text)) + (set (make-local-variable 'cvs-edit-log-revision) rev) + (set (make-local-variable 'cvs-minor-wrap-function) 'cvs-edit-log-minor-wrap) + (set (make-local-variable 'list-buffers-directory) lbd) + ;; (run-hooks 'cvs-mode-commit-hook) + )) + +(defun cvs-edit-log-minor-wrap (buf f) + (let ((cvs-ignore-marks-modif (cvs-mode-mark-get-modif "commit"))) + (funcall f))) + +(defun cvs-edit-log-filelist () + (cvs-mode-files nil nil :read-only t :file t :noquery t)) + +(defun cvs-do-edit-log (rev) + "Do the actual commit, using the current buffer as the log message." + (interactive (list cvs-edit-log-revision)) + (let ((msg (buffer-substring-no-properties (point-min) (point-max)))) + (cvs-mode!) + (cvs-mode-do "admin" (list (concat "-m" rev ":" msg)) nil))) + + ;;;; ;;;; CVS Mode commands ;;;; @@ -1850,7 +1924,10 @@ (interactive (list nil));; (cvs-flags-query 'cvs-undo-flags "undo flags") (if current-prefix-arg (call-interactively 'cvs-mode-revert-to-rev) (let* ((fis (cvs-do-removal 'undo "update" 'all)) - (removedp (lambda (fi) (eq (cvs-fileinfo->type fi) 'REMOVED))) + (removedp (lambda (fi) + (or (eq (cvs-fileinfo->type fi) 'REMOVED) + (and (eq (cvs-fileinfo->type fi) 'CONFLICT) + (eq (cvs-fileinfo->subtype fi) 'REMOVED))))) (fis-split (cvs-partition removedp fis)) (fis-removed (car fis-split)) (fis-other (cdr fis-split)))