Mercurial > emacs
comparison lisp/vc.el @ 91367:c70e45a7acfd
Merge from emacs--devo--0
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-324
author | Miles Bader <miles@gnu.org> |
---|---|
date | Wed, 30 Jan 2008 07:57:28 +0000 |
parents | 606f2d163a64 f1f0d8b05c52 |
children |
comparison
equal
deleted
inserted
replaced
91366:86f3a8f0a3a6 | 91367:c70e45a7acfd |
---|---|
1 ;;; vc.el --- drive a version-control system from within Emacs | 1 ;;; vc.el --- drive a version-control system from within Emacs |
2 | 2 |
3 ;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000, | 3 ;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000, |
4 ;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. | 4 ;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 |
5 ;; Free Software Foundation, Inc. | |
5 | 6 |
6 ;; Author: FSF (see below for full credits) | 7 ;; Author: FSF (see below for full credits) |
7 ;; Maintainer: Andre Spiegel <spiegel@gnu.org> | 8 ;; Maintainer: Andre Spiegel <spiegel@gnu.org> |
8 ;; Keywords: tools | 9 ;; Keywords: tools |
9 | |
10 ;; $Id$ | |
11 | 10 |
12 ;; This file is part of GNU Emacs. | 11 ;; This file is part of GNU Emacs. |
13 | 12 |
14 ;; GNU Emacs is free software; you can redistribute it and/or modify | 13 ;; GNU Emacs is free software; you can redistribute it and/or modify |
15 ;; it under the terms of the GNU General Public License as published by | 14 ;; it under the terms of the GNU General Public License as published by |
519 ;; end of the Version Control menu. The goal is to allow backends | 518 ;; end of the Version Control menu. The goal is to allow backends |
520 ;; to specify extra menu items that appear in the VC menu. This way | 519 ;; to specify extra menu items that appear in the VC menu. This way |
521 ;; you can provide menu entries for functionality that is specific | 520 ;; you can provide menu entries for functionality that is specific |
522 ;; to your backend and which does not map to any of the VC generic | 521 ;; to your backend and which does not map to any of the VC generic |
523 ;; concepts. | 522 ;; concepts. |
523 | |
524 ;;; Todo: | |
525 | |
526 ;; - Make vc-checkin avoid reverting the buffer if has not changed | |
527 ;; after the checkin. Comparing (md5 BUFFER) to (md5 FILE) should | |
528 ;; be enough. | |
529 ;; | |
530 ;; - vc-update/vc-merge should deal with VC systems that don't | |
531 ;; update/merge on a file basis, but on a whole repository basis. | |
532 ;; | |
533 ;; - the backend sometimes knows when a file it opens has been marked | |
534 ;; by the VCS as having a "conflict". Find a way to pass this info - | |
535 ;; to VC so that it can turn on smerge-mode when opening such a | |
536 ;; file. | |
537 ;; | |
538 ;; - the *VC-log* buffer needs font-locking. | |
539 ;; | |
540 ;; - make it easier to write logs, maybe C-x 4 a should add to the log | |
541 ;; buffer if there's one instead of the ChangeLog. | |
542 ;; | |
543 ;; - make vc-state for all backends return 'unregistered instead of | |
544 ;; nil for unregistered files, then update vc-next-action. | |
545 ;; | |
546 ;; - add a generic mechanism for remembering the current branch names, | |
547 ;; display the branch name in the mode-line. Replace | |
548 ;; vc-cvs-sticky-tag with that. | |
549 ;; | |
550 ;; - vc-register should register a fileset at a time. The backends | |
551 ;; already support this, only the front-end needs to be change to | |
552 ;; handle multiple files at a time. | |
553 ;; | |
554 ;; - add a mechanism to for ignoring files. | |
555 ;; | |
556 ;; - deal with push/pull operations. | |
557 ;; | |
558 ;; - decide if vc-status should replace vc-dired. | |
559 ;; | |
560 ;; - vc-status needs a menu, mouse bindings and some color bling. | |
561 ;; | |
562 ;; - vc-status needs to show missing files. It probably needs to have | |
563 ;; another state for those files. The user might want to restore | |
564 ;; them, or remove them from the VCS. C-x v v might also need | |
565 ;; adjustments. | |
566 ;; | |
567 ;; - "snapshots" should be renamed to "branches", and thoroughly reworked. | |
568 ;; | |
569 ;; - do not default to RCS anymore when the current directory is not | |
570 ;; controlled by any VCS and the user does C-x v v | |
571 ;; | |
524 | 572 |
525 ;;; Code: | 573 ;;; Code: |
526 | 574 |
527 (require 'vc-hooks) | 575 (require 'vc-hooks) |
528 (require 'ring) | 576 (require 'ring) |
905 | 953 |
906 (defun vc-process-filter (p s) | 954 (defun vc-process-filter (p s) |
907 "An alternative output filter for async process P. | 955 "An alternative output filter for async process P. |
908 One difference with the default filter is that this inserts S after markers. | 956 One difference with the default filter is that this inserts S after markers. |
909 Another is that undo information is not kept." | 957 Another is that undo information is not kept." |
910 (with-current-buffer (process-buffer p) | 958 (let ((buffer (process-buffer p))) |
911 (save-excursion | 959 (when (buffer-live-p buffer) |
912 (let ((buffer-undo-list t) | 960 (with-current-buffer buffer |
913 (inhibit-read-only t)) | 961 (save-excursion |
914 (goto-char (process-mark p)) | 962 (let ((buffer-undo-list t) |
915 (insert s) | 963 (inhibit-read-only t)) |
916 (set-marker (process-mark p) (point)))))) | 964 (goto-char (process-mark p)) |
965 (insert s) | |
966 (set-marker (process-mark p) (point)))))))) | |
917 | 967 |
918 (defun vc-setup-buffer (&optional buf) | 968 (defun vc-setup-buffer (&optional buf) |
919 "Prepare BUF for executing a VC command and make it current. | 969 "Prepare BUF for executing a VC command and make it current. |
920 BUF defaults to \"*vc*\", can be a string and will be created if necessary." | 970 BUF defaults to \"*vc*\", can be a string and will be created if necessary." |
921 (unless buf (setq buf "*vc*")) | 971 (unless buf (setq buf "*vc*")) |
932 (erase-buffer)))) | 982 (erase-buffer)))) |
933 | 983 |
934 (defvar vc-sentinel-movepoint) ;Dynamically scoped. | 984 (defvar vc-sentinel-movepoint) ;Dynamically scoped. |
935 | 985 |
936 (defun vc-process-sentinel (p s) | 986 (defun vc-process-sentinel (p s) |
937 (let ((previous (process-get p 'vc-previous-sentinel))) | 987 (let ((previous (process-get p 'vc-previous-sentinel)) |
938 (if previous (funcall previous p s)) | 988 (buf (process-buffer p))) |
939 (with-current-buffer (process-buffer p) | 989 ;; Impatient users sometime kill "slow" buffers; check liveness |
940 (let (vc-sentinel-movepoint) | 990 ;; to avoid "error in process sentinel: Selecting deleted buffer". |
941 ;; Normally, we want async code such as sentinels to not move point. | 991 (when (buffer-live-p buf) |
942 (save-excursion | 992 (if previous (funcall previous p s)) |
943 (goto-char (process-mark p)) | 993 (with-current-buffer buf |
944 (let ((cmds (process-get p 'vc-sentinel-commands))) | 994 (setq mode-line-process |
945 (process-put p 'vc-sentinel-commands nil) | 995 (let ((status (process-status p))) |
946 (dolist (cmd cmds) | 996 ;; Leave mode-line uncluttered, normally. |
947 ;; Each sentinel may move point and the next one should be run | 997 ;; (Let known any weirdness in-form-ally. ;-) --ttn |
948 ;; at that new point. We could get the same result by having | 998 (unless (eq 'exit status) |
949 ;; each sentinel read&set process-mark, but since `cmd' needs | 999 (format " (%s)" status)))) |
950 ;; to work both for async and sync processes, this would be | 1000 (let (vc-sentinel-movepoint) |
951 ;; difficult to achieve. | 1001 ;; Normally, we want async code such as sentinels to not move point. |
952 (vc-exec-after cmd)))) | 1002 (save-excursion |
953 ;; But sometimes the sentinels really want to move point. | 1003 (goto-char (process-mark p)) |
954 (if vc-sentinel-movepoint | 1004 (let ((cmds (process-get p 'vc-sentinel-commands))) |
955 (let ((win (get-buffer-window (current-buffer) 0))) | 1005 (process-put p 'vc-sentinel-commands nil) |
956 (if (not win) | 1006 (dolist (cmd cmds) |
957 (goto-char vc-sentinel-movepoint) | 1007 ;; Each sentinel may move point and the next one should be run |
958 (with-selected-window win | 1008 ;; at that new point. We could get the same result by having |
959 (goto-char vc-sentinel-movepoint))))))))) | 1009 ;; each sentinel read&set process-mark, but since `cmd' needs |
1010 ;; to work both for async and sync processes, this would be | |
1011 ;; difficult to achieve. | |
1012 (vc-exec-after cmd)))) | |
1013 ;; But sometimes the sentinels really want to move point. | |
1014 (if vc-sentinel-movepoint | |
1015 (let ((win (get-buffer-window (current-buffer) 0))) | |
1016 (if (not win) | |
1017 (goto-char vc-sentinel-movepoint) | |
1018 (with-selected-window win | |
1019 (goto-char vc-sentinel-movepoint)))))))))) | |
960 | 1020 |
961 (defun vc-exec-after (code) | 1021 (defun vc-exec-after (code) |
962 "Eval CODE when the current buffer's process is done. | 1022 "Eval CODE when the current buffer's process is done. |
963 If the current buffer has no process, just evaluate CODE. | 1023 If the current buffer has no process, just evaluate CODE. |
964 Else, add CODE to the process' sentinel." | 1024 Else, add CODE to the process' sentinel." |
973 ;; Make sure we've read the process's output before going further. | 1033 ;; Make sure we've read the process's output before going further. |
974 (if proc (accept-process-output proc)) | 1034 (if proc (accept-process-output proc)) |
975 (eval code)) | 1035 (eval code)) |
976 ;; If a process is running, add CODE to the sentinel | 1036 ;; If a process is running, add CODE to the sentinel |
977 ((eq (process-status proc) 'run) | 1037 ((eq (process-status proc) 'run) |
1038 (setq mode-line-process | |
1039 ;; Deliberate overstatement, but power law respected. | |
1040 ;; (The message is ephemeral, so we make it loud.) --ttn | |
1041 (propertize " (incomplete/in progress)" | |
1042 'face (if (featurep 'compile) | |
1043 ;; ttn's preferred loudness | |
1044 'compilation-warning | |
1045 ;; suitably available fallback | |
1046 font-lock-warning-face) | |
1047 'help-echo | |
1048 "A VC command is in progress in this buffer")) | |
978 (let ((previous (process-sentinel proc))) | 1049 (let ((previous (process-sentinel proc))) |
979 (unless (eq previous 'vc-process-sentinel) | 1050 (unless (eq previous 'vc-process-sentinel) |
980 (process-put proc 'vc-previous-sentinel previous)) | 1051 (process-put proc 'vc-previous-sentinel previous)) |
981 (set-process-sentinel proc 'vc-process-sentinel)) | 1052 (set-process-sentinel proc 'vc-process-sentinel)) |
982 (process-put proc 'vc-sentinel-commands | 1053 (process-put proc 'vc-sentinel-commands |
1274 (let ((firstbackend (vc-backend (car marked)))) | 1345 (let ((firstbackend (vc-backend (car marked)))) |
1275 (dolist (f (cdr marked)) | 1346 (dolist (f (cdr marked)) |
1276 (unless (eq (vc-backend f) firstbackend) | 1347 (unless (eq (vc-backend f) firstbackend) |
1277 (error "All members of a fileset must be under the same version-control system.")))) | 1348 (error "All members of a fileset must be under the same version-control system.")))) |
1278 marked)) | 1349 marked)) |
1279 ((eq major-mode 'vc-status-mode) | 1350 ((eq major-mode 'vc-status-mode) |
1280 (vc-status-marked-files)) | 1351 (let ((marked (vc-status-marked-files))) |
1281 ((vc-backend buffer-file-name) | 1352 (if marked |
1353 marked | |
1354 (list (vc-status-current-file))))) | |
1355 ((vc-backend buffer-file-name) | |
1282 (list buffer-file-name)) | 1356 (list buffer-file-name)) |
1283 ((and vc-parent-buffer (or (buffer-file-name vc-parent-buffer) | 1357 ((and vc-parent-buffer (or (buffer-file-name vc-parent-buffer) |
1284 (with-current-buffer vc-parent-buffer | 1358 (with-current-buffer vc-parent-buffer |
1285 vc-dired-mode))) | 1359 vc-dired-mode))) |
1286 (progn | 1360 (progn |
1305 (list buffer-file-name)) | 1379 (list buffer-file-name)) |
1306 (t (error "No fileset is available here.")))) | 1380 (t (error "No fileset is available here.")))) |
1307 | 1381 |
1308 (defun vc-ensure-vc-buffer () | 1382 (defun vc-ensure-vc-buffer () |
1309 "Make sure that the current buffer visits a version-controlled file." | 1383 "Make sure that the current buffer visits a version-controlled file." |
1310 (if vc-dired-mode | 1384 (cond |
1311 (set-buffer (find-file-noselect (dired-get-filename))) | 1385 (vc-dired-mode |
1386 (set-buffer (find-file-noselect (dired-get-filename)))) | |
1387 ((eq major-mode 'vc-status-mode) | |
1388 (set-buffer (find-file-noselect (vc-status-current-file)))) | |
1389 (t | |
1312 (while (and vc-parent-buffer | 1390 (while (and vc-parent-buffer |
1313 (buffer-live-p vc-parent-buffer) | 1391 (buffer-live-p vc-parent-buffer) |
1314 ;; Avoid infinite looping when vc-parent-buffer and | 1392 ;; Avoid infinite looping when vc-parent-buffer and |
1315 ;; current buffer are the same buffer. | 1393 ;; current buffer are the same buffer. |
1316 (not (eq vc-parent-buffer (current-buffer)))) | 1394 (not (eq vc-parent-buffer (current-buffer)))) |
1317 (set-buffer vc-parent-buffer)) | 1395 (set-buffer vc-parent-buffer)) |
1318 (if (not buffer-file-name) | 1396 (if (not buffer-file-name) |
1319 (error "Buffer %s is not associated with a file" (buffer-name)) | 1397 (error "Buffer %s is not associated with a file" (buffer-name)) |
1320 (if (not (vc-backend buffer-file-name)) | 1398 (if (not (vc-backend buffer-file-name)) |
1321 (error "File %s is not under version control" buffer-file-name))))) | 1399 (error "File %s is not under version control" buffer-file-name)))))) |
1322 | 1400 |
1323 ;;; Support for the C-x v v command. This is where all the single-file-oriented | 1401 ;;; Support for the C-x v v command. This is where all the single-file-oriented |
1324 ;;; code from before the fileset rewrite lives. | 1402 ;;; code from before the fileset rewrite lives. |
1325 | 1403 |
1326 (defsubst vc-editable-p (file) | 1404 (defsubst vc-editable-p (file) |
1402 (state (vc-state (car files))) | 1480 (state (vc-state (car files))) |
1403 (model (vc-checkout-model (car files))) | 1481 (model (vc-checkout-model (car files))) |
1404 revision) | 1482 revision) |
1405 ;; Verify that the fileset is homogenous | 1483 ;; Verify that the fileset is homogenous |
1406 (dolist (file (cdr files)) | 1484 (dolist (file (cdr files)) |
1407 (if (not (vc-compatible-state (vc-state file) state)) | 1485 (unless (vc-compatible-state (vc-state file) state) |
1408 (error "Fileset is in a mixed-up state")) | 1486 (error "Fileset is in a mixed-up state")) |
1409 (if (not (eq (vc-checkout-model file) model)) | 1487 (unless (eq (vc-checkout-model file) model) |
1410 (error "Fileset has mixed checkout models"))) | 1488 (error "Fileset has mixed checkout models"))) |
1411 ;; Check for buffers in the fileset not matching the on-disk contents. | 1489 ;; Check for buffers in the fileset not matching the on-disk contents. |
1412 (dolist (file files) | 1490 (dolist (file files) |
1413 (let ((visited (get-file-buffer file))) | 1491 (let ((visited (get-file-buffer file))) |
1414 (when visited | 1492 (when visited |
1426 (if (yes-or-no-p (format "Replace %s on disk with buffer contents? " file)) | 1504 (if (yes-or-no-p (format "Replace %s on disk with buffer contents? " file)) |
1427 (write-file buffer-file-name) | 1505 (write-file buffer-file-name) |
1428 (error "Aborted")) | 1506 (error "Aborted")) |
1429 ;; Now, check if we have unsaved changes. | 1507 ;; Now, check if we have unsaved changes. |
1430 (vc-buffer-sync t) | 1508 (vc-buffer-sync t) |
1431 (if (buffer-modified-p) | 1509 (when (buffer-modified-p) |
1432 (or (y-or-n-p (message "Use %s on disk, keeping modified buffer? " file)) | 1510 (or (y-or-n-p (message "Use %s on disk, keeping modified buffer? " file)) |
1433 (error "Aborted"))))))) | 1511 (error "Aborted"))))))) |
1434 ;; Do the right thing | 1512 ;; Do the right thing |
1435 (cond | 1513 (cond |
1436 ;; Files aren't registered | 1514 ;; Files aren't registered |
1437 ((not state) | 1515 ((or (not state) ;; RCS uses nil for unregistered files. |
1516 (eq state 'unregistered) | |
1517 (eq state 'ignored)) | |
1438 (mapc 'vc-register files)) | 1518 (mapc 'vc-register files)) |
1439 ;; Files are up-to-date, or need a merge and user specified a revision | 1519 ;; Files are up-to-date, or need a merge and user specified a revision |
1440 ((or (eq state 'up-to-date) (and verbose (eq state 'needs-patch))) | 1520 ((or (eq state 'up-to-date) (and verbose (eq state 'needs-patch))) |
1441 (cond | 1521 (cond |
1442 (verbose | 1522 (verbose |
1456 ;; Files have local changes | 1536 ;; Files have local changes |
1457 ((vc-compatible-state state 'edited) | 1537 ((vc-compatible-state state 'edited) |
1458 (let ((ready-for-commit files)) | 1538 (let ((ready-for-commit files)) |
1459 ;; If files are edited but read-only, give user a chance to correct | 1539 ;; If files are edited but read-only, give user a chance to correct |
1460 (dolist (file files) | 1540 (dolist (file files) |
1461 (if (not (file-writable-p file)) | 1541 (unless (file-writable-p file) |
1462 (progn | 1542 ;; Make the file+buffer read-write. |
1463 ;; Make the file+buffer read-write. | 1543 (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue?" file)) |
1464 (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue?" file)) | 1544 (error "Aborted")) |
1465 (error "Aborted")) | 1545 (set-file-modes file (logior (file-modes file) 128)) |
1466 (set-file-modes file (logior (file-modes file) 128)) | 1546 (let ((visited (get-file-buffer file))) |
1467 (let ((visited (get-file-buffer file))) | 1547 (when visited |
1468 (if visited | 1548 (with-current-buffer visited |
1469 (with-current-buffer visited | 1549 (toggle-read-only -1)))))) |
1470 (toggle-read-only -1))))))) | |
1471 ;; Allow user to revert files with no changes | 1550 ;; Allow user to revert files with no changes |
1472 (save-excursion | 1551 (save-excursion |
1473 (dolist (file files) | 1552 (dolist (file files) |
1474 (let ((visited (get-file-buffer file))) | 1553 (let ((visited (get-file-buffer file))) |
1475 ;; For files with locking, if the file does not contain | 1554 ;; For files with locking, if the file does not contain |
1476 ;; any changes, just let go of the lock, i.e. revert. | 1555 ;; any changes, just let go of the lock, i.e. revert. |
1477 (if (and (not (eq model 'implicit)) | 1556 (when (and (not (eq model 'implicit)) |
1478 (vc-workfile-unchanged-p file) | 1557 (vc-workfile-unchanged-p file) |
1479 ;; If buffer is modified, that means the user just | 1558 ;; If buffer is modified, that means the user just |
1480 ;; said no to saving it; in that case, don't revert, | 1559 ;; said no to saving it; in that case, don't revert, |
1481 ;; because the user might intend to save after | 1560 ;; because the user might intend to save after |
1482 ;; finishing the log entry and committing. | 1561 ;; finishing the log entry and committing. |
1483 (not (and visited (buffer-modified-p)))) | 1562 (not (and visited (buffer-modified-p)))) |
1484 (progn | 1563 (vc-revert-file file) |
1485 (vc-revert-file file) | 1564 (delete file ready-for-commit))))) |
1486 (delete file ready-for-commit)))))) | |
1487 ;; Remaining files need to be committed | 1565 ;; Remaining files need to be committed |
1488 (if (not ready-for-commit) | 1566 (if (not ready-for-commit) |
1489 (message "No files remain to be committed") | 1567 (message "No files remain to be committed") |
1490 (if (not verbose) | 1568 (if (not verbose) |
1491 (vc-checkin ready-for-commit) | 1569 (vc-checkin ready-for-commit) |
1492 (progn | 1570 (progn |
1493 (setq revision (read-string "New revision or backend: ")) | 1571 (setq revision (read-string "New revision or backend: ")) |
1494 (let ((vsym (intern (upcase revision)))) | 1572 (let ((vsym (intern (upcase revision)))) |
1495 (if (member vsym vc-handled-backends) | 1573 (if (member vsym vc-handled-backends) |
1496 (vc-transfer-file file vsym) | 1574 (dolist (file files) (vc-transfer-file file vsym)) |
1497 (vc-checkin ready-for-commit revision)))))))) | 1575 (vc-checkin ready-for-commit revision)))))))) |
1498 ;; locked by somebody else (locking VCSes only) | 1576 ;; locked by somebody else (locking VCSes only) |
1499 ((stringp state) | 1577 ((stringp state) |
1500 (let ((revision | 1578 ;; In the old days, we computed the revision once and used it on |
1501 (if verbose | 1579 ;; the single file. Then, for the 2007-2008 fileset rewrite, we |
1502 (read-string "Revision to steal: ") | 1580 ;; computed the revision once (incorrectly, using a free var) and |
1503 (vc-working-revision file)))) | 1581 ;; used it on all files. To fix the free var bug, we can either |
1504 (dolist (file files) (vc-steal-lock file revision state)))) | 1582 ;; use `(car files)' or do what we do here: distribute the |
1583 ;; revision computation among `files'. Although this may be | |
1584 ;; tedious for those backends where a "revision" is a trans-file | |
1585 ;; concept, it is nonetheless correct for both those and (more | |
1586 ;; importantly) for those where "revision" is a per-file concept. | |
1587 ;; If the intersection of the former group and "locking VCSes" is | |
1588 ;; non-empty [I vaguely doubt it --ttn], we can reinstate the | |
1589 ;; pre-computation approach of yore. | |
1590 (dolist (file files) | |
1591 (vc-steal-lock | |
1592 file (if verbose | |
1593 (read-string (format "%s revision to steal: " file)) | |
1594 (vc-working-revision file)) | |
1595 state))) | |
1505 ;; needs-patch | 1596 ;; needs-patch |
1506 ((eq state 'needs-patch) | 1597 ((eq state 'needs-patch) |
1507 (dolist (file files) | 1598 (dolist (file files) |
1508 (if (yes-or-no-p (format | 1599 (if (yes-or-no-p (format |
1509 "%s is not up-to-date. Get latest revision? " | 1600 "%s is not up-to-date. Get latest revision? " |
1510 (file-name-nondirectory file))) | 1601 (file-name-nondirectory file))) |
1511 (vc-checkout file (eq model 'implicit) t) | 1602 (vc-checkout file (eq model 'implicit) t) |
1512 (if (and (not (eq model 'implicit)) | 1603 (when (and (not (eq model 'implicit)) |
1513 (yes-or-no-p "Lock this revision? ")) | 1604 (yes-or-no-p "Lock this revision? ")) |
1514 (vc-checkout file t))))) | 1605 (vc-checkout file t))))) |
1515 ;; needs-merge | 1606 ;; needs-merge |
1516 ((eq state 'needs-merge) | 1607 ((eq state 'needs-merge) |
1517 (dolist (file files) | 1608 (dolist (file files) |
1518 (if (yes-or-no-p (format | 1609 (when (yes-or-no-p (format |
1519 "%s is not up-to-date. Merge in changes now? " | 1610 "%s is not up-to-date. Merge in changes now? " |
1520 (file-name-nondirectory file))) | 1611 (file-name-nondirectory file))) |
1521 (vc-maybe-resolve-conflicts file (vc-call merge-news file))))) | 1612 (vc-maybe-resolve-conflicts file (vc-call merge-news file))))) |
1522 | 1613 |
1523 ;; unlocked-changes | 1614 ;; unlocked-changes |
1524 ((eq state 'unlocked-changes) | 1615 ((eq state 'unlocked-changes) |
1525 (dolist (file files) | 1616 (dolist (file files) |
1526 (if (not (equal buffer-file-name file)) | 1617 (if (not (equal buffer-file-name file)) |
1665 contents of the log entry buffer. If COMMENT is a string and | 1756 contents of the log entry buffer. If COMMENT is a string and |
1666 INITIAL-CONTENTS is nil, do action immediately as if the user had | 1757 INITIAL-CONTENTS is nil, do action immediately as if the user had |
1667 entered COMMENT. If COMMENT is t, also do action immediately with an | 1758 entered COMMENT. If COMMENT is t, also do action immediately with an |
1668 empty comment. Remember the file's buffer in `vc-parent-buffer' | 1759 empty comment. Remember the file's buffer in `vc-parent-buffer' |
1669 \(current one if no file). AFTER-HOOK specifies the local value | 1760 \(current one if no file). AFTER-HOOK specifies the local value |
1670 for vc-log-operation-hook." | 1761 for `vc-log-after-operation-hook'." |
1671 (let ((parent | 1762 (let ((parent |
1672 (if (eq major-mode 'vc-dired-mode) | 1763 (if (eq major-mode 'vc-dired-mode) |
1673 ;; If we are called from VC dired, the parent buffer is | 1764 ;; If we are called from VC dired, the parent buffer is |
1674 ;; the current buffer. | 1765 ;; the current buffer. |
1675 (current-buffer) | 1766 (current-buffer) |
1898 | 1989 |
1899 ;; Old def for compatibility with Emacs-21.[123]. | 1990 ;; Old def for compatibility with Emacs-21.[123]. |
1900 (defmacro vc-diff-switches-list (backend) `(vc-switches ',backend 'diff)) | 1991 (defmacro vc-diff-switches-list (backend) `(vc-switches ',backend 'diff)) |
1901 (make-obsolete 'vc-diff-switches-list 'vc-switches "22.1") | 1992 (make-obsolete 'vc-diff-switches-list 'vc-switches "22.1") |
1902 | 1993 |
1903 (defun vc-diff-sentinel (verbose rev1-name rev2-name) | 1994 (defun vc-diff-finish (buffer-name verbose) |
1904 ;; The empty sync output case has already been handled, so the only | 1995 ;; The empty sync output case has already been handled, so the only |
1905 ;; possibility of an empty output is for an async process, in which case | 1996 ;; possibility of an empty output is for an async process. |
1906 ;; it's important to insert the "diffs end here" message in the buffer | 1997 (when (buffer-live-p buffer-name) |
1907 ;; since the user may miss a message in the echo area. | 1998 (with-current-buffer (get-buffer buffer-name) |
1908 (when verbose | 1999 (and verbose |
1909 (let ((inhibit-read-only t)) | 2000 (zerop (buffer-size)) |
1910 (if (eq (buffer-size) 0) | 2001 (let ((inhibit-read-only t)) |
1911 (insert "No differences found.\n") | 2002 (insert "No differences found.\n"))) |
1912 (insert (format "\n\nDiffs between %s and %s end here." rev1-name rev2-name))))) | 2003 (goto-char (point-min)) |
1913 (goto-char (point-min)) | 2004 (let ((window (get-buffer-window (current-buffer) t))) |
1914 (shrink-window-if-larger-than-buffer)) | 2005 (when window |
2006 (shrink-window-if-larger-than-buffer window)))))) | |
1915 | 2007 |
1916 (defvar vc-diff-added-files nil | 2008 (defvar vc-diff-added-files nil |
1917 "If non-nil, diff added files by comparing them to /dev/null.") | 2009 "If non-nil, diff added files by comparing them to /dev/null.") |
1918 | 2010 |
1919 (defun vc-diff-internal (async files rev1 rev2 &optional verbose) | 2011 (defun vc-diff-internal (async files rev1 rev2 &optional verbose) |
1968 (diff-mode) | 2060 (diff-mode) |
1969 ;; Make the *vc-diff* buffer read only, the diff-mode key | 2061 ;; Make the *vc-diff* buffer read only, the diff-mode key |
1970 ;; bindings are nicer for read only buffers. pcl-cvs does the | 2062 ;; bindings are nicer for read only buffers. pcl-cvs does the |
1971 ;; same thing. | 2063 ;; same thing. |
1972 (setq buffer-read-only t) | 2064 (setq buffer-read-only t) |
1973 (vc-exec-after `(vc-diff-sentinel ,verbose ,rev1-name ,rev2-name)) | 2065 (vc-exec-after `(vc-diff-finish ,(buffer-name) ,verbose)) |
1974 ;; Display the buffer, but at the end because it can change point. | 2066 ;; Display the buffer, but at the end because it can change point. |
1975 (pop-to-buffer (current-buffer)) | 2067 (pop-to-buffer (current-buffer)) |
1976 ;; In the async case, we return t even if there are no differences | 2068 ;; In the async case, we return t even if there are no differences |
1977 ;; because we don't know that yet. | 2069 ;; because we don't know that yet. |
1978 t))) | 2070 t))) |
2484 With prefix arg READ-SWITCHES, specify a value to override | 2576 With prefix arg READ-SWITCHES, specify a value to override |
2485 `dired-listing-switches' when generating the listing." | 2577 `dired-listing-switches' when generating the listing." |
2486 (interactive "DDired under VC (directory): \nP") | 2578 (interactive "DDired under VC (directory): \nP") |
2487 (let ((vc-dired-switches (concat vc-dired-listing-switches | 2579 (let ((vc-dired-switches (concat vc-dired-listing-switches |
2488 (if vc-dired-recurse "R" "")))) | 2580 (if vc-dired-recurse "R" "")))) |
2489 (if (eq (string-match tramp-file-name-regexp dir) 0) | |
2490 (error "Sorry, vc-directory does not work over Tramp")) | |
2491 (if read-switches | 2581 (if read-switches |
2492 (setq vc-dired-switches | 2582 (setq vc-dired-switches |
2493 (read-string "Dired listing switches: " | 2583 (read-string "Dired listing switches: " |
2494 vc-dired-switches))) | 2584 vc-dired-switches))) |
2495 (require 'dired) | 2585 (require 'dired) |
2510 state | 2600 state |
2511 name) | 2601 name) |
2512 | 2602 |
2513 (defvar vc-status nil) | 2603 (defvar vc-status nil) |
2514 | 2604 |
2515 (defun vc-status-insert-headers (backend dir) | 2605 (defun vc-status-headers (backend dir) |
2516 (insert (format "VC backend :%s\n" backend)) | 2606 (concat |
2517 (insert "Repository : The repository goes here\n") | 2607 (format "VC backend : %s\n" backend) |
2518 (insert (format "Working dir: %s\n\n\n" dir))) | 2608 "Repository : The repository goes here\n" |
2609 (format "Working dir: %s\n" dir))) | |
2519 | 2610 |
2520 (defun vc-status-printer (fileentry) | 2611 (defun vc-status-printer (fileentry) |
2521 "Pretty print FILEENTRY." | 2612 "Pretty print FILEENTRY." |
2522 (insert | 2613 (insert |
2614 ;; If you change this, change vc-status-move-to-goal-column. | |
2523 (format "%c %-20s %s" | 2615 (format "%c %-20s %s" |
2524 (if (vc-status-fileinfo->marked fileentry) ?* ? ) | 2616 (if (vc-status-fileinfo->marked fileentry) ?* ? ) |
2525 (vc-status-fileinfo->state fileentry) | 2617 (vc-status-fileinfo->state fileentry) |
2526 (vc-status-fileinfo->name fileentry)))) | 2618 (vc-status-fileinfo->name fileentry)))) |
2527 | 2619 |
2620 (defun vc-status-move-to-goal-column () | |
2621 (beginning-of-line) | |
2622 ;; Must be in sync with vc-status-printer. | |
2623 (forward-char 25)) | |
2624 | |
2625 ;;;###autoload | |
2528 (defun vc-status (dir) | 2626 (defun vc-status (dir) |
2529 "Show the VC status for DIR." | 2627 "Show the VC status for DIR." |
2530 (interactive "DVC status for directory: ") | 2628 (interactive "DVC status for directory: ") |
2531 (vc-setup-buffer "*vc-status*") | 2629 (vc-setup-buffer "*vc-status*") |
2532 (switch-to-buffer "*vc-status*") | 2630 (switch-to-buffer "*vc-status*") |
2533 (cd dir) | 2631 (cd dir) |
2534 (vc-status-mode)) | 2632 (vc-status-mode)) |
2535 | 2633 |
2536 (defvar vc-status-mode-map | 2634 (defvar vc-status-mode-map |
2537 (let ((map (make-sparse-keymap))) | 2635 (let ((map (make-keymap))) |
2636 (suppress-keymap map) | |
2637 ;; Marking. | |
2538 (define-key map "m" 'vc-status-mark-file) | 2638 (define-key map "m" 'vc-status-mark-file) |
2639 (define-key map "M" 'vc-status-mark-all-files) | |
2539 (define-key map "u" 'vc-status-unmark-file) | 2640 (define-key map "u" 'vc-status-unmark-file) |
2641 (define-key map "\C-?" 'vc-status-unmark-file-up) | |
2642 (define-key map "\M-\C-?" 'vc-status-unmark-all-files) | |
2643 ;; Movement. | |
2644 (define-key map "n" 'vc-status-next-line) | |
2645 (define-key map " " 'vc-status-next-line) | |
2646 (define-key map "\t" 'vc-status-next-line) | |
2647 (define-key map "p" 'vc-status-previous-line) | |
2648 (define-key map [backtab] 'vc-status-previous-line) | |
2649 ;; VC commands. | |
2650 (define-key map "=" 'vc-diff) | |
2651 (define-key map "a" 'vc-status-register) | |
2652 ;; Can't be "g" (as in vc map), so "A" for "Annotate". | |
2653 (define-key map "A" 'vc-annotate) | |
2654 ;; vc-print-log uses the current buffer, not a file. | |
2655 ;; (define-key map "l" 'vc-status-print-log) | |
2656 ;; The remainder. | |
2657 (define-key map "f" 'vc-status-find-file) | |
2658 (define-key map "o" 'vc-status-find-file-other-window) | |
2659 (define-key map "q" 'bury-buffer) | |
2660 (define-key map "g" 'vc-status-refresh) | |
2540 map) | 2661 map) |
2541 "Keymap for VC status") | 2662 "Keymap for VC status") |
2542 | 2663 |
2543 (defun vc-status-mode () | 2664 (defun vc-status-mode () |
2544 "Major mode for VC status. | 2665 "Major mode for VC status. |
2550 (let ((buffer-read-only nil) | 2671 (let ((buffer-read-only nil) |
2551 (backend (vc-responsible-backend default-directory)) | 2672 (backend (vc-responsible-backend default-directory)) |
2552 entries) | 2673 entries) |
2553 (erase-buffer) | 2674 (erase-buffer) |
2554 (set (make-local-variable 'vc-status) | 2675 (set (make-local-variable 'vc-status) |
2555 (ewoc-create #'vc-status-printer)) | 2676 (ewoc-create #'vc-status-printer |
2556 (vc-status-insert-headers backend default-directory) | 2677 (vc-status-headers backend default-directory))) |
2557 (setq entries (vc-call-backend backend 'dir-status default-directory)) | 2678 (vc-status-refresh))) |
2679 | |
2680 (put 'vc-status-mode 'mode-class 'special) | |
2681 | |
2682 (defun vc-update-vc-status-buffer (entries buffer) | |
2683 (with-current-buffer buffer | |
2558 (dolist (entry entries) | 2684 (dolist (entry entries) |
2559 (ewoc-enter-last | 2685 (ewoc-enter-last vc-status |
2560 vc-status (vc-status-create-fileinfo (cdr entry) (car entry)))))) | 2686 (vc-status-create-fileinfo (cdr entry) (car entry)))) |
2687 (ewoc-goto-node vc-status (ewoc-nth vc-status 0)))) | |
2688 | |
2689 (defun vc-status-refresh () | |
2690 "Refresh the contents of the VC status buffer." | |
2691 (interactive) | |
2692 ;; This is not very efficient; ewoc could use a new function here. | |
2693 (ewoc-filter vc-status (lambda (node) nil)) | |
2694 (let ((backend (vc-responsible-backend default-directory))) | |
2695 ;; Call the dir-status backend function. dir-status is supposed to | |
2696 ;; be asynchronous. It should compute the results and call the | |
2697 ;; function passed as a an arg to update the vc-status buffer with | |
2698 ;; the results. | |
2699 (vc-call-backend | |
2700 backend 'dir-status default-directory | |
2701 #'vc-update-vc-status-buffer (current-buffer)))) | |
2702 | |
2703 (defun vc-status-next-line (arg) | |
2704 "Go to the next line. | |
2705 If a prefix argument is given, move by that many lines." | |
2706 (interactive "p") | |
2707 (ewoc-goto-next vc-status arg) | |
2708 (vc-status-move-to-goal-column)) | |
2709 | |
2710 (defun vc-status-previous-line (arg) | |
2711 "Go to the previous line. | |
2712 If a prefix argument is given, move by that many lines." | |
2713 (interactive "p") | |
2714 (ewoc-goto-prev vc-status arg) | |
2715 (vc-status-move-to-goal-column)) | |
2561 | 2716 |
2562 (defun vc-status-mark-file () | 2717 (defun vc-status-mark-file () |
2563 "Mark the current file." | 2718 "Mark the current file and move to the next line." |
2564 (interactive) | 2719 (interactive) |
2565 (let* ((crt (ewoc-locate vc-status)) | 2720 (let* ((crt (ewoc-locate vc-status)) |
2566 (file (ewoc-data crt))) | 2721 (file (ewoc-data crt))) |
2567 (setf (vc-status-fileinfo->marked file) t) | 2722 (setf (vc-status-fileinfo->marked file) t) |
2568 (ewoc-invalidate vc-status crt) | 2723 (ewoc-invalidate vc-status crt) |
2569 (ewoc-goto-next vc-status 1))) | 2724 (vc-status-next-line 1))) |
2725 | |
2726 (defun vc-status-mark-all-files () | |
2727 "Mark all files." | |
2728 (interactive) | |
2729 (ewoc-map | |
2730 (lambda (file) | |
2731 (unless (vc-status-fileinfo->marked file) | |
2732 (setf (vc-status-fileinfo->marked file) t) | |
2733 t)) | |
2734 vc-status)) | |
2570 | 2735 |
2571 (defun vc-status-unmark-file () | 2736 (defun vc-status-unmark-file () |
2572 "Mark the current file." | 2737 "Unmark the current file and move to the next line." |
2573 (interactive) | 2738 (interactive) |
2574 (let* ((crt (ewoc-locate vc-status)) | 2739 (let* ((crt (ewoc-locate vc-status)) |
2575 (file (ewoc-data crt))) | 2740 (file (ewoc-data crt))) |
2576 (setf (vc-status-fileinfo->marked file) nil) | 2741 (setf (vc-status-fileinfo->marked file) nil) |
2577 (ewoc-invalidate vc-status crt) | 2742 (ewoc-invalidate vc-status crt) |
2578 (ewoc-goto-next vc-status 1))) | 2743 (vc-status-next-line 1))) |
2744 | |
2745 (defun vc-status-unmark-file-up () | |
2746 "Move to the previous line and unmark the file." | |
2747 (interactive) | |
2748 ;; If we're on the first line, we won't move up, but we will still | |
2749 ;; remove the mark. This seems a bit odd but it is what buffer-menu | |
2750 ;; does. | |
2751 (let* ((prev (ewoc-goto-prev vc-status 1)) | |
2752 (file (ewoc-data prev))) | |
2753 (setf (vc-status-fileinfo->marked file) nil) | |
2754 (ewoc-invalidate vc-status prev) | |
2755 (vc-status-move-to-goal-column))) | |
2756 | |
2757 (defun vc-status-unmark-all-files () | |
2758 "Unmark all files." | |
2759 (interactive) | |
2760 (ewoc-map | |
2761 (lambda (file) | |
2762 (when (vc-status-fileinfo->marked file) | |
2763 (setf (vc-status-fileinfo->marked file) nil) | |
2764 t)) | |
2765 vc-status)) | |
2766 | |
2767 (defun vc-status-register () | |
2768 "Register the marked files, or the current file if no marks." | |
2769 (interactive) | |
2770 (let ((files (or (vc-status-marked-files) | |
2771 (list (vc-status-current-file))))) | |
2772 (dolist (file files) | |
2773 (vc-register file)))) | |
2774 | |
2775 (defun vc-status-find-file () | |
2776 "Find the file on the current line." | |
2777 (interactive) | |
2778 (find-file (vc-status-current-file))) | |
2779 | |
2780 (defun vc-status-find-file-other-window () | |
2781 "Find the file on the current line, in another window." | |
2782 (interactive) | |
2783 (find-file-other-window (vc-status-current-file))) | |
2784 | |
2785 (defun vc-status-current-file () | |
2786 (let ((node (ewoc-locate vc-status))) | |
2787 (unless node | |
2788 (error "No file available.")) | |
2789 (expand-file-name (vc-status-fileinfo->name (ewoc-data node))))) | |
2579 | 2790 |
2580 (defun vc-status-marked-files () | 2791 (defun vc-status-marked-files () |
2581 "Return the list of marked files" | 2792 "Return the list of marked files" |
2582 (mapcar | 2793 (mapcar |
2583 (lambda (elem) | 2794 (lambda (elem) |
2584 (expand-file-name (vc-status-fileinfo->name elem))) | 2795 (expand-file-name (vc-status-fileinfo->name elem))) |
2585 (ewoc-collect | 2796 (ewoc-collect |
2586 vc-status | 2797 vc-status |
2587 (lambda (crt) (vc-status-fileinfo->marked crt))))) | 2798 (lambda (crt) (vc-status-fileinfo->marked crt))))) |
2588 | 2799 |
2589 ;;; End experimental code. | 2800 ;;; End experimental code. |
2590 | 2801 |
2591 ;; Named-configuration entry points | 2802 ;; Named-configuration entry points |
2780 (substitute-command-keys | 2991 (substitute-command-keys |
2781 "\\[vc-next-action] to correct"))) | 2992 "\\[vc-next-action] to correct"))) |
2782 (if (not (vc-find-backend-function (vc-backend file) 'merge-news)) | 2993 (if (not (vc-find-backend-function (vc-backend file) 'merge-news)) |
2783 (error "Sorry, merging news is not implemented for %s" | 2994 (error "Sorry, merging news is not implemented for %s" |
2784 (vc-backend file)) | 2995 (vc-backend file)) |
2785 (vc-call merge-news file) | 2996 (vc-maybe-resolve-conflicts file (vc-call merge-news file))))))) |
2786 (vc-resynch-buffer file t t)))))) | |
2787 | 2997 |
2788 (defun vc-version-backup-file (file &optional rev) | 2998 (defun vc-version-backup-file (file &optional rev) |
2789 "Return name of backup file for revision REV of FILE. | 2999 "Return name of backup file for revision REV of FILE. |
2790 If version backups should be used for FILE, and there exists | 3000 If version backups should be used for FILE, and there exists |
2791 such a backup for REV or the working revision of file, return | 3001 such a backup for REV or the working revision of file, return |
3022 (t | 3232 (t |
3023 ;; Don't supply any filenames to backend; this means | 3233 ;; Don't supply any filenames to backend; this means |
3024 ;; it should find all relevant files relative to | 3234 ;; it should find all relevant files relative to |
3025 ;; the default-directory. | 3235 ;; the default-directory. |
3026 nil))) | 3236 nil))) |
3027 (dolist (file (or args (list default-directory))) | |
3028 (if (eq (string-match tramp-file-name-regexp file) 0) | |
3029 (error "Sorry, vc-update-change-log does not work over Tramp"))) | |
3030 (vc-call-backend (vc-responsible-backend default-directory) | 3237 (vc-call-backend (vc-responsible-backend default-directory) |
3031 'update-changelog args)) | 3238 'update-changelog args)) |
3032 | 3239 |
3033 ;;; The default back end. Assumes RCS-like revision numbering. | 3240 ;;; The default back end. Assumes RCS-like revision numbering. |
3034 | 3241 |