diff options
| -rw-r--r-- | lisp/vc.el | 114 |
1 files changed, 62 insertions, 52 deletions
diff --git a/lisp/vc.el b/lisp/vc.el index 96f6d6fd66c..266d454be7c 100644 --- a/lisp/vc.el +++ b/lisp/vc.el | |||
| @@ -1157,6 +1157,7 @@ files in or below it." | |||
| 1157 | (set-buffer (get-buffer-create "*vc-diff*")) | 1157 | (set-buffer (get-buffer-create "*vc-diff*")) |
| 1158 | (cd file) | 1158 | (cd file) |
| 1159 | (vc-file-tree-walk | 1159 | (vc-file-tree-walk |
| 1160 | default-directory | ||
| 1160 | (function (lambda (f) | 1161 | (function (lambda (f) |
| 1161 | (message "Looking at %s" f) | 1162 | (message "Looking at %s" f) |
| 1162 | (and | 1163 | (and |
| @@ -1238,28 +1239,20 @@ the variable `vc-header-alist'." | |||
| 1238 | (replace-match "$\\1$")) | 1239 | (replace-match "$\\1$")) |
| 1239 | (vc-restore-buffer-context context))) | 1240 | (vc-restore-buffer-context context))) |
| 1240 | 1241 | ||
| 1241 | ;; The VC directory submode. Coopt Dired for this. | 1242 | ;; The VC directory major mode. Coopt Dired for this. |
| 1242 | ;; All VC commands get mapped into logical equivalents. | 1243 | ;; All VC commands get mapped into logical equivalents. |
| 1243 | 1244 | ||
| 1244 | (defvar vc-dired-prefix-map (make-sparse-keymap)) | 1245 | (define-derived-mode vc-dired-mode dired-mode "Dired under VC" |
| 1245 | (define-key vc-dired-prefix-map "\C-xv" vc-prefix-map) | 1246 | "The major mode used in VC directory buffers. It is derived from Dired. |
| 1246 | (define-key vc-dired-prefix-map "g" 'vc-directory) | ||
| 1247 | (define-key vc-dired-prefix-map "=" 'vc-diff) | ||
| 1248 | |||
| 1249 | (or (not (boundp 'minor-mode-map-alist)) | ||
| 1250 | (assq 'vc-dired-mode minor-mode-map-alist) | ||
| 1251 | (setq minor-mode-map-alist | ||
| 1252 | (cons (cons 'vc-dired-mode vc-dired-prefix-map) | ||
| 1253 | minor-mode-map-alist))) | ||
| 1254 | |||
| 1255 | (defun vc-dired-mode () | ||
| 1256 | "The augmented Dired minor mode used in VC directory buffers. | ||
| 1257 | All Dired commands operate normally. Users currently locking listed files | 1247 | All Dired commands operate normally. Users currently locking listed files |
| 1258 | are listed in place of the file's owner and group. | 1248 | are listed in place of the file's owner and group. |
| 1259 | Keystrokes bound to VC commands will execute as though they had been called | 1249 | Keystrokes bound to VC commands will execute as though they had been called |
| 1260 | on a buffer attached to the file named in the current Dired buffer line." | 1250 | on a buffer attached to the file named in the current Dired buffer line." |
| 1261 | (setq vc-dired-mode t) | 1251 | (setq vc-dired-mode t)) |
| 1262 | (setq vc-mode " under VC")) | 1252 | |
| 1253 | (define-key vc-dired-mode-map "\C-xv" vc-prefix-map) | ||
| 1254 | (define-key vc-dired-mode-map "g" 'vc-dired-update) | ||
| 1255 | (define-key vc-dired-mode-map "=" 'vc-diff) | ||
| 1263 | 1256 | ||
| 1264 | (defun vc-dired-state-info (file) | 1257 | (defun vc-dired-state-info (file) |
| 1265 | ;; Return the string that indicates the version control status | 1258 | ;; Return the string that indicates the version control status |
| @@ -1286,15 +1279,31 @@ on a buffer attached to the file named in the current Dired buffer line." | |||
| 1286 | ;; (insert (concat x "\t"))) | 1279 | ;; (insert (concat x "\t"))) |
| 1287 | ;; | 1280 | ;; |
| 1288 | ;; This code, like dired, assumes UNIX -l format. | 1281 | ;; This code, like dired, assumes UNIX -l format. |
| 1289 | (cond | 1282 | (let ((pos (point)) limit perm owner date-and-file) |
| 1290 | ((re-search-forward | 1283 | (end-of-line) |
| 1291 | "\\([drwx-]+ \\) *[0-9]+ \\([^ ]+\\) +[0-9]+\\( .*\\)" | 1284 | (setq limit (point)) |
| 1292 | nil 0) | 1285 | (goto-char pos) |
| 1293 | (if (numberp x) (setq x (match-string 2))) | 1286 | (cond |
| 1287 | ((or | ||
| 1288 | (re-search-forward ;; owner and group | ||
| 1289 | "\\([drwxlts-]+ \\) *[0-9]+ \\([^ ]+\\) +[^ ]+ +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)" | ||
| 1290 | limit t) | ||
| 1291 | (re-search-forward ;; only owner displayed | ||
| 1292 | "\\([drwxlts-]+ \\) *[0-9]+ \\([^ ]+\\) +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)" | ||
| 1293 | limit t)) | ||
| 1294 | (setq perm (match-string 1) | ||
| 1295 | owner (match-string 2) | ||
| 1296 | date-and-file (match-string 3))) | ||
| 1297 | ((re-search-forward ;; OS/2 -l format, no links, owner, group | ||
| 1298 | "\\([drwxlts-]+ \\) *[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)" | ||
| 1299 | limit t) | ||
| 1300 | (setq perm (match-string 1) | ||
| 1301 | date-and-file (match-string 2)))) | ||
| 1302 | (if (numberp x) (setq x (or owner (number-to-string x)))) | ||
| 1294 | (if x (setq x (concat "(" x ")"))) | 1303 | (if x (setq x (concat "(" x ")"))) |
| 1295 | (let ((rep (substring (concat x " ") 0 10))) | 1304 | (let ((rep (substring (concat x " ") 0 10))) |
| 1296 | (replace-match (concat "\\1" rep "\\3")))))) | 1305 | (replace-match (concat perm rep date-and-file))))) |
| 1297 | 1306 | ||
| 1298 | (defun vc-dired-update-line (file) | 1307 | (defun vc-dired-update-line (file) |
| 1299 | ;; Update the vc-dired listing line of file -- it is assumed | 1308 | ;; Update the vc-dired listing line of file -- it is assumed |
| 1300 | ;; that point is already on this line. Don't use dired-do-redisplay | 1309 | ;; that point is already on this line. Don't use dired-do-redisplay |
| @@ -1314,20 +1323,30 @@ on a buffer attached to the file named in the current Dired buffer line." | |||
| 1314 | (goto-char start)) | 1323 | (goto-char start)) |
| 1315 | (vc-dired-reformat-line (vc-dired-state-info file))) | 1324 | (vc-dired-reformat-line (vc-dired-state-info file))) |
| 1316 | 1325 | ||
| 1326 | (defun vc-dired-update (verbose) | ||
| 1327 | (interactive "P") | ||
| 1328 | (vc-directory default-directory verbose)) | ||
| 1329 | |||
| 1317 | ;;; Note in Emacs 18 the following defun gets overridden | 1330 | ;;; Note in Emacs 18 the following defun gets overridden |
| 1318 | ;;; with the symbol 'vc-directory-18. See below. | 1331 | ;;; with the symbol 'vc-directory-18. See below. |
| 1319 | ;;;###autoload | 1332 | ;;;###autoload |
| 1320 | (defun vc-directory (verbose) | 1333 | (defun vc-directory (dirname verbose) |
| 1321 | "Show version-control status of the current directory and subdirectories. | 1334 | "Show version-control status of the current directory and subdirectories. |
| 1322 | Normally it creates a Dired buffer that lists only the locked files | 1335 | Normally it creates a Dired buffer that lists only the locked files |
| 1323 | in all these directories. With a prefix argument, it lists all files." | 1336 | in all these directories. With a prefix argument, it lists all files." |
| 1324 | (interactive "P") | 1337 | (interactive "DDired under VC (directory): \nP") |
| 1338 | (setq dirname (expand-file-name dirname)) | ||
| 1339 | ;; force a trailing slash | ||
| 1340 | (if (not (eq (elt dirname (1- (length dirname))) ?/)) | ||
| 1341 | (setq dirname (concat dirname "/"))) | ||
| 1325 | (let (nonempty | 1342 | (let (nonempty |
| 1326 | (dl (length (expand-file-name default-directory))) | 1343 | (dl (length dirname)) |
| 1327 | (filelist nil) (statelist nil) | 1344 | (filelist nil) (statelist nil) |
| 1345 | (old-dir default-directory) | ||
| 1328 | dired-buf | 1346 | dired-buf |
| 1329 | dired-buf-mod-count) | 1347 | dired-buf-mod-count) |
| 1330 | (vc-file-tree-walk | 1348 | (vc-file-tree-walk |
| 1349 | dirname | ||
| 1331 | (function | 1350 | (function |
| 1332 | (lambda (f) | 1351 | (lambda (f) |
| 1333 | (if (vc-registered f) | 1352 | (if (vc-registered f) |
| @@ -1337,28 +1356,14 @@ in all these directories. With a prefix argument, it lists all files." | |||
| 1337 | (setq statelist (cons state statelist)))))))) | 1356 | (setq statelist (cons state statelist)))))))) |
| 1338 | (save-window-excursion | 1357 | (save-window-excursion |
| 1339 | (save-excursion | 1358 | (save-excursion |
| 1340 | ;; First, kill any existing vc-dired buffers of this directory. | 1359 | ;; This uses a semi-documented feature of dired; giving a switch |
| 1341 | ;; (Code much like dired-find-buffer-nocreate.) | 1360 | ;; argument forces the buffer to refresh each time. |
| 1342 | (let ((buffers (buffer-list)) | 1361 | (setq dired-buf |
| 1343 | (dir (expand-file-name default-directory))) | 1362 | (dired-internal-noselect |
| 1344 | (while buffers | 1363 | (cons dirname (nreverse filelist)) |
| 1345 | (if (buffer-name (car buffers)) | 1364 | dired-listing-switches 'vc-dired-mode)) |
| 1346 | (progn (set-buffer (car buffers)) | 1365 | (setq nonempty (not (eq 0 (length filelist)))))) |
| 1347 | (if (and (eq major-mode 'dired-mode) | ||
| 1348 | (string= dir | ||
| 1349 | (expand-file-name default-directory)) | ||
| 1350 | vc-dired-mode) | ||
| 1351 | (kill-buffer (car buffers))))) | ||
| 1352 | (setq buffers (cdr buffers))) | ||
| 1353 | ;; This uses a semi-documented feature of dired; giving a switch | ||
| 1354 | ;; argument forces the buffer to refresh each time. | ||
| 1355 | (dired | ||
| 1356 | (cons dir (nreverse filelist)) | ||
| 1357 | dired-listing-switches) | ||
| 1358 | (setq dired-buf (current-buffer)) | ||
| 1359 | (setq nonempty (not (eq 0 (length filelist))))))) | ||
| 1360 | (switch-to-buffer dired-buf) | 1366 | (switch-to-buffer dired-buf) |
| 1361 | (vc-dired-mode) | ||
| 1362 | ;; Make a few modifications to the header | 1367 | ;; Make a few modifications to the header |
| 1363 | (setq buffer-read-only nil) | 1368 | (setq buffer-read-only nil) |
| 1364 | (goto-char (point-min)) | 1369 | (goto-char (point-min)) |
| @@ -1385,7 +1390,7 @@ in all these directories. With a prefix argument, it lists all files." | |||
| 1385 | (insert " ") | 1390 | (insert " ") |
| 1386 | (setq buffer-read-only t) | 1391 | (setq buffer-read-only t) |
| 1387 | (message "No files are currently %s under %s" | 1392 | (message "No files are currently %s under %s" |
| 1388 | (if verbose "registered" "locked") default-directory)) | 1393 | (if verbose "registered" "locked") dirname)) |
| 1389 | )) | 1394 | )) |
| 1390 | 1395 | ||
| 1391 | ;; Emacs 18 version | 1396 | ;; Emacs 18 version |
| @@ -1398,6 +1403,7 @@ in all these directories. With a prefix argument, it lists all files." | |||
| 1398 | (erase-buffer) | 1403 | (erase-buffer) |
| 1399 | (cd dir) | 1404 | (cd dir) |
| 1400 | (vc-file-tree-walk | 1405 | (vc-file-tree-walk |
| 1406 | default-directory | ||
| 1401 | (function (lambda (f) | 1407 | (function (lambda (f) |
| 1402 | (if (vc-registered f) | 1408 | (if (vc-registered f) |
| 1403 | (let ((user (vc-locking-user f))) | 1409 | (let ((user (vc-locking-user f))) |
| @@ -1406,6 +1412,7 @@ in all these directories. With a prefix argument, it lists all files." | |||
| 1406 | "%s %s\n" | 1412 | "%s %s\n" |
| 1407 | (concat user) f)))))))) | 1413 | (concat user) f)))))))) |
| 1408 | (setq nonempty (not (zerop (buffer-size))))) | 1414 | (setq nonempty (not (zerop (buffer-size))))) |
| 1415 | |||
| 1409 | (if nonempty | 1416 | (if nonempty |
| 1410 | (progn | 1417 | (progn |
| 1411 | (pop-to-buffer "*vc-status*" t) | 1418 | (pop-to-buffer "*vc-status*" t) |
| @@ -1482,6 +1489,7 @@ in all these directories. With a prefix argument, it lists all files." | |||
| 1482 | (let ((status nil)) | 1489 | (let ((status nil)) |
| 1483 | (catch 'vc-locked-example | 1490 | (catch 'vc-locked-example |
| 1484 | (vc-file-tree-walk | 1491 | (vc-file-tree-walk |
| 1492 | default-directory | ||
| 1485 | (function (lambda (f) | 1493 | (function (lambda (f) |
| 1486 | (and (vc-registered f) | 1494 | (and (vc-registered f) |
| 1487 | (if (vc-locking-user f) (throw 'vc-locked-example f) | 1495 | (if (vc-locking-user f) (throw 'vc-locked-example f) |
| @@ -1499,6 +1507,7 @@ version becomes part of the named configuration." | |||
| 1499 | (if (stringp result) | 1507 | (if (stringp result) |
| 1500 | (error "File %s is locked" result) | 1508 | (error "File %s is locked" result) |
| 1501 | (vc-file-tree-walk | 1509 | (vc-file-tree-walk |
| 1510 | default-directory | ||
| 1502 | (function (lambda (f) (and | 1511 | (function (lambda (f) (and |
| 1503 | (vc-name f) | 1512 | (vc-name f) |
| 1504 | (vc-backend-assign-name f name))))) | 1513 | (vc-backend-assign-name f name))))) |
| @@ -1518,6 +1527,7 @@ levels in the snapshot." | |||
| 1518 | (if (eq result 'visited) | 1527 | (if (eq result 'visited) |
| 1519 | (setq update (yes-or-no-p "Update the affected buffers? "))) | 1528 | (setq update (yes-or-no-p "Update the affected buffers? "))) |
| 1520 | (vc-file-tree-walk | 1529 | (vc-file-tree-walk |
| 1530 | default-directory | ||
| 1521 | (function (lambda (f) (and | 1531 | (function (lambda (f) (and |
| 1522 | (vc-name f) | 1532 | (vc-name f) |
| 1523 | (vc-error-occurred | 1533 | (vc-error-occurred |
| @@ -2299,11 +2309,11 @@ Global user options: | |||
| 2299 | 2309 | ||
| 2300 | ;;; These things should probably be generally available | 2310 | ;;; These things should probably be generally available |
| 2301 | 2311 | ||
| 2302 | (defun vc-file-tree-walk (func &rest args) | 2312 | (defun vc-file-tree-walk (dirname func &rest args) |
| 2303 | "Walk recursively through default directory. | 2313 | "Walk recursively through DIRNAME. |
| 2304 | Invoke FUNC f ARGS on each non-directory file f underneath it." | 2314 | Invoke FUNC f ARGS on each non-directory file f underneath it." |
| 2305 | (vc-file-tree-walk-internal (expand-file-name default-directory) func args) | 2315 | (vc-file-tree-walk-internal (expand-file-name dirname) func args) |
| 2306 | (message "Traversing directory %s...done" default-directory)) | 2316 | (message "Traversing directory %s...done" dirname)) |
| 2307 | 2317 | ||
| 2308 | (defun vc-file-tree-walk-internal (file func args) | 2318 | (defun vc-file-tree-walk-internal (file func args) |
| 2309 | (if (not (file-directory-p file)) | 2319 | (if (not (file-directory-p file)) |