/[emacs]/emacs/lisp/pcvs.el
ViewVC logotype

Diff of /emacs/lisp/pcvs.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.35 by monnier, Thu May 16 20:03:52 2002 UTC revision 1.35.2.1 by miles, Fri Apr 4 06:20:10 2003 UTC
# Line 1  Line 1 
1  ;;; pcvs.el --- a front-end to CVS  ;;; pcvs.el --- a front-end to CVS
2    
3  ;; 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,2002
4    ;;               Free Software Foundation, Inc.
5    
6  ;; Author: (The PCL-CVS Trust) pcl-cvs@cyclic.com  ;; Author: (The PCL-CVS Trust) pcl-cvs@cyclic.com
7  ;;      (Per Cederqvist) ceder@lysator.liu.se  ;;      (Per Cederqvist) ceder@lysator.liu.se
# Line 59  Line 60 
60  ;;; Todo:  ;;; Todo:
61    
62  ;; ******** FIX THE DOCUMENTATION *********  ;; ******** FIX THE DOCUMENTATION *********
63  ;;  ;;
64  ;; - rework the displaying of error messages.  ;; - rework the displaying of error messages.
 ;; - use UP-TO-DATE rather than DEAD when cleaning before `examine'.  
65  ;; - allow to flush messages only  ;; - allow to flush messages only
66  ;; - allow to protect files like ChangeLog from flushing  ;; - allow to protect files like ChangeLog from flushing
67  ;; - automatically cvs-mode-insert files from find-file-hook  ;; - automatically cvs-mode-insert files from find-file-hook
# Line 72  Line 72 
72  ;; - allow cvs-confirm-removals to force always confirmation.  ;; - allow cvs-confirm-removals to force always confirmation.
73  ;; - cvs-checkout should ask for a revision (with completion).  ;; - cvs-checkout should ask for a revision (with completion).
74  ;; - removal confirmation should allow specifying another file name.  ;; - removal confirmation should allow specifying another file name.
75  ;;  ;;
76  ;; - hide fileinfos without getting rid of them (will require ewok work).  ;; - hide fileinfos without getting rid of them (will require ewok work).
77  ;; - add toolbar entries  ;; - add toolbar entries
78  ;; - marking  ;; - marking
# Line 243  Line 243 
243    
244  ;;;;  ;;;;
245    
246  (defun cvs-mode! (&optional -cvs-mode!-fun -cvs-mode!-noerror)  (defun cvs-mode! (&optional -cvs-mode!-fun)
247    "Switch to the *cvs* buffer.    "Switch to the *cvs* buffer.
248  If -CVS-MODE!-FUN is provided, it is executed *cvs* being the current buffer  If -CVS-MODE!-FUN is provided, it is executed *cvs* being the current buffer
249    and with its window selected.  Else, the *cvs* buffer is simply selected.    and with its window selected.  Else, the *cvs* buffer is simply selected.
 If -CVS-MODE!-NOERROR is non-nil, then failure to find a *cvs* buffer does  
   not generate an error and the current buffer is kept selected.  
250  -CVS-MODE!-FUN is called interactively if applicable and else with no argument."  -CVS-MODE!-FUN is called interactively if applicable and else with no argument."
251    (let* ((-cvs-mode!-buf (current-buffer))    (let* ((-cvs-mode!-buf (current-buffer))
252           (cvsbuf (cond ((cvs-buffer-p) (current-buffer))           (cvsbuf (cond ((cvs-buffer-p) (current-buffer))
253                         ((and cvs-buffer (cvs-buffer-p cvs-buffer)) cvs-buffer)                         ((and cvs-buffer (cvs-buffer-p cvs-buffer)) cvs-buffer)
                        (-cvs-mode!-noerror (current-buffer))  
254                         (t (error "can't find the *cvs* buffer"))))                         (t (error "can't find the *cvs* buffer"))))
255           (-cvs-mode!-wrapper cvs-minor-wrap-function)           (-cvs-mode!-wrapper cvs-minor-wrap-function)
256           (-cvs-mode!-cont (lambda ()           (-cvs-mode!-cont (lambda ()
# Line 338  the primay since reading the primary can Line 335  the primay since reading the primary can
335    "This mode is used for buffers related to a main *cvs* buffer.    "This mode is used for buffers related to a main *cvs* buffer.
336  All the `cvs-mode' buffer operations are simply rebound under  All the `cvs-mode' buffer operations are simply rebound under
337  the \\[cvs-mode-map] prefix."  the \\[cvs-mode-map] prefix."
338    nil " CVS")    nil " CVS"
339      :group 'pcl-cvs)
340  (put 'cvs-minor-mode 'permanent-local t)  (put 'cvs-minor-mode 'permanent-local t)
341    
342    
# Line 537  Working dir: " (abbreviate-file-name dir Line 535  Working dir: " (abbreviate-file-name dir
535                               (if cvs-cvsroot (list "-d" cvs-cvsroot))                               (if cvs-cvsroot (list "-d" cvs-cvsroot))
536                               args                               args
537                               files))                               files))
538                 (process-connection-type nil) ; Use a pipe, not a pty.                 ;; If process-connection-type is nil and the repository
539                   ;; is accessed via SSH, a bad interaction between libc,
540                   ;; CVS and SSH can lead to garbled output.
541                   ;; It might be a glibc-specific problem (but it also happens
542                   ;; under Mac OS X, it seems).
543                   ;; Until the problem is cleared, we'll use a pty rather than
544                   ;; a pipe.
545                   ;; (process-connection-type nil) ; Use a pipe, not a pty.
546                 (process                 (process
547                  ;; the process will be run in the selected dir                  ;; the process will be run in the selected dir
548                  (let ((default-directory (cvs-expand-dir-name dir)))                  (let ((default-directory (cvs-expand-dir-name dir)))
# Line 558  Working dir: " (abbreviate-file-name dir Line 563  Working dir: " (abbreviate-file-name dir
563    
564  (defun cvs-update-header (args fis) ; inline  (defun cvs-update-header (args fis) ; inline
565    (let* ((lastarg nil)    (let* ((lastarg nil)
          ;; filter out the largish commit message  
566           (args (mapcar (lambda (arg)           (args (mapcar (lambda (arg)
567                           (cond                           (cond
568                              ;; filter out the largish commit message
569                            ((and (eq lastarg nil) (string= arg "commit"))                            ((and (eq lastarg nil) (string= arg "commit"))
570                             (setq lastarg 'commit) arg)                             (setq lastarg 'commit) arg)
571                            ((and (eq lastarg 'commit) (string= arg "-m"))                            ((and (eq lastarg 'commit) (string= arg "-m"))
572                             (setq lastarg '-m) arg)                             (setq lastarg '-m) arg)
573                            ((eq lastarg '-m)                            ((eq lastarg '-m)
574                             (setq lastarg 'done) "<log message>")                             (setq lastarg 'done) "<log message>")
575                              ;; filter out the largish `admin -mrev:msg' message
576                              ((and (eq lastarg nil) (string= arg "admin"))
577                               (setq lastarg 'admin) arg)
578                              ((and (eq lastarg 'admin)
579                                    (string-match "\\`-m[^:]*:" arg))
580                               (setq lastarg 'done)
581                               (concat (match-string 0 arg) "<log message>"))
582                              ;; Keep the rest as is.
583                            (t arg)))                            (t arg)))
584                         args))                         args))
585           ;; turn them into a string           ;; turn them into a string
# Line 626  it is finished." Line 639  it is finished."
639            (save-excursion (eval cvs-postproc))            (save-excursion (eval cvs-postproc))
640            ;; check whether something is left            ;; check whether something is left
641            (unless cvs-postprocess            (unless cvs-postprocess
642                ;; IIRC, we enable undo again once the process is finished
643                ;; for cases where the output was inserted in *vc-diff* or
644                ;; in a file-like buffer.  -stef
645              (buffer-enable-undo)              (buffer-enable-undo)
646              (with-current-buffer cvs-buffer              (with-current-buffer cvs-buffer
647                (cvs-update-header nil nil) ;FIXME: might need to be inline                (cvs-update-header nil nil) ;FIXME: might need to be inline
648                (message "CVS process has completed"))))                (message "CVS process has completed in %s" (buffer-name)))))
649          ;; This might not even be necessary          ;; This might not even be necessary
650          (set-buffer obuf)))))          (set-buffer obuf)))))
651    
652  (defun cvs-parse-process (dcd &optional subdir)  (defun cvs-parse-process (dcd &optional subdir old-fis)
653    "FIXME: bad name, no doc."    "Parse the output of a cvs process.
654    (let* ((from-buf (current-buffer))  DCD is the `dont-change-disc' flag to use when parsing that output.
655           (fileinfos (cvs-parse-buffer 'cvs-parse-table dcd subdir))  SUBDIR is the subdirectory (if any) where this command was run.
656           (_ (set-buffer cvs-buffer))  OLD-FIS is the list of fileinfos on which the cvs command was applied and
657           last    which should be considered up-to-date if they are missing from the output."
658           (from-pt (point)))    (let* ((fileinfos (cvs-parse-buffer 'cvs-parse-table dcd subdir))
659      ;; add the new fileinfos           last)
660      (dolist (fi fileinfos)      (with-current-buffer cvs-buffer
661        (setq last (cvs-addto-collection cvs-cookies fi last)))        ;; Expand OLD-FIS to actual files.
662      (cvs-cleanup-collection cvs-cookies        (let ((fis nil))
663                              (eq cvs-auto-remove-handled t)          (dolist (fi old-fis)
664                              cvs-auto-remove-directories            (setq fis (if (eq (cvs-fileinfo->type fi) 'DIRCHANGE)
665                              nil)                          (nconc (ewoc-collect cvs-cookies 'cvs-dir-member-p
666      ;; update the display (might be unnecessary)                                               (cvs-fileinfo->dir fi))
667      ;;(ewoc-refresh cvs-cookies)                                 fis)
668      ;; revert buffers if necessary                        (cons fi fis))))
669      (when (and cvs-auto-revert (not dcd) (not cvs-from-vc))          (setq old-fis fis))
670        (cvs-revert-if-needed fileinfos))        ;; Drop OLD-FIS which were already up-to-date.
671      ;; get back to where we were.  `save-excursion' doesn't seem to        (let ((fis nil))
672      ;; work in this case, probably because the buffer is reconstructed          (dolist (fi old-fis)
673      ;; by the cookie code.            (unless (eq (cvs-fileinfo->type fi) 'UP-TO-DATE) (push fi fis)))
674      (goto-char from-pt)          (setq old-fis fis))
675      (set-buffer from-buf)))        ;; Add the new fileinfos to the ewoc.
676          (dolist (fi fileinfos)
677            (setq last (cvs-addto-collection cvs-cookies fi last))
678            ;; This FI was in the output, so remove it from OLD-FIS.
679            (setq old-fis (delq (ewoc-data last) old-fis)))
680          ;; Process the "silent output" (i.e. absence means up-to-date).
681          (dolist (fi old-fis)
682            (setf (cvs-fileinfo->type fi) 'UP-TO-DATE)
683            (setq last (cvs-addto-collection cvs-cookies fi last)))
684          (setq fileinfos (nconc old-fis fileinfos))
685          ;; Clean up the ewoc as requested by the user.
686          (cvs-cleanup-collection cvs-cookies
687                                  (eq cvs-auto-remove-handled t)
688                                  cvs-auto-remove-directories
689                                  nil)
690          ;; Revert buffers if necessary.
691          (when (and cvs-auto-revert (not dcd) (not cvs-from-vc))
692            (cvs-revert-if-needed fileinfos)))))
693    
694  (defmacro defun-cvs-mode (fun args docstring interact &rest body)  (defmacro defun-cvs-mode (fun args docstring interact &rest body)
695    "Define a function to be used in a *cvs* buffer.    "Define a function to be used in a *cvs* buffer.
# Line 676  clear what alternative to use. Line 709  clear what alternative to use.
709  - NOARGS will get all the arguments from the *cvs* buffer and will  - NOARGS will get all the arguments from the *cvs* buffer and will
710    always behave as if called interactively.    always behave as if called interactively.
711  - DOUBLE is the generic case."  - DOUBLE is the generic case."
712      (declare (debug (&define sexp lambda-list stringp ("interactive" interactive) def-body)))
713    (let ((style (cvs-cdr fun))    (let ((style (cvs-cdr fun))
714          (fun (cvs-car fun)))          (fun (cvs-car fun)))
715      (cond      (cond
# Line 710  before calling the real function `" (sym Line 744  before calling the real function `" (sym
744               (cvs-mode! ',fun-1)))))               (cvs-mode! ',fun-1)))))
745    
746       (t (error "unknown style %s in `defun-cvs-mode'" style)))))       (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))  
747    
748  (defun-cvs-mode cvs-mode-kill-process ()  (defun-cvs-mode cvs-mode-kill-process ()
749    "Kill the temporary buffer and associated process."    "Kill the temporary buffer and associated process."
# Line 744  TIN specifies an optional starting point Line 777  TIN specifies an optional starting point
777          ;; fi == tin          ;; fi == tin
778          (cvs-fileinfo-update (ewoc-data tin) fi)          (cvs-fileinfo-update (ewoc-data tin) fi)
779          (ewoc-invalidate c tin)          (ewoc-invalidate c tin)
780            ;; Move cursor back to where it belongs.
781            (when (bolp) (cvs-move-to-goal-column))
782          tin))))          tin))))
783    
784  (defcustom cvs-cleanup-functions nil  (defcustom cvs-cleanup-functions nil
# Line 857  and run `cvs-mode' on it. Line 892  and run `cvs-mode' on it.
892  With a prefix argument, prompt for cvs FLAGS to use."  With a prefix argument, prompt for cvs FLAGS to use."
893    (interactive    (interactive
894     (list (cvs-string->strings (read-string "Module(s): " (cvs-get-module)))     (list (cvs-string->strings (read-string "Module(s): " (cvs-get-module)))
895           (read-file-name "CVS Checkout Directory: "           (read-directory-name "CVS Checkout Directory: "
896                           nil default-directory nil)                           nil default-directory nil)
897           (cvs-add-branch-prefix           (cvs-add-branch-prefix
898            (cvs-flags-query 'cvs-checkout-flags "cvs checkout flags"))))            (cvs-flags-query 'cvs-checkout-flags "cvs checkout flags"))))
# Line 884  With a prefix argument, prompt for cvs F Line 919  With a prefix argument, prompt for cvs F
919             (not current-prefix-arg)             (not current-prefix-arg)
920             (not (eq last-command-char ?\r)))             (not (eq last-command-char ?\r)))
921        default-directory        default-directory
922      (read-file-name msg nil default-directory nil)))      (read-directory-name msg nil default-directory nil)))
923    
924  ;;;###autoload  ;;;###autoload
925  (defun cvs-quickdir (dir &optional flags noshow)  (defun cvs-quickdir (dir &optional flags noshow)
# Line 940  Optional argument NOSHOW if non-nil mean Line 975  Optional argument NOSHOW if non-nil mean
975  (defun cvs-update (directory flags)  (defun cvs-update (directory flags)
976    "Run a `cvs update' in the current working DIRECTORY.    "Run a `cvs update' in the current working DIRECTORY.
977  Feed the output to a *cvs* buffer and run `cvs-mode' on it.  Feed the output to a *cvs* buffer and run `cvs-mode' on it.
978  With a prefix argument, prompt for a directory and cvs FLAGS to use.  With a \\[universal-argument] prefix argument, prompt for a directory to use.
979  A prefix arg >8 (ex: \\[universal-argument] \\[universal-argument]),  A prefix arg >8 (ex: \\[universal-argument] \\[universal-argument]),
980    prevents reuse of an existing *cvs* buffer."    prevents reuse of an existing *cvs* buffer.
981    The prefix is also passed to `cvs-flags-query' to select the FLAGS
982      passed to cvs."
983    (interactive (list (cvs-query-directory "CVS Update (directory): ")    (interactive (list (cvs-query-directory "CVS Update (directory): ")
984                       (cvs-flags-query 'cvs-update-flags "cvs update flags")))                       (cvs-flags-query 'cvs-update-flags "cvs update flags")))
985    (when (eq flags t)    (when (eq flags t)
# Line 1030  Full documentation is in the Texinfo fil Line 1067  Full documentation is in the Texinfo fil
1067                 ("" cvs-branch-prefix (cvs-secondary-branch-prefix                 ("" cvs-branch-prefix (cvs-secondary-branch-prefix
1068                                        ("->" cvs-secondary-branch-prefix))))                                        ("->" cvs-secondary-branch-prefix))))
1069            " " cvs-mode-line-process))            " " cvs-mode-line-process))
1070    (buffer-disable-undo (current-buffer))    (buffer-disable-undo)
1071    ;;(set (make-local-variable 'goal-column) cvs-cursor-column)    ;;(set (make-local-variable 'goal-column) cvs-cursor-column)
1072    (set (make-local-variable 'revert-buffer-function) 'cvs-mode-revert-buffer)    (set (make-local-variable 'revert-buffer-function) 'cvs-mode-revert-buffer)
1073    (setq truncate-lines t)    (setq truncate-lines t)
# Line 1086  Full documentation is in the Texinfo fil Line 1123  Full documentation is in the Texinfo fil
1123    
1124  ;; Move around in the buffer  ;; Move around in the buffer
1125    
1126    (defun cvs-move-to-goal-column ()
1127      (let* ((eol (line-end-position))
1128             (fpos (next-single-property-change (point) 'cvs-goal-column nil eol)))
1129        (when (< fpos eol)
1130          (goto-char fpos))))
1131    
1132  (defun-cvs-mode cvs-mode-previous-line (arg)  (defun-cvs-mode cvs-mode-previous-line (arg)
1133    "Go to the previous line.    "Go to the previous line.
1134  If a prefix argument is given, move by that many lines."  If a prefix argument is given, move by that many lines."
1135    (interactive "p")    (interactive "p")
1136    (ewoc-goto-prev cvs-cookies arg)    (ewoc-goto-prev cvs-cookies arg)
1137    (let ((fpos (next-single-property-change    (cvs-move-to-goal-column))
                (point) 'cvs-goal-column  
                (current-buffer) (line-end-position)))  
         (eol (line-end-position)))  
     (when (< fpos eol)  
       (goto-char fpos))))  
1138    
1139  (defun-cvs-mode cvs-mode-next-line (arg)  (defun-cvs-mode cvs-mode-next-line (arg)
1140    "Go to the next line.    "Go to the next line.
1141  If a prefix argument is given, move by that many lines."  If a prefix argument is given, move by that many lines."
1142    (interactive "p")    (interactive "p")
1143    (ewoc-goto-next cvs-cookies arg)    (ewoc-goto-next cvs-cookies arg)
1144    (let ((fpos (next-single-property-change    (cvs-move-to-goal-column))
                (point) 'cvs-goal-column  
                (current-buffer) (line-end-position)))  
         (eol (line-end-position)))  
     (when (< fpos eol)  
       (goto-char fpos))))  
1145    
1146  ;;;;  ;;;;
1147  ;;;; Mark handling  ;;;; Mark handling
# Line 1333  If FILE is non-nil, directory entries wo Line 1366  If FILE is non-nil, directory entries wo
1366  (defcustom cvs-mode-commit-hook nil  (defcustom cvs-mode-commit-hook nil
1367    "Hook run after setting up the commit buffer."    "Hook run after setting up the commit buffer."
1368    :type 'hook    :type 'hook
1369    :options '(cvs-mode-diff))    :options '(cvs-mode-diff)
1370      :group 'pcl-cvs)
1371    
1372  (defun cvs-mode-commit (setup)  (defun cvs-mode-commit (setup)
1373    "Check in all marked files, or the current file.    "Check in all marked files, or the current file.
# Line 1373  The POSTPROC specified there (typically Line 1407  The POSTPROC specified there (typically
1407      (cvs-mode-do "commit" (list* "-m" msg flags) 'commit)))      (cvs-mode-do "commit" (list* "-m" msg flags) 'commit)))
1408    
1409    
1410    ;;;; Editing existing commit log messages.
1411    
1412    (defun cvs-edit-log-text-at-point ()
1413      (save-excursion
1414        (end-of-line)
1415        (when (re-search-backward "^revision " nil t)
1416          (forward-line 1)
1417          (if (looking-at "date:") (forward-line 1))
1418          (if (looking-at "branches:") (forward-line 1))
1419          (buffer-substring
1420           (point)
1421           (if (re-search-forward
1422                "^\\(-\\{28\\}\\|=\\{77\\}\\|revision [.0-9]+\\)$"
1423                nil t)
1424               (match-beginning 0)
1425             (point))))))
1426    
1427    (defun cvs-mode-edit-log (rev &optional text)
1428      "Edit the log message at point.
1429    This is best called from a `log-view-mode' buffer."
1430      (interactive
1431       (list
1432        (or (cvs-mode! (lambda () (cvs-prefix-get 'cvs-branch-prefix)))
1433            (read-string "Revision to edit: "))
1434        (cvs-edit-log-text-at-point)))
1435      ;; It seems that the save-excursion that happens if I use the better
1436      ;; form of `(cvs-mode! (lambda ...))' screws up a couple things which
1437      ;; end up being rather annoying (like log-edit-mode's message being
1438      ;; displayed in the wrong minibuffer).
1439      (cvs-mode!)
1440      (let ((buf (cvs-temp-buffer "message" 'normal 'nosetup))
1441            (lbd list-buffers-directory)
1442            (setupfun (or (nth 2 (cdr (assoc "message" cvs-buffer-name-alist)))
1443                          'log-edit)))
1444        (funcall setupfun 'cvs-do-edit-log nil 'cvs-edit-log-filelist buf)
1445        (when text (erase-buffer) (insert text))
1446        (set (make-local-variable 'cvs-edit-log-revision) rev)
1447        (set (make-local-variable 'cvs-minor-wrap-function) 'cvs-edit-log-minor-wrap)
1448        (set (make-local-variable 'list-buffers-directory) lbd)
1449        ;; (run-hooks 'cvs-mode-commit-hook)
1450        ))
1451    
1452    (defun cvs-edit-log-minor-wrap (buf f)
1453      (let ((cvs-ignore-marks-modif (cvs-mode-mark-get-modif "commit")))
1454        (funcall f)))
1455    
1456    (defun cvs-edit-log-filelist ()
1457      (cvs-mode-files nil nil :read-only t :file t :noquery t))
1458    
1459    (defun cvs-do-edit-log (rev)
1460      "Do the actual commit, using the current buffer as the log message."
1461      (interactive (list cvs-edit-log-revision))
1462      (let ((msg (buffer-substring-no-properties (point-min) (point-max))))
1463        (cvs-mode!)
1464        (cvs-mode-do "admin" (list (concat "-m" rev ":" msg)) nil)))
1465    
1466    
1467  ;;;;  ;;;;
1468  ;;;; CVS Mode commands  ;;;; CVS Mode commands
1469  ;;;;  ;;;;
# Line 1544  Signal an error if there is no backup fi Line 1635  Signal an error if there is no backup fi
1635      (or (find-buffer-visiting buffile)      (or (find-buffer-visiting buffile)
1636          (with-current-buffer (create-file-buffer buffile)          (with-current-buffer (create-file-buffer buffile)
1637            (message "Retrieving revision %s..." rev)            (message "Retrieving revision %s..." rev)
1638            (let ((res (call-process cvs-program nil t nil            ;; Discard stderr output to work around the CVS+SSH+libc
1639              ;; problem when stdout and stderr are the same.
1640              ;; FIXME: this doesn't seem to make any difference :-(
1641              (let ((res (call-process cvs-program nil '(t . nil) nil
1642                                     "-q" "update" "-p" "-r" rev file)))                                     "-q" "update" "-p" "-r" rev file)))
1643              (when (and res (not (and (equal 0 res))))              (when (and res (not (and (equal 0 res))))
1644                (error "Something went wrong retrieving revision %s: %s" rev res))                (error "Something went wrong retrieving revision %s: %s" rev res))
# Line 1628  Signal an error if there is no backup fi Line 1722  Signal an error if there is no backup fi
1722                   rev1-buf rev2-buf)))))                   rev1-buf rev2-buf)))))
1723    
1724    
 (defun cvs-fileinfo-kill (c fi)  
   "Mark a fileinfo xor its members (in case of a directory) as dead."  
   (if (eq (cvs-fileinfo->type fi) 'DIRCHANGE)  
       (dolist (fi (ewoc-collect c 'cvs-dir-member-p  
                                 (cvs-fileinfo->dir fi)))  
         (setf (cvs-fileinfo->type fi) 'DEAD))  
     (setf (cvs-fileinfo->type fi) 'DEAD)))  
   
1725  (defun cvs-is-within-p (fis dir)  (defun cvs-is-within-p (fis dir)
1726    "Non-nil is buffer is inside one of FIS (in DIR)."    "Non-nil is buffer is inside one of FIS (in DIR)."
1727    (when (stringp buffer-file-name)    (when (stringp buffer-file-name)
# Line 1662  POSTPROC is a list of expressions to be Line 1748  POSTPROC is a list of expressions to be
1748      ;; Save the relevant buffers      ;; Save the relevant buffers
1749      (save-some-buffers nil (lambda () (cvs-is-within-p fis def-dir))))      (save-some-buffers nil (lambda () (cvs-is-within-p fis def-dir))))
1750    (unless (listp flags) (error "flags should be a list of strings"))    (unless (listp flags) (error "flags should be a list of strings"))
1751      ;; Some w32 versions of CVS don't like an explicit . too much.
1752      (when (and (car fis) (null (cdr fis))
1753                 (eq (cvs-fileinfo->type (car fis)) 'DIRCHANGE)
1754                 ;; (equal (cvs-fileinfo->file (car fis)) ".")
1755                 (equal (cvs-fileinfo->dir (car fis)) ""))
1756        (setq fis nil))
1757    (let* ((cvs-buf (current-buffer))    (let* ((cvs-buf (current-buffer))
1758           (single-dir (or (not (listp cvs-execute-single-dir))           (single-dir (or (not (listp cvs-execute-single-dir))
1759                           (member cmd cvs-execute-single-dir)))                           (member cmd cvs-execute-single-dir)))
# Line 1672  POSTPROC is a list of expressions to be Line 1764  POSTPROC is a list of expressions to be
1764                              (eq cvs-auto-remove-handled 'delayed) nil t)                              (eq cvs-auto-remove-handled 'delayed) nil t)
1765      (when (fboundp after-mode)      (when (fboundp after-mode)
1766        (setq postproc (append postproc `((,after-mode)))))        (setq postproc (append postproc `((,after-mode)))))
1767      (when parse (push `(cvs-parse-process ',dont-change-disc) postproc))      (when parse
1768      (when (member cmd '("status" "update"))     ;FIXME: Yuck!!        (let ((old-fis
1769        ;; absence of `cvs update' output has a specific meaning.               (when (member cmd '("status" "update"))    ;FIXME: Yuck!!
1770        (push                  ;; absence of `cvs update' output has a specific meaning.
1771         `(dolist (fi ',(or fis                  (or fis (list (cvs-create-fileinfo 'DIRCHANGE "" "." ""))))))
1772                            (list (cvs-create-fileinfo 'DIRCHANGE "" "." ""))))          (push `(cvs-parse-process ',dont-change-disc nil ',old-fis) postproc)))
           (cvs-fileinfo-kill ',cvs-cookies fi))  
        postproc))  
1773      (setq postproc (if (cdr postproc) (cons 'progn postproc) (car postproc)))      (setq postproc (if (cdr postproc) (cons 'progn postproc) (car postproc)))
1774      (cvs-update-header args fis)      (cvs-update-header args fis)
1775      (with-current-buffer buf      (with-current-buffer buf
# Line 1809  This command ignores files that are not Line 1899  This command ignores files that are not
1899  With a prefix, opens the buffer in an OTHER window."  With a prefix, opens the buffer in an OTHER window."
1900    (interactive (list last-input-event current-prefix-arg))    (interactive (list last-input-event current-prefix-arg))
1901    (when (ignore-errors (mouse-set-point e) t)   ;for invocation via the mouse    (when (ignore-errors (mouse-set-point e) t)   ;for invocation via the mouse
1902      (unless (memq (get-text-property (point) 'face)      (unless (memq (get-text-property (1- (line-end-position)) 'font-lock-face)
1903                    '(cvs-header-face cvs-filename-face))                    '(cvs-header-face cvs-filename-face))
1904        (error "Not a file name")))        (error "Not a file name")))
1905    (cvs-mode!    (cvs-mode!
# Line 1845  The file is removed and `cvs update FILE Line 1935  The file is removed and `cvs update FILE
1935    (interactive (list nil));; (cvs-flags-query 'cvs-undo-flags "undo flags")    (interactive (list nil));; (cvs-flags-query 'cvs-undo-flags "undo flags")
1936    (if current-prefix-arg (call-interactively 'cvs-mode-revert-to-rev)    (if current-prefix-arg (call-interactively 'cvs-mode-revert-to-rev)
1937      (let* ((fis (cvs-do-removal 'undo "update" 'all))      (let* ((fis (cvs-do-removal 'undo "update" 'all))
1938             (removedp (lambda (fi) (eq (cvs-fileinfo->type fi) 'REMOVED)))             (removedp (lambda (fi)
1939                           (or (eq (cvs-fileinfo->type fi) 'REMOVED)
1940                               (and (eq (cvs-fileinfo->type fi) 'CONFLICT)
1941                                    (eq (cvs-fileinfo->subtype fi) 'REMOVED)))))
1942             (fis-split (cvs-partition removedp fis))             (fis-split (cvs-partition removedp fis))
1943             (fis-removed (car fis-split))             (fis-removed (car fis-split))
1944             (fis-other (cdr fis-split)))             (fis-other (cdr fis-split)))
# Line 1920  Returns a list of FIS that should be `cv Line 2013  Returns a list of FIS that should be `cv
2013           (tmpbuf (cvs-temp-buffer)))           (tmpbuf (cvs-temp-buffer)))
2014      (when (and (not silent) (equal cvs-confirm-removals 'list))      (when (and (not silent) (equal cvs-confirm-removals 'list))
2015        (with-current-buffer tmpbuf        (with-current-buffer tmpbuf
2016          (cvs-insert-strings (mapcar 'cvs-fileinfo->full-path fis))          (let ((inhibit-read-only t))
2017          (cvs-pop-to-buffer-same-frame (current-buffer))            (cvs-insert-strings (mapcar 'cvs-fileinfo->full-path fis))
2018          (shrink-window-if-larger-than-buffer)))            (cvs-pop-to-buffer-same-frame (current-buffer))
2019              (shrink-window-if-larger-than-buffer))))
2020      (if (not (or silent      (if (not (or silent
2021                   (unwind-protect                   (unwind-protect
2022                       (yes-or-no-p (format "Delete %d files? " (length files)))                       (yes-or-no-p (format "Delete %d files? " (length files)))
# Line 1948  With prefix argument, prompt for cvs fla Line 2042  With prefix argument, prompt for cvs fla
2042  (defvar cvs-tag-name "")  (defvar cvs-tag-name "")
2043  (defun-cvs-mode (cvs-mode-tag . SIMPLE) (tag &optional flags)  (defun-cvs-mode (cvs-mode-tag . SIMPLE) (tag &optional flags)
2044    "Run `cvs tag TAG' on all selected files.    "Run `cvs tag TAG' on all selected files.
2045  With prefix argument, prompt for cvs flags."  With prefix argument, prompt for cvs flags.
2046    By default this can only be used on directories.
2047    Use \\[cvs-mode-force-command] or change `cvs-force-dir-tag' if you need
2048    to use it on individual files."
2049    (interactive    (interactive
2050     (list (setq cvs-tag-name     (list (setq cvs-tag-name
2051                 (cvs-query-read cvs-tag-name "Tag name: " cvs-qtypedesc-tag))                 (cvs-query-read cvs-tag-name "Tag name: " cvs-qtypedesc-tag))
# Line 2126  The exact behavior is determined also by Line 2223  The exact behavior is determined also by
2223    
2224  (defun cvs-vc-command-advice (command file flags)  (defun cvs-vc-command-advice (command file flags)
2225    (when (and (equal command "cvs")    (when (and (equal command "cvs")
2226               ;; don't parse output we don't understand.               (progn
2227               (member (car flags) cvs-parse-known-commands))                 (while (and (stringp (car flags))
2228      (save-excursion                             (string-match "\\`-" (car flags)))
2229                     (pop flags))
2230                   ;; don't parse output we don't understand.
2231                   (member (car flags) cvs-parse-known-commands)))
2232        (save-current-buffer
2233        (let ((buffer (current-buffer))        (let ((buffer (current-buffer))
2234              (dir default-directory)              (dir default-directory)
2235              (cvs-from-vc t))              (cvs-from-vc t))
# Line 2140  The exact behavior is determined also by Line 2241  The exact behavior is determined also by
2241              (let ((subdir (substring dir (length default-directory))))              (let ((subdir (substring dir (length default-directory))))
2242                (set-buffer buffer)                (set-buffer buffer)
2243                (set (make-local-variable 'cvs-buffer) cvs-buf)                (set (make-local-variable 'cvs-buffer) cvs-buf)
2244                  ;; `cvs -q add file' produces no useful output :-(
2245                  (when (and (equal (car flags) "add")
2246                             (goto-char (point-min))
2247                             (looking-at ".*to add this file permanently\n\\'"))
2248                    (insert "cvs add: scheduling file `"
2249                            (file-name-nondirectory file)
2250                            "' for addition\n"))
2251                ;; VC never (?) does `cvs -n update' so dcd=nil                ;; VC never (?) does `cvs -n update' so dcd=nil
2252                ;; should probably always be the right choice.                ;; should probably always be the right choice.
2253                (cvs-parse-process nil subdir))))))))                (cvs-parse-process nil subdir))))))))

Legend:
Removed from v.1.35  
changed lines
  Added in v.1.35.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26