[Emacs-diffs] Changes to emacs/lisp/pcvs.el [lexbind]

[Miles Bader]

Index: emacs/lisp/pcvs.el
diff -c emacs/lisp/pcvs.el:1.35.2.1 emacs/lisp/pcvs.el:1.35.2.2
*** emacs/lisp/pcvs.el:1.35.2.1 Fri Apr  4 01:20:10 2003
--- emacs/lisp/pcvs.el  Tue Oct 14 19:51:20 2003
***************
*** 1,6 ****
  ;;; pcvs.el --- a front-end to CVS
  
! ;; Copyright (C) 1991,92,93,94,95,95,97,98,99,2000,2002
  ;;             Free Software Foundation, Inc.
  
  ;; Author: (The PCL-CVS Trust) address@hidden
--- 1,6 ----
  ;;; pcvs.el --- a front-end to CVS
  
! ;; Copyright (C) 1991,92,93,94,95,95,97,98,99,2000,02,2003
  ;;             Free Software Foundation, Inc.
  
  ;; Author: (The PCL-CVS Trust) address@hidden
***************
*** 14,20 ****
  ;;    (Jari Aalto+mail.emacs) address@hidden
  ;; Maintainer: (Stefan Monnier) monnier+lists/cvs/address@hidden
  ;; Keywords: CVS, version control, release management
- ;; Revision: $Id: pcvs.el,v 1.35.2.1 2003/04/04 06:20:10 miles Exp $
  
  ;; This file is part of GNU Emacs.
  
--- 14,19 ----
***************
*** 202,207 ****
--- 201,208 ----
  ;;;; Mouse bindings and mode motion
  ;;;;
  
+ (defvar cvs-minor-current-files)
+ 
  (defun cvs-menu (e)
    "Popup the CVS menu."
    (interactive "e")
***************
*** 368,374 ****
      (let ((proc (get-buffer-process buf)))
        (when (and (not normal) (processp proc)
                 (memq (process-status proc) '(run stop)))
!       (error "Can not run two cvs processes simultaneously")))
  
      (if (not name) (kill-local-variable 'other-window-scroll-buffer)
        ;; Strangely, if no window is created, `display-buffer' ends up
--- 369,382 ----
      (let ((proc (get-buffer-process buf)))
        (when (and (not normal) (processp proc)
                 (memq (process-status proc) '(run stop)))
!       (if cmd
!           ;; When CMD is specified, the buffer is normally shown to the
!           ;; user, so interrupting the process is not harmful.
!           ;; Use `delete-process' rather than `kill-process' otherwise
!           ;; the pending output of the process will still get inserted
!           ;; after we erase the buffer.
!           (delete-process proc)
!         (error "Can not run two cvs processes simultaneously"))))
  
      (if (not name) (kill-local-variable 'other-window-scroll-buffer)
        ;; Strangely, if no window is created, `display-buffer' ends up
***************
*** 443,454 ****
         (setq default-directory dir)
         (setq buffer-read-only nil)
         (erase-buffer)
!        (insert "\
! Repository : " (directory-file-name (cvs-get-cvsroot)) "
! Module     : " (cvs-get-module) "
! Working dir: " (abbreviate-file-name dir) "
! 
! ")
         (setq buffer-read-only t)
         (cvs-mode)
         (set (make-local-variable 'list-buffers-directory) buffer-name)
--- 451,468 ----
         (setq default-directory dir)
         (setq buffer-read-only nil)
         (erase-buffer)
!        (insert "Repository : " (directory-file-name (cvs-get-cvsroot))
!                "\nModule     : " (cvs-get-module)
!                "\nWorking dir: " (abbreviate-file-name dir)
!                (if (not (file-readable-p "CVS/Tag")) "\n"
!                  (let ((tag (cvs-file-to-string "CVS/Tag")))
!                    (cond
!                     ((string-match "\\`T" tag)
!                      (concat "\nTag        : " (substring tag 1)))
!                     ((string-match "\\`D" tag)
!                      (concat "\nDate       : " (substring tag 1)))
!                     ("\n"))))
!                "\n")
         (setq buffer-read-only t)
         (cvs-mode)
         (set (make-local-variable 'list-buffers-directory) buffer-name)
***************
*** 729,735 ****
       ((eq style 'DOUBLE)
        (string-match ".*" docstring)
        (let ((line1 (match-string 0 docstring))
-           (restdoc (substring docstring (match-end 0)))
            (fun-1 (intern (concat (symbol-name fun) "-1"))))
        `(progn
           (defun ,fun-1 ,args
--- 743,748 ----
***************
*** 964,969 ****
--- 977,983 ----
                     (cvs-flags-query 'cvs-update-flags "cvs -n update flags")))
    (when (eq flags t)
      (setf flags (cvs-flags-query 'cvs-update-flags nil 'noquery)))
+   (when find-file-visit-truename (setq directory (file-truename directory)))
    (cvs-cmd-do "update" directory flags nil
              (> (prefix-numeric-value current-prefix-arg) 8)
              :cvsargs '("-n")
***************
*** 1058,1064 ****
    (cvs-prefix-set 'cvs-force-command arg))
  
  (put 'cvs-mode 'mode-class 'special)
! (define-derived-mode cvs-mode fundamental-mode "CVS"
    "Mode used for PCL-CVS, a frontend to CVS.
  Full documentation is in the Texinfo file."
    (setq mode-line-process
--- 1072,1078 ----
    (cvs-prefix-set 'cvs-force-command arg))
  
  (put 'cvs-mode 'mode-class 'special)
! (define-derived-mode cvs-mode nil "CVS"
    "Mode used for PCL-CVS, a frontend to CVS.
  Full documentation is in the Texinfo file."
    (setq mode-line-process
***************
*** 1067,1072 ****
--- 1081,1088 ----
               ("" cvs-branch-prefix (cvs-secondary-branch-prefix
                                      ("->" cvs-secondary-branch-prefix))))
          " " cvs-mode-line-process))
+   (if buffer-file-name
+       (error "Use M-x cvs-quickdir to get a *cvs* buffer."))
    (buffer-disable-undo)
    ;;(set (make-local-variable 'goal-column) cvs-cursor-column)
    (set (make-local-variable 'revert-buffer-function) 'cvs-mode-revert-buffer)
***************
*** 1240,1246 ****
    (let ((tin (ewoc-goto-prev cvs-cookies 1)))
      (when tin
        (setf (cvs-fileinfo->marked (ewoc-data tin)) nil)
!       (ewoc-invalidate cvs-cookies tin))))
  
  (defconst cvs-ignore-marks-alternatives
    '(("toggle-marks"   . "/TM")
--- 1256,1263 ----
    (let ((tin (ewoc-goto-prev cvs-cookies 1)))
      (when tin
        (setf (cvs-fileinfo->marked (ewoc-data tin)) nil)
!       (ewoc-invalidate cvs-cookies tin)))
!   (cvs-move-to-goal-column))
  
  (defconst cvs-ignore-marks-alternatives
    '(("toggle-marks"   . "/TM")
***************
*** 1280,1286 ****
  (defun cvs-mode-mark-get-modif (cmd)
    (if (cvs-ignore-marks-p cmd 'read-only) "/IM" "/FM"))
  
- (defvar cvs-minor-current-files)
  (defun cvs-get-marked (&optional ignore-marks ignore-contents)
    "Return a list of all selected fileinfos.
  If there are any marked tins, and IGNORE-MARKS is nil, return them.
--- 1297,1302 ----
***************
*** 1424,1429 ****
--- 1440,1446 ----
           (match-beginning 0)
         (point))))))
  
+ (defvar cvs-edit-log-revision)
  (defun cvs-mode-edit-log (rev &optional text)
    "Edit the log message at point.
  This is best called from a `log-view-mode' buffer."
***************
*** 1556,1564 ****
    (interactive (list (cvs-flags-query 'cvs-diff-flags "diff flags")))
    (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")))
!        ;;(tins (cvs-filter-applicable filter marked))
         (fis (car (cvs-partition 'cvs-fileinfo->backup-file marked))))
      (unless (consp fis)
        (error "No files with a backup file selected!"))
--- 1573,1579 ----
    (interactive (list (cvs-flags-query 'cvs-diff-flags "diff flags")))
    (unless (listp flags) (error "flags should be a list of strings"))
    (save-some-buffers)
!   (let* ((marked (cvs-get-marked (cvs-ignore-marks-p "diff")))
         (fis (car (cvs-partition 'cvs-fileinfo->backup-file marked))))
      (unless (consp fis)
        (error "No files with a backup file selected!"))
***************
*** 1591,1596 ****
--- 1606,1612 ----
  ;;
  
  (defvar ediff-after-quit-destination-buffer)
+ (defvar ediff-after-quit-hook-internal)
  (defvar cvs-transient-buffers)
  (defun cvs-ediff-startup-hook ()
    (add-hook 'ediff-after-quit-hook-internal
***************
*** 1638,1645 ****
          ;; Discard stderr output to work around the CVS+SSH+libc
          ;; problem when stdout and stderr are the same.
          ;; FIXME: this doesn't seem to make any difference :-(
!         (let ((res (call-process cvs-program nil '(t . nil) nil
!                                  "-q" "update" "-p" "-r" rev file)))
            (when (and res (not (and (equal 0 res))))
              (error "Something went wrong retrieving revision %s: %s" rev res))
            (set-buffer-modified-p nil)
--- 1654,1667 ----
          ;; Discard stderr output to work around the CVS+SSH+libc
          ;; problem when stdout and stderr are the same.
          ;; FIXME: this doesn't seem to make any difference :-(
!         (let ((res (apply 'call-process cvs-program nil '(t . nil) nil
!                           "-q" "update" "-p"
!                           ;; If `rev' is HEAD, don't pass it at all:
!                           ;; the default behavior is to get the head
!                           ;; of the current branch whereas "-r HEAD"
!                           ;; stupidly gives you the head of the trunk.
!                           (append (unless (equal rev "HEAD") (list "-r" rev))
!                                   (list file)))))
            (when (and res (not (and (equal 0 res))))
              (error "Something went wrong retrieving revision %s: %s" rev res))
            (set-buffer-modified-p nil)
***************
*** 1754,1761 ****
             ;; (equal (cvs-fileinfo->file (car fis)) ".")
             (equal (cvs-fileinfo->dir (car fis)) ""))
      (setq fis nil))
!   (let* ((cvs-buf (current-buffer))
!        (single-dir (or (not (listp cvs-execute-single-dir))
                         (member cmd cvs-execute-single-dir)))
         (parse (member cmd cvs-parse-known-commands))
         (args (append cvsargs (list cmd) flags))
--- 1776,1782 ----
             ;; (equal (cvs-fileinfo->file (car fis)) ".")
             (equal (cvs-fileinfo->dir (car fis)) ""))
      (setq fis nil))
!   (let* ((single-dir (or (not (listp cvs-execute-single-dir))
                         (member cmd cvs-execute-single-dir)))
         (parse (member cmd cvs-parse-known-commands))
         (args (append cvsargs (list cmd) flags))
***************
*** 1773,1786 ****
      (setq postproc (if (cdr postproc) (cons 'progn postproc) (car postproc)))
      (cvs-update-header args fis)
      (with-current-buffer buf
-       ;;(set (make-local-variable 'cvs-buffer) cvs-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 parse 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
--- 1794,1806 ----
      (setq postproc (if (cdr postproc) (cons 'progn postproc) (car postproc)))
      (cvs-update-header args fis)
      (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)
    "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
***************
*** 1850,1873 ****
  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))
      (setf (cvs-fileinfo->type fi) 'DEAD))
    (cvs-cleanup-collection cvs-cookies nil nil nil))
  
  
! (defun cvs-append-to-ignore (dir str)
!   "Add STR to the .cvsignore file in DIR."
!   (save-window-excursion
!     (set-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-toggle-read-only))
      (goto-char (point-max))
!     (unless (zerop (current-column)) (insert "\n"))
!     (insert str "\n")
      (if cvs-sort-ignore-file (sort-lines nil (point-min) (point-max)))
      (save-buffer)))
  
--- 1870,1896 ----
  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)
!                         (eq (cvs-fileinfo->subtype fi) 'NEW-DIR))
      (setf (cvs-fileinfo->type fi) 'DEAD))
    (cvs-cleanup-collection cvs-cookies nil nil nil))
  
  
! (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)))
  
***************
*** 1898,1907 ****
    "Select a buffer containing the file.
  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 (1- (line-end-position)) 'font-lock-face)
!                 '(cvs-header-face cvs-filename-face))
!       (error "Not a file name")))
    (cvs-mode!
     (lambda (&optional rev)
       (interactive (list (cvs-prefix-get 'cvs-branch-prefix)))
--- 1921,1932 ----
    "Select a buffer containing the file.
  With a prefix, opens the buffer in an OTHER window."
    (interactive (list last-input-event current-prefix-arg))
!   ;; If the event moves point, check that it moves it to a valid location.
!   (when (and (/= (point) (progn (ignore-errors (mouse-set-point e)) (point)))
!            (not (memq (get-text-property (1- (line-end-position))
!                                            'font-lock-face)
!                         '(cvs-header-face cvs-filename-face))))
!     (error "Not a file name"))
    (cvs-mode!
     (lambda (&optional rev)
       (interactive (list (cvs-prefix-get 'cvs-branch-prefix)))
***************
*** 2019,2025 ****
          (shrink-window-if-larger-than-buffer))))
      (if (not (or silent
                 (unwind-protect
!                    (yes-or-no-p (format "Delete %d files? " (length files)))
                   (cvs-bury-buffer tmpbuf cvs-buffer))))
        (progn (message "Aborting") nil)
        (dolist (fi files)
--- 2044,2059 ----
          (shrink-window-if-larger-than-buffer))))
      (if (not (or silent
                 (unwind-protect
!                    (yes-or-no-p
!                     (let ((nfiles (length files))
!                           (verb (if (eq filter 'undo) "Undo" "Delete")))
!                       (if (= 1 nfiles)
!                           (format "%s file: \"%s\" ? "
!                                   verb
!                                   (cvs-fileinfo->file (car files)))
!                         (format "%s %d files? "
!                                 verb
!                                 nfiles))))
                   (cvs-bury-buffer tmpbuf cvs-buffer))))
        (progn (message "Aborting") nil)
        (dolist (fi files)
***************
*** 2228,2234 ****
                           (string-match "\\`-" (car flags)))
                 (pop flags))
               ;; don't parse output we don't understand.
!              (member (car flags) cvs-parse-known-commands)))
      (save-current-buffer
        (let ((buffer (current-buffer))
            (dir default-directory)
--- 2262,2273 ----
                           (string-match "\\`-" (car flags)))
                 (pop flags))
               ;; don't parse output we don't understand.
!              (member (car flags) cvs-parse-known-commands))
!            ;; Don't parse "update -p" output.
!            (not (and (member (car flags) '("update" "checkout"))
!                      (let ((found-p nil))
!                        (dolist (flag flags found-p)
!                          (if (equal flag "-p") (setq found-p t)))))))
      (save-current-buffer
        (let ((buffer (current-buffer))
            (dir default-directory)
***************
*** 2282,2285 ****
--- 2321,2325 ----
  
  (provide 'pcvs)
  
+ ;;; arch-tag: 8e3a7494-0453-4389-9ab3-a557ce9fab61
  ;;; pcvs.el ends here