cgit.sxemacs.org Git - packages/blob - xemacs-packages/prog-modes/cvs.el

   1 ;; cvs.el --- Light cvs support for emacs (ediff + msb + dired + mode line)
   2 ;;
   3 ;; Copyright (C) 1995-1998 Frederic Lepied <Frederic.Lepied@sugix.frmug.org>
   4 ;;
   5 ;; Author: Frederic Lepied <Frederic.Lepied@sugix.frmug.org>
   6 ;; Version: $Id: cvs.el,v 1.4 2006-06-16 10:23:27 viteno Exp $
   7 ;; Keywords: cvs ediff mode-line
   8 ;;
   9 ;; LCD Archive Entry:
  10 ;; cvs|Frederic Lepied|Frederic.Lepied@sugix.frmug.org|
  11 ;; Light cvs support for emacs (ediff + msb + dired + mode line).|
  12 ;; $Date: 2006-06-16 10:23:27 $|$Revision: 1.4 $|~/modes/cvs.el.gz|
  13 ;;
  14 ;; This program is free  software;  you can redistribute   it and/or modify  it
  15 ;; under the terms of  the GNU General Public  License as published by the Free
  16 ;; Software  Foundation; either version  2 of the  License, or (at your option)
  17 ;; any later version.
  18 ;;
  19 ;; This program is distributed in the hope that it  will be useful, but WITHOUT
  20 ;; ANY WARRANTY;  without even  the   implied warranty  of  MERCHANTABILITY  or
  21 ;; FITNESS FOR A  PARTICULAR PURPOSE.  See  the GNU General  Public License for
  22 ;; more details.
  23 ;;
  24 ;; You should have received a copy of the GNU General Public License along with
  25 ;; this program; if not, write to the Free  Software Foundation, Inc., 675 Mass
  26 ;; Ave, Cambridge, MA 02139, USA.
  27 ;;
  28 ;; Purpose of this package:
  29 ;;   1. Display CVS revision in mode line.
  30 ;;   2. Compare file changes between CVS revisions using ediff.
  31 ;;   3. Some keystrokes and menu entries to execute cvs status, cvs log and
  32 ;; cvsann (Thanks to Ray Nickson <nickson@cs.uq.oz.au>).
  33 ;;   4. Simple interface to cvs commit and cvs update commands.
  34 ;;   5. Status listing per directory courtesy of Stephan Heuel
  35 ;; <steve@ipb.uni-bonn.de>.
  36 ;;   6. msb support (better buffer selection).
  37 ;;   7. dired support.
  38 ;;   8. softlink tree support.
  39 ;;   9. little module support (status and update).
  40 ;;
  41 ;; Installation:
  42 ;;   put cvs.el in a directory in your load-path and byte compile it.
  43 ;;   then put (require 'cvs) in your .emacs or in site-start.el
  44 ;;
  45 ;; Thanks to Darryl  Okahata <darrylo@sr.hp.com> for the module status
  46 ;; enhancements, branch merge new command and the module update new command.
  47
  48 ;;=============================================================================
  49 ;; dependencies
  50 ;;=============================================================================
  51 (require 'easymenu)
  52
  53 ;;=============================================================================
  54 (defconst cvs:version "$Id: cvs.el,v 1.4 2006-06-16 10:23:27 viteno Exp $"
  55   "Version number of cvs.el. To communicate with bug report")
  56
  57 ;;=============================================================================
  58 (defconst cvs:maintainer-address "cvs-help@sugix.frmug.org"
  59   "Address to send any comment, bug or report")
  60
  61 ;;=============================================================================
  62 (defvar cvs:current-revision  nil
  63   "Stores the CVS revision number of the file")
  64 (make-variable-buffer-local 'cvs:current-revision)
  65
  66 ;;=============================================================================
  67 (defvar cvs-temp-dir (or (getenv "TMPDIR")
  68                          (getenv "TMP")
  69                          (getenv "TEMP"))
  70   "* if non nil, `cvs-temp-dir' is the directory where to extract versions.")
  71
  72 ;;=============================================================================
  73 (defvar cvs-command "cvs"
  74   "Name of the cvs command including path if needed")
  75
  76 ;;=============================================================================
  77 (defvar cvsann-command "cvsann"
  78   "Name of the cvsann command including path if needed")
  79
  80 ;;=============================================================================
  81 (defvar cvs-root nil
  82   "*If non nil, `cvs-root' is the base directory of the CVS repository.")
  83
  84 ;;=============================================================================
  85 (defvar cvs-minor-mode-hooks nil
  86   "Hooks run when Cvs mode is initialized")
  87
  88 ;;=============================================================================
  89 (defvar cvs-load-hooks nil
  90   "Hooks run when cvs.el has been loaded")
  91
  92 ;;=============================================================================
  93 (defvar cvs-commit-hooks nil
  94   "Hooks run entering commit buffer")
  95
  96 ;;=============================================================================
  97 (defvar cvs-before-commit-hooks nil
  98   "Hooks run before commiting")
  99
 100 ;;=============================================================================
 101 (defvar cvs-add-hooks nil
 102   "Hooks run after adding a file into CVS with `cvs-add'")
 103
 104 ;;=============================================================================
 105 (defvar cvs-mark-hooks nil
 106   "Hooks run after marking or unmarking a file with `cvs-mark'")
 107
 108 ;;=============================================================================
 109 (defvar cvs-shell-command
 110   (if (memq system-type '(ms-dos emx windows-nt))
 111       shell-file-name
 112     "/bin/sh")
 113   "Name of the shell used in cvs commands.
 114 It is initialized from `shell-file-name' on most systems.
 115 NB: Not all shells may be adequate as `shell-file-name'.")
 116
 117 ;;=============================================================================
 118 (defvar cvs-shell-command-option
 119   (cond ((memq system-type '(ms-dos windows-nt))
 120          (if (boundp 'shell-command-switch)
 121              shell-command-switch
 122            "/c"))
 123         (t                              ;Unix & EMX (Emacs 19 port to OS/2)
 124          "-c"))
 125   "Shell argument indicating that next argument is the command.
 126 It is initialized from `shell-command-switch' on most systems.
 127 NB: Not all shells may have an adequate `shell-command-switch'.")
 128
 129 ;;=============================================================================
 130 (defvar cvs-file-option "-F"
 131   "CVS option to read log from a file.
 132 Some CVS versions need \"-f\" others need \"-F\".")
 133
 134 ;;=============================================================================
 135 (defvar cvs-diff-options ()
 136   "*Optional arguments passed to the cvs diff command (`cvs-diff').
 137 For example you can do unified diff with '(\"-u\").")
 138
 139 ;;=============================================================================
 140 (defvar cvs-no-log-option nil
 141   "CVS option not to log the cvs_command in the command history.")
 142
 143 ;;=============================================================================
 144 (defvar cvs-never-use-emerge nil
 145   "* don't merge update conflicts with emerge function from ediff package if set to t.")
 146
 147 ;;=============================================================================
 148 (defvar cvs-ediff-merge-no-cleanup nil
 149   "*If not nil, do not rename *ediff-merge* buffer after the merge.")
 150
 151 ;;=============================================================================
 152 (defvar cvs-save-prefix ".#"
 153   "prefix used by cvs to save a file if there are conflicts while updating")
 154
 155 ;;=============================================================================
 156 ;; minor mode status variable (buffer local).
 157 ;;=============================================================================
 158 (defvar cvs-minor-mode nil
 159   "Status variable to switch to CVS minor mode if sets to t")
 160 (make-variable-buffer-local 'cvs-minor-mode)
 161 (put 'cvs-minor-mode 'permanent-local t)
 162
 163 ;;=============================================================================
 164 (defvar cvs-minor-mode-in-modeline t
 165   "If non-nil display the version number in the modeline.
 166 This variable has to be set before loading the package cvs.el.")
 167
 168 ;;=============================================================================
 169 ;; minor mode status variable (buffer local).
 170 ;;=============================================================================
 171 (defvar cvs:mark nil
 172   "Status variable to say if a file will be commited in the next commit command.")
 173 (make-variable-buffer-local 'cvs:mark)
 174 (put 'cvs:mark 'permanent-local t)
 175
 176 ;;=============================================================================
 177 (defvar cvs:marked-list nil
 178   "List of marked files. See `cvs-mark'")
 179
 180 (defvar cvs:commit-list nil
 181   "List of files uppon which to perform cvs commit")
 182
 183 ;;=============================================================================
 184 ;; minor mode entry point.
 185 ;;=============================================================================
 186 (defun cvs-minor-mode (&optional arg)
 187   "
 188 Help to admin CVS controlled files :
 189         \\[cvs-log]             display cvs log output.
 190         \\[cvs-file-status]             display cvs status output.
 191         \\[cvs-annotate]                display cvs annotate output.
 192         \\[cvs-history]         display cvs history output.
 193         \\[cvs-who]             display who is responsable of the selected region.
 194         \\[cvs-description]             change the description message.
 195         \\[cvs-change-log]              change a log message.
 196         \\[cvs-edit]            run the cvs edit or unedit command.
 197         \\[cvs-ediff-internal]          run ediff between current file and a revision.
 198         \\[cvs-ediff]           run ediff between two revisions of the file.
 199         \\[cvs-diff]            display diff between current file and a revision.
 200         \\[cvs-version-other-window]            retrieve a specified version in an other window.
 201         \\[cvs-update-file]             update the file from the repository.
 202         \\[cvs-revert]          revert the file to a previous version from the repository.
 203         \\[cvs-merge-backup]            run a merger to remove conflict from the update process.
 204         \\[cvs-mark]            add/remove a file to the marked list (toggle).
 205         \\[cvs-flush]           make the marked list empty.
 206         \\[cvs-commit]          perform the cvs commit command on the marked list.
 207         \\[cvs-commit-file]             perform the cvs commit command on the current file.
 208         \\[cvs-status-process]          display the status of the files in the current module.
 209         \\[cvs-marked-status]           display the status of the marked files.
 210         \\[cvs-submit-report]           send a bug/comment report to the cvs.el maintainer."
 211   (setq cvs-minor-mode (if (null arg) t (car arg)))
 212   (if cvs-minor-mode
 213       (progn
 214         (easy-menu-add cvs:menu cvs:map)
 215         (run-hooks 'cvs-minor-mode-hooks)))
 216   cvs-minor-mode)
 217
 218 ;;=============================================================================
 219 ;; register cvs minor mode keymap and mode line display.
 220 ;;=============================================================================
 221 (defvar cvs:map (make-sparse-keymap)
 222   "CVS minor mode keymap")
 223
 224 (defvar cvs:commit-map (make-sparse-keymap)
 225   "CVS commit edition buffer keymap")
 226
 227 (define-key cvs:map "\C-cvW" 'cvs-who)
 228 (define-key cvs:map "\C-cvo" 'cvs-log)
 229 (define-key cvs:map "\C-cvs" 'cvs-file-status)
 230 (define-key cvs:map "\C-cve" 'cvs-editors)
 231 (define-key cvs:map "\C-cvw" 'cvs-watchers)
 232 (define-key cvs:map "\C-x\C-q" 'cvs-edit)
 233 (define-key cvs:map "\C-cvU" 'cvs-update-directory)
 234 (define-key cvs:map "\C-cvS" 'cvs-status-process)
 235 (define-key cvs:map "\C-cvM" 'cvs-marked-status)
 236 (define-key cvs:map "\C-cvB" 'cvs-merge-branch)
 237 (define-key cvs:map "\C-cvL" 'cvs-status-mark-changed)
 238 (define-key cvs:map "\C-cvd" 'cvs-ediff-internal)
 239 (define-key cvs:map "\C-cvi" 'cvs-diff)
 240 (define-key cvs:map "\C-cv\C-d" 'cvs-ediff)
 241 (define-key cvs:map "\C-cvv" 'cvs-version-other-window)
 242 (define-key cvs:map "\C-cvm" 'cvs-mark)
 243 (define-key cvs:map "\C-cvc" 'cvs-commit)
 244 (define-key cvs:map "\C-cvC" 'cvs-commit-file)
 245 (define-key cvs:map "\C-cvl" 'cvs-list)
 246 (define-key cvs:map "\C-cvf" 'cvs-flush)
 247 (define-key cvs:map "\C-cvu" 'cvs-update-file)
 248 (define-key cvs:map "\C-cvr" 'cvs-revert)
 249 (define-key cvs:map "\C-cvb" 'cvs-submit-report)
 250 (define-key cvs:map "\C-cvh" 'cvs-history)
 251 (define-key cvs:map "\C-cva" 'cvs-annotate)
 252 (define-key cvs:commit-map "\C-c\C-c" 'cvs-do-commit)
 253 (define-key cvs:commit-map "\C-c\C-d" 'cvs-bury-buffer)
 254 (define-key cvs:commit-map "\C-cvl" 'cvs-list)
 255 (easy-menu-define
 256  cvs:menu
 257  cvs:map
 258  "CVS minor mode keymap"
 259  '("CVS"
 260     ["Update File" cvs-update-file t]
 261     ["Commit File" cvs-commit-file t]
 262     ["(Un)Edit" cvs-edit t]
 263     ["Log" cvs-log t]
 264     ["Annotate" cvs-annotate t]
 265     ["History" cvs-history t]
 266     ["File Status" cvs-file-status t]
 267     ["Editors" cvs-editors t]
 268     ["Watchers" cvs-watchers t]
 269     ["EDiff" cvs-ediff-internal t]
 270     ["Diff" cvs-diff t]
 271     "-----------"
 272     ["Module Status" cvs-status-process t]
 273     ["Update Module" cvs-update-directory t]
 274     "-----------"
 275     ("Marking Files"
 276      ["(Un)Mark current buffer" cvs-mark t]
 277      ["Show List" cvs-list t]
 278      ["Flush List" cvs-flush t]
 279      )
 280     ("Action on Marked Files"
 281      ["Commit" cvs-commit t]
 282      ["Show Status" cvs-marked-status t]
 283      )
 284     ("Other Commands"
 285      ["EDiff two revs" cvs-ediff t]
 286      ["Restore version" cvs-revert t]
 287      ["Merge backup" cvs-merge-backup t]
 288      ["Merge branch" cvs-merge-branch t]
 289      ["Retrieve version" cvs-version-other-window t]
 290      ["Change description" cvs-description t]
 291      ["Change log message" cvs-change-log t]
 292      ["Who" cvs-who t])
 293     "--------"
 294     ["Send bug/comment report" cvs-submit-report t]))
 295
 296 (defconst cvs:entry
 297   (list 'cvs-minor-mode (cons "" '(" CVS:" cvs:current-revision)))
 298   "Entry to display CVS revision number in mode line")
 299
 300 (or (assq 'cvs-minor-mode minor-mode-alist)
 301     (not cvs-minor-mode-in-modeline)
 302     (setq minor-mode-alist (cons cvs:entry minor-mode-alist)))
 303
 304 (or (assq 'cvs-minor-mode minor-mode-map-alist)
 305     (setq minor-mode-map-alist (cons (cons 'cvs-minor-mode cvs:map)
 306                                      minor-mode-map-alist)))
 307
 308 ;;=============================================================================
 309 (defconst cvs:mark-entry
 310   (list 'cvs:mark " marked")
 311   "Entry to display CVS revision number in mode line")
 312
 313 (or (assq 'cvs:mark minor-mode-alist)
 314     (setq minor-mode-alist (cons cvs:mark-entry minor-mode-alist)))
 315
 316 ;;=============================================================================
 317 (defvar cvs:remote-regexp "^/[^/:]*[^/:]:"
 318   "regexp to test if a file is accessed from ftp")
 319
 320 (defun is-under-cvs ()
 321   "Test if the file in the current buffer is under CVS.
 322 If so, set the variables `cvs:current-revision' and `cvs-minor-mode'."
 323   (interactive)
 324   (let ((result nil)
 325         current-revision)
 326     (if (and buffer-file-name
 327              (not (string-match cvs:remote-regexp buffer-file-name))) ; reject remote files
 328         (progn
 329           (save-excursion
 330             (let* ((filename (file-truename buffer-file-name))
 331                    (buffer (current-buffer))
 332                    (entries-filename (concat (file-name-directory
 333                                               filename)
 334                                              "CVS/Entries")))
 335               (if (file-exists-p entries-filename)
 336                   (progn
 337                     (set-buffer (cvs:find-file-noselect entries-filename))
 338                     (goto-char 1)
 339                     (if (re-search-forward (concat "^/"
 340                                                    (regexp-quote (file-name-nondirectory filename))
 341                                                    "/\\([^/]*\\)/")
 342                                            nil t)
 343                         (progn
 344                           (setq result t)
 345                           (setq current-revision (buffer-substring
 346                                                   (match-beginning 1)
 347                                                   (match-end 1)))
 348                           (if (looking-at ".*/T\\([^/\n][^/\n]*\\)[ \t]*\n")
 349                               (let ( (tag (buffer-substring (match-beginning 1)
 350                                                             (match-end 1))) )
 351                                 (setq current-revision
 352                                       (format "%s-%s" tag current-revision))
 353                                 ))
 354                           )
 355                       )
 356                     ))))
 357                 ))
 358     (if result
 359         (progn
 360           (setq cvs:current-revision current-revision)
 361           (cvs-minor-mode)))
 362     result))
 363
 364
 365 (defun cvs:get-numeric-revision (revision)
 366   (progn
 367     (if (string-match "-\\([.0-9][.0-9]*\\)$" revision)
 368         (setq revision (match-string 1 revision)))
 369     revision
 370     ))
 371
 372
 373 (defun cvs:get-tag-revision (revision)
 374   (let ( (case-fold-search t) )
 375     (if (string-match "^\\([a-z].*\\)-[.0-9][.0-9]*$" revision)
 376         (setq revision (match-string 1 revision)))
 377     revision
 378     ))
 379
 380 ;;=============================================================================
 381 (defun cvs-ediff (old-rev new-rev)
 382   "Run Ediff between versions `old-rev' and `new-rev' of the current buffer."
 383   (interactive "sFirst version to visit (default is latest version):
 384 sSecond version to visit (default is latest version): ")
 385   (let ((old-vers (cvs-version-other-window old-rev)))
 386     (other-window 1)
 387     (cvs-version-other-window new-rev)
 388     ;; current-buffer is now supposed to contain the old version
 389     ;; in another window
 390     ;; We delete the temp file that was created by vc.el for the old
 391     ;; version
 392     (ediff-buffers old-vers (current-buffer)
 393                    (list (` (lambda () (delete-file (, (buffer-file-name))))))
 394                    'ediff-revision)
 395     ))
 396
 397 ;;=============================================================================
 398 (defun cvs-ediff-internal (rev)
 399   "Run Ediff on version REV of the current buffer in another window.
 400 If the current buffer is named `F', the version is named `F.~REV~'.
 401 If `F.~REV~' already exists, it is used instead of being re-created."
 402   (interactive "sVersion to visit (default is latest version): ")
 403   (let ((newvers (current-buffer)))
 404     (cvs-version-other-window rev)
 405     ;; current-buffer is now supposed to contain the old version
 406     ;; in another window
 407     ;; We delete the temp file that was created by vc.el for the old
 408     ;; version
 409     (ediff-buffers (current-buffer) newvers
 410                    (list (` (lambda () (delete-file (, (buffer-file-name))))))
 411                    'ediff-revision)
 412     ))
 413
 414 ;;=============================================================================
 415 (defun cvs-version-other-window (rev)
 416   "Visit version REV of the current buffer in another window.
 417 If the current buffer is named `F', the version is named `F.~REV~'.
 418 If `F.~REV~' already exists, it is used instead of being re-created."
 419   (interactive "sVersion to visit (default is latest version): ")
 420   (if buffer-file-name
 421       (let* ((version (if (string-equal rev "")
 422                           "lst"
 423                         rev))
 424              (filename (if cvs-temp-dir
 425                            (concat (file-name-as-directory cvs-temp-dir)
 426                                    (file-name-nondirectory buffer-file-name)
 427                                    ".~" version "~")
 428                          (concat buffer-file-name ".~" version "~"))))
 429         (if (or (file-exists-p filename)
 430                 (cvs:checkout (file-name-nondirectory buffer-file-name) rev
 431                               filename))
 432             (find-file-other-window filename)))))
 433
 434 ;;=============================================================================
 435 (defun cvs:checkout (filename rev output-name)
 436   "Checkout filename with revision `rev' to `output-name'."
 437   (let ((command (if (string= rev "")
 438                      (format "%s %s %s -Q update -p %s > %s" cvs-command
 439                              (if cvs-root
 440                                  (format "-d %s" cvs-root) "")
 441                              (if cvs-no-log-option
 442                                  cvs-no-log-option "")
 443                              filename output-name)
 444                      (format "%s %s %s -Q update -r %s -p %s > %s" cvs-command
 445                              (if cvs-root
 446                                  (format "-d %s" cvs-root) "")
 447                              (if cvs-no-log-option
 448                                  cvs-no-log-option "")
 449                              rev filename output-name))))
 450     (message "Retrieving version with command : %s" command)
 451     (if (/= (call-process cvs-shell-command nil nil t cvs-shell-command-option command)
 452             0)
 453         (error "Error while retrieving %s version of %s into %s"
 454                (if (string= "" rev) "last" rev) filename output-name)
 455       output-name)))
 456
 457 ;;=============================================================================
 458 (defun cvs-add (msg &optional file)
 459   "Add the current file into the CVS system"
 460   (interactive "sEnter description : ")
 461   (if (not file)
 462       (setq file (buffer-file-name)))
 463   (let ((command (format "%s %s add -m \"%s\" %s" cvs-command
 464                          (if cvs-root
 465                              (format "-d %s" cvs-root) "")
 466                          msg
 467                          (file-name-nondirectory file)))
 468         (filename (file-name-nondirectory file))
 469         (buf (get-buffer-create "*CVS Add output*")))
 470     (save-excursion
 471       (set-buffer buf)
 472       (setq buffer-read-only nil)
 473       (erase-buffer))
 474     (if (= (call-process cvs-shell-command nil buf t cvs-shell-command-option command)
 475            0)
 476         (progn
 477           (is-under-cvs)
 478           (run-hooks 'cvs-add-hooks)
 479           (message "File added to CVS -- use 'commit' to make permanent")
 480           )
 481       (cvs:display-temp-buffer buf "add")
 482       (error "Error while registering %s into CVS" filename))))
 483
 484 ;;=============================================================================
 485 ;; Change CVS description or log message
 486 ;;=============================================================================
 487 (defvar cvs:temp-filename nil
 488   "Internal variable used by cvs-description and cvs-change-log")
 489 (make-variable-buffer-local 'cvs:temp-filename)
 490 (put 'cvs:temp-filename 'permanent-local t)
 491
 492 (defvar cvs:temp-revision nil
 493   "Internal variable used by cvs-description and cvs-change-log")
 494 (make-variable-buffer-local 'cvs:temp-revision)
 495 (put 'cvs:temp-revision 'permanent-local t)
 496
 497 (defun cvs:get-description (file)
 498   (cvs:call-command cvs-command "*CVS temp*" "log"
 499                     (list "log" "-r0" (file-name-nondirectory file)))
 500   (save-excursion
 501     (set-buffer "*CVS temp*")
 502     (goto-char (point-min))
 503     (if (not (search-forward-regexp "^description:" nil t))
 504         (error "Invalid log output for file %s" rev file)
 505       (let* ((min (progn
 506                     (next-line 1) (beginning-of-line) (point)))
 507              (max (progn
 508                     (search-forward "======================================")
 509                     (beginning-of-line) (point)))
 510              (str (buffer-substring min max)))
 511         (kill-buffer "*CVS temp*")
 512         str))))
 513
 514 (defun cvs-description (&optional file)
 515   "Change the description of the current file into the CVS system"
 516   (interactive)
 517   (if (not file)
 518       (setq file (buffer-file-name)))
 519   (let ((dir default-directory)
 520         (str  (cvs:get-description file)))
 521     (switch-to-buffer-other-window (get-buffer-create "*CVS Description*"))
 522     (setq cvs:temp-filename file)
 523     (setq default-directory dir)
 524     (erase-buffer)
 525     (insert str)
 526     (insert "CVS: ----------------------------------------------------------------------\n")
 527     (insert "CVS: Enter description.  Lines beginning with `CVS: ' are removed automatically\n")
 528     (insert "CVS: changing description of " file "\n")
 529     (insert "CVS: ----------------------------------------------------------------------\n")
 530     (local-set-key "\C-c\C-c" 'cvs:do-description)
 531     (goto-char 0)
 532     (message "Type C-c C-c when done.")
 533     ))
 534
 535 (defun cvs:do-description ()
 536   "Change the description of the current file into the CVS system"
 537   (interactive)
 538   (let ((msg nil)
 539         (file-name cvs:temp-filename))
 540     (goto-char 0)
 541     (flush-lines "^CVS: .*$")
 542     (setq msg (buffer-string))
 543     (cvs-bury-buffer)
 544     (let ((command (format "%s %s admin -t-\"%s\" %s" cvs-command
 545                            (if cvs-root
 546                                (format "-d %s" cvs-root) "")
 547                            msg
 548                            (file-name-nondirectory file-name)))
 549           (filename (file-name-nondirectory file-name))
 550           (buf (get-buffer-create "*CVS Admin output*")) )
 551       (save-excursion
 552         (set-buffer buf)
 553         (setq buffer-read-only nil)
 554         (erase-buffer))
 555       (if (not (= (call-process cvs-shell-command nil buf t cvs-shell-command-option command)
 556                   0))
 557           (progn
 558             (cvs:display-temp-buffer buf "admin")
 559             (error "Error while changing description of %s into CVS" filename))))))
 560
 561 ;;=============================================================================
 562 (defun cvs:get-change-log (file rev)
 563   (cvs:call-command cvs-command "*CVS temp*" "log"
 564                     (list "log" (concat "-r" rev) (file-name-nondirectory file)))
 565   (save-excursion
 566     (set-buffer "*CVS temp*")
 567     (goto-char (point-min))
 568     (if (not (search-forward-regexp "^date: " nil t))
 569         (error "Revision %s doesn't exist for file %s" rev file)
 570       (let* ((min (progn
 571                     (next-line 1) (beginning-of-line) (point)))
 572              (max (progn
 573                     (search-forward "======================================")
 574                     (beginning-of-line) (point)))
 575              (str (buffer-substring min max)))
 576         (kill-buffer "*CVS temp*")
 577         str))))
 578
 579 (defun cvs-change-log (rev &optional file)
 580   "Change the description of the current file into the CVS system"
 581   (interactive "sVersion (default is current version): ")
 582   (if (not file)
 583       (setq file (buffer-file-name)))
 584   (if (string= "" rev)
 585       (setq rev cvs:current-revision))
 586   (let ((dir default-directory)
 587         (str (cvs:get-change-log file rev)))
 588     (switch-to-buffer-other-window (get-buffer-create "*CVS Description*"))
 589     (setq cvs:temp-filename file)
 590     (setq cvs:temp-revision rev)
 591     (setq default-directory dir)
 592     (erase-buffer)
 593     (insert str)
 594     (insert "CVS: ----------------------------------------------------------------------\n")
 595     (insert "CVS: Enter Log.  Lines beginning with `CVS: ' are removed automatically\n")
 596     (insert "CVS: changing log message of " file " for revision " rev "\n")
 597     (insert "CVS: ----------------------------------------------------------------------\n")
 598     (local-set-key "\C-c\C-c" 'cvs:do-change-log)
 599     (goto-char 0)
 600     (message "Type C-c C-c when done.")
 601     ))
 602
 603 (defun cvs:do-change-log ()
 604   "Change the description of the current file into the CVS system"
 605   (interactive)
 606   (let ((msg nil)
 607         (file-name cvs:temp-filename)
 608         (rev cvs:temp-revision))
 609     (goto-char 0)
 610     (flush-lines "^CVS: .*$")
 611     (setq msg (buffer-string))
 612     (cvs-bury-buffer)
 613     (let ((command (format "%s %s admin -m%s:\"%s\" %s" cvs-command
 614                            (if cvs-root
 615                                (format "-d %s" cvs-root) "")
 616                            rev
 617                            msg
 618                            (file-name-nondirectory file-name)))
 619           (filename (file-name-nondirectory file-name))
 620           (buf (get-buffer-create "*CVS Admin output*")) )
 621       (save-excursion
 622         (set-buffer buf)
 623         (setq buffer-read-only nil)
 624         (erase-buffer))
 625       (if (not (= (call-process cvs-shell-command nil buf t cvs-shell-command-option command)
 626                   0))
 627           (progn
 628             (cvs:display-temp-buffer buf "admin")
 629             (error "Error while changing log message of %s into CVS" filename))))))
 630
 631 ;;=============================================================================
 632 (defun cvs-edit (&optional file)
 633   "Run the cvs edit or unedit command on the file.
 634 If the file is read-only, runs the edit command else runs the unedit command."
 635   (interactive)
 636   (if (not file)
 637       (setq file (buffer-file-name)))
 638   (let* ((revision cvs:current-revision)
 639          (filename (file-truename file))
 640          (default-directory (file-name-directory (expand-file-name filename)))
 641          (comm (if (file-writable-p file) "unedit" "edit"))
 642          (command-args (if cvs-root
 643                            (list "-d" cvs-root comm
 644                                  (file-name-nondirectory filename))
 645                          (list comm (file-name-nondirectory
 646                                      filename)) ))
 647         (buf (get-buffer-create " *CVS Edit output*")) )
 648     (save-excursion
 649       (set-buffer buf)
 650       (setq buffer-read-only nil)
 651       (erase-buffer))
 652     (if (= (apply 'call-process cvs-command nil buf t command-args) 0)
 653         (let ((file-buf (get-file-buffer file)))
 654           (if file-buf
 655               (save-excursion
 656                 (set-buffer file-buf)
 657                 (revert-buffer t t))))
 658       (cvs:display-temp-buffer buf "edit")
 659       (error "Error while editing %s"
 660              (file-name-nondirectory filename)))))
 661
 662 ;;=============================================================================
 663 (defun cvs-update-file (&optional file)
 664   "Update the current file from the repository"
 665   (interactive)
 666   (if (not file)
 667       (setq file (buffer-file-name)))
 668   (save-buffer)
 669   (let* ((revision (cvs:get-numeric-revision cvs:current-revision))
 670          (filename (file-truename file))
 671          (default-directory (file-name-directory (expand-file-name filename)))
 672          (command-args (if cvs-root
 673                            (list "-d" cvs-root "update"
 674                                 (file-name-nondirectory filename))
 675                          (list "update" (file-name-nondirectory
 676                                          filename))))
 677          (buf (get-buffer-create "*CVS Update output*")))
 678     (save-excursion
 679       (set-buffer buf)
 680       (setq buffer-read-only nil)
 681       (erase-buffer))
 682     (if (= (apply 'call-process cvs-command nil buf t command-args) 0)
 683         (progn
 684           (cvs:merge-or-revert buf filename revision)
 685           (if (not (string-equal file filename))
 686               (let ((file-buf (get-file-buffer file)))
 687                 (if file-buf
 688                     (save-excursion
 689                       (set-buffer file-buf)
 690                       (revert-buffer t t)))))
 691           (message (format "Updated \"%s\"" file))
 692           )
 693       (cvs:display-temp-buffer buf "update")
 694       (error "Error while updating %s"
 695              (file-name-nondirectory filename)))))
 696
 697 ;;=============================================================================
 698 (defun cvs-update-directory ()
 699   "Update the current directory from the repository"
 700   (interactive)
 701   (let ((command-args (if cvs-root
 702                           (list "-d" cvs-root "update")
 703                         (list "update")))
 704         (buf (get-buffer-create "*CVS Update output*")))
 705     (and (or (not (memq t (mapcar #'(lambda (buf) (and (buffer-file-name buf)
 706                                                        (buffer-modified-p buf)))
 707                                   (buffer-list))))
 708              (yes-or-no-p "Modified buffers exist; update anyway? "))
 709          (progn
 710            (save-excursion
 711              (set-buffer buf)
 712              (setq buffer-read-only nil)
 713              (erase-buffer))
 714            (pop-to-buffer buf)
 715            (if (= (apply 'call-process cvs-command nil buf t command-args) 0)
 716                (progn
 717                  (goto-char (point-max))
 718                  (insert "\ncvs update finished.\n")
 719                  (cvs:display-temp-buffer buf "update")
 720                  )
 721              (progn
 722                (goto-char (point-max))
 723                (insert "\ncvs update finished with errors.\n")
 724                (cvs:display-temp-buffer buf "update")
 725                (error "Error while updating %s" default-directory)))
 726            ))
 727     ))
 728
 729 ;;=============================================================================
 730 (defun cvs:merge-convert-symbolic-to-numeric (file name)
 731   (let ( (tmpbuf " *CVSrev*")
 732          (cmd-format-args (format "%s %s update -p -r%%s %%s | head > /dev/null"
 733                                   cvs-command (if cvs-root
 734                                                   (format "-d %s" cvs-root)
 735                                                 "")))
 736         )
 737     (if (string-match "^[a-z]" name)
 738         (save-excursion
 739           (setq tmpbuf (get-buffer-create tmpbuf))
 740           (message "Converting symbolic name to numeric (please wait) ...")
 741           (buffer-disable-undo tmpbuf)
 742           (erase-buffer tmpbuf)
 743           (call-process cvs-shell-command nil tmpbuf nil
 744                         cvs-shell-command-option
 745                         (format cmd-format-args name file))
 746           (set-buffer tmpbuf)
 747           (goto-char (point-min))
 748           (if (not (re-search-forward "^VERS:[ \t]*\\([.0-9][.[0-9]*\\)[ \t]*$"
 749                                       nil t))
 750               (progn
 751                 (pop-to-buffer tmpbuf)
 752                 (error (format "Unable to convert symbolic name \"%s\"!" name))
 753                 ))
 754           (setq name (buffer-substring (match-beginning 1) (match-end 1)))
 755           (kill-buffer tmpbuf)
 756           ))
 757     name
 758     ))
 759
 760 (defun cvs:merge-query-args ()
 761   (let ((case-fold-search t)
 762         from to part1 part2
 763         (filename (file-name-nondirectory buffer-file-name))
 764         )
 765     (while (and (setq to (read-from-minibuffer "Branch revision to merge? "))
 766                 (or (while (string-match "[ \t][ \t]*" to)
 767                       (replace-match "" nil nil to))
 768                     t)
 769                 (string-equal to ""))
 770       )
 771     (setq to (cvs:merge-convert-symbolic-to-numeric filename to))
 772     (if (not (string-match "^\\([.0-9][.0-9]*\\)\\.\\([0-9][0-9]*\\)$" to))
 773         (error (format "\"%s\" is not a valid revision!") to))
 774     (setq part1 (match-string 1 to)
 775           part2 (match-string 2 to))
 776     (setq part2 (1- (string-to-number part2)))
 777     (if (> part2 0)
 778         (progn
 779           (setq from (format "%s.%s" part1 part2))
 780           )
 781       (progn
 782         (if (not (string-match "^\\([.0-9][.0-9]*\\)\\.[0-9][0-9]*\\.[0-9][0-9]*$" to))
 783             (error (format "Unable to find the previous revision for revision %s!"
 784                            to)))
 785         (setq from (match-string 1 to))
 786         ))
 787     (while (and (setq from (read-from-minibuffer "Merge back to revision? " from))
 788                 (or (while (string-match "[ \t][ \t]*" from)
 789                       (replace-match "" nil nil from))
 790                     t)
 791                 (string-equal from ""))
 792       )
 793     (setq from (cvs:merge-convert-symbolic-to-numeric filename from))
 794     (if (not (string-match "^\\([.0-9][.0-9]*\\)\\.\\([0-9][0-9]*\\)$" from))
 795         (error (format "\"%s\" is not a valid revision!") from))
 796     (message (format "From %s to %s" from to))
 797     (list from to)
 798     ))
 799
 800
 801 (defun cvs-merge-branch (branch-from branch-to)
 802   "Merge a branch into the current source file."
 803   (interactive (cvs:merge-query-args))
 804   (save-buffer)
 805   (let ( status
 806          (command-args (append (if cvs-root
 807                                    (list "-d" cvs-root "update")
 808                                  (list "update"))
 809                                (list (format "-j%s" branch-from)
 810                                      (format "-j%s" branch-to))
 811                                (list (file-name-nondirectory buffer-file-name))))
 812          (filename (file-name-nondirectory buffer-file-name))
 813          (buf (get-buffer-create "*CVSmerge*"))
 814          )
 815     (message (format "Merging branch %s to %s to %s ..."
 816                      branch-from branch-to filename))
 817     (save-excursion
 818       (set-buffer buf)
 819       (setq buffer-read-only nil)
 820       (buffer-disable-undo buf)
 821       (erase-buffer buf)
 822       (display-buffer buf)
 823       (sit-for 0)
 824       )
 825     (setq status (apply 'call-process cvs-command nil buf t command-args))
 826     (message "Reverting buffer ...")
 827     (revert-buffer t t)
 828     (if (not (= status 0))
 829         (progn
 830           (cvs:display-temp-buffer buf "branch merge")
 831           (error "Error while merging branch %s to %s to %s"
 832                  branch-from branch-to filename)
 833           )
 834       (progn
 835         (message (format "Merged branch %s to %s to %s"
 836                          branch-from branch-to filename))
 837         ))
 838     ))
 839
 840
 841 ;;=============================================================================
 842 (defun cvs:merge-or-revert (buf file revision)
 843   "Revert the buffer or run `ediff-merge-files-with-ancestor' to merge the conflicts."
 844   (let ((conflict (save-excursion
 845                     (set-buffer buf)
 846                     (goto-char (point-min))
 847                     (search-forward "conflicts" nil t)))
 848         (filename (file-name-nondirectory file)))
 849     (if conflict
 850         (message "conflict detected while updating %s" filename))
 851     (if (or (not conflict)
 852             cvs-never-use-emerge
 853             (and (or (fboundp 'ediff-merge-files-with-ancestor)
 854                      (fboundp 'emerge-files-with-ancestor))
 855                  (not (y-or-n-p "Conflicts detected do you want to run emerge ? ")))
 856             )
 857         (let ((file-buf (get-file-buffer filename)))
 858           (if file-buf
 859               (save-excursion
 860                 (set-buffer file-buf)
 861                 (revert-buffer t t))))
 862       (rename-file file (concat filename ".old") t)
 863       (rename-file (concat (file-name-directory filename)
 864                            cvs-save-prefix
 865                            (file-name-nondirectory filename) "." revision)
 866                    file t)
 867       (let ((ancestor (concat filename ".~" revision "~"))
 868             (new (concat filename ".~lst~")))
 869         (cvs:checkout filename revision ancestor)
 870         (cvs:checkout filename "" new)
 871         (if (fboundp 'ediff-merge-files-with-ancestor)
 872             (progn
 873               (ediff-merge-files-with-ancestor new filename ancestor
 874                                                (list (` (lambda ()
 875                                                           (delete-file (, ancestor))
 876                                                           (delete-file (, new))))))
 877 ;;            (delete-other-windows)
 878 ;;            (write-file filename)
 879 ;;            (revert-buffer t t)
 880               )
 881           (emerge-files-with-ancestor nil new filename ancestor filename
 882                                      (list (` (lambda ()
 883                                                 (delete-file (, ancestor))
 884                                                 (delete-file (, new))))))
 885           ))
 886       )))
 887
 888 ;;=============================================================================
 889 ;; ediff cleanup
 890 ;;=============================================================================
 891 (add-hook 'ediff-cleanup-hook 'cvs:ediff-cleanup)
 892
 893 (defun cvs:buffer (buf)
 894   (save-excursion
 895     (set-buffer buf)
 896     (if cvs-minor-mode
 897         buf) ) )
 898
 899 (defun cvs:ediff-cleanup (&optional ask)
 900   "In merge jobs, kill buffers A, B, and, ancestor. Renames buffer C.
 901 The buffer C is saved under the filename registered under CVS."
 902   (cond ((and (not cvs-ediff-merge-no-cleanup)
 903               ediff-merge-job)
 904          (let ((buf (or (cvs:buffer ediff-buffer-A)
 905                         (cvs:buffer ediff-buffer-B) )) )
 906            (cond (buf
 907                   (save-excursion
 908                     (let ((filename (buffer-file-name buf)))
 909                       (kill-buffer buf)
 910                       (set-buffer ediff-buffer-C)
 911                       (write-file filename nil)
 912                       (revert-buffer t t) )
 913                   ) ))
 914            )
 915          ;; clean all the buffers
 916          (ediff-janitor ask)
 917          )) )
 918
 919 ;;=============================================================================
 920 (defun cvs-merge-backup (&optional file)
 921   (interactive)
 922   (if (not file)
 923       (setq file (buffer-file-name)))
 924   (let* ((filename (file-truename file))
 925          (files (directory-files (file-name-directory filename) nil
 926                                  (concat "\\.#" (file-name-nondirectory filename) "\\..*")))
 927          )
 928     (if (not files)
 929         (error "No backup file to merge!"))
 930     (if (> 1 (length files))
 931         (error "too much backup files (%d)" (length files)))
 932     (let ((version (save-excursion
 933                      (let ((buf (set-buffer (generate-new-buffer "*CVS work*")))
 934                            result)
 935                        (insert (car files))
 936                        (goto-char 1)
 937                        (re-search-forward (concat "\\.#" (file-name-nondirectory filename) "\\.\\(.*\\)$"))
 938                        (setq result (buffer-substring (match-beginning 1) (match-end 1)))
 939                        (kill-buffer buf)
 940                        result))))
 941       (if (or (fboundp 'ediff-merge-files-with-ancestor)
 942               (fboundp 'emerge-files-with-ancestor))
 943             (let ((ancestor (concat filename ".~" version "~"))
 944                   (new (concat filename ".~lst~")))
 945               (cvs:checkout filename version ancestor)
 946               (cvs:checkout filename "" new)
 947               (if (fboundp 'ediff-merge-files-with-ancestor)
 948                   (progn
 949                     (ediff-merge-files-with-ancestor new (car files) ancestor
 950                                                      (list (` (lambda ()
 951                                                                 (delete-file (, ancestor))
 952                                                                 (delete-file (, new))))))
 953                     ;;        (delete-other-windows)
 954                     ;;        (write-file filename)
 955                     ;;        (revert-buffer t t)
 956                     )
 957                 (emerge-files-with-ancestor nil new (car files) ancestor filename
 958                                             (list (` (lambda ()
 959                                                        (delete-file (, ancestor))
 960                                                        (delete-file (, new))))))
 961                 ))
 962             )))
 963     )
 964
 965 ;;=============================================================================
 966 (defun cvs:repository(&optional filename)
 967   "Retrieve repository name of current CVS file"
 968   (let ((result nil)
 969         (filename (file-truename (or filename buffer-file-name))))
 970     (if filename
 971         (let ((repository-filename (concat (file-name-directory
 972                                             filename)
 973                                            "CVS/Repository")))
 974           (save-excursion
 975             (if (file-exists-p repository-filename)
 976                 (progn
 977                   (set-buffer (cvs:find-file-noselect repository-filename))
 978                   (goto-char 1)
 979                   (end-of-line)
 980                   (setq result (buffer-substring 1 (point)))
 981                   )))))
 982     result))
 983
 984
 985 ;;=============================================================================
 986 (defun cvs-log (&optional file)
 987   "Show the CVS log for the current buffer's file."
 988   (interactive)
 989   (if (not file)
 990       (setq file (buffer-file-name)))
 991   (cvs:call-command cvs-command "*CVS Log*" "log"
 992                     (list "log" (file-name-nondirectory file))))
 993
 994 ;;=============================================================================
 995 (defun cvs-file-status (&optional file)
 996   "Show the CVS status information for the current buffer's file."
 997   (interactive)
 998   (if (not file)
 999       (setq file (buffer-file-name)))
1000   (cvs:call-command cvs-command "*CVS Status*" "status"
1001                     (list "status" (file-name-nondirectory file)
1002                           )))
1003
1004 ;;=============================================================================
1005 (defun cvs-history (&optional file)
1006   "Show the CVS history information for the current buffer's file."
1007   (interactive)
1008   (if (not file)
1009       (setq file (buffer-file-name)))
1010   (cvs:call-command cvs-command "*CVS History*" "history"
1011                     (list "history" (file-name-nondirectory file)
1012                           )))
1013
1014 ;;=============================================================================
1015 (defun cvs-annotate (&optional file)
1016   "Show the CVS annotate information for the current buffer's file."
1017   (interactive)
1018   (if (not file)
1019       (setq file (buffer-file-name)))
1020   (let ((buf (cvs:call-command cvs-command "*CVS annotate*" "annotate"
1021                                (list "annotate" (file-name-nondirectory
1022                                                  file ) ) ))
1023         (mode major-mode))
1024     (if (and buf mode)
1025         (save-excursion
1026           (set-buffer buf)
1027           (setq major-mode mode)
1028           ))))
1029
1030 ;;=============================================================================
1031 (defun cvs-editors (&optional file)
1032   "Show the CVS editors information for the current buffer's file."
1033   (interactive)
1034   (if (not file)
1035       (setq file (buffer-file-name)))
1036   (cvs:call-command cvs-command "*CVS Editors*" "editors"
1037                     (list "editors" (file-name-nondirectory file)
1038                           )))
1039
1040 ;;=============================================================================
1041 (defun cvs-watchers (&optional file)
1042   "Show the CVS watchers information for the current buffer's file."
1043   (interactive)
1044   (if (not file)
1045       (setq file (buffer-file-name)))
1046   (cvs:call-command cvs-command "*CVS Watchers*" "watchers"
1047                     (list "watchers" (file-name-nondirectory file)
1048                           )))
1049
1050 ;;=============================================================================
1051 (defun cvs-who (start end &optional file)
1052   "Who was responsible for the CVS-controlled code in the region?"
1053   (interactive "r")
1054   (if (not file)
1055       (setq file (buffer-file-name)))
1056   (save-restriction
1057     (widen)
1058     (setq start (count-lines 1 start)
1059           end   (count-lines 1 end))
1060     (let ((fil  (file-name-nondirectory
1061                  (file-name-nondirectory file)))
1062           (all  (count-lines 1 (point-max))))
1063       (cvs:call-command cvsann-command "*CVS Who*" "who" (list fil))
1064       (set-buffer "*CVS Who*")
1065       (let ((buffer-read-only nil))
1066         (erase-buffer)
1067         (cvs:call-command cvsann-command "*CVS Who*" "who" (list fil))
1068         (setq buffer-read-only nil)
1069         (if (< (count-lines 1 (point-max)) all)
1070             nil
1071           (goto-char 1)
1072           (forward-line end)
1073           (delete-region (point) (point-max))
1074           (goto-char 1)
1075           (forward-line start)
1076           (delete-region 1 (point)))))))
1077
1078 ;;=============================================================================
1079 (defun cvs-diff (rev &optional file)
1080   "Run cvs diff with version REV of the current buffer."
1081   (interactive "sVersion to visit (default is latest version): ")
1082   (if (not file)
1083       (setq file (buffer-file-name)))
1084   (if (string= "" rev)
1085       (setq rev "HEAD"))
1086   (cvs:call-command cvs-command "*CVS Diff*" "diff"
1087                     (append (list "diff")
1088                             cvs-diff-options
1089                             (list "-r" rev (file-name-nondirectory
1090                                             file)))))
1091
1092 ;;=============================================================================
1093 (defun cvs-revert (rev &optional file)
1094   "Revert current file from a version from repository"
1095 ;  (interactive "sVersion to revert from (default is latest version): ")
1096   (interactive (list (read-from-minibuffer
1097                       "Version to revert from: "
1098                       (cvs:get-tag-revision cvs:current-revision))
1099                      nil))
1100   (if (not file)
1101       (setq file (buffer-file-name)))
1102   (save-buffer)
1103   (if (yes-or-no-p (concat "All your changes on " (file-name-nondirectory
1104                                                    file)
1105                            " will be lost! Do you want to continue ? "))
1106       (progn
1107         (rename-file file (concat file ".old") t)
1108         (let (;(revision cvs:current-revision)
1109               (filename file)
1110               (command-args (append (if cvs-root
1111                                         (list "-d" cvs-root "update")
1112                                       (list "update"))
1113                                     (cond
1114                                      ( (or (string= rev "") (string= rev "-A"))
1115                                        '("-A"))
1116                                      (t
1117                                       (list "-r" rev)))
1118                                     (list (file-name-nondirectory file))))
1119               (buf (get-buffer-create "*CVS Revert output*")))
1120           (message "Reverting buffer ...")
1121           (save-excursion
1122             (set-buffer buf)
1123             (setq buffer-read-only nil)
1124             (erase-buffer))
1125           (let ((result (apply 'call-process cvs-command nil buf t command-args)))
1126             (revert-buffer t t)
1127             (cond ((not (= result 0))
1128                    (cvs:display-temp-buffer buf "revert")
1129                    (error "Error while reverting %s"
1130                           (file-name-nondirectory file)))
1131                   (t
1132                    (message (format "Reverted \"%s\"" file)))
1133                   )
1134             )))))
1135
1136 ;;=============================================================================
1137 (defun cvs-mark (&optional file)
1138   "(Un)Mark the current file to be committed in the commit command (toggle)."
1139   (interactive)
1140   (if (not file)
1141       (setq file (buffer-file-name)))
1142   (if (not (member file cvs:marked-list))
1143       (progn
1144         (setq cvs:marked-list (cons file cvs:marked-list))
1145         (setq cvs:mark t))
1146     (setq cvs:marked-list (delete file cvs:marked-list))
1147     (setq cvs:mark nil))
1148   (run-hooks 'cvs-mark-hooks)
1149   (force-mode-line-update))
1150
1151 ;;=============================================================================
1152 (defun cvs-flush-file (file)
1153   "Flush a single file."
1154   (if (get-file-buffer file)
1155       (save-excursion
1156         (set-buffer (get-file-buffer file))
1157         (setq cvs:mark nil)))
1158   )
1159
1160 (defun cvs-flush ()
1161   "Flush the list of files to be committed."
1162   (interactive)
1163   (mapcar 'cvs-flush-file cvs:commit-list)
1164   (mapcar 'cvs-flush-file cvs:marked-list)
1165   (setq cvs:marked-list nil)
1166   (setq cvs:commit-list nil)
1167   (message "Flushed file list")
1168   (force-mode-line-update t))
1169
1170 ;;=============================================================================
1171 (defun cvs-commit (&optional l)
1172   "Setup a buffer to enter comment associated with the commit process."
1173   (interactive)
1174   (if (not l)
1175       (setq l cvs:marked-list))
1176   (setq cvs:commit-list (if (null l)
1177                             (list buffer-file-name)
1178                           l))
1179   (let ((dir default-directory))
1180     (switch-to-buffer-other-window (get-buffer-create "*CVS Commit*"))
1181     (setq default-directory dir)
1182     (erase-buffer)
1183     (insert "\n")
1184     (insert "CVS: ----------------------------------------------------------------------\n")
1185     (insert "CVS: Enter Log.  Lines beginning with `CVS: ' are removed automatically\n")
1186     (insert "CVS: committing files:\n")
1187     (mapcar (function (lambda(c)
1188                         (insert "CVS: " c "\n")))
1189                 cvs:commit-list)
1190     (insert "CVS: \n")
1191     (insert "CVS: Type C-c C-c when done or C-c C-d to abort.\n")
1192     (insert "CVS: ----------------------------------------------------------------------\n")
1193
1194     (use-local-map cvs:commit-map)
1195     (goto-char 0)
1196     (run-hooks 'cvs-commit-hooks)
1197     (message "Type C-c C-c when done or C-c C-d to abort.")
1198     ))
1199
1200 ;;=============================================================================
1201 (defun cvs-do-commit ()
1202   "Commit the list of files cvs:marked-list"
1203   (interactive)
1204   (cvs:save)
1205   (goto-char 0)
1206   (flush-lines "^CVS: .*$")
1207   (run-hooks 'cvs-before-commit-hooks)
1208   (let* ((filename (make-temp-name (concat (or (and cvs-temp-dir
1209                                                     (file-name-as-directory cvs-temp-dir))
1210                                                "/tmp/")
1211                                            "cvs")))
1212          (command-list (if cvs-root
1213                            (list "-d" cvs-root "commit" cvs-file-option filename)
1214                          (list "commit" cvs-file-option filename))))
1215     (write-region (point-min) (point-max) filename)
1216     (cvs-bury-buffer)
1217     (let ((buf (set-buffer (get-buffer-create "*CVS Commit output*"))))
1218       (setq buffer-read-only nil)
1219       (goto-char (point-max))
1220       (mapcar
1221        (lambda(elt)
1222          (setq default-directory (car elt))
1223          (message "Committing in %s..." (car elt))
1224          (if (/= (apply 'call-process cvs-command nil t t
1225                         (append command-list (cdr elt)))
1226                  0)
1227              (progn
1228                (cvs:display-temp-buffer buf "commit")
1229                (error "Error while committing %S in %s" (cdr elt) (car elt))
1230                ))
1231          (message "Committing in %s...done" (car elt)) )
1232        (cvs:files-to-alist cvs:commit-list))
1233       (insert "------------------------------------------------------------------------------\n")
1234       (cvs:display-temp-buffer buf "commit")
1235       (delete-file filename)
1236       (save-excursion
1237         (mapcar
1238          (lambda(name)
1239            (let ((buf (get-file-buffer name)))
1240              (if buf
1241                  (progn
1242                    (set-buffer buf)
1243                    (revert-buffer t t)))))
1244          cvs:commit-list))))
1245   (cvs-flush))
1246
1247 ;;=============================================================================
1248 (defun cvs:files-to-alist(l)
1249   "Sort a list of files to an alist containing the directory as the key and
1250 the list of file names without directory as the value"
1251   (let ((alist nil)
1252         (elt nil)
1253         (file nil))
1254     (while l
1255       (setq file (file-truename (car l)))
1256       (setq elt (assoc (file-name-directory file) alist))
1257       (if elt
1258           (setcdr elt
1259                    (nconc (cdr elt) (list (file-name-nondirectory file))))
1260         (setq alist (cons
1261                      (cons (file-name-directory file)
1262                            (list (file-name-nondirectory file)))
1263                      alist)))
1264       (setq l (cdr l)))
1265     alist))
1266
1267 ;;=============================================================================
1268 (defun cvs-list (&optional dir)
1269   "List the files to commit cvs:marked-list in a buffer"
1270   (interactive)
1271   (if (null dir)
1272       (setq dir default-directory))
1273   (set-buffer (get-buffer-create "*CVS List of marked files to commit*"))
1274   (setq buffer-read-only nil)
1275   (setq default-directory dir)
1276   (erase-buffer)
1277   (goto-char (point-min))
1278   (insert "Marked file(s):\n\n")
1279   (if cvs:marked-list
1280       (mapcar (function (lambda(c)
1281                           (insert "  ")(insert c)(insert "\n")))
1282               cvs:marked-list)
1283     (insert "  ***** No marked files *****\n"))
1284   (set-buffer-modified-p nil)
1285   (cvs:display-temp-buffer (current-buffer) "list"))
1286
1287 ;;=============================================================================
1288 ;; extract from files.el and modified not to ask question to the user if the
1289 ;; file needs to be reloaded.
1290 ;;=============================================================================
1291 (defun cvs:find-file-noselect (filename)
1292   "Read file FILENAME into a buffer and return the buffer.
1293 If a buffer exists visiting FILENAME, return that one, but
1294 verify that the file has not changed since visited or saved.
1295 The buffer is not selected, just returned to the caller."
1296   (setq filename
1297         (abbreviate-file-name
1298          (expand-file-name filename)))
1299   (if (file-directory-p filename)
1300       (error "%s is a directory." filename)
1301     (let* ((buf (get-file-buffer filename))
1302            (truename (abbreviate-file-name (file-truename filename)))
1303            (number (nthcdr 10 (file-attributes truename)))
1304            ;; Find any buffer for a file which has same truename.
1305            (other (and (not buf) (get-file-buffer filename)))
1306            error)
1307       ;; Let user know if there is a buffer with the same truename.
1308       (if other
1309           (progn
1310             ;; Optionally also find that buffer.
1311             (if (or find-file-existing-other-name find-file-visit-truename)
1312                 (setq buf other))))
1313       (if buf
1314           (or (verify-visited-file-modtime buf)
1315               (cond ((not (file-exists-p filename))
1316                      (error "File %s no longer exists!" filename))
1317                     (t
1318                      (file-name-nondirectory filename)
1319                      (save-excursion
1320                        (set-buffer buf)
1321                        (revert-buffer t t)))))
1322         (save-excursion
1323           (setq buf (create-file-buffer filename))
1324           (set-buffer buf)
1325           (erase-buffer)
1326           (condition-case ()
1327               (insert-file-contents filename t)
1328             (file-error
1329              (setq error t)
1330              ;; Run find-file-not-found-hooks until one returns non-nil.
1331              (let ((hooks find-file-not-found-hooks))
1332                (while (and hooks
1333                            (not (and (funcall (car hooks))
1334                                      ;; If a hook succeeded, clear error.
1335                                      (progn (setq error nil)
1336                                             ;; Also exit the loop.
1337                                             t))))
1338                  (setq hooks (cdr hooks))))))
1339           ;; Find the file's truename, and maybe use that as visited name.
1340           (setq buffer-file-truename truename)
1341           (setq buffer-file-number number)
1342           ;; On VMS, we may want to remember which directory in a search list
1343           ;; the file was found in.
1344           (and (eq system-type 'vax-vms)
1345                (let (logical)
1346                  (if (string-match ":" (file-name-directory filename))
1347                      (setq logical (substring (file-name-directory filename)
1348                                               0 (match-beginning 0))))
1349                  (not (member logical find-file-not-true-dirname-list)))
1350                (setq buffer-file-name buffer-file-truename))
1351           (if find-file-visit-truename
1352               (setq buffer-file-name
1353                     (setq filename
1354                           (expand-file-name buffer-file-truename))))
1355           ;; Set buffer's default directory to that of the file.
1356           (setq default-directory (file-name-directory filename))
1357           ;; Turn off backup files for certain file names.  Since
1358           ;; this is a permanent local, the major mode won't eliminate it.
1359           (and (not (funcall backup-enable-predicate buffer-file-name))
1360                (progn
1361                  (make-local-variable 'backup-inhibited)
1362                  (setq backup-inhibited t)))
1363           (after-find-file error t)))
1364       buf)))
1365
1366 ;;=============================================================================
1367 ;; NB duplicated from misc-fns.el
1368 ;;=============================================================================
1369 (defun cvs:call-command (program bufname name &optional args)
1370   "Call PROGRAM synchronously in a separate process.
1371 Input comes from /dev/null.
1372 Output goes to a buffer named BUFNAME, which is created or emptied first, and
1373 displayed afterward (if non-empty).
1374 Optional third arg is a list of arguments to pass to PROGRAM."
1375   (let ((dir default-directory))
1376     (set-buffer (get-buffer-create bufname))
1377     (setq default-directory dir)
1378     (setq buffer-read-only nil)
1379     (erase-buffer)
1380     (apply 'call-process program nil t nil
1381            (if cvs-root
1382                (append (list "-d" cvs-root) args)
1383              args))
1384     (goto-char 0)
1385     (run-hooks (intern (concat "cvs-" name "-hooks")))
1386     (cvs:display-temp-buffer (current-buffer) name)))
1387
1388 (defun cvs:display-temp-buffer (buf name)
1389   "Display buffer setting it read only, unmodified and binding key q to bury-buffer."
1390   (save-excursion
1391     (set-buffer buf)
1392     (cvs-info-mode name)
1393     (set-buffer-modified-p nil)
1394     (setq buffer-read-only t))
1395   (pop-to-buffer buf)
1396   buf)
1397
1398 (defun cvs-bury-buffer (&optional buf)
1399   "Bury a buffer even if it is in a dedicated window"
1400   (interactive)
1401   (if (null buf)
1402       (setq buf (current-buffer)))
1403   (let ((win (get-buffer-window buf)))
1404     (if (window-dedicated-p win)
1405         (progn
1406           (delete-windows-on buf t)
1407           (bury-buffer buf))
1408       (bury-buffer)
1409       (other-window -1))))
1410
1411 ;;=============================================================================
1412 ;; major mode stuff to display CVS info buffers
1413 ;;=============================================================================
1414 (defvar cvs-info-mode-hooks nil
1415   "Hooks run when entering `cvs-info-mode'.")
1416
1417 (defvar cvs-info-mode-map nil
1418   "key map used by `cvs-info-mode'.")
1419
1420 (if cvs-info-mode-map
1421     ()
1422   (require 'dired)
1423
1424    ;; Inherit from dired map
1425   (if (not (fboundp 'set-keymap-parents))
1426       ;; FSF way
1427       (setq cvs-info-mode-map (cons 'keymap dired-mode-map))
1428     ;; XEmacs way
1429     (setq cvs-info-mode-map (make-sparse-keymap))
1430     (set-keymap-parents cvs-info-mode-map dired-mode-map))
1431
1432   (define-key cvs-info-mode-map "U" 'cvs-status-update)
1433   (define-key cvs-info-mode-map "C" 'cvs-status-mark-and-commit)
1434   (define-key cvs-info-mode-map "g" 'cvs-status-process)
1435   (define-key cvs-info-mode-map "\C-k" 'cvs-status-delete-file)
1436   (define-key cvs-info-mode-map "q" 'cvs-bury-buffer)
1437   (define-key cvs-info-mode-map " " 'scroll-up)
1438   (define-key cvs-info-mode-map "\177" 'scroll-down)
1439 )
1440
1441 (defun cvs-info-mode (name)
1442   "Major mode to display CVS information buffers.
1443 Special commands:
1444 \\{cvs-info-mode-map}
1445
1446 Turning on `cvs-info-mode' runs the hooks `cvs-info-mode-hooks'."
1447   (interactive "s")
1448   (use-local-map cvs-info-mode-map)
1449   (setq cvs-dired-mode t)
1450   (setq mode-name (concat "CVS " name))
1451   (setq major-mode 'cvs-info-mode)
1452   (run-hooks 'cvs-info-mode-hooks)
1453 )
1454
1455 ;;=============================================================================
1456 (defvar cvs:status-buffer "*CVS-Statuslist*"
1457   "Name of the CVS module status buffer")
1458
1459 (defvar cvs:status-file-keymap
1460   (let ((m (make-sparse-keymap)))
1461     (if (fboundp 'set-keymap-name)
1462         (set-keymap-name m 'cvs:status-file-keymap))
1463     (if (string-match "XEmacs" emacs-version)
1464         (progn
1465           (define-key m 'button2 'dired-mouse-find-file)
1466           (define-key m [return] 'dired-find-file)
1467           ))
1468     m)
1469   "The keymap used for the highlighted messages in the status buffer.")
1470
1471 (defun cvs-status-get-filename ()
1472   (let ( (buf (current-buffer))
1473          (statbuf (get-buffer cvs:status-buffer)) )
1474     (if (not (eq buf statbuf))
1475         (error "The current buffer is not the Module Status buffer!"))
1476     (cvs:get-filename)
1477     ))
1478
1479 (defun cvs-status-update ()
1480   "Update all files that are marked as needing update."
1481   (interactive)
1482   (let (filename (statbuf (get-buffer cvs:status-buffer)) (filecount 0))
1483     (message "Updating files ...")
1484     (save-excursion
1485       (if (not statbuf)
1486           (error "The CVS Module Status buffer does not exist!"))
1487       (set-buffer statbuf)
1488       (goto-char (point-min))
1489       (while (re-search-forward "^ *[*] *Needs \\(Update\\|Patch\\)" (point-max) t)
1490         (setq filename (expand-file-name (cvs-status-get-filename)))
1491         (find-file-noselect filename)
1492         (cvs-update-file filename)
1493         (setq filecount (1+ filecount))
1494         )
1495       (message (format "Updated %d files" filecount))
1496       )
1497     ))
1498
1499 (defun cvs-status-mark-changed (&optional no-display)
1500   "Mark all Locally changed files in the Module Status buffer"
1501   (interactive)
1502   (let (filename (statbuf (get-buffer cvs:status-buffer)) (filecount 0)
1503                  (oldcount (length cvs:marked-list)))
1504     (save-excursion
1505       (if (not statbuf)
1506           (error "The CVS Module Status buffer does not exist!"))
1507       (set-buffer statbuf)
1508       (goto-char (point-min))
1509       (while (re-search-forward "^ *[*] *Locally " (point-max) t)
1510         (setq filename (expand-file-name (cvs:get-filename)))
1511         (if (not (member filename cvs:marked-list))
1512             (save-excursion
1513               (let ( (buf (get-file-buffer filename)) )
1514                 (if buf
1515                     (set-buffer buf))
1516                 (cvs-mark filename)
1517                 (setq filecount (1+ filecount))
1518                 )))
1519         )
1520       (if (not no-display)
1521           (cvs-list))
1522       (message (format "Marked %d new files, %d files already marked"
1523                        filecount oldcount))
1524       )
1525     ))
1526
1527 (defun cvs-status-mark-and-commit ()
1528   "Mark and commit all Locally changed files in the Module Status buffer"
1529   (interactive)
1530   (cvs-status-mark-changed t)
1531   (cvs-dired-commit))
1532
1533 (defun cvs-status-delete-file ()
1534   "Delete a file from the Module Status buffer.
1535 The file is only deleted from the buffer, and not from the disk.
1536 This command can only be executed from the Module Status buffer."
1537   (interactive)
1538   (let ( (buf (current-buffer))
1539          (statbuf (get-buffer cvs:status-buffer))
1540          case-fold-search buffer-read-only)
1541     (if (not (eq buf statbuf))
1542         (error "The current buffer is not the Module Status buffer!"))
1543     (save-excursion
1544       (beginning-of-line)
1545       (if (looking-at " *[*] *[A-Z]")
1546           (progn
1547             (delete-region (point)
1548                            (save-excursion
1549                              (forward-line 1)
1550                              (point)
1551                              ))
1552             (set-buffer-modified-p nil)
1553             )
1554         (error "No file on this line")
1555         )
1556       )
1557     ))
1558
1559 (defun cvs:status-filter (proc string)
1560   "Filter for the cvs update process"
1561   (save-excursion
1562     (set-buffer (process-buffer proc))
1563     (let ((buffer-read-only nil)
1564           (buf (get-buffer cvs:status-buffer))
1565           (start (process-mark proc))
1566           )
1567       (goto-char (point-max))
1568       (insert string)
1569       (goto-char start)
1570       (while (re-search-forward "^\\([A-Z?]\\) \\(.*\\)" (point-max) t)
1571         (let* ((status (elt (buffer-substring (match-beginning 1) (match-end 1)) 0))
1572                (filename (buffer-substring (match-beginning 2) (match-end 2)))
1573                (status-name (cond
1574                              ((eq status ?U) "Needs Update")
1575                              ((eq status ?P) "Needs Patch")
1576                              ((eq status ?A) "Locally Added")
1577                              ((eq status ?R) "Locally Removed")
1578                              ((eq status ?M) "Locally Modified")
1579                              ((eq status ?C) "Conflict")
1580                              ((eq status ??) "Unknown")
1581                              (t (concat "Invalid " status)) )) )
1582           (save-excursion
1583             (set-buffer buf)
1584             (goto-char (point-max))
1585             (let ( (buffer-read-only nil)
1586                    begin end extent)
1587               (if (fboundp 'make-extent)
1588                   (progn
1589                     (insert (format "  * %-17s : " status-name))
1590                     (setq begin (point))
1591                     (insert filename)
1592                     (setq end (point))
1593                     (insert "\n")
1594                     (setq extent (make-extent begin end))
1595                     (set-extent-face extent 'bold)
1596                     (set-extent-property extent 'highlight t)
1597                     (set-extent-property extent 'keymap cvs:status-file-keymap)
1598                     )
1599                 (insert (format "  * %-17s : %s\n" status-name filename)))
1600               ))))
1601       (set-marker (process-mark proc) (point))
1602       )))
1603
1604 (defun cvs:status-sentinel (process event)
1605   "Sentinel for the cvs status process"
1606   (save-excursion
1607     (let ( (buf (get-buffer cvs:status-buffer))
1608            (oldbuf (current-buffer))
1609            )
1610       (set-buffer buf)
1611       (goto-char (point-max))
1612       (let (buffer-read-only)
1613         (insert "=================================================================\n")
1614         (insert "    (Status complete)\n\n")
1615         (insert
1616          (substitute-command-keys
1617           "Use:
1618
1619     \\[cvs-status-delete-file]          To delete files from the above list.
1620     \\[cvs-status-mark-changed] To mark all locally-modified, added or deleted files.
1621
1622     \\[cvs-dired-commit]        To commit all marked files.
1623
1624     \\[cvs-status-update]               To update all files marked as needing update.
1625     \\[cvs-status-mark-and-commit]              To mark and commit all files marked as
1626                 locally-modified, added or deleted.
1627
1628     \\[cvs-dired-update-file]   To update the single file under the cursor.
1629     \\[cvs-dired-commit-file]   To commit the single file under the cursor.
1630 "))
1631         )
1632       (cvs:display-temp-buffer buf "Statuslist")
1633       (buffer-enable-undo buf)
1634       (kill-buffer (process-buffer process))
1635       (pop-to-buffer oldbuf)
1636       )))
1637
1638 (defun cvs-status-process (&optional files)
1639   "Display the status of the current module files"
1640   (interactive)
1641   (let* ((args (cons "-d" (if cvs-root
1642                               (append (list "-d" cvs-root) files) files)))
1643          (proc-buffer (get-buffer-create " *CVS-Temp*"))
1644          proc
1645          (dir default-directory)
1646          (buf (get-buffer-create cvs:status-buffer)))
1647     (buffer-disable-undo proc-buffer)
1648     (save-excursion
1649       (set-buffer proc-buffer)
1650       (erase-buffer))
1651     (setq proc (eval (append
1652                       (list 'start-process "cvs status" proc-buffer
1653                             cvs-command "-n" "update")
1654                       args)))
1655     (set-process-filter proc 'cvs:status-filter)
1656     (set-process-sentinel proc 'cvs:status-sentinel)
1657     (set-marker (process-mark proc)
1658                 (save-excursion (set-buffer proc-buffer)
1659                                 (point-min))
1660                 proc-buffer)
1661     (save-excursion
1662       (pop-to-buffer buf)
1663       (setq default-directory dir)      ; to make dired happy
1664       (setq dired-subdir-alist (list (list dir (point-min))))
1665       (cvs:display-temp-buffer buf "Statuslist")
1666       (let ((buffer-read-only nil))
1667         (erase-buffer)
1668         (insert (format "%s\n" "Status of files, relative to the directory:"))
1669         (insert (format "\t%s\n" dir))
1670         (insert "=================================================================\n")
1671         )
1672       )
1673     ))
1674
1675 (defun cvs:current-line ()
1676   "Return the current line as an integer."
1677   (+ (count-lines (point-min) (point))
1678      (if (eq (current-column) 0)
1679          1
1680        0)))
1681
1682 (defun cvs:get-filename ()
1683   (let ((lineno (cvs:current-line)))
1684     (and (not (eq lineno 1))
1685          (not (eq lineno 2))
1686          (save-excursion
1687            (beginning-of-line)
1688            (and (re-search-forward "^.+ : \\(.*\\)"
1689                                    (save-excursion (end-of-line) (point))
1690                                    t)
1691                 (buffer-substring (match-beginning 1) (match-end 1)) ) ) )
1692     ) )
1693
1694 (require 'advice)
1695 (defadvice dired-get-filename (around check-mode activate)
1696   "Use an alternative function in cvs info mode"
1697   (cond ((eq major-mode 'cvs-info-mode)
1698           (setq ad-return-value (cvs:get-filename)))
1699          (t
1700           ad-do-it)))
1701
1702 (defun cvs-marked-status (&optional l)
1703   "Show the status of marked files"
1704   (interactive)
1705   (if (not l)
1706       (setq l cvs:marked-list))
1707   (cvs-status-process l))
1708
1709 ;;=============================================================================
1710 ;; explicitly committing current buffer
1711 ;;=============================================================================
1712 (defun cvs-commit-file ()
1713   "Explicitly commit current buffer.
1714 Even when there is a nonempty list of marked files.
1715 This function uses `cvs-commit'."
1716   (interactive)
1717   (let ((cvs:marked-list nil))
1718     (cvs-commit)))
1719
1720 ;;=============================================================================
1721 (defun cvs:save ()
1722   "Save the buffers modified in cvs:commit-list"
1723   (let ((files cvs:commit-list))
1724     (while files
1725       (let ((buf (get-file-buffer (car files))))
1726         (if (and buf
1727                  (buffer-modified-p buf)
1728                  (y-or-n-p (concat "Save file " (car files) "? ")))
1729             (save-excursion
1730               (set-buffer buf)
1731               (save-buffer)
1732               ))
1733         (setq files (cdr files))))))
1734
1735 ;;=============================================================================
1736 (defun cvs-submit-report ()
1737   "Report a problem, a suggestion or a comment about cvs.el"
1738   (interactive)
1739   (require 'reporter)
1740   (reporter-submit-bug-report
1741    cvs:maintainer-address
1742    (concat "cvs.el " cvs:version)
1743    '(cvs-temp-dir
1744      cvs-command
1745      cvs-root
1746      cvs-minor-mode-hooks
1747      cvs-load-hooks
1748      cvs-commit-hooks
1749      cvs-before-commit-hooks
1750      cvs-add-hooks
1751      cvs-shell-command
1752      cvs-shell-command-option
1753      cvs-file-option
1754      cvs-no-log-option
1755      cvs-never-use-emerge
1756      cvs-save-prefix)
1757    nil
1758    (function (lambda()
1759                (insert (concat "\nCVSROOT=" (getenv "CVSROOT") "\n"))
1760                (call-process "cvs" nil t nil "-v")))
1761    "Dear cvs.el maintainer,"
1762    ))
1763
1764 ;;=============================================================================
1765 (defun cvs:hook ()
1766   "`Find-file' and `revert-buffer' hooks for CVS detection.
1767 If detected, `cvs:hook' positions the ediff variable
1768 `ediff-version-control' to process diff between CVS revisions."
1769   (if (is-under-cvs)
1770       (progn
1771         (if (not (boundp 'ediff-version-control-package))
1772             (setq ediff-version-control-package 'vc))
1773         (make-local-variable 'ediff-version-control-package)
1774         (setq ediff-version-control-package 'cvs))))
1775
1776 (add-hook 'find-file-hooks (function cvs:hook))
1777 (add-hook 'after-revert-hook (function cvs:hook))
1778
1779 ;;=============================================================================
1780 ;; msb support
1781 ;;=============================================================================
1782 (defun cvs:add-msb-submenu ()
1783   "Add msb entries to list CVS and CVS marked buffers"
1784   (setq msb-menu-cond (append (list '((and (boundp 'cvs-minor-mode)
1785                                            cvs-minor-mode
1786                                            'multi)
1787                                       1015
1788                                       "CVS (%d)")
1789                                     '((and (boundp 'cvs-minor-mode)
1790                                            cvs-minor-mode
1791                                            cvs:mark
1792                                            'multi)
1793                                       1016
1794                                       "CVS marked files (%d)"))
1795                               msb-menu-cond))
1796   (add-hook 'cvs-mark-hooks (function (lambda()
1797                                         (menu-bar-update-buffers t)))))
1798
1799 (or (and (featurep 'msb)
1800          (cvs:add-msb-submenu))
1801     (add-hook 'msb-after-load-hooks
1802               (function cvs:add-msb-submenu)))
1803
1804 ;;=============================================================================
1805 ;; dired support
1806 ;;=============================================================================
1807 (defun cvs:dired-hook ()
1808   "`dired-mode-hook' to add support for cvs in dired buffers"
1809   (let ((dir (concat (expand-file-name dired-directory) "CVS")))
1810     (if (and (not (string-match cvs:remote-regexp dir))
1811              (file-directory-p dir))
1812         (cvs-dired-mode)))
1813   )
1814
1815 (add-hook 'dired-mode-hook (function cvs:dired-hook))
1816
1817 (defvar cvs-dired-mode nil
1818   "Status variable to switch to CVS minor mode if sets to t")
1819 (make-variable-buffer-local 'cvs-dired-mode)
1820 (put 'cvs-dired-mode 'permanent-local t)
1821
1822 (defconst cvs-dired:entry
1823   (list 'cvs-dired-mode (cons "" '(" CVS")))
1824   "Entry to display CVS in mode line")
1825
1826 (defvar cvs-dired:map (make-sparse-keymap)
1827   "CVS dired minor mode keymap")
1828
1829 (define-key cvs-dired:map "\C-cvo" 'cvs-dired-log)
1830 (define-key cvs-dired:map "\C-cvs" 'cvs-dired-file-status)
1831 (define-key cvs-dired:map "\C-x\C-q" 'cvs-dired-edit)
1832 (define-key cvs-dired:map "\C-cve" 'cvs-dired-editors)
1833 (define-key cvs-dired:map "\C-cvw" 'cvs-dired-watchers)
1834 (define-key cvs-dired:map "\C-cvU" 'cvs-update-directory)
1835 (define-key cvs-dired:map "\C-cvS" 'cvs-status-process)
1836 (define-key cvs-dired:map "\C-cvM" 'cvs-dired-marked-status)
1837 (define-key cvs-dired:map "\C-cvA" 'cvs-dired-add)
1838 (define-key cvs-dired:map "\C-cvB" 'cvs-merge-branch)
1839 (define-key cvs-dired:map "\C-cvL" 'cvs-status-mark-changed)
1840 (define-key cvs-dired:map "\C-cvd" 'cvs-dired-ediff-internal)
1841 (define-key cvs-dired:map "\C-cv\C-d" 'cvs-dired-ediff)
1842 (define-key cvs-dired:map "\C-cvi" 'cvs-dired-diff)
1843 (define-key cvs-dired:map "\C-cvc" 'cvs-dired-commit)
1844 (define-key cvs-dired:map "\C-cvC" 'cvs-dired-commit-file)
1845 (define-key cvs-dired:map "\C-cvl" 'cvs-list)
1846 (define-key cvs-dired:map "\C-cvf" 'cvs-flush)
1847 (define-key cvs-dired:map "\C-cvu" 'cvs-dired-update-file)
1848 (define-key cvs-dired:map "\C-cvr" 'cvs-dired-revert)
1849 (define-key cvs-dired:map "\C-cvb" 'cvs-submit-report)
1850 (define-key cvs-dired:map "\C-cvh" 'cvs-dired-history)
1851 (define-key cvs-dired:map "\C-cva" 'cvs-dired-annotate)
1852 (easy-menu-define
1853  cvs-dired:menu
1854  cvs-dired:map
1855  "CVS dired minor mode keymap"
1856  '("CVS"
1857     ["Add" cvs-dired-add t]
1858     "-----------"
1859     ["Update File" cvs-dired-update-file t]
1860     ["(Un)Edit" cvs-dired-edit t]
1861     ["Commit File" cvs-dired-commit-file t]
1862     ["Log" cvs-dired-log t]
1863     ["Annotate" cvs-dired-annotate t]
1864     ["History" cvs-dired-history t]
1865     ["File Status" cvs-dired-file-status t]
1866     ["Editors" cvs-dired-editors t]
1867     ["Watchers" cvs-dired-watchers t]
1868     ["EDiff" cvs-dired-ediff-internal t]
1869     ["Diff" cvs-dired-diff t]
1870     "-----------"
1871     ["Module Status" cvs-status-process t]
1872     ["Update Module" cvs-update-directory t]
1873     "-----------"
1874     ("Marking Files"
1875      ["Show List" cvs-list t]
1876      ["Flush List" cvs-flush t]
1877      )
1878     ("Action on Marked Files"
1879      ["Commit" cvs-dired-commit t]
1880      ["Show Status" cvs-dired-marked-status t]
1881      )
1882     ("Other Commands"
1883      ["EDiff two revs" cvs-ediff t]
1884      ["Restore version" cvs-dired-revert t]
1885      ["Change description" cvs-dired-description t]
1886      ["Change log message" cvs-dired-change-log t]
1887      ["Merge backup" cvs-dired-merge-backup t]
1888      ["Merge branch" cvs-merge-branch t])
1889     "--------"
1890     ["Send mail report" cvs-submit-report t]))
1891
1892 (or (assq 'cvs-dired-mode minor-mode-alist)
1893     (setq minor-mode-alist (cons cvs-dired:entry minor-mode-alist)))
1894
1895 (or (assq 'cvs-dired-mode minor-mode-map-alist)
1896     (setq minor-mode-map-alist (cons (cons 'cvs-dired-mode cvs-dired:map)
1897                                      minor-mode-map-alist)))
1898
1899 (defun cvs-dired-mode ()
1900   "Turn on cvs-dired minor mode."
1901   (setq cvs-dired-mode t)
1902   (easy-menu-add cvs-dired:menu cvs-dired:map)
1903   )
1904
1905 (defun cvs-dired-file-status ()
1906   "Call `cvs-file-status' on current file."
1907   (interactive)
1908   (cvs-file-status (dired-get-filename)))
1909
1910 (defun cvs-dired-edit ()
1911   "Call `cvs-edit' on current file."
1912   (interactive)
1913   (let ((filename (dired-get-filename)))
1914     (cvs-edit filename)
1915     (dired-update-file-line filename) ) )
1916
1917 (defun cvs-dired-editors ()
1918   "Call `cvs-editors' on current file."
1919   (interactive)
1920   (cvs-editors (dired-get-filename)))
1921
1922 (defun cvs-dired-watchers ()
1923   "Call `cvs-watchers' on current file."
1924   (interactive)
1925   (cvs-watchers (dired-get-filename)))
1926
1927 (defun cvs-dired-commit-file ()
1928   "Call `cvs-commit-file' on current file."
1929   (interactive)
1930   (cvs-commit (list (dired-get-filename))))
1931
1932 (defun cvs-dired-log ()
1933   "Call `cvs-log' on current file."
1934   (interactive)
1935   (cvs-log (dired-get-filename)))
1936
1937 (defun cvs-dired-annotate ()
1938   "Call `cvs-annotate' on current file."
1939   (interactive)
1940   (cvs-annotate (dired-get-filename)))
1941
1942 (defun cvs-dired-history ()
1943   "Call `cvs-history' on current file."
1944   (interactive)
1945   (cvs-history (dired-get-filename)))
1946
1947 (defun cvs-dired-update-file ()
1948   "Call `cvs-update-file' on current file."
1949   (interactive)
1950   (cvs-update-file (dired-get-filename)))
1951
1952 (defun cvs-dired-diff (rev)
1953   "Call `cvs-diff' on current file."
1954   (interactive "sVersion to visit (default is latest version): ")
1955   (cvs-diff rev (dired-get-filename)))
1956
1957 (defun cvs-dired-add (msg)
1958   "Add current file to CVS."
1959   (interactive "sEnter description : ")
1960   (cvs-add msg (dired-get-filename)))
1961
1962 (defun cvs-dired-description ()
1963   "Call `cvs-description' on current file."
1964   (interactive)
1965   (cvs-description (dired-get-filename)))
1966
1967 (defun cvs-dired-change-log (rev)
1968   "Call `cvs-change-log' on current file."
1969   (interactive "sVersion (default is current version): ")
1970   (cvs-change-log rev (dired-get-filename)))
1971
1972 (defun cvs-dired-revert (rev)
1973   "Call `cvs-revert' on current file."
1974   (interactive "sVersion to revert from (default is latest version): ")
1975   (cvs-revert rev (dired-get-filename)))
1976
1977 (defun cvs-dired-merge-backup ()
1978   "Call `cvs-merge-backup' on current file."
1979   (interactive)
1980   (cvs-merge-backup (dired-get-filename)))
1981
1982 (defun cvs-dired-commit ()
1983   "Call `cvs-commit' on marked files."
1984   (interactive)
1985   (let ((l (or (let (f (dired-get-marked-files))
1986                  (if (and f (> (length f) 0)) f nil)) cvs:marked-list)))
1987     (if (not l)
1988         (error "No marked files")
1989       (cvs-commit l))))
1990
1991 ;; Of dubious use:
1992 ;;(defun cvs-dired-update-marked ()
1993 ;;  "Call `cvs-update-file' on marked files."
1994 ;;  (interactive)
1995 ;;  (let ((l (or (let (f (dired-get-marked-files))
1996 ;;               (if (and f (> (length f) 0)) f nil)) cvs:marked-list)))
1997 ;;    (if (not l)
1998 ;;      (error "No marked files")
1999 ;;      (cvs-update-file l))))
2000
2001 (defun cvs-dired-marked-status ()
2002   "Call `cvs-marked-status' on marked files."
2003   (interactive)
2004   (let ((l (or (let (f (dired-get-marked-files))
2005                  (if (and f (> (length f) 0)) f nil)) cvs:marked-list)))
2006     (if (not l)
2007         (error "No marked file")
2008       (cvs-marked-status l))))
2009
2010 (defun cvs-dired-ediff-internal ()
2011   "Edit currect file and call `cvs-ediff-internal'."
2012   (interactive)
2013   (dired-find-file)
2014   (call-interactively 'cvs-ediff-internal))
2015
2016 (defun cvs-dired-ediff ()
2017   "Edit currect file and call `cvs-ediff'."
2018   (interactive)
2019   (dired-find-file)
2020   (call-interactively 'cvs-ediff))
2021
2022 ;;=============================================================================
2023 (run-hooks 'cvs-load-hooks)
2024
2025 ;;=============================================================================
2026 (provide 'cvs)
2027
2028 ;;; end of cvs.el