1 ;; cvs.el --- Light cvs support for emacs (ediff + msb + dired + mode line)
3 ;; Copyright (C) 1995-1998 Frederic Lepied <Frederic.Lepied@sugix.frmug.org>
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
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|
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)
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
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.
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).
38 ;; 8. softlink tree support.
39 ;; 9. little module support (status and update).
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
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.
48 ;;=============================================================================
50 ;;=============================================================================
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")
57 ;;=============================================================================
58 (defconst cvs:maintainer-address "cvs-help@sugix.frmug.org"
59 "Address to send any comment, bug or report")
61 ;;=============================================================================
62 (defvar cvs:current-revision nil
63 "Stores the CVS revision number of the file")
64 (make-variable-buffer-local 'cvs:current-revision)
66 ;;=============================================================================
67 (defvar cvs-temp-dir (or (getenv "TMPDIR")
70 "* if non nil, `cvs-temp-dir' is the directory where to extract versions.")
72 ;;=============================================================================
73 (defvar cvs-command "cvs"
74 "Name of the cvs command including path if needed")
76 ;;=============================================================================
77 (defvar cvsann-command "cvsann"
78 "Name of the cvsann command including path if needed")
80 ;;=============================================================================
82 "*If non nil, `cvs-root' is the base directory of the CVS repository.")
84 ;;=============================================================================
85 (defvar cvs-minor-mode-hooks nil
86 "Hooks run when Cvs mode is initialized")
88 ;;=============================================================================
89 (defvar cvs-load-hooks nil
90 "Hooks run when cvs.el has been loaded")
92 ;;=============================================================================
93 (defvar cvs-commit-hooks nil
94 "Hooks run entering commit buffer")
96 ;;=============================================================================
97 (defvar cvs-before-commit-hooks nil
98 "Hooks run before commiting")
100 ;;=============================================================================
101 (defvar cvs-add-hooks nil
102 "Hooks run after adding a file into CVS with `cvs-add'")
104 ;;=============================================================================
105 (defvar cvs-mark-hooks nil
106 "Hooks run after marking or unmarking a file with `cvs-mark'")
108 ;;=============================================================================
109 (defvar cvs-shell-command
110 (if (memq system-type '(ms-dos emx windows-nt))
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'.")
117 ;;=============================================================================
118 (defvar cvs-shell-command-option
119 (cond ((memq system-type '(ms-dos windows-nt))
120 (if (boundp 'shell-command-switch)
123 (t ;Unix & EMX (Emacs 19 port to OS/2)
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'.")
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\".")
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\").")
139 ;;=============================================================================
140 (defvar cvs-no-log-option nil
141 "CVS option not to log the cvs_command in the command history.")
143 ;;=============================================================================
144 (defvar cvs-never-use-emerge nil
145 "* don't merge update conflicts with emerge function from ediff package if set to t.")
147 ;;=============================================================================
148 (defvar cvs-ediff-merge-no-cleanup nil
149 "*If not nil, do not rename *ediff-merge* buffer after the merge.")
151 ;;=============================================================================
152 (defvar cvs-save-prefix ".#"
153 "prefix used by cvs to save a file if there are conflicts while updating")
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)
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.")
168 ;;=============================================================================
169 ;; minor mode status variable (buffer local).
170 ;;=============================================================================
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)
176 ;;=============================================================================
177 (defvar cvs:marked-list nil
178 "List of marked files. See `cvs-mark'")
180 (defvar cvs:commit-list nil
181 "List of files uppon which to perform cvs commit")
183 ;;=============================================================================
184 ;; minor mode entry point.
185 ;;=============================================================================
186 (defun cvs-minor-mode (&optional arg)
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)))
214 (easy-menu-add cvs:menu cvs:map)
215 (run-hooks 'cvs-minor-mode-hooks)))
218 ;;=============================================================================
219 ;; register cvs minor mode keymap and mode line display.
220 ;;=============================================================================
221 (defvar cvs:map (make-sparse-keymap)
222 "CVS minor mode keymap")
224 (defvar cvs:commit-map (make-sparse-keymap)
225 "CVS commit edition buffer keymap")
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)
258 "CVS minor mode keymap"
260 ["Update File" cvs-update-file t]
261 ["Commit File" cvs-commit-file t]
262 ["(Un)Edit" cvs-edit 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]
272 ["Module Status" cvs-status-process t]
273 ["Update Module" cvs-update-directory t]
276 ["(Un)Mark current buffer" cvs-mark t]
277 ["Show List" cvs-list t]
278 ["Flush List" cvs-flush t]
280 ("Action on Marked Files"
281 ["Commit" cvs-commit t]
282 ["Show Status" cvs-marked-status t]
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]
294 ["Send bug/comment report" cvs-submit-report t]))
297 (list 'cvs-minor-mode (cons "" '(" CVS:" cvs:current-revision)))
298 "Entry to display CVS revision number in mode line")
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)))
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)))
308 ;;=============================================================================
309 (defconst cvs:mark-entry
310 (list 'cvs:mark " marked")
311 "Entry to display CVS revision number in mode line")
313 (or (assq 'cvs:mark minor-mode-alist)
314 (setq minor-mode-alist (cons cvs:mark-entry minor-mode-alist)))
316 ;;=============================================================================
317 (defvar cvs:remote-regexp "^/[^/:]*[^/:]:"
318 "regexp to test if a file is accessed from ftp")
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'."
326 (if (and buffer-file-name
327 (not (string-match cvs:remote-regexp buffer-file-name))) ; reject remote files
330 (let* ((filename (file-truename buffer-file-name))
331 (buffer (current-buffer))
332 (entries-filename (concat (file-name-directory
335 (if (file-exists-p entries-filename)
337 (set-buffer (cvs:find-file-noselect entries-filename))
339 (if (re-search-forward (concat "^/"
340 (regexp-quote (file-name-nondirectory filename))
345 (setq current-revision (buffer-substring
348 (if (looking-at ".*/T\\([^/\n][^/\n]*\\)[ \t]*\n")
349 (let ( (tag (buffer-substring (match-beginning 1)
351 (setq current-revision
352 (format "%s-%s" tag current-revision))
360 (setq cvs:current-revision current-revision)
365 (defun cvs:get-numeric-revision (revision)
367 (if (string-match "-\\([.0-9][.0-9]*\\)$" revision)
368 (setq revision (match-string 1 revision)))
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)))
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)))
387 (cvs-version-other-window new-rev)
388 ;; current-buffer is now supposed to contain the old version
390 ;; We delete the temp file that was created by vc.el for the old
392 (ediff-buffers old-vers (current-buffer)
393 (list (` (lambda () (delete-file (, (buffer-file-name))))))
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
407 ;; We delete the temp file that was created by vc.el for the old
409 (ediff-buffers (current-buffer) newvers
410 (list (` (lambda () (delete-file (, (buffer-file-name))))))
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): ")
421 (let* ((version (if (string-equal rev "")
424 (filename (if cvs-temp-dir
425 (concat (file-name-as-directory cvs-temp-dir)
426 (file-name-nondirectory buffer-file-name)
428 (concat buffer-file-name ".~" version "~"))))
429 (if (or (file-exists-p filename)
430 (cvs:checkout (file-name-nondirectory buffer-file-name) rev
432 (find-file-other-window filename)))))
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
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
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)
453 (error "Error while retrieving %s version of %s into %s"
454 (if (string= "" rev) "last" rev) filename output-name)
457 ;;=============================================================================
458 (defun cvs-add (msg &optional file)
459 "Add the current file into the CVS system"
460 (interactive "sEnter description : ")
462 (setq file (buffer-file-name)))
463 (let ((command (format "%s %s add -m \"%s\" %s" cvs-command
465 (format "-d %s" cvs-root) "")
467 (file-name-nondirectory file)))
468 (filename (file-name-nondirectory file))
469 (buf (get-buffer-create "*CVS Add output*")))
472 (setq buffer-read-only nil)
474 (if (= (call-process cvs-shell-command nil buf t cvs-shell-command-option command)
478 (run-hooks 'cvs-add-hooks)
479 (message "File added to CVS -- use 'commit' to make permanent")
481 (cvs:display-temp-buffer buf "add")
482 (error "Error while registering %s into CVS" filename))))
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)
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)
497 (defun cvs:get-description (file)
498 (cvs:call-command cvs-command "*CVS temp*" "log"
499 (list "log" "-r0" (file-name-nondirectory file)))
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)
506 (next-line 1) (beginning-of-line) (point)))
508 (search-forward "======================================")
509 (beginning-of-line) (point)))
510 (str (buffer-substring min max)))
511 (kill-buffer "*CVS temp*")
514 (defun cvs-description (&optional file)
515 "Change the description of the current file into the CVS system"
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)
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)
532 (message "Type C-c C-c when done.")
535 (defun cvs:do-description ()
536 "Change the description of the current file into the CVS system"
539 (file-name cvs:temp-filename))
541 (flush-lines "^CVS: .*$")
542 (setq msg (buffer-string))
544 (let ((command (format "%s %s admin -t-\"%s\" %s" cvs-command
546 (format "-d %s" cvs-root) "")
548 (file-name-nondirectory file-name)))
549 (filename (file-name-nondirectory file-name))
550 (buf (get-buffer-create "*CVS Admin output*")) )
553 (setq buffer-read-only nil)
555 (if (not (= (call-process cvs-shell-command nil buf t cvs-shell-command-option command)
558 (cvs:display-temp-buffer buf "admin")
559 (error "Error while changing description of %s into CVS" filename))))))
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)))
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)
571 (next-line 1) (beginning-of-line) (point)))
573 (search-forward "======================================")
574 (beginning-of-line) (point)))
575 (str (buffer-substring min max)))
576 (kill-buffer "*CVS temp*")
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): ")
583 (setq file (buffer-file-name)))
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)
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)
600 (message "Type C-c C-c when done.")
603 (defun cvs:do-change-log ()
604 "Change the description of the current file into the CVS system"
607 (file-name cvs:temp-filename)
608 (rev cvs:temp-revision))
610 (flush-lines "^CVS: .*$")
611 (setq msg (buffer-string))
613 (let ((command (format "%s %s admin -m%s:\"%s\" %s" cvs-command
615 (format "-d %s" cvs-root) "")
618 (file-name-nondirectory file-name)))
619 (filename (file-name-nondirectory file-name))
620 (buf (get-buffer-create "*CVS Admin output*")) )
623 (setq buffer-read-only nil)
625 (if (not (= (call-process cvs-shell-command nil buf t cvs-shell-command-option command)
628 (cvs:display-temp-buffer buf "admin")
629 (error "Error while changing log message of %s into CVS" filename))))))
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."
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
647 (buf (get-buffer-create " *CVS Edit output*")) )
650 (setq buffer-read-only nil)
652 (if (= (apply 'call-process cvs-command nil buf t command-args) 0)
653 (let ((file-buf (get-file-buffer file)))
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)))))
662 ;;=============================================================================
663 (defun cvs-update-file (&optional file)
664 "Update the current file from the repository"
667 (setq file (buffer-file-name)))
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
677 (buf (get-buffer-create "*CVS Update output*")))
680 (setq buffer-read-only nil)
682 (if (= (apply 'call-process cvs-command nil buf t command-args) 0)
684 (cvs:merge-or-revert buf filename revision)
685 (if (not (string-equal file filename))
686 (let ((file-buf (get-file-buffer file)))
689 (set-buffer file-buf)
690 (revert-buffer t t)))))
691 (message (format "Updated \"%s\"" file))
693 (cvs:display-temp-buffer buf "update")
694 (error "Error while updating %s"
695 (file-name-nondirectory filename)))))
697 ;;=============================================================================
698 (defun cvs-update-directory ()
699 "Update the current directory from the repository"
701 (let ((command-args (if cvs-root
702 (list "-d" cvs-root "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)))
708 (yes-or-no-p "Modified buffers exist; update anyway? "))
712 (setq buffer-read-only nil)
715 (if (= (apply 'call-process cvs-command nil buf t command-args) 0)
717 (goto-char (point-max))
718 (insert "\ncvs update finished.\n")
719 (cvs:display-temp-buffer buf "update")
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)))
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)
737 (if (string-match "^[a-z]" name)
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))
747 (goto-char (point-min))
748 (if (not (re-search-forward "^VERS:[ \t]*\\([.0-9][.[0-9]*\\)[ \t]*$"
751 (pop-to-buffer tmpbuf)
752 (error (format "Unable to convert symbolic name \"%s\"!" name))
754 (setq name (buffer-substring (match-beginning 1) (match-end 1)))
760 (defun cvs:merge-query-args ()
761 (let ((case-fold-search t)
763 (filename (file-name-nondirectory buffer-file-name))
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))
769 (string-equal to ""))
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)))
779 (setq from (format "%s.%s" part1 part2))
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!"
785 (setq from (match-string 1 to))
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))
791 (string-equal from ""))
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))
801 (defun cvs-merge-branch (branch-from branch-to)
802 "Merge a branch into the current source file."
803 (interactive (cvs:merge-query-args))
806 (command-args (append (if cvs-root
807 (list "-d" cvs-root "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*"))
815 (message (format "Merging branch %s to %s to %s ..."
816 branch-from branch-to filename))
819 (setq buffer-read-only nil)
820 (buffer-disable-undo buf)
825 (setq status (apply 'call-process cvs-command nil buf t command-args))
826 (message "Reverting buffer ...")
828 (if (not (= status 0))
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)
835 (message (format "Merged branch %s to %s to %s"
836 branch-from branch-to filename))
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
846 (goto-char (point-min))
847 (search-forward "conflicts" nil t)))
848 (filename (file-name-nondirectory file)))
850 (message "conflict detected while updating %s" filename))
851 (if (or (not conflict)
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 ? ")))
857 (let ((file-buf (get-file-buffer filename)))
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)
865 (file-name-nondirectory filename) "." revision)
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)
873 (ediff-merge-files-with-ancestor new filename ancestor
875 (delete-file (, ancestor))
876 (delete-file (, new))))))
877 ;; (delete-other-windows)
878 ;; (write-file filename)
879 ;; (revert-buffer t t)
881 (emerge-files-with-ancestor nil new filename ancestor filename
883 (delete-file (, ancestor))
884 (delete-file (, new))))))
888 ;;=============================================================================
890 ;;=============================================================================
891 (add-hook 'ediff-cleanup-hook 'cvs:ediff-cleanup)
893 (defun cvs:buffer (buf)
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)
904 (let ((buf (or (cvs:buffer ediff-buffer-A)
905 (cvs:buffer ediff-buffer-B) )) )
908 (let ((filename (buffer-file-name buf)))
910 (set-buffer ediff-buffer-C)
911 (write-file filename nil)
912 (revert-buffer t t) )
915 ;; clean all the buffers
919 ;;=============================================================================
920 (defun cvs-merge-backup (&optional 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) "\\..*")))
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*")))
937 (re-search-forward (concat "\\.#" (file-name-nondirectory filename) "\\.\\(.*\\)$"))
938 (setq result (buffer-substring (match-beginning 1) (match-end 1)))
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)
949 (ediff-merge-files-with-ancestor new (car files) ancestor
951 (delete-file (, ancestor))
952 (delete-file (, new))))))
953 ;; (delete-other-windows)
954 ;; (write-file filename)
955 ;; (revert-buffer t t)
957 (emerge-files-with-ancestor nil new (car files) ancestor filename
959 (delete-file (, ancestor))
960 (delete-file (, new))))))
965 ;;=============================================================================
966 (defun cvs:repository(&optional filename)
967 "Retrieve repository name of current CVS file"
969 (filename (file-truename (or filename buffer-file-name))))
971 (let ((repository-filename (concat (file-name-directory
975 (if (file-exists-p repository-filename)
977 (set-buffer (cvs:find-file-noselect repository-filename))
980 (setq result (buffer-substring 1 (point)))
985 ;;=============================================================================
986 (defun cvs-log (&optional file)
987 "Show the CVS log for the current buffer's file."
990 (setq file (buffer-file-name)))
991 (cvs:call-command cvs-command "*CVS Log*" "log"
992 (list "log" (file-name-nondirectory file))))
994 ;;=============================================================================
995 (defun cvs-file-status (&optional file)
996 "Show the CVS status information for the current buffer's file."
999 (setq file (buffer-file-name)))
1000 (cvs:call-command cvs-command "*CVS Status*" "status"
1001 (list "status" (file-name-nondirectory file)
1004 ;;=============================================================================
1005 (defun cvs-history (&optional file)
1006 "Show the CVS history information for the current buffer's file."
1009 (setq file (buffer-file-name)))
1010 (cvs:call-command cvs-command "*CVS History*" "history"
1011 (list "history" (file-name-nondirectory file)
1014 ;;=============================================================================
1015 (defun cvs-annotate (&optional file)
1016 "Show the CVS annotate information for the current buffer's file."
1019 (setq file (buffer-file-name)))
1020 (let ((buf (cvs:call-command cvs-command "*CVS annotate*" "annotate"
1021 (list "annotate" (file-name-nondirectory
1027 (setq major-mode mode)
1030 ;;=============================================================================
1031 (defun cvs-editors (&optional file)
1032 "Show the CVS editors information for the current buffer's file."
1035 (setq file (buffer-file-name)))
1036 (cvs:call-command cvs-command "*CVS Editors*" "editors"
1037 (list "editors" (file-name-nondirectory file)
1040 ;;=============================================================================
1041 (defun cvs-watchers (&optional file)
1042 "Show the CVS watchers information for the current buffer's file."
1045 (setq file (buffer-file-name)))
1046 (cvs:call-command cvs-command "*CVS Watchers*" "watchers"
1047 (list "watchers" (file-name-nondirectory file)
1050 ;;=============================================================================
1051 (defun cvs-who (start end &optional file)
1052 "Who was responsible for the CVS-controlled code in the region?"
1055 (setq file (buffer-file-name)))
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))
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)
1073 (delete-region (point) (point-max))
1075 (forward-line start)
1076 (delete-region 1 (point)))))))
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): ")
1083 (setq file (buffer-file-name)))
1084 (if (string= "" rev)
1086 (cvs:call-command cvs-command "*CVS Diff*" "diff"
1087 (append (list "diff")
1089 (list "-r" rev (file-name-nondirectory
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))
1101 (setq file (buffer-file-name)))
1103 (if (yes-or-no-p (concat "All your changes on " (file-name-nondirectory
1105 " will be lost! Do you want to continue ? "))
1107 (rename-file file (concat file ".old") t)
1108 (let (;(revision cvs:current-revision)
1110 (command-args (append (if cvs-root
1111 (list "-d" cvs-root "update")
1114 ( (or (string= rev "") (string= rev "-A"))
1118 (list (file-name-nondirectory file))))
1119 (buf (get-buffer-create "*CVS Revert output*")))
1120 (message "Reverting buffer ...")
1123 (setq buffer-read-only nil)
1125 (let ((result (apply 'call-process cvs-command nil buf t command-args)))
1127 (cond ((not (= result 0))
1128 (cvs:display-temp-buffer buf "revert")
1129 (error "Error while reverting %s"
1130 (file-name-nondirectory file)))
1132 (message (format "Reverted \"%s\"" file)))
1136 ;;=============================================================================
1137 (defun cvs-mark (&optional file)
1138 "(Un)Mark the current file to be committed in the commit command (toggle)."
1141 (setq file (buffer-file-name)))
1142 (if (not (member file cvs:marked-list))
1144 (setq cvs:marked-list (cons file cvs:marked-list))
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))
1151 ;;=============================================================================
1152 (defun cvs-flush-file (file)
1153 "Flush a single file."
1154 (if (get-file-buffer file)
1156 (set-buffer (get-file-buffer file))
1157 (setq cvs:mark nil)))
1161 "Flush the list of files to be committed."
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))
1170 ;;=============================================================================
1171 (defun cvs-commit (&optional l)
1172 "Setup a buffer to enter comment associated with the commit process."
1175 (setq l cvs:marked-list))
1176 (setq cvs:commit-list (if (null l)
1177 (list buffer-file-name)
1179 (let ((dir default-directory))
1180 (switch-to-buffer-other-window (get-buffer-create "*CVS Commit*"))
1181 (setq default-directory dir)
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")))
1191 (insert "CVS: Type C-c C-c when done or C-c C-d to abort.\n")
1192 (insert "CVS: ----------------------------------------------------------------------\n")
1194 (use-local-map cvs:commit-map)
1196 (run-hooks 'cvs-commit-hooks)
1197 (message "Type C-c C-c when done or C-c C-d to abort.")
1200 ;;=============================================================================
1201 (defun cvs-do-commit ()
1202 "Commit the list of files cvs:marked-list"
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))
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)
1217 (let ((buf (set-buffer (get-buffer-create "*CVS Commit output*"))))
1218 (setq buffer-read-only nil)
1219 (goto-char (point-max))
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)))
1228 (cvs:display-temp-buffer buf "commit")
1229 (error "Error while committing %S in %s" (cdr elt) (car elt))
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)
1239 (let ((buf (get-file-buffer name)))
1243 (revert-buffer t t)))))
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"
1255 (setq file (file-truename (car l)))
1256 (setq elt (assoc (file-name-directory file) alist))
1259 (nconc (cdr elt) (list (file-name-nondirectory file))))
1261 (cons (file-name-directory file)
1262 (list (file-name-nondirectory file)))
1267 ;;=============================================================================
1268 (defun cvs-list (&optional dir)
1269 "List the files to commit cvs:marked-list in a buffer"
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)
1277 (goto-char (point-min))
1278 (insert "Marked file(s):\n\n")
1280 (mapcar (function (lambda(c)
1281 (insert " ")(insert c)(insert "\n")))
1283 (insert " ***** No marked files *****\n"))
1284 (set-buffer-modified-p nil)
1285 (cvs:display-temp-buffer (current-buffer) "list"))
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."
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)))
1307 ;; Let user know if there is a buffer with the same truename.
1310 ;; Optionally also find that buffer.
1311 (if (or find-file-existing-other-name find-file-visit-truename)
1314 (or (verify-visited-file-modtime buf)
1315 (cond ((not (file-exists-p filename))
1316 (error "File %s no longer exists!" filename))
1318 (file-name-nondirectory filename)
1321 (revert-buffer t t)))))
1323 (setq buf (create-file-buffer filename))
1327 (insert-file-contents filename t)
1330 ;; Run find-file-not-found-hooks until one returns non-nil.
1331 (let ((hooks find-file-not-found-hooks))
1333 (not (and (funcall (car hooks))
1334 ;; If a hook succeeded, clear error.
1335 (progn (setq error nil)
1336 ;; Also exit the loop.
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)
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
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))
1361 (make-local-variable 'backup-inhibited)
1362 (setq backup-inhibited t)))
1363 (after-find-file error t)))
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)
1380 (apply 'call-process program nil t nil
1382 (append (list "-d" cvs-root) args)
1385 (run-hooks (intern (concat "cvs-" name "-hooks")))
1386 (cvs:display-temp-buffer (current-buffer) name)))
1388 (defun cvs:display-temp-buffer (buf name)
1389 "Display buffer setting it read only, unmodified and binding key q to bury-buffer."
1392 (cvs-info-mode name)
1393 (set-buffer-modified-p nil)
1394 (setq buffer-read-only t))
1398 (defun cvs-bury-buffer (&optional buf)
1399 "Bury a buffer even if it is in a dedicated window"
1402 (setq buf (current-buffer)))
1403 (let ((win (get-buffer-window buf)))
1404 (if (window-dedicated-p win)
1406 (delete-windows-on buf t)
1409 (other-window -1))))
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'.")
1417 (defvar cvs-info-mode-map nil
1418 "key map used by `cvs-info-mode'.")
1420 (if cvs-info-mode-map
1424 ;; Inherit from dired map
1425 (if (not (fboundp 'set-keymap-parents))
1427 (setq cvs-info-mode-map (cons 'keymap dired-mode-map))
1429 (setq cvs-info-mode-map (make-sparse-keymap))
1430 (set-keymap-parents cvs-info-mode-map dired-mode-map))
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)
1441 (defun cvs-info-mode (name)
1442 "Major mode to display CVS information buffers.
1444 \\{cvs-info-mode-map}
1446 Turning on `cvs-info-mode' runs the hooks `cvs-info-mode-hooks'."
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)
1455 ;;=============================================================================
1456 (defvar cvs:status-buffer "*CVS-Statuslist*"
1457 "Name of the CVS module status buffer")
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)
1465 (define-key m 'button2 'dired-mouse-find-file)
1466 (define-key m [return] 'dired-find-file)
1469 "The keymap used for the highlighted messages in the status buffer.")
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!"))
1479 (defun cvs-status-update ()
1480 "Update all files that are marked as needing update."
1482 (let (filename (statbuf (get-buffer cvs:status-buffer)) (filecount 0))
1483 (message "Updating files ...")
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))
1495 (message (format "Updated %d files" filecount))
1499 (defun cvs-status-mark-changed (&optional no-display)
1500 "Mark all Locally changed files in the Module Status buffer"
1502 (let (filename (statbuf (get-buffer cvs:status-buffer)) (filecount 0)
1503 (oldcount (length cvs:marked-list)))
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))
1513 (let ( (buf (get-file-buffer filename)) )
1517 (setq filecount (1+ filecount))
1520 (if (not no-display)
1522 (message (format "Marked %d new files, %d files already marked"
1523 filecount oldcount))
1527 (defun cvs-status-mark-and-commit ()
1528 "Mark and commit all Locally changed files in the Module Status buffer"
1530 (cvs-status-mark-changed t)
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."
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!"))
1545 (if (looking-at " *[*] *[A-Z]")
1547 (delete-region (point)
1552 (set-buffer-modified-p nil)
1554 (error "No file on this line")
1559 (defun cvs:status-filter (proc string)
1560 "Filter for the cvs update process"
1562 (set-buffer (process-buffer proc))
1563 (let ((buffer-read-only nil)
1564 (buf (get-buffer cvs:status-buffer))
1565 (start (process-mark proc))
1567 (goto-char (point-max))
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)))
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)) )) )
1584 (goto-char (point-max))
1585 (let ( (buffer-read-only nil)
1587 (if (fboundp 'make-extent)
1589 (insert (format " * %-17s : " status-name))
1590 (setq begin (point))
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)
1599 (insert (format " * %-17s : %s\n" status-name filename)))
1601 (set-marker (process-mark proc) (point))
1604 (defun cvs:status-sentinel (process event)
1605 "Sentinel for the cvs status process"
1607 (let ( (buf (get-buffer cvs:status-buffer))
1608 (oldbuf (current-buffer))
1611 (goto-char (point-max))
1612 (let (buffer-read-only)
1613 (insert "=================================================================\n")
1614 (insert " (Status complete)\n\n")
1616 (substitute-command-keys
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.
1622 \\[cvs-dired-commit] To commit all marked files.
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.
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.
1632 (cvs:display-temp-buffer buf "Statuslist")
1633 (buffer-enable-undo buf)
1634 (kill-buffer (process-buffer process))
1635 (pop-to-buffer oldbuf)
1638 (defun cvs-status-process (&optional files)
1639 "Display the status of the current module files"
1641 (let* ((args (cons "-d" (if cvs-root
1642 (append (list "-d" cvs-root) files) files)))
1643 (proc-buffer (get-buffer-create " *CVS-Temp*"))
1645 (dir default-directory)
1646 (buf (get-buffer-create cvs:status-buffer)))
1647 (buffer-disable-undo proc-buffer)
1649 (set-buffer proc-buffer)
1651 (setq proc (eval (append
1652 (list 'start-process "cvs status" proc-buffer
1653 cvs-command "-n" "update")
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)
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))
1668 (insert (format "%s\n" "Status of files, relative to the directory:"))
1669 (insert (format "\t%s\n" dir))
1670 (insert "=================================================================\n")
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)
1682 (defun cvs:get-filename ()
1683 (let ((lineno (cvs:current-line)))
1684 (and (not (eq lineno 1))
1688 (and (re-search-forward "^.+ : \\(.*\\)"
1689 (save-excursion (end-of-line) (point))
1691 (buffer-substring (match-beginning 1) (match-end 1)) ) ) )
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)))
1702 (defun cvs-marked-status (&optional l)
1703 "Show the status of marked files"
1706 (setq l cvs:marked-list))
1707 (cvs-status-process l))
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'."
1717 (let ((cvs:marked-list nil))
1720 ;;=============================================================================
1722 "Save the buffers modified in cvs:commit-list"
1723 (let ((files cvs:commit-list))
1725 (let ((buf (get-file-buffer (car files))))
1727 (buffer-modified-p buf)
1728 (y-or-n-p (concat "Save file " (car files) "? ")))
1733 (setq files (cdr files))))))
1735 ;;=============================================================================
1736 (defun cvs-submit-report ()
1737 "Report a problem, a suggestion or a comment about cvs.el"
1740 (reporter-submit-bug-report
1741 cvs:maintainer-address
1742 (concat "cvs.el " cvs:version)
1746 cvs-minor-mode-hooks
1749 cvs-before-commit-hooks
1752 cvs-shell-command-option
1755 cvs-never-use-emerge
1759 (insert (concat "\nCVSROOT=" (getenv "CVSROOT") "\n"))
1760 (call-process "cvs" nil t nil "-v")))
1761 "Dear cvs.el maintainer,"
1764 ;;=============================================================================
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."
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))))
1776 (add-hook 'find-file-hooks (function cvs:hook))
1777 (add-hook 'after-revert-hook (function cvs:hook))
1779 ;;=============================================================================
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)
1789 '((and (boundp 'cvs-minor-mode)
1794 "CVS marked files (%d)"))
1796 (add-hook 'cvs-mark-hooks (function (lambda()
1797 (menu-bar-update-buffers t)))))
1799 (or (and (featurep 'msb)
1800 (cvs:add-msb-submenu))
1801 (add-hook 'msb-after-load-hooks
1802 (function cvs:add-msb-submenu)))
1804 ;;=============================================================================
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))
1815 (add-hook 'dired-mode-hook (function cvs:dired-hook))
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)
1822 (defconst cvs-dired:entry
1823 (list 'cvs-dired-mode (cons "" '(" CVS")))
1824 "Entry to display CVS in mode line")
1826 (defvar cvs-dired:map (make-sparse-keymap)
1827 "CVS dired minor mode keymap")
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)
1855 "CVS dired minor mode keymap"
1857 ["Add" cvs-dired-add t]
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]
1871 ["Module Status" cvs-status-process t]
1872 ["Update Module" cvs-update-directory t]
1875 ["Show List" cvs-list t]
1876 ["Flush List" cvs-flush t]
1878 ("Action on Marked Files"
1879 ["Commit" cvs-dired-commit t]
1880 ["Show Status" cvs-dired-marked-status t]
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])
1890 ["Send mail report" cvs-submit-report t]))
1892 (or (assq 'cvs-dired-mode minor-mode-alist)
1893 (setq minor-mode-alist (cons cvs-dired:entry minor-mode-alist)))
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)))
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)
1905 (defun cvs-dired-file-status ()
1906 "Call `cvs-file-status' on current file."
1908 (cvs-file-status (dired-get-filename)))
1910 (defun cvs-dired-edit ()
1911 "Call `cvs-edit' on current file."
1913 (let ((filename (dired-get-filename)))
1915 (dired-update-file-line filename) ) )
1917 (defun cvs-dired-editors ()
1918 "Call `cvs-editors' on current file."
1920 (cvs-editors (dired-get-filename)))
1922 (defun cvs-dired-watchers ()
1923 "Call `cvs-watchers' on current file."
1925 (cvs-watchers (dired-get-filename)))
1927 (defun cvs-dired-commit-file ()
1928 "Call `cvs-commit-file' on current file."
1930 (cvs-commit (list (dired-get-filename))))
1932 (defun cvs-dired-log ()
1933 "Call `cvs-log' on current file."
1935 (cvs-log (dired-get-filename)))
1937 (defun cvs-dired-annotate ()
1938 "Call `cvs-annotate' on current file."
1940 (cvs-annotate (dired-get-filename)))
1942 (defun cvs-dired-history ()
1943 "Call `cvs-history' on current file."
1945 (cvs-history (dired-get-filename)))
1947 (defun cvs-dired-update-file ()
1948 "Call `cvs-update-file' on current file."
1950 (cvs-update-file (dired-get-filename)))
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)))
1957 (defun cvs-dired-add (msg)
1958 "Add current file to CVS."
1959 (interactive "sEnter description : ")
1960 (cvs-add msg (dired-get-filename)))
1962 (defun cvs-dired-description ()
1963 "Call `cvs-description' on current file."
1965 (cvs-description (dired-get-filename)))
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)))
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)))
1977 (defun cvs-dired-merge-backup ()
1978 "Call `cvs-merge-backup' on current file."
1980 (cvs-merge-backup (dired-get-filename)))
1982 (defun cvs-dired-commit ()
1983 "Call `cvs-commit' on marked files."
1985 (let ((l (or (let (f (dired-get-marked-files))
1986 (if (and f (> (length f) 0)) f nil)) cvs:marked-list)))
1988 (error "No marked files")
1992 ;;(defun cvs-dired-update-marked ()
1993 ;; "Call `cvs-update-file' on marked files."
1995 ;; (let ((l (or (let (f (dired-get-marked-files))
1996 ;; (if (and f (> (length f) 0)) f nil)) cvs:marked-list)))
1998 ;; (error "No marked files")
1999 ;; (cvs-update-file l))))
2001 (defun cvs-dired-marked-status ()
2002 "Call `cvs-marked-status' on marked files."
2004 (let ((l (or (let (f (dired-get-marked-files))
2005 (if (and f (> (length f) 0)) f nil)) cvs:marked-list)))
2007 (error "No marked file")
2008 (cvs-marked-status l))))
2010 (defun cvs-dired-ediff-internal ()
2011 "Edit currect file and call `cvs-ediff-internal'."
2014 (call-interactively 'cvs-ediff-internal))
2016 (defun cvs-dired-ediff ()
2017 "Edit currect file and call `cvs-ediff'."
2020 (call-interactively 'cvs-ediff))
2022 ;;=============================================================================
2023 (run-hooks 'cvs-load-hooks)
2025 ;;=============================================================================